(epg-context-set-passphrase-callback)
[bpt/emacs.git] / lisp / epg.el
CommitLineData
c154c0be
MO
1;;; epg.el --- the EasyPG Library
2;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
ae940284 3;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
c154c0be
MO
4
5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Keywords: PGP, GnuPG
7
8;; This file is part of GNU Emacs.
9
eb3fa2cf 10;; GNU Emacs is free software: you can redistribute it and/or modify
c154c0be 11;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
c154c0be
MO
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
eb3fa2cf 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c154c0be
MO
22
23;;; Code:
24
25(require 'epg-config)
26
27(defvar epg-user-id nil
28 "GnuPG ID of your default identity.")
29
30(defvar epg-user-id-alist nil
31 "An alist mapping from key ID to user ID.")
32
33(defvar epg-last-status nil)
34(defvar epg-read-point nil)
35(defvar epg-process-filter-running nil)
36(defvar epg-pending-status-list nil)
37(defvar epg-key-id nil)
38(defvar epg-context nil)
39(defvar epg-debug-buffer nil)
40
41;; from gnupg/include/cipher.h
42(defconst epg-cipher-algorithm-alist
43 '((0 . "NONE")
44 (1 . "IDEA")
45 (2 . "3DES")
46 (3 . "CAST5")
47 (4 . "BLOWFISH")
48 (7 . "AES")
49 (8 . "AES192")
50 (9 . "AES256")
51 (10 . "TWOFISH")
13890796
DU
52 (11 . "CAMELLIA128")
53 (12 . "CAMELLIA256")
c154c0be
MO
54 (110 . "DUMMY")))
55
56;; from gnupg/include/cipher.h
57(defconst epg-pubkey-algorithm-alist
58 '((1 . "RSA")
59 (2 . "RSA_E")
60 (3 . "RSA_S")
61 (16 . "ELGAMAL_E")
62 (17 . "DSA")
63 (20 . "ELGAMAL")))
64
65;; from gnupg/include/cipher.h
66(defconst epg-digest-algorithm-alist
67 '((1 . "MD5")
68 (2 . "SHA1")
69 (3 . "RMD160")
70 (8 . "SHA256")
71 (9 . "SHA384")
13890796
DU
72 (10 . "SHA512")
73 (11 . "SHA224")))
c154c0be
MO
74
75;; from gnupg/include/cipher.h
76(defconst epg-compress-algorithm-alist
77 '((0 . "NONE")
78 (1 . "ZIP")
79 (2 . "ZLIB")
80 (3 . "BZIP2")))
81
82(defconst epg-invalid-recipients-reason-alist
83 '((0 . "No specific reason given")
84 (1 . "Not Found")
85 (2 . "Ambigious specification")
86 (3 . "Wrong key usage")
87 (4 . "Key revoked")
88 (5 . "Key expired")
89 (6 . "No CRL known")
90 (7 . "CRL too old")
91 (8 . "Policy mismatch")
92 (9 . "Not a secret key")
93 (10 . "Key not trusted")))
94
95(defconst epg-delete-problem-reason-alist
96 '((1 . "No such key")
97 (2 . "Must delete secret key first")
98 (3 . "Ambigious specification")))
99
100(defconst epg-import-ok-reason-alist
101 '((0 . "Not actually changed")
102 (1 . "Entirely new key")
103 (2 . "New user IDs")
104 (4 . "New signatures")
105 (8 . "New subkeys")
106 (16 . "Contains private key")))
107
108(defconst epg-import-problem-reason-alist
109 '((0 . "No specific reason given")
110 (1 . "Invalid Certificate")
111 (2 . "Issuer Certificate missing")
112 (3 . "Certificate Chain too long")
113 (4 . "Error storing certificate")))
114
115(defconst epg-no-data-reason-alist
116 '((1 . "No armored data")
117 (2 . "Expected a packet but did not found one")
118 (3 . "Invalid packet found, this may indicate a non OpenPGP message")
119 (4 . "Signature expected but not found")))
120
121(defconst epg-unexpected-reason-alist nil)
122
123(defvar epg-key-validity-alist
124 '((?o . unknown)
125 (?i . invalid)
126 (?d . disabled)
127 (?r . revoked)
128 (?e . expired)
129 (?- . none)
130 (?q . undefined)
131 (?n . never)
132 (?m . marginal)
133 (?f . full)
134 (?u . ultimate)))
135
136(defvar epg-key-capablity-alist
137 '((?e . encrypt)
138 (?s . sign)
139 (?c . certify)
140 (?a . authentication)))
141
142(defvar epg-new-signature-type-alist
143 '((?D . detached)
144 (?C . clear)
145 (?S . normal)))
146
147(defvar epg-dn-type-alist
148 '(("1.2.840.113549.1.9.1" . "EMail")
149 ("2.5.4.12" . "T")
150 ("2.5.4.42" . "GN")
151 ("2.5.4.4" . "SN")
152 ("0.2.262.1.10.7.20" . "NameDistinguisher")
153 ("2.5.4.16" . "ADDR")
154 ("2.5.4.15" . "BC")
155 ("2.5.4.13" . "D")
156 ("2.5.4.17" . "PostalCode")
157 ("2.5.4.65" . "Pseudo")
158 ("2.5.4.5" . "SerialNumber")))
159
160(defvar epg-prompt-alist nil)
161
162(put 'epg-error 'error-conditions '(epg-error error))
163
164(defun epg-make-data-from-file (file)
165 "Make a data object from FILE."
166 (cons 'epg-data (vector file nil)))
167
168(defun epg-make-data-from-string (string)
169 "Make a data object from STRING."
170 (cons 'epg-data (vector nil string)))
171
172(defun epg-data-file (data)
173 "Return the file of DATA."
174 (unless (eq (car-safe data) 'epg-data)
175 (signal 'wrong-type-argument (list 'epg-data-p data)))
176 (aref (cdr data) 0))
177
178(defun epg-data-string (data)
179 "Return the string of DATA."
180 (unless (eq (car-safe data) 'epg-data)
181 (signal 'wrong-type-argument (list 'epg-data-p data)))
182 (aref (cdr data) 1))
183
184(defun epg-make-context (&optional protocol armor textmode include-certs
185 cipher-algorithm digest-algorithm
186 compress-algorithm)
187 "Return a context object."
188 (cons 'epg-context
189 (vector (or protocol 'OpenPGP) armor textmode include-certs
190 cipher-algorithm digest-algorithm compress-algorithm
7c0ffa6d 191 (list #'epg-passphrase-callback-function)
c154c0be
MO
192 nil
193 nil nil nil nil nil nil)))
194
195(defun epg-context-protocol (context)
196 "Return the protocol used within CONTEXT."
197 (unless (eq (car-safe context) 'epg-context)
198 (signal 'wrong-type-argument (list 'epg-context-p context)))
199 (aref (cdr context) 0))
200
201(defun epg-context-armor (context)
05234615 202 "Return t if the output should be ASCII armored in CONTEXT."
c154c0be
MO
203 (unless (eq (car-safe context) 'epg-context)
204 (signal 'wrong-type-argument (list 'epg-context-p context)))
205 (aref (cdr context) 1))
206
207(defun epg-context-textmode (context)
208 "Return t if canonical text mode should be used in CONTEXT."
209 (unless (eq (car-safe context) 'epg-context)
210 (signal 'wrong-type-argument (list 'epg-context-p context)))
211 (aref (cdr context) 2))
212
213(defun epg-context-include-certs (context)
05234615 214 "Return how many certificates should be included in an S/MIME signed message."
c154c0be
MO
215 (unless (eq (car-safe context) 'epg-context)
216 (signal 'wrong-type-argument (list 'epg-context-p context)))
217 (aref (cdr context) 3))
218
219(defun epg-context-cipher-algorithm (context)
220 "Return the cipher algorithm in CONTEXT."
221 (unless (eq (car-safe context) 'epg-context)
222 (signal 'wrong-type-argument (list 'epg-context-p context)))
223 (aref (cdr context) 4))
224
225(defun epg-context-digest-algorithm (context)
226 "Return the digest algorithm in CONTEXT."
227 (unless (eq (car-safe context) 'epg-context)
228 (signal 'wrong-type-argument (list 'epg-context-p context)))
229 (aref (cdr context) 5))
230
231(defun epg-context-compress-algorithm (context)
232 "Return the compress algorithm in CONTEXT."
233 (unless (eq (car-safe context) 'epg-context)
234 (signal 'wrong-type-argument (list 'epg-context-p context)))
235 (aref (cdr context) 6))
236
237(defun epg-context-passphrase-callback (context)
238 "Return the function used to query passphrase."
239 (unless (eq (car-safe context) 'epg-context)
240 (signal 'wrong-type-argument (list 'epg-context-p context)))
241 (aref (cdr context) 7))
242
243(defun epg-context-progress-callback (context)
244 "Return the function which handles progress update."
245 (unless (eq (car-safe context) 'epg-context)
246 (signal 'wrong-type-argument (list 'epg-context-p context)))
247 (aref (cdr context) 8))
248
249(defun epg-context-signers (context)
05234615 250 "Return the list of key-id for signing."
c154c0be
MO
251 (unless (eq (car-safe context) 'epg-context)
252 (signal 'wrong-type-argument (list 'epg-context-p context)))
253 (aref (cdr context) 9))
254
255(defun epg-context-sig-notations (context)
05234615 256 "Return the list of notations for signing."
c154c0be
MO
257 (unless (eq (car-safe context) 'epg-context)
258 (signal 'wrong-type-argument (list 'epg-context-p context)))
259 (aref (cdr context) 10))
260
261(defun epg-context-process (context)
262 "Return the process object of `epg-gpg-program'.
263This function is for internal use only."
264 (unless (eq (car-safe context) 'epg-context)
265 (signal 'wrong-type-argument (list 'epg-context-p context)))
266 (aref (cdr context) 11))
267
268(defun epg-context-output-file (context)
269 "Return the output file of `epg-gpg-program'.
270This function is for internal use only."
271 (unless (eq (car-safe context) 'epg-context)
272 (signal 'wrong-type-argument (list 'epg-context-p context)))
273 (aref (cdr context) 12))
274
275(defun epg-context-result (context)
276 "Return the result of the previous cryptographic operation."
277 (unless (eq (car-safe context) 'epg-context)
278 (signal 'wrong-type-argument (list 'epg-context-p context)))
279 (aref (cdr context) 13))
280
281(defun epg-context-operation (context)
282 "Return the name of the current cryptographic operation."
283 (unless (eq (car-safe context) 'epg-context)
284 (signal 'wrong-type-argument (list 'epg-context-p context)))
285 (aref (cdr context) 14))
286
287(defun epg-context-set-protocol (context protocol)
288 "Set the protocol used within CONTEXT."
289 (unless (eq (car-safe context) 'epg-context)
290 (signal 'wrong-type-argument (list 'epg-context-p context)))
291 (aset (cdr context) 0 protocol))
292
293(defun epg-context-set-armor (context armor)
05234615 294 "Specify if the output should be ASCII armored in CONTEXT."
c154c0be
MO
295 (unless (eq (car-safe context) 'epg-context)
296 (signal 'wrong-type-argument (list 'epg-context-p context)))
297 (aset (cdr context) 1 armor))
298
299(defun epg-context-set-textmode (context textmode)
300 "Specify if canonical text mode should be used in CONTEXT."
301 (unless (eq (car-safe context) 'epg-context)
302 (signal 'wrong-type-argument (list 'epg-context-p context)))
303 (aset (cdr context) 2 textmode))
304
305(defun epg-context-set-include-certs (context include-certs)
306 "Set how many certificates should be included in an S/MIME signed message."
307 (unless (eq (car-safe context) 'epg-context)
308 (signal 'wrong-type-argument (list 'epg-context-p context)))
309 (aset (cdr context) 3 include-certs))
310
311(defun epg-context-set-cipher-algorithm (context cipher-algorithm)
312 "Set the cipher algorithm in CONTEXT."
313 (unless (eq (car-safe context) 'epg-context)
314 (signal 'wrong-type-argument (list 'epg-context-p context)))
315 (aset (cdr context) 4 cipher-algorithm))
316
317(defun epg-context-set-digest-algorithm (context digest-algorithm)
318 "Set the digest algorithm in CONTEXT."
319 (unless (eq (car-safe context) 'epg-context)
320 (signal 'wrong-type-argument (list 'epg-context-p context)))
321 (aset (cdr context) 5 digest-algorithm))
322
323(defun epg-context-set-compress-algorithm (context compress-algorithm)
324 "Set the compress algorithm in CONTEXT."
325 (unless (eq (car-safe context) 'epg-context)
326 (signal 'wrong-type-argument (list 'epg-context-p context)))
327 (aset (cdr context) 6 compress-algorithm))
328
329(defun epg-context-set-passphrase-callback (context
330 passphrase-callback)
b18508dd
DU
331 "Set the function used to query passphrase.
332
333PASSPHRASE-CALLBACK is either a function, or a cons-cell whose
334car is a function and cdr is a callback data.
335The function gets three arguments: the context, the key-id in
336question, and the callback data (if any)."
c154c0be
MO
337 (unless (eq (car-safe context) 'epg-context)
338 (signal 'wrong-type-argument (list 'epg-context-p context)))
7c0ffa6d
DU
339 (aset (cdr context) 7 (if (consp passphrase-callback)
340 passphrase-callback
341 (list passphrase-callback))))
c154c0be
MO
342
343(defun epg-context-set-progress-callback (context
344 progress-callback)
345 "Set the function which handles progress update.
b18508dd
DU
346
347PROGRESS-CALLBACK is either a function, or a cons-cell whose
348car is a function and cdr is a callback data.
349
350The function gets five arguments: the context, the operation
351description, the character to display a progress unit, the
352current amount done, the total amount to be done, and the
353callback data (if any)."
c154c0be
MO
354 (unless (eq (car-safe context) 'epg-context)
355 (signal 'wrong-type-argument (list 'epg-context-p context)))
7c0ffa6d
DU
356 (aset (cdr context) 8 (if (consp progress-callback)
357 progress-callback
358 (list progress-callback))))
c154c0be
MO
359
360(defun epg-context-set-signers (context signers)
05234615 361 "Set the list of key-id for signing."
c154c0be
MO
362 (unless (eq (car-safe context) 'epg-context)
363 (signal 'wrong-type-argument (list 'epg-context-p context)))
364 (aset (cdr context) 9 signers))
365
366(defun epg-context-set-sig-notations (context notations)
05234615 367 "Set the list of notations for signing."
c154c0be
MO
368 (unless (eq (car-safe context) 'epg-context)
369 (signal 'wrong-type-argument (list 'epg-context-p context)))
370 (aset (cdr context) 10 notations))
371
372(defun epg-context-set-process (context process)
373 "Set the process object of `epg-gpg-program'.
374This function is for internal use only."
375 (unless (eq (car-safe context) 'epg-context)
376 (signal 'wrong-type-argument (list 'epg-context-p context)))
377 (aset (cdr context) 11 process))
378
379(defun epg-context-set-output-file (context output-file)
380 "Set the output file of `epg-gpg-program'.
381This function is for internal use only."
382 (unless (eq (car-safe context) 'epg-context)
383 (signal 'wrong-type-argument (list 'epg-context-p context)))
384 (aset (cdr context) 12 output-file))
385
386(defun epg-context-set-result (context result)
387 "Set the result of the previous cryptographic operation."
388 (unless (eq (car-safe context) 'epg-context)
389 (signal 'wrong-type-argument (list 'epg-context-p context)))
390 (aset (cdr context) 13 result))
391
392(defun epg-context-set-operation (context operation)
393 "Set the name of the current cryptographic operation."
394 (unless (eq (car-safe context) 'epg-context)
395 (signal 'wrong-type-argument (list 'epg-context-p context)))
396 (aset (cdr context) 14 operation))
397
398(defun epg-make-signature (status &optional key-id)
399 "Return a signature object."
400 (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil
401 nil)))
402
403(defun epg-signature-status (signature)
404 "Return the status code of SIGNATURE."
405 (unless (eq (car-safe signature) 'epg-signature)
406 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
407 (aref (cdr signature) 0))
408
409(defun epg-signature-key-id (signature)
410 "Return the key-id of SIGNATURE."
411 (unless (eq (car-safe signature) 'epg-signature)
412 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
413 (aref (cdr signature) 1))
414
415(defun epg-signature-validity (signature)
416 "Return the validity of SIGNATURE."
417 (unless (eq (car-safe signature) 'epg-signature)
418 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
419 (aref (cdr signature) 2))
420
421(defun epg-signature-fingerprint (signature)
422 "Return the fingerprint of SIGNATURE."
423 (unless (eq (car-safe signature) 'epg-signature)
424 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
425 (aref (cdr signature) 3))
426
427(defun epg-signature-creation-time (signature)
428 "Return the creation time of SIGNATURE."
429 (unless (eq (car-safe signature) 'epg-signature)
430 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
431 (aref (cdr signature) 4))
432
433(defun epg-signature-expiration-time (signature)
434 "Return the expiration time of SIGNATURE."
435 (unless (eq (car-safe signature) 'epg-signature)
436 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
437 (aref (cdr signature) 5))
438
439(defun epg-signature-pubkey-algorithm (signature)
440 "Return the public key algorithm of SIGNATURE."
441 (unless (eq (car-safe signature) 'epg-signature)
442 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
443 (aref (cdr signature) 6))
444
445(defun epg-signature-digest-algorithm (signature)
446 "Return the digest algorithm of SIGNATURE."
447 (unless (eq (car-safe signature) 'epg-signature)
448 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
449 (aref (cdr signature) 7))
450
451(defun epg-signature-class (signature)
452 "Return the class of SIGNATURE."
453 (unless (eq (car-safe signature) 'epg-signature)
454 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
455 (aref (cdr signature) 8))
456
457(defun epg-signature-version (signature)
458 "Return the version of SIGNATURE."
459 (unless (eq (car-safe signature) 'epg-signature)
460 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
461 (aref (cdr signature) 9))
462
463(defun epg-sig-notations (signature)
464 "Return the list of notations of SIGNATURE."
465 (unless (eq (car-safe signature) 'epg-signature)
466 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
467 (aref (cdr signature) 10))
468
469(defun epg-signature-set-status (signature status)
470 "Set the status code of SIGNATURE."
471 (unless (eq (car-safe signature) 'epg-signature)
472 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
473 (aset (cdr signature) 0 status))
474
475(defun epg-signature-set-key-id (signature key-id)
476 "Set the key-id of SIGNATURE."
477 (unless (eq (car-safe signature) 'epg-signature)
478 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
479 (aset (cdr signature) 1 key-id))
480
481(defun epg-signature-set-validity (signature validity)
482 "Set the validity of SIGNATURE."
483 (unless (eq (car-safe signature) 'epg-signature)
484 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
485 (aset (cdr signature) 2 validity))
486
487(defun epg-signature-set-fingerprint (signature fingerprint)
488 "Set the fingerprint of SIGNATURE."
489 (unless (eq (car-safe signature) 'epg-signature)
490 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
491 (aset (cdr signature) 3 fingerprint))
492
493(defun epg-signature-set-creation-time (signature creation-time)
494 "Set the creation time of SIGNATURE."
495 (unless (eq (car-safe signature) 'epg-signature)
496 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
497 (aset (cdr signature) 4 creation-time))
498
499(defun epg-signature-set-expiration-time (signature expiration-time)
500 "Set the expiration time of SIGNATURE."
501 (unless (eq (car-safe signature) 'epg-signature)
502 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
503 (aset (cdr signature) 5 expiration-time))
504
505(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm)
506 "Set the public key algorithm of SIGNATURE."
507 (unless (eq (car-safe signature) 'epg-signature)
508 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
509 (aset (cdr signature) 6 pubkey-algorithm))
510
511(defun epg-signature-set-digest-algorithm (signature digest-algorithm)
512 "Set the digest algorithm of SIGNATURE."
513 (unless (eq (car-safe signature) 'epg-signature)
514 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
515 (aset (cdr signature) 7 digest-algorithm))
516
517(defun epg-signature-set-class (signature class)
518 "Set the class of SIGNATURE."
519 (unless (eq (car-safe signature) 'epg-signature)
520 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
521 (aset (cdr signature) 8 class))
522
523(defun epg-signature-set-version (signature version)
524 "Set the version of SIGNATURE."
525 (unless (eq (car-safe signature) 'epg-signature)
526 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
527 (aset (cdr signature) 9 version))
528
529(defun epg-signature-set-notations (signature notations)
530 "Set the list of notations of SIGNATURE."
531 (unless (eq (car-safe signature) 'epg-signature)
532 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
533 (aset (cdr signature) 10 notations))
534
535(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm
536 class creation-time fingerprint)
537 "Return a new signature object."
538 (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm
539 class creation-time fingerprint)))
540
541(defun epg-new-signature-type (new-signature)
542 "Return the type of NEW-SIGNATURE."
543 (unless (eq (car-safe new-signature) 'epg-new-signature)
544 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
545 (aref (cdr new-signature) 0))
546
547(defun epg-new-signature-pubkey-algorithm (new-signature)
548 "Return the public key algorithm of NEW-SIGNATURE."
549 (unless (eq (car-safe new-signature) 'epg-new-signature)
550 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
551 (aref (cdr new-signature) 1))
552
553(defun epg-new-signature-digest-algorithm (new-signature)
554 "Return the digest algorithm of NEW-SIGNATURE."
555 (unless (eq (car-safe new-signature) 'epg-new-signature)
556 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
557 (aref (cdr new-signature) 2))
558
559(defun epg-new-signature-class (new-signature)
560 "Return the class of NEW-SIGNATURE."
561 (unless (eq (car-safe new-signature) 'epg-new-signature)
562 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
563 (aref (cdr new-signature) 3))
564
565(defun epg-new-signature-creation-time (new-signature)
566 "Return the creation time of NEW-SIGNATURE."
567 (unless (eq (car-safe new-signature) 'epg-new-signature)
568 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
569 (aref (cdr new-signature) 4))
570
571(defun epg-new-signature-fingerprint (new-signature)
572 "Return the fingerprint of NEW-SIGNATURE."
573 (unless (eq (car-safe new-signature) 'epg-new-signature)
574 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
575 (aref (cdr new-signature) 5))
576
577(defun epg-make-key (owner-trust)
578 "Return a key object."
579 (cons 'epg-key (vector owner-trust nil nil)))
580
581(defun epg-key-owner-trust (key)
582 "Return the owner trust of KEY."
583 (unless (eq (car-safe key) 'epg-key)
584 (signal 'wrong-type-argument (list 'epg-key-p key)))
585 (aref (cdr key) 0))
586
587(defun epg-key-sub-key-list (key)
588 "Return the sub key list of KEY."
589 (unless (eq (car-safe key) 'epg-key)
590 (signal 'wrong-type-argument (list 'epg-key-p key)))
591 (aref (cdr key) 1))
592
593(defun epg-key-user-id-list (key)
594 "Return the user ID list of KEY."
595 (unless (eq (car-safe key) 'epg-key)
596 (signal 'wrong-type-argument (list 'epg-key-p key)))
597 (aref (cdr key) 2))
598
599(defun epg-key-set-sub-key-list (key sub-key-list)
600 "Set the sub key list of KEY."
601 (unless (eq (car-safe key) 'epg-key)
602 (signal 'wrong-type-argument (list 'epg-key-p key)))
603 (aset (cdr key) 1 sub-key-list))
604
605(defun epg-key-set-user-id-list (key user-id-list)
606 "Set the user ID list of KEY."
607 (unless (eq (car-safe key) 'epg-key)
608 (signal 'wrong-type-argument (list 'epg-key-p key)))
609 (aset (cdr key) 2 user-id-list))
610
611(defun epg-make-sub-key (validity capability secret-p algorithm length id
612 creation-time expiration-time)
613 "Return a sub key object."
614 (cons 'epg-sub-key
615 (vector validity capability secret-p algorithm length id creation-time
616 expiration-time nil)))
617
618(defun epg-sub-key-validity (sub-key)
619 "Return the validity of SUB-KEY."
620 (unless (eq (car-safe sub-key) 'epg-sub-key)
621 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
622 (aref (cdr sub-key) 0))
623
624(defun epg-sub-key-capability (sub-key)
625 "Return the capability of SUB-KEY."
626 (unless (eq (car-safe sub-key) 'epg-sub-key)
627 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
628 (aref (cdr sub-key) 1))
629
630(defun epg-sub-key-secret-p (sub-key)
631 "Return non-nil if SUB-KEY is a secret key."
632 (unless (eq (car-safe sub-key) 'epg-sub-key)
633 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
634 (aref (cdr sub-key) 2))
635
636(defun epg-sub-key-algorithm (sub-key)
637 "Return the algorithm of SUB-KEY."
638 (unless (eq (car-safe sub-key) 'epg-sub-key)
639 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
640 (aref (cdr sub-key) 3))
641
642(defun epg-sub-key-length (sub-key)
643 "Return the length of SUB-KEY."
644 (unless (eq (car-safe sub-key) 'epg-sub-key)
645 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
646 (aref (cdr sub-key) 4))
647
648(defun epg-sub-key-id (sub-key)
649 "Return the ID of SUB-KEY."
650 (unless (eq (car-safe sub-key) 'epg-sub-key)
651 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
652 (aref (cdr sub-key) 5))
653
654(defun epg-sub-key-creation-time (sub-key)
655 "Return the creation time of SUB-KEY."
656 (unless (eq (car-safe sub-key) 'epg-sub-key)
657 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
658 (aref (cdr sub-key) 6))
659
660(defun epg-sub-key-expiration-time (sub-key)
661 "Return the expiration time of SUB-KEY."
662 (unless (eq (car-safe sub-key) 'epg-sub-key)
663 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
664 (aref (cdr sub-key) 7))
665
666(defun epg-sub-key-fingerprint (sub-key)
667 "Return the fingerprint of SUB-KEY."
668 (unless (eq (car-safe sub-key) 'epg-sub-key)
669 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
670 (aref (cdr sub-key) 8))
671
672(defun epg-sub-key-set-fingerprint (sub-key fingerprint)
673 "Set the fingerprint of SUB-KEY.
674This function is for internal use only."
675 (unless (eq (car-safe sub-key) 'epg-sub-key)
676 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
677 (aset (cdr sub-key) 8 fingerprint))
678
679(defun epg-make-user-id (validity string)
680 "Return a user ID object."
681 (cons 'epg-user-id (vector validity string nil)))
682
683(defun epg-user-id-validity (user-id)
684 "Return the validity of USER-ID."
685 (unless (eq (car-safe user-id) 'epg-user-id)
686 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
687 (aref (cdr user-id) 0))
688
689(defun epg-user-id-string (user-id)
690 "Return the name of USER-ID."
691 (unless (eq (car-safe user-id) 'epg-user-id)
692 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
693 (aref (cdr user-id) 1))
694
695(defun epg-user-id-signature-list (user-id)
696 "Return the signature list of USER-ID."
697 (unless (eq (car-safe user-id) 'epg-user-id)
698 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
699 (aref (cdr user-id) 2))
700
701(defun epg-user-id-set-signature-list (user-id signature-list)
702 "Set the signature list of USER-ID."
703 (unless (eq (car-safe user-id) 'epg-user-id)
704 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
705 (aset (cdr user-id) 2 signature-list))
706
707(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time
708 expiration-time user-id class
709 exportable-p)
710 "Return a key signature object."
711 (cons 'epg-key-signature
712 (vector validity pubkey-algorithm key-id creation-time expiration-time
713 user-id class exportable-p)))
714
715(defun epg-key-signature-validity (key-signature)
716 "Return the validity of KEY-SIGNATURE."
717 (unless (eq (car-safe key-signature) 'epg-key-signature)
718 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
719 (aref (cdr key-signature) 0))
720
721(defun epg-key-signature-pubkey-algorithm (key-signature)
722 "Return the public key algorithm of KEY-SIGNATURE."
723 (unless (eq (car-safe key-signature) 'epg-key-signature)
724 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
725 (aref (cdr key-signature) 1))
726
727(defun epg-key-signature-key-id (key-signature)
728 "Return the key-id of KEY-SIGNATURE."
729 (unless (eq (car-safe key-signature) 'epg-key-signature)
730 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
731 (aref (cdr key-signature) 2))
732
733(defun epg-key-signature-creation-time (key-signature)
734 "Return the creation time of KEY-SIGNATURE."
735 (unless (eq (car-safe key-signature) 'epg-key-signature)
736 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
737 (aref (cdr key-signature) 3))
738
739(defun epg-key-signature-expiration-time (key-signature)
740 "Return the expiration time of KEY-SIGNATURE."
741 (unless (eq (car-safe key-signature) 'epg-key-signature)
742 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
743 (aref (cdr key-signature) 4))
744
745(defun epg-key-signature-user-id (key-signature)
746 "Return the user-id of KEY-SIGNATURE."
747 (unless (eq (car-safe key-signature) 'epg-key-signature)
748 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
749 (aref (cdr key-signature) 5))
750
751(defun epg-key-signature-class (key-signature)
752 "Return the class of KEY-SIGNATURE."
753 (unless (eq (car-safe key-signature) 'epg-key-signature)
754 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
755 (aref (cdr key-signature) 6))
756
757(defun epg-key-signature-exportable-p (key-signature)
758 "Return t if KEY-SIGNATURE is exportable."
759 (unless (eq (car-safe key-signature) 'epg-key-signature)
760 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
761 (aref (cdr key-signature) 7))
762
763(defun epg-make-sig-notation (name value &optional human-readable
764 critical)
765 "Return a notation object."
766 (cons 'epg-sig-notation (vector name value human-readable critical)))
767
768(defun epg-sig-notation-name (sig-notation)
769 "Return the name of SIG-NOTATION."
770 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
771 (signal 'wrong-type-argument (list 'epg-sig-notation-p
772 sig-notation)))
773 (aref (cdr sig-notation) 0))
774
775(defun epg-sig-notation-value (sig-notation)
776 "Return the value of SIG-NOTATION."
777 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
778 (signal 'wrong-type-argument (list 'epg-sig-notation-p
779 sig-notation)))
780 (aref (cdr sig-notation) 1))
781
782(defun epg-sig-notation-human-readable (sig-notation)
783 "Return the human-readable of SIG-NOTATION."
784 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
785 (signal 'wrong-type-argument (list 'epg-sig-notation-p
786 sig-notation)))
787 (aref (cdr sig-notation) 2))
788
789(defun epg-sig-notation-critical (sig-notation)
790 "Return the critical of SIG-NOTATION."
791 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
792 (signal 'wrong-type-argument (list 'epg-sig-notation-p
793 sig-notation)))
794 (aref (cdr sig-notation) 3))
795
796(defun epg-sig-notation-set-value (sig-notation value)
797 "Set the value of SIG-NOTATION."
798 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
799 (signal 'wrong-type-argument (list 'epg-sig-notation-p
800 sig-notation)))
801 (aset (cdr sig-notation) 1 value))
802
803(defun epg-make-import-status (fingerprint &optional reason new user-id
804 signature sub-key secret)
05234615 805 "Return an import status object."
c154c0be
MO
806 (cons 'epg-import-status (vector fingerprint reason new user-id signature
807 sub-key secret)))
808
809(defun epg-import-status-fingerprint (import-status)
810 "Return the fingerprint of the key that was considered."
811 (unless (eq (car-safe import-status) 'epg-import-status)
812 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
813 (aref (cdr import-status) 0))
814
815(defun epg-import-status-reason (import-status)
816 "Return the reason code for import failure."
817 (unless (eq (car-safe import-status) 'epg-import-status)
818 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
819 (aref (cdr import-status) 1))
820
821(defun epg-import-status-new (import-status)
822 "Return t if the imported key was new."
823 (unless (eq (car-safe import-status) 'epg-import-status)
824 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
825 (aref (cdr import-status) 2))
826
827(defun epg-import-status-user-id (import-status)
828 "Return t if the imported key contained new user IDs."
829 (unless (eq (car-safe import-status) 'epg-import-status)
830 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
831 (aref (cdr import-status) 3))
832
833(defun epg-import-status-signature (import-status)
834 "Return t if the imported key contained new signatures."
835 (unless (eq (car-safe import-status) 'epg-import-status)
836 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
837 (aref (cdr import-status) 4))
838
839(defun epg-import-status-sub-key (import-status)
840 "Return t if the imported key contained new sub keys."
841 (unless (eq (car-safe import-status) 'epg-import-status)
842 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
843 (aref (cdr import-status) 5))
844
845(defun epg-import-status-secret (import-status)
846 "Return t if the imported key contained a secret key."
847 (unless (eq (car-safe import-status) 'epg-import-status)
848 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
849 (aref (cdr import-status) 6))
850
851(defun epg-make-import-result (considered no-user-id imported imported-rsa
852 unchanged new-user-ids new-sub-keys
853 new-signatures new-revocations
854 secret-read secret-imported
855 secret-unchanged not-imported
856 imports)
05234615 857 "Return an import result object."
c154c0be
MO
858 (cons 'epg-import-result (vector considered no-user-id imported imported-rsa
859 unchanged new-user-ids new-sub-keys
860 new-signatures new-revocations secret-read
861 secret-imported secret-unchanged
862 not-imported imports)))
863
864(defun epg-import-result-considered (import-result)
865 "Return the total number of considered keys."
866 (unless (eq (car-safe import-result) 'epg-import-result)
867 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
868 (aref (cdr import-result) 0))
869
870(defun epg-import-result-no-user-id (import-result)
871 "Return the number of keys without user ID."
872 (unless (eq (car-safe import-result) 'epg-import-result)
873 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
874 (aref (cdr import-result) 1))
875
876(defun epg-import-result-imported (import-result)
877 "Return the number of imported keys."
878 (unless (eq (car-safe import-result) 'epg-import-result)
879 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
880 (aref (cdr import-result) 2))
881
882(defun epg-import-result-imported-rsa (import-result)
883 "Return the number of imported RSA keys."
884 (unless (eq (car-safe import-result) 'epg-import-result)
885 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
886 (aref (cdr import-result) 3))
887
888(defun epg-import-result-unchanged (import-result)
889 "Return the number of unchanged keys."
890 (unless (eq (car-safe import-result) 'epg-import-result)
891 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
892 (aref (cdr import-result) 4))
893
894(defun epg-import-result-new-user-ids (import-result)
895 "Return the number of new user IDs."
896 (unless (eq (car-safe import-result) 'epg-import-result)
897 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
898 (aref (cdr import-result) 5))
899
900(defun epg-import-result-new-sub-keys (import-result)
901 "Return the number of new sub keys."
902 (unless (eq (car-safe import-result) 'epg-import-result)
903 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
904 (aref (cdr import-result) 6))
905
906(defun epg-import-result-new-signatures (import-result)
907 "Return the number of new signatures."
908 (unless (eq (car-safe import-result) 'epg-import-result)
909 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
910 (aref (cdr import-result) 7))
911
912(defun epg-import-result-new-revocations (import-result)
913 "Return the number of new revocations."
914 (unless (eq (car-safe import-result) 'epg-import-result)
915 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
916 (aref (cdr import-result) 8))
917
918(defun epg-import-result-secret-read (import-result)
919 "Return the total number of secret keys read."
920 (unless (eq (car-safe import-result) 'epg-import-result)
921 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
922 (aref (cdr import-result) 9))
923
924(defun epg-import-result-secret-imported (import-result)
925 "Return the number of imported secret keys."
926 (unless (eq (car-safe import-result) 'epg-import-result)
927 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
928 (aref (cdr import-result) 10))
929
930(defun epg-import-result-secret-unchanged (import-result)
931 "Return the number of unchanged secret keys."
932 (unless (eq (car-safe import-result) 'epg-import-result)
933 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
934 (aref (cdr import-result) 11))
935
936(defun epg-import-result-not-imported (import-result)
937 "Return the number of keys not imported."
938 (unless (eq (car-safe import-result) 'epg-import-result)
939 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
940 (aref (cdr import-result) 12))
941
942(defun epg-import-result-imports (import-result)
943 "Return the list of `epg-import-status' objects."
944 (unless (eq (car-safe import-result) 'epg-import-result)
945 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
946 (aref (cdr import-result) 13))
947
948(defun epg-context-result-for (context name)
949 "Return the result of CONTEXT associated with NAME."
950 (cdr (assq name (epg-context-result context))))
951
952(defun epg-context-set-result-for (context name value)
953 "Set the result of CONTEXT associated with NAME to VALUE."
954 (let* ((result (epg-context-result context))
955 (entry (assq name result)))
956 (if entry
957 (setcdr entry value)
958 (epg-context-set-result context (cons (cons name value) result)))))
959
960(defun epg-signature-to-string (signature)
961 "Convert SIGNATURE to a human readable string."
962 (let* ((user-id (cdr (assoc (epg-signature-key-id signature)
963 epg-user-id-alist)))
964 (pubkey-algorithm (epg-signature-pubkey-algorithm signature)))
965 (concat
966 (cond ((eq (epg-signature-status signature) 'good)
967 "Good signature from ")
968 ((eq (epg-signature-status signature) 'bad)
969 "Bad signature from ")
970 ((eq (epg-signature-status signature) 'expired)
971 "Expired signature from ")
972 ((eq (epg-signature-status signature) 'expired-key)
973 "Signature made by expired key ")
974 ((eq (epg-signature-status signature) 'revoked-key)
975 "Signature made by revoked key ")
976 ((eq (epg-signature-status signature) 'no-pubkey)
977 "No public key for "))
978 (epg-signature-key-id signature)
979 (if user-id
980 (concat " "
981 (if (stringp user-id)
982 user-id
983 (epg-decode-dn user-id)))
984 "")
985 (if (epg-signature-validity signature)
986 (format " (trust %s)" (epg-signature-validity signature))
987 "")
988 (if (epg-signature-creation-time signature)
989 (format-time-string " created at %Y-%m-%dT%T%z"
990 (epg-signature-creation-time signature))
991 "")
992 (if pubkey-algorithm
993 (concat " using "
994 (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
995 (format "(unknown algorithm %d)" pubkey-algorithm)))
996 ""))))
997
998(defun epg-verify-result-to-string (verify-result)
999 "Convert VERIFY-RESULT to a human readable string."
1000 (mapconcat #'epg-signature-to-string verify-result "\n"))
1001
1002(defun epg-new-signature-to-string (new-signature)
1003 "Convert NEW-SIGNATURE to a human readable string."
1004 (concat
1005 (cond ((eq (epg-new-signature-type new-signature) 'detached)
1006 "Detached signature ")
1007 ((eq (epg-new-signature-type new-signature) 'clear)
1008 "Cleartext signature ")
1009 (t
1010 "Signature "))
1011 (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
1012 epg-pubkey-algorithm-alist))
1013 "/"
1014 (cdr (assq (epg-new-signature-digest-algorithm new-signature)
1015 epg-digest-algorithm-alist))
1016 " "
1017 (format "%02X " (epg-new-signature-class new-signature))
1018 (epg-new-signature-fingerprint new-signature)))
1019
1020(defun epg-import-result-to-string (import-result)
1021 "Convert IMPORT-RESULT to a human readable string."
1022 (concat (format "Total number processed: %d\n"
1023 (epg-import-result-considered import-result))
1024 (if (> (epg-import-result-not-imported import-result) 0)
1025 (format " skipped new keys: %d\n"
1026 (epg-import-result-not-imported import-result)))
1027 (if (> (epg-import-result-no-user-id import-result) 0)
1028 (format " w/o user IDs: %d\n"
1029 (epg-import-result-no-user-id import-result)))
1030 (if (> (epg-import-result-imported import-result) 0)
1031 (concat (format " imported: %d"
1032 (epg-import-result-imported import-result))
1033 (if (> (epg-import-result-imported-rsa import-result) 0)
1034 (format " (RSA: %d)"
1035 (epg-import-result-imported-rsa
1036 import-result)))
1037 "\n"))
1038 (if (> (epg-import-result-unchanged import-result) 0)
1039 (format " unchanged: %d\n"
1040 (epg-import-result-unchanged import-result)))
1041 (if (> (epg-import-result-new-user-ids import-result) 0)
1042 (format " new user IDs: %d\n"
1043 (epg-import-result-new-user-ids import-result)))
1044 (if (> (epg-import-result-new-sub-keys import-result) 0)
1045 (format " new subkeys: %d\n"
1046 (epg-import-result-new-sub-keys import-result)))
1047 (if (> (epg-import-result-new-signatures import-result) 0)
1048 (format " new signatures: %d\n"
1049 (epg-import-result-new-signatures import-result)))
1050 (if (> (epg-import-result-new-revocations import-result) 0)
1051 (format " new key revocations: %d\n"
1052 (epg-import-result-new-revocations import-result)))
1053 (if (> (epg-import-result-secret-read import-result) 0)
1054 (format " secret keys read: %d\n"
1055 (epg-import-result-secret-read import-result)))
1056 (if (> (epg-import-result-secret-imported import-result) 0)
1057 (format " secret keys imported: %d\n"
1058 (epg-import-result-secret-imported import-result)))
1059 (if (> (epg-import-result-secret-unchanged import-result) 0)
1060 (format " secret keys unchanged: %d\n"
1061 (epg-import-result-secret-unchanged import-result)))))
1062
1063(defun epg--start (context args)
1064 "Start `epg-gpg-program' in a subprocess with given ARGS."
1065 (if (and (epg-context-process context)
1066 (eq (process-status (epg-context-process context)) 'run))
1067 (error "%s is already running in this context"
1068 (if (eq (epg-context-protocol context) 'CMS)
1069 epg-gpgsm-program
1070 epg-gpg-program)))
1071 (let* ((args (append (list "--no-tty"
1072 "--status-fd" "1"
1073 "--yes")
1074 (if (and (not (eq (epg-context-protocol context) 'CMS))
1075 (string-match ":" (or (getenv "GPG_AGENT_INFO")
1076 "")))
1077 '("--use-agent"))
1078 (if (and (not (eq (epg-context-protocol context) 'CMS))
1079 (epg-context-progress-callback context))
1080 '("--enable-progress-filter"))
1081 (if epg-gpg-home-directory
1082 (list "--homedir" epg-gpg-home-directory))
1083 (unless (eq (epg-context-protocol context) 'CMS)
1084 '("--command-fd" "0"))
1085 (if (epg-context-armor context) '("--armor"))
1086 (if (epg-context-textmode context) '("--textmode"))
1087 (if (epg-context-output-file context)
1088 (list "--output" (epg-context-output-file context)))
1089 args))
1090 (coding-system-for-write 'binary)
1091 (coding-system-for-read 'binary)
1092 process-connection-type
1093 (orig-mode (default-file-modes))
1094 (buffer (generate-new-buffer " *epg*"))
1095 process)
1096 (if epg-debug
1097 (save-excursion
1098 (unless epg-debug-buffer
1099 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1100 (set-buffer epg-debug-buffer)
1101 (goto-char (point-max))
1102 (insert (format "%s %s\n"
1103 (if (eq (epg-context-protocol context) 'CMS)
1104 epg-gpgsm-program
1105 epg-gpg-program)
1106 (mapconcat #'identity args " ")))))
1107 (with-current-buffer buffer
1108 (if (fboundp 'set-buffer-multibyte)
1109 (set-buffer-multibyte nil))
1110 (make-local-variable 'epg-last-status)
1111 (setq epg-last-status nil)
1112 (make-local-variable 'epg-read-point)
1113 (setq epg-read-point (point-min))
1114 (make-local-variable 'epg-process-filter-running)
1115 (setq epg-process-filter-running nil)
1116 (make-local-variable 'epg-pending-status-list)
1117 (setq epg-pending-status-list nil)
1118 (make-local-variable 'epg-key-id)
1119 (setq epg-key-id nil)
1120 (make-local-variable 'epg-context)
1121 (setq epg-context context))
1122 (unwind-protect
1123 (progn
1124 (set-default-file-modes 448)
1125 (setq process
1126 (apply #'start-process "epg" buffer
1127 (if (eq (epg-context-protocol context) 'CMS)
1128 epg-gpgsm-program
1129 epg-gpg-program)
1130 args)))
1131 (set-default-file-modes orig-mode))
1132 (set-process-filter process #'epg--process-filter)
1133 (epg-context-set-process context process)))
1134
1135(defun epg--process-filter (process input)
1136 (if epg-debug
1137 (save-excursion
1138 (unless epg-debug-buffer
1139 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1140 (set-buffer epg-debug-buffer)
1141 (goto-char (point-max))
1142 (insert input)))
1143 (if (buffer-live-p (process-buffer process))
1144 (save-excursion
1145 (set-buffer (process-buffer process))
1146 (goto-char (point-max))
1147 (insert input)
1148 (unless epg-process-filter-running
1149 (unwind-protect
1150 (progn
1151 (setq epg-process-filter-running t)
1152 (goto-char epg-read-point)
1153 (beginning-of-line)
1154 (while (looking-at ".*\n") ;the input line finished
1155 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
1156 (let* ((status (match-string 1))
1157 (string (match-string 2))
1158 (symbol (intern-soft (concat "epg--status-"
1159 status))))
1160 (if (member status epg-pending-status-list)
1161 (setq epg-pending-status-list nil))
1162 (if (and symbol
1163 (fboundp symbol))
1164 (funcall symbol epg-context string))
1165 (setq epg-last-status (cons status string))))
1166 (forward-line)
1167 (setq epg-read-point (point))))
1168 (setq epg-process-filter-running nil))))))
1169
1170(defun epg-read-output (context)
1171 "Read the output file CONTEXT and return the content as a string."
1172 (with-temp-buffer
1173 (if (fboundp 'set-buffer-multibyte)
1174 (set-buffer-multibyte nil))
1175 (if (file-exists-p (epg-context-output-file context))
1176 (let ((coding-system-for-read 'binary))
1177 (insert-file-contents (epg-context-output-file context))
1178 (buffer-string)))))
1179
1180(defun epg-wait-for-status (context status-list)
1181 "Wait until one of elements in STATUS-LIST arrives."
1182 (with-current-buffer (process-buffer (epg-context-process context))
1183 (setq epg-pending-status-list status-list)
1184 (while (and (eq (process-status (epg-context-process context)) 'run)
1185 epg-pending-status-list)
47e49712
DU
1186 (accept-process-output (epg-context-process context) 1))
1187 (if epg-pending-status-list
1188 (epg-context-set-result-for context 'error 'exit))))
c154c0be
MO
1189
1190(defun epg-wait-for-completion (context)
1191 "Wait until the `epg-gpg-program' process completes."
1192 (while (eq (process-status (epg-context-process context)) 'run)
de22b81d 1193 (accept-process-output (epg-context-process context) 1))
2a268ee2 1194 ;; This line is needed to run the process-filter right now.
de22b81d 1195 (sleep-for 0.1))
c154c0be
MO
1196
1197(defun epg-reset (context)
1198 "Reset the CONTEXT."
1199 (if (and (epg-context-process context)
1200 (buffer-live-p (process-buffer (epg-context-process context))))
1201 (kill-buffer (process-buffer (epg-context-process context))))
1202 (epg-context-set-process context nil))
1203
1204(defun epg-delete-output-file (context)
1205 "Delete the output file of CONTEXT."
1206 (if (and (epg-context-output-file context)
1207 (file-exists-p (epg-context-output-file context)))
1208 (delete-file (epg-context-output-file context))))
1209
1210(eval-and-compile
1211 (if (fboundp 'decode-coding-string)
1212 (defalias 'epg--decode-coding-string 'decode-coding-string)
1213 (defalias 'epg--decode-coding-string 'identity)))
1214
1215(defun epg--status-USERID_HINT (context string)
1216 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1217 (let* ((key-id (match-string 1 string))
1218 (user-id (match-string 2 string))
1219 (entry (assoc key-id epg-user-id-alist)))
1220 (condition-case nil
1221 (setq user-id (epg--decode-coding-string
1222 (epg--decode-percent-escape user-id)
1223 'utf-8))
1224 (error))
1225 (if entry
1226 (setcdr entry user-id)
1227 (setq epg-user-id-alist (cons (cons key-id user-id)
1228 epg-user-id-alist))))))
1229
1230(defun epg--status-NEED_PASSPHRASE (context string)
1231 (if (string-match "\\`\\([^ ]+\\)" string)
1232 (setq epg-key-id (match-string 1 string))))
1233
1234(defun epg--status-NEED_PASSPHRASE_SYM (context string)
1235 (setq epg-key-id 'SYM))
1236
1237(defun epg--status-NEED_PASSPHRASE_PIN (context string)
1238 (setq epg-key-id 'PIN))
1239
1240(eval-and-compile
1241 (if (fboundp 'clear-string)
1242 (defalias 'epg--clear-string 'clear-string)
1243 (defun epg--clear-string (string)
1244 (fillarray string 0))))
1245
1246(eval-and-compile
1247 (if (fboundp 'encode-coding-string)
1248 (defalias 'epg--encode-coding-string 'encode-coding-string)
1249 (defalias 'epg--encode-coding-string 'identity)))
1250
1251(defun epg--status-GET_HIDDEN (context string)
1252 (when (and epg-key-id
1253 (string-match "\\`passphrase\\." string))
1254 (unless (epg-context-passphrase-callback context)
1255 (error "passphrase-callback not set"))
1256 (let (inhibit-quit
1257 passphrase
1258 passphrase-with-new-line
1259 encoded-passphrase-with-new-line)
1260 (unwind-protect
1261 (condition-case nil
1262 (progn
1263 (setq passphrase
1264 (funcall
7c0ffa6d 1265 (car (epg-context-passphrase-callback context))
c154c0be
MO
1266 context
1267 epg-key-id
7c0ffa6d 1268 (cdr (epg-context-passphrase-callback context))))
c154c0be
MO
1269 (when passphrase
1270 (setq passphrase-with-new-line (concat passphrase "\n"))
1271 (epg--clear-string passphrase)
1272 (setq passphrase nil)
1273 (if epg-passphrase-coding-system
1274 (progn
1275 (setq encoded-passphrase-with-new-line
1276 (epg--encode-coding-string
1277 passphrase-with-new-line
1278 (coding-system-change-eol-conversion
1279 epg-passphrase-coding-system 'unix)))
1280 (epg--clear-string passphrase-with-new-line)
1281 (setq passphrase-with-new-line nil))
1282 (setq encoded-passphrase-with-new-line
1283 passphrase-with-new-line
1284 passphrase-with-new-line nil))
1285 (process-send-string (epg-context-process context)
1286 encoded-passphrase-with-new-line)))
1287 (quit
1288 (epg-context-set-result-for
1289 context 'error
1290 (cons '(quit)
1291 (epg-context-result-for context 'error)))
1292 (delete-process (epg-context-process context))))
1293 (if passphrase
1294 (epg--clear-string passphrase))
1295 (if passphrase-with-new-line
1296 (epg--clear-string passphrase-with-new-line))
1297 (if encoded-passphrase-with-new-line
1298 (epg--clear-string encoded-passphrase-with-new-line))))))
1299
1300(defun epg--prompt-GET_BOOL (context string)
1301 (let ((entry (assoc string epg-prompt-alist)))
1302 (y-or-n-p (if entry (cdr entry) (concat string "? ")))))
1303
1304(defun epg--prompt-GET_BOOL-untrusted_key.override (context string)
1305 (y-or-n-p (if (and (equal (car epg-last-status) "USERID_HINT")
1306 (string-match "\\`\\([^ ]+\\) \\(.*\\)"
1307 (cdr epg-last-status)))
1308 (let* ((key-id (match-string 1 (cdr epg-last-status)))
1309 (user-id (match-string 2 (cdr epg-last-status)))
1310 (entry (assoc key-id epg-user-id-alist)))
1311 (if entry
1312 (setq user-id (cdr entry)))
1313 (format "Untrusted key %s %s. Use anyway? " key-id user-id))
1314 "Use untrusted key anyway? ")))
1315
1316(defun epg--status-GET_BOOL (context string)
1317 (let (inhibit-quit)
1318 (condition-case nil
1319 (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string))
1320 #'epg--prompt-GET_BOOL)
1321 context string)
1322 (process-send-string (epg-context-process context) "y\n")
1323 (process-send-string (epg-context-process context) "n\n"))
1324 (quit
1325 (epg-context-set-result-for
1326 context 'error
1327 (cons '(quit)
1328 (epg-context-result-for context 'error)))
1329 (delete-process (epg-context-process context))))))
1330
1331(defun epg--status-GET_LINE (context string)
1332 (let ((entry (assoc string epg-prompt-alist))
1333 inhibit-quit)
1334 (condition-case nil
1335 (process-send-string (epg-context-process context)
1336 (concat (read-string
1337 (if entry
1338 (cdr entry)
1339 (concat string ": ")))
1340 "\n"))
1341 (quit
1342 (epg-context-set-result-for
1343 context 'error
1344 (cons '(quit)
1345 (epg-context-result-for context 'error)))
1346 (delete-process (epg-context-process context))))))
1347
1348(defun epg--status-*SIG (context status string)
1349 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1350 (let* ((key-id (match-string 1 string))
1351 (user-id (match-string 2 string))
1352 (entry (assoc key-id epg-user-id-alist)))
1353 (epg-context-set-result-for
1354 context
1355 'verify
1356 (cons (epg-make-signature status key-id)
1357 (epg-context-result-for context 'verify)))
1358 (condition-case nil
1359 (if (eq (epg-context-protocol context) 'CMS)
1360 (setq user-id (epg-dn-from-string user-id))
1361 (setq user-id (epg--decode-coding-string
1362 (epg--decode-percent-escape user-id)
1363 'utf-8)))
1364 (error))
1365 (if entry
1366 (setcdr entry user-id)
1367 (setq epg-user-id-alist
1368 (cons (cons key-id user-id) epg-user-id-alist))))
1369 (epg-context-set-result-for
1370 context
1371 'verify
1372 (cons (epg-make-signature status)
1373 (epg-context-result-for context 'verify)))))
1374
1375(defun epg--status-GOODSIG (context string)
1376 (epg--status-*SIG context 'good string))
1377
1378(defun epg--status-EXPSIG (context string)
1379 (epg--status-*SIG context 'expired string))
1380
1381(defun epg--status-EXPKEYSIG (context string)
1382 (epg--status-*SIG context 'expired-key string))
1383
1384(defun epg--status-REVKEYSIG (context string)
1385 (epg--status-*SIG context 'revoked-key string))
1386
1387(defun epg--status-BADSIG (context string)
1388 (epg--status-*SIG context 'bad string))
1389
1390(defun epg--status-NO_PUBKEY (context string)
1391 (let ((signature (car (epg-context-result-for context 'verify))))
1392 (if (and signature
1393 (eq (epg-signature-status signature) 'error)
1394 (equal (epg-signature-key-id signature) string))
1395 (epg-signature-set-status signature 'no-pubkey))))
1396
1397(defun epg--time-from-seconds (seconds)
1398 (let ((number-seconds (string-to-number (concat seconds ".0"))))
1399 (cons (floor (/ number-seconds 65536))
1400 (floor (mod number-seconds 65536)))))
1401
1402(defun epg--status-ERRSIG (context string)
1403 (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1404\\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
1405 string)
1406 (let ((signature (epg-make-signature 'error)))
1407 (epg-context-set-result-for
1408 context
1409 'verify
1410 (cons signature
1411 (epg-context-result-for context 'verify)))
1412 (epg-signature-set-key-id
1413 signature
1414 (match-string 1 string))
1415 (epg-signature-set-pubkey-algorithm
1416 signature
1417 (string-to-number (match-string 2 string)))
1418 (epg-signature-set-digest-algorithm
1419 signature
1420 (string-to-number (match-string 3 string)))
1421 (epg-signature-set-class
1422 signature
1423 (string-to-number (match-string 4 string) 16))
1424 (epg-signature-set-creation-time
1425 signature
1426 (epg--time-from-seconds (match-string 5 string))))))
1427
1428(defun epg--status-VALIDSIG (context string)
1429 (let ((signature (car (epg-context-result-for context 'verify))))
1430 (when (and signature
1431 (eq (epg-signature-status signature) 'good)
1432 (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
1433\\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
1434\\(.*\\)"
1435 string))
1436 (epg-signature-set-fingerprint
1437 signature
1438 (match-string 1 string))
1439 (epg-signature-set-creation-time
1440 signature
1441 (epg--time-from-seconds (match-string 2 string)))
1442 (unless (equal (match-string 3 string) "0")
1443 (epg-signature-set-expiration-time
1444 signature
1445 (epg--time-from-seconds (match-string 3 string))))
1446 (epg-signature-set-version
1447 signature
1448 (string-to-number (match-string 4 string)))
1449 (epg-signature-set-pubkey-algorithm
f1914c40 1450 signature
c154c0be
MO
1451 (string-to-number (match-string 5 string)))
1452 (epg-signature-set-digest-algorithm
1453 signature
1454 (string-to-number (match-string 6 string)))
1455 (epg-signature-set-class
1456 signature
1457 (string-to-number (match-string 7 string) 16)))))
1458
1459(defun epg--status-TRUST_UNDEFINED (context string)
1460 (let ((signature (car (epg-context-result-for context 'verify))))
1461 (if (and signature
1462 (eq (epg-signature-status signature) 'good))
1463 (epg-signature-set-validity signature 'undefined))))
1464
1465(defun epg--status-TRUST_NEVER (context string)
1466 (let ((signature (car (epg-context-result-for context 'verify))))
1467 (if (and signature
1468 (eq (epg-signature-status signature) 'good))
1469 (epg-signature-set-validity signature 'never))))
1470
1471(defun epg--status-TRUST_MARGINAL (context string)
1472 (let ((signature (car (epg-context-result-for context 'verify))))
1473 (if (and signature
1474 (eq (epg-signature-status signature) 'marginal))
1475 (epg-signature-set-validity signature 'marginal))))
1476
1477(defun epg--status-TRUST_FULLY (context string)
1478 (let ((signature (car (epg-context-result-for context 'verify))))
1479 (if (and signature
1480 (eq (epg-signature-status signature) 'good))
1481 (epg-signature-set-validity signature 'full))))
1482
1483(defun epg--status-TRUST_ULTIMATE (context string)
1484 (let ((signature (car (epg-context-result-for context 'verify))))
1485 (if (and signature
1486 (eq (epg-signature-status signature) 'good))
1487 (epg-signature-set-validity signature 'ultimate))))
1488
1489(defun epg--status-NOTATION_NAME (context string)
1490 (let ((signature (car (epg-context-result-for context 'verify))))
1491 (if signature
1492 (epg-signature-set-notations
1493 signature
1494 (cons (epg-make-sig-notation string nil t nil)
1495 (epg-sig-notations signature))))))
1496
1497(defun epg--status-NOTATION_DATA (context string)
1498 (let ((signature (car (epg-context-result-for context 'verify)))
1499 notation)
1500 (if (and signature
1501 (setq notation (car (epg-sig-notations signature))))
1502 (epg-sig-notation-set-value notation string))))
1503
1504(defun epg--status-POLICY_URL (context string)
1505 (let ((signature (car (epg-context-result-for context 'verify))))
1506 (if signature
1507 (epg-signature-set-notations
1508 signature
1509 (cons (epg-make-sig-notation nil string t nil)
1510 (epg-sig-notations signature))))))
1511
1512(defun epg--status-PROGRESS (context string)
1513 (if (and (epg-context-progress-callback context)
1514 (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1515 string))
7c0ffa6d 1516 (funcall (car (epg-context-progress-callback context))
c154c0be
MO
1517 context
1518 (match-string 1 string)
1519 (match-string 2 string)
1520 (string-to-number (match-string 3 string))
1521 (string-to-number (match-string 4 string))
7c0ffa6d 1522 (cdr (epg-context-progress-callback context)))))
c154c0be
MO
1523
1524(defun epg--status-ENC_TO (context string)
1525 (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1526 (epg-context-set-result-for
1527 context 'encrypted-to
1528 (cons (list (match-string 1 string)
1529 (string-to-number (match-string 2 string))
1530 (string-to-number (match-string 3 string)))
1531 (epg-context-result-for context 'encrypted-to)))))
1532
1533(defun epg--status-DECRYPTION_FAILED (context string)
1534 (epg-context-set-result-for context 'decryption-failed t))
1535
1536(defun epg--status-DECRYPTION_OKAY (context string)
1537 (epg-context-set-result-for context 'decryption-okay t))
1538
1539(defun epg--status-NODATA (context string)
1540 (epg-context-set-result-for
1541 context 'error
1542 (cons (cons 'no-data (string-to-number string))
1543 (epg-context-result-for context 'error))))
1544
1545(defun epg--status-UNEXPECTED (context string)
1546 (epg-context-set-result-for
1547 context 'error
1548 (cons (cons 'unexpected (string-to-number string))
1549 (epg-context-result-for context 'error))))
1550
1551(defun epg--status-KEYEXPIRED (context string)
1552 (epg-context-set-result-for
1553 context 'error
1554 (cons (list 'key-expired (cons 'expiration-time
1555 (epg--time-from-seconds string)))
1556 (epg-context-result-for context 'error))))
1557
1558(defun epg--status-KEYREVOKED (context string)
1559 (epg-context-set-result-for
1560 context 'error
1561 (cons '(key-revoked)
1562 (epg-context-result-for context 'error))))
1563
1564(defun epg--status-BADARMOR (context string)
1565 (epg-context-set-result-for
1566 context 'error
1567 (cons '(bad-armor)
1568 (epg-context-result-for context 'error))))
1569
1570(defun epg--status-INV_RECP (context string)
1571 (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1572 (epg-context-set-result-for
1573 context 'error
1574 (cons (list 'invalid-recipient
1575 (cons 'reason
1576 (string-to-number (match-string 1 string)))
1577 (cons 'requested-recipient
1578 (match-string 2 string)))
1579 (epg-context-result-for context 'error)))))
1580
1581(defun epg--status-NO_RECP (context string)
1582 (epg-context-set-result-for
1583 context 'error
1584 (cons '(no-recipients)
1585 (epg-context-result-for context 'error))))
1586
1587(defun epg--status-DELETE_PROBLEM (context string)
1588 (if (string-match "\\`\\([0-9]+\\)" string)
1589 (epg-context-set-result-for
1590 context 'error
1591 (cons (cons 'delete-problem
1592 (string-to-number (match-string 1 string)))
1593 (epg-context-result-for context 'error)))))
1594
1595(defun epg--status-SIG_CREATED (context string)
1596 (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1597\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1598 (epg-context-set-result-for
1599 context 'sign
1600 (cons (epg-make-new-signature
1601 (cdr (assq (aref (match-string 1 string) 0)
1602 epg-new-signature-type-alist))
1603 (string-to-number (match-string 2 string))
1604 (string-to-number (match-string 3 string))
1605 (string-to-number (match-string 4 string) 16)
1606 (epg--time-from-seconds (match-string 5 string))
1607 (substring string (match-end 0)))
1608 (epg-context-result-for context 'sign)))))
1609
1610(defun epg--status-KEY_CREATED (context string)
1611 (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1612 (epg-context-set-result-for
1613 context 'generate-key
1614 (cons (list (cons 'type (string-to-char (match-string 1 string)))
1615 (cons 'fingerprint (match-string 2 string)))
1616 (epg-context-result-for context 'generate-key)))))
1617
1618(defun epg--status-KEY_NOT_CREATED (context string)
1619 (epg-context-set-result-for
1620 context 'error
1621 (cons '(key-not-created)
1622 (epg-context-result-for context 'error))))
1623
1624(defun epg--status-IMPORTED (context string)
1625 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1626 (let* ((key-id (match-string 1 string))
1627 (user-id (match-string 2 string))
1628 (entry (assoc key-id epg-user-id-alist)))
1629 (condition-case nil
1630 (setq user-id (epg--decode-coding-string
1631 (epg--decode-percent-escape user-id)
1632 'utf-8))
1633 (error))
1634 (if entry
1635 (setcdr entry user-id)
1636 (setq epg-user-id-alist (cons (cons key-id user-id)
1637 epg-user-id-alist))))))
1638
1639(defun epg--status-IMPORT_OK (context string)
1640 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1641 (let ((reason (string-to-number (match-string 1 string))))
1642 (epg-context-set-result-for
1643 context 'import-status
1644 (cons (epg-make-import-status (if (match-beginning 2)
1645 (match-string 3 string))
1646 nil
1647 (/= (logand reason 1) 0)
1648 (/= (logand reason 2) 0)
1649 (/= (logand reason 4) 0)
1650 (/= (logand reason 8) 0)
1651 (/= (logand reason 16) 0))
1652 (epg-context-result-for context 'import-status))))))
1653
1654(defun epg--status-IMPORT_PROBLEM (context string)
1655 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1656 (epg-context-set-result-for
1657 context 'import-status
1658 (cons (epg-make-import-status
1659 (if (match-beginning 2)
1660 (match-string 3 string))
1661 (string-to-number (match-string 1 string)))
1662 (epg-context-result-for context 'import-status)))))
1663
1664(defun epg--status-IMPORT_RES (context string)
1665 (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1666\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1667\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1668 (epg-context-set-result-for
1669 context 'import
1670 (epg-make-import-result (string-to-number (match-string 1 string))
1671 (string-to-number (match-string 2 string))
1672 (string-to-number (match-string 3 string))
1673 (string-to-number (match-string 4 string))
1674 (string-to-number (match-string 5 string))
1675 (string-to-number (match-string 6 string))
1676 (string-to-number (match-string 7 string))
1677 (string-to-number (match-string 8 string))
1678 (string-to-number (match-string 9 string))
1679 (string-to-number (match-string 10 string))
1680 (string-to-number (match-string 11 string))
1681 (string-to-number (match-string 12 string))
1682 (string-to-number (match-string 13 string))
1683 (epg-context-result-for context 'import-status)))
1684 (epg-context-set-result-for context 'import-status nil)))
1685
1686(defun epg-passphrase-callback-function (context key-id handback)
1687 (if (eq key-id 'SYM)
1688 (read-passwd "Passphrase for symmetric encryption: "
1689 (eq (epg-context-operation context) 'encrypt))
1690 (read-passwd
1691 (if (eq key-id 'PIN)
1692 "Passphrase for PIN: "
1693 (let ((entry (assoc key-id epg-user-id-alist)))
1694 (if entry
1695 (format "Passphrase for %s %s: " key-id (cdr entry))
1696 (format "Passphrase for %s: " key-id)))))))
1697
1698(make-obsolete 'epg-passphrase-callback-function
5443c9b7 1699 'epa-passphrase-callback-function "23.1")
c154c0be
MO
1700
1701(defun epg--list-keys-1 (context name mode)
1702 (let ((args (append (if epg-gpg-home-directory
1703 (list "--homedir" epg-gpg-home-directory))
1704 '("--with-colons" "--no-greeting" "--batch"
1705 "--with-fingerprint" "--with-fingerprint")
1706 (unless (eq (epg-context-protocol context) 'CMS)
1707 '("--fixed-list-mode"))))
1708 (list-keys-option (if (memq mode '(t secret))
1709 "--list-secret-keys"
1710 (if (memq mode '(nil public))
1711 "--list-keys"
1712 "--list-sigs")))
1713 (coding-system-for-read 'binary)
1714 keys string field index)
1715 (if name
1716 (progn
1717 (unless (listp name)
1718 (setq name (list name)))
1719 (while name
1720 (setq args (append args (list list-keys-option (car name)))
1721 name (cdr name))))
1722 (setq args (append args (list list-keys-option))))
1723 (with-temp-buffer
1724 (apply #'call-process
1725 (if (eq (epg-context-protocol context) 'CMS)
1726 epg-gpgsm-program
1727 epg-gpg-program)
1728 nil (list t nil) nil args)
1729 (goto-char (point-min))
1730 (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1731 (setq keys (cons (make-vector 15 nil) keys)
1732 string (match-string 0)
1733 index 0
1734 field 0)
1735 (while (eq index
1736 (string-match "\\([^:]+\\)?:" string index))
1737 (setq index (match-end 0))
1738 (aset (car keys) field (match-string 1 string))
1739 (setq field (1+ field))))
1740 (nreverse keys))))
1741
1742(defun epg--make-sub-key-1 (line)
1743 (epg-make-sub-key
1744 (if (aref line 1)
1745 (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1746 (delq nil
1747 (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
1748 (aref line 11)))
1749 (member (aref line 0) '("sec" "ssb"))
1750 (string-to-number (aref line 3))
1751 (string-to-number (aref line 2))
1752 (aref line 4)
1753 (epg--time-from-seconds (aref line 5))
1754 (if (aref line 6)
1755 (epg--time-from-seconds (aref line 6)))))
1756
1757;;;###autoload
1758(defun epg-list-keys (context &optional name mode)
1759 "Return a list of epg-key objects matched with NAME.
1760If MODE is nil or 'public, only public keyring should be searched.
f1914c40 1761If MODE is t or 'secret, only secret keyring should be searched.
c154c0be
MO
1762Otherwise, only public keyring should be searched and the key
1763signatures should be included.
1764NAME is either a string or a list of strings."
1765 (let ((lines (epg--list-keys-1 context name mode))
1766 keys cert pointer pointer-1 index string)
1767 (while lines
1768 (cond
1769 ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1770 (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1771 keys (cons (epg-make-key
1772 (if (aref (car lines) 8)
1773 (cdr (assq (string-to-char (aref (car lines) 8))
1774 epg-key-validity-alist))))
1775 keys))
1776 (epg-key-set-sub-key-list
1777 (car keys)
1778 (cons (epg--make-sub-key-1 (car lines))
1779 (epg-key-sub-key-list (car keys)))))
1780 ((member (aref (car lines) 0) '("sub" "ssb"))
1781 (epg-key-set-sub-key-list
1782 (car keys)
1783 (cons (epg--make-sub-key-1 (car lines))
1784 (epg-key-sub-key-list (car keys)))))
1785 ((equal (aref (car lines) 0) "uid")
1786 ;; Decode the UID name as a backslash escaped UTF-8 string,
1787 ;; generated by GnuPG/GpgSM.
1788 (setq string (copy-sequence (aref (car lines) 9))
1789 index 0)
1790 (while (string-match "\"" string index)
1791 (setq string (replace-match "\\\"" t t string)
1792 index (1+ (match-end 0))))
1793 (condition-case nil
1794 (setq string (epg--decode-coding-string
1795 (car (read-from-string (concat "\"" string "\"")))
1796 'utf-8))
1797 (error
1798 (setq string (aref (car lines) 9))))
1799 (epg-key-set-user-id-list
1800 (car keys)
1801 (cons (epg-make-user-id
1802 (if (aref (car lines) 1)
1803 (cdr (assq (string-to-char (aref (car lines) 1))
1804 epg-key-validity-alist)))
1805 (if cert
1806 (condition-case nil
1807 (epg-dn-from-string string)
1808 (error string))
1809 string))
1810 (epg-key-user-id-list (car keys)))))
1811 ((equal (aref (car lines) 0) "fpr")
1812 (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
1813 (aref (car lines) 9)))
1814 ((equal (aref (car lines) 0) "sig")
1815 (epg-user-id-set-signature-list
1816 (car (epg-key-user-id-list (car keys)))
1817 (cons
1818 (epg-make-key-signature
1819 (if (aref (car lines) 1)
1820 (cdr (assq (string-to-char (aref (car lines) 1))
1821 epg-key-validity-alist)))
1822 (string-to-number (aref (car lines) 3))
1823 (aref (car lines) 4)
1824 (epg--time-from-seconds (aref (car lines) 5))
1825 (epg--time-from-seconds (aref (car lines) 6))
1826 (aref (car lines) 9)
1827 (string-to-number (aref (car lines) 10) 16)
1828 (eq (aref (aref (car lines) 10) 2) ?x))
1829 (epg-user-id-signature-list
1830 (car (epg-key-user-id-list (car keys))))))))
1831 (setq lines (cdr lines)))
1832 (setq keys (nreverse keys)
1833 pointer keys)
1834 (while pointer
1835 (epg-key-set-sub-key-list
1836 (car pointer)
1837 (nreverse (epg-key-sub-key-list (car pointer))))
1838 (setq pointer-1 (epg-key-set-user-id-list
1839 (car pointer)
1840 (nreverse (epg-key-user-id-list (car pointer)))))
1841 (while pointer-1
1842 (epg-user-id-set-signature-list
1843 (car pointer-1)
1844 (nreverse (epg-user-id-signature-list (car pointer-1))))
1845 (setq pointer-1 (cdr pointer-1)))
1846 (setq pointer (cdr pointer)))
1847 keys))
1848
1849(eval-and-compile
1850 (if (fboundp 'make-temp-file)
1851 (defalias 'epg--make-temp-file 'make-temp-file)
1852 (defvar temporary-file-directory)
1853 ;; stolen from poe.el.
1854 (defun epg--make-temp-file (prefix)
1855 "Create a temporary file.
1856The returned file name (created by appending some random characters at the end
1857of PREFIX, and expanding against `temporary-file-directory' if necessary),
1858is guaranteed to point to a newly created empty file.
1859You can then use `write-region' to write new data into the file."
1860 (let (tempdir tempfile)
1861 (setq prefix (expand-file-name prefix
1862 (if (featurep 'xemacs)
1863 (temp-directory)
1864 temporary-file-directory)))
1865 (unwind-protect
1866 (let (file)
1867 ;; First, create a temporary directory.
1868 (while (condition-case ()
1869 (progn
1870 (setq tempdir (make-temp-name
1871 (concat
1872 (file-name-directory prefix)
1873 "DIR")))
1874 ;; return nil or signal an error.
1875 (make-directory tempdir))
1876 ;; let's try again.
1877 (file-already-exists t)))
1878 (set-file-modes tempdir 448)
1879 ;; Second, create a temporary file in the tempdir.
1880 ;; There *is* a race condition between `make-temp-name'
1881 ;; and `write-region', but we don't care it since we are
1882 ;; in a private directory now.
1883 (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1884 (write-region "" nil tempfile nil 'silent)
1885 (set-file-modes tempfile 384)
1886 ;; Finally, make a hard-link from the tempfile.
1887 (while (condition-case ()
1888 (progn
1889 (setq file (make-temp-name prefix))
1890 ;; return nil or signal an error.
1891 (add-name-to-file tempfile file))
1892 ;; let's try again.
1893 (file-already-exists t)))
1894 file)
1895 ;; Cleanup the tempfile.
1896 (and tempfile
1897 (file-exists-p tempfile)
1898 (delete-file tempfile))
1899 ;; Cleanup the tempdir.
1900 (and tempdir
1901 (file-directory-p tempdir)
1902 (delete-directory tempdir)))))))
1903
1904(defun epg--args-from-sig-notations (notations)
1905 (apply #'nconc
1906 (mapcar
1907 (lambda (notation)
1908 (if (and (epg-sig-notation-name notation)
1909 (not (epg-sig-notation-human-readable notation)))
1910 (error "Unreadable"))
1911 (if (epg-sig-notation-name notation)
1912 (list "--sig-notation"
1913 (if (epg-sig-notation-critical notation)
1914 (concat "!" (epg-sig-notation-name notation)
1915 "=" (epg-sig-notation-value notation))
1916 (concat (epg-sig-notation-name notation)
1917 "=" (epg-sig-notation-value notation))))
1918 (list "--sig-policy-url"
1919 (if (epg-sig-notation-critical notation)
1920 (concat "!" (epg-sig-notation-value notation))
1921 (epg-sig-notation-value notation)))))
1922 notations)))
1923
1924;;;###autoload
1925(defun epg-cancel (context)
1926 (if (buffer-live-p (process-buffer (epg-context-process context)))
1927 (save-excursion
1928 (set-buffer (process-buffer (epg-context-process context)))
1929 (epg-context-set-result-for
1930 epg-context 'error
1931 (cons '(quit)
1932 (epg-context-result-for epg-context 'error)))))
1933 (if (eq (process-status (epg-context-process context)) 'run)
1934 (delete-process (epg-context-process context))))
1935
1936;;;###autoload
1937(defun epg-start-decrypt (context cipher)
1938 "Initiate a decrypt operation on CIPHER.
1939CIPHER must be a file data object.
1940
1941If you use this function, you will need to wait for the completion of
1942`epg-gpg-program' by using `epg-wait-for-completion' and call
1943`epg-reset' to clear a temporaly output file.
1944If you are unsure, use synchronous version of this function
1945`epg-decrypt-file' or `epg-decrypt-string' instead."
1946 (unless (epg-data-file cipher)
1947 (error "Not a file"))
1948 (epg-context-set-operation context 'decrypt)
1949 (epg-context-set-result context nil)
1950 (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
1951 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1952 (unless (eq (epg-context-protocol context) 'CMS)
1953 (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1954
1955(defun epg--check-error-for-decrypt (context)
1956 (if (epg-context-result-for context 'decryption-failed)
1957 (signal 'epg-error (list "Decryption failed")))
1958 (if (epg-context-result-for context 'no-secret-key)
1959 (signal 'epg-error
1960 (list "No secret key"
1961 (epg-context-result-for context 'no-secret-key))))
1962 (unless (epg-context-result-for context 'decryption-okay)
1963 (let* ((error (epg-context-result-for context 'error)))
1964 (if (assq 'no-data error)
1965 (signal 'epg-error (list "No data")))
1966 (signal 'epg-error (list "Can't decrypt" error)))))
1967
1968;;;###autoload
1969(defun epg-decrypt-file (context cipher plain)
1970 "Decrypt a file CIPHER and store the result to a file PLAIN.
1971If PLAIN is nil, it returns the result as a string."
1972 (unwind-protect
1973 (progn
1974 (if plain
1975 (epg-context-set-output-file context plain)
1976 (epg-context-set-output-file context
1977 (epg--make-temp-file "epg-output")))
1978 (epg-start-decrypt context (epg-make-data-from-file cipher))
1979 (epg-wait-for-completion context)
1980 (epg--check-error-for-decrypt context)
1981 (unless plain
1982 (epg-read-output context)))
1983 (unless plain
1984 (epg-delete-output-file context))
1985 (epg-reset context)))
1986
1987;;;###autoload
1988(defun epg-decrypt-string (context cipher)
1989 "Decrypt a string CIPHER and return the plain text."
1990 (let ((input-file (epg--make-temp-file "epg-input"))
1991 (coding-system-for-write 'binary))
1992 (unwind-protect
1993 (progn
1994 (write-region cipher nil input-file nil 'quiet)
1995 (epg-context-set-output-file context
1996 (epg--make-temp-file "epg-output"))
1997 (epg-start-decrypt context (epg-make-data-from-file input-file))
1998 (epg-wait-for-completion context)
1999 (epg--check-error-for-decrypt context)
2000 (epg-read-output context))
2001 (epg-delete-output-file context)
2002 (if (file-exists-p input-file)
2003 (delete-file input-file))
2004 (epg-reset context))))
2005
2006;;;###autoload
2007(defun epg-start-verify (context signature &optional signed-text)
2008 "Initiate a verify operation on SIGNATURE.
2009SIGNATURE and SIGNED-TEXT are a data object if they are specified.
2010
2011For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
2012For a normal or a cleartext signature, SIGNED-TEXT should be nil.
2013
2014If you use this function, you will need to wait for the completion of
2015`epg-gpg-program' by using `epg-wait-for-completion' and call
2016`epg-reset' to clear a temporaly output file.
2017If you are unsure, use synchronous version of this function
2018`epg-verify-file' or `epg-verify-string' instead."
2019 (epg-context-set-operation context 'verify)
2020 (epg-context-set-result context nil)
2021 (if signed-text
2022 ;; Detached signature.
2023 (if (epg-data-file signed-text)
2024 (epg--start context (list "--verify" "--" (epg-data-file signature)
2025 (epg-data-file signed-text)))
2026 (epg--start context (list "--verify" "--" (epg-data-file signature)
2027 "-"))
2028 (if (eq (process-status (epg-context-process context)) 'run)
2029 (process-send-string (epg-context-process context)
2030 (epg-data-string signed-text)))
2031 (if (eq (process-status (epg-context-process context)) 'run)
2032 (process-send-eof (epg-context-process context))))
2033 ;; Normal (or cleartext) signature.
2034 (if (epg-data-file signature)
761cd524
DU
2035 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
2036 (list "--verify" "--" (epg-data-file signature))
2037 (list "--" (epg-data-file signature))))
2038 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
2039 '("--verify" "-")
2040 '("-")))
c154c0be
MO
2041 (if (eq (process-status (epg-context-process context)) 'run)
2042 (process-send-string (epg-context-process context)
2043 (epg-data-string signature)))
2044 (if (eq (process-status (epg-context-process context)) 'run)
2045 (process-send-eof (epg-context-process context))))))
2046
2047;;;###autoload
2048(defun epg-verify-file (context signature &optional signed-text plain)
2049 "Verify a file SIGNATURE.
2050SIGNED-TEXT and PLAIN are also a file if they are specified.
2051
2052For a detached signature, both SIGNATURE and SIGNED-TEXT should be
2053string. For a normal or a cleartext signature, SIGNED-TEXT should be
2054nil. In the latter case, if PLAIN is specified, the plaintext is
2055stored into the file after successful verification."
2056 (unwind-protect
2057 (progn
2058 (if plain
2059 (epg-context-set-output-file context plain)
2060 (epg-context-set-output-file context
2061 (epg--make-temp-file "epg-output")))
2062 (if signed-text
2063 (epg-start-verify context
2064 (epg-make-data-from-file signature)
2065 (epg-make-data-from-file signed-text))
2066 (epg-start-verify context
2067 (epg-make-data-from-file signature)))
2068 (epg-wait-for-completion context)
2069 (unless plain
2070 (epg-read-output context)))
2071 (unless plain
2072 (epg-delete-output-file context))
2073 (epg-reset context)))
2074
2075;;;###autoload
2076(defun epg-verify-string (context signature &optional signed-text)
2077 "Verify a string SIGNATURE.
2078SIGNED-TEXT is a string if it is specified.
2079
2080For a detached signature, both SIGNATURE and SIGNED-TEXT should be
2081string. For a normal or a cleartext signature, SIGNED-TEXT should be
2082nil. In the latter case, this function returns the plaintext after
2083successful verification."
2084 (let ((coding-system-for-write 'binary)
2085 input-file)
2086 (unwind-protect
2087 (progn
2088 (epg-context-set-output-file context
2089 (epg--make-temp-file "epg-output"))
2090 (if signed-text
2091 (progn
2092 (setq input-file (epg--make-temp-file "epg-signature"))
2093 (write-region signature nil input-file nil 'quiet)
2094 (epg-start-verify context
2095 (epg-make-data-from-file input-file)
2096 (epg-make-data-from-string signed-text)))
2097 (epg-start-verify context (epg-make-data-from-string signature)))
2098 (epg-wait-for-completion context)
2099 (epg-read-output context))
2100 (epg-delete-output-file context)
2101 (if (and input-file
2102 (file-exists-p input-file))
2103 (delete-file input-file))
2104 (epg-reset context))))
2105
2106;;;###autoload
2107(defun epg-start-sign (context plain &optional mode)
2108 "Initiate a sign operation on PLAIN.
2109PLAIN is a data object.
2110
2111If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2112If it is nil or 'normal, it makes a normal signature.
2113Otherwise, it makes a cleartext signature.
2114
2115If you use this function, you will need to wait for the completion of
2116`epg-gpg-program' by using `epg-wait-for-completion' and call
2117`epg-reset' to clear a temporaly output file.
2118If you are unsure, use synchronous version of this function
2119`epg-sign-file' or `epg-sign-string' instead."
2120 (epg-context-set-operation context 'sign)
2121 (epg-context-set-result context nil)
2122 (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
2123 (epg-context-set-armor context nil)
2124 (epg-context-set-textmode context nil))
2125 (epg--start context
2126 (append (list (if (memq mode '(t detached))
2127 "--detach-sign"
2128 (if (memq mode '(nil normal))
2129 "--sign"
2130 "--clearsign")))
2131 (apply #'nconc
2132 (mapcar
2133 (lambda (signer)
2134 (list "-u"
2135 (epg-sub-key-id
2136 (car (epg-key-sub-key-list signer)))))
2137 (epg-context-signers context)))
2138 (epg--args-from-sig-notations
2139 (epg-context-sig-notations context))
2140 (if (epg-data-file plain)
2141 (list "--" (epg-data-file plain)))))
2142 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2143 (unless (eq (epg-context-protocol context) 'CMS)
2144 (epg-wait-for-status context '("BEGIN_SIGNING")))
2145 (when (epg-data-string plain)
2146 (if (eq (process-status (epg-context-process context)) 'run)
2147 (process-send-string (epg-context-process context)
2148 (epg-data-string plain)))
2149 (if (eq (process-status (epg-context-process context)) 'run)
2150 (process-send-eof (epg-context-process context)))))
2151
2152;;;###autoload
2153(defun epg-sign-file (context plain signature &optional mode)
2154 "Sign a file PLAIN and store the result to a file SIGNATURE.
2155If SIGNATURE is nil, it returns the result as a string.
2156If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2157If it is nil or 'normal, it makes a normal signature.
2158Otherwise, it makes a cleartext signature."
2159 (unwind-protect
2160 (progn
2161 (if signature
2162 (epg-context-set-output-file context signature)
2163 (epg-context-set-output-file context
2164 (epg--make-temp-file "epg-output")))
2165 (epg-start-sign context (epg-make-data-from-file plain) mode)
2166 (epg-wait-for-completion context)
2167 (unless (epg-context-result-for context 'sign)
2168 (if (epg-context-result-for context 'error)
2169 (error "Sign failed: %S"
2170 (epg-context-result-for context 'error))
2171 (error "Sign failed")))
2172 (unless signature
2173 (epg-read-output context)))
2174 (unless signature
2175 (epg-delete-output-file context))
2176 (epg-reset context)))
2177
2178;;;###autoload
2179(defun epg-sign-string (context plain &optional mode)
2180 "Sign a string PLAIN and return the output as string.
2181If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2182If it is nil or 'normal, it makes a normal signature.
2183Otherwise, it makes a cleartext signature."
2184 (let ((input-file
2185 (unless (or (eq (epg-context-protocol context) 'CMS)
2186 (condition-case nil
2187 (progn
2188 (epg-check-configuration (epg-configuration))
2189 t)
2190 (error)))
2191 (epg--make-temp-file "epg-input")))
2192 (coding-system-for-write 'binary))
2193 (unwind-protect
2194 (progn
2195 (epg-context-set-output-file context
2196 (epg--make-temp-file "epg-output"))
2197 (if input-file
2198 (write-region plain nil input-file nil 'quiet))
2199 (epg-start-sign context
2200 (if input-file
2201 (epg-make-data-from-file input-file)
2202 (epg-make-data-from-string plain))
2203 mode)
2204 (epg-wait-for-completion context)
2205 (unless (epg-context-result-for context 'sign)
2206 (if (epg-context-result-for context 'error)
2207 (error "Sign failed: %S"
2208 (epg-context-result-for context 'error))
2209 (error "Sign failed")))
2210 (epg-read-output context))
2211 (epg-delete-output-file context)
2212 (if input-file
2213 (delete-file input-file))
2214 (epg-reset context))))
2215
2216;;;###autoload
2217(defun epg-start-encrypt (context plain recipients
2218 &optional sign always-trust)
2219 "Initiate an encrypt operation on PLAIN.
2220PLAIN is a data object.
2221If RECIPIENTS is nil, it performs symmetric encryption.
2222
2223If you use this function, you will need to wait for the completion of
2224`epg-gpg-program' by using `epg-wait-for-completion' and call
2225`epg-reset' to clear a temporaly output file.
2226If you are unsure, use synchronous version of this function
2227`epg-encrypt-file' or `epg-encrypt-string' instead."
2228 (epg-context-set-operation context 'encrypt)
2229 (epg-context-set-result context nil)
2230 (epg--start context
2231 (append (if always-trust '("--always-trust"))
2232 (if recipients '("--encrypt") '("--symmetric"))
2233 (if sign '("--sign"))
2234 (if sign
2235 (apply #'nconc
2236 (mapcar
2237 (lambda (signer)
2238 (list "-u"
2239 (epg-sub-key-id
2240 (car (epg-key-sub-key-list
2241 signer)))))
2242 (epg-context-signers context))))
2243 (if sign
2244 (epg--args-from-sig-notations
2245 (epg-context-sig-notations context)))
2246 (apply #'nconc
2247 (mapcar
2248 (lambda (recipient)
2249 (list "-r"
2250 (epg-sub-key-id
2251 (car (epg-key-sub-key-list recipient)))))
2252 recipients))
2253 (if (epg-data-file plain)
2254 (list "--" (epg-data-file plain)))))
2255 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2256 (unless (eq (epg-context-protocol context) 'CMS)
2257 (if sign
2258 (epg-wait-for-status context '("BEGIN_SIGNING"))
2259 (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
2260 (when (epg-data-string plain)
2261 (if (eq (process-status (epg-context-process context)) 'run)
2262 (process-send-string (epg-context-process context)
2263 (epg-data-string plain)))
2264 (if (eq (process-status (epg-context-process context)) 'run)
2265 (process-send-eof (epg-context-process context)))))
2266
2267;;;###autoload
2268(defun epg-encrypt-file (context plain recipients
2269 cipher &optional sign always-trust)
2270 "Encrypt a file PLAIN and store the result to a file CIPHER.
2271If CIPHER is nil, it returns the result as a string.
2272If RECIPIENTS is nil, it performs symmetric encryption."
2273 (unwind-protect
2274 (progn
2275 (if cipher
2276 (epg-context-set-output-file context cipher)
2277 (epg-context-set-output-file context
2278 (epg--make-temp-file "epg-output")))
2279 (epg-start-encrypt context (epg-make-data-from-file plain)
2280 recipients sign always-trust)
2281 (epg-wait-for-completion context)
2282 (if (and sign
2283 (not (epg-context-result-for context 'sign)))
2284 (if (epg-context-result-for context 'error)
2285 (error "Sign failed: %S"
2286 (epg-context-result-for context 'error))
2287 (error "Sign failed")))
2288 (if (epg-context-result-for context 'error)
2289 (error "Encrypt failed: %S"
2290 (epg-context-result-for context 'error)))
2291 (unless cipher
2292 (epg-read-output context)))
2293 (unless cipher
2294 (epg-delete-output-file context))
2295 (epg-reset context)))
2296
2297;;;###autoload
2298(defun epg-encrypt-string (context plain recipients
2299 &optional sign always-trust)
2300 "Encrypt a string PLAIN.
2301If RECIPIENTS is nil, it performs symmetric encryption."
2302 (let ((input-file
2303 (unless (or (not sign)
2304 (eq (epg-context-protocol context) 'CMS)
2305 (condition-case nil
2306 (progn
2307 (epg-check-configuration (epg-configuration))
2308 t)
2309 (error)))
2310 (epg--make-temp-file "epg-input")))
2311 (coding-system-for-write 'binary))
2312 (unwind-protect
2313 (progn
2314 (epg-context-set-output-file context
2315 (epg--make-temp-file "epg-output"))
2316 (if input-file
2317 (write-region plain nil input-file nil 'quiet))
2318 (epg-start-encrypt context
2319 (if input-file
2320 (epg-make-data-from-file input-file)
2321 (epg-make-data-from-string plain))
2322 recipients sign always-trust)
2323 (epg-wait-for-completion context)
2324 (if (and sign
2325 (not (epg-context-result-for context 'sign)))
2326 (if (epg-context-result-for context 'error)
2327 (error "Sign failed: %S"
2328 (epg-context-result-for context 'error))
2329 (error "Sign failed")))
2330 (if (epg-context-result-for context 'error)
2331 (error "Encrypt failed: %S"
2332 (epg-context-result-for context 'error)))
2333 (epg-read-output context))
2334 (epg-delete-output-file context)
2335 (if input-file
2336 (delete-file input-file))
2337 (epg-reset context))))
2338
2339;;;###autoload
2340(defun epg-start-export-keys (context keys)
2341 "Initiate an export keys operation.
2342
2343If you use this function, you will need to wait for the completion of
2344`epg-gpg-program' by using `epg-wait-for-completion' and call
2345`epg-reset' to clear a temporaly output file.
2346If you are unsure, use synchronous version of this function
2347`epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
2348 (epg-context-set-operation context 'export-keys)
2349 (epg-context-set-result context nil)
2350 (epg--start context (cons "--export"
2351 (mapcar
2352 (lambda (key)
2353 (epg-sub-key-id
2354 (car (epg-key-sub-key-list key))))
2355 keys))))
2356
2357;;;###autoload
2358(defun epg-export-keys-to-file (context keys file)
2359 "Extract public KEYS."
2360 (unwind-protect
2361 (progn
2362 (if file
2363 (epg-context-set-output-file context file)
2364 (epg-context-set-output-file context
2365 (epg--make-temp-file "epg-output")))
2366 (epg-start-export-keys context keys)
2367 (epg-wait-for-completion context)
2368 (if (epg-context-result-for context 'error)
2369 (error "Export keys failed: %S"
2370 (epg-context-result-for context 'error)))
2371 (unless file
2372 (epg-read-output context)))
2373 (unless file
2374 (epg-delete-output-file context))
2375 (epg-reset context)))
2376
2377;;;###autoload
2378(defun epg-export-keys-to-string (context keys)
2379 "Extract public KEYS and return them as a string."
2380 (epg-export-keys-to-file context keys nil))
2381
2382;;;###autoload
2383(defun epg-start-import-keys (context keys)
2384 "Initiate an import keys operation.
2385KEYS is a data object.
2386
2387If you use this function, you will need to wait for the completion of
2388`epg-gpg-program' by using `epg-wait-for-completion' and call
2389`epg-reset' to clear a temporaly output file.
2390If you are unsure, use synchronous version of this function
2391`epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
2392 (epg-context-set-operation context 'import-keys)
2393 (epg-context-set-result context nil)
2394 (epg--start context (if (epg-data-file keys)
2395 (list "--import" "--" (epg-data-file keys))
2396 (list "--import")))
2397 (when (epg-data-string keys)
2398 (if (eq (process-status (epg-context-process context)) 'run)
2399 (process-send-string (epg-context-process context)
2400 (epg-data-string keys)))
2401 (if (eq (process-status (epg-context-process context)) 'run)
2402 (process-send-eof (epg-context-process context)))))
2403
2404(defun epg--import-keys-1 (context keys)
2405 (unwind-protect
2406 (progn
2407 (epg-start-import-keys context keys)
2408 (epg-wait-for-completion context)
2409 (if (epg-context-result-for context 'error)
2410 (error "Import keys failed: %S"
2411 (epg-context-result-for context 'error))))
2412 (epg-reset context)))
2413
2414;;;###autoload
2415(defun epg-import-keys-from-file (context keys)
2416 "Add keys from a file KEYS."
2417 (epg--import-keys-1 context (epg-make-data-from-file keys)))
2418
2419;;;###autoload
2420(defun epg-import-keys-from-string (context keys)
2421 "Add keys from a string KEYS."
2422 (epg--import-keys-1 context (epg-make-data-from-string keys)))
2423
2424;;;###autoload
2425(defun epg-start-receive-keys (context key-id-list)
2426 "Initiate a receive key operation.
2427KEY-ID-LIST is a list of key IDs.
2428
2429If you use this function, you will need to wait for the completion of
2430`epg-gpg-program' by using `epg-wait-for-completion' and call
2431`epg-reset' to clear a temporaly output file.
2432If you are unsure, use synchronous version of this function
2c6c404a 2433`epg-receive-keys' instead."
c154c0be
MO
2434 (epg-context-set-operation context 'receive-keys)
2435 (epg-context-set-result context nil)
2436 (epg--start context (cons "--recv-keys" key-id-list)))
2437
2438;;;###autoload
2439(defun epg-receive-keys (context keys)
2440 "Add keys from server.
2441KEYS is a list of key IDs"
2442 (unwind-protect
2443 (progn
2444 (epg-start-receive-keys context keys)
2445 (epg-wait-for-completion context)
2446 (if (epg-context-result-for context 'error)
2447 (error "Receive keys failed: %S"
2448 (epg-context-result-for context 'error))))
2449 (epg-reset context)))
2450
2451;;;###autoload
2452(defalias 'epg-import-keys-from-server 'epg-receive-keys)
2453
2454;;;###autoload
2455(defun epg-start-delete-keys (context keys &optional allow-secret)
05234615 2456 "Initiate a delete keys operation.
c154c0be
MO
2457
2458If you use this function, you will need to wait for the completion of
2459`epg-gpg-program' by using `epg-wait-for-completion' and call
2460`epg-reset' to clear a temporaly output file.
2461If you are unsure, use synchronous version of this function
2462`epg-delete-keys' instead."
2463 (epg-context-set-operation context 'delete-keys)
2464 (epg-context-set-result context nil)
2465 (epg--start context (cons (if allow-secret
2466 "--delete-secret-key"
2467 "--delete-key")
2468 (mapcar
2469 (lambda (key)
2470 (epg-sub-key-id
2471 (car (epg-key-sub-key-list key))))
2472 keys))))
2473
2474;;;###autoload
2475(defun epg-delete-keys (context keys &optional allow-secret)
2476 "Delete KEYS from the key ring."
2477 (unwind-protect
2478 (progn
2479 (epg-start-delete-keys context keys allow-secret)
2480 (epg-wait-for-completion context)
2481 (let ((entry (assq 'delete-problem
2482 (epg-context-result-for context 'error))))
2483 (if entry
2484 (if (setq entry (assq (cdr entry)
2485 epg-delete-problem-reason-alist))
2486 (error "Delete keys failed: %s" (cdr entry))
2487 (error "Delete keys failed")))))
2488 (epg-reset context)))
2489
2490;;;###autoload
2491(defun epg-start-sign-keys (context keys &optional local)
2492 "Initiate a sign keys operation.
2493
2494If you use this function, you will need to wait for the completion of
2495`epg-gpg-program' by using `epg-wait-for-completion' and call
2496`epg-reset' to clear a temporaly output file.
2497If you are unsure, use synchronous version of this function
2498`epg-sign-keys' instead."
2499 (epg-context-set-operation context 'sign-keys)
2500 (epg-context-set-result context nil)
2501 (epg--start context (cons (if local
2502 "--lsign-key"
2503 "--sign-key")
2504 (mapcar
2505 (lambda (key)
2506 (epg-sub-key-id
2507 (car (epg-key-sub-key-list key))))
2508 keys))))
5443c9b7 2509(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
c154c0be
MO
2510
2511;;;###autoload
2512(defun epg-sign-keys (context keys &optional local)
2513 "Sign KEYS from the key ring."
2514 (unwind-protect
2515 (progn
2516 (epg-start-sign-keys context keys local)
2517 (epg-wait-for-completion context)
2518 (if (epg-context-result-for context 'error)
2519 (error "Sign keys failed: %S"
2520 (epg-context-result-for context 'error))))
2521 (epg-reset context)))
5443c9b7 2522(make-obsolete 'epg-sign-keys "do not use." "23.1")
c154c0be
MO
2523
2524;;;###autoload
2525(defun epg-start-generate-key (context parameters)
2526 "Initiate a key generation.
2527PARAMETERS specifies parameters for the key.
2528
2529If you use this function, you will need to wait for the completion of
2530`epg-gpg-program' by using `epg-wait-for-completion' and call
2531`epg-reset' to clear a temporaly output file.
2532If you are unsure, use synchronous version of this function
2533`epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2534 (epg-context-set-operation context 'generate-key)
2535 (epg-context-set-result context nil)
2536 (if (epg-data-file parameters)
2537 (epg--start context (list "--batch" "--genkey" "--"
2538 (epg-data-file parameters)))
2539 (epg--start context '("--batch" "--genkey"))
2540 (if (eq (process-status (epg-context-process context)) 'run)
2541 (process-send-string (epg-context-process context)
2542 (epg-data-string parameters)))
2543 (if (eq (process-status (epg-context-process context)) 'run)
2544 (process-send-eof (epg-context-process context)))))
2545
2546;;;###autoload
2547(defun epg-generate-key-from-file (context parameters)
2548 "Generate a new key pair.
2549PARAMETERS is a file which tells how to create the key."
2550 (unwind-protect
2551 (progn
2552 (epg-start-generate-key context (epg-make-data-from-file parameters))
2553 (epg-wait-for-completion context)
2554 (if (epg-context-result-for context 'error)
2555 (error "Generate key failed: %S"
2556 (epg-context-result-for context 'error))))
2557 (epg-reset context)))
2558
2559;;;###autoload
2560(defun epg-generate-key-from-string (context parameters)
2561 "Generate a new key pair.
2562PARAMETERS is a string which tells how to create the key."
2563 (unwind-protect
2564 (progn
2565 (epg-start-generate-key context (epg-make-data-from-string parameters))
2566 (epg-wait-for-completion context)
2567 (if (epg-context-result-for context 'error)
2568 (error "Generate key failed: %S"
2569 (epg-context-result-for context 'error))))
2570 (epg-reset context)))
2571
2572(defun epg--decode-percent-escape (string)
2573 (let ((index 0))
2574 (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2575 string index)
2576 (if (match-beginning 2)
2577 (setq string (replace-match "%" t t string)
2578 index (1- (match-end 0)))
2579 (setq string (replace-match
2580 (string (string-to-number (match-string 3 string) 16))
2581 t t string)
2582 index (- (match-end 0) 2))))
2583 string))
2584
2585(defun epg--decode-hexstring (string)
2586 (let ((index 0))
2587 (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2588 (setq string (replace-match (string (string-to-number
2589 (match-string 0 string) 16))
2590 t t string)
2591 index (1- (match-end 0))))
2592 string))
2593
2594(defun epg--decode-quotedstring (string)
2595 (let ((index 0))
2596 (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2597\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2598 string index)
2599 (if (match-beginning 2)
2600 (setq string (replace-match "\\2" t nil string)
2601 index (1- (match-end 0)))
2602 (if (match-beginning 3)
2603 (setq string (replace-match (string (string-to-number
2604 (match-string 0 string) 16))
2605 t t string)
2606 index (- (match-end 0) 2)))))
2607 string))
2608
2609(defun epg-dn-from-string (string)
2610 "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2611The return value is an alist mapping from types to values."
2612 (let ((index 0)
2613 (length (length string))
2614 alist type value group)
2615 (while (< index length)
2616 (if (eq index (string-match "[ \t\n\r]*" string index))
2617 (setq index (match-end 0)))
2618 (if (eq index (string-match
2619 "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
2620 string index))
2621 (setq type (match-string 1 string)
2622 index (match-end 0))
2623 (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2624 string index))
2625 (setq type (match-string 1 string)
2626 index (match-end 0))))
2627 (unless type
2628 (error "Invalid type"))
2629 (if (eq index (string-match
2630 "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2631 string index))
2632 (setq index (match-end 0)
2633 value (epg--decode-quotedstring (match-string 0 string)))
2634 (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2635 (setq index (match-end 0)
2636 value (epg--decode-hexstring (match-string 1 string)))
2637 (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2638 string index))
2639 (setq index (match-end 0)
2640 value (epg--decode-quotedstring
2641 (match-string 0 string))))))
2642 (if group
2643 (if (stringp (car (car alist)))
2644 (setcar alist (list (cons type value) (car alist)))
2645 (setcar alist (cons (cons type value) (car alist))))
2646 (if (consp (car (car alist)))
2647 (setcar alist (nreverse (car alist))))
2648 (setq alist (cons (cons type value) alist)
2649 type nil
2650 value nil))
2651 (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2652 (setq index (match-end 0)
2653 group (eq (aref string (match-beginning 1)) ?+))))
2654 (nreverse alist)))
2655
2656(defun epg-decode-dn (alist)
2657 "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2658Type names are resolved using `epg-dn-type-alist'."
2659 (mapconcat
2660 (lambda (rdn)
2661 (if (stringp (car rdn))
2662 (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2663 (if entry
2664 (format "%s=%s" (cdr entry) (cdr rdn))
2665 (format "%s=%s" (car rdn) (cdr rdn))))
2666 (concat "(" (epg-decode-dn rdn) ")")))
2667 alist
2668 ", "))
2669
2670(provide 'epg)
2671
37b77401 2672;; arch-tag: de8f0acc-1bcf-4c14-a09e-bfffe1b579b7
c154c0be 2673;;; epg.el ends here