Coverage report: /home/ellis/comp/ext/ironclad/src/digests/blake2.lisp

Kind	Covered	All	%
expression	0	450	0.0
branch	0	16	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; blake2.lisp -- implementation of the BLAKE2b hash function (RFC 7693)

2

(in-package :crypto)

3

4

;;; Parameters

5

(eval-when (:compile-toplevel :load-toplevel :execute)

6

(defconstant +blake2-rounds+ 12)

7

(defconstant +blake2-block-size+ 128)

8

(defconst +blake2-sigma+

9

(make-array '(12 16)

10

:element-type '(integer 0 15)

11

:initial-contents '((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)

12

                                     (14 10 4 8 9 15 13 6 1 12 0 2 11 7 5 3)

13

                                     (11 8 12 0 5 2 15 13 10 14 3 6 7 1 9 4)

14

                                     (7 9 3 1 13 12 11 14 2 6 5 10 4 0 15 8)

15

                                     (9 0 5 7 2 4 10 15 14 1 11 12 6 8 3 13)

16

                                     (2 12 6 10 0 11 8 3 4 13 7 5 15 14 1 9)

17

                                     (12 5 1 15 14 13 4 10 0 7 6 3 9 2 8 11)

18

                                     (13 11 7 14 12 1 3 9 5 0 15 4 8 6 2 10)

19

                                     (6 15 14 9 11 3 0 8 12 2 13 7 1 4 10 5)

20

                                     (10 2 8 4 7 6 1 5 15 11 9 14 3 12 13 0)

21

                                     (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)

22

                                     (14 10 4 8 9 15 13 6 1 12 0 2 11 7 5 3))))

23

