Coverage report: /home/ellis/comp/ext/ironclad/src/macs/siphash.lisp

Kind	Covered	All	%
expression	0	271	0.0
branch	0	18	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; siphash.lisp -- implementation of the SipHash MAC

2

(in-package :crypto)

3

4

(defclass siphash (mac)

5

((state :accessor siphash-state

6

:initform (make-array 4 :element-type '(unsigned-byte 64))

7

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

8

(compression-rounds :accessor siphash-compression-rounds

9

:initarg :compression-rounds

10

:initform 2

11

:type fixnum)

12

(finalization-rounds :accessor siphash-finalization-rounds

13

:initarg :finalization-rounds

14

:initform 4

15

:type fixnum)

16

(digest-length :accessor siphash-digest-length

17

:initarg :digest-length

18

:initform 8

19

:type fixnum)

20

(data-length :accessor siphash-data-length

21

:initform 0

22

:type fixnum)

23

(buffer :accessor siphash-buffer

24

:initform (make-array 8 :element-type '(unsigned-byte 8))

25

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

26

(buffer-length :accessor siphash-buffer-length

27

:initform 0

28

:type (integer 0 8))))

29

30

(defun make-siphash (key &key (compression-rounds 2) (finalization-rounds 4) (digest-length 8))

31

(declare (type (simple-array (unsigned-byte 8) (*)) key))

32

(unless (= (length key) 16)

33

(error 'invalid-mac-parameter

34

:mac-name 'siphash

35

:message "The key length must be 16 bytes"))

36

(unless (or (= digest-length 8) (= digest-length 16))

37

(error 'invalid-mac-parameter

38

:mac-name 'siphash

39

:message "The digest length must be 8 or 16 bytes"))

40

(make-instance 'siphash

41

:key key

42

:compression-rounds compression-rounds

43

:finalization-rounds finalization-rounds

44

:digest-length digest-length))

45

46

(defmethod shared-initialize :after ((mac siphash) slot-names &rest initargs &key key &allow-other-keys)

47

(declare (ignore slot-names initargs)

48

(type (simple-array (unsigned-byte 8) (16)) key))

49

(let ((state (siphash-state mac))

50

(k0 (ub64ref/le key 0))

51

(k1 (ub64ref/le key 8)))

52

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

53

(type (unsigned-byte 64) k0 k1))

54

(setf (aref state 0) (logxor k0 #x736f6d6570736575)

55

(aref state 1) (logxor k1 #x646f72616e646f6d)

56

(aref state 2) (logxor k0 #x6c7967656e657261)

57

(aref state 3) (logxor k1 #x7465646279746573))

58

(when (= (siphash-digest-length mac) 16)

59

(setf (aref state 1) (logxor (aref state 1) #xee)))

60

(setf (siphash-data-length mac) 0)

61

(setf (siphash-buffer-length mac) 0)

62

mac))

63

64

(defmacro siphash-round (v0 v1 v2 v3)

65

`(setf ,v0 (mod64+ ,v0 ,v1)

66

,v2 (mod64+ ,v2 ,v3)

67

,v1 (rol64 ,v1 13)

68

,v3 (rol64 ,v3 16)

69

,v1 (logxor ,v1 ,v0)

70

,v3 (logxor ,v3 ,v2)

71

,v0 (rol64 ,v0 32)

72

,v2 (mod64+ ,v2 ,v1)

73

,v0 (mod64+ ,v0 ,v3)

74

,v1 (rol64 ,v1 17)

75

,v3 (rol64 ,v3 21)

76

,v1 (logxor ,v1 ,v2)

77

,v3 (logxor ,v3 ,v0)

78

,v2 (rol64 ,v2 32)))

79

80

(defun siphash-compress (state data start remaining data-length n-rounds)

81

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

82

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

83

(type fixnum start remaining data-length n-rounds)

84

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

85

(let ((v0 (aref state 0))

86

(v1 (aref state 1))

87

(v2 (aref state 2))

88

(v3 (aref state 3)))

89

(declare (type (unsigned-byte 64) v0 v1 v2 v3))

90

(do ((m 0))

91

((< remaining 8))

92

(declare (type (unsigned-byte 64) m))

93

(setf m (ub64ref/le data start))

94

(setf v3 (logxor v3 m))

95

(dotimes (i n-rounds)

96

(siphash-round v0 v1 v2 v3))

97

(setf v0 (logxor v0 m))

98

(incf start 8)

99

(incf data-length 8)

100

(decf remaining 8))

101

(setf (aref state 0) v0

102

(aref state 1) v1

103

(aref state 2) v2

104

(aref state 3) v3)

105

(values start remaining data-length)))

106

107

(defun siphash-finalize (state n-rounds tag)

108

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

109

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

110

(type fixnum n-rounds)

111

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

112

(let ((digest-length (length tag))

113

(v0 (aref state 0))

114

(v1 (aref state 1))

115

(v2 (aref state 2))

116

(v3 (aref state 3)))

117

(declare (type fixnum digest-length)

118

(type (unsigned-byte 64) v0 v1 v2 v3))

119

(setf v2 (logxor v2 (if (= digest-length 16) #xee #xff)))

120

(dotimes (i n-rounds)

121

(siphash-round v0 v1 v2 v3))

122

(setf (ub64ref/le tag 0) (logxor v0 v1 v2 v3))

123

(when (= digest-length 16)

124

(setf v1 (logxor v1 #xdd))

125

(dotimes (i n-rounds)

126

(siphash-round v0 v1 v2 v3))

127

(setf (ub64ref/le tag 8) (logxor v0 v1 v2 v3)))

128

(values)))

129

130

(defun update-siphash (mac data &key (start 0) (end (length data)))

131

(declare (type (simple-array (unsigned-byte 8) (*)) data)

132

(type fixnum start end)

133

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

134

(let ((buffer (siphash-buffer mac))

135

(buffer-length (siphash-buffer-length mac))

136

(state (siphash-state mac))

137

(n-rounds (siphash-compression-rounds mac))

138

(data-length (siphash-data-length mac))

139

(remaining (- end start)))

140

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

141

(type (integer 0 8) buffer-length)

142

(type (simple-array (unsigned-byte 64) (4)) state)

143

(type fixnum n-rounds data-length remaining))

144

145

;; Fill the buffer with new data if necessary

146

(when (plusp buffer-length)

147

(let ((n (min remaining (- 8 buffer-length))))

148

(declare (type (integer 0 8) n))

149

(replace buffer data

150

:start1 buffer-length

151

:start2 start

152

:end2 (+ start n))

153

(incf buffer-length n)

154

(incf start n)

155

(incf data-length n)

156

(decf remaining n)))

157

158

;; Process the buffer

159

(when (= buffer-length 8)

160

(siphash-compress state buffer 0 8 data-length n-rounds)

161

(setf buffer-length 0))

162

163

;; Process the data

164

;; TODO: (siphash-process-full-blocks ...)

165

(multiple-value-setq (start remaining data-length)

166

(siphash-compress state data start remaining data-length n-rounds))

167

168

;; Put the remaining data in the buffer

169

(when (plusp remaining)

170

(replace buffer data :start1 0 :start2 start :end2 end)

171

(incf data-length remaining)

172

(setf buffer-length remaining))

173

174

;; Save the state

175

(setf (siphash-data-length mac) data-length)

176

(setf (siphash-buffer-length mac) buffer-length)

177

(values)))

178

179

(defun siphash-digest (mac)

180

(let ((buffer (copy-seq (siphash-buffer mac)))

181

(buffer-length (siphash-buffer-length mac))

182

(state (copy-seq (siphash-state mac)))

183

(compression-rounds (siphash-compression-rounds mac))

184

(finalization-rounds (siphash-finalization-rounds mac))

185

(digest-length (siphash-digest-length mac))

186

(data-length (siphash-data-length mac)))

187

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

188

(type (integer 0 8) buffer-length)

189

(type (simple-array (unsigned-byte 64) (4)) state)

190

(type fixnum compression-rounds finalization-rounds digest-length data-length)

191

(dynamic-extent buffer state))

192

193

;; Pad and process the buffer

194

(fill buffer 0 :start buffer-length)

195

(setf (aref buffer 7) (mod data-length 256))

196

(siphash-compress state buffer 0 8 data-length compression-rounds)

197

198

;; Produce the tag

199

(let ((tag (make-array digest-length :element-type '(unsigned-byte 8))))

200

(siphash-finalize state finalization-rounds tag)

201

tag)))

202

203

(defmac siphash

204

make-siphash

205

update-siphash

206

siphash-digest)