Updated version to 1.3.3.
[zs3.git] / crypto.lisp
blob40dc7d4c8d245522c680175d1e8e7afa8653b4cf
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
30 (in-package #:zs3)
32 (defparameter *empty-string-sha256*
33 (ironclad:byte-array-to-hex-string
34 (ironclad:digest-sequence :sha256 (make-array 0 :element-type 'octet))))
36 (defparameter *newline-vector*
37 (make-array 1 :element-type 'octet :initial-element 10))
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*))
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)))
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))))
65 (defgeneric add-newline (digester)
66 (:method (digester)
67 (terpri (signed-stream digester))
68 (ironclad:update-hmac (hmac digester) (newline digester))))
70 (defgeneric add-line (string digester)
71 (:method (string digester)
72 (add-string string digester)
73 (add-newline digester)))
75 (defgeneric digest (digester)
76 (:method (digester)
77 (ironclad:hmac-digest (hmac digester))))
79 (defgeneric digest64 (digester)
80 (:method (digester)
81 (base64:usb8-array-to-base64-string
82 (ironclad:hmac-digest (hmac digester)))))
84 (defun file-md5 (file)
85 (ironclad:digest-file :md5 file))
87 (defun file-md5/b64 (file)
88 (base64:usb8-array-to-base64-string (file-md5 file)))
90 (defun file-md5/hex (file)
91 (ironclad:byte-array-to-hex-string (file-md5 file)))
93 (defun file-sha256 (file)
94 (ironclad:digest-file :sha256 file))
96 (defun file-sha256/hex (file)
97 (ironclad:byte-array-to-hex-string (file-sha256 file)))
99 (defun vector-sha256 (vector)
100 (ironclad:digest-sequence :sha256 vector))
102 (defun vector-sha256/hex (vector)
103 (ironclad:byte-array-to-hex-string (vector-sha256 vector)))
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)))))
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)))))
125 (defun vector-md5/b64 (vector)
126 (base64:usb8-array-to-base64-string
127 (ironclad:digest-sequence :md5 vector)))
129 (defun file-etag (file)
130 (format nil "\"~A\"" (file-md5/hex file)))
132 (defun sign-string (key string)
133 (let ((digester (make-digester key)))
134 (add-string string digester)
135 (digest64 digester)))
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)))