First commit of simple Fortuna implementation. Not yet fully debugged…

…, nor ready to be relied upon

.gitignore

@@ -14,4 +14,4 @@
 *.fx64fsl
 *.fas
 *.lib
-
+*~

ironclad.asd

@@ -32,7 +32,7 @@
   :maintainer "Nathan Froyd <froydnj@gmail.com>"
   :description "A cryptographic toolkit written in pure Common Lisp"
   :default-component-class ironclad-source-file
-  #+sbcl :depends-on #+sbcl (sb-rotate-byte)
+  #+sbcl :depends-on #+sbcl (sb-rotate-byte sb-posix)
   :components ((:static-file "README")
                (:static-file "LICENSE")
                (:static-file "TODO")
@@ -117,7 +117,14 @@
                                   :components
                                   ((:file "public-key")
                                    (:file "dsa" :depends-on ("public-key"))
-                                   (:file "rsa" :depends-on ("public-key"))))))
+                                   (:file "rsa" :depends-on ("public-key"))))
+			 (:module "prng"
+				  :depends-on ("digests" "ciphers")
+				  :components
+				  ((:file "prng")
+				   (:file "fortuna" :depends-on ("prng"
+								 "generator"))
+				   (:file "generator")))))
                (:module "doc"
                         :components
                         ((:html-file "ironclad")
@@ -197,7 +204,7 @@
 
 (asdf:defsystem ironclad-tests
   :depends-on (ironclad)
-  :version "0.5"
+  :version "0.6"
   :in-order-to ((test-op (load-op :ironclad-tests)))
   :components ((:module "testing"
                         :components
@@ -213,6 +220,7 @@
                                    (:file "padding")
                                    (:file "pkcs5")
                                    (:file "ironclad")
+				   (:file "prng")
                                    ;; test vectors
                                    (:test-vector-file "crc24")
                                    (:test-vector-file "crc32")

src/package.lisp

@@ -48,6 +48,11 @@
    #:dsa-key-p #:dsa-key-q #:dsa-key-g #:dsa-key-y #:dsa-key-x
    #:dsa-signature-r #:dsa-signature-s
 
+   ;; pseudo-random number generators
+   #:pseudo-random-number-generator #:list-all-prngs #:make-prng #:random-data
+   #:read-os-random-seed #:read-seed #:write-seed #:fortuna-prng
+   #:add-random-event
+
    ;; conditions
    #:ironclad-error #:initialization-vector-not-supplied
    #:invalid-initialization-vector #:invalid-key-length

src/prng/fortuna.lisp

@@ -0,0 +1,123 @@
+;;;; fortuna.lisp -- Fortuna PRNG
+
+(in-package :crypto)
+
+
+(defparameter +min-pool-size+
+  128
+  "Minimum pool size before a reseed is allowed.  This should be the
+  number of bytes of pool data that are likely to contain 128 bits of
+  entropy.  Defaults to a pessimistic estimate of 1 bit of entropy per
+  byte.")
+
+(defclass pool ()
+  ((digest :initform (ironclad:make-digest :sha256))
+   (length :initform 0))
+  (:documentation "A Fortuna entropy pool.  DIGEST contains its current
+  state; LENGTH the length in bytes of the entropy it contains."))
+
+(defclass fortuna-prng (pseudo-random-number-generator)
+  ((pools :initform (loop for i from 1 to 32
+		       collect (make-instance 'pool)))
+   (reseed-count :initform 0)
+   (last-reseed :initform 0)
+   (generator :initform (make-instance 'generator)))
+  (:documentation "A Fortuna random number generator.  Contains 32
+  entropy pools which are used to reseed GENERATOR."))
+
+(defmethod random-data ((pseudo-random-number-generator
+			 fortuna-prng)
+			num-bytes)
+  (when (plusp num-bytes)
+    (with-slots (pools generator reseed-count last-reseed)
+	pseudo-random-number-generator
+      (when (and (>= (slot-value (first pools) 'length) +min-pool-size+)
+		 (> (- (get-internal-run-time) last-reseed) 100))
+	(incf reseed-count)
+	(loop for i from 0 below (length pools)
+	   while (zerop (mod reseed-count (expt 2 i)))
+	   collect (with-slots (digest length) (nth i pools)
+		     (setf length 0)
+		     (ironclad:produce-digest digest))  into seed
+	   finally (reseed generator (apply #'concatenate
+					    '(vector (unsigned-byte 8)) seed))))
+      (assert (plusp reseed-count))
+      (pseudo-random-data generator num-bytes))))
+
+
+(defun add-random-event (pseudo-random-number-generator source pool-id event)
+  (assert (and (<= 1 (length event) 32)
+	       (<= 0 source 255)
+	       (<= 0 pool-id 31)))
+  (let ((pool (nth pool-id (slot-value pseudo-random-number-generator 'pools))))
+    (ironclad:update-digest (slot-value pool 'digest)
+			    (concatenate '(vector (unsigned-byte 8))
+					 (ironclad:integer-to-octets source)
+					 (ironclad:integer-to-octets
+					  (length event))
+					 event))
+    (incf (slot-value pool 'length) (length event))))
+
+
+(defun strong-random (limit pseudo-random-number-generator)
+  "Return a strong random number from 0 to limit-1 inclusive"
+  (let* ((log-limit (log limit 2))
+	 (num-bytes (ceiling log-limit 8))
+	 (mask (1- (expt 2 (ceiling log-limit)))))
+    (loop for random = (logand (ironclad:octets-to-integer
+				(random-data pseudo-random-number-generator
+					     num-bytes))
+			       mask)
+       until (< random limit)
+       finally (return random))))
+
+
+(defun random-bits (pseudo-random-number-generator num-bits)
+  (logand (1- (expt 2 num-bits))
+	  (ironclad:octets-to-integer
+	   (random-data pseudo-random-number-generator (ceiling num-bits 8)))))
+
+
+(defmethod write-seed ((pseudo-random-number-generator fortuna-prng) path)
+  (with-open-file (seed-file path
+			     :direction :output
+			     :if-exists :supersede
+			     :if-does-not-exist :create
+			     :element-type '(unsigned-byte 8))
+    (write-sequence (random-data pseudo-random-number-generator 64) seed-file)))
+
+
+(defmethod read-os-random-seed ((pseudo-random-number-generator fortuna-prng)
+			    &optional (source :random))
+  "Read a random seed from /dev/random or equivalent."
+  (reseed (slot-value pseudo-random-number-generator 'generator)
+	  (os-random-seed source 64)))
+
+
+(defmethod internal-read-seed ((pseudo-random-number-generator fortuna-prng)
+			       path)
+  (with-open-file (seed-file path
+			     :direction :input
+			     :element-type '(unsigned-byte 8))
+    (let ((seq (make-array 64 :element-type '(unsigned-byte 8))))
+      (assert (>= (read-sequence seq seed-file) 64))
+      (reseed (slot-value pseudo-random-number-generator 'generator) seq)
+      (incf (slot-value pseudo-random-number-generator 'reseed-count ))))
+  (write-seed pseudo-random-number-generator path))
+
+
+(defun feed-fifo (pseudo-random-number-generator path)
+  "Feed random data into a FIFO"
+  (loop while
+       (handler-case (with-open-file 
+			 (fortune-out path :direction :output
+				      :if-exists :overwrite
+				      :element-type '(unsigned-byte 8))
+		       (loop do (write-sequence
+				 (random-data pseudo-random-number-generator
+						      (1- (expt 2 20)))
+				 fortune-out)))
+	 (stream-error () t))))
+
+
+

src/prng/generator.lisp

@@ -0,0 +1,59 @@
+;;;; generator.lisp -- Fortuna PRNG generator
+
+(in-package :crypto)
+
+
+
+;; FIXME: should this be moved into digests?
+(defun shad-256 (octets)
+  (ironclad:digest-sequence :sha256 (ironclad:digest-sequence :sha256 octets)))
+
+(defclass generator ()
+  ((key
+    :initform (coerce #(0 0 0 0
+			0 0 0 0
+			0 0 0 0
+			0 0 0 0)
+		      '(vector (unsigned-byte 8))))
+   (counter :initform 0)
+   (cipher-name :initform :aes :initarg :cipher-name)
+   (cipher :initform nil))
+  (:documentation "Fortuna generator.  KEY is the key used to initialise
+  CIPHER as an instance of CIPHER-NAME (which must be a valid NAME
+  recognised by MAKE-CIPHER, along with +IV-CONSTANT."))
+
+
+(defun reseed (generator seed)
+  (with-slots (key counter cipher cipher-name) generator
+    (setf key
+	  (shad-256
+	   (concatenate '(vector (unsigned-byte 8)) key seed)))
+    (incf counter)
+    (setf cipher
+	  (make-cipher cipher-name :key key :mode :ecb))))
+
+
+(defun generate-blocks (generator num-blocks)
+  "Internal use only"
+  (with-slots (cipher key counter) generator
+    (assert (and cipher
+		 (plusp counter)))
+    (loop for i from 1 to num-blocks
+       collect (let ((block (integer-to-octets counter
+					       :n-bits 128
+					       :big-endian nil)))
+		      (encrypt-in-place cipher block)
+		      block)
+       into blocks
+       do (incf counter)
+       finally (return (apply #'concatenate 'simple-octet-vector blocks)))))
+
+
+(defun pseudo-random-data (generator num-bytes)
+  (assert (< 0 num-bytes (expt 2 20)))
+  (let* ((output (subseq (generate-blocks generator (ceiling num-bytes 16))
+			 0
+			 num-bytes))
+	 (key (generate-blocks generator 2)))
+    (setf (slot-value generator 'key) key)
+    output))

src/prng/prng.lisp

@@ -0,0 +1,74 @@
+;;;; prng.lisp -- common functions for pseudo-random number generators
+
+(in-package :crypto)
+
+
+(defclass pseudo-random-number-generator ()
+  ()
+  (:documentation "A pseudo random number generator.  Base class for
+  other PRNGs; not intended to be instantiated."))
+
+(defun list-all-prngs ()
+  '(fortuna))
+
+(defgeneric make-prng (name &key seed)
+  (:documentation "Create a new NAME-type random number generator,
+  seeding it from SEED.  If SEED is a pathname or namestring, read data
+  from the indicated file; if it is sequence of bytes, use those bytes
+  directly; if it is :RANDOM then read from /dev/random; if it
+  is :URANDOM then read from /dev/urandom; if it is NIl then the
+  generator is not seeded."))
+
+(defmethod make-prng :around (name &key (seed :random))
+  (let ((prng (call-next-method)))
+    (cond
+      ((eq seed nil))
+      ((find seed '(:random :urandom)) (read-os-random-seed prng seed))
+      ((or (pathnamep seed) (stringp seed)) (read-seed prng seed))
+      ((typep seed 'simple-octet-vector)
+       (reseed (slot-value prng 'generator) seed)
+       (incf (slot-value prng 'reseed-count)))
+      (t (error "SEED must be an octet vector, pathname indicator, :random or :urandom")))
+    prng))
+
+(defmethod make-prng ((name (eql :fortuna)) &key seed)
+  (make-instance 'fortuna-prng))
+
+(defgeneric random-data (pseudo-random-number-generator num-bytes)
+  (:documentation "Generate NUM-BYTES bytes using
+  PSEUDO-RANDOM-NUMBER-GENERATOR"))
+
+(defun os-random-seed (source num-bytes)
+  #+unix(let ((path (cond
+		      ((eq source :random) #P"/dev/random")
+		      ((eq source :urandom) #P"/dev/urandom")
+		      (t (error "Source must be either :random or :urandom"))))
+	      (seq (make-array num-bytes :element-type '(unsigned-byte 8))))
+	  (with-open-file (seed-file path :element-type '(unsigned-byte 8))
+	    (assert (>= (read-sequence seq seed-file) num-bytes))
+	    seq))
+  ;; FIXME: this is _untested_!
+  #+(and win32 sb-dynamic-core)(sb!win32:crypt-gen-random num-bytes)
+  #-(or unix (and win32 sb-dynamic-core))(error "OS-RANDOM-SEED is not supported on your platform."))
+
+(defgeneric read-os-random-seed (prng &optional source)
+  (:documentation "(Re)seed PRNG from PATH."))
+
+(defun read-seed (pseudo-random-number-generator path)
+  "Reseed PSEUDO-RANDOM-NUMBER-GENERATOR from PATH.  If PATH doesn't
+exist, reseed from /dev/random and then write that seed to PATH."
+  (if (probe-file path)
+      (internal-read-seed pseudo-random-number-generator path)
+      (progn
+	(read-os-random-seed pseudo-random-number-generator)
+	(write-seed pseudo-random-number-generator path)
+	;; FIXME: this only works under SBCL.  It's important, though,
+	;; as it sets the proper permissions for reading a seedfile.
+	#+sbcl(sb-posix:chmod path (logior sb-posix:S-IRUSR sb-posix:S-IWUSR)))))
+
+(defgeneric internal-read-seed (prng path)
+  (:documentation "Reseed PRNG from PATH.."))
+
+(defgeneric write-seed (prng path)
+  (:documentation "Write enough random data from PRNG to PATH to
+  properly reseed it."))

testing/test-vectors/prng.lisp

@@ -0,0 +1,5 @@
+(in-package :crypto-tests)
+
+(rtest:deftest :prng-fortuna (run-test-vector-file :prng *prng-tests*) t)
+
+;;    (random-data (make-prng :fortuna :seed (coerce #(0) 'simple-octet-vector)) 1) #(28))

testing/test-vectors/prng.testvec

@@ -0,0 +1,16 @@
+;; each test is written by reasoning from the definition in Cryptography
+;; Engineering, _not_ by checking what the implementation currently does
+
+(:generator-test :aes
+		 (#(0 1 2 3))
+		 (#(137 205 83 241 66 231 102 41 140 77 103 232 6 233 4 112)
+		   #(137 168 106 238 93 35 73 66 123 59 154 60 252 2 145 225)
+		   #(163 142 31 183 14 54 61 146 214 4 250 9 255 208 95 46)
+		   #(219 216 11 79 52 240 144 101 7 227 126 75 192 108 72 104)))
+
+;; this test was written by taking current behaviour
+(:fortuna-test #(0 1 2 3)
+	       ((0 0 #(0 0 0 0)))
+	       #(137 205 83 241 66 231 102 41 140 77 103
+		 232 6 233 4 112 137 168 106 238 93 35 73
+		 66 123 59 154 60 252 2 145 225 163 142 31 183))

testing/testfuns.lisp

@@ -220,3 +220,33 @@
 (defparameter *mac-tests*
   (list (cons :hmac-test #'hmac-test)
         (cons :cmac-test #'cmac-test)))
+
+
+;;; PRNG testing routines
+(defun fortuna-test (name seed entropy expected-sequence)
+  (let ((prng (crypto:make-prng :fortuna
+				:seed (coerce seed 'crypto::simple-octet-vector)))
+	(num-bytes (length expected-sequence)))
+    (loop for (source pool-id event) in entropy
+       do (crypto:add-random-event prng source pool-id event))
+    (equalp expected-sequence
+	    (crypto:random-data prng num-bytes))))
+
+
+(defun generator-test (name cipher seeds expected-sequences)
+  (declare (ignore name))
+  (let ((generator (make-instance 'crypto::generator :cipher-name cipher)))
+    (loop for seed in seeds
+       do (crypto::reseed generator seed))
+    (every (lambda (sequence)
+	     (assert (zerop (mod (length sequence) 16)))
+	     (equalp sequence
+		     (crypto::generate-blocks generator
+					      (/ (length sequence) 16))))
+	   expected-sequences)))
+
+
+(defparameter *prng-tests*
+  `((:fortuna-test . ,#'fortuna-test)
+    (:generator-test . ,#'generator-test)))
+