1;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
2;;;; elgamal.lisp -- implementation of the ElGamal encryption and signature scheme
3
4(in-package :crypto)
5
6
7;;; class definitions
8
9(defclass elgamal-key ()
10  ((group :initarg :group :reader group)))
11
12(defclass elgamal-public-key (elgamal-key)
13  ((y :initarg :y :reader elgamal-key-y :type integer)))
14
15(defclass elgamal-private-key (elgamal-key)
16  ((y :initarg :y :reader elgamal-key-y :type integer)
17   (x :initarg :x :reader elgamal-key-x :type integer)))
18
19(defun elgamal-key-p (elgamal-key)
20  (group-pval (group elgamal-key)))
21
22(defun elgamal-key-g (elgamal-key)
23  (group-gval (group elgamal-key)))
24
25
26;;; function definitions
27
28(defmethod make-public-key ((kind (eql :elgamal))
29                            &key p g y &allow-other-keys)
30  (unless p
31    (error 'missing-key-parameter
32           :kind 'elgamal
33           :parameter 'p
34           :description "modulus"))
35  (unless g
36    (error 'missing-key-parameter
37           :kind 'elgamal
38           :parameter 'g
39           :description "generator"))
40  (unless y
41    (error 'missing-key-parameter
42           :kind 'elgamal
43           :parameter 'y
44           :description "public key"))
45  (let ((group (make-instance 'discrete-logarithm-group :p p :g g)))
46    (make-instance 'elgamal-public-key :group group :y y)))
47
48(defmethod destructure-public-key ((public-key elgamal-public-key))
49  (list :p (elgamal-key-p public-key)
50        :g (elgamal-key-g public-key)
51        :y (elgamal-key-y public-key)))
52
53(defmethod make-private-key ((kind (eql :elgamal))
54                             &key p g y x &allow-other-keys)
55  (unless p
56    (error 'missing-key-parameter
57           :kind 'elgamal
58           :parameter 'p
59           :description "modulus"))
60  (unless g
61    (error 'missing-key-parameter
62           :kind 'elgamal
63           :parameter 'g
64           :description "generator"))
65  (unless x
66    (error 'missing-key-parameter
67           :kind 'elgamal
68           :parameter 'x
69           :description "private key"))
70  (let ((group (make-instance 'discrete-logarithm-group :p p :g g)))
71    (make-instance 'elgamal-private-key :group group :x x :y (or y (expt-mod g x p)))))
72
73(defmethod destructure-private-key ((private-key elgamal-private-key))
74  (list :p (elgamal-key-p private-key)
75        :g (elgamal-key-g private-key)
76        :x (elgamal-key-x private-key)
77        :y (elgamal-key-y private-key)))
78
79(defmethod generate-key-pair ((kind (eql :elgamal)) &key num-bits compatible-with-key &allow-other-keys)
80  (if compatible-with-key
81      (let* ((p (elgamal-key-p compatible-with-key))
82             (g (elgamal-key-g compatible-with-key))
83             (x (+ 2 (strong-random (- p 3))))
84             (y (expt-mod g x p)))
85        (values (make-private-key :elgamal :p p :g g :y y :x x)
86                (make-public-key :elgamal :p p :g g :y y)))
87      (progn
88        (unless num-bits
89          (error 'missing-key-parameter
90                 :kind 'elgamal
91                 :parameter 'num-bits
92                 :description "modulus size"))
93        (let* ((n (if (< num-bits 512)
94                      (error 'ironclad-error
95                             :format-control "NUM-BITS is too small for an Elgamal key.")
96                      256))
97               (q (generate-prime n))
98               (p (loop for z = (logior (ash 1 (- num-bits n 1))
99                                        (dpb 0 (byte 1 0) (random-bits (- num-bits n))))
100                        for p = (1+ (* z q))
101                        until (and (= num-bits (integer-length p))
102                                   (prime-p p))
103                        finally (return p)))
104               (g (find-subgroup-generator p q))
105               (x (+ 2 (strong-random (- p 3))))
106               (y (expt-mod g x p)))
107          (values (make-private-key :elgamal :p p :g g :y y :x x)
108                  (make-public-key :elgamal :p p :g g :y y))))))
109
110(defmethod generate-signature-nonce ((key elgamal-private-key) message &optional p)
111  (declare (ignore key message))
112  (or *signature-nonce-for-test*
113      (loop
114        for k = (+ 1 (strong-random (- p 2)))
115        until (= 1 (gcd k (- p 1)))
116        finally (return k))))
117(defmethod generate-signature-nonce ((key elgamal-public-key) message &optional p)
118  ;; The name 'generate-signature-nonce' is not really adapted here as it is
119  ;; used for encryption. But is it worth adding a new generic function just
120  ;; for this case?
121  (declare (ignore key message))
122  (or *signature-nonce-for-test*
123      (loop
124        for k = (+ 1 (strong-random (- p 2)))
125        until (= 1 (gcd k (- p 1)))
126        finally (return k))))
127
128(defmethod make-message ((kind (eql :elgamal)) &key c1 c2 n-bits &allow-other-keys)
129  (unless c1
130    (error 'missing-message-parameter
131           :kind 'elgamal
132           :parameter 'c1
133           :description "first ciphertext element"))
134  (unless c2
135    (error 'missing-message-parameter
136           :kind 'elgamal
137           :parameter 'c2
138           :description "second ciphertext element"))
139  (unless n-bits
140    (error 'missing-message-parameter
141           :kind 'elgamal
142           :parameter 'n-bits
143           :description "modulus size"))
144  (concatenate '(simple-array (unsigned-byte 8) (*))
145               (integer-to-octets c1 :n-bits n-bits)
146               (integer-to-octets c2 :n-bits n-bits)))
147
148(defmethod destructure-message ((kind (eql :elgamal)) message)
149  (let ((length (length message)))
150    (if (oddp length)
151        (error 'invalid-message-length :kind 'elgamal)
152        (let* ((middle (/ length 2))
153               (n-bits (* middle 8))
154               (c1 (octets-to-integer message :start 0 :end middle))
155               (c2 (octets-to-integer message :start middle)))
156          (list :c1 c1 :c2 c2 :n-bits n-bits)))))
157
158(defmethod encrypt-message ((key elgamal-public-key) msg &key (start 0) end oaep &allow-other-keys)
159  (let* ((p (elgamal-key-p key))
160         (pbits (integer-length p))
161         (g (elgamal-key-g key))
162         (y (elgamal-key-y key))
163         (m (if oaep
164                (octets-to-integer (oaep-encode oaep (subseq msg start end) (/ pbits 8)))
165                (octets-to-integer msg :start start :end end)))
166         (k (generate-signature-nonce key msg p))
167         (c1 (expt-mod g k p))
168         (c2 (mod (* m (expt-mod y k p)) p)))
169    (unless (< m p)
170      (error 'invalid-message-length :kind 'elgamal))
171    (make-message :elgamal :c1 c1 :c2 c2 :n-bits pbits)))
172
173(defmethod decrypt-message ((key elgamal-private-key) msg &key (start 0) end n-bits oaep &allow-other-keys)
174  (let* ((p (elgamal-key-p key))
175         (pbits (integer-length p))
176         (end (or end (length msg))))
177    (unless (= (* 4 (- end start)) pbits)
178      (error 'invalid-message-length :kind 'elgamal))
179    (let* ((x (elgamal-key-x key))
180           (message-elements (destructure-message :elgamal (subseq msg start end)))
181           (c1 (getf message-elements :c1))
182           (c2 (getf message-elements :c2))
183           (m (mod (* c2 (modular-inverse-with-blinding (expt-mod c1 x p) p)) p)))
184      (if oaep
185          (oaep-decode oaep (integer-to-octets m :n-bits pbits))
186          (integer-to-octets m :n-bits n-bits)))))
187
188(defmethod make-signature ((kind (eql :elgamal)) &key r s n-bits &allow-other-keys)
189  (unless r
190    (error 'missing-signature-parameter
191           :kind 'elgamal
192           :parameter 'r
193           :description "first signature element"))
194  (unless s
195    (error 'missing-signature-parameter
196           :kind 'elgamal
197           :parameter 's
198           :description "second signature element"))
199  (unless n-bits
200    (error 'missing-signature-parameter
201           :kind 'elgamal
202           :parameter 'n-bits
203           :description "modulus size"))
204  (concatenate '(simple-array (unsigned-byte 8) (*))
205               (integer-to-octets r :n-bits n-bits)
206               (integer-to-octets s :n-bits n-bits)))
207
208(defmethod destructure-signature ((kind (eql :elgamal)) signature)
209  (let ((length (length signature)))
210    (if (oddp length)
211        (error 'invalid-signature-length :kind 'elgamal)
212        (let* ((middle (/ length 2))
213               (n-bits (* middle 8))
214               (r (octets-to-integer signature :start 0 :end middle))
215               (s (octets-to-integer signature :start middle)))
216          (list :r r :s s :n-bits n-bits)))))
217
218(defmethod sign-message ((key elgamal-private-key) msg &key (start 0) end &allow-other-keys)
219  (let* ((m (octets-to-integer msg :start start :end end))
220         (p (elgamal-key-p key))
221         (pbits (integer-length p)))
222    (unless (< m (- p 1))
223      (error 'invalid-message-length :kind 'elgamal))
224    (let* ((g (elgamal-key-g key))
225           (x (elgamal-key-x key))
226           (k (generate-signature-nonce key msg p))
227           (r (expt-mod g k p))
228           (s (mod (* (- m (* r x)) (modular-inverse-with-blinding k (- p 1))) (- p 1))))
229      (if (not (zerop s))
230          (make-signature :elgamal :r r :s s :n-bits pbits)
231          (sign-message key msg :start start :end end)))))
232
233(defmethod verify-signature ((key elgamal-public-key) msg signature &key (start 0) end &allow-other-keys)
234  (let* ((m (octets-to-integer msg :start start :end end))
235         (p (elgamal-key-p key))
236         (pbits (integer-length p)))
237    (unless (= (* 4 (length signature)) pbits)
238      (error 'invalid-signature-length :kind 'elgamal))
239    (unless (< m (- p 1))
240      (error 'invalid-message-length :kind 'elgamal))
241    (let* ((g (elgamal-key-g key))
242           (y (elgamal-key-y key))
243           (signature-elements (destructure-signature :elgamal signature))
244           (r (getf signature-elements :r))
245           (s (getf signature-elements :s)))
246      (and (< 0 r p)
247           (< 0 s (- p 1))
248           (= (expt-mod g m p)
249              (mod (* (expt-mod y r p) (expt-mod r s p)) p))))))
250
251(defmethod diffie-hellman ((private-key elgamal-private-key) (public-key elgamal-public-key))
252  (let ((p (elgamal-key-p private-key))
253        (p1 (elgamal-key-p public-key))
254        (g (elgamal-key-g private-key))
255        (g1 (elgamal-key-g public-key)))
256    (unless (and (= p p1) (= g g1))
257      (error 'incompatible-keys :kind 'elgamal))
258    (let ((pbits (integer-length p))
259          (x (elgamal-key-x private-key))
260          (y (elgamal-key-y public-key)))
261      (integer-to-octets (expt-mod y x p) :n-bits pbits))))
262