Add bcrypt-pbkdf

6 files changed, 135 insertions, 16 deletions

diff --git a/NEWS b/NEWS
index 89d3f60..52e0980 100644
--- a/NEWS
+++ b/NEWS
@@ -13,7 +13,7 @@ P-384) and Secp521r1 (a.k.a. NIST P-521) elliptic curves.
 Added the generate-signature-nonce method that can be redefined to get
 deterministic signature nonces instead of random ones.
 
-Added the bcrypt key derivation function.
+Added the bcrypt and bcrypt-pbkdf key derivation functions.
 
 * Version 0.50, released 2020-07-01
 
diff --git a/README.org b/README.org
index 24d6953..2bb1325 100644
--- a/README.org
+++ b/README.org
@@ -918,6 +918,7 @@ Returns ~t~ if /name/ would be in the list returned by
 Ironclad comes with a few key derivation functions:
  - Argon2 (only Argon2d and Argon2i without parallelism are implemented)
  - Bcrypt
+ - Bcrypt-pbkdf
  - PBKDF1
  - PBKDF2
  - Scrypt
@@ -938,6 +939,8 @@ For bcrypt, the /salt/ must be 16 bytes long, the /iteration-count/ must be
 a power of 2 between 2^4 and 2^31, and the /key-length/ must be 24.
 Scrypt and HMAC ignore the /iteration-count/ parameter.
 
+For bcrypt-pbkdf, the /key-length/ must be between 1 and 1024.
+
 
 #+NAME: make-kdf
 #+BEGIN_SRC lisp
@@ -950,6 +953,7 @@ Returns a key derivation function instance.
  - argon2d
  - argon2i
  - bcrypt
+ - bcrypt-pbkdf
  - pbkdf1
  - pbkdf2
  - scrypt-kdf
diff --git a/src/kdf/bcrypt.lisp b/src/kdf/bcrypt.lisp
index 03449d0..ca5c976 100644
--- a/src/kdf/bcrypt.lisp
+++ b/src/kdf/bcrypt.lisp
@@ -6,23 +6,30 @@
 
 (defconst +bcrypt-initial-hash+
   (ascii-string-to-byte-array "OrpheanBeholderScryDoubt"))
+(defconst +bcrypt-pbkdf-initial-hash+
+  (ascii-string-to-byte-array "OxychromaticBlowfishSwatDynamite"))
 
 (defun bcrypt-expand-key (passphrase salt p-array s-boxes)
   (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt)
            (type blowfish-p-array p-array)
            (type blowfish-s-boxes s-boxes))
