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

Kind	Covered	All	%
expression	0	838	0.0
branch	0	24	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; argon2.lisp -- implementation of the Argon2 key derivation function

2

;; Based on the Argon2 implementation present in the Monocypher

3

;; crypto library (http://loup-vaillant.fr/projects/monocypher/)

4

(in-package :crypto)

5

6

(defclass argon2 ()

7

((block :accessor argon2-block :type (simple-array (unsigned-byte 64) (128)))

8

(pass-number :accessor argon2-pass-number)

9

(slice-number :accessor argon2-slice-number)

10

(nb-blocks :accessor argon2-nb-blocks)

11

(block-count :accessor argon2-block-count)

12

(nb-iterations :accessor argon2-nb-iterations)

13

(counter :accessor argon2-counter)

14

(offset :accessor argon2-offset)

15

(additional-key :accessor argon2-additional-key :type (simple-array (unsigned-byte 8) (*)))

16

(additional-data :accessor argon2-additional-data :type (simple-array (unsigned-byte 8) (*)))

17

(work-area :accessor argon2-work-area :type (simple-array (unsigned-byte 64) (*)))

18

(digester :accessor argon2-digester)))

19

20

(defclass argon2i (argon2)

21

())

22

23

(defclass argon2d (argon2)

24

())

25

26

(defclass argon2id (argon2)

27

())

28

29

(defconstant +argon2-block-size+ 128)

30

31

(deftype argon2-block ()

32

'(simple-array (unsigned-byte 64) (128)))

33

34

35

(defun argon2-load-block (b bytes)

36

(declare (type (simple-array (unsigned-byte 64) (*)) b)

37

(type (simple-array (unsigned-byte 8) (*)) bytes))

38

(dotimes (i +argon2-block-size+)

39

(setf (aref b i) (ub64ref/le bytes (* 8 i))))

40

(values))

41

42

(defun argon2-store-block (bytes b &key (start2 0))

43

(declare (type (simple-array (unsigned-byte 64) (*)) b)

44

(type (simple-array (unsigned-byte 8) (*)) bytes))

45

(dotimes (i +argon2-block-size+)

46

(setf (ub64ref/le bytes (* 8 i)) (aref b (+ (* +argon2-block-size+ start2) i))))

47

(values))

48

49

(defun argon2-copy-block (b1 b2 &key (start1 0) (start2 0))

50

(declare (type (simple-array (unsigned-byte 64) (*)) b1 b2))

51

(dotimes (i +argon2-block-size+)

52

(setf (aref b1 (+ (* +argon2-block-size+ start1) i))

53

(aref b2 (+ (* +argon2-block-size+ start2) i))))

54

(values))

55

56

(defun argon2-xor-block (b1 b2 &key (start1 0) (start2 0))

57

(declare (type (simple-array (unsigned-byte 64) (*)) b1 b2))

58

(dotimes (i +argon2-block-size+)

59

(setf (aref b1 (+ (* +argon2-block-size+ start1) i))

60

(logxor (aref b1 (+ (* +argon2-block-size+ start1) i))

61

(aref b2 (+ (* +argon2-block-size+ start2) i)))))

62

(values))

63

64

(defun argon2-update-digester-32 (digester input)

65

(update-mac digester (integer-to-octets input :n-bits 32 :big-endian nil))

66

(values))

67

68

(defun argon2-extended-hash (state digest digest-size input input-size)

69

(declare (type (simple-array (unsigned-byte 8) (*)) digest input))

70

(let ((no-key (make-array 0 :element-type '(unsigned-byte 8)))

71

(digester (argon2-digester state)))

72

(reinitialize-instance digester :key no-key :digest-length (min digest-size 64))

73

(argon2-update-digester-32 digester digest-size)

74

(update-mac digester input :end input-size)

75

(produce-mac digester :digest digest)

76

(when (> digest-size 64)

77

(let ((r (- (ceiling digest-size 32) 2))

78

(i 1)

79

(in 0)

80

(out 32))

81

(loop while (< i r) do

82

(reinitialize-instance digester :key no-key :digest-length 64)

83

(update-mac digester digest :start in :end (+ in 64))

84

(produce-mac digester :digest digest :digest-start out)

85

(incf i 1)

86

(incf in 32)

87

(incf out 32))

88

(reinitialize-instance digester :key no-key :digest-length (- digest-size (* 32 r)))

89

(update-mac digester digest :start in :end (+ in 64))

90

(produce-mac digester :digest digest :digest-start out))))

91

(values))

92

93

(defmacro argon2-g (a b c d)

94

`(setf ,a (mod64+ ,a (mod64+ ,b (mod64* 2 (mod64* (logand ,a #xffffffff) (logand ,b #xffffffff)))))

95

,d (ror64 (logxor ,d ,a) 32)

96

          ,c (mod64+ ,c (mod64+ ,d (mod64* 2 (mod64* (logand ,c #xffffffff) (logand ,d #xffffffff)))))

97

,b (ror64 (logxor ,b ,c) 24)

98

          ,a (mod64+ ,a (mod64+ ,b (mod64* 2 (mod64* (logand ,a #xffffffff) (logand ,b #xffffffff)))))

99

,d (ror64 (logxor ,d ,a) 16)

100

          ,c (mod64+ ,c (mod64+ ,d (mod64* 2 (mod64* (logand ,c #xffffffff) (logand ,d #xffffffff)))))

101

,b (ror64 (logxor ,b ,c) 63)))

102

103

(defmacro argon2-round (v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)

104

`(progn

105

(argon2-g ,v0 ,v4 ,v8 ,v12)

106

(argon2-g ,v1 ,v5 ,v9 ,v13)

107

(argon2-g ,v2 ,v6 ,v10 ,v14)

108

(argon2-g ,v3 ,v7 ,v11 ,v15)

109

(argon2-g ,v0 ,v5 ,v10 ,v15)

110

(argon2-g ,v1 ,v6 ,v11 ,v12)

111

(argon2-g ,v2 ,v7 ,v8 ,v13)

112

(argon2-g ,v3 ,v4 ,v9 ,v14)))

113

114

(defun argon2-g-rounds (work-block)

115

(declare (type argon2-block work-block))

116

(loop for i from 0 below 128 by 16 do

117

(argon2-round (aref work-block i)

118

(aref work-block (+ i 1))

119

(aref work-block (+ i 2))

120

(aref work-block (+ i 3))

121

(aref work-block (+ i 4))

122

(aref work-block (+ i 5))

123

(aref work-block (+ i 6))

124

(aref work-block (+ i 7))

125

(aref work-block (+ i 8))

126

(aref work-block (+ i 9))

127

(aref work-block (+ i 10))

128

(aref work-block (+ i 11))

129

(aref work-block (+ i 12))

130

(aref work-block (+ i 13))

131

(aref work-block (+ i 14))

132

(aref work-block (+ i 15))))

133

(loop for i from 0 below 16 by 2 do

134

(argon2-round (aref work-block i)

135

(aref work-block (+ i 1))

136

(aref work-block (+ i 16))

137

(aref work-block (+ i 17))

138

(aref work-block (+ i 32))

139

(aref work-block (+ i 33))

140

(aref work-block (+ i 48))

141

(aref work-block (+ i 49))

142

(aref work-block (+ i 64))

143

(aref work-block (+ i 65))

144

(aref work-block (+ i 80))

145

(aref work-block (+ i 81))

146

(aref work-block (+ i 96))

147

(aref work-block (+ i 97))

148

(aref work-block (+ i 112))

149

(aref work-block (+ i 113))))

150

(values))

151

152

(defun argon2-g-copy (work-area r x y)

153

(declare (type (simple-array (unsigned-byte 64) (*)) work-area))

154

(let ((tmp (make-array +argon2-block-size+ :element-type '(unsigned-byte 64))))

155

(declare (type argon2-block tmp)

156

(dynamic-extent tmp))

157

(argon2-copy-block tmp work-area :start2 x)

158

(argon2-xor-block tmp work-area :start2 y)

159

(argon2-copy-block work-area tmp :start1 r)

160

(argon2-g-rounds tmp)

161

(argon2-xor-block work-area tmp :start1 r))

162

(values))

163

164

(defun argon2-g-xor (work-area r x y)

165

(declare (type (simple-array (unsigned-byte 64) (*)) work-area))

166

(let ((tmp (make-array +argon2-block-size+ :element-type '(unsigned-byte 64))))

167

(declare (type argon2-block tmp)

168

(dynamic-extent tmp))

169

(argon2-copy-block tmp work-area :start2 x)

170

(argon2-xor-block tmp work-area :start2 y)

171

(argon2-xor-block work-area tmp :start1 r)

172

(argon2-g-rounds tmp)

173

(argon2-xor-block work-area tmp :start1 r))

174

(values))

175

176

(defun argon2-unary-g (work-block)

177

(declare (type argon2-block work-block))

178

(let ((tmp (make-array +argon2-block-size+ :element-type '(unsigned-byte 64))))

179

(declare (type argon2-block tmp)

180

(dynamic-extent tmp))

181

(argon2-copy-block tmp work-block)

182

(argon2-g-rounds work-block)

183

(argon2-xor-block work-block tmp))

184

(values))

185

186

(defun argon2i-gidx-refresh (state)

187

(let ((b (argon2-block state)))

188

(setf (aref b 0) (argon2-pass-number state)

189

(aref b 1) 0

190

(aref b 2) (argon2-slice-number state)

191

(aref b 3) (argon2-nb-blocks state)

192

(aref b 4) (argon2-nb-iterations state)

193

(aref b 5) (etypecase state

194

(argon2i 1)

195

(argon2id 2))

196

(aref b 6) (argon2-counter state))

197

(fill b 0 :start 7)

198

(argon2-unary-g b)

199

(argon2-unary-g b)

200

(values)))

201

202

(defun argon2i-gidx-init (state pass-number slice-number nb-blocks nb-iterations)

203

(setf (argon2-pass-number state) pass-number

204

(argon2-slice-number state) slice-number

205

(argon2-nb-blocks state) nb-blocks

206

(argon2-nb-iterations state) nb-iterations

207

(argon2-counter state) 0)

208

(if (and (zerop pass-number) (zerop slice-number))

209

(progn

210

(setf (argon2-offset state) 2)

211

(incf (argon2-counter state))

212

(argon2i-gidx-refresh state))

213

(setf (argon2-offset state) 0))

214

(values))

215

216

(defun argon2i-gidx-next (state)

217

(when (zerop (mod (argon2-offset state) +argon2-block-size+))

218

(incf (argon2-counter state))

219

(argon2i-gidx-refresh state))

220

(let* ((offset (argon2-offset state))

221

(index (mod offset +argon2-block-size+))

222

(first-pass (zerop (argon2-pass-number state)))

223

(nb-blocks (argon2-nb-blocks state))

224

(slice-size (floor nb-blocks 4))

225

(slice-number (argon2-slice-number state))

226

(nb-segments (if first-pass slice-number 3))

227

(area-size (- (+ (* nb-segments slice-size) offset) 1))

228

(next-slice (* (mod (+ slice-number 1) 4) slice-size))

229

(start-pos (if first-pass 0 next-slice))

230

(j1 (logand (aref (argon2-block state) index) #xffffffff))

231

(x (ash (* j1 j1) -32))

232

(y (ash (* area-size x) -32))

233

(z (- area-size 1 y)))

234

(incf (argon2-offset state))

235

(mod (+ start-pos z) nb-blocks)))

236

237

(defun argon2d-gidx-init (state pass-number slice-number nb-blocks nb-iterations)

238

(setf (argon2-pass-number state) pass-number

239

(argon2-slice-number state) slice-number

240

(argon2-nb-blocks state) nb-blocks

241

(argon2-nb-iterations state) nb-iterations

242

(argon2-counter state) 0)

243

(if (and (zerop pass-number) (zerop slice-number))

244

(setf (argon2-offset state) 2)

245

(setf (argon2-offset state) 0))

246

(values))

247

248

(defun argon2d-gidx-next (state previous-block)

249

(let* ((offset (argon2-offset state))

250

(index (* +argon2-block-size+ previous-block))

251

(first-pass (zerop (argon2-pass-number state)))

252

(nb-blocks (argon2-nb-blocks state))

253

(slice-size (floor nb-blocks 4))

254

(slice-number (argon2-slice-number state))

255

(nb-segments (if first-pass slice-number 3))

256

(area-size (- (+ (* nb-segments slice-size) offset) 1))

257

(next-slice (* (mod (+ slice-number 1) 4) slice-size))

258

(start-pos (if first-pass 0 next-slice))

259

(j1 (logand (aref (argon2-work-area state) index) #xffffffff))

260

(x (ash (* j1 j1) -32))

261

(y (ash (* area-size x) -32))

262

(z (- area-size 1 y)))

263

(incf (argon2-offset state))

264

(mod (+ start-pos z) nb-blocks)))

265

266

(defmethod shared-initialize ((kdf argon2) slot-names &rest initargs

267

                               &key block-count additional-key additional-data &allow-other-keys)

268

(declare (ignore initargs))

269

(let ((no-data (make-array 0 :element-type '(unsigned-byte 8))))

270

(setf (argon2-block kdf) (make-array +argon2-block-size+

271

:element-type '(unsigned-byte 64))

272

(argon2-block-count kdf) (max 8 (or block-count 4096))

273

(argon2-additional-key kdf) (or additional-key no-data)

274

(argon2-additional-data kdf) (or additional-data no-data)

275

(argon2-work-area kdf) (make-array (* +argon2-block-size+ block-count)

276

                                              :element-type '(unsigned-byte 64))

277

(argon2-digester kdf) (make-mac :blake2-mac no-data)))

278

kdf)

279

280

(defmethod derive-key ((kdf argon2) passphrase salt iteration-count key-length)

281

(declare (type (simple-array (unsigned-byte 8) (*)) passphrase salt))

282

(when (or (< key-length 4) (< iteration-count 1) (< (length salt) 8))

283

(error 'unsupported-argon2-parameters))

284

(setf (argon2-nb-iterations kdf) iteration-count)

285

(let ((data-independent-p (or (typep kdf 'argon2i) (typep kdf 'argon2id)))

286

(work-area (argon2-work-area kdf))

287

(block-count (argon2-block-count kdf))

288

(additional-key (argon2-additional-key kdf))

289

(additional-data (argon2-additional-data kdf))

290

(digester (argon2-digester kdf))

291

(no-key (make-array 0 :element-type '(unsigned-byte 8)))

292

(tmp-area (make-array 1024 :element-type '(unsigned-byte 8))))

293

(declare (type (simple-array (unsigned-byte 64) (*)) work-area)

294

(type (simple-array (unsigned-byte 8) (1024)) tmp-area)

295

(dynamic-extent tmp-area))

296

(reinitialize-instance digester :key no-key :digest-length 64)

297

(argon2-update-digester-32 digester 1)

298

(argon2-update-digester-32 digester key-length)

299

(argon2-update-digester-32 digester block-count)

300

(argon2-update-digester-32 digester iteration-count)

301

(argon2-update-digester-32 digester #x13)

302

(argon2-update-digester-32 digester (etypecase kdf

303

(argon2d 0)

304

(argon2i 1)

305

(argon2id 2)))

306

(argon2-update-digester-32 digester (length passphrase))

307

(update-mac digester passphrase)

308

(argon2-update-digester-32 digester (length salt))

309

(update-mac digester salt)

310

(argon2-update-digester-32 digester (length additional-key))

311

(update-mac digester additional-key)

312

(argon2-update-digester-32 digester (length additional-data))

313

(update-mac digester additional-data)

314

(let ((initial-hash (make-array 72 :element-type '(unsigned-byte 8)))

315

(tmp-block (make-array +argon2-block-size+ :element-type '(unsigned-byte 64))))

316

(declare (type (simple-array (unsigned-byte 8) (72)) initial-hash)

317

(type argon2-block tmp-block)

318

(dynamic-extent initial-hash tmp-block))

319

(produce-mac digester :digest initial-hash)

320

321

(setf (ub32ref/le initial-hash 64) 0

322

(ub32ref/le initial-hash 68) 0)

323

(argon2-extended-hash kdf tmp-area 1024 initial-hash 72)

324

(argon2-load-block tmp-block tmp-area)

325

(argon2-copy-block work-area tmp-block)

326

327

(setf (ub32ref/le initial-hash 64) 1)

328

(argon2-extended-hash kdf tmp-area 1024 initial-hash 72)

329

(argon2-load-block tmp-block tmp-area)

330

(argon2-copy-block work-area tmp-block :start1 1))

331

332

(let* ((nb-blocks (- block-count (mod block-count 4)))

333

(segment-size (floor nb-blocks 4)))

334

(dotimes (pass-number iteration-count)

335

(let ((first-pass (zerop pass-number)))

336

(dotimes (segment 4)

337

(when (and (= segment 2) (typep kdf 'argon2id))

338

(setf data-independent-p nil))

339

(if data-independent-p

340

(argon2i-gidx-init kdf pass-number segment nb-blocks iteration-count)

341

(argon2d-gidx-init kdf pass-number segment nb-blocks iteration-count))

342

(let* ((start-offset (if (and first-pass (zerop segment)) 2 0))

343

(segment-start (+ (* segment segment-size) start-offset))

344

(segment-end (* (+ segment 1) segment-size)))

345

(loop for current-block from segment-start below segment-end do

346

(let* ((previous-block (if (zerop current-block)

347

(- nb-blocks 1)

348

(- current-block 1)))

349

(reference-block (if data-independent-p

350

(argon2i-gidx-next kdf)

351

                                             (argon2d-gidx-next kdf previous-block))))

352

(if first-pass

353

(argon2-g-copy work-area current-block previous-block reference-block)

354

                       (argon2-g-xor work-area current-block previous-block reference-block))))))))

355

(let ((hash (make-array key-length :element-type '(unsigned-byte 8))))

356

(argon2-store-block tmp-area work-area :start2 (- nb-blocks 1))

357

(argon2-extended-hash kdf hash key-length tmp-area 1024)

358

hash))))