Coverage report: /home/ellis/comp/ext/ironclad/src/kdf/bcrypt.lisp

KindCoveredAll%
expression0357 0.0
branch018 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; bcrypt.lisp -- implementation of the bcrypt password hashing function
2
 (in-package :crypto)
3
 
4
 (defclass bcrypt ()
5
   ())
6
 
7
 (defconst +bcrypt-initial-hash+
8
   (ascii-string-to-byte-array "OrpheanBeholderScryDoubt"))
9
 
10
 (defun bcrypt-expand-key (passphrase salt p-array s-boxes)
11
   (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt)
12
            (type blowfish-p-array p-array)
13
            (type blowfish-s-boxes s-boxes))
14
   (let ((salt-length (length salt))
15
         (salt-index 0)
16
         (data (make-array 8 :element-type '(unsigned-byte 8) :initial-element 0)))
17
     (declare (type fixnum salt-length salt-index)
18
              (type (simple-array (unsigned-byte 8) (8)) data))
19
     (mix-p-array passphrase p-array)
20
     (dotimes (i 9)
21
       (xor-block 8 data 0 salt salt-index data 0)
22
       (setf salt-index (mod (+ salt-index 8) salt-length))
23
       (blowfish-encrypt-block* p-array s-boxes data 0 data 0)
24
       (let ((index (* 2 i)))
25
         (setf (aref p-array index) (ub32ref/be data 0)
26
               (aref p-array (1+ index)) (ub32ref/be data 4))))
27
     (dotimes (i 4)
28
       (dotimes (j 128)
29
         (xor-block 8 data 0 salt salt-index data 0)
30
         (setf salt-index (mod (+ salt-index 8) salt-length))
31
         (blowfish-encrypt-block* p-array s-boxes data 0 data 0)
32
         (let ((index (+ (* 256 i) (* 2 j))))
33
           (setf (aref s-boxes index) (ub32ref/be data 0)
34
                 (aref s-boxes (1+ index)) (ub32ref/be data 4)))))))
35
 
36
 (defun bcrypt-eksblowfish (passphrase salt rounds)
37
   (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt))
38
   (let ((passphrase (concatenate '(simple-array (unsigned-byte 8) (*))
39
                                  passphrase (vector 0)))
40
         (p-array (copy-seq +p-array+))
41
         (s-boxes (concatenate '(simple-array (unsigned-byte 32) (1024))
42
                               +s-box-0+ +s-box-1+ +s-box-2+ +s-box-3+)))
43
     (declare (type (simple-array (unsigned-byte 8) (*)) passphrase)
44
              (type blowfish-p-array p-array)
45
              (type blowfish-s-boxes s-boxes))
46
     (bcrypt-expand-key passphrase salt p-array s-boxes)
47
     (dotimes (i rounds)
48
       (initialize-blowfish-vectors passphrase p-array s-boxes)
49
       (initialize-blowfish-vectors salt p-array s-boxes))
50
     (values p-array s-boxes)))
51
 
52
 (defmethod derive-key ((kdf bcrypt) passphrase salt iteration-count key-length)
53
   (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt))
54
   (unless (<= (length passphrase) 72)
55
     (error 'ironclad-error
56
            :format-control "PASSPHRASE must be at most 72 bytes long."))
57
   (unless (= (length salt) 16)
58
     (error 'ironclad-error
59
            :format-control "SALT must be 16 bytes long."))
60
   (unless (and (zerop (logand iteration-count (1- iteration-count)))
61
                (<= (expt 2 4) iteration-count (expt 2 31)))
62
     (error 'ironclad-error
63
            :format-control "ITERATION-COUNT must be a power of 2 between 2^4 and 2^31."))
64
   (unless (= key-length 24)
65
     (error 'ironclad-error
66
            :format-control "KEY-LENGTH must be 24."))
67
   (multiple-value-bind (p-array s-boxes)
68
       (bcrypt-eksblowfish passphrase salt iteration-count)
69
     (declare (type blowfish-p-array p-array)
70
              (type blowfish-s-boxes s-boxes))
71
     (let ((hash (copy-seq +bcrypt-initial-hash+)))
72
       (declare (type (simple-array (unsigned-byte 8) (24)) hash))
73
       (dotimes (i 64 hash)
74
         (blowfish-encrypt-block* p-array s-boxes hash 0 hash 0)
75
         (blowfish-encrypt-block* p-array s-boxes hash 8 hash 8)
76
         (blowfish-encrypt-block* p-array s-boxes hash 16 hash 16)))))
