January 2007 - crypticl-cvs@common-lisp.net

[crypticl-cvs] CVS crypticl/src
by tskogan 27 Jan '07

27 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv24062/src Modified Files: random.lisp load.lisp keygenerator.lisp aes.lisp Log Message: Get rid of load time warnings by reordering some code. Becuase the random number generator uses aes, aes must come before random, but aes depends on the keygenerator for producing keys which again depends on random; a circle dependency. Solve this a bit hackish by moving some aes code related to keys into keygenerator. --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/27 11:28:30 1.9 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/27 17:07:17 1.10 @@ -122,7 +122,7 @@ The input should be high entropy bits, ideally 256 bits of entropy or more, given as a bignum or a byte array." (unless *random-secure-state* - (setf *random-secure-state* (make-SecurePRNG))) + (setf *random-secure-state* (make-SecurePRNG-AES))) (typecase new-seed (integer (reseed *random-secure-state* (integer-to-octet-vector new-seed))) --- /project/crypticl/cvsroot/crypticl/src/load.lisp 2007/01/18 21:37:02 1.8 +++ /project/crypticl/cvsroot/crypticl/src/load.lisp 2007/01/27 17:07:17 1.9 @@ -21,11 +21,13 @@ "utilities" "numtheory" "common" - "sha" ;used by random - "random" - "keygenerator" - "md5" "aes" "idea" "dsa" "rsa" "diffie-hellman" - "sha256" + "sha" + "sha256" + "aes" + "random" + "keygenerator" + "md5" "idea" "dsa" "rsa" "diffie-hellman" + "keystore" "test"))) (format t "Loading the Crypticl library...") --- /project/crypticl/cvsroot/crypticl/src/keygenerator.lisp 2007/01/17 22:00:52 1.7 +++ /project/crypticl/cvsroot/crypticl/src/keygenerator.lisp 2007/01/27 17:07:17 1.8 @@ -124,4 +124,9 @@ +(defun aes-generate-key (&optional (bitsize 128) encoding) + (declare (ignore encoding)) + (assert (member bitsize '(128 192 256)) () "AES invalid key size ~A" bitsize) + (generate-symmetric-key bitsize "AES")) +(register-key-generator 'AES #'aes-generate-key) \ No newline at end of file --- /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/23 23:55:39 1.9 +++ /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/27 17:07:17 1.10 @@ -658,12 +658,6 @@ (defmethod decrypt ((obj AES) &optional data (start 0) (end (length data))) (update-and-decrypt obj data start end)) - -(defun aes-generate-key (&optional (bitsize 128) encoding) - (declare (ignore encoding)) - (assert (member bitsize '(128 192 256)) () "AES invalid key size ~A" bitsize) - (generate-symmetric-key bitsize "AES")) - ;;;;;;; ;;; Test suite @@ -749,7 +743,7 @@ "Testing long vector." (let ((aa (make-AES)) (tmp nil) - (key (generate-key 'AES 128)) + (key #16(2)) ;(generate-key 'AES 128)) Use a fixed key (iv #16(2)) (clear #500(3))) (format t "~&AES long vector...") @@ -797,9 +791,3 @@ (register-constructor 'AES #'make-AES) -(register-key-generator 'AES #'aes-generate-key) - - - - -

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 27 Jan '07

27 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv24062/doc Modified Files: TODO Log Message: Get rid of load time warnings by reordering some code. Becuase the random number generator uses aes, aes must come before random, but aes depends on the keygenerator for producing keys which again depends on random; a circle dependency. Solve this a bit hackish by moving some aes code related to keys into keygenerator. --- /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/24 21:45:12 1.6 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/27 17:07:17 1.7 @@ -3,10 +3,6 @@ -bug in AES key expansion for 256-bit keys, maybe others. More test cases needed. --Get high entropy seed for PRNG on Windows (native API CryptGenRandom, -Advapi32.dll, Wincrypt.h,) --Replace use of SHA-1 in PRNG with a block cipher (AES) in counter mode. --Study the Fortuna PRNG. -more example applications to test and improve the api -SHA-512? -Document how to run the full test set (when porting to new platform).

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 27 Jan '07

