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

Kind	Covered	All	%
expression	1	164	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-128.lisp -- the RIPEMD-128 digest function

2

3

(in-package :crypto)

4

5

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

6

(a #x67452301)

7

(b #xefcdab89)

8

(c #x98badcfe)

9

(d #x10325476))

10

11

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

12

13

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

14

(declare (type ripemd-128-regs regs)

15

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

16

#.(burn-baby-burn))

17

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

18

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

19

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

20

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

21

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

22

;; define the necessary logical functions

23

(flet ((f (x y z)

24

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

25

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

26

(g (x y z)

27

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

28

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

29

(h (x y z)

30

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

31

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

32

(i (x y z)

33

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

34

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

35

#+ironclad-fast-mod32-arithmetic

36

(declare (inline f g h i))

37

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

38

`(progn

39

(setf ,a (mod32+ ,a

40

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

41

(mod32+ ,x ,k))))

42

(setf ,a (rol32 ,a ,s))))

43

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

44

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

45

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

46

,s ,constant)

47

into result

48

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

49

(with-ripemd-round (block f 0)

50

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

51

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

52

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

53

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

54

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

55

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

56

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

57

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

58

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

59

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

60

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

61

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

62

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

63

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

64

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

65

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

66

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

67

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

68

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

69

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

70

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

71

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

72

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

73

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

74

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

75

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

76

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

77

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

78

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

79

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

80

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

81

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

82

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

83

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

84

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

85

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

86

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

87

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

88

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

89

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

90

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

91

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

92

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

93

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

94

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

95

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

96

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

97

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

98

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

99

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

100

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

101

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

102

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

103

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

104

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

105

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

106

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

107

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

108

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

109

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

110

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

111

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

112

(with-ripemd-round (block f 0)

113

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

114

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

115

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

116

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

117

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

118

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

119

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

120

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

121

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

122

(ripemd-128-regs-b regs) (mod32+ (ripemd-128-regs-c regs) (mod32+ d1 a2))

123

(ripemd-128-regs-c regs) (mod32+ (ripemd-128-regs-d regs) (mod32+ a1 b2))

124

(ripemd-128-regs-d regs) (mod32+ (ripemd-128-regs-a regs) (mod32+ b1 c2))

125

(ripemd-128-regs-a regs) d2)

126

regs))))

127

128

(defstruct (ripemd-128

129

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

130

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

131

(:copier nil)

132

(:include mdx))

133

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

134

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

135

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

136

137

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

138

(declare (ignore initargs))

139

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

140

(setf (ripemd-128-amount state) 0

141

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

142

state)

143

144

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

145

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

146

(cond

147

(copy

148

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

149

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

150

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

151

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

152

copy)

153

(t

154

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

155

(ripemd-128-amount state)

156

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

157

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

158

(ripemd-128-buffer-index state)))))

159

160

(define-digest-updater ripemd-128

161

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

162

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

163

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

164

(flet ((compress (state sequence offset)

165

(let ((block (ripemd-128-block state)))

166

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

167

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

168

(declare (dynamic-extent #'compress))

169

(declare (notinline mdx-updater))

170

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

171

172

(define-digest-finalizer (ripemd-128 16)

173

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

174

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

175

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

176

177

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

178

(unsigned-byte 8) values. Calling UPDATE-RIPEMD-128-STATE after a call to

179

FINALIZE-RIPEMD-128-STATE results in unspecified behaviour."

180

(let ((regs (ripemd-128-regs state))

181

(block (ripemd-128-block state))

182

(buffer (ripemd-128-buffer state))

183

(buffer-index (ripemd-128-buffer-index state))

184

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

185

(declare (type ripemd-128-regs regs)

186

(type (integer 0 63) buffer-index)

187

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

188

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

189

;; Add mandatory bit 1 padding

190

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

191

;; Fill with 0 bit padding

192

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

193

from (1+ buffer-index) below 64

194

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

195

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

196

;; Flush block first if length wouldn't fit

197

(when (>= buffer-index 56)

198

(update-ripemd-128-block regs block)

199

;; Create new fully 0 padded block

200

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

201

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

202

;; Add 64bit message bit length

203

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

204

;; Flush last block

205

(update-ripemd-128-block regs block)

206

;; Done, remember digest for later calls

207

(finalize-registers state regs)))

208

209

(defdigest ripemd-128 :digest-length 16 :block-length 64)