[crypticl-cvs] CVS crypticl/src

tskogan tskogan at common-lisp.net
Tue Jan 16 23:43:12 UTC 2007


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

Modified Files:
	sha256.lisp 
Log Message:
Test CLOS api. Put api at the head of the file. Cleanup.


--- /project/crypticl/cvsroot/crypticl/src/sha256.lisp	2007/01/16 00:53:33	1.5
+++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp	2007/01/16 23:43:12	1.6
@@ -4,6 +4,7 @@
 ;;;; Description: The SHA-256 hash algorithm
 ;;;; Author: Taale Skogan
 ;;;; Distribution:  See the accompanying file LICENSE.
+;;;; Initial version: 16.01.2007
 
 
 ;;; Based on reference [1] from http://csrc.nist.gov/cryptval/shs.htm
@@ -17,9 +18,107 @@
 
 (in-package crypticl)
 
-;;; SHA-256 uses a sequence of 64 32-bit word constants. They
-;;; are referred to as K0,...,K63.
-(defvar *sha-256-constants*
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Low-level function API
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun sha-256-on-octet-vector (octet-vector)
+  "Return SHA-256 hash of byte array/octet 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))))
+
+(defun sha-256-on-octet-stream (stream)
+  "Return SHA-256 hash of stream."
+  (sha-256-encode
+   (make-buffer-filler #'(lambda () (read-byte stream nil)))))
+
+(defun sha-256-file (path)
+  "Return SHA-256 hash of a file."
+  (with-open-file (str path)
+    (sha-256-on-octet-stream str)))
+
+
+;;;;;;;;;;;;;
+;;;
+;;; CLOS API
+;;;
+;;;;;;;;;;;;;
+(defun make-SHA-256 ()
+  "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 but the spec
+seems to be that we run algorithm on the initial state and return a full
+256 bits hash even when the message length is 0.
+
+Calling it a second time without adding data returns the previous value.
+"
+  (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))
+
+
+;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Implementation
+;;;
+;;;;;;;;;;;;;;;;;;;
+(defparameter *sha-256-constants*
     (make-array 64
 		:element-type '(unsigned-byte 32)
 		:initial-contents
@@ -38,7 +137,8 @@
 		  #x19a4c116 #x1e376c08 #x2748774c #x34b0bcb5 
 		  #x391c0cb3 #x4ed8aa4a #x5b9cca4f #x682e6ff3 
 		  #x748f82ee #x78a5636f #x84c87814 #x8cc70208 
-		  #x90befffa #xa4506ceb #xbef9a3f7 #xc67178f2)))
+		  #x90befffa #xa4506ceb #xbef9a3f7 #xc67178f2))
+  "SHA-256 uses a sequence of 64 32-bit word constants.")
 
 (defun sha-256-constant (i)
   (aref *sha-256-constants* i))
@@ -114,7 +214,7 @@
 	      g (32-add g gg)
 	      h (32-add h hh))))
     
-    ;; Return hash value.
+    ;; Return hash value as array.
     (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)
@@ -193,36 +293,11 @@
     w))
 
 
-;;;;;;;;;;;;;
-;;;
-;;; 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)
@@ -243,6 +318,7 @@
    (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))
@@ -279,7 +355,6 @@
       (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 
@@ -311,6 +386,7 @@
 	  (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.
@@ -353,79 +429,21 @@
     ;; 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
 ;;;;
 ;;;;;;;;;;;;;;;;;;
-(defun test-sha-256 ()
+(defun run-all-sha-256-tests ()
+  "Run all tests."
   (test-sha-256-short)
-  (test-sha-256-long))
+  (test-sha-256-long)
+  (run-shavs-256))
+
+(defun test-SHA-256 ()
+  "Run these tests at load time."
+  (test-sha-256-short))
 
 (defun test-sha-256-short ()
   "Test vector 1 and 2 are taken from reference FIPS 180-2."
@@ -436,11 +454,11 @@
 	  (list "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
 		"248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1")
 	  )))
-    (format t "Testing SHA-256.~%")
-    (dolist (x test-list (format t "Short messages OK.~%"))
+    (format t "~&Testing SHA-256 short vectors...")
+    (dolist (x test-list (format t "OK."))
       (let ((in (first x))
 	    (ex (second x))
-	    (obj (make-SHA256)))
+	    (obj (make-SHA-256)))
 	;; low-level API
 	(assert (string= (hex (sha-256-on-string in)) ex) ()
 	  "sha-256 test for input string ~A~%" in)
@@ -527,18 +545,57 @@
 (defun shavs-256 (len msg md)
   (when (= len 0)
     (setf msg ""))
-  (assert (string= (hex (sha-256-on-octet-vector (hexo msg)))
-		   md)
-      nil (format nil "Failed on msg ~A" msg)))
+  (let ((bts (hexo msg))		; msg as bytes
+	(obj (make-SHA-256)))
+  
+    ;; Low-level API
+    (assert (string= (hex (sha-256-on-octet-vector bts)) md) ()
+      "sha-256 failed low-level hash on msg '~A'" msg)
+  
+    ;; CLOS API
+    ;; hash all in one
+    (assert (string= (hex (hash obj bts)) md) ()
+      "sha-256 failed all-in-on-hash on msg '~A'" msg)
+    
+    ;;  update with all, then hash
+    (reset obj)
+    (update obj bts)
+    (assert (string= (hex (hash obj)) md) ()
+      "sha-256 failed single-update-hash on msg '~A'" msg)
     
+    ;; update multiple times, then hash
+    (reset obj)
+    (let ((size (length bts)))
+      (do* ((pos 0 (+ pos next))
+	    (next (shavs-next-update-size pos size) 
+		  (shavs-next-update-size pos size))
+	    (end (+ pos next) (+ pos next)))
+	  ((> end size))
+	;;(format t "size ~2 at A pos ~2 at A next ~2 at A end ~2 at A~%" size pos next end)
+	(update obj (subseq bts pos end))))
+    (assert (string= (hex (hash obj)) md) ()
+      "sha-256 failed multiple-updates-hash on msg '~A'" md)
+    ))
 
-(defun run-shavs (&optional (path "../test/SHA256ShortMsg.txt"))
+(defun shavs-next-update-size (pos size)
+  ;; 60 a bit bigger than the msg block size (64 bytes)
+  (let ((next (random 100))
+	(leftover (- size pos))) 
+    (max 1 ; always advance at least once
+	 (if (>= next leftover)
+	     leftover
+	   next))))
+  
+(defun run-shavs-on-string (string)
+  (with-input-from-string (str string)
+    (shavs str)))
+
+(defun run-shavs-256 (&optional (path "../test/SHA256ShortMsg.txt"))
   "Verify SHA-256 against SHAVS test vectors from file.
 
 NB The long test vectors are in the file ../test/SHA256LongMsg.txt"
   (with-open-file (str path)
     (shavs str)))
 
-(defun run-shavs-on-string (string)
-  (with-input-from-string (str string)
-    (shavs str)))
\ No newline at end of file
+
+(register-constructor 'SHA-256 #'make-SHA-256)
\ No newline at end of file




More information about the Crypticl-cvs mailing list