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