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 (defclass digester ()
  37   ((hmac
  38     :initarg :hmac
  39     :accessor hmac)
  40    (newline
  41     :initarg :newline
  42     :accessor newline
  43     :allocation :class)
  44    (signed-stream
  45     :initarg :signed-stream
  46     :accessor signed-stream))
  47   (:default-initargs
  48    :signed-stream (make-string-output-stream)
  49    :newline (make-array 1 :element-type '(unsigned-byte 8)
  50                         :initial-element 10)))
  51
  52 (defun make-digester (key &key (digest-algorithm :sha1))
  53   (let ((hmac (ironclad:make-hmac (string-octets key) digest-algorithm)))
  54     (make-instance 'digester
  55                    :hmac hmac)))
  56
  57 (defgeneric add-string (string digester)
  58   (:method (string digester)
  59     (write-string string (signed-stream digester))
  60     (ironclad:update-hmac (hmac digester) (string-octets string))))
  61
  62 (defgeneric add-newline (digester)
  63   (:method (digester)
  64     (terpri (signed-stream digester))
  65     (ironclad:update-hmac (hmac digester) (newline digester))))
  66
  67 (defgeneric add-line (string digester)
  68   (:method (string digester)
  69     (add-string string digester)
  70     (add-newline digester)))
  71
  72 (defgeneric digest64 (digester)
  73   (:method (digester)
  74     (base64:usb8-array-to-base64-string
  75      (ironclad:hmac-digest (hmac digester)))))
  76
  77 (defun file-md5 (file)
  78    (ironclad:digest-file :md5 file))
  79
  80 (defun file-md5/b64 (file)
  81   (base64:usb8-array-to-base64-string (file-md5 file)))
  82
  83 (defun file-md5/hex (file)
  84   (ironclad:byte-array-to-hex-string (file-md5 file)))
  85
  86 (defun file-sha256 (file)
  87   (ironclad:digest-file :sha256 file))
  88
  89 (defun file-sha256/hex (file)
  90   (ironclad:byte-array-to-hex-string (file-sha256 file)))
  91
  92 (defun vector-sha256 (vector)
  93   (ironclad:digest-sequence :sha256 vector))
  94
  95 (defun vector-sha256/hex (vector)
  96   (ironclad:byte-array-to-hex-string (vector-sha256 vector)))
  97
  98 (defun vector-md5/b64 (vector)
  99   (base64:usb8-array-to-base64-string
 100    (ironclad:digest-sequence :md5 vector)))
 101
 102 (defun file-etag (file)
 103   (format nil "\"~A\"" (file-md5/hex file)))
 104
 105 (defun sign-string (key string)
 106   (let ((digester (make-digester key)))
 107     (add-string string digester)
 108     (digest64 digester)))