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