-  (let ((data (make-array 8 :element-type '(unsigned-byte 8) :initial-element 0)))
-    (declare (type (simple-array (unsigned-byte 8) (8)) data))
+  (let ((salt-length (length salt))
+        (salt-index 0)
+        (data (make-array 8 :element-type '(unsigned-byte 8) :initial-element 0)))
+    (declare (type fixnum salt-length salt-index)
+             (type (simple-array (unsigned-byte 8) (8)) data))
     (mix-p-array passphrase p-array)
     (dotimes (i 9)
-      (xor-block 8 data 0 salt (if (evenp i) 0 8) data 0)
+      (xor-block 8 data 0 salt salt-index data 0)
+      (setf salt-index (mod (+ salt-index 8) salt-length))
       (blowfish-encrypt-block* p-array s-boxes data 0 data 0)
       (let ((index (* 2 i)))
         (setf (aref p-array index) (ub32ref/be data 0)
               (aref p-array (1+ index)) (ub32ref/be data 4))))
     (dotimes (i 4)
       (dotimes (j 128)
-        (xor-block 8 data 0 salt (if (oddp j) 0 8) data 0)
+        (xor-block 8 data 0 salt salt-index data 0)
+        (setf salt-index (mod (+ salt-index 8) salt-length))
         (blowfish-encrypt-block* p-array s-boxes data 0 data 0)
         (let ((index (+ (* 256 i) (* 2 j))))
           (setf (aref s-boxes index) (ub32ref/be data 0)
@@ -70,13 +77,71 @@
         (blowfish-encrypt-block* p-array s-boxes hash 8 hash 8)
         (blowfish-encrypt-block* p-array s-boxes hash 16 hash 16)))))
 
-#|
-;; http://kwarc.github.io/llamapun/src/crypto/bcrypt.rs.html
-;; https://github.com/patrickfav/bcrypt/wiki/Published-Test-Vectors
-(let* ((kdf (crypto:make-kdf :bcrypt))
-       (pass (crypto:hex-string-to-byte-array "552a55"))
-       (salt (crypto:hex-string-to-byte-array "10410410410410410410410410410410"))
-       (hash (crypto:derive-key kdf pass salt 32 24)))
-  (write-line "\"1bb69143f9a8d304c8d23d99ab049a77a68e2ccc744206\"")
-  (crypto:byte-array-to-hex-string hash))
-|#
+(defun bcrypt-hash (passphrase salt hash)
+  (declare (type (simple-array (unsigned-byte 8) (64)) passphrase salt)
+           (type (simple-array (unsigned-byte 8) (32)) hash))
+  (let ((p-array (copy-seq +p-array+))
+        (s-boxes (concatenate '(simple-array (unsigned-byte 32) (1024))
+                              +s-box-0+ +s-box-1+ +s-box-2+ +s-box-3+)))
+    (declare (type blowfish-p-array p-array)
+             (type blowfish-s-boxes s-boxes))
+    (bcrypt-expand-key passphrase salt p-array s-boxes)
+    (dotimes (i 64)
+      (initialize-blowfish-vectors salt p-array s-boxes)
+      (initialize-blowfish-vectors passphrase p-array s-boxes))
+    (replace hash +bcrypt-pbkdf-initial-hash+)
+    (dotimes (i 64)
+      (blowfish-encrypt-block* p-array s-boxes hash 0 hash 0)
+      (blowfish-encrypt-block* p-array s-boxes hash 8 hash 8)
+      (blowfish-encrypt-block* p-array s-boxes hash 16 hash 16)
+      (blowfish-encrypt-block* p-array s-boxes hash 24 hash 24))
+    (dotimes (i 8)
+      (let ((index (* 4 i)))
+        (declare (type (mod 32) index))
+        (setf (ub32ref/le hash index) (ub32ref/be hash index))))
+    hash))
+
+(defmethod derive-key ((kdf bcrypt-pbkdf) passphrase salt iteration-count key-length)
+  (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt)
+           (type fixnum key-length))
+  (unless (plusp iteration-count)
+    (error 'ironclad-error
+           :format-control "ITERATION-COUNT must be a least 1."))
+  (unless (<= 1 key-length 1024)
+    (error 'ironclad-error
+           :format-control "KEY-LENGTH must be between 1 and 1024."))
+  (let* ((key (make-array key-length :element-type '(unsigned-byte 8)))
+         (salt-length (length salt))
+         (salt+count (concatenate '(simple-array (unsigned-byte 8) (*))
+                                  salt (vector 0 0 0 0)))
+         (sha2pass (make-array 64 :element-type '(unsigned-byte 8)))
+         (sha2salt (make-array 64 :element-type '(unsigned-byte 8)))
+         (data (make-array 32 :element-type '(unsigned-byte 8)))
+         (tmp (make-array 32 :element-type '(unsigned-byte 8)))
+         (stride (ceiling key-length 32))
+         (amt (ceiling key-length stride)))
+    (declare (type (simple-array (unsigned-byte 8) (*)) key salt+count)
+             (type (simple-array (unsigned-byte 8) (64)) sha2pass sha2salt)
+             (type (simple-array (unsigned-byte 8) (32)) data tmp)
+             (type fixnum stride amt))
+    (digest-sequence :sha512 passphrase :digest sha2pass)
+    (do ((count 1 (1+ count))
+         (kl key-length))
+        ((<= kl 0) key)
+      (declare (type fixnum count kl))
+      (setf (ub32ref/be salt+count salt-length) count)
+      (digest-sequence :sha512 salt+count :digest sha2salt)
+      (bcrypt-hash sha2pass sha2salt tmp)
+      (replace data tmp)
+      (dotimes (i (1- iteration-count))
+        (digest-sequence :sha512 tmp :digest sha2salt)
+        (bcrypt-hash sha2pass sha2salt tmp)
+        (xor-block 32 data 0 tmp 0 data 0))
+      (setf amt (min amt kl))
+      (dotimes (i amt (decf kl amt))
+        (let ((dest (+ (* i stride) (1- count))))
+          (declare (type fixnum dest))
+          (unless (< dest key-length)
+            (decf kl i)
+            (return))
+          (setf (aref key dest) (aref data i)))))))
diff --git a/src/kdf/kdf-common.lisp b/src/kdf/kdf-common.lisp
index 6039bd7..4d36a97 100644
--- a/src/kdf/kdf-common.lisp
+++ b/src/kdf/kdf-common.lisp
@@ -40,6 +40,9 @@
 (defclass bcrypt ()
   ())
 
+(defclass bcrypt-pbkdf ()
+  ())
+
 (defun make-kdf (kind &key digest
                       (n 4096) (r 8) (p 2)
                       (block-count 10000) additional-key additional-data)
@@ -86,5 +89,7 @@ argon2"
                     :additional-data additional-data))
     (bcrypt
      (make-instance 'bcrypt))
+    (bcrypt-pbkdf
+     (make-instance 'bcrypt-pbkdf))
     (t
      (error 'unsupported-kdf :kdf kind))))
diff --git a/src/package.lisp b/src/package.lisp
index cc0f1e8..17beac1 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -54,7 +54,7 @@
 
    ;; KDFs
    #:pbkdf1 #:pbkdf2 #:hmac-kdf #:scrypt-kdf #:argon2i #:argon2d
-   #:bcrypt
+   #:bcrypt #:bcrypt-pbkdf
    #:make-kdf #:derive-key
 
    ;; KDF convenience functions
diff --git a/testing/test-vectors/bcrypt.lisp b/testing/test-vectors/bcrypt.lisp
index d5e6b74..9da4aab 100644
--- a/testing/test-vectors/bcrypt.lisp
+++ b/testing/test-vectors/bcrypt.lisp
@@ -27,3 +27,48 @@
                   24
                   (crypto:hex-string-to-byte-array "eeee31f80919920425881002d140d555b28a5c72e00f097d"))
   t)
+
+(rtest:deftest bcrypt-4
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt)
+                  (crypto:ascii-string-to-byte-array "/MH51`!BP&0tj3%YCA;Xk%e3S`o\\EI")
+                  (crypto:hex-string-to-byte-array "811902780b80d2a0e4e43f2bde449612")
+                  1024
+                  24
+                  (crypto:hex-string-to-byte-array "d69e68b5c372ad72fb6488275f4687334afb1dba41d00cf1"))
+  t)
+
+(rtest:deftest bcrypt-pbkdf-1
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt-pbkdf)
+                  (crypto:ascii-string-to-byte-array "password")
+                  (crypto:ascii-string-to-byte-array "salt")
+                  4
+                  32
+                  (crypto:hex-string-to-byte-array "5bbf0cc293587f1c3635555c27796598d47e579071bf427e9d8fbe842aba34d9"))
+  t)
+
+(rtest:deftest bcrypt-pbkdf-2
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt-pbkdf)
+                  (crypto:ascii-string-to-byte-array "password")
+                  (crypto:hex-string-to-byte-array "00")
+                  4
+                  16
+                  (crypto:hex-string-to-byte-array "c12b566235eee04c212598970a579a67"))
+  t)
+
+(rtest:deftest bcrypt-pbkdf-3
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt-pbkdf)
+                  (crypto:ascii-string-to-byte-array "password")
+                  (crypto:ascii-string-to-byte-array "salt")
+                  8
+                  64
+                  (crypto:hex-string-to-byte-array "e1367ec5151a33faac4cc1c144cd23fa15d5548493ecc99b9b5d9c0d3b27bec76227ea66088b849b20ab7aa478010246e74bba51723fefa9f9474d6508845e8d"))
+  t)
+
+(rtest:deftest bcrypt-pbkdf-4
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt-pbkdf)
+                  (crypto:hex-string-to-byte-array "0db3ac94b3ee53284f4a22893b3c24ae")
+                  (crypto:hex-string-to-byte-array "3a62f0f0dbcef823cfcc854856ea1028")
+                  8
+                  256
+                  (crypto:hex-string-to-byte-array "2054b9fff34e3721440334746828e9ed38de4b72e0a69adc170a13b5e8d646385ea4034ae6d26600ee2332c5ed40ad557c86e3403fbb30e4e1dc1ae06b99a071368f518d2c426651c9e7e437fd6c915b1bbfc3a4cea71491490ea7afb7dd0290a678a4f441128db1792eab2776b21eb4238e0715add4127dff44e4b3e4cc4c4f9970083f3f74bd698873fdf648844f75c9bf7f9e0c4d9e5d89a7783997492966616707611cb901de31a19726b6e08c3a8001661f2d5c9dcc33b4aa072f90dd0b3f548d5eeba4211397e2fb062e526e1d68f46a4ce256185b4badc2685fbe78e1c7657b59f83ab9ab80cf9318d6add1f5933f12d6f36182c8e8115f68030a1244"))
+  t)