27 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv32149 Modified Files: random.lisp Log Message: Failed attempt to get access to CryptGenRandom on Windows. Unable to get Allegro's ffi binding to do what I want. --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/24 21:45:12 1.8 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/27 11:28:30 1.9 @@ -148,7 +148,181 @@ ;;;; TESTING -(defun foo () - (setf *random-secure-state* nil) - (random-secure-bignum 128)) - \ No newline at end of file + +;;;; Failed attempt to get access to CryptGenRandom on Windows. +;;;; Unable to get Allegro's ffi binding to do what I want. +;;;(defun win32-random () ;(size) +;;; " +;;;Some material on CryptGenRandom and the win32 api in general: +;;; +;;;win32 typedefs: +;;; +;;;typedef unsigned char BYTE +;;;typedef unsigned long DWORD +;;; +;;;LPCTSTR Long Pointer to a Constant null-Terminated String (C programming/Windows API) +;;;typedef const CHAR *PCSTR, *LPCSTR; +;;; +;;;Python Cryptography Toolkit, file src/winrandom.c +;;;A successful use of CryptGenRandom. +;;; +;;;wincrypt.h +;;;typedef unsigned long HCRYPTPROV; +;;; +;;;From msdn library: +;;;http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seccrypto/security/cryptgenrandom.asp +;;; +;;;http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seccrypto/security/cryptgenrandom.asp +;;; +;;;BOOL WINAPI CryptGenRandom( +;;; HCRYPTPROV hProv, +;;; DWORD dwLen, +;;; BYTE* pbBuffer); +;;; +;;;BOOL WINAPI CryptAcquireContext( +;;; HCRYPTPROV* phProv, +;;; LPCTSTR pszContainer, +;;; LPCTSTR pszProvider, +;;; DWORD dwProvType, +;;; DWORD dwFlags); +;;; +;;;if(CryptAcquireContext( +;;; &hCryptProv, // handle to the CSP +;;; UserName, // container name +;;; NULL, // use the default provider +;;; PROV_RSA_FULL, // provider type +;;; 0)) // flag values +;;;{... +;;; +;;;Example C code: +;;; +;;;#include <windows.h> +;;;#include <wincrypt.h> +;;; +;;;static HCRYPTPROV hProvider; +;;; +;;;void spc_rand_init(void) { +;;; if (!CryptAcquireContext(&hProvider, 0, 0, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) +;;; ExitProcess((UINT)-1); /* Feel free to properly signal an error instead. */ +;;;} +;;; +;;;unsigned char *spc_rand(unsigned char *pbBuffer, size_t cbBuffer) { +;;; if (!hProvider) spc_rand_init( ); +;;; if (!CryptGenRandom(hProvider, cbBuffer, pbBuffer)) +;;; ExitProcess((UINT)-1); /* Feel free to properly signal an error instead. */ +;;; return pbBuffer; +;;;} +;;; +;;; +;;;Another example (from http://erngui.com/articles/rng/index.html): +;;; +;;;#define _WIN32_WINNT 0x0400 +;;;#include <windows.h> +;;;#include <wincrypt.h> +;;; +;;;long getrand() +;;;{ +;;; HCRYPTPROV hProv = 0; +;;; CryptAcquireContext(&hProv, +;;; 0, 0, PROV_RSA_FULL, +;;; CRYPT_VERIFYCONTEXT); +;;; long rnd; +;;; CryptGenRandom(hProv, +;;; sizeof(rnd), (BYTE*)&rnd); +;;; CryptReleaseContext(hProv, 0); +;;; return rnd; +;;;} +;;; +;;; +;;;/* Provider Types */ +;;;1530 #define PROV_RSA_FULL 1 +;;;1531 #define PROV_RSA_SIG 2 +;;;1532 #define PROV_DSS 3 +;;;1533 #define PROV_FORTEZZA 4 +;;;1534 #define PROV_MS_EXCHANGE 5 +;;;1535 #define PROV_SSL 6 +;;;1536 #define PROV_RSA_SCHANNEL 12 +;;;1537 #define PROV_DSS_DH 13 +;;;1538 #define PROV_EC_ECDSA_SIG 14 +;;;1539 #define PROV_EC_ECNRA_SIG 15 +;;;1540 #define PROV_EC_ECDSA_FULL 16 +;;;1541 #define PROV_EC_ECNRA_FULL 17 +;;;1542 #define PROV_DH_SCHANNEL 18 +;;;1543 #define PROV_SPYRUS_LYNKS 20 +;;;1544 #define PROV_RNG 21 +;;;1545 #define PROV_INTEL_SEC 22 +;;;1546 #define PROV_REPLACE_OWF 23 +;;;1547 #define PROV_RSA_AES 24 +;;; +;;; +;;;common error codes: +;;; +;;;ERROR_INVALID_PARAMETER ( 0x57/87L ) +;;;One of the parameters contains a value that is not valid. This is most +;;;often a pointer that is not valid. +;;; +;;;NTE_KEYSET_NOT_DEF( 0x80090019L ) +;;;The key container specified by pszContainer does not exist, or the +;;;requested provider does not exist. +;;;" +;;; (load "Kernel32.dll") ; for GetLastError +;;; (load "Advapi32.dll") +;;; ;; Check that we have the foreign functions we need +;;; (load "" :unreferenced-lib-names +;;; (list "CryptGenRandom" "CryptAcquireContextW" +;;; "CryptAcquireContextA" "GetLastError")) +;;; +;;; ;; BOOL WINAPI CryptAcquireContext( +;;; ;; HCRYPTPROV* phProv, +;;; ;; LPCTSTR pszContainer, // const CHAR *LPCTSTR ??? No? +;;; ;; LPCTSTR pszProvider, +;;; ;; DWORD dwProvType, +;;; ;; DWORD dwFlags); +;;; ;; +;;; ;; CryptAcquireContextW also seems to work. +;;; (ff:def-foreign-call (CryptAcquireContext "CryptAcquireContextA") +;;; ((phProv (* :unsigned-long) (:unsigned-long)) +;;; (pszContainer (* :char)) +;;; (pszProvider (* :char)) +;;; (dwProvType :unsigned-long fixnum) +;;; (dwFlags :unsigned-long fixnum)) +;;; :error-value :os-specific +;;; :returning (:int boolean)) +;;; +;;; (ff:def-foreign-call (GetLastError "GetLastError") (:void) +;;; :returning (:unsigned-long bignum)) +;;; +;;; (flet ((err (where) +;;; (format t "Error in ~A: 0x~,2'0X~%" where (GetLastError)))) +;;; +;;; (let ((phProv (ff:allocate-fobject :unsigned-long :foreign-static-gc))) +;;; (unless (CryptAcquireContext +;;; phProv ;phProv +;;; 0 ;pszContainer +;;; 0 ;pszProvider +;;; 1 ;dwProvType 1 = PROV_RSA_FULL +;;; 0) ;dwFlags) +;;; (err "CryptAcquireContext")) +;;; +;;; ;; BOOL WINAPI CryptGenRandom( +;;; ;; HCRYPTPROV hProv, //typedef unsigned long HCRYPTPROV; +;;; ;; DWORD dwLen, +;;; ;; BYTE* pbBuffer); //typedef unsigned char BYTE +;;; (ff:def-foreign-call (CryptGenRandom "CryptGenRandom") +;;; ((a :unsigned-long (:unsigned-long)) +;;; (b :unsigned-long) +;;; (c (* :unsigned-char))) +;;; :returning (:int boolean)) +;;; +;;; (let*((c (make-array 16 :element-type '(unsigned-byte 8) +;;; :initial-element 2)) +;;; (before (hex c)) +;;; after) +;;; ;; XXX This call always fail and error code is 87/0x57 +;;; ;; which supposedly is a bad pointer of some sort. +;;; (unless (CryptGenRandom phProv 8 c) +;;; (err "CryptGenRandom")) +;;; (setf after (hex c)) +;;; (if (string= before after) +;;; (format t "failure, no random bytes returned") +;;; (format t "SUCCESS!! Got random bytes: ~A~%" after))))))

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 24 Jan '07

24 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv5500/doc Modified Files: USERGUIDE TODO ChangeLog Log Message: Replaced secure PRNG based on SHA-1 with 128 bits AES in counter mode. Should be 256 bits, but seems to be a bug in AES key expansion. --- /project/crypticl/cvsroot/crypticl/doc/USERGUIDE 2007/01/20 15:35:00 1.4 +++ /project/crypticl/cvsroot/crypticl/doc/USERGUIDE 2007/01/24 21:45:12 1.5 @@ -68,12 +68,13 @@ "a9993e364706816aba3e25717850c26c9cd0d89d" Implementation note: -There is a semantic difference between calling hash on a -hash object with no data and calling hash on an empty byte vector. Calling -hash on an empty object is more likely to be a user error and hence returns -nil. Calling hash on an empty byte vector on the other hand, may simply mean -that we got very short input and hence returns the initial state of the SHA-1 -algorithm (which is a valid 160 bits byte vector). + +There is a semantic difference between calling hash on a hash object with no +data and calling hash on an empty byte vector. Calling hash on an empty object +is more likely to be a user error and hence returns nil. Calling hash on an +empty byte vector on the other hand, may simply mean that we got very short +input and hence returns the initial state of the SHA-1 algorithm (which is a +valid 160 bits byte vector). The object oriented interface introduced above is built on top of low level function primitives for each algorithm. Sometimes it's easier to work directly --- /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/21 01:15:22 1.5 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/24 21:45:12 1.6 @@ -1,11 +1,14 @@ TODO list for Crypticl ====================== --Get high entropy seed for PRNG on Windows +-bug in AES key expansion for 256-bit keys, maybe others. More test +cases needed. +-Get high entropy seed for PRNG on Windows (native API CryptGenRandom, +Advapi32.dll, Wincrypt.h,) -Replace use of SHA-1 in PRNG with a block cipher (AES) in counter mode. -Study the Fortuna PRNG. -more example applications to test and improve the api -SHA-512? --Document how to run the full test set. - +-Document how to run the full test set (when porting to new platform). +-only use hex and hexo, not the long versions. --- /project/crypticl/cvsroot/crypticl/doc/ChangeLog 2007/01/17 22:00:57 1.15 +++ /project/crypticl/cvsroot/crypticl/doc/ChangeLog 2007/01/24 21:45:12 1.16 @@ -1,3 +1,8 @@ +24-01-2007 Taale Skogan + Replaced secure PRNG based on SHA-1 with 128 bits AES in counter + mode. Should be 256 bits, but seems to be a bug in AES key + expansion. + 17-01-2007 Taale Skogan Removed email addresses (spam).

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 24 Jan '07

24 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv5500/src Modified Files: random.lisp diffie-hellman.lisp Log Message: Replaced secure PRNG based on SHA-1 with 128 bits AES in counter mode. Should be 256 bits, but seems to be a bug in AES key expansion. --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/23 23:55:39 1.7 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/24 21:45:12 1.8 @@ -5,125 +5,14 @@ ;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. -;;To do: -;;-get high entropy bits on non-Linux system. Either roll your own (most likely bad idea) or use win32API to handle one other system. But this is not important. win32 API CryptGenRandom. - (in-package crypticl) +;;;; +;;;; INTERNALS +;;;; -(defun random-secure-bignum (bitsize) - "Return random integer bitsize bits long generatated from a cryptograpically secure pseudo random number generator. The function is very slow because random-secure invokes SHA-1 multiple times. It should only be used for cryptographic keys and the like. - -Note that according to Menezes et al (1997), there exists no formal proof that this add-hoc solution using SHA-1 is cryptographically secure. But it is nevertheless approved for use in standards like the Digital Signature Standard (NIST 2000). -" - (random-bignum-internal bitsize #'random-secure)) - - -(defun random-bignum-internal (bitsize rand-function) - "Internal version of random-bignum. rand-function is a random number generator which takes one integer argument r and returns an integer in the range [0,r-1]." - (assert (> bitsize 0)) - (let* ((size (ceiling bitsize 8)) - (octet-array (make-array size - :element-type '(unsigned-byte 8))) - n) - (do ((i 0 (1+ i))) - ((>= i size)) - (setf (aref octet-array i) (funcall rand-function 256))) - - ;;Remove extra bits if necessary. This is done by setting the - ;;unnecessary 8 - (bitsize mod 8) most significant bits to zero. - (setf n (octet-vector-to-integer octet-array)) - (if (= 0 (mod bitsize 8)) - n - (dpb 0 (byte (- 8 (mod bitsize 8)) bitsize) n)))) - - -(defun random-bignum-max-odd (bitsize) - "Return random, bitsize bits long, odd integer. In other words, the least and most significant bit is always 1." - (let ((n (random-secure-bignum bitsize))) - (setf n (dpb 1 (byte 1 (1- bitsize)) n) - n (dpb 1 (byte 1 0) n)))) - - - -;;;;;;;; CRYPTOGRAPHICALLY SECURE RANDOM NUMBER GENERATOR - -(defparameter *random-secure-obj* nil - "State for the random number generator") - -(defun random-secure-range (low high) - "Return random integer in the range [low,high]. This should only be used for values of low close to 0." - (while t - (let ((n (random-secure (+ high 1)))) - (when (>= n low) - (return-from random-secure-range n))))) - - -(defun random-secure (n) - "Return random integer in the range [0,n-1]." - (if (not *random-secure-obj*) - (setf *random-secure-obj* (make-SecurePRNG))) - (SecurePRNG-random *random-secure-obj* n)) - -(defun random-secure-octets (size) - "Returns size pseudorandom octets from a cryptographically secure PRNG." - (if (not *random-secure-obj*) - (setf *random-secure-obj* (make-SecurePRNG))) - (SecurePRNG-octets *random-secure-obj* size)) - -(defclass SecurePRNG () - ((seed :accessor seed - :initarg :seed)) - (:documentation "Cryptographically secure pseudo random number generator.")) - -(defun set-seed (seed) - "Creates a new seed for the secure PRNG. Input should be a high entropy bignum at least 160 bits long." - (if (not *random-secure-obj*) - (setf *random-secure-obj* (make-SecurePRNG))) - (setf (seed *random-secure-obj*) seed)) - -(defun make-SecurePRNG () - "Constructor for the Secure-PRNG class. Assumes that a 160 bits secret/seed is enough." - (make-instance 'SecurePRNG - :seed (random-secure-seed 160))) - - -(defmethod SecurePRNG-random ((obj SecurePRNG) n) - "Return random number in the range [0,n-1] where n <= 2^160. Is terrible inefficient for small n because we waste most of the 160 bits SHA-1 returns." - (assert (<= (integer-length n) 160)) - (let* ((seed (seed obj)) - (state (octet-vector-to-integer - (sha-1-on-octet-vector (integer-to-octet-vector seed))))) - - ;;update seed to get forward security - (setf (seed obj) (mod (+ 1 seed state) - (expt 2 160))) - - ;;reduce n to proper size - (mod state n))) - - -(defmethod SecurePRNG-octets ((obj SecurePRNG) size) - "Returns size pseudorandom octets from a cryptographically secure PRNG." - (let ((rounds (ceiling size 20)) ;20 octets in 160 bits - (ret (make-array size :element-type '(unsigned-byte 8))) - (current-size 0) ;num octets processed so far - (hash nil)) - - (dotimes (i rounds) - (setf hash (sha-1-on-octet-vector (integer-to-octet-vector (seed obj)))) - (do ((j 0 (1+ j))) - ((or (>= current-size size) (>= j 20))) - - (setf (aref ret current-size) (aref hash j)) - (incf current-size)) - - ;;update seed to get forward security - (setf (seed obj) (mod (+ 1 (seed obj) (octet-vector-to-integer hash)) - (expt 2 160)))) - ret)) - - +(defparameter *random-secure-state* nil + "State for the secure random number generator") (defun high-entropy-octets (size) "Return size octets from some hopefully high entropy bit source." @@ -132,66 +21,38 @@ :if-does-not-exist nil) (if (not file) (progn - (warn "/dev/random was not available on this system.") - (warn "Add 160 bits high entropy seed maually using set-seed.") - (warn "Will use random in the mean time.") + (warn "Unable to get high entropy bits for seeding the secure") + (warn "random number generator. Seed with at least 256 high") + (warn "entropy bits by calling reseed-secure-prng. Will continue") + (warn "in NON-SECURE mode in the mean time.") (do ((i 0 (1+ i))) ((>= i size)) - (setf (aref ret i) (random 256)))) + (setf (aref ret i) (random 256)))) - (progn - (do ((i 0 (1+ i))) - ((>= i size)) - ;;Fails if /dev/random runs out of bytes, but that - ;;should never happen. - (setf (aref ret i) (read-byte file nil))))) - ret))) - - - -(defun random-secure-seed (bitsize) - "Returns bitsize integer with full entrophy (enthropy equals bitsize). Only works on Linux-like systems where /dev/random is a source of high enthropy bits." - (let* ((size (ceiling bitsize 8)) - (octet-array (high-entropy-octets size)) - n) ;Return value + (do ((i 0 (1+ i))) + ((>= i size)) + (setf (aref ret i) (read-byte file nil))))) - ;;Remove extra bits if necessary. This is done by setting the - ;;unnecessary 8 - (bitsize mod 8) most significant bits to zero. - (setf n (octet-vector-to-integer octet-array)) - (if (= 0 (mod bitsize 8)) - n - (dpb 0 (byte (- 8 (mod bitsize 8)) bitsize) n)))) - - - -;;;; -;;;; AES version -;;;; -;;;; Based on Fortuna from Practical Cryptography. -;;;; -(defparameter *random-secure-obj-aes* nil - "State for the random number generator") + ret)) -(defun random-secure-octets-aes (size) - "Returns size pseudorandom octets from a cryptographically secure PRNG." - (unless *random-secure-obj-aes* - (setf *random-secure-obj-aes* (make-SecurePRNG-AES))) - - (SecurePRNG-octets-aes *random-secure-obj-aes* size)) +;;; +;;; AES related code +;;; +;;; Based on Fortuna from Practical Cryptography. +;;; (defclass SecurePRNG-AES () ((key :accessor key - :initform #16(0)) + :initform #16(0)) ; TODO use 32 bytes (256 bits) (ctr :accessor ctr - :initform #16(0))) + :initform #16(0))) ; TODO use 32 bytes (256 bits) (:documentation "Cryptographically secure pseudo random number generator.")) (defun make-SecurePRNG-AES () "Constructor for the Secure-PRNG class. Assumes that X bits secret/seed is enough." (let ((obj (make-instance 'SecurePRNG-AES))) - (format t "ctr after init = ~A~%" (hex (ctr obj))) (reseed obj (high-entropy-octets 16)))) (defmethod reseed ((obj SecurePRNG-AES) new-seed) @@ -203,54 +64,91 @@ (setf (key obj) (subseq (hash hasher new-seed) 0 keysize)) ;; We run in counter mode so update counter (inc-counter obj) - (format t "ctr in reseed = ~A~%" (hex (ctr obj))) obj)) (defmethod inc-counter ((obj SecurePRNG-AES)) (int-as-octet-vector-add (ctr obj) 1)) -(defun set-seed-aes (new-seed) +(defmethod SecurePRNG-octets-aes ((obj SecurePRNG-AES) size) + "Returns size pseudorandom octets from a cryptographically secure PRNG." + (let* ((res (make-array size + :element-type '(unsigned-byte 8) + :initial-element 0)) + (ctr-size (length (ctr obj))) + (tmp (make-array ctr-size + :element-type '(unsigned-byte 8) + :initial-element 0))) + (do* ((offset 0 (+ offset next)) + (leftover size (- leftover next)) + (next (min ctr-size leftover) (min ctr-size leftover))) + ((<= leftover 0)) + ;; the cipher overwrites the input buffer so we cannot use + ;; (ctr obj) directly. + (octet-vector-copy (ctr obj) 0 ctr-size tmp 0) + (aes-crypt-octet-vector tmp (key obj) 'ctr-onetime nil) + (octet-vector-copy tmp 0 next res offset) + (inc-counter obj)) + + res)) + + +;;;; +;;;; API +;;;; + +(defun random-secure-octets (size) + "Return size octets from a cryptographically secure PRNG." + (unless *random-secure-state* + (setf *random-secure-state* (make-SecurePRNG-AES))) + (SecurePRNG-octets-aes *random-secure-state* size)) + + +(defun random-secure-bignum (bitsize) + "Return bignum from a cryptographically secure PRNG." + (let* ((size (ceiling bitsize 8)) + (keep (mod bitsize 8)) + (ov (random-secure-octets size))) + ;; Remove extra bits if bitsize not a multiple of 8. + ;; This is done by only keeping the least (bitsize mod 8) significant + ;; bits in the most significant byte. + (unless (= keep 0) + (setf (aref ov 0) (mask-field (byte keep 0) (aref ov 0)))) + (octet-vector-to-integer ov))) + + +(defun reseed-secure-prng (new-seed) "Reseed the global secure PRNG. The input should be high entropy bits, ideally 256 bits of entropy or more, given as a bignum or a byte array." - (unless *random-secure-obj-aes* - (setf *random-secure-obj-aes* (make-SecurePRNG))) + (unless *random-secure-state* + (setf *random-secure-state* (make-SecurePRNG))) (typecase new-seed - (integer (reseed *random-secure-obj-aes* + (integer (reseed *random-secure-state* (integer-to-octet-vector new-seed))) - (vector (reseed *random-secure-obj-aes* new-seed)))) + (vector (reseed *random-secure-state* new-seed)))) -(defmethod SecurePRNG-octets-aes ((obj SecurePRNG-AES) size) - "Returns size pseudorandom octets from a cryptographically secure PRNG." - (let ((res (make-array size - :element-type '(unsigned-byte 8) - :initial-element 0)) - (tmp (make-array (length (ctr obj)) - :element-type '(unsigned-byte 8) - :initial-element 0)) - (ctr-size (length (ctr obj)))) - - (do* ((offset 0 (+ offset next)) - (leftover size (- leftover next)) - (next (min ctr-size leftover) (min ctr-size leftover))) - ((<= leftover 0)) - ;; the cipher overwrites the input buffer so we cannot use - ;; (ctr obj) directly. - (octet-vector-copy (ctr obj) 0 ctr-size tmp 0) - (aes-crypt-octet-vector tmp (key obj) 'ctr-onetime nil) - (octet-vector-copy tmp 0 next res offset) - (inc-counter obj)) - - res)) + +(defun random-bignum-max-odd (bitsize) + "Return random, bitsize bits long, odd integer. + +In other words, the least and most significant bit is always 1. +Used by RSA and DSA." + (let ((n (random-secure-bignum bitsize))) + (setf n (dpb 1 (byte 1 (1- bitsize)) n) + n (dpb 1 (byte 1 0) n)))) + + +(defun random-secure-bignum-range (low high) + "Return bignum in the range [low,high] from secure PRNG." + ;; Be lazy and retry a few times + (let ((bitsize (integer-length high))) + (do ((n (- low 1)(random-secure-bignum bitsize))) + ((and (<= n high) (>= n low)) n)))) +;;;; TESTING (defun foo () - (setf *random-secure-obj-aes* (make-SecurePRNG-AES)) - (format t "ctr before = ~A~%" (hex (ctr *random-secure-obj-aes*))) - (format t "bytes = ~A~%"(hex (random-secure-octets-aes 16))) - (format t "ctr = ~A~%" (hex (ctr *random-secure-obj-aes*)))) - -(defun bar (&optional (size 16)) - (format t "bytes = ~A~%"(hex (random-secure-octets-aes size))) - (format t "ctr = ~A~%" (hex (ctr *random-secure-obj-aes*)))) + (setf *random-secure-state* nil) + (random-secure-bignum 128)) + \ No newline at end of file --- /project/crypticl/cvsroot/crypticl/src/diffie-hellman.lisp 2007/01/17 22:00:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/diffie-hellman.lisp 2007/01/24 21:45:12 1.7 @@ -25,7 +25,7 @@ (defmethod generate-random-Diffie-Hellman ((obj Diffie-Hellman)) (let* ((g (g (key obj))) (p (p (key obj))) - (x (random-secure-range 1 (- p 2)))) + (x (random-secure-bignum-range 1 (- p 2)))) (setf (x (key obj)) x) (mod-expt g x p)))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 23 Jan '07

23 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv1593 Modified Files: utilities.lisp random.lisp aes.lisp Log Message: Backup of initial version of secure random generator with aes in counter mode. --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/22 22:45:32 1.9 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/23 23:55:39 1.10 @@ -73,14 +73,9 @@ (defun int-as-octet-vector-add (ov n) - "Add n to octet vector ov." + "Add n to octet vector ov and keep size of octet vector." (integer-to-octet-vector (+ (octet-vector-to-integer ov) n) :vector ov)) -(defun foo (data ctr) - (aes-crypt-octet-vector data #16(0) 'ctr nil ctr) - (int-as-octet-vector-add ctr 1) - (hex data)) - (defun hex (ov) (octet-vector-to-hex-string ov)) @@ -171,8 +166,7 @@ (unless out (setf out (make-array size :element-type '(unsigned-byte 8)))) (dotimes (i size out) - (setf (aref out (+ out-start i)) (aref in (+ start i)))))) - + (setf (aref out (+ out-start i)) (aref in (+ start i)))))) (defun concat (&rest args) "Concatenates strings and vectors. --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/23 21:20:36 1.6 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/23 23:55:39 1.7 @@ -161,3 +161,96 @@ (if (= 0 (mod bitsize 8)) n (dpb 0 (byte (- 8 (mod bitsize 8)) bitsize) n)))) + + + +;;;; +;;;; AES version +;;;; +;;;; Based on Fortuna from Practical Cryptography. +;;;; +(defparameter *random-secure-obj-aes* nil + "State for the random number generator") + +(defun random-secure-octets-aes (size) + "Returns size pseudorandom octets from a cryptographically secure PRNG." + (unless *random-secure-obj-aes* + (setf *random-secure-obj-aes* (make-SecurePRNG-AES))) + + (SecurePRNG-octets-aes *random-secure-obj-aes* size)) + +(defclass SecurePRNG-AES () + ((key + :accessor key + :initform #16(0)) + (ctr + :accessor ctr + :initform #16(0))) + (:documentation "Cryptographically secure pseudo random number generator.")) + +(defun make-SecurePRNG-AES () + "Constructor for the Secure-PRNG class. Assumes that X bits secret/seed is enough." + (let ((obj (make-instance 'SecurePRNG-AES))) + (format t "ctr after init = ~A~%" (hex (ctr obj))) + (reseed obj (high-entropy-octets 16)))) + +(defmethod reseed ((obj SecurePRNG-AES) new-seed) + "Reseed with byte array of high entropy bits." + (let ((hasher (make-SHA-256)) + (keysize (length (key obj)))) + ;; Concatenate old key with new seed and hash + (update hasher (key obj)) + (setf (key obj) (subseq (hash hasher new-seed) 0 keysize)) + ;; We run in counter mode so update counter + (inc-counter obj) + (format t "ctr in reseed = ~A~%" (hex (ctr obj))) + obj)) + +(defmethod inc-counter ((obj SecurePRNG-AES)) + (int-as-octet-vector-add (ctr obj) 1)) + +(defun set-seed-aes (new-seed) + "Reseed the global secure PRNG. + +The input should be high entropy bits, ideally 256 bits of entropy or more, +given as a bignum or a byte array." + (unless *random-secure-obj-aes* + (setf *random-secure-obj-aes* (make-SecurePRNG))) + (typecase new-seed + (integer (reseed *random-secure-obj-aes* + (integer-to-octet-vector new-seed))) + (vector (reseed *random-secure-obj-aes* new-seed)))) + +(defmethod SecurePRNG-octets-aes ((obj SecurePRNG-AES) size) + "Returns size pseudorandom octets from a cryptographically secure PRNG." + (let ((res (make-array size + :element-type '(unsigned-byte 8) + :initial-element 0)) + (tmp (make-array (length (ctr obj)) + :element-type '(unsigned-byte 8) + :initial-element 0)) + (ctr-size (length (ctr obj)))) + + (do* ((offset 0 (+ offset next)) + (leftover size (- leftover next)) + (next (min ctr-size leftover) (min ctr-size leftover))) + ((<= leftover 0)) + ;; the cipher overwrites the input buffer so we cannot use + ;; (ctr obj) directly. + (octet-vector-copy (ctr obj) 0 ctr-size tmp 0) + (aes-crypt-octet-vector tmp (key obj) 'ctr-onetime nil) + (octet-vector-copy tmp 0 next res offset) + (inc-counter obj)) + + res)) + + +(defun foo () + (setf *random-secure-obj-aes* (make-SecurePRNG-AES)) + (format t "ctr before = ~A~%" (hex (ctr *random-secure-obj-aes*))) + (format t "bytes = ~A~%"(hex (random-secure-octets-aes 16))) + (format t "ctr = ~A~%" (hex (ctr *random-secure-obj-aes*)))) + +(defun bar (&optional (size 16)) + (format t "bytes = ~A~%"(hex (random-secure-octets-aes size))) + (format t "ctr = ~A~%" (hex (ctr *random-secure-obj-aes*)))) --- /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/21 01:15:22 1.8 +++ /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/23 23:55:39 1.9 @@ -375,8 +375,17 @@ (aes-ecb-mode data round-key num-rounds doEncrypt)) ((eq mode 'cbc) (aes-cbc-mode data round-key num-rounds doEncrypt iv)) + ((eq mode 'ctr-onetime) + (aes-generate-one-time-pad-ctr data round-key num-rounds)) (t (error "No such mode ~A" mode))))) +(defun aes-generate-one-time-pad-ctr (data round-key num-rounds) + "data is the counter" + (let ((encrypted-block (make-array '(4 4))) + (offset 0)) + (get-block encrypted-block data offset) + (aes-encrypt-block encrypted-block round-key num-rounds) + (copy-back-block encrypted-block data offset))) (defun aes-cbc-mode (data round-key num-rounds doEncrypt iv)

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 23 Jan '07

23 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv1638 Modified Files: random.lisp Log Message: Remove non-secure generator to avoid mistakes. --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/20 15:46:59 1.5 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/23 21:20:36 1.6 @@ -1,24 +1,15 @@ ;;;;-*-lisp-*- ;;;; The Crypticl cryptographic library. ;;;; -;;;; Description: Pseudo random number generation. +;;;; Description: Cryptographically secure pseudo random number generator. ;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. - ;;To do: ;;-get high entropy bits on non-Linux system. Either roll your own (most likely bad idea) or use win32API to handle one other system. But this is not important. win32 API CryptGenRandom. -;;-test suite. Some simple statistical tests on output? (in-package crypticl) -(defun random-bignum (bitsize) - "Return random integer bitsize bits long, i.e. an integer in the range [0, 2^bitsize - 1]. Uses the internal Lisp PSNG random which is _not_ cryptographically secure. -" - (warn "Using a PSNG which is _not_ cryptographically secure.") - (random-bignum-internal bitsize #'random)) - - (defun random-secure-bignum (bitsize) "Return random integer bitsize bits long generatated from a cryptograpically secure pseudo random number generator. The function is very slow because random-secure invokes SHA-1 multiple times. It should only be used for cryptographic keys and the like. @@ -55,8 +46,7 @@ -;;;;;;;; -;;; CRYPTOGRAPHICALLY SECURE RANDOM NUMBER GENERATOR +;;;;;;;; CRYPTOGRAPHICALLY SECURE RANDOM NUMBER GENERATOR (defparameter *random-secure-obj* nil "State for the random number generator")

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 22 Jan '07

22 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv4482 Modified Files: utilities.lisp Log Message: Add keyword option. --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/21 01:15:22 1.8 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/22 22:45:32 1.9 @@ -35,13 +35,26 @@ (setq integer (+ (* integer 256) (aref vector i)))) integer)) -(defun integer-to-octet-vector (integer &key vector (start 0)) - "Transforms positive integers to byte vector using big endian format. Assumes a byte is 8 bits. " +(defun integer-to-octet-vector (integer &key vector + (start 0) + size) + "Transforms positive integers to byte vector using big endian/most +significant byte first format. + +Parameters: +size -- size of returned vector, prepadded with zero bytes if necessary. +" + (when (and size vector) + (assert (= size (length vector)))) (let* ((required-length - ;; Special case for 0 because integer-length returns 0 then. - (if (= integer 0) - 1 - (ceiling (integer-length integer) 8))) + (cond + (vector (length vector)) + (size size) + (t + ;; Special case for 0 because integer-length returns 0 then. + (if (= integer 0) + 1 + (ceiling (integer-length integer) 8))))) (result (or vector (make-array required-length :element-type '(unsigned-byte 8) @@ -59,6 +72,15 @@ result)) +(defun int-as-octet-vector-add (ov n) + "Add n to octet vector ov." + (integer-to-octet-vector (+ (octet-vector-to-integer ov) n) :vector ov)) + +(defun foo (data ctr) + (aes-crypt-octet-vector data #16(0) 'ctr nil ctr) + (int-as-octet-vector-add ctr 1) + (hex data)) + (defun hex (ov) (octet-vector-to-hex-string ov))

1 0

[crypticl-cvs] CVS crypticl/etc
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/etc In directory clnet:/tmp/cvs-serv7590 Modified Files: .emacs Log Message: add scp-buffer. --- /project/crypticl/cvsroot/crypticl/etc/.emacs 2007/01/21 01:24:52 1.1 +++ /project/crypticl/cvsroot/crypticl/etc/.emacs 2007/01/21 01:55:59 1.2 @@ -182,3 +182,12 @@ (put 'upcase-region 'disabled nil) + + +;;tskogan@common-lisp.net:/project/crypticl/public_html +(defun scp-buffer (dst) + (interactive "s scp current file to remote destination: ") + (let ((retval (call-process "pscp" nil nil nil (buffer-file-name) dst))) + (if (eq 0 retval) + (princ (format "Copied file %s to %s" (buffer-file-name) dst)) + (princ (format "scp failed with return value %s" retval)))))

1 0

[crypticl-cvs] CVS crypticl/doc/html
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc/html In directory clnet:/tmp/cvs-serv6825 Modified Files: index.html Log Message: *** empty log message *** --- /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:36:02 1.7 +++ /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/21 01:40:26 1.8 @@ -45,7 +45,7 @@ <h3>Download</h3> <a href="crypticl-0.1.1.tar.gz">Crypticl 0.1</a><p> - <a href="obol-0.1.1.tar.gz">Obol 0.1</a>, includes crypticl.<p> + <a href="obol-0.1.1.tar.gz">Obol 0.1</a>, includes Crypticl.<p> <h3>CVS</h3>

1 0

[crypticl-cvs] CVS crypticl/etc
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/etc In directory clnet:/tmp/cvs-serv3393 Added Files: .emacs Log Message: Adding .emacs used for Crypticl dev. --- /project/crypticl/cvsroot/crypticl/etc/.emacs 2007/01/21 01:24:52 NONE +++ /project/crypticl/cvsroot/crypticl/etc/.emacs 2007/01/21 01:24:52 1.1 ;;;; .emacs for crypticl ;;Binding *.lisp files to Common Lisp mode. Does this by adding cons cell ;;to global variable. Must come before we load lisp. (setq auto-mode-alist (cons '("\\.lisp?$" . common-lisp-mode) auto-mode-alist)) (setq auto-mode-alist (cons '("\\.emacs?$" . emacs-lisp-mode) auto-mode-alist)) (setq fi:common-lisp-buffer-name "*common-lisp*" fi:common-lisp-directory "C:/crypticl/src/" fi:common-lisp-image-name "C:/Programfiler/acl62/mlisp" fi:common-lisp-image-file "C:/Programfiler/acl62/mlisp" fi:common-lisp-image-arguments nil fi:common-lisp-host "localhost") (load "C:/Programfiler/acl62/eli/fi-site-init.el") (defun run-common-lisp () (interactive) (fi:common-lisp fi:common-lisp-buffer-name fi:common-lisp-directory fi:common-lisp-image-name fi:common-lisp-image-arguments fi:common-lisp-host) (define-key fi:inferior-common-lisp-mode-map "\M-n" 'fi:push-input) (define-key fi:inferior-common-lisp-mode-map "\M-p" 'fi:pop-input)) (global-set-key "\C-x\C-x" '(lambda () (interactive) (switch-to-buffer "*common-lisp*"))) ;;Shortcut (defun rcl () (interactive) (run-common-lisp)) (defun run-allegro-8 () (interactive) (push "C:/Programfiler/acl80-express/eli/" load-path) (load "fi-site-init.el") (setq fi:common-lisp-image-name "C:/Programfiler/acl80-express/allegro-ansi.exe") (setq fi:common-lisp-image-file "C:/Programfiler/acl80-express/allegro-ansi.dxl") (setq fi:common-lisp-image-arguments '("+B" "+cn")) (fi:common-lisp fi:common-lisp-buffer-name fi:common-lisp-directory fi:common-lisp-image-name fi:common-lisp-image-arguments fi:common-lisp-host fi:common-lisp-image-file)) (defun run-sbcl () (interactive) (setq inferior-lisp-program "C:/Programfiler/sbcl/1.0/sbcl.exe --noinform") (add-to-list 'load-path "C:/slime-2.0") (require 'slime) (slime-setup)) ;;; Use the Common Lisp HyperSpec (require 'hyperspec) (setq common-lisp-hyperspec-root "file:C:/hyperspec/HyperSpec/") ;; lookup on loop:collect works (eval-after-load "hyperspec" '(load "hyperspec-addon")) (global-set-key [f1] 'common-lisp-hyperspec) ;at .xemacs\abbrevs ;(read-abbrev-file) ;;Mapping M-p to scroll through previous commands (global-set-key "\M-p" 'fi:pop-input) ;;Mapping M-n to scroll through next commands (global-set-key "\M-n" 'fi:push-input) (defun last-command () (interactive) (print (format "Last command:%S" last-command))) ;;;;;;; ;; Return after long jump. (defvar *last-point* nil) (defun store-point () "queue sematics" (interactive) (setq *last-point* (append (list (point)) *last-point*))) (defun pop-point () "pops last point, unless there is only one left. If so, only return it (no pop)" (if (> (length *last-point*) 1) (prog1 (car *last-point*) (setq *last-point* (cdr *last-point*))) (car *last-point*))) (defun return-to-point () (interactive) (goto-char (pop-point))) (global-set-key [f4] 'store-point) (global-set-key [f5] 'return-to-point) (defadvice end-of-buffer (before jump-return ()) "" (store-point)) (ad-activate 'end-of-buffer) (defadvice beginning-of-buffer (before jump-return ()) "" (store-point)) (ad-activate 'beginning-of-buffer) (defadvice fi:lisp-find-definition (before jump-return ()) "" (store-point)) (ad-activate 'fi:lisp-find-definition) (defadvice isearch-forward (before jump-return ()) "" (store-point)) (ad-activate 'isearch-forward) ;; Run cl each time emacs is run: ;;(run-common-lisp) (setq auto-mode-alist (cons '("\\.py$" . python-mode) auto-mode-alist)) (setq interpreter-mode-alist (cons '("python" . python-mode) interpreter-mode-alist)) (autoload 'python-mode "python-mode" "Python editing mode." t) (global-font-lock-mode t) (setq font-lock-maximum-decoration t) (setq transient-mark-mode t) (column-number-mode 1) (custom-set-variables ;; custom-set-variables was added by Custom -- don't edit or cut/paste it! ;; Your init file should contain only one such instance. '(case-fold-search t) '(current-language-environment "Latin-1") '(default-input-method "latin-1-prefix") '(global-font-lock-mode t nil (font-lock)) '(show-paren-mode t nil (paren)) '(transient-mark-mode t)) (custom-set-faces ;; custom-set-faces was added by Custom -- don't edit or cut/paste it! ;; Your init file should contain only one such instance. ) ;; Make text the default mode (setq default-major-mode 'text-mode) ;; Use fill mode (fixed length lines (add-hook 'text-mode-hook 'turn-on-auto-fill) ;; ========== Set the fill column ========== ;; 78 visible character + line ending (two bytes on windows) (setq-default fill-column 78) ;; ===== Turn off tab character ===== ;; ;; Emacs normally uses both tabs and spaces to indent lines. If you ;; prefer, all indentation can be made from spaces only. To request this, ;; set `indent-tabs-mode' to `nil'. This is a per-buffer variable; ;; altering the variable affects only the current buffer, but it can be ;; disabled for all buffers. ;; ;; Use (setq ...) to set value locally to a buffer ;; Use (setq-default ...) to set value globally ;; (setq-default indent-tabs-mode nil) (put 'upcase-region 'disabled nil)

1 0

[crypticl-cvs] CVS crypticl/etc
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/etc In directory clnet:/tmp/cvs-serv3158/etc Log Message: Directory /project/crypticl/cvsroot/crypticl/etc added to the repository

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv1390/doc Modified Files: TODO README Log Message: Porting to SBCL 1.0.1: -force hex to return lowercase hex digits. -replace defconstant with defparameter because of picky behavior in SBCL. --- /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/20 16:54:59 1.4 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/21 01:15:22 1.5 @@ -7,5 +7,5 @@ -more example applications to test and improve the api -SHA-512? -Document how to run the full test set. --Port to SBCL + --- /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 19:33:41 1.10 +++ /project/crypticl/cvsroot/crypticl/doc/README 2007/01/21 01:15:22 1.11 @@ -30,10 +30,11 @@ Tested on: -Allegro 6.2 Windows XP --Allegro CL 8.0 (Updated June 14, 2006) Windows XP +-Allegro CL 8.0 (June 14, 2006) Windows XP +-SBCL 1.0.1 (December 26, 2006) Windows XP -The library has only been tested with Allegro under Windows, but most of the -code should be portable. +Most of the testing has been on Allegro under Windows, but the code should be +fairly portable. DOCUMENTATION

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 21 Jan '07

21 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv1390/src Modified Files: utilities.lisp aes.lisp Log Message: Porting to SBCL 1.0.1: -force hex to return lowercase hex digits. -replace defconstant with defparameter because of picky behavior in SBCL. --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/20 19:33:41 1.7 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/21 01:15:22 1.8 @@ -67,10 +67,12 @@ (defun octet-vector-to-hex-string (bv) "Returns a hex string representation of a byte vector. Does not ignore leading zeros." - (let ((hex-string "")) - (dotimes (i (length bv) hex-string ) - (setf hex-string - (concatenate 'string hex-string (format nil "~2,'0X" (aref bv i))))))) + (string-downcase + (let ((hex-string "")) + (dotimes (i (length bv) hex-string ) + (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." @@ -96,8 +98,7 @@ -;;;(defun byte-vector-to-hex-string (bv) -;;; "Legacy support. Will be removed" +;;;(defun byte-vector-to-hex-string (bv) "Legacy support. Will be removed" ;;; (octet-vector-to-hex-string bv)) (defun hexo (str) @@ -213,7 +214,7 @@ Each character is converted to a single byte. Intended for working with ASCII strings and 8-bit encodings. " - (map '(simple-array (unsigned-byte 8)) + (map '(simple-array (unsigned-byte 8) (*)) ;; NB! char-code can return a number bigger than 8 bits #'(lambda (c) (ldb (byte 8 0) (char-code c))) s)) --- /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/18 21:50:37 1.7 +++ /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/21 01:15:22 1.8 @@ -22,10 +22,10 @@ (in-package crypticl) -(defconstant NB 4 +(defparameter NB 4 "Number of 32 bits words in the state = number of columns in state. Equals variable BC in the reference implementation.") -(defconstant logtable +(defparameter logtable #( 0 0 25 1 50 2 26 198 75 199 27 104 51 238 223 3 100 4 224 14 52 141 129 239 76 113 8 200 248 105 28 193 125 194 29 181 249 185 39 106 77 228 166 114 154 201 9 120 @@ -44,7 +44,7 @@ 103 74 237 222 197 49 254 24 13 99 140 128 192 247 112 7) ) -(defconstant alogtable +(defparameter alogtable #( 1 3 5 15 17 51 85 255 26 46 114 150 161 248 19 53 95 225 56 72 216 115 149 164 247 2 6 10 30 34 102 170 229 52 92 228 55 89 235 38 106 190 217 112 144 171 230 49 @@ -63,7 +63,7 @@ 57 75 221 124 132 151 162 253 28 36 108 180 199 82 246 1) ) -(defconstant Sbox +(defparameter Sbox #( 99 124 119 123 242 107 111 197 48 1 103 43 254 215 171 118 202 130 201 125 250 89 71 240 173 212 162 175 156 164 114 192 183 253 147 38 54 63 247 204 52 165 229 241 113 216 49 21 @@ -82,7 +82,7 @@ 140 161 137 13 191 230 66 104 65 153 45 15 176 84 187 22) "S-box.") -(defconstant Si +(defparameter Si #( 82 9 106 213 48 54 165 56 191 64 163 158 129 243 215 251 124 227 57 130 155 47 255 135 52 142 67 68 196 222 233 203 84 123 148 50 166 194 35 61 238 76 149 11 66 250 195 78 @@ -103,7 +103,7 @@ -(defconstant RC #(#x00 #x01 #x02 #x04 #x08 #x10 #x20 #x40 #x80 +(defparameter RC #(#x00 #x01 #x02 #x04 #x08 #x10 #x20 #x40 #x80 #x1b #x36 #x6c #xd8 #xab #x4d #x9a #x2f #x5e #xbc #x63 #xc6 #x97 #x35 #x6a #xd4 #xb3 #x7d #xfa #xef #xc5 #x91)

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 20 Jan '07

20 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv4220/doc Modified Files: README Log Message: Replace the two last calls to Allegro specific excl: functions. --- /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 16:54:59 1.9 +++ /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 19:33:41 1.10 @@ -32,9 +32,8 @@ -Allegro 6.2 Windows XP -Allegro CL 8.0 (Updated June 14, 2006) Windows XP -The library has only been tested with Allegro under Windows and may use some -Allegro specific functions by accident, but the bulk of the code is portable -to all Common Lisp implementations. +The library has only been tested with Allegro under Windows, but most of the +code should be portable. DOCUMENTATION

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 20 Jan '07

20 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv4220/src Modified Files: utilities.lisp common.lisp Log Message: Replace the two last calls to Allegro specific excl: functions. --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/17 22:00:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/20 19:33:41 1.7 @@ -35,13 +35,6 @@ (setq integer (+ (* integer 256) (aref vector i)))) integer)) - -(defun string-to-octets (str &optional (start 0) (end (length str))) - (let* ((size (- end start)) - (o (make-array size :element-type '(unsigned-byte 8)))) - (dotimes (i size o) - (setf (aref o i) (char-code (char str (+ start i))))))) - (defun integer-to-octet-vector (integer &key vector (start 0)) "Transforms positive integers to byte vector using big endian format. Assumes a byte is 8 bits. " (let* ((required-length @@ -173,8 +166,8 @@ (dolist (s lst) (write-string s str)))) -;;;;;;; -;;; String utilities (from CLOCC) + +;;;; String utilities (defun split-seq (seq pred &key (start 0) end key strict) "Return a list of subseq's of SEQ, split on predicate PRED. @@ -213,3 +206,22 @@ nil ; prefix longer than string (string= s prefix :end1 len)))) +(defun string-to-octets (s) + "Return string to byte array. + +This function is NOT portable and very implementation dependend. +Each character is converted to a single byte. Intended for working with +ASCII strings and 8-bit encodings. +" + (map '(simple-array (unsigned-byte 8)) + ;; NB! char-code can return a number bigger than 8 bits + #'(lambda (c) (ldb (byte 8 0) (char-code c))) s)) + +(defun octets-to-string (octet-vector) + "Convert byte array to string. + +Assumes the byte array was produced by string-to-octets on +the same platform." + (map 'string #'code-char octet-vector)) + + \ No newline at end of file --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/20 15:37:51 1.9 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/20 19:33:41 1.10 @@ -5,10 +5,10 @@ ;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. -;; To do: -;;-register constructors for byte-encoding constructors in the same way as for normal constructors. +;; TODO: +;;-register constructors for byte-encoding constructors in the same way +;; as for normal constructors. ;;-better spki string encoding with type. -;;-replace excl function (in-package crypticl) @@ -153,7 +153,6 @@ nil))) #'string-reader))) - (defun make-byte-array-reader-function-old (array &optional (end (length array))) "Return a reader that for each call returns the next byte from the array or nil if it reaches the end. Uses closure." @@ -256,8 +255,7 @@ (defun get-element-encodings (msg-elements) "Get byte encoding for each msg element, transform to base64 spki and return the bytes." - ;;TODO replace excl function - (excl:string-to-octets + (string-to-octets (to-spki (mapcar #'get-msg-element-encoding msg-elements)))) (defun to-spki(msg-elements) @@ -310,7 +308,7 @@ (octet-vector-to-integer octvec)) (t (error "Unknown type=~A" type)))) (parse-spki - (excl:octets-to-string encoding)))) + (octets-to-string encoding)))) ;;;;;;

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 20 Jan '07

20 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv30017 Modified Files: TODO README Log Message: Updating platform info after testing on Allegro 8.0. --- /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/16 23:49:39 1.3 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/20 16:54:59 1.4 @@ -6,10 +6,6 @@ -Study the Fortuna PRNG. -more example applications to test and improve the api -SHA-512? --Cleanup test result output and refactor test code. Only run some test - by default so not to exhaust the Allegro heap. Document how to run the - full test set. Less verbose test output by default, only report "All -Crypticl tests OK" or similar on success. --Port to Allegro 8 (or higher) +-Document how to run the full test set. -Port to SBCL --- /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 15:35:00 1.8 +++ /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 16:54:59 1.9 @@ -25,8 +25,15 @@ example: (load "C:\\crypticl\\src\\load") -The library has only been tested with Allegro 6.2 under Windows and may -contain some Allegro specific functions, but the bulk of the code is portable +PLATFORMS +========= + +Tested on: +-Allegro 6.2 Windows XP +-Allegro CL 8.0 (Updated June 14, 2006) Windows XP + +The library has only been tested with Allegro under Windows and may use some +Allegro specific functions by accident, but the bulk of the code is portable to all Common Lisp implementations.

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 20 Jan '07

20 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv3774 Modified Files: test.lisp sha256.lisp sha.lisp rsa.lisp md5.lisp common.lisp Log Message: Be consistent and always use SHA-1, not SHA1. --- /project/crypticl/cvsroot/crypticl/src/test.lisp 2007/01/17 22:00:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/test.lisp 2007/01/20 15:37:51 1.7 @@ -18,7 +18,7 @@ ;; Simulate the author signing the code and creating a code certificate. ;; The certificate is represented by (signer,r,s, codehash) where r and s - ;; is the algorithm specific signature part, in this case DSA with SHA1. + ;; is the algorithm specific signature part, in this case DSA with SHA-1. (setf codehash (with-open-file (str path :direction :input) (sha1-on-octet-stream str))) @@ -48,7 +48,7 @@ (defun run-tests() - (test-SHA1) + (test-SHA-1) (test-MD5) (test-AES) (test-RSA) --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/18 21:50:35 1.8 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/20 15:37:51 1.9 @@ -270,7 +270,7 @@ (h obj) (32-add (h obj) hh)))) -;;; TODO identical to SHA1 method i sha.lisp so reuse +;;; TODO identical to SHA-1 method i sha.lisp so reuse (defmethod fill-vector ((obj SHA-256) return-vector octet-vector start) "Return the next 512 bits for hashing. --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/18 21:50:35 1.9 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/20 15:37:51 1.10 @@ -199,7 +199,7 @@ ;;;;;;; ;;; CLOS -(defclass SHA1 (Hash) +(defclass SHA-1 (Hash) ((octet-count :accessor octet-count ;octets processed so far :initform 0) (leftover-octets :accessor leftover-octets ;unprocessed octets @@ -215,7 +215,7 @@ (e :accessor e))) -(defmethod fill-vector ((obj SHA1) return-vector octet-vector start) +(defmethod fill-vector ((obj SHA-1) return-vector octet-vector start) "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. @@ -253,7 +253,7 @@ (+ start used))) -(defmethod store-state ((obj SHA1) octet-vector offset end octet-count) +(defmethod store-state ((obj SHA-1) octet-vector offset end octet-count) "Store state between calls to update." (let ((leftover-offset (leftover-count obj)) (octets-left (- end offset))) @@ -268,7 +268,7 @@ (setf (leftover-count obj) (+ leftover-offset octets-left)))) -(defmethod sha1-add-octet-vector ((obj SHA1) octet-vector start end) +(defmethod sha1-add-octet-vector ((obj SHA-1) octet-vector start end) (let ((vec (make-array 16 :element-type '(unsigned-byte 32))) (input-size (- end start)) (offset start)) @@ -293,7 +293,7 @@ (e obj) (32-add (e obj) ee)))) -(defmethod sha1-final ((obj SHA1)) +(defmethod sha1-final ((obj SHA-1)) (let ((vec (make-array 16 :element-type '(unsigned-byte 32))) (buffer-filler (make-buffer-filler @@ -310,7 +310,7 @@ (reset obj)))) -(defmethod reset ((obj SHA1)) +(defmethod reset ((obj SHA-1)) (initialize-sha1-state (a obj) (b obj) (c obj) (d obj) (e obj)) (setf (octet-count obj) 0 (leftover-count obj) 0)) @@ -319,15 +319,15 @@ ;;;;;;;; ;;; CLOS API -(defun make-SHA1 () - "Constructor for the SHA1 class" - (let ((obj (make-instance 'SHA1 :algorithm "SHA1"))) +(defun make-SHA-1 () + "Constructor for the SHA-1 class" + (let ((obj (make-instance 'SHA-1 :algorithm "SHA-1"))) (initialize-sha1-state (a obj) (b obj) (c obj) (d obj) (e obj)) obj)) -(defmethod hash ((obj SHA1) &optional data (start 0) (end (length data))) - "Return SHA1 hash. Note that calling hash on an empty object or a second time on the same object makes no sense. The value returned in both cases is the initial state of the SHA-1 algorithm." +(defmethod hash ((obj SHA-1) &optional data (start 0) (end (length data))) + "Return SHA-1 hash. Note that calling hash on an empty object or a second time on the same object makes no sense. The value returned in both cases is the initial state of the SHA-1 algorithm." (when (and (fresh obj) (not data)) (return-from hash nil)) (when data @@ -339,9 +339,9 @@ (sha1-final obj)) -(defmethod update ((obj SHA1) (octet-vector vector) +(defmethod update ((obj SHA-1) (octet-vector vector) &optional (start 0) (end (length octet-vector))) - "Add octets to SHA1 hash object. Get hash value by calling hash." + "Add octets to SHA-1 hash object. Get hash value by calling hash." (sha1-add-octet-vector obj octet-vector start end) (setf (fresh obj) nil)) @@ -349,10 +349,10 @@ ;;;;;;;; ;;; Low level API -(defmethod hash-stream ((obj SHA1) (s stream)) +(defmethod hash-stream ((obj SHA-1) (s stream)) (sha1-on-octet-stream s)) -(defmethod hash-string ((obj SHA1) (str string)) +(defmethod hash-string ((obj SHA-1) (str string)) (sha1-on-string str)) (defun sha1-on-string (string) @@ -377,7 +377,7 @@ ;;;;;;;; ;;; Test suite -(defun test-SHA1 (&key test-long) +(defun test-SHA-1 (&key test-long) "Test vector 1 and 2 are taken from reference FIPS 180-2." (let ((test-list (list @@ -396,7 +396,7 @@ (sha1-on-octet-vector in)) ex)() "sha1 test for input string ~A~%" in) - (let ((obj (make-SHA1))) + (let ((obj (make-SHA-1))) ;; Test hash only. (assert (string= (octet-vector-to-hex-string (hash obj in)) ex) () @@ -416,4 +416,4 @@ (format t "Done testing long vector.~%")))) -(register-constructor 'SHA1 #'make-SHA1) \ No newline at end of file +(register-constructor 'SHA-1 #'make-SHA-1) \ No newline at end of file --- /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2007/01/18 21:50:37 1.7 +++ /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2007/01/20 15:37:51 1.8 @@ -270,27 +270,27 @@ ;;;;;;;;;;;; -;;; Signatures SHA1withRSA +;;; Signatures SHA-1withRSA -(defclass SHA1withRSA (Signature) +(defclass SHA-1withRSA (Signature) ((key :accessor key :initarg :key)) - (:documentation "A class for digital signatures using RSA and SHA1.")) + (:documentation "A class for digital signatures using RSA and SHA-1.")) -(defun make-SHA1withRSA () +(defun make-SHA-1withRSA () "Constructor. The default is to create an empty instance that can be initialized with the apropriate keys for signing or verifying. The typical usage will be to use init-verify with an authenticated copy of someone's public key to verify a document they have signed. " - (make-instance 'SHA1withRSA)) + (make-instance 'SHA-1withRSA)) -(defmethod init-sign ((obj SHA1withRSA) (private-key RSAPrivateKey)) +(defmethod init-sign ((obj SHA-1withRSA) (private-key RSAPrivateKey)) "Initialize for signing." (setf (key obj) private-key)) -(defmethod init-verify ((obj SHA1withRSA) (public-key RSAPublicKey)) +(defmethod init-verify ((obj SHA-1withRSA) (public-key RSAPublicKey)) "Initialize instance for verifying. " (setf (key obj) public-key)) -(defmethod sign ((obj SHA1withRSA) message &key message-hash) +(defmethod sign ((obj SHA-1withRSA) message &key message-hash) "Sign a message and return the signature (s). Input is either the message as byte array message or a hash of the message, message-hash. Use nil for the message to choose the message-hash variant." (let* ((key (key obj)) (cipher (new-instance (algorithm key)))) @@ -302,7 +302,7 @@ (sha1-on-string message)) (t (sha1-on-octet-vector message)))))))) -(defmethod verify ((obj SHA1withRSA) signature message &key message-hash) +(defmethod verify ((obj SHA-1withRSA) signature message &key message-hash) "Verify a DSA signature s for a message. Input is either the message as byte array message or a hash of the message, message-hash. Use nil for the message to choose the message-hash variant." (let* ((sig (first signature)) (key (key obj)) @@ -507,7 +507,7 @@ (register-constructor 'RSA #'make-RSA) -(register-constructor 'SHA1withRSA #'make-SHA1withRSA) +(register-constructor 'SHA-1withRSA #'make-SHA-1withRSA) (register-key-generator 'RSA #'rsa-generate-keys) (register-key-from-encoding 'RSAPublicKey #'make-RSAPublicKey-from-encoding) (register-key-from-encoding 'RSAPrivateKey #'make-RSAPrivateKey-from-encoding) --- /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/18 21:50:37 1.6 +++ /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/20 15:37:51 1.7 @@ -144,7 +144,7 @@ if there is more data. It returns nil if all data including padding and data length has been returned. -This is almost identical to the SHA1 function sha1-make-buffer-filler, except for the order (big-endian vs little-endian) the octets are stored in. +This is almost identical to the SHA-1 function sha1-make-buffer-filler, except for the order (big-endian vs little-endian) the octets are stored in. The buffer-filler is a state-machine with four states. :done, :data, :length and :zeropad. The initial state is :data. When there is no more data, #x80 is returned and the new state is either :write-length (if current word is 13 and current byte is 3) else :zeropad. If we enter :write-length we write the length in the last two 32 bit words and enter :done. In state :zeropad we write zeros until we reach word 13 and byte 3 and then enter :write-length. When we reach the :done state, the next call will return nil." (let ((state :data) --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/18 21:37:02 1.8 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/20 15:37:51 1.9 @@ -79,12 +79,12 @@ :report "Try another algorithm." :interactive (lambda () (format t "~&New algorithm: ") - ;;(format t "(use 'SHA1 or SHA1, not \"SHA1\"): ") + ;;(format t "(use 'SHA-1 or SHA-1, not \"SHA-1\"): ") (list (read))) (typecase value - (cons (setf algorithm (second value))) ;input 'SHA1 - (string (setf algorithm value)) ;input "SHA1" - (symbol (setf algorithm value))))))) ;input SHA1 + (cons (setf algorithm (second value))) ;input 'SHA-1 + (string (setf algorithm value)) ;input "SHA-1" + (symbol (setf algorithm value))))))) ;input SHA-1 (defun load-algorithm (&optional (path "des.lisp"))

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 20 Jan '07

20 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv2674 Modified Files: USERGUIDE README Log Message: Fixed width (78 visible chars) paragraphs with fill-region to make cvs diff easier. --- /project/crypticl/cvsroot/crypticl/doc/USERGUIDE 2005/10/01 18:47:20 1.3 +++ /project/crypticl/cvsroot/crypticl/doc/USERGUIDE 2007/01/20 15:35:00 1.4 @@ -1,40 +1,52 @@ -;;;;-*-text-*- -;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; CRYPTICL - USER GUIDE -;; -;; *** WORK IN PROGRESS *** -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;; +======================== += += CRYPTICL - USER GUIDE += +======================== + CONTENTS ======== --Introduction --Hash functions --Symmetric key encryption --Digital signatures + +-INTRODUCTION +-HASH FUNCTIONS +-SYMMETRIC KEY ENCRYPTION +-DIGITAL SIGNATURES +-DIFFIE-HELLMAN INTRODUCTION ============ -This user guide focus on examples showing typical tasks. The unit tests for each algorithm is a further source of examples. To test the examples yourself load crypticl and then change into the package with in-package: + +This is a short introduction and user guide for the Crypticl cryptography +library written in and for Common Lisp. + +This user guide focus on examples showing typical tasks. The unit tests for +each algorithm is a further source of examples. To test the examples yourself +load crypticl and then change into the package with in-package: cl-user(2):(load "C:\\crypticl\\src\\load.lisp") ... cl-user(3): (in-package crypticl) #<The crypticl package> -The examples use two utility functions, hex and hexo, to simplify the output. hex takes an octet vector (byte vector) and returns a string representation in hex. hexo is the reverse, it takes a hex string and returns the octect vector equivalent. Both functions are part of the library. +The examples use two utility functions, hex and hexo, to simplify the +output. hex takes an octet vector (byte vector) and returns a string +representation in hex. hexo is the reverse, it takes a hex string and returns +the octect vector equivalent. Both functions are part of the library. HASH FUNCTIONS ============== + Create a SHA-1 object: -crypticl(4): (setf obj (new-instance 'SHA1)) +crypticl(4): (setf obj (new-instance 'SHA-1)) #<SHA1 @ #x211285fa> -The new-instance function is a factory method used to generate instances of all the algorithms. An md5 object can for example be created with (new-instance 'MD5). +The new-instance function is a factory method used to generate instances of +all the algorithms. A SHA-256 object can for example be created with +(new-instance 'SHA-256). Compute SHA-1 hash of a byte vector: @@ -55,10 +67,18 @@ crypticl(14): (hex (hash obj)) "a9993e364706816aba3e25717850c26c9cd0d89d" -Implementation note: -There is a semantic difference between calling hash on a hash object with no data and calling hash on an empty byte vector. Calling hash on an empty object is more likely to be a user error and hence returns nil. Calling hash on an empty byte vector on the other hand, may simply mean that we got very short input and hence returns the initial state of the SHA-1 algorithm (which is a valid 160 bits byte vector). - -The object oriented interface introduced above is built on top of low level function primitives for each algorithm. Sometimes it's easier to work directly with them. To get the SHA1 hash of a stream (typically a file) use sha1-on-octet-stream: +Implementation note: +There is a semantic difference between calling hash on a +hash object with no data and calling hash on an empty byte vector. Calling +hash on an empty object is more likely to be a user error and hence returns +nil. Calling hash on an empty byte vector on the other hand, may simply mean +that we got very short input and hence returns the initial state of the SHA-1 +algorithm (which is a valid 160 bits byte vector). + +The object oriented interface introduced above is built on top of low level +function primitives for each algorithm. Sometimes it's easier to work directly +with them. To get the SHA1 hash of a stream (typically a file) use +sha1-on-octet-stream: crypticl(31): (with-open-file (s "rsa.lisp") (hex (sha1-on-octet-stream s))) @@ -68,13 +88,19 @@ SYMMETRIC KEY ENCRYPTION ======================== -The Cipher class provides common functionality for symmetric and asymmetric algorithms used for encryption. Subclasses of the Cipher class must support the following methods: -init-encrypt: Initializes the Cipher object for encryption. Arguments may include the key and mode to use. +The Cipher class provides common functionality for symmetric and asymmetric +algorithms used for encryption. Subclasses of the Cipher class must support +the following methods: + +init-encrypt: Initializes the Cipher object for encryption. Arguments may +include the key and mode to use. -init-decrypt: Initializes the Cipher object for decryption. Arguments may include the key and mode to use. +init-decrypt: Initializes the Cipher object for decryption. Arguments may +include the key and mode to use. -update: Updates the state of the Cipher object. This means adding encrypted data for decryption or cleartext for encryption. +update: Updates the state of the Cipher object. This means adding encrypted +data for decryption or cleartext for encryption. encrypt: Applies padding and encrypts any leftover data. @@ -95,7 +121,8 @@ -> Signature -> DSA -To use a symmetric encryption scheme like IDEA or AES, start by getting an instance of the algorithm: +To use a symmetric encryption scheme like IDEA or AES, start by getting an +instance of the algorithm: crypticl(37): (setf obj (new-instance 'AES)) #<AES @ #x20d98f5a> @@ -114,7 +141,9 @@ crypticl(48): (hex (encrypt obj #(1 2 3))) "b92a901ceb2d6da3f74cfafcc8bc4064" -Note that although the input is only a 3 byte vector the output is a 16 byte long vector because of padding. To decrypt, initialize the object for decryption with the same key used for encryption and call decrypt: +Note that although the input is only a 3 byte vector the output is a 16 byte +long vector because of padding. To decrypt, initialize the object for +decryption with the same key used for encryption and call decrypt: crypticl(49): (init-decrypt obj aeskey) @@ -122,7 +151,8 @@ #(1 2 3) -The next example is more advanced and sets both the iv and mode before doing encryption and decryption in several steps using the update function. +The next example is more advanced and sets both the iv and mode before doing +encryption and decryption in several steps using the update function. crypticl(126): (setf obj (new-instance 'AES)) @@ -130,7 +160,14 @@ crypticl(129): (init-encrypt obj aeskey :mode 'cbc :iv #16(0)) 0 -The CBC mode is the default mode and the only safe mode implemented. The default iv is #16(0). In the following we encrypt the input stream a bit at a time, a typical thing to do for large files or network streams. Each call to update returns the cryptotext for the section of cleartext given as input, minus possibly a residue modulo the block size. The encryption (or decryption) must be closed with a call to encrypt(decrypt). This call will empty any buffered cleartext from previous calls to update, add padding and return the last of the cryptotext. +The CBC mode is the default mode and the only safe mode implemented. The +default iv is #16(0). In the following we encrypt the input stream a bit at a +time, a typical thing to do for large files or network streams. Each call to +update returns the cryptotext for the section of cleartext given as input, +minus possibly a residue modulo the block size. The encryption (or decryption) +must be closed with a call to encrypt(decrypt). This call will empty any +buffered cleartext from previous calls to update, add padding and return the +last of the cryptotext. crypticl(131): (init-encrypt obj aeskey :mode 'cbc :iv #16(0)) 0 @@ -139,7 +176,8 @@ crypticl(135): (hex (update obj #7(2))) "" -NOte how this call didn't return any cryptotext because update didn't add enough cleartext to fill a whole block of cryptotext. +Note how this call didn't return any cryptotext because update didn't add +enough cleartext to fill a whole block of cryptotext. crypticl(136): (hex (encrypt obj)) "e32e05ea9f3d9c40c12431c3ef77afbb" @@ -152,9 +190,12 @@ -Digital signatures +DIGITAL SIGNATURES ================== -We create a DSA object and generate a keypair. We see that the keypair object contain a private key for signing data and a public key for verifying signatures. + +We create a DSA object and generate a keypair. We see that the keypair object +contain a private key for signing data and a public key for verifying +signatures. crypticl(148): (setf obj (new-instance 'DSA)) #<DSA @ #x215d9faa> @@ -173,20 +214,27 @@ crypticl(155): (init-sign obj (private dsakey)) ... -Sign the data. The sign function returns the signature as a list of two numbers: +Sign the data. The sign function returns the signature as a list of two +numbers: + crypticl(156): (setf signature (sign obj #16(1))) (610205237490270933520572927751741211804151194981 814606745356376522186211750303275432244290651385) -We can verify a singature by initializing the DSA object with the public key and give the data and the signature as input too verify: +We can verify a singature by initializing the DSA object with the public key +and give the data and the signature as input too verify: crypticl(158): (verify obj signature #16(1)) t -Diffie-Hellman +DIFFIE-HELLMAN ============== -The following functions illustrates the Diffie-Hellman interface. The result will be list with two secrets which should be equal. Each of the two Diffie-Hellman objects dh1 and dh2 represents the two endpoints in a secure exchange of a common secret. + +The following functions illustrates the Diffie-Hellman interface. The result +will be list with two secrets which should be equal. Each of the two +Diffie-Hellman objects dh1 and dh2 represents the two endpoints in a secure +exchange of a common secret. (defun test-dh () (let (half-secret-1 --- /project/crypticl/cvsroot/crypticl/doc/README 2007/01/17 22:00:57 1.7 +++ /project/crypticl/cvsroot/crypticl/doc/README 2007/01/20 15:35:00 1.8 @@ -1,4 +1,5 @@ INTRODUCTION +============ Crypticl is a library of cryptographic functions written in Common Lisp. The goal is to provide flexible, high level cryptographic abstractions on top of @@ -9,10 +10,16 @@ implement all available cryptographic algorithms. Hence AES is included and DES is not. + WEBSITE +======= + http://common-lisp.net/project/crypticl/ + INSTALL +======= + The library can be loaded by loading the file "load.lisp". This file will load the library and run unit tests. @@ -22,26 +29,44 @@ contain some Allegro specific functions, but the bulk of the code is portable to all Common Lisp implementations. + DOCUMENTATION +============= + See the user guide in the file USERGUIDE. + DEVELOPERS +========== + Document changes in the ChangeLog in addition to writing commit messages. Before commiting, check that the library loads correctly into a fresh top level (use (delete-package 'crypticl) and reload) and verify that the unit tests are successful. Tag with V_<major>_<minor>_<num>, like V_0_1_0, V_0_1_1, etc. + TODO +==== + The file TODO is meant as a supplement to the various TODO comments in the source. + CHANGELOG +========= + See the file ChangeLog for the project change log. + CREDITS +======= + Tage Stabell-Kulø Frode V. Fjeld + AUTHOR +====== + Taale Skogan \ No newline at end of file

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 18 Jan '07

18 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv27121 Modified Files: sha256.lisp sha.lisp rsa.lisp md5.lisp idea.lisp aes.lisp Log Message: Unify output from load time tests. --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/18 21:37:02 1.7 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/18 21:50:35 1.8 @@ -432,7 +432,7 @@ (list "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1") ))) - (format t "~&Testing SHA-256 short vectors...") + (format t "~&SHA-256 short vectors...") (dolist (x test-list (format t "OK.")) (let ((in (first x)) (ex (second x)) --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/18 21:37:02 1.8 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/18 21:50:35 1.9 @@ -388,8 +388,8 @@ "84983e441c3bd26ebaae4aa1f95129e5e54670f1") (list #300(2 2 2) "e697e7834a688d2c982003a312da660a17a0fc9d")))) - (format t "Testing SHA-1.~%") - (dolist (x test-list (format t "Short vectors OK.~%")) + (format t "~&SHA-1 short vectors...") + (dolist (x test-list (format t "OK.")) (let ((in (first x)) (ex (second x))) (assert (string= (octet-vector-to-hex-string --- /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2007/01/17 22:00:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2007/01/18 21:50:37 1.7 @@ -443,7 +443,7 @@ (otherwise (error "Unknown spec ~A" spec))))) - (format t "~& ~A test suite OK." spec)) + (format t "~&~A test suite OK." spec)) (defun test-RSA() --- /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/17 22:00:52 1.5 +++ /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/18 21:50:37 1.6 @@ -427,7 +427,7 @@ "md5 test octet version for long vector~%")) (otherwise (error "Unknown spec ~A" spec))))) - (format t "~& ~A test suite OK." spec)) + (format t "~&~A test suite OK." spec)) (defun test-MD5() --- /project/crypticl/cvsroot/crypticl/src/idea.lisp 2007/01/17 22:00:52 1.5 +++ /project/crypticl/cvsroot/crypticl/src/idea.lisp 2007/01/18 21:50:37 1.6 @@ -524,7 +524,7 @@ (vector-check in input "IDEA CLOS decryption error"))) (otherwise (error "Unknown spec ~A" spec))))) - (format t "~& ~A test suite OK." spec)) + (format t "~&~A test suite OK." spec)) (defun test-IDEA() --- /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/17 22:00:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/18 21:50:37 1.7 @@ -684,7 +684,7 @@ (clear (hexo clear-org)) (key (hexo key-org)) (iv (hexo iv-org))) - (format t "~&Testing AES CLOS...") + (format t "~&AES CLOS...") (formatv t "~&Clear text:~%~A" (hex clear)) (init-encrypt aa key :iv iv) @@ -723,7 +723,7 @@ (defun aes-test-suite-fips-197 () "Offical FIPS 197 test vector (for ECB mode obviously)." - (format t "~&Testing AES on official FIPS 197 test vector...") + (format t "~&AES on official FIPS 197 test vector...") (let* ((fips-clear "00112233445566778899aabbccddeeff") (fips-key "000102030405060708090a0b0c0d0e0f") (fips-ciphertext "69c4e0d86a7b0430d8cdb78070b4c55a") @@ -743,7 +743,7 @@ (key (generate-key 'AES 128)) (iv #16(2)) (clear #500(3))) - (format t "~&Testing AES long vector...") + (format t "~&AES long vector...") (init-encrypt aa key :iv iv) (setf tmp (encrypt aa clear)) (init-decrypt aa key :iv iv) @@ -755,9 +755,7 @@ (defun test-AES () (aes-test-suite-fips-197) (aes-test-suite-CLOS) - (aes-test-suite-long) - (format t "~&AES OK.")) - + (aes-test-suite-long)) ;;;;;;;; ;;; Debug helpers

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 18 Jan '07

18 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv24210 Modified Files: sha256.lisp sha.lisp load.lisp common.lisp Log Message: Load sha256 correctly. Refactor commom code in sha-1 and sha-256. --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/16 23:43:12 1.6 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/18 21:37:02 1.7 @@ -18,101 +18,6 @@ (in-package crypticl) -;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; 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 @@ -215,30 +120,8 @@ h (32-add h hh)))) ;; 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) - "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) - )))) - + (int32s-to-octet-vector a b c d e f g h))) + (defun do-sha-256-message-block (a b c d e f g h mb) "Hash one 512 bits sha-256 message block. @@ -368,7 +251,7 @@ (sha-256-encode-block obj vec)) ;; Return hash. - (sha-256-make-octet-vector (a obj) (b obj) (c obj) (d obj) + (int32s-to-octet-vector (a obj) (b obj) (c obj) (d obj) (e obj) (f obj) (g obj) (h obj)))) @@ -430,6 +313,101 @@ (+ start used))) +;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; 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 (int32s-to-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)) + + ;;;;;;;;;;;;;;;;;; ;;;; ;;;; Tests --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/16 23:45:21 1.7 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/18 21:37:02 1.8 @@ -26,25 +26,6 @@ ,d #x10325476 ,e #xc3d2e1f0)) -(defmacro sha1-make-octet-vector (a b c d e) - "Make byte-vector from 5 32 bits integers. - -Note that SHA-1 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)) - (vector ,@(bytes 'a) - ,@(bytes 'b) - ,@(bytes 'c) - ,@(bytes 'd) - ,@(bytes 'e))))) - - (defun sha1-length64 (message-length-in-bits) "Returns input integer as two 32-bit words, high order bits first." (values (ldb (byte 32 32) message-length-in-bits) @@ -211,7 +192,7 @@ d (32-add d dd) e (32-add e ee)))) ;; Return hash value. - (sha1-make-octet-vector a b c d e))) + (int32s-to-octet-vector a b c d e))) @@ -325,7 +306,7 @@ (sha1-round obj vec)) ;; Reset object and return hash. - (prog1 (sha1-make-octet-vector (a obj) (b obj) (c obj) (d obj) (e obj)) + (prog1 (int32s-to-octet-vector (a obj) (b obj) (c obj) (d obj) (e obj)) (reset obj)))) --- /project/crypticl/cvsroot/crypticl/src/load.lisp 2007/01/17 22:00:52 1.7 +++ /project/crypticl/cvsroot/crypticl/src/load.lisp 2007/01/18 21:37:02 1.8 @@ -25,6 +25,7 @@ "random" "keygenerator" "md5" "aes" "idea" "dsa" "rsa" "diffie-hellman" + "sha256" "keystore" "test"))) (format t "Loading the Crypticl library...") --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/17 22:00:52 1.7 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/18 21:37:02 1.8 @@ -95,9 +95,25 @@ -;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Common functionality for hash functions. - +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun int32s-to-octet-vector (&rest int32s) + "Make octet vector (byte array in C terms) from 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." + (let ((res (make-array (* 4 (length int32s)) + :element-type '(unsigned-byte 8) + :fill-pointer 0))) + (dolist (int32 int32s res) + (vector-push (ldb (byte 8 24) int32) res) + (vector-push (ldb (byte 8 16) int32) res) + (vector-push (ldb (byte 8 8) int32) res) + (vector-push (ldb (byte 8 0) int32) res)))) (defun 32-add (&rest args) "Adds a 32-bit number modulo (expt 2 32)"

1 0

[crypticl-cvs] CVS crypticl/doc/html
by tskogan 17 Jan '07

17 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc/html In directory clnet:/tmp/cvs-serv933 Modified Files: index.html Log Message: Remove validation stuff. --- /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:23:19 1.6 +++ /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:36:02 1.7 @@ -1,12 +1,8 @@ -<?xml version="1.0"?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<html> <head> - <title>Crypticl</title> - <link rel="stylesheet" type="text/css" href="style.css"/> - <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> -</head> + <title>Crypticl</title> + <link rel="stylesheet" type="text/css" href="style.css"/> + </head> <body> <div class="header">

1 0

[crypticl-cvs] CVS crypticl/doc/html
by tskogan 17 Jan '07

17 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc/html In directory clnet:/tmp/cvs-serv317 Modified Files: index.html Log Message: Remove validator link. --- /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:12:16 1.5 +++ /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:23:19 1.6 @@ -62,10 +62,6 @@ <div class="footer"> Taale Skogan 17. January 2007. </div> - - <div class="check"> - <a href="http://validator.w3.org/check/referer"> - Valid XHTML 1.0 Strict</a> - </div +  </body> </html>

1 0

[crypticl-cvs] CVS crypticl/doc/html
by tskogan 17 Jan '07

17 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc/html In directory clnet:/tmp/cvs-serv30348 Modified Files: index.html Log Message: Corrections and updates. --- /project/crypticl/cvsroot/crypticl/doc/html/index.html 2005/10/02 14:54:51 1.4 +++ /project/crypticl/cvsroot/crypticl/doc/html/index.html 2007/01/17 22:12:16 1.5 @@ -16,9 +16,9 @@ <h3>Introduction</h3> - <p>Crypticl is a library of cryptographic functions written in Common Lisp. The goal is to provide flexible, high level cryptographic abstractions on top of a kernel of core cryptographic primitives. The core currently includes AES, IDEA, SHA-1, DSA and RSA primitives. It is distributed under an MIT-style license.</p> + <p>Crypticl is a library of cryptographic functions written in Common Lisp. The goal is to provide flexible, high level cryptographic abstractions on top of a kernel of core cryptographic primitives. The core currently includes AES, IDEA, MD5, SHA-1, SHA-256, DSA and RSA primitives. It is distributed under an MIT-style license.</p> -<p>The library will be limited to common, secure algorithms and not try to implement all available cryptographic algorithms. Hence AES is included and DES is not and MD5 will be removed due to recently discovered weaknesses. +<p>The library will be limited to common, secure algorithms and not try to implement all available cryptographic algorithms. Hence AES is included and DES is not. <!-- <h3>Mailing Lists</h3> @@ -44,7 +44,7 @@ <h3>Obol</h3> Obol is a special purpose programming language for implementing security -protocols of the kind used in SSL, SSH and Kerberos. I have included an <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/obol/?cvsroot=crypticl">implementation of Obol</a> and the language runtime in the cvs repository. The implementation uses crypticl to implement the cryptographic core of the Obol runtime and illustrates how crypticl can be used by an application. +protocols of the kind used in SSL, SSH and Kerberos. I have included an <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/obol/?cvsroot=crypticl">implementation of Obol</a> and the language runtime in the CVS repository. The implementation uses Crypticl to implement the cryptographic core of the Obol runtime and illustrates how Crypticl can be used by an application. <h3>Download</h3> @@ -60,7 +60,7 @@ <div class="footer"> - Tåle Skogan 2. October 2005. + Taale Skogan 17. January 2007. </div> <div class="check">

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 17 Jan '07

17 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv29476/doc Modified Files: README ChangeLog Log Message: Removed email addresses (to reduce spam). --- /project/crypticl/cvsroot/crypticl/doc/README 2005/10/01 16:52:18 1.6 +++ /project/crypticl/cvsroot/crypticl/doc/README 2007/01/17 22:00:57 1.7 @@ -44,4 +44,4 @@ Frode V. Fjeld AUTHOR -Tåle Skogan tasko(a)frisurf.no \ No newline at end of file +Taale Skogan \ No newline at end of file --- /project/crypticl/cvsroot/crypticl/doc/ChangeLog 2005/10/01 19:13:36 1.14 +++ /project/crypticl/cvsroot/crypticl/doc/ChangeLog 2007/01/17 22:00:57 1.15 @@ -1,18 +1,24 @@ -01-10-2005 Taale Skogan<tasko(a)frisurf.no> +17-01-2007 Taale Skogan + Removed email addresses (spam). + +16-01-2007 Taale Skogan + Implemented SHA-256. + +01-10-2005 Taale Skogan * doc/html/index.html: releasing version 0.1. --------------------------------- TAG 0.1.1 ------------------------------- -01-10-2005 Taale Skogan<tasko(a)frisurf.no> +01-10-2005 Taale Skogan * doc/USERGUIDE: minor changes. * doc/README: minor layout changes. * src/common.lisp: make print-external-symbols work from top level of another package as intended. -07-11-2004 Taale Skogan<tasko(a)frisurf.no> +07-11-2004 Taale Skogan Updated front page with comment on MD5. MD5 will be removed. * doc/html/index.html -25-11-2004 Taale Skogan<tasko(a)frisurf.no> +25-11-2004 Taale Skogan Removed allegro specific excl: function. Still one left. Using aa instead of the norwegian character å in my name. Renamed various versions of TO DO: to To do: at the top of the files. @@ -23,35 +29,35 @@ * doc/README: updated with TODO entry. * doc/TODO: added file. -2004-11-24 Tage Stabell-Kulo <tage(a)tagehome.pasta.cs.uit.no> +2004-11-24 Tage Stabell-Kulo * src/sha1.lisp: Added more verbose printout. * src/aes.lisp: Changed variable S to Sbox and T to tmp. --------------------------------- TAG 0.1.0 ------------------------------- -24-11-2004 Taale Skogan<tasko(a)frisurf.no> +24-11-2004 Taale Skogan * doc/README: tag instructions. -23-11-2004 Taale Skogan<tasko(a)frisurf.no> +23-11-2004 Taale Skogan * doc/README: new install instructions. -15-11-2004 Taale Skogan<tasko(a)frisurf.no> +15-11-2004 Taale Skogan * src/crypticl-package.lisp: place load code in separate file. * src/load.lisp: load function. -14-11-2004 Taale Skogan<tasko(a)frisurf.no> +14-11-2004 Taale Skogan Minor modifications to get Obol runtime to load. -07-11-2004 Taale Skogan<tasko(a)frisurf.no> +07-11-2004 Taale Skogan Adding to USERGUIDE. -07-11-2004 Taale Skogan<tasko(a)frisurf.no> +07-11-2004 Taale Skogan Refactoring key generation. Put key generation code in each algorithm and make the algorithm resonsible for registering the interface. Put KeyStore in separate file. -06-11-2004 Taale Skogan<tasko(a)frisurf.no> +06-11-2004 Taale Skogan Cleaning up load. Completing renaming from CLC to Crypticl. * src/load.lisp: deleted. Functionality moved to crypticl-package.lisp. @@ -61,6 +67,6 @@ interface new-instance. * src/crypticl-package.lisp: Cleaning up load. -09-09-2004 Taale Skogan<tasko(a)frisurf.no> +09-09-2004 Taale Skogan Using max column 80. * doc/README: max column 80. \ No newline at end of file

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 17 Jan '07

17 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv29476/src Modified Files: utilities.lisp test.lisp rsa.lisp random.lisp numtheory.lisp md5.lisp load.lisp keystore.lisp keygenerator.lisp idea.lisp dsa.lisp diffie-hellman.lisp des.lisp crypticl-package.lisp common.lisp aes.lisp LICENSE Log Message: Removed email addresses (to reduce spam). --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/07 15:55:17 1.5 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/17 22:00:52 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Non-cryptopgrahic utilities -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/test.lisp 2007/01/16 23:46:06 1.5 +++ /project/crypticl/cvsroot/crypticl/src/test.lisp 2007/01/17 22:00:52 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Test code for the library. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. (in-package crypticl) --- /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2004/11/25 21:56:53 1.5 +++ /project/crypticl/cvsroot/crypticl/src/rsa.lisp 2007/01/17 22:00:52 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: RSA encryption/decryption according to PKCS#1 -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; References: --- /project/crypticl/cvsroot/crypticl/src/random.lisp 2004/11/25 21:56:52 1.3 +++ /project/crypticl/cvsroot/crypticl/src/random.lisp 2007/01/17 22:00:52 1.4 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Pseudo random number generation. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. --- /project/crypticl/cvsroot/crypticl/src/numtheory.lisp 2004/11/25 21:56:52 1.3 +++ /project/crypticl/cvsroot/crypticl/src/numtheory.lisp 2007/01/17 22:00:52 1.4 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Number theoretic utilities, including primality testing. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; References: --- /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/06 12:56:16 1.4 +++ /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/17 22:00:52 1.5 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: The RSA MD5 message digest algorithm from Internet RFC 1321. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;;; Credit: Low level code based on implementation by Mark Nahabedian with ;;;; enhancements by Tony Eng. --- /project/crypticl/cvsroot/crypticl/src/load.lisp 2004/11/25 21:56:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/load.lisp 2007/01/17 22:00:52 1.7 @@ -6,7 +6,7 @@ ;;;; Usage: Loading this file will load the rest of the library. ;;;; After loading you can list the public interface with ;;;; (crypticl:print-external-symbols) from the top-level. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/keystore.lisp 2004/11/25 21:56:52 1.3 +++ /project/crypticl/cvsroot/crypticl/src/keystore.lisp 2007/01/17 22:00:52 1.4 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Simple key store utility. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/keygenerator.lisp 2004/11/25 21:56:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/keygenerator.lisp 2007/01/17 22:00:52 1.7 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Interface for key generation. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/idea.lisp 2004/11/25 21:56:52 1.4 +++ /project/crypticl/cvsroot/crypticl/src/idea.lisp 2007/01/17 22:00:52 1.5 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: IDEA - International Data Encryption Algorithm -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; Based on the references [1] and [2]. --- /project/crypticl/cvsroot/crypticl/src/dsa.lisp 2004/11/25 21:56:52 1.6 +++ /project/crypticl/cvsroot/crypticl/src/dsa.lisp 2007/01/17 22:00:52 1.7 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: The Digital Signature Algorithm (DSA). -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; Implementation based on the Digital Signature Standard (DSS) ([1]). --- /project/crypticl/cvsroot/crypticl/src/diffie-hellman.lisp 2004/11/25 21:56:52 1.5 +++ /project/crypticl/cvsroot/crypticl/src/diffie-hellman.lisp 2007/01/17 22:00:52 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Diffie-Hellman -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. --- /project/crypticl/cvsroot/crypticl/src/des.lisp 2004/11/25 21:56:52 1.3 +++ /project/crypticl/cvsroot/crypticl/src/des.lisp 2007/01/17 22:00:52 1.4 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: A void DES implementation. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; DES has not been implemented, but a DES class and some --- /project/crypticl/cvsroot/crypticl/src/crypticl-package.lisp 2004/11/25 21:56:52 1.7 +++ /project/crypticl/cvsroot/crypticl/src/crypticl-package.lisp 2007/01/17 22:00:52 1.8 @@ -6,7 +6,7 @@ ;;;; Usage: Loading this file will load the rest of the library. ;;;; After loading you can list the public interface with ;;;; (crypticl:print-external-symbols) from the top-level. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/16 23:44:32 1.6 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/17 22:00:52 1.7 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: Common functionality. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;; To do: --- /project/crypticl/cvsroot/crypticl/src/aes.lisp 2004/11/25 21:56:51 1.5 +++ /project/crypticl/cvsroot/crypticl/src/aes.lisp 2007/01/17 22:00:52 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: AES -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;To do: --- /project/crypticl/cvsroot/crypticl/src/LICENSE 2004/09/20 19:13:36 1.1.1.1 +++ /project/crypticl/cvsroot/crypticl/src/LICENSE 2007/01/17 22:00:55 1.2 @@ -1,11 +1,11 @@ ###################################################################### ## -## Copyright (C) 2003 -## Tåle Skogan +## Copyright (C) 2003-2007 +## Taale Skogan ## ## Filename: LICENSE ## Description: Defines the terms under which this software may be copied. -## Author: Tåle Skogan, tasko(a)frisurf.no +## Author: Taale Skogan ## ###################################################################### Redistribution and use in source and binary forms, with or without

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 16 Jan '07

16 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv25835 Modified Files: TODO Log Message: updates --- /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/07 18:02:27 1.2 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/16 23:49:39 1.3 @@ -1,16 +1,15 @@ TODO list for Crypticl ====================== --Get high entropy seed for PRNG on windows +-Get high entropy seed for PRNG on Windows -Replace use of SHA-1 in PRNG with a block cipher (AES) in counter mode. -Study the Fortuna PRNG. -more example applications to test and improve the api -SHA-512? --CLOS version of SHA-256 --Cleanup test result output and refactor test code. Only run some test by default -so not to exhaust the Allegro heap. Document how to run the full test -set. Less verbose test output by default, only report "All Crypticl tests OK" -or similar on success. +-Cleanup test result output and refactor test code. Only run some test + by default so not to exhaust the Allegro heap. Document how to run the + full test set. Less verbose test output by default, only report "All +Crypticl tests OK" or similar on success. -Port to Allegro 8 (or higher) -Port to SBCL

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 16 Jan '07

16 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv25684 Modified Files: test.lisp Log Message: Add SHA-256 tests to load-tests. --- /project/crypticl/cvsroot/crypticl/src/test.lisp 2004/11/25 21:56:53 1.4 +++ /project/crypticl/cvsroot/crypticl/src/test.lisp 2007/01/16 23:46:06 1.5 @@ -53,6 +53,8 @@ (test-AES) (test-RSA) (test-IDEA) - (test-DSA)) + (test-DSA) + (test-SHA-256) + (format t "~&All Crypticl load-time tests successful!")) (run-tests) \ No newline at end of file

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 16 Jan '07

16 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv25650 Modified Files: sha.lisp Log Message: Fix comment (update, not add). --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/07 00:44:12 1.6 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/16 23:45:21 1.7 @@ -273,7 +273,7 @@ (defmethod store-state ((obj SHA1) octet-vector offset end octet-count) - "Store state between calls to add" + "Store state between calls to update." (let ((leftover-offset (leftover-count obj)) (octets-left (- end offset)))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 16 Jan '07

16 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv25483 Modified Files: common.lisp Log Message: Comment on the implementation dependent nature of byte-code. --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/06 12:42:11 1.5 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/16 23:44:32 1.6 @@ -131,6 +131,7 @@ (end (length string))) (flet ((string-reader () (if (< i end) + ;;XXX Can return more than a 8 bit value with Unicode strings (prog1 (char-code (aref string i)) ;return this (incf i)) ;Can't use 1+ nil)))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 16 Jan '07

16 Jan '07

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@A pos ~2@A next ~2@A end ~2@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

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 16 Jan '07

16 Jan '07

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

1 0

[crypticl-cvs] CVS crypticl/doc
by tskogan 07 Jan '07

07 Jan '07

Update of /project/crypticl/cvsroot/crypticl/doc In directory clnet:/tmp/cvs-serv28233 Modified Files: TODO Log Message: updated --- /project/crypticl/cvsroot/crypticl/doc/TODO 2004/11/25 21:59:05 1.1 +++ /project/crypticl/cvsroot/crypticl/doc/TODO 2007/01/07 18:02:27 1.2 @@ -1,7 +1,16 @@ TODO list for Crypticl ====================== --random numbers on windows --applications --sha256, sha512 +-Get high entropy seed for PRNG on windows +-Replace use of SHA-1 in PRNG with a block cipher (AES) in counter mode. +-Study the Fortuna PRNG. +-more example applications to test and improve the api +-SHA-512? +-CLOS version of SHA-256 +-Cleanup test result output and refactor test code. Only run some test by default +so not to exhaust the Allegro heap. Document how to run the full test +set. Less verbose test output by default, only report "All Crypticl tests OK" +or similar on success. +-Port to Allegro 8 (or higher) +-Port to SBCL

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 07 Jan '07

07 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv3801 Modified Files: utilities.lisp sha256.lisp Log Message: Added test code for the SHAVS tests. They run successfully. --- /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/07 00:45:33 1.4 +++ /project/crypticl/cvsroot/crypticl/src/utilities.lisp 2007/01/07 15:55:17 1.5 @@ -203,4 +203,13 @@ (do ((i 0 (1+ i))) ((>= i (length v1)) t) (unless (equal (aref v1 i) (aref v2 i)) - (return nil))))) \ No newline at end of file + (return nil))))) + + +(defun string-startswith (s prefix) + "Return true if the string s starts with the given prefix" + (let ((len (length prefix))) + (if (> len (length s)) + nil ; prefix longer than string + (string= s prefix :end1 len)))) + --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/07 00:45:33 1.3 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/07 15:55:17 1.4 @@ -6,9 +6,14 @@ ;;;; Distribution: See the accompanying file LICENSE. -;;; Based on the reference [1] +;;; Based on reference [1] from http://csrc.nist.gov/cryptval/shs.htm +;;; (live 07.01.2007). ;;; -;;; [1] FIPS 180-2 "Secure Hash Standard" +;;; [1] NIST. 2002. Secure Hash Standard. FIPS PUB 180-2, +;;; http://csrc.nist.gov/publications/fips/fips180-2/ +;;; fips180-2withchangenotice.pdf. +;;; [2] Lawrence E. Bassham III. 2004. The Secure Hash Algorithm +;;; Validation System (SHAVS). (in-package crypticl) @@ -53,9 +58,8 @@ ;;; words, which are represented as x, y, and z. The result of each function ;;; is a new 32-bit word. ;;; -;;; Note on the notation in the docstrings: -;;; not is a bitwise not operation, also referred to as the complement -;;; operation. +;;; 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) "(x and y) xor (not x and z)" (logxor (logand x y) @@ -92,9 +96,8 @@ (ash x -10))) - (defun sha-256-encode (buffer-filler) - "Main non-CLOS function. Encodes 512 bits blocks until done." + "Compute SHA-256 hash." (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) @@ -195,8 +198,16 @@ (make-buffer-filler (make-string-reader-function string)))) +(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)))) + +;;;; ;;;; tests +;;;; (defun test-sha-256 () "Test vector 1 and 2 are taken from reference FIPS 180-2." (let ((test-list @@ -221,4 +232,78 @@ (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 + (format t "Long messages OK.~%")) + + +;;; Official test vectors from The Secure Hash Algorithm Validation System +;;; (SHAVS) (reference [2]. +(defun shavs (stream) + (parse-shavs-lines + (loop for line = (read-line stream nil 'eof) + until (eq line 'eof) + collect line)) + (format t "SHAVS tests OK")) + +(defun parse-shavs-lines (lines) + "Parse the SHAVS file format. + +file format: +Len = 0 +Msg = 00 +MD = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 + +Len = 8 +Msg = bd +MD = 68325720aabd7c82f30f554b313d0570c95accbb7dc4b5aae11204c08ffe732b +" + (let ((state 'read-more) + (count 0) + len + msg + md) + (dolist (line lines) + (cond + ((string-startswith line "Len") + (setf len (parse-integer line :start 6))) + ((string-startswith line "Msg") + (setf msg (subseq line 6))) + ((string-startswith line "MD") + (setf md (subseq line 5) + state 'run-sha)) + (t + (setf state 'read-more))) + + (case state + ;; continue reading + (read-more nil) + ;; we have a new test vector + (run-sha (shavs-256 len msg md) + (incf count) + (setf state 'read-more + len nil + msg nil + md nil)) + )) + + (format t "Tested ~D test vectors~%" count) + )) + + +(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))) + + +(defun run-shavs (&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

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 07 Jan '07

07 Jan '07

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

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 07 Jan '07

07 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv10354 Modified Files: sha.lisp Log Message: Reformat comments. Add optional debug function to state machine. --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/06 12:56:16 1.5 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/07 00:44:12 1.6 @@ -2,7 +2,7 @@ ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: The SHA-1 message digest algorithm. -;;;; Author: Taale Skogan <tasko(a)frisurf.no> +;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. @@ -13,14 +13,13 @@ ;;; [1] FIPS 180-2 "Secure Hash Standard" ;;; [2] Schneier,B. 1996. "Applied Cryptography" -;;To do: +;;TODO: ;; -repeating code in sha1-round and sha1-encode (difficult because of objects) - (in-package crypticl) (defmacro initialize-sha1-state (a b c d e) - "Initializes the state of the hash algorithm" + "Initializes the state of the hash algorithm." `(setf ,a #x67452301 ,b #xefcdab89 ,c #x98badcfe @@ -28,7 +27,11 @@ ,e #xc3d2e1f0)) (defmacro sha1-make-octet-vector (a b c d e) - "Make byte-vector from 5 32 bits integers. Note that SHA-1 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" + "Make byte-vector from 5 32 bits integers. + +Note that SHA-1 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) @@ -43,12 +46,13 @@ (defun sha1-length64 (message-length-in-bits) - "Returns input integer message-length-in-bits as two 32-bit words, high order bits first" + "Returns input integer as two 32-bit words, high order bits first." (values (ldb (byte 32 32) message-length-in-bits) (ldb (byte 32 0) message-length-in-bits))) (defun new-sha1-length64 (mess-len octet-vector start) - "Returns octet-vector after the interger mess-len has been encoded as eight bytes, high order bits first, starting at start" + "Returns octet-vector after the interger mess-len has been encoded as eight +bytes, high order bits first, starting at start." (do ((char 56 (- char 8))) ((> 0 char) octet-vector) @@ -73,23 +77,42 @@ (defun make-buffer-filler (reader-function &optional (octet-count 0)) "Returns buffer-filler function for use as argument to sha1-encode. + The buffer-filler fills a buffer with 16 32 bits words and returns true if there is more data. It returns nil if all data including padding and data length has been returned. Note that MD5 and SHA-1 uses the same padding scheme. -The buffer-filler is a state-machine with four states. :done, :data, :length and :zeropad. The initial state is :data. When there is no more data, #x80 is returned and the new state is either :write-length (if current word is 13 and current byte is 3) else :zeropad. If we enter :write-length we write the length in the last two 32 bit words and enter :done. In state :zeropad we write zeros until we reach word 13 and byte 3 and then enter :write-length. When we reach the :done state, the next call will return nil." +The buffer-filler is a state-machine with the four states +:data +:done +:length +:zeropad + +The initial state is :data. When there is no more data, #x80 is returned +and the new state is either :write-length (if current word is 13 and +current byte is 3) else :zeropad. If we enter :write-length we write the +length in the last two 32 bit words and enter :done. In state :zeropad we +write zeros until we reach word 13 and byte 3 and then enter :write-length. +When we reach the :done state, the next call will return nil." (let ((state :data) - (byte-count octet-count) ;counts number of bytes read + (byte-count octet-count) ;counts number of bytes read (byte-num -1)) ;0,1,2 or 3 afterwards (flet ((buffer-filler (buffer) (dotimes (word 16 t) ;16*32 = 512 - (flet ((gb () ;helper to get the next byte + (flet ( + (gb () ;helper to get the next byte + (flet ((db () + ;; (format t "state ~A word ~D ~%" state word) + nil)) (setf byte-num (mod (1+ byte-num) 4)) (ecase state - (:done (return-from buffer-filler nil)) + (:done + (db) + (return-from buffer-filler nil)) (:data + (db) (let ((a-byte (funcall reader-function))) (cond (a-byte @@ -99,17 +122,19 @@ (setf state :write-length) #x80) (t (setf state :zeropad) #x80)))) (:zeropad + (db) (if (and (= word 13) (= byte-num 3)) (setf state :write-length)) 0) (:write-length + (db) (multiple-value-bind (hi low) (sha1-length64 (* 8 byte-count)) (setf (aref buffer 14) hi) ;opposite order of MD5 (setf (aref buffer 15) low);opposite order of MD5 (setf state :done) - (return-from buffer-filler t)))))) + (return-from buffer-filler t))))))) ;;Get a word. Note that again the order is the opposite of MD5 (let ((b3 (gb))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 06 Jan '07

06 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv24715 Modified Files: sha256.lisp Log Message: The six logical functions. --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/06 12:58:08 1.1 +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/06 13:46:37 1.2 @@ -50,6 +50,33 @@ ;;; SHA-256 uses six logical functions, where each function operates on 32-bit ;;; 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: +;;; not is a bitwise not operation, also referred to as the complement +;;; operation. +(defun ch-256 (x y z) + "(x and y) xor (not x and z)" + (logxor (logand x y) + (logand (lognot x) z))) + +(defun maj-256 (x y z) + "(x and y) xor (x and z) xor (y and z)" + (logxor (logand x y) + (logand x z) + (logand y z))) + +(defun sum-0 (x) + "ROTR 2(x) xor ROTR 13(x) xor ROTR 22(x)" + (logxor (right-rot-32 x 2) + (right-rot-32 x 13) + (right-rot-32 x 22))) + +(defun sum-1 (x) + "ROTR 6(x) xor ROTR 11(x) xor ROTR 25(x)" + (logxor (right-rot-32 x 6) + (right-rot-32 x 11) + (right-rot-32 x 25))) + (defun sigma-0 (x) "ROTR 7(x) xor ROTR 18(x) xor SHR 3(x)" (logxor (right-rot-32 x 7)

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 06 Jan '07

06 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv8087 Added Files: sha256.lisp Log Message: Starting SHA-256. --- /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/06 12:58:08 NONE +++ /project/crypticl/cvsroot/crypticl/src/sha256.lisp 2007/01/06 12:58:08 1.1 ;;;;-*-lisp-*- ;;;; The Crypticl cryptographic library. ;;;; ;;;; Description: The SHA-256 hash algorithm ;;;; Author: Taale Skogan ;;;; Distribution: See the accompanying file LICENSE. ;;; Based on the reference [1] ;;; ;;; [1] FIPS 180-2 "Secure Hash Standard" (in-package crypticl) ;;; SHA-256 Constants ;;; SHA-256 uses a sequence of sixty-four constant 32-bit words (defvar *sha256-constants* (make-array 64 :element-type '(unsigned-byte 32) :initial-contents '(#x428a2f98 #x71374491 #xb5c0fbcf #xe9b5dba5 #x3956c25b #x59f111f1 #x923f82a4 #xab1c5ed5 #xd807aa98 #x12835b01 #x243185be #x550c7dc3 #x72be5d74 #x80deb1fe #x9bdc06a7 #xc19bf174 #xe49b69c1 #xefbe4786 #x0fc19dc6 #x240ca1cc #x2de92c6f #x4a7484aa #x5cb0a9dc #x76f988da #x983e5152 #xa831c66d #xb00327c8 #xbf597fc7 #xc6e00bf3 #xd5a79147 #x06ca6351 #x14292967 #x27b70a85 #x2e1b2138 #x4d2c6dfc #x53380d13 #x650a7354 #x766a0abb #x81c2c92e #x92722c85 #xa2bfe8a1 #xa81a664b #xc24b8b70 #xc76c51a3 #xd192e819 #xd6990624 #xf40e3585 #x106aa070 #x19a4c116 #x1e376c08 #x2748774c #x34b0bcb5 #x391c0cb3 #x4ed8aa4a #x5b9cca4f #x682e6ff3 #x748f82ee #x78a5636f #x84c87814 #x8cc70208 #x90befffa #xa4506ceb #xbef9a3f7 #xc67178f2))) (defmacro initial-sha256-hash-value (a b c d e f g h) "Initializes the state of the hash algorithm" `(setf ,a #x6a09e667 ,b #xbb67ae85 ,c #x3c6ef372 ,d #xa54ff53a ,e #x510e527f ,f #x9b05688c ,g #x1f83d9ab ,h #x5be0cd19)) ;;; SHA-256 uses six logical functions, where each function operates on 32-bit ;;; words, which are represented as x, y, and z. The result of each function ;;; is a new 32-bit word. (defun sigma-0 (x) "ROTR 7(x) xor ROTR 18(x) xor SHR 3(x)" (logxor (right-rot-32 x 7) (right-rot-32 x 18) (ash x -3))) (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) (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))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 06 Jan '07

06 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv7923 Modified Files: sha.lisp md5.lisp Log Message: Renamed rotation function in preparation for SHA-256. --- /project/crypticl/cvsroot/crypticl/src/sha.lisp 2004/11/25 21:56:53 1.4 +++ /project/crypticl/cvsroot/crypticl/src/sha.lisp 2007/01/06 12:56:16 1.5 @@ -134,7 +134,7 @@ (setf (aref w i) (aref m i) ) ) (dotimes (i 64 t) (setf (aref w (+ i 16)) - (32-left-rot (logxor (aref w (+ i 13)) (aref w (+ i 8)) + (left-rot-32 (logxor (aref w (+ i 13)) (aref w (+ i 8)) (aref w (+ i 2)) (aref w (+ i ))) 1) )) w)) @@ -144,14 +144,14 @@ (let ((w (sha1-expand x)) (temp)) (macrolet ((sha-round (sha-function w-offset constant) - `(setf temp (32-add (32-left-rot a 5) + `(setf temp (32-add (left-rot-32 a 5) (,sha-function b c d) e (aref w (+ i ,w-offset)) ,constant) e d d c - c (32-left-rot b 30 ) + c (left-rot-32 b 30 ) b a a temp))) --- /project/crypticl/cvsroot/crypticl/src/md5.lisp 2004/11/25 21:56:52 1.3 +++ /project/crypticl/cvsroot/crypticl/src/md5.lisp 2007/01/06 12:56:16 1.4 @@ -107,7 +107,7 @@ (defmacro md5-function-ffgghhii (a b c d X k s i fghi) `(setf ,a (32-add ,b - (32-left-rot (32-add (32-add ,a + (left-rot-32 (32-add (32-add ,a (,fghi ,b ,c ,d)) (32-add (aref ,X ,k) ,(aref *random-sine-table* (1- i))))

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 06 Jan '07

06 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv7127 Added Files: .cvsignore Log Message: Ignore *.fasl files. --- /project/crypticl/cvsroot/crypticl/src/.cvsignore 2007/01/06 12:49:09 NONE +++ /project/crypticl/cvsroot/crypticl/src/.cvsignore 2007/01/06 12:49:09 1.1 *.fasl

1 0

[crypticl-cvs] CVS crypticl/src
by tskogan 06 Jan '07

06 Jan '07

Update of /project/crypticl/cvsroot/crypticl/src In directory clnet:/tmp/cvs-serv6364 Modified Files: common.lisp Log Message: Adding utils needed by SHA-256. --- /project/crypticl/cvsroot/crypticl/src/common.lisp 2005/10/01 16:34:44 1.4 +++ /project/crypticl/cvsroot/crypticl/src/common.lisp 2007/01/06 12:42:11 1.5 @@ -104,14 +104,22 @@ (ldb (byte 32 0) (reduce #'+ args))) -(defun 32-left-rot (a by) +(defun left-rot-32 (a by) "Left rotation modulo 32. If number longer than 32 bits, ignore extra bits." - (let ((break (- 32 by))) - (dpb (ldb (byte break 0) a) - (byte break by) - (ldb (byte by break) - a)))) - + (let ((pivot (- 32 by))) + (dpb (ldb (byte pivot 0) a) + (byte pivot by) + (ldb (byte by pivot) a)))) + +(defun right-rot-32 (a by) + "Right rotation modulo 32. If number longer than 32 bits, ignore extra bits. + +1) Shift the (32 - by) left bits to the right by places +2) Shift the right by bits all over to the left. +" + (let ((leftpart (- 32 by))) + (+ (ash a (- by)) + (ash (ldb (byte by 0) a) leftpart)))) (defun make-string-reader-function (string) "Return a function that reads one byte at a time from a string or nil

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

crypticl-cvs January 2007