77
 
78
 
79
 (defclass bcrypt-pbkdf ()
80
   ())
81
 
82
 (defconst +bcrypt-pbkdf-initial-hash+
83
   (ascii-string-to-byte-array "OxychromaticBlowfishSwatDynamite"))
84
 
85
 (defun bcrypt-hash (passphrase salt hash)
86
   (declare (type (simple-array (unsigned-byte 8) (64)) passphrase salt)
87
            (type (simple-array (unsigned-byte 8) (32)) hash))
88
   (let ((p-array (copy-seq +p-array+))
89
         (s-boxes (concatenate '(simple-array (unsigned-byte 32) (1024))
90
                               +s-box-0+ +s-box-1+ +s-box-2+ +s-box-3+)))
91
     (declare (type blowfish-p-array p-array)
92
              (type blowfish-s-boxes s-boxes))
93
     (bcrypt-expand-key passphrase salt p-array s-boxes)
94
     (dotimes (i 64)
95
       (initialize-blowfish-vectors salt p-array s-boxes)
96
       (initialize-blowfish-vectors passphrase p-array s-boxes))
97
     (replace hash +bcrypt-pbkdf-initial-hash+)
98
     (dotimes (i 64)
99
       (blowfish-encrypt-block* p-array s-boxes hash 0 hash 0)
100
       (blowfish-encrypt-block* p-array s-boxes hash 8 hash 8)
101
       (blowfish-encrypt-block* p-array s-boxes hash 16 hash 16)
102
       (blowfish-encrypt-block* p-array s-boxes hash 24 hash 24))
103
     (dotimes (i 8)
104
       (let ((index (* 4 i)))
105
         (declare (type (mod 32) index))
106
         (setf (ub32ref/le hash index) (ub32ref/be hash index))))
107
     hash))
108
 
109
 (defmethod derive-key ((kdf bcrypt-pbkdf) passphrase salt iteration-count key-length)
110
   (declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt)
111
            (type fixnum key-length))
112
   (unless (plusp iteration-count)
113
     (error 'ironclad-error
114
            :format-control "ITERATION-COUNT must be a least 1."))
115
   (unless (<= 1 key-length 1024)
116
     (error 'ironclad-error
117
            :format-control "KEY-LENGTH must be between 1 and 1024."))
118
   (let* ((key (make-array key-length :element-type '(unsigned-byte 8)))
119
          (salt-length (length salt))
120
          (salt+count (concatenate '(simple-array (unsigned-byte 8) (*))
121
                                   salt (vector 0 0 0 0)))
122
          (sha2pass (make-array 64 :element-type '(unsigned-byte 8)))
123
          (sha2salt (make-array 64 :element-type '(unsigned-byte 8)))
124
          (data (make-array 32 :element-type '(unsigned-byte 8)))
125
          (tmp (make-array 32 :element-type '(unsigned-byte 8)))
126
          (stride (ceiling key-length 32))
127
          (amt (ceiling key-length stride)))
128
     (declare (type (simple-array (unsigned-byte 8) (*)) key salt+count)
129
              (type (simple-array (unsigned-byte 8) (64)) sha2pass sha2salt)
130
              (type (simple-array (unsigned-byte 8) (32)) data tmp)
131
              (type fixnum stride amt))
132
     (digest-sequence :sha512 passphrase :digest sha2pass)
133
     (do ((count 1 (1+ count))
134
          (kl key-length))
135
         ((<= kl 0) key)
136
       (declare (type fixnum count kl))
137
       (setf (ub32ref/be salt+count salt-length) count)
138
       (digest-sequence :sha512 salt+count :digest sha2salt)
139
       (bcrypt-hash sha2pass sha2salt tmp)
140
       (replace data tmp)
141
       (dotimes (i (1- iteration-count))
142
         (digest-sequence :sha512 tmp :digest sha2salt)
143
         (bcrypt-hash sha2pass sha2salt tmp)
144
         (xor-block 32 data 0 tmp 0 data 0))
145
       (setf amt (min amt kl))
146
       (dotimes (i amt (decf kl amt))
147
         (let ((dest (+ (* i stride) (1- count))))
148
           (declare (type fixnum dest))
149
           (unless (< dest key-length)
150
             (decf kl i)
151
             (return))
152
           (setf (aref key dest) (aref data i)))))))