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