crypto.lisp

   1 ;;;;
   2 ;;;; Copyright (c) 2008 Zachary Beane, All Rights Reserved
   3 ;;;;
   4 ;;;; Redistribution and use in source and binary forms, with or without
   5 ;;;; modification, are permitted provided that the following conditions
   6 ;;;; are met:
   7 ;;;;
   8 ;;;;   * Redistributions of source code must retain the above copyright
   9 ;;;;     notice, this list of conditions and the following disclaimer.
  10 ;;;;
  11 ;;;;   * Redistributions in binary form must reproduce the above
  12 ;;;;     copyright notice, this list of conditions and the following
  13 ;;;;     disclaimer in the documentation and/or other materials
  14 ;;;;     provided with the distribution.
  15 ;;;;
  16 ;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  17 ;;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  18 ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  19 ;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  20 ;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  21 ;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  22 ;;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  23 ;;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  24 ;;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  25 ;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  26 ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27 ;;;;
  28 ;;;; crypto.lisp
  29
  30 (in-package #:zs3)
  31
  32 (defparameter *empty-string-sha256*
  33   (ironclad:byte-array-to-hex-string
  34    (ironclad:digest-sequence :sha256 (make-array 0 :element-type 'octet))))
  35
  36 (defparameter *newline-vector*
  37   (make-array 1 :element-type 'octet :initial-element 10))
  38
  39 (defclass digester ()
  40   ((hmac
  41     :initarg :hmac
  42     :accessor hmac)
  43    (newline
  44     :initarg :newline
  45     :accessor newline
  46     :allocation :class)
  47    (signed-stream
  48     :initarg :signed-stream
  49     :accessor signed-stream))
  50   (:default-initargs
  51    :signed-stream (make-string-output-stream)
  52    :newline *newline-vector*))
  53
  54 (defun make-digester (key &key (digest-algorithm :sha1))
  55   (when (stringp key)
  56     (setf key (string-octets key)))
  57   (make-instance 'digester
  58                  :hmac (ironclad:make-hmac key digest-algorithm)))
  59
  60 (defgeneric add-string (string digester)
  61   (:method (string digester)
  62     (write-string string (signed-stream digester))
  63     (ironclad:update-hmac (hmac digester) (string-octets string))))
  64
  65 (defgeneric add-newline (digester)
  66   (:method (digester)
  67     (terpri (signed-stream digester))
  68     (ironclad:update-hmac (hmac digester) (newline digester))))
  69
  70 (defgeneric add-line (string digester)
  71   (:method (string digester)
  72     (add-string string digester)
  73     (add-newline digester)))
  74
  75 (defgeneric digest (digester)
  76   (:method (digester)
  77     (ironclad:hmac-digest (hmac digester))))
  78
  79 (defgeneric digest64 (digester)
  80   (:method (digester)
  81     (base64:usb8-array-to-base64-string
  82      (ironclad:hmac-digest (hmac digester)))))
  83
  84 (defun file-md5 (file)
  85    (ironclad:digest-file :md5 file))
  86
  87 (defun file-md5/b64 (file)
  88   (base64:usb8-array-to-base64-string (file-md5 file)))
  89
  90 (defun file-md5/hex (file)
  91   (ironclad:byte-array-to-hex-string (file-md5 file)))
  92
  93 (defun file-sha256 (file)
  94   (ironclad:digest-file :sha256 file))
  95
  96 (defun file-sha256/hex (file)
  97   (ironclad:byte-array-to-hex-string (file-sha256 file)))
  98
  99 (defun vector-sha256 (vector)
 100   (ironclad:digest-sequence :sha256 vector))
 101
 102 (defun vector-sha256/hex (vector)
 103   (ironclad:byte-array-to-hex-string (vector-sha256 vector)))
 104
 105 (defun strings-sha256/hex (strings)
 106   (when strings
 107     (let ((digest (ironclad:make-digest :sha256)))
 108       (ironclad:update-digest digest (string-octets (first strings)))
 109       (dolist (string (rest strings))
 110         (ironclad:update-digest digest *newline-vector*)
 111         (ironclad:update-digest digest (string-octets string)))
 112       (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)))))
 113
 114 (defun strings-hmac-sha256/hex (key strings)
 115   (when strings
 116     (when (stringp key)
 117       (setf key (string-octets key)))
 118     (let ((digest (ironclad:make-hmac key :sha256)))
 119       (ironclad:update-hmac digest (string-octets (first strings)))
 120       (dolist (string (rest strings))
 121         (ironclad:update-hmac digest *newline-vector*)
 122         (ironclad:update-hmac digest (string-octets string)))
 123       (ironclad:byte-array-to-hex-string (ironclad:hmac-digest digest)))))
 124
 125 (defun vector-md5/b64 (vector)
 126   (base64:usb8-array-to-base64-string
 127    (ironclad:digest-sequence :md5 vector)))
 128
 129 (defun file-etag (file)
 130   (format nil "\"~A\"" (file-md5/hex file)))
 131
 132 (defun sign-string (key string)
 133   (let ((digester (make-digester key)))
 134     (add-string string digester)
 135     (digest64 digester)))
 136
 137 (defun hmac-sha256 (key strings)
 138   (let ((digester (make-digester key :digest-algorithm :sha256)))
 139     (if (consp strings)
 140         (dolist (s strings)
 141           (add-string s digester))
 142         (add-string strings digester))
 143     (digest digester)))