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

Kind	Covered	All	%
expression	0	688	0.0
branch	0	34	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; elgamal.lisp -- implementation of the ElGamal encryption and signature scheme

2

(in-package :crypto)

3

4

;;; class definitions

5

(defclass elgamal-key ()

6

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

7

8

(defclass elgamal-public-key (elgamal-key)

9

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

10

11

(defclass elgamal-private-key (elgamal-key)

12

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

13

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

14

15

(defun elgamal-key-p (elgamal-key)

16

(group-pval (group elgamal-key)))

17

18

(defun elgamal-key-g (elgamal-key)

19

(group-gval (group elgamal-key)))

20

21

;;; function definitions

22

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

23

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

24

(unless p

25

(error 'missing-key-parameter

26

:kind 'elgamal

27

:parameter 'p

28

:description "modulus"))

29

(unless g

30

(error 'missing-key-parameter

31

:kind 'elgamal

32

:parameter 'g

33

:description "generator"))

34

(unless y

35

(error 'missing-key-parameter

36

:kind 'elgamal

37

:parameter 'y

38

:description "public key"))

39

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

40

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

41

42

(defmethod destructure-public-key ((public-key elgamal-public-key))

43

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

44

:g (elgamal-key-g public-key)

45

:y (elgamal-key-y public-key)))

46

47

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

48

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

49

(unless p

50

(error 'missing-key-parameter

51

:kind 'elgamal

52

:parameter 'p

53

:description "modulus"))

54

(unless g

55

(error 'missing-key-parameter

56

:kind 'elgamal

57

:parameter 'g

58

:description "generator"))

59

(unless x

60

(error 'missing-key-parameter

61

:kind 'elgamal

62

:parameter 'x

63

:description "private key"))

64

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

65

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

66

67

(defmethod destructure-private-key ((private-key elgamal-private-key))

68

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

69

:g (elgamal-key-g private-key)

70

:x (elgamal-key-x private-key)

71

:y (elgamal-key-y private-key)))

72

73

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

74

(if compatible-with-key

75

(let* ((p (elgamal-key-p compatible-with-key))

76

(g (elgamal-key-g compatible-with-key))

77

(x (+ 2 (strong-random (- p 3))))

78

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

79

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

80

(make-public-key :elgamal :p p :g g :y y)))

81

(progn

82

(unless num-bits

83

(error 'missing-key-parameter

84

:kind 'elgamal

85

:parameter 'num-bits

86

:description "modulus size"))

87

(let* ((n (if (< num-bits 512)

88

(error 'ironclad-error

89

                              :format-control "NUM-BITS is too small for an Elgamal key.")

90

256))

91

(q (generate-prime n))

92

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

93

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

94

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

95

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

96

(prime-p p))

97

finally (return p)))

98

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

99

(x (+ 2 (strong-random (- p 3))))

100

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

101

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

102

(make-public-key :elgamal :p p :g g :y y))))))

103

104

(defmethod generate-signature-nonce ((key elgamal-private-key) message &optional p)

105

(declare (ignore key message))

106

(or *signature-nonce-for-test*

107

(loop

108

for k = (+ 1 (strong-random (- p 2)))

109

until (= 1 (gcd k (- p 1)))

110

finally (return k))))

111

(defmethod generate-signature-nonce ((key elgamal-public-key) message &optional p)

112

;; The name 'generate-signature-nonce' is not really adapted here as it is

113

;; used for encryption. But is it worth adding a new generic function just

114

;; for this case?

115

(declare (ignore key message))

116

(or *signature-nonce-for-test*

117

(loop

118

for k = (+ 1 (strong-random (- p 2)))

119

until (= 1 (gcd k (- p 1)))

120

finally (return k))))

121

122

(defmethod make-message ((kind (eql :elgamal)) &key c1 c2 n-bits &allow-other-keys)

123

(unless c1

124

(error 'missing-message-parameter

125

:kind 'elgamal

126

:parameter 'c1

127

:description "first ciphertext element"))

128

(unless c2

129

(error 'missing-message-parameter

130

:kind 'elgamal

131

:parameter 'c2

132

:description "second ciphertext element"))

133

(unless n-bits

134

(error 'missing-message-parameter

135

:kind 'elgamal

136

:parameter 'n-bits

137

:description "modulus size"))

138

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

139

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

140

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

141

142

(defmethod destructure-message ((kind (eql :elgamal)) message)

143

(let ((length (length message)))

144

(if (oddp length)

145

(error 'invalid-message-length :kind 'elgamal)

146

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

147

(n-bits (* middle 8))

148

(c1 (octets-to-integer message :start 0 :end middle))

149

(c2 (octets-to-integer message :start middle)))

150

(list :c1 c1 :c2 c2 :n-bits n-bits)))))

