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

Modified Files: sha256.lisp Log Message: Initial version of CLOS api. Needs clean up and more test cases including SHAVS and semantics of border cases.

--- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/07 15:55:17 1.4 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/16 00:53:33 1.5 @@ -191,24 +191,243 @@ (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))))

+ +;;;;;;;;;;;;; +;;; +;;; Low-level function API +;;; +;;;;;;;;;;;;; (defun sha-256-on-octet-vector (octet-vector) "Return SHA-256 hash of byte array/octect vector" (sha-256-encode (make-buffer-filler (make-byte-array-reader-function octet-vector))))

+(defun sha-256-on-string (string) + "Return SHA-256 hash of a string. + +NB! With this function the hash value depends on the encoding of string +and implementation specific details of the Common Lisp distribution you +are using (see make-string-reader-function and its' use of char-code +for more details). For more control, decode the string to a byte array +yourself and use the byte array interface sha-256-on-octet-vector instead. +" + (sha-256-encode + (make-buffer-filler + (make-string-reader-function string)))) + + +;;;;;;;;;;;;; +;;; +;;; CLOS internals +;;; +;;;;;;;;;;;;; +(defclass SHA-256 (Hash) + ((octet-count :accessor octet-count ;octets processed so far + :initform 0) + (leftover-octets :accessor leftover-octets ;unprocessed octets + :initform (make-array 64 :element-type '(unsigned-byte 8))) + (leftover-count :accessor leftover-count ;number of unprocessed octets + :initform 0) + (fresh :accessor fresh :initform t) + ;; True if we have called hash and need to reset the object state. + (called-hash :accessor called-hash :initform nil) + ;; SHA-256 state: 8 32 bits words. + (a :accessor a) + (b :accessor b) + (c :accessor c) + (d :accessor d) + (e :accessor e) + (f :accessor f) + (g :accessor g) + (h :accessor h))) + +(defmethod store-leftover ((obj SHA-256) octet-vector offset end octet-count) + "Store leftover bytes between calls to update" + (let ((leftover-offset (leftover-count obj)) + (octets-left (- end offset))) + + ;; We know there are less than 64 octets left so they all fit + ;; in the leftover-octets array in obj. + (dotimes (i octets-left) + (setf (aref (leftover-octets obj) (+ leftover-offset i)) + (aref octet-vector (+ offset i)))) + + (setf (octet-count obj) octet-count) + (setf (leftover-count obj) (+ leftover-offset octets-left)))) + + +(defmethod sha-256-add-octet-vector ((obj SHA-256) octet-vector start end) + "Compute intermediate hash value, and store leftover bytes. + +Consume a multiple of 512 bits (64 bytes) blocks and compute the +intermediate hash value. Store any leftover bytes while waiting +for more data (cannot pad at this point). +" + (let ((vec (make-array 16 :element-type '(unsigned-byte 32))) + (input-size (- end start)) + (offset start)) + + ;; First consume leftover bytes from previous rounds. + ;; We consume 64 bytes (512 bits; the size of the message schedule) + ;; each round until there is less than left. Store leftovers. + (do ((left (+ (leftover-count obj) input-size) (- left 64)) + (oct-count (octet-count obj) (+ 64 oct-count))) + ((< left 64) (store-leftover obj octet-vector offset end oct-count)) + (setf offset (fill-vector obj vec octet-vector offset)) + (sha-256-encode-block obj vec))))

