1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
|
;;;; ripemd-160.lisp -- the RIPEMD-160 digest function
(in-package :crypto)
(defstruct (ripemd-160-regs
(:type (vector (unsigned-byte 32)))
(:constructor initial-ripemd-160-regs)
(:copier %copy-ripemd-160-regs))
(a #x67452301)
(b #xefcdab89)
(c #x98badcfe)
(d #x10325476)
(e #xc3d2e1f0))
(deftype ripemd-160-regs () '(simple-array (unsigned-byte 32) (5)))
(defun update-ripemd-160-block (regs block)
(declare (type ripemd-160-regs regs)
(type (simple-array (unsigned-byte 32) (16)) block)
(optimize (speed 3) (safety 0) (space 0) (debug 0)))
(let* ((a1 (ripemd-160-regs-a regs)) (a2 a1)
(b1 (ripemd-160-regs-b regs)) (b2 b1)
(c1 (ripemd-160-regs-c regs)) (c2 c1)
(d1 (ripemd-160-regs-d regs)) (d2 d1)
(e1 (ripemd-160-regs-e regs)) (e2 e1))
(declare (type (unsigned-byte 32) a1 a2 b1 b2 c1 c2 d1 d2 e1 e2))
(flet ((f (x y z)
(declare (type (unsigned-byte 32) x y z))
(ldb (byte 32 0) (logxor x y z)))
(g (x y z)
(declare (type (unsigned-byte 32) x y z))
(ldb (byte 32 0) (logxor z (logand x (logxor y z)))))
(h (x y z)
(declare (type (unsigned-byte 32) x y z))
(ldb (byte 32 0) (logxor z (logior x (lognot y)))))
(i (x y z)
(declare (type (unsigned-byte 32) x y z))
(ldb (byte 32 0) (logxor y (logand z (logxor x y)))))
(j (x y z)
(declare (type (unsigned-byte 32) x y z))
(ldb (byte 32 0) (logxor x (logior y (lognot z))))))
(declare (inline f g h i j))
(macrolet ((subround (func a b c d e x s k)
`(progn
(setf ,a (mod32+ ,a
(mod32+ (funcall (function ,func) ,b ,c ,d)
(mod32+ ,x ,k))))
(setf ,a (mod32+ (rol32 ,a ,s) ,e))
(setf ,c (rol32 ,c 10))))
(with-ripemd-round ((block func constant) &rest clauses)
(loop for (a b c d e i s) in clauses
collect `(subround ,func ,a ,b ,c ,d ,e (aref ,block ,i)
,s ,constant)
into result
finally (return `(progn ,@result)))))
(with-ripemd-round (block f 0)
(a1 b1 c1 d1 e1 0 11) (e1 a1 b1 c1 d1 1 14)
(d1 e1 a1 b1 c1 2 15) (c1 d1 e1 a1 b1 3 12)
(b1 c1 d1 e1 a1 4 5) (a1 b1 c1 d1 e1 5 8)
(e1 a1 b1 c1 d1 6 7) (d1 e1 a1 b1 c1 7 9)
(c1 d1 e1 a1 b1 8 11) (b1 c1 d1 e1 a1 9 13)
(a1 b1 c1 d1 e1 10 14) (e1 a1 b1 c1 d1 11 15)
(d1 e1 a1 b1 c1 12 6) (c1 d1 e1 a1 b1 13 7)
(b1 c1 d1 e1 a1 14 9) (a1 b1 c1 d1 e1 15 8))
(with-ripemd-round (block g #x5a827999)
(e1 a1 b1 c1 d1 7 7) (d1 e1 a1 b1 c1 4 6)
(c1 d1 e1 a1 b1 13 8) (b1 c1 d1 e1 a1 1 13)
(a1 b1 c1 d1 e1 10 11) (e1 a1 b1 c1 d1 6 9)
(d1 e1 a1 b1 c1 15 7) (c1 d1 e1 a1 b1 3 15)
(b1 c1 d1 e1 a1 12 7) (a1 b1 c1 d1 e1 0 12)
(e1 a1 b1 c1 d1 9 15) (d1 e1 a1 b1 c1 5 9)
(c1 d1 e1 a1 b1 2 11) (b1 c1 d1 e1 a1 14 7)
(a1 b1 c1 d1 e1 11 13) (e1 a1 b1 c1 d1 8 12))
(with-ripemd-round (block h #x6ed9eba1)
(d1 e1 a1 b1 c1 3 11) (c1 d1 e1 a1 b1 10 13)
(b1 c1 d1 e1 a1 14 6) (a1 b1 c1 d1 e1 4 7)
(e1 a1 b1 c1 d1 9 14) (d1 e1 a1 b1 c1 15 9)
(c1 d1 e1 a1 b1 8 13) (b1 c1 d1 e1 a1 1 15)
(a1 b1 c1 d1 e1 2 14) (e1 a1 b1 c1 d1 7 8)
(d1 e1 a1 b1 c1 0 13) (c1 d1 e1 a1 b1 6 6)
(b1 c1 d1 e1 a1 13 5) (a1 b1 c1 d1 e1 11 12)
(e1 a1 b1 c1 d1 5 7) (d1 e1 a1 b1 c1 12 5))
(with-ripemd-round (block i #x8f1bbcdc)
(c1 d1 e1 a1 b1 1 11) (b1 c1 d1 e1 a1 9 12)
(a1 b1 c1 d1 e1 11 14) (e1 a1 b1 c1 d1 10 15)
(d1 e1 a1 b1 c1 0 14) (c1 d1 e1 a1 b1 8 15)
(b1 c1 d1 e1 a1 12 9) (a1 b1 c1 d1 e1 4 8)
(e1 a1 b1 c1 d1 13 9) (d1 e1 a1 b1 c1 3 14)
(c1 d1 e1 a1 b1 7 5) (b1 c1 d1 e1 a1 15 6)
(a1 b1 c1 d1 e1 14 8) (e1 a1 b1 c1 d1 5 6)
(d1 e1 a1 b1 c1 6 5) (c1 d1 e1 a1 b1 2 12))
(with-ripemd-round (block j #xa953fd4e)
(b1 c1 d1 e1 a1 4 9) (a1 b1 c1 d1 e1 0 15)
(e1 a1 b1 c1 d1 5 5) (d1 e1 a1 b1 c1 9 11)
(c1 d1 e1 a1 b1 7 6) (b1 c1 d1 e1 a1 12 8)
(a1 b1 c1 d1 e1 2 13) (e1 a1 b1 c1 d1 10 12)
(d1 e1 a1 b1 c1 14 5) (c1 d1 e1 a1 b1 1 12)
(b1 c1 d1 e1 a1 3 13) (a1 b1 c1 d1 e1 8 14)
(e1 a1 b1 c1 d1 11 11) (d1 e1 a1 b1 c1 6 8)
(c1 d1 e1 a1 b1 15 5) (b1 c1 d1 e1 a1 13 6))
(with-ripemd-round (block j #x50a28be6)
(a2 b2 c2 d2 e2 5 8) (e2 a2 b2 c2 d2 14 9)
(d2 e2 a2 b2 c2 7 9) (c2 d2 e2 a2 b2 0 11)
(b2 c2 d2 e2 a2 9 13) (a2 b2 c2 d2 e2 2 15)
(e2 a2 b2 c2 d2 11 15) (d2 e2 a2 b2 c2 4 5)
(c2 d2 e2 a2 b2 13 7) (b2 c2 d2 e2 a2 6 7)
(a2 b2 c2 d2 e2 15 8) (e2 a2 b2 c2 d2 8 11)
(d2 e2 a2 b2 c2 1 14) (c2 d2 e2 a2 b2 10 14)
(b2 c2 d2 e2 a2 3 12) (a2 b2 c2 d2 e2 12 6))
(with-ripemd-round (block i #x5c4dd124)
(e2 a2 b2 c2 d2 6 9) (d2 e2 a2 b2 c2 11 13)
(c2 d2 e2 a2 b2 3 15) (b2 c2 d2 e2 a2 7 7)
(a2 b2 c2 d2 e2 0 12) (e2 a2 b2 c2 d2 13 8)
(d2 e2 a2 b2 c2 5 9) (c2 d2 e2 a2 b2 10 11)
(b2 c2 d2 e2 a2 14 7) (a2 b2 c2 d2 e2 15 7)
(e2 a2 b2 c2 d2 8 12) (d2 e2 a2 b2 c2 12 7)
(c2 d2 e2 a2 b2 4 6) (b2 c2 d2 e2 a2 9 15)
(a2 b2 c2 d2 e2 1 13) (e2 a2 b2 c2 d2 2 11))
(with-ripemd-round (block h #x6d703ef3)
(d2 e2 a2 b2 c2 15 9) (c2 d2 e2 a2 b2 5 7)
(b2 c2 d2 e2 a2 1 15) (a2 b2 c2 d2 e2 3 11)
(e2 a2 b2 c2 d2 7 8) (d2 e2 a2 b2 c2 14 6)
(c2 d2 e2 a2 b2 6 6) (b2 c2 d2 e2 a2 9 14)
(a2 b2 c2 d2 e2 11 12) (e2 a2 b2 c2 d2 8 13)
(d2 e2 a2 b2 c2 12 5) (c2 d2 e2 a2 b2 2 14)
(b2 c2 d2 e2 a2 10 13) (a2 b2 c2 d2 e2 0 13)
(e2 a2 b2 c2 d2 4 7) (d2 e2 a2 b2 c2 13 5))
(with-ripemd-round (block g #x7a6d76e9)
(c2 d2 e2 a2 b2 8 15) (b2 c2 d2 e2 a2 6 5)
(a2 b2 c2 d2 e2 4 8) (e2 a2 b2 c2 d2 1 11)
(d2 e2 a2 b2 c2 3 14) (c2 d2 e2 a2 b2 11 14)
(b2 c2 d2 e2 a2 15 6) (a2 b2 c2 d2 e2 0 14)
(e2 a2 b2 c2 d2 5 6) (d2 e2 a2 b2 c2 12 9)
(c2 d2 e2 a2 b2 2 12) (b2 c2 d2 e2 a2 13 9)
(a2 b2 c2 d2 e2 9 12) (e2 a2 b2 c2 d2 7 5)
(d2 e2 a2 b2 c2 10 15) (c2 d2 e2 a2 b2 14 8))
(with-ripemd-round (block f 0)
(b2 c2 d2 e2 a2 12 8) (a2 b2 c2 d2 e2 15 5)
(e2 a2 b2 c2 d2 10 12) (d2 e2 a2 b2 c2 4 9)
(c2 d2 e2 a2 b2 1 12) (b2 c2 d2 e2 a2 5 5)
(a2 b2 c2 d2 e2 8 14) (e2 a2 b2 c2 d2 7 6)
(d2 e2 a2 b2 c2 6 8) (c2 d2 e2 a2 b2 2 13)
(b2 c2 d2 e2 a2 13 6) (a2 b2 c2 d2 e2 14 5)
(e2 a2 b2 c2 d2 0 15) (d2 e2 a2 b2 c2 3 13)
(c2 d2 e2 a2 b2 9 11) (b2 c2 d2 e2 a2 11 11))
(setf c1 (mod32+ (ripemd-160-regs-b regs) (mod32+ c1 d2))
(ripemd-160-regs-b regs) (mod32+ (ripemd-160-regs-c regs) (mod32+ d1 e2))
(ripemd-160-regs-c regs) (mod32+ (ripemd-160-regs-d regs) (mod32+ e1 a2))
(ripemd-160-regs-d regs) (mod32+ (ripemd-160-regs-e regs) (mod32+ a1 b2))
(ripemd-160-regs-e regs) (mod32+ (ripemd-160-regs-a regs) (mod32+ b1 c2))
(ripemd-160-regs-a regs) c1)
regs))))
(declaim (inline ripemd-160-regs-digest))
(defun ripemd-160-regs-digest (regs)
"Create the final 16 byte message-digest from the RIPEMD-160 working state
in regs. Returns a (simple-array (unsigned-byte 8) (16))."
(declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
(type ripemd-160-regs regs))
(let ((result (make-array 20 :element-type '(unsigned-byte 8))))
(declare (type (simple-array (unsigned-byte 8) (20)) result))
(macrolet ((frob (reg offset)
(let ((var (gensym)))
`(let ((,var ,reg))
(declare (type (unsigned-byte 32) ,var))
(setf
(aref result ,offset) (first-byte ,var)
(aref result ,(+ offset 1)) (second-byte ,var)
(aref result ,(+ offset 2)) (third-byte ,var)
(aref result ,(+ offset 3)) (fourth-byte ,var))))))
(frob (ripemd-160-regs-a regs) 0)
(frob (ripemd-160-regs-b regs) 4)
(frob (ripemd-160-regs-c regs) 8)
(frob (ripemd-160-regs-d regs) 12)
(frob (ripemd-160-regs-e regs) 16))
result))
(defstruct (ripemd-160-state
(:constructor make-ripemd-160-state ())
(:constructor %make-ripemd-160-state (regs amount block buffer buffer-index finalized-p))
(:copier nil))
(regs (initial-ripemd-160-regs) :type ripemd-160-regs :read-only t)
(amount 0 :type (integer 0 *))
(block (make-array 16 :element-type '(unsigned-byte 32)) :read-only t
:type (simple-array (unsigned-byte 32) (16)))
(buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t
:type (simple-array (unsigned-byte 8) (64)))
(buffer-index 0 :type (integer 0 63))
(finalized-p nil))
(defun copy-ripemd-160-state (state)
(declare (type ripemd-160-state state))
(%make-ripemd-160-state (%copy-ripemd-160-regs (ripemd-160-state-regs state))
(ripemd-160-state-amount state)
(copy-seq (ripemd-160-state-block state))
(copy-seq (ripemd-160-state-buffer state))
(ripemd-160-state-buffer-index state)
(when (ripemd-160-state-finalized-p state)
(copy-seq (ripemd-160-state-finalized-p state)))))
(defun update-ripemd-160-state (state sequence &key (start 0) (end (length sequence)))
"Update the given ripemd-160-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
(declare (type ripemd-160-state state)
(type (simple-array (unsigned-byte 8) (*)) sequence)
(type fixnum start end)
(optimize (speed 3) #+(or cmu sbcl) (safety 0) (space 0) (debug 0))
#+cmu
(ext:optimize-interface (safety 1) (debug 1)))
(let ((regs (ripemd-160-state-regs state))
(block (ripemd-160-state-block state))
(buffer (ripemd-160-state-buffer state))
(buffer-index (ripemd-160-state-buffer-index state))
(length (- end start)))
(declare (type ripemd-160-regs regs) (type fixnum length)
(type (integer 0 63) buffer-index)
(type (simple-array (unsigned-byte 32) (16)) block)
(type (simple-array (unsigned-byte 8) (64)) buffer))
;; Handle old rest
(unless (zerop buffer-index)
(let ((amount (min (- 64 buffer-index) length)))
(declare (type (integer 0 63) amount))
(copy-to-buffer sequence start amount buffer buffer-index)
(setq start (the fixnum (+ start amount)))
(let ((new-index (mod (+ buffer-index amount) 64)))
(when (zerop new-index)
(fill-block-ub8-le block buffer 0)
(update-ripemd-160-block regs block))
(when (>= start end)
(setf (ripemd-160-state-buffer-index state) new-index)
(incf (ripemd-160-state-amount state) length)
(return-from update-ripemd-160-state state)))))
(loop for offset of-type (unsigned-byte 29) from start below end by 64
until (< (- end offset) 64)
do
(fill-block-ub8-le block sequence offset)
(update-ripemd-160-block regs block)
finally
(let ((amount (- end offset)))
(unless (zerop amount)
(copy-to-buffer sequence offset amount buffer 0))
(setf (ripemd-160-state-buffer-index state) amount)))
(incf (ripemd-160-state-amount state) length)
state))
(defun finalize-ripemd-160-state (state)
"If the given ripemd-160-state has not already been finalized, finalize it,
by processing any remaining input in its buffer, with suitable padding
and appended bit-length, as specified by the RIPEMD-160 standard.
The resulting RIPEMD-160 message-digest is returned as an array of twenty
(unsigned-byte 8) values. Calling `update-ripemd-160-state' after a call to
`finalize-ripemd-160-state' results in unspecified behaviour."
(declare (type ripemd-160-state state)
(optimize (speed 3) #+(or cmu sbcl) (safety 0) (space 0) (debug 0))
#+cmu
(ext:optimize-interface (safety 1) (debug 1)))
(or (ripemd-160-state-finalized-p state)
(let ((regs (ripemd-160-state-regs state))
(block (ripemd-160-state-block state))
(buffer (ripemd-160-state-buffer state))
(buffer-index (ripemd-160-state-buffer-index state))
(total-length (* 8 (ripemd-160-state-amount state))))
(declare (type ripemd-160-regs regs)
(type (integer 0 63) buffer-index)
(type (simple-array (unsigned-byte 32) (16)) block)
(type (simple-array (unsigned-byte 8) (*)) buffer))
;; Add mandatory bit 1 padding
(setf (aref buffer buffer-index) #x80)
;; Fill with 0 bit padding
(loop for index of-type (integer 0 64)
from (1+ buffer-index) below 64
do (setf (aref buffer index) #x00))
(fill-block-ub8-le block buffer 0)
;; Flush block first if length wouldn't fit
(when (>= buffer-index 56)
(update-ripemd-160-block regs block)
;; Create new fully 0 padded block
(loop for index of-type (integer 0 16) from 0 below 16
do (setf (aref block index) #x00000000)))
;; Add 64bit message bit length
(setf (aref block 14) (ldb (byte 32 0) total-length))
(setf (aref block 15) (ldb (byte 32 32) total-length))
;; Flush last block
(update-ripemd-160-block regs block)
;; Done, remember digest for later calls
(setf (ripemd-160-state-finalized-p state)
(ripemd-160-regs-digest regs)))))
(defdigest ripemd-160
(:digest-length 20)
(:state-type ripemd-160-state)
(:creation-function make-ripemd-160-state)
(:copy-function copy-ripemd-160-state)
(:update-function update-ripemd-160-state)
(:finalize-function finalize-ripemd-160-state))
|