[crypticl-cvs] CVS crypticl/src
tskogan
tskogan at common-lisp.net
Tue Jan 16 00:53:33 UTC 2007
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
More information about the Crypticl-cvs
mailing list