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
  85
  86 (defun file-md5 (file)
  87    (ironclad:digest-file :md5 file))
  88
  89 (defun file-md5/b64 (file)
  90   (base64:usb8-array-to-base64-string (file-md5 file)))
  91
  92 (defun file-md5/hex (file)
  93   (ironclad:byte-array-to-hex-string (file-md5 file)))
  94
  95 (defun file-sha256 (file)
  96   (ironclad:digest-file :sha256 file))
  97
  98 (defun file-sha256/hex (file)
  99   (ironclad:byte-array-to-hex-string (file-sha256 file)))
 100
 101 (defun vector-sha256 (vector)
 102   (ironclad:digest-sequence :sha256 vector))
 103
 104 (defun vector-sha256/hex (vector)
 105   (ironclad:byte-array-to-hex-string (vector-sha256 vector)))
 106
 107 (defun strings-sha256/hex (strings)
 108   (when strings
 109     (let ((digest (ironclad:make-digest :sha256)))
 110       (ironclad:update-digest digest (string-octets (first strings)))
 111       (dolist (string (rest strings))
 112         (ironclad:update-digest digest *newline-vector*)
 113         (ironclad:update-digest digest (string-octets string)))
 114       (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)))))
 115
 116 (defun strings-hmac-sha256/hex (key strings)
 117   (when strings
 118     (when (stringp key)
 119       (setf key (string-octets key)))
 120     (let ((digest (ironclad:make-hmac key :sha256)))
 121       (ironclad:update-hmac digest (string-octets (first strings)))
 122       (dolist (string (rest strings))
 123         (ironclad:update-hmac digest *newline-vector*)
 124         (ironclad:update-hmac digest (string-octets string)))
 125       (ironclad:byte-array-to-hex-string (ironclad:hmac-digest digest)))))
 126
 127 (defun vector-md5/b64 (vector)
 128   (base64:usb8-array-to-base64-string
 129    (ironclad:digest-sequence :md5 vector)))
 130
 131 (defun file-etag (file)
 132   (format nil "\"~A\"" (file-md5/hex file)))
 133
 134 (defun sign-string (key string)
 135   (let ((digester (make-digester key)))
 136     (add-string string digester)
 137     (digest64 digester)))
 138
 139 (defun hmac-sha256 (key strings)
 140   (let ((digester (make-digester key :digest-algorithm :sha256)))
 141     (if (consp strings)
 142         (dolist (s strings)
 143           (add-string s digester))
 144         (add-string strings digester))
 145     (digest digester)))
 146
 147
 148
 149