Add bcrypt

7 files changed, 126 insertions, 1 deletions

diff --git a/NEWS b/NEWS
index 74d7327..89d3f60 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,8 @@ 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.
+
 * Version 0.50, released 2020-07-01
 
 ** bug fixes
diff --git a/README.org b/README.org
index 61a2a12..24d6953 100644
--- a/README.org
+++ b/README.org
@@ -917,6 +917,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
  - PBKDF1
  - PBKDF2
  - Scrypt
@@ -933,6 +934,8 @@ a password and salt (both must be of type
 ~(simple-array (unsigned-byte 8) (*))~), and number of iterations,
 returns the password digest as a byte array of length /key-length/.
 
+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.
 
 
@@ -946,6 +949,7 @@ Returns a key derivation function instance.
 /kind/ denotes the key derivation function to use. They are:
  - argon2d
  - argon2i
+ - bcrypt
  - pbkdf1
  - pbkdf2
  - scrypt-kdf
diff --git a/ironclad.asd b/ironclad.asd
index 71cd5d8..85b2137 100644
--- a/ironclad.asd
+++ b/ironclad.asd
@@ -137,6 +137,7 @@
                               :serial t
                               :components ((:file "kdf-common")
                                            (:file "argon2")
+                                           (:file "bcrypt")
                                            (:file "hmac")
                                            (:file "pkcs5")
                                            (:file "password-hash")
@@ -320,9 +321,10 @@
                                            (:test-vector-file "tree-hash")
                                            (:test-vector-file "whirlpool")
                                            ;; kdf
+                                           (:file "pkcs5")
                                            (:file "argon2d")
                                            (:file "argon2i")
-                                           (:file "pkcs5")
+                                           (:file "bcrypt")
                                            (:file "scrypt")
                                            (:file "hmac-kdf")
                                            ;; macs
diff --git a/src/kdf/bcrypt.lisp b/src/kdf/bcrypt.lisp
new file mode 100644
index 0000000..03449d0
--- /dev/null
+++ b/src/kdf/bcrypt.lisp
@@ -0,0 +1,82 @@
+;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
+;;;; bcrypt.lisp -- implementation of the bcrypt password hashing function
+
+(in-package :crypto)
+
+
+(defconst +bcrypt-initial-hash+
+  (ascii-string-to-byte-array "OrpheanBeholderScryDoubt"))
+
+(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))
+    (mix-p-array passphrase p-array)
+    (dotimes (i 9)
+      (xor-block 8 data 0 salt (if (evenp i) 0 8) data 0)
+      (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)
+        (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)
+                (aref s-boxes (1+ index)) (ub32ref/be data 4)))))))
+
+(defun bcrypt-eksblowfish (passphrase salt rounds)
+  (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt))
+  (let ((passphrase (concatenate '(simple-array (unsigned-byte 8) (*))
+                                 passphrase (vector 0)))
+        (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 (simple-array (unsigned-byte 8) (*)) passphrase)
+             (type blowfish-p-array p-array)
+             (type blowfish-s-boxes s-boxes))
+    (bcrypt-expand-key passphrase salt p-array s-boxes)
+    (dotimes (i rounds)
+      (initialize-blowfish-vectors passphrase p-array s-boxes)
+      (initialize-blowfish-vectors salt p-array s-boxes))
+    (values p-array s-boxes)))
+
+(defmethod derive-key ((kdf bcrypt) passphrase salt iteration-count key-length)
+  (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt))
+  (unless (<= (length passphrase) 72)
+    (error 'ironclad-error
+           :format-control "PASSPHRASE must be at most 72 bytes long."))
+  (unless (= (length salt) 16)
+    (error 'ironclad-error
+           :format-control "SALT must be 16 bytes long."))
+  (unless (and (zerop (logand iteration-count (1- iteration-count)))
+               (<= (expt 2 4) iteration-count (expt 2 31)))
+    (error 'ironclad-error
+           :format-control "ITERATION-COUNT must be a power of 2 between 2^4 and 2^31."))
+  (unless (= key-length 24)
+    (error 'ironclad-error
+           :format-control "KEY-LENGTH must be 24."))
+  (multiple-value-bind (p-array s-boxes)
+      (bcrypt-eksblowfish passphrase salt iteration-count)
+    (declare (type blowfish-p-array p-array)
+             (type blowfish-s-boxes s-boxes))
+    (let ((hash (copy-seq +bcrypt-initial-hash+)))
+      (declare (type (simple-array (unsigned-byte 8) (24)) hash))
+      (dotimes (i 64 hash)
+        (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)))))
+
+#|
+;; 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))
+|#
diff --git a/src/kdf/kdf-common.lisp b/src/kdf/kdf-common.lisp
index fc9ec50..6039bd7 100644
--- a/src/kdf/kdf-common.lisp
+++ b/src/kdf/kdf-common.lisp
@@ -37,6 +37,9 @@
 (defclass argon2d (argon2)
   ())
 
+(defclass bcrypt ()
+  ())
+
 (defun make-kdf (kind &key digest
                       (n 4096) (r 8) (p 2)
                       (block-count 10000) additional-key additional-data)
@@ -81,5 +84,7 @@ argon2"
                     :block-count block-count
                     :additional-key additional-key
                     :additional-data additional-data))
+    (bcrypt
+     (make-instance 'bcrypt))
     (t
      (error 'unsupported-kdf :kdf kind))))
diff --git a/src/package.lisp b/src/package.lisp
index 3e77faa..cc0f1e8 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -54,6 +54,7 @@
 
    ;; KDFs
    #:pbkdf1 #:pbkdf2 #:hmac-kdf #:scrypt-kdf #:argon2i #:argon2d
+   #:bcrypt
    #:make-kdf #:derive-key
 
    ;; KDF convenience functions
diff --git a/testing/test-vectors/bcrypt.lisp b/testing/test-vectors/bcrypt.lisp
new file mode 100644
index 0000000..d5e6b74
--- /dev/null
+++ b/testing/test-vectors/bcrypt.lisp
@@ -0,0 +1,29 @@
+(in-package :crypto-tests)
+
+
+(rtest:deftest bcrypt-1
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt)
+                  (crypto:ascii-string-to-byte-array "Kk4DQuMMfZL9o")
+                  (crypto:hex-string-to-byte-array "79762be9970f5be73ac77c0e4f0a3851")
+                  16
+                  24
+                  (crypto:hex-string-to-byte-array "db8f0360d2aa48e1415598bbc1b5c0d9103043ea39686ad2"))
+  t)
+
+(rtest:deftest bcrypt-2
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt)
+                  (crypto:ascii-string-to-byte-array "U*U")
+                  (crypto:hex-string-to-byte-array "10410410410410410410410410410410")
+                  32
+                  24
+                  (crypto:hex-string-to-byte-array "1bb69143f9a8d304c8d23d99ab049a77a68e2ccc744206bb"))
+  t)
+
+(rtest:deftest bcrypt-3
+    (run-kdf-test (crypto:make-kdf 'crypto:bcrypt)
+                  (crypto:ascii-string-to-byte-array "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
+                  (crypto:hex-string-to-byte-array "71d79f8218a39259a7a29aabb2dbafc3")
+                  32
+                  24
+                  (crypto:hex-string-to-byte-array "eeee31f80919920425881002d140d555b28a5c72e00f097d"))
+  t)