| ;;;; ripemd-160.lisp -- the RIPEMD-160 digest function (in-package :crypto) (define-digest-registers (ripemd-160 :endian :little) (a #x67452301) (b #xefcdab89) (c #x98badcfe) (d #x10325476) (e #xc3d2e1f0)) (defun update-ripemd-160-block (regs block) (declare (type ripemd-160-regs regs) (type (simple-array (unsigned-byte 32) (16)) block) #.(burn-baby-burn)) (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)))) (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))))) (define-digest-updater ripemd-160 "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." (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 index 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)) (define-digest-finalizer ripemd-160 20 "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." (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 (finalize-registers state 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)) |