Merge pull request #27 from howeyc/scrypt

Add scrypt key derivation.

doc/ironclad-doc.txt

@@ -425,23 +425,36 @@ passed to " @make-hmac " when " 'hmac' " was constructed.")
 @insufficient-buffer-space " error will be signaled if there is
 insufficient space in " 'buffer' ".")
 
-(:h3 "PBKDF")
+((:h2 id "kdfs") "Key derivation functions")
 
-(:p "Ironclad comes with the basic PBKDF1 and PBKDF2 algorithms, as
-well as convenience functions for using them to store passwords.")
+(:p "Ironclad comes with the basic PBKDF1 and PBKDF2 algorithms, as well as
+an implementation of the scrypt key derivation function as defined by 
+Colin Percival's " (:url
+"http://www.tarsnap.com/scrypt.html"
+"The scrypt key derivation function."))
 
 (:describe :function (ironclad:derive-key digest))
 
-(:p "Given a key derivation function object (produced by " `make-kdf`
-"), a password and salt (both must be of type " `(SIMPLE-ARRAY
+(:p "Given a key derivation function object (produced by " `make-kdf` "),
+ a password and salt (both must be of type " `(SIMPLE-ARRAY
 (UNSIGNED-BYTE 8) (*))` "), and number of digest iterations, returns
 the password digest as a byte array of length " 'key-length' ".")
 
-(:describe :function (ironclad:make-kdf kind))
+(:p "Scrypt ignores " 'iteration-count' " parameter.")
+
+(:describe :function (ironclad:make-kdf kdf))
 
 (:p "Returns a key derivation function instance (" 'kind' " must
-either be " 'pbkdf1' " or " 'pbkdf2' ") that uses the given "
-'digest' ".")
+either be " 'pbkdf1' ", " 'pbkdf2' " or " 'scrypt-kdf' "). The PBKDF
+algorithms use " 'digest' ". The scrypt key derivation uses cost parameters "
+'N' ", " 'r' " and " 'p' " (" 'N' " is a CPU cost parameter that must be a 
+power of 2, " 'r' " and " 'p' " are memory cost parameters that must be defined
+such that " 'r' " * " 'p' " <= 2^30.)")
+
+(:h3 "PBKDF Convenience functions")
+
+(:p "Ironclad comes with well as convenience functions for using 
+ PBKDF1 and PBKDF2 to store passwords.")
 
 (:describe :function (ironclad:pbkdf2-hash-password password))
 
@@ -461,6 +474,8 @@ that encodes the given salt and PBKDF2 algorithm parameters.")
 produced by " `pbkdf2-hash-password-to-combined-string` ", checks whether
 the password is valid.")
 
+(:p "Returns an scrypt key derivation function instance.")
+
 (:h3 "CMACs")
 
 (:p "Instances of CMACs are constructed by specifying a secret key and a

ironclad.asd

@@ -48,7 +48,9 @@
                          #+(or lispworks sbcl openmcl cmu allegro)
                          (:file "octet-stream" :depends-on ("common"))
                          (:file "padding" :depends-on ("common"))
-                         (:file "pkcs5" :depends-on ("common"))
+                         (:file "kdf-common" :depends-on ("package"))
+                         (:file "pkcs5" :depends-on ("common" "kdf-common"))
+                         (:file "scrypt" :depends-on ("kdf-common" "pkcs5"))
                          (:file "password-hash" :depends-on ("pkcs5"))
                          (:file "math" :depends-on ("prng" "public-key"))
                          (:module "sbcl-opt"
@@ -226,6 +228,7 @@
                                    (:file "digests")
                                    (:file "padding")
                                    (:file "pkcs5")
+                                   (:file "scrypt")
                                    (:file "ironclad")
                                    (:file "prng")
                                    ;; test vectors

src/conditions.lisp

@@ -64,6 +64,15 @@ for a particular mode of operation but not supplied."))
                      (digest condition))))
   (:documentation "Signaled when an invalid digest name is provided to MAKE-DIGEST."))
 
+(define-condition unsupported-scrypt-cost-factors (ironclad-error)
+  ((N :initarg :N :reader cost-N)
+   (r :initarg :r :reader cost-r)
+   (p :initarg :p :reader cost-p))
+  (:report (lambda (condition stream)
+             (format stream "Scrypt cost factors not supported. N=~A must be a power of two and (r=~A * p=~A) <= 2^30."
+                     (cost-N condition) (cost-r condition) (cost-p condition))))
+  (:documentation "Signaled when a invalid cost factors are provided to MAKE-SCRYPT-KDF."))
+
 (define-condition insufficient-buffer-space (ironclad-error)
   ((buffer :initarg :buffer :reader insufficient-buffer-space-buffer)
    (start :initarg :start :reader insufficient-buffer-space-start)

src/kdf-common.lisp

@@ -0,0 +1,37 @@
+;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
+(in-package :crypto)
+
+(defgeneric derive-key (kdf passphrase salt iteration-count key-length))
+
+(defclass pbkdf1 ()
+  ((digest :reader kdf-digest)))
+
+(defclass pbkdf2 ()
+  ((digest-name :initarg :digest :reader kdf-digest)))
+
+(defclass scrypt-kdf ()
+ ((N :initarg :N :reader scrypt-kdf-N)
+  (r :initarg :r :reader scrypt-kdf-r)
+  (p :initarg :p :reader scrypt-kdf-p)))
+
+(defun make-kdf (kind &key digest (N 16384) (r 8) (p 1))
+  ;; PBKDF1, at least, will do stricter checking; this is good enough for now.
+  "digest is used for pbkdf1 and pbkdf2.
+   N, p, and r are cost factors for scrypt."
+  (case kind
+    (pbkdf1
+     (unless (digestp digest)
+       (error 'unsupported-digest :name digest))
+     (make-instance 'pbkdf1 :digest digest))
+    (pbkdf2
+     (unless (digestp digest)
+       (error 'unsupported-digest :name digest))
+     (make-instance 'pbkdf2 :digest digest))
+    (scrypt-kdf
+     (when (or (<= N 1)
+               (not (zerop (logand N (1- N))))
+               (>= (* r p) (expt 2 30)))
+       (error 'unsupported-scrypt-cost-factors :N N :r r :p p))
+     (make-instance 'scrypt-kdf :N N :r r :p p))
+    (t
+     (error 'unsupported-kdf :kdf kind))))

src/package.lisp

@@ -33,7 +33,7 @@
    #:ecb #:cbc #:ctr #:ofb #:cfb #:stream
 
    ;; KDFs
-   #:pbkdf1 #:pbkdf2
+   #:pbkdf1 #:pbkdf2 #:scrypt-kdf
    #:make-kdf #:derive-key
 
    ;; KDF convenience functions
@@ -65,6 +65,7 @@
    #:ironclad-error #:initialization-vector-not-supplied
    #:invalid-initialization-vector #:invalid-key-length
    #:unsupported-cipher #:unsupported-mode #:unsupported-digest
+   #:unsupported-scrypt-cost-factors
    #:insufficient-buffer-space #:invalid-padding
    #:key-not-supplied
 

src/pkcs5.lisp

@@ -1,14 +1,9 @@
 ;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
 (in-package :crypto)
 
-(defgeneric derive-key (kdf passphrase salt iteration-count key-length))
-
 
 ;;; PBKDF1 from RFC 2898, section 5.1
 
-(defclass pbkdf1 ()
-  ((digest :reader kdf-digest)))
-
 (defmethod shared-initialize :after ((kdf pbkdf1) slot-names &rest initargs
                                      &key digest &allow-other-keys)
   (declare (ignore slot-names initargs))
@@ -53,9 +48,6 @@
 
 ;;; PBKDF2, from RFC 2898, section 5.2
 
-(defclass pbkdf2 ()
-  ((digest-name :initarg :digest :reader kdf-digest)))
-
 (defun pbkdf2-derive-key (digest passphrase salt iteration-count key-length)
   (unless (plusp iteration-count)
     (error 'invalid-argument))
@@ -91,15 +83,3 @@
 
 (defmethod derive-key ((kdf pbkdf2) passphrase salt iteration-count key-length)
   (pbkdf2-derive-key (kdf-digest kdf) passphrase salt iteration-count key-length))
-
-(defun make-kdf (kind &key digest)
-  ;; PBKDF1, at least, will do stricter checking; this is good enough for now.
-  (unless (digestp digest)
-    (error 'unsupported-digest :name digest))
-  (case kind
-    (pbkdf1
-     (make-instance 'pbkdf1 :digest digest))
-    (pbkdf2
-     (make-instance 'pbkdf2 :digest digest))
-    (t
-     (error 'unsupported-kdf :kdf kind))))

src/scrypt.lisp

@@ -0,0 +1,74 @@
+;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
+(in-package :crypto)
+
+
+;;; scrypt from Colin Percival's
+;;; "Stronger Key Derivation via Sequential Memory-Hard Functions"
+;;; presented at BSDCan'09, May 2009.
+;;; http://www.tarsnap.com/scrypt.html
+
+(defmacro salsa-vector-4mix (x i4 i8 i12 i0)
+  `(setf (aref ,x ,i4) (ldb (byte 32 0) (logxor (aref ,x ,i4) (rol32 (mod32+ (aref ,x ,i0) (aref ,x ,i12)) 7)))
+         (aref ,x ,i8) (ldb (byte 32 0) (logxor (aref ,x ,i8) (rol32 (mod32+ (aref ,x ,i4) (aref ,x ,i0)) 9)))
+         (aref ,x ,i12) (ldb (byte 32 0) (logxor (aref ,x ,i12) (rol32 (mod32+ (aref ,x ,i8) (aref ,x ,i4)) 13)))
+         (aref ,x ,i0) (ldb (byte 32 0) (logxor (aref ,x ,i0) (rol32 (mod32+ (aref ,x ,i12) (aref ,x ,i8)) 18)))))
+
+(defun scrypt-vector-salsa (b)
+ (let ((x (make-array 16 :element-type '(unsigned-byte 32)))
+       (w (make-array 16 :element-type '(unsigned-byte 32))))
+  (declare (type (simple-array (unsigned-byte 32) (16)) x w))
+  (declare (dynamic-extent x w))
+  (fill-block-ub8-le x b 0)
+  (replace w x)
+
+  (loop repeat 4 do
+    (salsa-vector-4mix x 4 8 12 0)
+    (salsa-vector-4mix x 9 13 1 5)
+    (salsa-vector-4mix x 14 2 6 10)
+    (salsa-vector-4mix x 3 7 11 15)
+    (salsa-vector-4mix x 1 2 3 0)
+    (salsa-vector-4mix x 6 7 4 5)
+    (salsa-vector-4mix x 11 8 9 10)
+    (salsa-vector-4mix x 12 13 14 15))
+
+  (dotimes (i 16)
+    (setf (nibbles:ub32ref/le b (* i 4)) (mod32+ (aref x i) (aref w i))))))
+
+(defun block-mix (b xy xy-start r)
+ (let ((xs (make-array 64 :element-type '(unsigned-byte 8))))
+  (declare (type (simple-array (unsigned-byte 8) (64)) x w))
+  (declare (dynamic-extent x w))
+  (replace xs b :start2 (* 64 (1- (* 2 r))) :end1 64)
+  (dotimes (i (* 2 r))
+    (xor-block 64 xs b (* i 64) xs 0)
+    (scrypt-vector-salsa xs)
+    (replace xy xs :start1 (+ xy-start (* i 64)) :end2 64))
+  (dotimes (i r)
+    (replace b xy :start1 (* i 64) :end1 (+ 64 (* i 64)) :start2 (+ xy-start (* 64 2 i))))
+  (dotimes (i r)
+    (replace b xy :start1 (* 64 (+ i r)) :end1 (+ (* 64 (+ i r)) 64) :start2 (+ xy-start (* 64 (1+ (* i 2))))))))
+
+(defun smix (b b-start r N v xy)
+ (let ((x xy)
+       (xy-start (* 128 r))
+       (smix-length (* 128 r)))
+  (replace x b :end1 smix-length :start2 b-start)
+  (dotimes (i N)
+    (replace v x :start1 (* i smix-length) :end2 smix-length)
+    (block-mix x xy xy-start r))
+  (dotimes (i N)
+    (let ((j (ldb (byte 32 0) (logand (nibbles:ub64ref/le x (* (1- (* 2 r)) 64)) (1- N)))))
+      (xor-block smix-length x v (* j smix-length) x 0)
+      (block-mix x xy xy-start r)))
+  (replace b x :start1 b-start :end1 (+ b-start smix-length))))
+
+(defmethod derive-key ((kdf scrypt-kdf) passphrase salt iteration-count key-length)
+ (declare (ignore iteration-count))
+ (let* ((pb-kdf (make-kdf 'PBKDF2 :digest 'SHA256))
+        (xy (make-array (* 256 (scrypt-kdf-r kdf)) :element-type '(unsigned-byte 8)))
+        (v (make-array (* 128 (scrypt-kdf-r kdf) (scrypt-kdf-N kdf)) :element-type '(unsigned-byte 8)))
+        (b (derive-key pb-kdf passphrase salt 1 (* (scrypt-kdf-p kdf) 128 (scrypt-kdf-r kdf)))))
+  (dotimes (i (scrypt-kdf-p kdf))
+    (smix b (* i 128 (scrypt-kdf-r kdf)) (scrypt-kdf-r kdf) (scrypt-kdf-N kdf) v xy))
+  (reinitialize-instance pb-kdf :digest 'SHA256)
+  (derive-key pb-kdf passphrase b 1 key-length)))

testing/test-vectors/scrypt.lisp

@@ -0,0 +1,56 @@
+;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
+(in-package :crypto-tests)
+
+;;; Test vectors based on calling crypto_scrypt library function in
+;;; the original scrypt utility.
+
+(defvar *scrypt1-password*
+  (coerce #(112 97 115 115 119 111 114 100)
+          '(vector (unsigned-byte 8))))
+(defvar *scrypt1-salt*
+  (coerce #(115 97 108 116)
+          '(vector (unsigned-byte 8))))
+
+(defvar *scrypt1-key*
+  (coerce #(116 87 49 175 68 132 243 35 150 137 105 237 162 137 174 238 0 91 89
+            3 172 86 30 100 165 172 161 33 121 123 247 115)
+          '(vector (unsigned-byte 8))))
+
+(rtest:deftest scryptkdf1
+    (run-kdf-test (crypto:make-kdf 'crypto:scrypt-kdf :N 16384 :r 8 :p 1)
+                  *scrypt1-password* *scrypt1-salt* 1000 (length *scrypt1-key*) *scrypt1-key*)
+  t)
+
+(defvar *scrypt2-password*
+  (coerce #(112 97 115 115 119 111 114 100)
+          '(vector (unsigned-byte 8))))
+(defvar *scrypt2-salt*
+  (coerce #(115 97 108 116)
+          '(vector (unsigned-byte 8))))
+
+(defvar *scrypt2-key*
+  (coerce #(243 198 84 124 73 207 248 197 175 189 52 186 30 224 136 138 229 99
+            59 58 111 136 95 54 139 227 241 159 14 126 231 215)
+          '(vector (unsigned-byte 8))))
+
+(rtest:deftest scryptkdf2
+    (run-kdf-test (crypto:make-kdf 'crypto:scrypt-kdf :N 16384 :r 8 :p 2)
+                  *scrypt2-password* *scrypt2-salt* 1000 (length *scrypt2-key*) *scrypt2-key*)
+  t)
+
+(defvar *scrypt3-password*
+  (coerce #(112 97 115 115 119 111 114 100)
+          '(vector (unsigned-byte 8))))
+(defvar *scrypt3-salt*
+  (coerce #(115 97 108 116)
+          '(vector (unsigned-byte 8))))
+
+(defvar *scrypt3-key*
+  (coerce #(136 189 94 219 82 209 221 0 24 135 114 173 54 23 18 144 34 78 116
+            130 149 37 177 141 115 35 165 127 145 150 60 55) 
+          '(vector (unsigned-byte 8))))
+
+(rtest:deftest scryptkdf3
+    (run-kdf-test (crypto:make-kdf 'crypto:scrypt-kdf :N 16 :r 100 :p 100)
+                  *scrypt3-password* *scrypt3-salt* 1000 (length *scrypt3-key*) *scrypt3-key*)
+  t)