151

152

(defmethod encrypt-message ((key elgamal-public-key) msg &key (start 0) end oaep &allow-other-keys)

153

(let* ((p (elgamal-key-p key))

154

(pbits (integer-length p))

155

(g (elgamal-key-g key))

156

(y (elgamal-key-y key))

157

(m (if oaep

158

(octets-to-integer (oaep-encode oaep (subseq msg start end) (/ pbits 8)))

159

(octets-to-integer msg :start start :end end)))

160

(k (generate-signature-nonce key msg p))

161

(c1 (expt-mod g k p))

162

(c2 (mod (* m (expt-mod y k p)) p)))

163

(unless (< m p)

164

(error 'invalid-message-length :kind 'elgamal))

165

(make-message :elgamal :c1 c1 :c2 c2 :n-bits pbits)))

166

167

(defmethod decrypt-message ((key elgamal-private-key) msg &key (start 0) end n-bits oaep &allow-other-keys)

168

(let* ((p (elgamal-key-p key))

169

(pbits (integer-length p))

170

(end (or end (length msg))))

171

(unless (= (* 4 (- end start)) pbits)

172

(error 'invalid-message-length :kind 'elgamal))

173

(let* ((x (elgamal-key-x key))

174

(message-elements (destructure-message :elgamal (subseq msg start end)))

175

(c1 (getf message-elements :c1))

176

(c2 (getf message-elements :c2))

177

(m (mod (* c2 (modular-inverse-with-blinding (expt-mod c1 x p) p)) p)))

178

(if oaep

179

(oaep-decode oaep (integer-to-octets m :n-bits pbits))

180

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

181

182

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

183

(unless r

184

(error 'missing-signature-parameter

185

:kind 'elgamal

186

:parameter 'r

187

:description "first signature element"))

188

(unless s

189

(error 'missing-signature-parameter

190

:kind 'elgamal

191

:parameter 's

192

:description "second signature element"))

193

(unless n-bits

194

(error 'missing-signature-parameter

195

:kind 'elgamal

196

:parameter 'n-bits

197

:description "modulus size"))

198

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

199

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

200

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

201

202

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

203

(let ((length (length signature)))

204

(if (oddp length)

205

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

206

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

207

(n-bits (* middle 8))

208

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

209

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

210

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

211

212

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

213

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

214

(p (elgamal-key-p key))

215

(pbits (integer-length p)))

216

(unless (< m (- p 1))

217

(error 'invalid-message-length :kind 'elgamal))

218

(let* ((g (elgamal-key-g key))

219

(x (elgamal-key-x key))

220

(k (generate-signature-nonce key msg p))

221

(r (expt-mod g k p))

222

(s (mod (* (- m (* r x)) (modular-inverse-with-blinding k (- p 1))) (- p 1))))

223

(if (not (zerop s))

224

(make-signature :elgamal :r r :s s :n-bits pbits)

225

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

226

227

(defmethod verify-signature ((key elgamal-public-key) msg signature &key (start 0) end &allow-other-keys)

228

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

229

(p (elgamal-key-p key))

230

(pbits (integer-length p)))

231

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

232

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

233

(unless (< m (- p 1))

234

(error 'invalid-message-length :kind 'elgamal))

235

(let* ((g (elgamal-key-g key))

236

(y (elgamal-key-y key))

237

(signature-elements (destructure-signature :elgamal signature))

238

(r (getf signature-elements :r))

239

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

240

(and (< 0 r p)

241

(< 0 s (- p 1))

242

(= (expt-mod g m p)

243

(mod (* (expt-mod y r p) (expt-mod r s p)) p))))))

244

245

(defmethod diffie-hellman ((private-key elgamal-private-key) (public-key elgamal-public-key))

246

(let ((p (elgamal-key-p private-key))

247

(p1 (elgamal-key-p public-key))

248

(g (elgamal-key-g private-key))

249

(g1 (elgamal-key-g public-key)))

250

(unless (and (= p p1) (= g g1))

251

(error 'incompatible-keys :kind 'elgamal))

252

(let ((pbits (integer-length p))

253

(x (elgamal-key-x private-key))

254

(y (elgamal-key-y public-key)))

255

(integer-to-octets (expt-mod y x p) :n-bits pbits))))