Coverage report: /home/ellis/comp/ext/ironclad/src/digests/ripemd-160.lisp

Kind	Covered	All	%
expression	1	181	0.6
branch	0	2	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; ripemd-160.lisp -- the RIPEMD-160 digest function

2

3

(in-package :crypto)

4

5

(define-digest-registers (ripemd-160 :endian :little)

6

(a #x67452301)

7

(b #xefcdab89)

8

(c #x98badcfe)

9

(d #x10325476)

10

(e #xc3d2e1f0))

11

12

(defconst +pristine-ripemd-160-registers+ (initial-ripemd-160-regs))

13

14

(defun update-ripemd-160-block (regs block)

15

(declare (type ripemd-160-regs regs)

16

(type (simple-array (unsigned-byte 32) (16)) block)

17

#.(burn-baby-burn))

18

(let* ((a1 (ripemd-160-regs-a regs)) (a2 a1)

19

(b1 (ripemd-160-regs-b regs)) (b2 b1)

20

(c1 (ripemd-160-regs-c regs)) (c2 c1)

21

(d1 (ripemd-160-regs-d regs)) (d2 d1)

22

(e1 (ripemd-160-regs-e regs)) (e2 e1))

23

(declare (type (unsigned-byte 32) a1 a2 b1 b2 c1 c2 d1 d2 e1 e2))

24

(flet ((f (x y z)

25

(declare (type (unsigned-byte 32) x y z))

26

(ldb (byte 32 0) (logxor x y z)))

27

(g (x y z)

28

(declare (type (unsigned-byte 32) x y z))

29

(ldb (byte 32 0) (logxor z (logand x (logxor y z)))))

30

(h (x y z)

31

(declare (type (unsigned-byte 32) x y z))

32

(ldb (byte 32 0) (logxor z (logior x (lognot y)))))

33

(i (x y z)

34

(declare (type (unsigned-byte 32) x y z))

35

(ldb (byte 32 0) (logxor y (logand z (logxor x y)))))

36

(j (x y z)

37

(declare (type (unsigned-byte 32) x y z))

38

(ldb (byte 32 0) (logxor x (logior y (lognot z))))))

39

#+ironclad-fast-mod32-arithmetic

40

(declare (inline f g h i j))

41

(macrolet ((subround (func a b c d e x s k)

42

`(progn

43

(setf ,a (mod32+ ,a

44

(mod32+ (funcall (function ,func) ,b ,c ,d)

45

(mod32+ ,x ,k))))

46

(setf ,a (mod32+ (rol32 ,a ,s) ,e))

47

(setf ,c (rol32 ,c 10))))

48

(with-ripemd-round ((block func constant) &rest clauses)

49

(loop for (a b c d e i s) in clauses

50

collect `(subround ,func ,a ,b ,c ,d ,e (aref ,block ,i)

51

,s ,constant)

52

into result

53

finally (return `(progn ,@result)))))

54

(with-ripemd-round (block f 0)

55

(a1 b1 c1 d1 e1 0 11) (e1 a1 b1 c1 d1 1 14)

56

(d1 e1 a1 b1 c1 2 15) (c1 d1 e1 a1 b1 3 12)

57

(b1 c1 d1 e1 a1 4 5) (a1 b1 c1 d1 e1 5 8)

58

(e1 a1 b1 c1 d1 6 7) (d1 e1 a1 b1 c1 7 9)

59

(c1 d1 e1 a1 b1 8 11) (b1 c1 d1 e1 a1 9 13)

60

(a1 b1 c1 d1 e1 10 14) (e1 a1 b1 c1 d1 11 15)

61

(d1 e1 a1 b1 c1 12 6) (c1 d1 e1 a1 b1 13 7)

62

(b1 c1 d1 e1 a1 14 9) (a1 b1 c1 d1 e1 15 8))

63

(with-ripemd-round (block g #x5a827999)

64

(e1 a1 b1 c1 d1 7 7) (d1 e1 a1 b1 c1 4 6)

65

(c1 d1 e1 a1 b1 13 8) (b1 c1 d1 e1 a1 1 13)

66

(a1 b1 c1 d1 e1 10 11) (e1 a1 b1 c1 d1 6 9)

67

(d1 e1 a1 b1 c1 15 7) (c1 d1 e1 a1 b1 3 15)

68

(b1 c1 d1 e1 a1 12 7) (a1 b1 c1 d1 e1 0 12)

69

(e1 a1 b1 c1 d1 9 15) (d1 e1 a1 b1 c1 5 9)

70

(c1 d1 e1 a1 b1 2 11) (b1 c1 d1 e1 a1 14 7)

71

(a1 b1 c1 d1 e1 11 13) (e1 a1 b1 c1 d1 8 12))

72

(with-ripemd-round (block h #x6ed9eba1)

73

(d1 e1 a1 b1 c1 3 11) (c1 d1 e1 a1 b1 10 13)

74

(b1 c1 d1 e1 a1 14 6) (a1 b1 c1 d1 e1 4 7)

75

(e1 a1 b1 c1 d1 9 14) (d1 e1 a1 b1 c1 15 9)

76

(c1 d1 e1 a1 b1 8 13) (b1 c1 d1 e1 a1 1 15)

77

(a1 b1 c1 d1 e1 2 14) (e1 a1 b1 c1 d1 7 8)

78

(d1 e1 a1 b1 c1 0 13) (c1 d1 e1 a1 b1 6 6)

79

(b1 c1 d1 e1 a1 13 5) (a1 b1 c1 d1 e1 11 12)

80

(e1 a1 b1 c1 d1 5 7) (d1 e1 a1 b1 c1 12 5))

81

(with-ripemd-round (block i #x8f1bbcdc)

82

(c1 d1 e1 a1 b1 1 11) (b1 c1 d1 e1 a1 9 12)

83

(a1 b1 c1 d1 e1 11 14) (e1 a1 b1 c1 d1 10 15)

84

(d1 e1 a1 b1 c1 0 14) (c1 d1 e1 a1 b1 8 15)

85

(b1 c1 d1 e1 a1 12 9) (a1 b1 c1 d1 e1 4 8)

86

(e1 a1 b1 c1 d1 13 9) (d1 e1 a1 b1 c1 3 14)

87

(c1 d1 e1 a1 b1 7 5) (b1 c1 d1 e1 a1 15 6)

88

(a1 b1 c1 d1 e1 14 8) (e1 a1 b1 c1 d1 5 6)

89

(d1 e1 a1 b1 c1 6 5) (c1 d1 e1 a1 b1 2 12))

90

(with-ripemd-round (block j #xa953fd4e)

91

(b1 c1 d1 e1 a1 4 9) (a1 b1 c1 d1 e1 0 15)

92

(e1 a1 b1 c1 d1 5 5) (d1 e1 a1 b1 c1 9 11)

93

(c1 d1 e1 a1 b1 7 6) (b1 c1 d1 e1 a1 12 8)

94

(a1 b1 c1 d1 e1 2 13) (e1 a1 b1 c1 d1 10 12)

95

(d1 e1 a1 b1 c1 14 5) (c1 d1 e1 a1 b1 1 12)

96

(b1 c1 d1 e1 a1 3 13) (a1 b1 c1 d1 e1 8 14)

97

(e1 a1 b1 c1 d1 11 11) (d1 e1 a1 b1 c1 6 8)

98

(c1 d1 e1 a1 b1 15 5) (b1 c1 d1 e1 a1 13 6))

99

(with-ripemd-round (block j #x50a28be6)

100

(a2 b2 c2 d2 e2 5 8) (e2 a2 b2 c2 d2 14 9)

101

(d2 e2 a2 b2 c2 7 9) (c2 d2 e2 a2 b2 0 11)

102

(b2 c2 d2 e2 a2 9 13) (a2 b2 c2 d2 e2 2 15)

103

(e2 a2 b2 c2 d2 11 15) (d2 e2 a2 b2 c2 4 5)

104

(c2 d2 e2 a2 b2 13 7) (b2 c2 d2 e2 a2 6 7)

105

(a2 b2 c2 d2 e2 15 8) (e2 a2 b2 c2 d2 8 11)

106

(d2 e2 a2 b2 c2 1 14) (c2 d2 e2 a2 b2 10 14)

107

(b2 c2 d2 e2 a2 3 12) (a2 b2 c2 d2 e2 12 6))

108

(with-ripemd-round (block i #x5c4dd124)

109

(e2 a2 b2 c2 d2 6 9) (d2 e2 a2 b2 c2 11 13)

110

(c2 d2 e2 a2 b2 3 15) (b2 c2 d2 e2 a2 7 7)

111

(a2 b2 c2 d2 e2 0 12) (e2 a2 b2 c2 d2 13 8)

112

(d2 e2 a2 b2 c2 5 9) (c2 d2 e2 a2 b2 10 11)

113

(b2 c2 d2 e2 a2 14 7) (a2 b2 c2 d2 e2 15 7)

114

(e2 a2 b2 c2 d2 8 12) (d2 e2 a2 b2 c2 12 7)

115

(c2 d2 e2 a2 b2 4 6) (b2 c2 d2 e2 a2 9 15)

116

(a2 b2 c2 d2 e2 1 13) (e2 a2 b2 c2 d2 2 11))

117

(with-ripemd-round (block h #x6d703ef3)

118

(d2 e2 a2 b2 c2 15 9) (c2 d2 e2 a2 b2 5 7)

119

(b2 c2 d2 e2 a2 1 15) (a2 b2 c2 d2 e2 3 11)

120

(e2 a2 b2 c2 d2 7 8) (d2 e2 a2 b2 c2 14 6)

121

(c2 d2 e2 a2 b2 6 6) (b2 c2 d2 e2 a2 9 14)

122

(a2 b2 c2 d2 e2 11 12) (e2 a2 b2 c2 d2 8 13)

123

(d2 e2 a2 b2 c2 12 5) (c2 d2 e2 a2 b2 2 14)

124

(b2 c2 d2 e2 a2 10 13) (a2 b2 c2 d2 e2 0 13)

125

(e2 a2 b2 c2 d2 4 7) (d2 e2 a2 b2 c2 13 5))

126

(with-ripemd-round (block g #x7a6d76e9)

127

(c2 d2 e2 a2 b2 8 15) (b2 c2 d2 e2 a2 6 5)

128

(a2 b2 c2 d2 e2 4 8) (e2 a2 b2 c2 d2 1 11)

129

(d2 e2 a2 b2 c2 3 14) (c2 d2 e2 a2 b2 11 14)

130

(b2 c2 d2 e2 a2 15 6) (a2 b2 c2 d2 e2 0 14)

131

(e2 a2 b2 c2 d2 5 6) (d2 e2 a2 b2 c2 12 9)

132

(c2 d2 e2 a2 b2 2 12) (b2 c2 d2 e2 a2 13 9)

133

(a2 b2 c2 d2 e2 9 12) (e2 a2 b2 c2 d2 7 5)

134

(d2 e2 a2 b2 c2 10 15) (c2 d2 e2 a2 b2 14 8))

135

(with-ripemd-round (block f 0)

136

(b2 c2 d2 e2 a2 12 8) (a2 b2 c2 d2 e2 15 5)

137

(e2 a2 b2 c2 d2 10 12) (d2 e2 a2 b2 c2 4 9)

138

(c2 d2 e2 a2 b2 1 12) (b2 c2 d2 e2 a2 5 5)

139

(a2 b2 c2 d2 e2 8 14) (e2 a2 b2 c2 d2 7 6)

140

(d2 e2 a2 b2 c2 6 8) (c2 d2 e2 a2 b2 2 13)

141

(b2 c2 d2 e2 a2 13 6) (a2 b2 c2 d2 e2 14 5)

142

(e2 a2 b2 c2 d2 0 15) (d2 e2 a2 b2 c2 3 13)

143

(c2 d2 e2 a2 b2 9 11) (b2 c2 d2 e2 a2 11 11))

144

(setf c1 (mod32+ (ripemd-160-regs-b regs) (mod32+ c1 d2))

145

(ripemd-160-regs-b regs) (mod32+ (ripemd-160-regs-c regs) (mod32+ d1 e2))

146

(ripemd-160-regs-c regs) (mod32+ (ripemd-160-regs-d regs) (mod32+ e1 a2))

147

(ripemd-160-regs-d regs) (mod32+ (ripemd-160-regs-e regs) (mod32+ a1 b2))

148

(ripemd-160-regs-e regs) (mod32+ (ripemd-160-regs-a regs) (mod32+ b1 c2))

149

(ripemd-160-regs-a regs) c1)

150

regs))))

151

152

(defstruct (ripemd-160

153

(:constructor %make-ripemd-160-digest nil)

154

(:constructor %make-ripemd-160-state (regs amount block buffer buffer-index))

155

(:copier nil)

156

(:include mdx))

157

(regs (initial-ripemd-160-regs) :type ripemd-160-regs :read-only t)

158

(block (make-array 16 :element-type '(unsigned-byte 32))

159

:type (simple-array (unsigned-byte 32) (16)) :read-only t))

160

161

(defmethod reinitialize-instance ((state ripemd-160) &rest initargs)

162

(declare (ignore initargs))

163

(replace (ripemd-160-regs state) +pristine-ripemd-160-registers+)

164

(setf (ripemd-160-amount state) 0

165

(ripemd-160-buffer-index state) 0)

166

state)

167

168

(defmethod copy-digest ((state ripemd-160) &optional copy)

169

(check-type copy (or null ripemd-160))

170

(cond

171

(copy

172

(replace (ripemd-160-regs copy) (ripemd-160-regs state))

173

(replace (ripemd-160-buffer copy) (ripemd-160-buffer state))

174

(setf (ripemd-160-amount copy) (ripemd-160-amount state)

175

(ripemd-160-buffer-index copy) (ripemd-160-buffer-index state))

176

copy)

177

(t

178

(%make-ripemd-160-state (copy-seq (ripemd-160-regs state))

179

(ripemd-160-amount state)

180

(copy-seq (ripemd-160-block state))

181

(copy-seq (ripemd-160-buffer state))

182

(ripemd-160-buffer-index state)))))

183

184

(define-digest-updater ripemd-160

185

"Update the given ripemd-160-state from sequence, which is either a

186

simple-string or a simple-array with element-type (unsigned-byte 8),

187

bounded by start and end, which must be numeric bounding-indices."

188

(flet ((compress (state sequence offset)

189

(let ((block (ripemd-160-block state)))

190

(fill-block-ub8-le block sequence offset)

191

(update-ripemd-160-block (ripemd-160-regs state) block))))

192

(declare (dynamic-extent #'compress))

193

(declare (notinline mdx-updater))

194

(mdx-updater state #'compress sequence start end)))

195

196

(define-digest-finalizer (ripemd-160 20)

197

"If the given ripemd-160-state has not already been finalized, finalize it,

198

by processing any remaining input in its buffer, with suitable padding

199

and appended bit-length, as specified by the RIPEMD-160 standard.

200

201

The resulting RIPEMD-160 message-digest is returned as an array of twenty

202

(unsigned-byte 8) values. Calling `update-ripemd-160-state' after a call to

203

`finalize-ripemd-160-state' results in unspecified behaviour."

204

(let ((regs (ripemd-160-regs state))

205

(block (ripemd-160-block state))

206

(buffer (ripemd-160-buffer state))

207

(buffer-index (ripemd-160-buffer-index state))

208

(total-length (* 8 (ripemd-160-amount state))))

209

(declare (type ripemd-160-regs regs)

210

(type (integer 0 63) buffer-index)

211

(type (simple-array (unsigned-byte 32) (16)) block)

212

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

213

;; Add mandatory bit 1 padding

214

(setf (aref buffer buffer-index) #x80)

215

;; Fill with 0 bit padding

216

(loop for index of-type (integer 0 64)

217

from (1+ buffer-index) below 64

218

do (setf (aref buffer index) #x00))

219

(fill-block-ub8-le block buffer 0)

220

;; Flush block first if length wouldn't fit

221

(when (>= buffer-index 56)

222

(update-ripemd-160-block regs block)

223

;; Create new fully 0 padded block

224

(loop for index of-type (integer 0 16) from 0 below 16

225

do (setf (aref block index) #x00000000)))

226

;; Add 64bit message bit length

227

(store-data-length block total-length 14)

228

;; Flush last block

229

(update-ripemd-160-block regs block)

230

;; Done, remember digest for later calls

231

(finalize-registers state regs)))

232

233

(defdigest ripemd-160 :digest-length 20 :block-length 64)