+ + +(defmethod sha-256-final ((obj SHA-256)) + (let ((vec (make-array 16 :element-type '(unsigned-byte 32))) + (buffer-filler + (make-buffer-filler + (make-byte-array-reader-function + (leftover-octets obj) (leftover-count obj)) + (octet-count obj)))) + + ;; Loops at most two times. + (while (funcall buffer-filler vec) + (sha-256-encode-block obj vec)) + + ;; Return hash. + (sha-256-make-octet-vector (a obj) (b obj) (c obj) (d obj) + (e obj) (f obj) (g obj) (h obj)))) + + +(defmethod sha-256-encode-block ((obj SHA-256) mb) + "Encode a single 512 bits block and add the state to the object." + (multiple-value-bind (aa bb cc dd ee ff gg hh) + (do-sha-256-message-block (a obj) (b obj) (c obj) (d obj) + (e obj) (f obj) (g obj) (h obj) mb) + (setf (a obj) (32-add (a obj) aa) + (b obj) (32-add (b obj) bb) + (c obj) (32-add (c obj) cc) + (d obj) (32-add (d obj) dd) + (e obj) (32-add (e obj) ee) + (f obj) (32-add (f obj) ff) + (g obj) (32-add (g obj) gg) + (h obj) (32-add (h obj) hh)))) + +;;; TODO identical to SHA1 method i sha.lisp so reuse +(defmethod fill-vector ((obj SHA-256) return-vector octet-vector start) + "Return the next 512 bits for hashing. + +Return a 16 * 32 bit vector filled with leftover octets from previous +rounds and octets from the input vector. We know that we have at +least 64 bytes." + (let ((offset 0) ;offset in the tmp vevtor v. + (used 0) ;Num octets used from input vector. + (v (make-array 64 :element-type '(unsigned-byte 8)))) + + ;; Get leftover octets from previous calls to add. + ;; We kown that obj contains < 64 bytes. + (dotimes (i (leftover-count obj)) + (setf (aref v offset) (aref (leftover-octets obj) offset)) + (incf offset)) + + ;; No leftover octets so we reset the leftover count. + (setf (leftover-count obj) 0) + + ;; How many octets do we need from input vector. + (setf used (- 64 offset)) + + ;; Fill the remaining entries. + (dotimes (i used) + (setf (aref v (+ offset i)) (aref octet-vector (+ start i)))) + + ;; Transfer to new format. + (dotimes (word 16) + (let ((b3 (aref v (* word 4))) + (b2 (aref v (+ (* word 4) 1))) + (b1 (aref v (+ (* word 4) 2))) + (b0 (aref v (+ (* word 4) 3)))) + (setf (aref return-vector word) + (dpb b3(byte 8 24) + (dpb b2 (byte 8 16) + (dpb b1 (byte 8 8) + b0)))))) + + ;; Return offset in input vector. + (+ start used))) + +;;;;;;;;;;;;; +;;; +;;; CLOS API +;;; +;;;;;;;;;;;;; +(defun make-SHA256 () + "Constructor for the SHA-256 class" + (let ((obj (make-instance 'SHA-256 :algorithm "SHA-256"))) + (reset obj) + obj)) + +(defmethod reset ((obj SHA-256)) + (initial-sha-256-hash-value (a obj) (b obj) (c obj) (d obj) + (e obj) (f obj) (g obj) (h obj)) + (setf (octet-count obj) 0 + (leftover-count obj) 0 + (called-hash obj) nil + (fresh obj) t)) + +(defmethod hash ((obj SHA-256) &optional data (start 0) (end (length data))) + "Return SHA-256 hash of all bytes added so far. + +Note that calling hash on an empty object object makes no sense and we +return nil. + +XXX Calling it a second time without adding data? The same value as the first +time? +" + (when (and (fresh obj) (not data)) + ;; Returning a hash value on no data makes no sense. + (return-from hash nil)) + (when (and (not data) (called-hash obj)) + ;; Return previous hash value when we have one and no data has been + ;; added since last call to hash. + (return-from hash (sha-256-make-octet-vector (a obj) (b obj) (c obj) (d obj) + (e obj) (f obj) (g obj) (h obj)))) + (when data + (typecase data + (vector (sha-256-add-octet-vector obj data start end)) + (otherwise + (error "Hash on data type ~A not implemented." (type-of data))))) + + (setf (called-hash obj) t) + (sha-256-final obj)) + + +(defmethod update ((obj SHA-256) (octet-vector vector) + &optional (start 0) (end (length octet-vector))) + "Add bytes to SHA-256 hash object. + +Will compute the intermediate hash value and not store the input. Useful +for hashing a large file that doesn't fit in memory or a data stream. + +When all bytes have been added you get the hash value by calling the +hash method." + ;; Reset object if we have called hash + (when (called-hash obj) + (reset obj)) + + (sha-256-add-octet-vector obj octet-vector start end) + (setf (fresh obj) nil)) + + +(register-constructor 'SHA256 #'make-SHA256) + +;;;;;;;;;;;;;;;;;; ;;;; -;;;; tests +;;;; Tests ;;;; +;;;;;;;;;;;;;;;;;; (defun test-sha-256 () + (test-sha-256-short) + (test-sha-256-long)) + +(defun test-sha-256-short () "Test vector 1 and 2 are taken from reference FIPS 180-2." (let ((test-list (list @@ -220,12 +439,28 @@ (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)() + (ex (second x)) + (obj (make-SHA256))) + ;; low-level API + (assert (string= (hex (sha-256-on-string in)) ex) () "sha-256 test for input string ~A~%" in) - ))) + + ;; CLOS API + ;; Test hash only. + (reset obj) + (assert (string= (hex (hash obj (string-to-octets in))) ex) () + "sha-256 CLOS test for input string ~A~%" in) + + ;; Test update and hash. + (reset obj) + (update obj (string-to-octets in)) + (assert (string= (hex (hash obj)) ex) () + "sha-256 CLOS update+hash test for input string ~A~%" in) + ))))

- ;;; Test long message + +(defun test-sha-256-long () + "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