Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv10746

Modified Files: utilities.lisp sha256.lisp Log Message: Initial SHA-256 implementation. Test vectors runs ok. Cleanup and more testing remains.

--- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2004/11/25 21:56:53 1.3 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/07 00:45:33 1.4 @@ -69,6 +69,9 @@ (defun hex (ov) (octet-vector-to-hex-string ov))

+(defun hex-int32 (i) + (hex-prepad-zero (integer-to-octet-vector i) 4)) + (defun octet-vector-to-hex-string (bv) "Returns a hex string representation of a byte vector. Does not ignore leading zeros." (let ((hex-string "")) @@ -76,8 +79,20 @@ (setf hex-string (concatenate 'string hex-string (format nil "~2,'0X" (aref bv i)))))))

+(defun pp-hex (ov) + "Pretty-print byte array in hex with 8 hex digits per block." + (with-output-to-string (str) + (let ((count 0)) + (dolist (x (map 'list (lambda (x) x) ov)) + (when (and (> count 0) (= (mod count 4) 0)) + (write-string " " str)) + (write-string (format nil "~2,'0X" x) str) + (incf count))))) + + +

-(defun hex-prepad-zero (ov size) +(defun hex-prepad-zero (ov size) "Size is minimum length in octets. NB! One octet = 2 hex litterals." (let* ((out (hex ov)) (prefix-length (- size (/ (length out) 2)))) @@ -152,6 +167,11 @@ ((every #'vectorp args) (apply #'concatenate (cons 'vector args))) (t (error "Invalid types ~A" args))))

+(defun make-str (lst) + "Construct a string from a list of string" + (with-output-to-string (str) + (dolist (s lst) + (write-string s str))))

;;;;;;; ;;; String utilities (from CLOCC) --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/06 13:46:37 1.2 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/07 00:45:33 1.3 @@ -12,9 +12,9 @@

(in-package crypticl)

-;;; SHA-256 Constants -;;; SHA-256 uses a sequence of sixty-four constant 32-bit words -(defvar *sha256-constants* +;;; SHA-256 uses a sequence of 64 32-bit word constants. They +;;; are referred to as K0,...,K63. +(defvar *sha-256-constants* (make-array 64 :element-type '(unsigned-byte 32) :initial-contents @@ -35,8 +35,10 @@ #x748f82ee #x78a5636f #x84c87814 #x8cc70208 #x90befffa #xa4506ceb #xbef9a3f7 #xc67178f2)))

+(defun sha-256-constant (i) + (aref *sha-256-constants* i))

-(defmacro initial-sha256-hash-value (a b c d e f g h) +(defmacro initial-sha-256-hash-value (a b c d e f g h) "Initializes the state of the hash algorithm" `(setf ,a #x6a09e667 ,b #xbb67ae85 @@ -51,7 +53,7 @@ ;;; words, which are represented as x, y, and z. The result of each function ;;; is a new 32-bit word. ;;; -;;; Note on notation in the docstrings: +;;; Note on the notation in the docstrings: ;;; not is a bitwise not operation, also referred to as the complement ;;; operation. (defun ch-256 (x y z) @@ -86,19 +88,137 @@ (defun sigma-1 (x) "ROTR 17(x) xor ROTR 19(x) xor SHR 10(x)" (logxor (right-rot-32 x 17) - (right-rot-32 x 17) + (right-rot-32 x 19) (ash x -10)))

-;;;(defun sha256-message-schedule (m) -;;; "Expand input array m with 512 bits = 16 32 bits words to array of 64 -;;;32 bits words" -;;; (let ((w (make-array 64 :element-type '(unsigned-byte 32)))) -;;; (dotimes (i 16 t) -;;; (setf (aref w i) (aref m i) ) ) -;;; (dotimes (i 48 t) -;;; (setf (aref w (+ i 16)) -;;; (left-rot-32 ( (aref w (- i 2)) (aref w (+ i 8)) -;;; (aref w (+ i 2)) (aref w (+ i ))) 1) )) -;;; w)) \ No newline at end of file +(defun sha-256-encode (buffer-filler) + "Main non-CLOS function. Encodes 512 bits blocks until done." + (let ((mb (make-array 16 :element-type '(unsigned-byte 32))) + a b c d e f g h) ; the 8 working variables. + (initial-sha-256-hash-value a b c d e f g h) + + (while (funcall buffer-filler mb) + (multiple-value-bind (aa bb cc dd ee ff gg hh) + (do-sha-256-message-block a b c d e f g h mb) + (setq a (32-add a aa) + b (32-add b bb) + c (32-add c cc) + d (32-add d dd) + e (32-add e ee) + f (32-add f ff) + g (32-add g gg) + h (32-add h hh)))) + + ;; Return hash value. + (sha-256-make-octet-vector a b c d e f g h))) + +(defmacro sha-256-make-octet-vector (a b c d e f g h) + "Make byte-vector from 5 32 bits integers. + +Note that SHA uses the big-endian convention so the least significant byte +of an integer is stored in the rightmost position in the byte array. +This is the opposite of MD5." + (flet ((bytes (num32) + `((ldb (byte 8 24) ,num32) + (ldb (byte 8 16) ,num32) + (ldb (byte 8 8) ,num32) + (ldb (byte 8 0) ,num32)))) + `(let ((a ,a) (b ,b) (c ,c) (d ,d) (e ,e) (f ,f) (g ,g) (h ,h)) + (vector ,@(bytes 'a) + ,@(bytes 'b) + ,@(bytes 'c) + ,@(bytes 'd) + ,@(bytes 'e) + ,@(bytes 'f) + ,@(bytes 'g) + ,@(bytes 'h) + )))) + +(defun do-sha-256-message-block (a b c d e f g h mb) + "Hash one 512 bits sha-256 message block. + +Parameters: +a b c d e f g h - the current state of the hash function +mb - the message block, 512 bits of message, possibly padded, in a byte array +" + (let ((ms (sha-256-message-schedule mb))) + (dotimes (i 64) + (let (T1 T2) + (setf + ;; h + sum-1(e) + ch(e f g) + Kt + Wt + T1 (32-add h + (sum-1 e) + (ch-256 e f g) + (sha-256-constant i) + (aref ms i)) + ;; sum-0(a) + maj(a b c) + T2 (32-add (sum-0 a) (maj-256 a b c)) + h g + g f + f e + e (32-add d T1) + d c + c b + b a + a (32-add T1 T2))) + ;;(pp-sha-256-state i a b c d e f g h) + ) + + (values a b c d e f g h))) + +(defun pp-sha-256-state (iteration &rest r) + "pretty-print the 8 state variables for debugging" + (format t "iter ~D ~A~%" iteration + (make-str (map 'list + (lambda (x) (format nil "~A " (hex-int32 x))) r)))) + +(defun sha-256-message-schedule (mb) + "Return the message schedule." + (let ((w (make-array 64 :element-type '(unsigned-byte 32)))) + (dotimes (i 16) + ;; Wt = Mt + (setf (aref w i) (aref mb i))) + (for (i 16 64) + ;; Wt = sigma-1(Wt-2) + Wt-7 + sigma-0(Wt-15) + Wt-16 + (setf (aref w i) + (32-add (sigma-1 (aref w (- i 2))) + (aref w (- i 7)) + (sigma-0 (aref w (- i 15))) + (aref w (- i 16))))) + w)) + +(defun sha-256-on-string (string) + "Return SHA-256 hash of string" + (sha-256-encode + (make-buffer-filler + (make-string-reader-function string)))) + + +;;;; tests +(defun test-sha-256 () + "Test vector 1 and 2 are taken from reference FIPS 180-2." + (let ((test-list + (list + (list "abc" + "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad") + (list "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1") + ))) + (format t "Testing SHA-256.~%") + (dolist (x test-list (format t "Short messages OK.~%")) + (let ((in (first x)) + (ex (second x))) + (assert (string= (hex (sha-256-on-string in)) ex)() + "sha-256 test for input string ~A~%" in) + ))) + + ;;; Test long message + (format t "Testing long messages. This may take some seconds...~%") + ;; only "a"s, ascii code of a is 97. + (assert (string= (hex (sha-256-on-string + (make-string 1000000 :initial-element #\a))) + "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0") () + "sha-256 test for long test vector 1000000.") + (format t "Long messages OK.~%")) \ No newline at end of file