Coverage report: /home/ellis/comp/ext/ironclad/src/public-key/dsa.lisp

Kind	Covered	All	%
expression	0	488	0.0
branch	0	32	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; dsa.lisp -- implementation of the Digital Signature Algorithm

2

(in-package :crypto)

3

4

;;; class definitions

5

(defclass dsa-key ()

6

((group :initarg :group :reader group)))

7

8

(defclass dsa-public-key (dsa-key)

9

((y :initarg :y :reader dsa-key-y :type integer)))

10

11

(defclass dsa-private-key (dsa-key)

12

((y :initarg :y :reader dsa-key-y :type integer)

13

(x :initarg :x :reader dsa-key-x :type integer)))

14

15

(defun dsa-key-p (dsa-key)

16

(group-pval (group dsa-key)))

17

(defun dsa-key-q (dsa-key)

18

(group-qval (group dsa-key)))

19

(defun dsa-key-g (dsa-key)

20

(group-gval (group dsa-key)))

21

22

;;; function definitions

23

(defmethod make-public-key ((kind (eql :dsa))

24

&key p q g y &allow-other-keys)

25

(unless p

26

(error 'missing-key-parameter

27

:kind 'dsa

28

:parameter 'p

29

:description "modulus"))

30

(unless q

31

(error 'missing-key-parameter

32

:kind 'dsa

33

:parameter 'q

34

:description "subgroup modulus"))

35

(unless g

36

(error 'missing-key-parameter

37

:kind 'dsa

38

:parameter 'g

39

:description "generator"))

40

(unless y

41

(error 'missing-key-parameter

42

:kind 'dsa

43

:parameter 'y

44

:description "public key"))

45

(let ((group (make-instance 'discrete-logarithm-group :p p :q q :g g)))

46

(make-instance 'dsa-public-key :group group :y y)))

47

48

(defmethod destructure-public-key ((public-key dsa-public-key))

49

(list :p (dsa-key-p public-key)

50

:q (dsa-key-q public-key)

51

:g (dsa-key-g public-key)

52

:y (dsa-key-y public-key)))

53

54

(defmethod make-private-key ((kind (eql :dsa))

55

&key p q g y x &allow-other-keys)

56

(unless p

57

(error 'missing-key-parameter

58

:kind 'dsa

59

:parameter 'p

60

:description "modulus"))

61

(unless q

62

(error 'missing-key-parameter

63

:kind 'dsa

64

:parameter 'q

65

:description "subgroup modulus"))

66

(unless g

67

(error 'missing-key-parameter

68

:kind 'dsa

69

:parameter 'g

70

:description "generator"))

71

(unless x

72

(error 'missing-key-parameter

73

:kind 'dsa

74

:parameter 'x

75

:description "private key"))

76

(let ((group (make-instance 'discrete-logarithm-group :p p :q q :g g)))

77

(make-instance 'dsa-private-key :group group :x x :y (or y (expt-mod g x p)))))

78

79

(defmethod destructure-private-key ((private-key dsa-private-key))

80

(list :p (dsa-key-p private-key)

81

:q (dsa-key-q private-key)

82

:g (dsa-key-g private-key)

83

:x (dsa-key-x private-key)

84

:y (dsa-key-y private-key)))

85

86

(defmethod generate-key-pair ((kind (eql :dsa)) &key num-bits &allow-other-keys)

87

(unless num-bits

88

(error 'missing-key-parameter

89

:kind 'dsa

90

:parameter 'num-bits

91

:description "modulus size"))

92

(let* ((n (cond ((< num-bits 512) (error 'ironclad-error

93

                                            :format-control "NUM-BITS is too small for a DSA key."))

94

((<= num-bits 1024) 160)

95

((<= num-bits 2048) 224)

96

((<= num-bits 3072) 256)

97

((<= num-bits 7680) 384)

98

((<= num-bits 15360) 512)

99

(t (error 'ironclad-error

100

                             :format-control "NUM-BITS is too big for a DSA key."))))

101

(q (generate-prime n))

102

(p (loop for z = (logior (ash 1 (- num-bits n 1))

103

                                   (dpb 0 (byte 1 0) (random-bits (- num-bits n))))

104

for p = (1+ (* z q))

105

until (and (= num-bits (integer-length p))

106

(prime-p p))

107

finally (return p)))

108

(g (find-subgroup-generator p q))

109

(x (+ 2 (strong-random (- q 2))))

110

(y (expt-mod g x p)))

111

(values (make-private-key :dsa :p p :q q :g g :y y :x x)

112

(make-public-key :dsa :p p :q q :g g :y y))))

113

114

(defmethod generate-signature-nonce ((key dsa-private-key) message &optional q)

115

(declare (ignore key message))

116

(or *signature-nonce-for-test*

117

(1+ (strong-random (1- q)))))

118

119

(defmethod make-signature ((kind (eql :dsa)) &key r s n-bits &allow-other-keys)

120

(unless r

121

(error 'missing-signature-parameter

122

:kind 'dsa

123

:parameter 'r

124

:description "first signature element"))

125

(unless s

126

(error 'missing-signature-parameter

127

:kind 'dsa

128

:parameter 's

129

:description "second signature element"))

130

(unless n-bits

131

(error 'missing-signature-parameter

132

:kind 'dsa

133

:parameter 'n-bits

134

:description "subgroup modulus size"))

135

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

136

(integer-to-octets r :n-bits n-bits)

137

(integer-to-octets s :n-bits n-bits)))

138

139

(defmethod destructure-signature ((kind (eql :dsa)) signature)

140

(let ((length (length signature)))

141

(if (oddp length)

142

(error 'invalid-signature-length :kind 'dsa)

143

(let* ((middle (/ length 2))

144

(n-bits (* middle 8))

145

(r (octets-to-integer signature :start 0 :end middle))

146

(s (octets-to-integer signature :start middle)))

147

(list :r r :s s :n-bits n-bits)))))

148

149

;;; Note that hashing is not performed here.

150

(defmethod sign-message ((key dsa-private-key) message &key (start 0) end &allow-other-keys)

151

(let* ((end (or end (length message)))

152

(q (dsa-key-q key))

153

(qbits (integer-length q)))

154

(when (> (* 8 (- end start)) qbits)

155

;; Only keep the required number of bits of message

156

(setf end (+ start (/ qbits 8))))

157

(let* ((m (octets-to-integer message :start start :end end))

158

(p (dsa-key-p key))

159

(g (dsa-key-g key))

160

(x (dsa-key-x key))

161

(k (generate-signature-nonce key message q))

162

(r (mod (expt-mod g k p) q))

163

(k-inverse (modular-inverse-with-blinding k q))

164

(s (mod (* k-inverse (+ (* x r) m)) q)))

165

(assert (= (mod (* k k-inverse) q) 1))

166

(if (not (or (zerop r) (zerop s)))

167

(make-signature :dsa :r r :s s :n-bits qbits)

168

(sign-message key message :start start :end end)))))

169

170

(defmethod verify-signature ((key dsa-public-key) message signature &key (start 0) end &allow-other-keys)

171

(let* ((end (or end (length message)))

172

(q (dsa-key-q key))

173

(qbits (integer-length q)))

174

(unless (= (* 4 (length signature)) qbits)

175

(error 'invalid-signature-length :kind 'dsa))

176

(when (> (* 8 (- end start)) qbits)

177

;; Only keep the required number of bits of message

178

(setf end (+ start (/ qbits 8))))

179

(let* ((m (octets-to-integer message :start start :end end))

180

(p (dsa-key-p key))

181

(g (dsa-key-g key))

182

(y (dsa-key-y key))

183

(signature-elements (destructure-signature :dsa signature))

184

(r (getf signature-elements :r))

185

(s (getf signature-elements :s)))

186

(unless (and (< 0 r q) (< 0 s q))

187

(return-from verify-signature nil))

188

(let* ((w (modular-inverse s q))

189

(u1 (mod (* m w) q))

190

(u2 (mod (* r w) q))

191

(v (mod (mod (* (expt-mod g u1 p) (expt-mod y u2 p)) p) q)))

192

(= v r)))))