(defconst +blake2-iv+

24

(make-array 8

25

:element-type '(unsigned-byte 64)

26

:initial-contents '(#x6A09E667F3BCC908

27

#xBB67AE8584CAA73B

28

#x3C6EF372FE94F82B

29

#xA54FF53A5F1D36F1

30

#x510E527FADE682D1

31

#x9B05688C2B3E6C1F

32

#x1F83D9ABFB41BD6B

33

#x5BE0CD19137E2179))))

34

35

(defun blake2-make-initial-state (output-length &optional (key-length 0))

36

(when (> output-length 64)

37

(error 'ironclad-error :format-control "The output length must be at most 64 bytes."))

38

(when (> key-length 64)

39

(error 'ironclad-error :format-control "The key length must be at most 64 bytes."))

40

(let ((state (copy-seq +blake2-iv+)))

41

(setf (aref state 0) (logxor (aref state 0)

42

#x01010000

43

(ash key-length 8)

44

output-length))

45

state))

46

47

;;; Blake2b rounds

48

(declaim (ftype (function ((simple-array (unsigned-byte 64) (8))

49

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

50

fixnum

51

(unsigned-byte 128)

52

boolean))

53

blake2-rounds))

54

(defun blake2-rounds (state input start offset final)

55

(declare (type (simple-array (unsigned-byte 64) (8)) state)

56

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

57

(type fixnum start)

58

(type (unsigned-byte 128) offset)

59

(type boolean final)

60

(optimize (speed 3) (space 0) (safety 0) (debug 0)))

61

(macrolet ((blake2-mixing (va vb vc vd x y)

62

`(setf ,va (mod64+ (mod64+ ,va ,vb) ,x)

63

,vd (ror64 (logxor ,vd ,va) 32)

64

,vc (mod64+ ,vc ,vd)

65

,vb (ror64 (logxor ,vb ,vc) 24)

66

,va (mod64+ (mod64+ ,va ,vb) ,y)

67

,vd (ror64 (logxor ,vd ,va) 16)

68

,vc (mod64+ ,vc ,vd)

69

,vb (ror64 (logxor ,vb ,vc) 63))))

70

(let ((v0 (aref state 0))

71

(v1 (aref state 1))

72

(v2 (aref state 2))

73

(v3 (aref state 3))

74

(v4 (aref state 4))

75

(v5 (aref state 5))

76

(v6 (aref state 6))

77

(v7 (aref state 7))

78

(v8 (aref +blake2-iv+ 0))

79

(v9 (aref +blake2-iv+ 1))

80

(v10 (aref +blake2-iv+ 2))

81

(v11 (aref +blake2-iv+ 3))

82

(v12 (aref +blake2-iv+ 4))

83

(v13 (aref +blake2-iv+ 5))

84

(v14 (aref +blake2-iv+ 6))

85

(v15 (aref +blake2-iv+ 7))

86

(m (make-array 16 :element-type '(unsigned-byte 64) :initial-element 0)))

87

       (declare (type (unsigned-byte 64) v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)

88

(type (simple-array (unsigned-byte 64) (16)) m)

89

(dynamic-extent m))

90

(setf v12 (logxor v12 (ldb (byte 64 0) offset))

91

v13 (logxor v13 (ldb (byte 64 64) offset)))

92

(when final

93

(setf v14 (logxor v14 #xFFFFFFFFFFFFFFFF)))

94

95

;; Get input data as 64-bit little-endian integers

96

(dotimes-unrolled (i 16)

97

(setf (aref m i) (ub64ref/le input (+ start (* i 8)))))

98

99

;; Mixing rounds

100

(dotimes-unrolled (i +blake2-rounds+)

101

         (blake2-mixing v0 v4 v8 v12 (aref m (aref +blake2-sigma+ i 0)) (aref m (aref +blake2-sigma+ i 1)))

102

         (blake2-mixing v1 v5 v9 v13 (aref m (aref +blake2-sigma+ i 2)) (aref m (aref +blake2-sigma+ i 3)))

103

         (blake2-mixing v2 v6 v10 v14 (aref m (aref +blake2-sigma+ i 4)) (aref m (aref +blake2-sigma+ i 5)))

104

         (blake2-mixing v3 v7 v11 v15 (aref m (aref +blake2-sigma+ i 6)) (aref m (aref +blake2-sigma+ i 7)))

105

         (blake2-mixing v0 v5 v10 v15 (aref m (aref +blake2-sigma+ i 8)) (aref m (aref +blake2-sigma+ i 9)))

106

         (blake2-mixing v1 v6 v11 v12 (aref m (aref +blake2-sigma+ i 10)) (aref m (aref +blake2-sigma+ i 11)))

107

         (blake2-mixing v2 v7 v8 v13 (aref m (aref +blake2-sigma+ i 12)) (aref m (aref +blake2-sigma+ i 13)))

108

         (blake2-mixing v3 v4 v9 v14 (aref m (aref +blake2-sigma+ i 14)) (aref m (aref +blake2-sigma+ i 15))))

109

110

;; Compute new state

111

(setf (aref state 0) (logxor (aref state 0) v0 v8)

112

(aref state 1) (logxor (aref state 1) v1 v9)

113

(aref state 2) (logxor (aref state 2) v2 v10)

114

(aref state 3) (logxor (aref state 3) v3 v11)

115

(aref state 4) (logxor (aref state 4) v4 v12)

116

(aref state 5) (logxor (aref state 5) v5 v13)

117

(aref state 6) (logxor (aref state 6) v6 v14)

118

(aref state 7) (logxor (aref state 7) v7 v15))))

119

120

(values))

121

122

;;; Digest structures and functions

123

(defstruct (blake2

124

(:constructor %make-blake2-digest nil)

125

(:copier nil))

126

(state (blake2-make-initial-state 64)

127

:type (simple-array (unsigned-byte 64) (8)))

128

(offset 0 :type (unsigned-byte 128))

129

(buffer (make-array 128 :element-type '(unsigned-byte 8) :initial-element 0)

130

:type (simple-array (unsigned-byte 8) (128)))

131

(buffer-index 0 :type (integer 0 128)))

132

133

(defstruct (blake2/384

134

(:include blake2)

135

(:constructor %make-blake2/384-digest

136

(&aux (state (blake2-make-initial-state 48))))

137

(:copier nil)))

138

139

(defstruct (blake2/256

140

(:include blake2)

141

(:constructor %make-blake2/256-digest

142

(&aux (state (blake2-make-initial-state 32))))

143

(:copier nil)))

144

145

(defstruct (blake2/160

146

(:include blake2)

147

(:constructor %make-blake2/160-digest

148

(&aux (state (blake2-make-initial-state 20))))

149

(:copier nil)))

150

151

(defmethod reinitialize-instance ((state blake2) &rest initargs)

152

(declare (ignore initargs))

153

(setf (blake2-state state) (etypecase state

154

(blake2/160 (blake2-make-initial-state 20))

155

(blake2/256 (blake2-make-initial-state 32))

156

(blake2/384 (blake2-make-initial-state 48))

157

(blake2 (blake2-make-initial-state 64)))

158

(blake2-offset state) 0

159

(blake2-buffer-index state) 0)

160

state)

161

162

(defmethod copy-digest ((state blake2) &optional copy)

163

(check-type copy (or null blake2))

164

(let ((copy (if copy

165

copy

166

(etypecase state

167

(blake2/160 (%make-blake2/160-digest))

168

(blake2/256 (%make-blake2/256-digest))

169

(blake2/384 (%make-blake2/384-digest))

170

(blake2 (%make-blake2-digest))))))

171

(declare (type blake2 copy))

172

(replace (blake2-state copy) (blake2-state state))

173

(setf (blake2-offset copy) (blake2-offset state))

174

(replace (blake2-buffer copy) (blake2-buffer state))

175

(setf (blake2-buffer-index copy) (blake2-buffer-index state))

176

copy))

177

178

(defun blake2-update (state input start end final)

179

(declare (type blake2 state)

180

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

181

(type fixnum start end)

182

(type boolean final)

183

(optimize (speed 3) (space 0) (safety 0) (debug 0)))

184

(let ((blake2-state (blake2-state state))

185

(offset (blake2-offset state))

186

(buffer (blake2-buffer state))

187

(buffer-index (blake2-buffer-index state))

188

(length (- end start))

189

(n 0))

190

(declare (type (simple-array (unsigned-byte 64) (8)) blake2-state)

191

(type (unsigned-byte 128) offset)

192

(type (simple-array (unsigned-byte 8) (128)) buffer)

193

(type (integer 0 128) buffer-index)

194

(type fixnum length n))

195

196

;; Try to fill the buffer with the new data

197

(setf n (min length (- +blake2-block-size+ buffer-index)))

198

(replace buffer input :start1 buffer-index :start2 start :end2 (+ start n))

199

(unless final

200

(incf offset n))

201

(incf buffer-index n)

202

(incf start n)

203

(decf length n)

204

205

;; Process as many blocks as we can, but unless we are in the

206

;; final call, keep some data in the buffer (so that it can be

207

;; processed with the 'final' flag in the final call

208

209

;; Process data in buffer

210

(when (and (= buffer-index +blake2-block-size+)

211

(or final (plusp length)))

212

(blake2-rounds blake2-state buffer 0 offset final)

213

(setf buffer-index 0))

214

215

;; Process data in message

216

(unless final

217

(loop until (<= length +blake2-block-size+) do

218

(incf offset +blake2-block-size+)

219

(blake2-rounds blake2-state input start offset nil)

220

(incf start +blake2-block-size+)

221

(decf length +blake2-block-size+)))

222

223

;; Put remaining message data in buffer

224

(when (plusp length)

225

(replace buffer input :end1 length :start2 start)

226

(incf offset length)

227

(incf buffer-index length))

228

229

;; Save the new state

230

(setf (blake2-offset state) offset

231

(blake2-buffer-index state) buffer-index)

232

(values)))

233

234

(defun blake2-finalize (state digest digest-start)

235

(let* ((digest-length (digest-length state))

236

(blake2-state (blake2-state state))

237

(buffer-index (blake2-buffer-index state))

238

(padding-length (- +blake2-block-size+ buffer-index))

239

(padding (make-array padding-length

240

:element-type '(unsigned-byte 8)

241

:initial-element 0)))

242

243

;; Process remaining data after padding it

244

(blake2-update state padding 0 padding-length t)

245

246

;; Get output

247

(let ((output (make-array +blake2-block-size+ :element-type '(unsigned-byte 8) :initial-element 0)))

248

(dotimes (i 8)

249

(setf (ub64ref/le output (* i 8)) (aref blake2-state i)))

250

(replace digest output :start1 digest-start :end2 digest-length)

251

digest)))

252

253

(define-digest-updater blake2

254

(blake2-update state sequence start end nil))

255

256

(define-digest-finalizer ((blake2 64)

257

(blake2/384 48)

258

(blake2/256 32)

259

(blake2/160 20))

260

(blake2-finalize state digest digest-start))

261

262

(defdigest blake2 :digest-length 64 :block-length 128)

263

(defdigest blake2/384 :digest-length 48 :block-length 128)

264

(defdigest blake2/256 :digest-length 32 :block-length 128)

265

(defdigest blake2/160 :digest-length 20 :block-length 128)