* epg.el (epg--start): Don't specify --enable-progress-filter for
[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 (and (not (eq (epg-context-protocol context) 'CMS))
1049                                 (epg-context-progress-callback context))
1050                            '("--enable-progress-filter"))
1051                        (if epg-gpg-home-directory
1052                            (list "--homedir" epg-gpg-home-directory))
1053                        (unless (eq (epg-context-protocol context) 'CMS)
1054                          '("--command-fd" "0"))
1055                        (if (epg-context-armor context) '("--armor"))
1056                        (if (epg-context-textmode context) '("--textmode"))
1057                        (if (epg-context-output-file context)
1058                            (list "--output" (epg-context-output-file context)))
1059                        args))
1060          (coding-system-for-write 'binary)
1061          process-connection-type
1062          (orig-mode (default-file-modes))
1063          (buffer (generate-new-buffer " *epg*"))
1064          process)
1065     (if epg-debug
1066         (save-excursion
1067           (unless epg-debug-buffer
1068             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1069           (set-buffer epg-debug-buffer)
1070           (goto-char (point-max))
1071           (insert (format "%s %s\n"
1072                           (if (eq (epg-context-protocol context) 'CMS)
1073                               epg-gpgsm-program
1074                            epg-gpg-program)
1075                           (mapconcat #'identity args " ")))))
1076     (with-current-buffer buffer
1077       (make-local-variable 'epg-read-point)
1078       (setq epg-read-point (point-min))
1079       (make-local-variable 'epg-process-filter-running)
1080       (setq epg-process-filter-running nil)
1081       (make-local-variable 'epg-pending-status-list)
1082       (setq epg-pending-status-list nil)
1083       (make-local-variable 'epg-key-id)
1084       (setq epg-key-id nil)
1085       (make-local-variable 'epg-context)
1086       (setq epg-context context))
1087     (unwind-protect
1088         (progn
1089           (set-default-file-modes 448)
1090           (setq process
1091                 (apply #'start-process "epg" buffer
1092                        (if (eq (epg-context-protocol context) 'CMS)
1093                            epg-gpgsm-program
1094                          epg-gpg-program)
1095                        args)))
1096       (set-default-file-modes orig-mode))
1097     (set-process-filter process #'epg--process-filter)
1098     (epg-context-set-process context process)))
1099
1100 (defun epg--process-filter (process input)
1101   (if epg-debug
1102       (save-excursion
1103         (unless epg-debug-buffer
1104           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1105         (set-buffer epg-debug-buffer)
1106         (goto-char (point-max))
1107         (insert input)))
1108   (if (buffer-live-p (process-buffer process))
1109       (save-excursion
1110         (set-buffer (process-buffer process))
1111         (goto-char (point-max))
1112         (insert input)
1113         (unless epg-process-filter-running
1114           (unwind-protect
1115               (progn
1116                 (setq epg-process-filter-running t)
1117                 (goto-char epg-read-point)
1118                 (beginning-of-line)
1119                 (while (looking-at ".*\n") ;the input line finished
1120                   (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
1121                       (let* ((status (match-string 1))
1122                              (string (match-string 2))
1123                              (symbol (intern-soft (concat "epg--status-"
1124                                                           status))))
1125                         (if (member status epg-pending-status-list)
1126                             (setq epg-pending-status-list nil))
1127                         (if (and symbol
1128                                  (fboundp symbol))
1129                             (funcall symbol epg-context string))))
1130                   (forward-line)
1131                   (setq epg-read-point (point))))
1132             (setq epg-process-filter-running nil))))))
1133
1134 (defun epg-read-output (context)
1135   "Read the output file CONTEXT and return the content as a string."
1136   (with-temp-buffer
1137     (if (fboundp 'set-buffer-multibyte)
1138         (set-buffer-multibyte nil))
1139     (if (file-exists-p (epg-context-output-file context))
1140         (let ((coding-system-for-read 'binary))
1141           (insert-file-contents (epg-context-output-file context))
1142           (buffer-string)))))
1143
1144 (defun epg-wait-for-status (context status-list)
1145   "Wait until one of elements in STATUS-LIST arrives."
1146   (with-current-buffer (process-buffer (epg-context-process context))
1147     (setq epg-pending-status-list status-list)
1148     (while (and (eq (process-status (epg-context-process context)) 'run)
1149                 epg-pending-status-list)
1150       (accept-process-output (epg-context-process context) 1))))
1151
1152 (defun epg-wait-for-completion (context)
1153   "Wait until the `epg-gpg-program' process completes."
1154   (while (eq (process-status (epg-context-process context)) 'run)
1155     (accept-process-output (epg-context-process context) 1)))
1156
1157 (defun epg-reset (context)
1158   "Reset the CONTEXT."
1159   (if (and (epg-context-process context)
1160            (buffer-live-p (process-buffer (epg-context-process context))))
1161       (kill-buffer (process-buffer (epg-context-process context))))
1162   (epg-context-set-process context nil))
1163
1164 (defun epg-delete-output-file (context)
1165   "Delete the output file of CONTEXT."
1166   (if (and (epg-context-output-file context)
1167            (file-exists-p (epg-context-output-file context)))
1168       (delete-file (epg-context-output-file context))))
1169
1170 (defun epg--status-USERID_HINT (context string)
1171   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1172       (let* ((key-id (match-string 1 string))
1173              (user-id (match-string 2 string))
1174              (entry (assoc key-id epg-user-id-alist)))
1175         (if entry
1176             (setcdr entry user-id)
1177           (setq epg-user-id-alist (cons (cons key-id user-id)
1178                                         epg-user-id-alist))))))
1179
1180 (defun epg--status-NEED_PASSPHRASE (context string)
1181   (if (string-match "\\`\\([^ ]+\\)" string)
1182       (setq epg-key-id (match-string 1 string))))
1183
1184 (defun epg--status-NEED_PASSPHRASE_SYM (context string)
1185   (setq epg-key-id 'SYM))
1186
1187 (defun epg--status-NEED_PASSPHRASE_PIN (context string)
1188   (setq epg-key-id 'PIN))
1189
1190 (defun epg--status-GET_HIDDEN (context string)
1191   (when (and epg-key-id
1192              (string-match "\\`passphrase\\." string))
1193     (unless (epg-context-passphrase-callback context)
1194       (error "passphrase-callback not set"))
1195     (let (inhibit-quit
1196           passphrase
1197           passphrase-with-new-line
1198           encoded-passphrase-with-new-line)
1199       (unwind-protect
1200           (condition-case nil
1201               (progn
1202                 (setq passphrase
1203                       (funcall
1204                        (if (consp (epg-context-passphrase-callback context))
1205                            (car (epg-context-passphrase-callback context))
1206                          (epg-context-passphrase-callback context))
1207                        context
1208                        epg-key-id
1209                        (if (consp (epg-context-passphrase-callback context))
1210                            (cdr (epg-context-passphrase-callback context)))))
1211                 (when passphrase
1212                   (setq passphrase-with-new-line (concat passphrase "\n"))
1213                   (epg--clear-string passphrase)
1214                   (setq passphrase nil)
1215                   (if epg-passphrase-coding-system
1216                       (progn
1217                         (setq encoded-passphrase-with-new-line
1218                               (encode-coding-string
1219                                passphrase-with-new-line
1220                                epg-passphrase-coding-system))
1221                         (epg--clear-string passphrase-with-new-line)
1222                         (setq passphrase-with-new-line nil))
1223                     (setq encoded-passphrase-with-new-line
1224                           passphrase-with-new-line
1225                           passphrase-with-new-line nil))
1226                   (process-send-string (epg-context-process context)
1227                                        encoded-passphrase-with-new-line)))
1228             (quit
1229              (epg-context-set-result-for
1230               context 'error
1231               (cons '(quit)
1232                     (epg-context-result-for context 'error)))
1233              (delete-process (epg-context-process context))))
1234         (if passphrase
1235             (epg--clear-string passphrase))
1236         (if passphrase-with-new-line
1237             (epg--clear-string passphrase-with-new-line))
1238         (if encoded-passphrase-with-new-line
1239             (epg--clear-string encoded-passphrase-with-new-line))))))
1240
1241 (defun epg--status-GET_BOOL (context string)
1242   (let ((entry (assoc string epg-prompt-alist))
1243         inhibit-quit)
1244     (condition-case nil
1245       (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
1246           (process-send-string (epg-context-process context) "y\n")
1247         (process-send-string (epg-context-process context) "n\n"))
1248       (quit
1249        (epg-context-set-result-for
1250         context 'error
1251         (cons '(quit)
1252               (epg-context-result-for context 'error)))
1253        (delete-process (epg-context-process context))))))
1254
1255 (defun epg--status-GET_LINE (context string)
1256   (let ((entry (assoc string epg-prompt-alist))
1257         inhibit-quit)
1258     (condition-case nil
1259         (process-send-string (epg-context-process context)
1260                              (concat (read-string
1261                                       (if entry
1262                                           (cdr entry)
1263                                         (concat string ": ")))
1264                                      "\n"))
1265       (quit
1266        (epg-context-set-result-for
1267         context 'error
1268         (cons '(quit)
1269               (epg-context-result-for context 'error)))
1270        (delete-process (epg-context-process context))))))
1271
1272 (defun epg--status-*SIG (context status string)
1273   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1274       (let* ((key-id (match-string 1 string))
1275              (user-id (match-string 2 string))
1276              (entry (assoc key-id epg-user-id-alist)))
1277         (epg-context-set-result-for
1278          context
1279          'verify
1280          (cons (epg-make-signature status key-id)
1281                (epg-context-result-for context 'verify)))
1282         (if (eq (epg-context-protocol context) 'CMS)
1283             (condition-case nil
1284                 (setq user-id (epg-dn-from-string user-id))
1285               (error)))
1286         (if entry
1287             (setcdr entry user-id)
1288           (setq epg-user-id-alist
1289                 (cons (cons key-id user-id) epg-user-id-alist))))
1290     (epg-context-set-result-for
1291      context
1292      'verify
1293      (cons (epg-make-signature status)
1294            (epg-context-result-for context 'verify)))))
1295
1296 (defun epg--status-GOODSIG (context string)
1297   (epg--status-*SIG context 'good string))
1298
1299 (defun epg--status-EXPSIG (context string)
1300   (epg--status-*SIG context 'expired string))
1301
1302 (defun epg--status-EXPKEYSIG (context string)
1303   (epg--status-*SIG context 'expired-key string))
1304
1305 (defun epg--status-REVKEYSIG (context string)
1306   (epg--status-*SIG context 'revoked-key string))
1307
1308 (defun epg--status-BADSIG (context string)
1309   (epg--status-*SIG context 'bad string))
1310
1311 (defun epg--status-NO_PUBKEY (context string)
1312   (let ((signature (car (epg-context-result-for context 'verify))))
1313     (if (and signature
1314              (eq (epg-signature-status signature) 'error)
1315              (equal (epg-signature-key-id signature) string))
1316         (epg-signature-set-status signature 'no-pubkey))))
1317
1318 (defun epg--time-from-seconds (seconds)
1319   (let ((number-seconds (string-to-number (concat seconds ".0"))))
1320     (cons (floor (/ number-seconds 65536))
1321           (floor (mod number-seconds 65536)))))
1322
1323 (defun epg--status-ERRSIG (context string)
1324   (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1325 \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
1326                     string)
1327       (let ((signature (epg-make-signature 'error)))
1328         (epg-context-set-result-for
1329          context
1330          'verify
1331          (cons signature
1332                (epg-context-result-for context 'verify)))
1333         (epg-signature-set-key-id
1334          signature
1335          (match-string 1 string))
1336         (epg-signature-set-pubkey-algorithm
1337          signature
1338          (string-to-number (match-string 2 string)))
1339         (epg-signature-set-digest-algorithm
1340          signature
1341          (string-to-number (match-string 3 string)))
1342         (epg-signature-set-class
1343          signature
1344          (string-to-number (match-string 4 string) 16))
1345         (epg-signature-set-creation-time
1346          signature
1347          (epg--time-from-seconds (match-string 5 string))))))
1348
1349 (defun epg--status-VALIDSIG (context string)
1350   (let ((signature (car (epg-context-result-for context 'verify))))
1351     (when (and signature
1352                (eq (epg-signature-status signature) 'good)
1353                (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
1354 \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
1355 \\(.*\\)"
1356                            string))
1357       (epg-signature-set-fingerprint
1358        signature
1359        (match-string 1 string))
1360       (epg-signature-set-creation-time
1361        signature
1362        (epg--time-from-seconds (match-string 2 string)))
1363       (epg-signature-set-expiration-time
1364        signature
1365        (epg--time-from-seconds (match-string 3 string)))
1366       (epg-signature-set-version
1367        signature
1368        (string-to-number (match-string 4 string)))
1369       (epg-signature-set-pubkey-algorithm
1370        signature 
1371        (string-to-number (match-string 5 string)))
1372       (epg-signature-set-digest-algorithm
1373        signature
1374        (string-to-number (match-string 6 string)))
1375       (epg-signature-set-class
1376        signature
1377        (string-to-number (match-string 7 string) 16)))))
1378
1379 (defun epg--status-TRUST_UNDEFINED (context string)
1380   (let ((signature (car (epg-context-result-for context 'verify))))
1381     (if (and signature
1382              (eq (epg-signature-status signature) 'good))
1383         (epg-signature-set-validity signature 'undefined))))
1384
1385 (defun epg--status-TRUST_NEVER (context string)
1386   (let ((signature (car (epg-context-result-for context 'verify))))
1387     (if (and signature
1388              (eq (epg-signature-status signature) 'good))
1389         (epg-signature-set-validity signature 'never))))
1390
1391 (defun epg--status-TRUST_MARGINAL (context string)
1392   (let ((signature (car (epg-context-result-for context 'verify))))
1393     (if (and signature
1394              (eq (epg-signature-status signature) 'marginal))
1395         (epg-signature-set-validity signature 'marginal))))
1396
1397 (defun epg--status-TRUST_FULLY (context string)
1398   (let ((signature (car (epg-context-result-for context 'verify))))
1399     (if (and signature
1400              (eq (epg-signature-status signature) 'good))
1401         (epg-signature-set-validity signature 'full))))
1402
1403 (defun epg--status-TRUST_ULTIMATE (context string)
1404   (let ((signature (car (epg-context-result-for context 'verify))))
1405     (if (and signature
1406              (eq (epg-signature-status signature) 'good))
1407         (epg-signature-set-validity signature 'ultimate))))
1408
1409 (defun epg--status-NOTATION_NAME (context string)
1410   (let ((signature (car (epg-context-result-for context 'verify))))
1411     (if signature
1412         (epg-signature-set-notations
1413          signature
1414          (cons (epg-make-sig-notation string nil t nil)
1415                (epg-sig-notations signature))))))
1416
1417 (defun epg--status-NOTATION_DATA (context string)
1418   (let ((signature (car (epg-context-result-for context 'verify)))
1419         notation)
1420     (if (and signature
1421              (setq notation (car (epg-sig-notations signature))))
1422         (epg-sig-notation-set-value notation string))))
1423
1424 (defun epg--status-POLICY_URL (context string)
1425   (let ((signature (car (epg-context-result-for context 'verify))))
1426     (if signature
1427         (epg-signature-set-notations
1428          signature
1429          (cons (epg-make-sig-notation nil string t nil)
1430                (epg-sig-notations signature))))))
1431
1432 (defun epg--status-PROGRESS (context string)
1433   (if (and (epg-context-progress-callback context)
1434            (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1435                          string))
1436       (funcall (if (consp (epg-context-progress-callback context))
1437                    (car (epg-context-progress-callback context))
1438                  (epg-context-progress-callback context))
1439                context
1440                (match-string 1 string)
1441                (match-string 2 string)
1442                (string-to-number (match-string 3 string))
1443                (string-to-number (match-string 4 string))
1444                (if (consp (epg-context-progress-callback context))
1445                    (cdr (epg-context-progress-callback context))))))
1446
1447 (defun epg--status-DECRYPTION_FAILED (context string)
1448   (epg-context-set-result-for context 'decryption-failed t))
1449
1450 (defun epg--status-DECRYPTION_OKAY (context string)
1451   (epg-context-set-result-for context 'decryption-okay t))
1452
1453 (defun epg--status-NODATA (context string)
1454   (epg-context-set-result-for
1455    context 'error
1456    (cons (cons 'no-data (string-to-number string))
1457          (epg-context-result-for context 'error))))
1458
1459 (defun epg--status-UNEXPECTED (context string)
1460   (epg-context-set-result-for
1461    context 'error
1462    (cons (cons 'unexpected (string-to-number string))
1463          (epg-context-result-for context 'error))))
1464
1465 (defun epg--status-KEYEXPIRED (context string)
1466   (epg-context-set-result-for
1467    context 'error
1468    (cons (list 'key-expired (cons 'expiration-time
1469                                   (epg--time-from-seconds string)))
1470          (epg-context-result-for context 'error))))
1471
1472 (defun epg--status-KEYREVOKED (context string)
1473   (epg-context-set-result-for
1474    context 'error
1475    (cons '(key-revoked)
1476          (epg-context-result-for context 'error))))
1477
1478 (defun epg--status-BADARMOR (context string)
1479   (epg-context-set-result-for
1480    context 'error
1481    (cons '(bad-armor)
1482          (epg-context-result-for context 'error))))
1483
1484 (defun epg--status-INV_RECP (context string)
1485   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1486       (epg-context-set-result-for
1487        context 'error
1488        (cons (list 'invalid-recipient
1489                    (cons 'reason
1490                          (string-to-number (match-string 1 string)))
1491                    (cons 'requested-recipient
1492                          (match-string 2 string)))
1493              (epg-context-result-for context 'error)))))
1494
1495 (defun epg--status-NO_RECP (context string)
1496   (epg-context-set-result-for
1497    context 'error
1498    (cons '(no-recipients)
1499          (epg-context-result-for context 'error))))
1500
1501 (defun epg--status-DELETE_PROBLEM (context string)
1502   (if (string-match "\\`\\([0-9]+\\)" string)
1503       (epg-context-set-result-for
1504        context 'error
1505        (cons (cons 'delete-problem
1506                    (string-to-number (match-string 1 string)))
1507              (epg-context-result-for context 'error)))))
1508
1509 (defun epg--status-SIG_CREATED (context string)
1510   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1511 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1512       (epg-context-set-result-for
1513        context 'sign
1514        (cons (epg-make-new-signature
1515               (cdr (assq (aref (match-string 1 string) 0)
1516                          epg-new-signature-type-alist))
1517               (string-to-number (match-string 2 string))
1518               (string-to-number (match-string 3 string))
1519               (string-to-number (match-string 4 string) 16)
1520               (epg--time-from-seconds (match-string 5 string))
1521               (substring string (match-end 0)))
1522              (epg-context-result-for context 'sign)))))
1523
1524 (defun epg--status-KEY_CREATED (context string)
1525   (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1526       (epg-context-set-result-for
1527        context 'generate-key
1528        (cons (list (cons 'type (string-to-char (match-string 1 string)))
1529                    (cons 'fingerprint (match-string 2 string)))
1530              (epg-context-result-for context 'generate-key)))))
1531
1532 (defun epg--status-KEY_NOT_CREATED (context string)
1533   (epg-context-set-result-for
1534    context 'error
1535    (cons '(key-not-created)
1536          (epg-context-result-for context 'error))))
1537
1538 (defun epg--status-IMPORTED (context string)
1539   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1540       (let* ((key-id (match-string 1 string))
1541              (user-id (match-string 2 string))
1542              (entry (assoc key-id epg-user-id-alist)))
1543         (if entry
1544             (setcdr entry user-id)
1545           (setq epg-user-id-alist (cons (cons key-id user-id)
1546                                         epg-user-id-alist))))))
1547
1548 (defun epg--status-IMPORT_OK (context string)
1549   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1550       (let ((reason (string-to-number (match-string 1 string))))
1551         (epg-context-set-result-for
1552          context 'import-status
1553          (cons (epg-make-import-status (if (match-beginning 2)
1554                                            (match-string 3 string))
1555                                        nil
1556                                        (/= (logand reason 1) 0)
1557                                        (/= (logand reason 2) 0)
1558                                        (/= (logand reason 4) 0)
1559                                        (/= (logand reason 8) 0)
1560                                        (/= (logand reason 16) 0))
1561                (epg-context-result-for context 'import-status))))))
1562
1563 (defun epg--status-IMPORT_PROBLEM (context string)
1564   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1565       (epg-context-set-result-for
1566        context 'import-status
1567        (cons (epg-make-import-status
1568               (if (match-beginning 2)
1569                   (match-string 3 string))
1570               (string-to-number (match-string 1 string)))
1571              (epg-context-result-for context 'import-status)))))
1572
1573 (defun epg--status-IMPORT_RES (context string)
1574   (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1575 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1576 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1577     (epg-context-set-result-for
1578      context 'import
1579      (epg-make-import-result (string-to-number (match-string 1 string))
1580                              (string-to-number (match-string 2 string))
1581                              (string-to-number (match-string 3 string))
1582                              (string-to-number (match-string 4 string))
1583                              (string-to-number (match-string 5 string))
1584                              (string-to-number (match-string 6 string))
1585                              (string-to-number (match-string 7 string))
1586                              (string-to-number (match-string 8 string))
1587                              (string-to-number (match-string 9 string))
1588                              (string-to-number (match-string 10 string))
1589                              (string-to-number (match-string 11 string))
1590                              (string-to-number (match-string 12 string))
1591                              (string-to-number (match-string 13 string))
1592                              (epg-context-result-for context 'import-status)))
1593     (epg-context-set-result-for context 'import-status nil)))
1594
1595 (defun epg-passphrase-callback-function (context key-id handback)
1596   (if (eq key-id 'SYM)
1597       (read-passwd "Passphrase for symmetric encryption: "
1598                    (eq (epg-context-operation context) 'encrypt))
1599     (read-passwd
1600      (if (eq key-id 'PIN)
1601         "Passphrase for PIN: "
1602        (let ((entry (assoc key-id epg-user-id-alist)))
1603          (if entry
1604              (format "Passphrase for %s %s: " key-id (cdr entry))
1605            (format "Passphrase for %s: " key-id)))))))
1606
1607 (make-obsolete 'epg-passphrase-callback-function
1608                'epa-passphrase-callback-function)
1609
1610 (defun epg--list-keys-1 (context name mode)
1611   (let ((args (append (if epg-gpg-home-directory
1612                           (list "--homedir" epg-gpg-home-directory))
1613                       (list "--with-colons" "--no-greeting" "--batch"
1614                             "--with-fingerprint"
1615                             "--with-fingerprint"
1616                             (if (memq mode '(t secret))
1617                                 "--list-secret-keys"
1618                               (if (memq mode '(nil public))
1619                                   "--list-keys"
1620                                 "--list-sigs")))
1621                       (unless (eq (epg-context-protocol context) 'CMS)
1622                         '("--fixed-list-mode"))
1623                       (if name (list name))))
1624         keys string field index)
1625     (with-temp-buffer
1626       (apply #'call-process
1627              (if (eq (epg-context-protocol context) 'CMS)
1628                  epg-gpgsm-program
1629                epg-gpg-program)
1630              nil (list t nil) nil args)
1631       (goto-char (point-min))
1632       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1633         (setq keys (cons (make-vector 15 nil) keys)
1634               string (match-string 0)
1635               index 0
1636               field 0)
1637         (while (eq index
1638                    (string-match "\\([^:]+\\)?:" string index))
1639           (setq index (match-end 0))
1640           (aset (car keys) field (match-string 1 string))
1641           (setq field (1+ field))))
1642       (nreverse keys))))
1643
1644 (defun epg--make-sub-key-1 (line)
1645   (epg-make-sub-key
1646    (if (aref line 1)
1647        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1648    (delq nil
1649          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
1650                  (aref line 11)))
1651    (member (aref line 0) '("sec" "ssb"))
1652    (string-to-number (aref line 3))
1653    (string-to-number (aref line 2))
1654    (aref line 4)
1655    (epg--time-from-seconds (aref line 5))
1656    (epg--time-from-seconds (aref line 6))))
1657
1658 ;;;###autoload
1659 (defun epg-list-keys (context &optional name mode)
1660   "Return a list of epg-key objects matched with NAME.
1661 If MODE is nil or 'public, only public keyring should be searched.
1662 If MODE is t or 'secret, only secret keyring should be searched. 
1663 Otherwise, only public keyring should be searched and the key
1664 signatures should be included."
1665   (let ((lines (epg--list-keys-1 context name mode))
1666         keys cert pointer pointer-1)
1667     (while lines
1668       (cond
1669        ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1670         (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1671               keys (cons (epg-make-key
1672                           (if (aref (car lines) 8)
1673                               (cdr (assq (string-to-char (aref (car lines) 8))
1674                                          epg-key-validity-alist))))
1675                          keys))
1676         (epg-key-set-sub-key-list
1677          (car keys)
1678          (cons (epg--make-sub-key-1 (car lines))
1679                (epg-key-sub-key-list (car keys)))))
1680        ((member (aref (car lines) 0) '("sub" "ssb"))
1681         (epg-key-set-sub-key-list
1682          (car keys)
1683          (cons (epg--make-sub-key-1 (car lines))
1684                (epg-key-sub-key-list (car keys)))))
1685        ((equal (aref (car lines) 0) "uid")
1686         (epg-key-set-user-id-list
1687          (car keys)
1688          (cons (epg-make-user-id
1689                 (if (aref (car lines) 1)
1690                     (cdr (assq (string-to-char (aref (car lines) 1))
1691                                epg-key-validity-alist)))
1692                 (if cert
1693                     (condition-case nil
1694                         (epg-dn-from-string (aref (car lines) 9))
1695                       (error (aref (car lines) 9)))
1696                   (aref (car lines) 9)))
1697                (epg-key-user-id-list (car keys)))))
1698        ((equal (aref (car lines) 0) "fpr")
1699         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
1700                                      (aref (car lines) 9)))
1701        ((equal (aref (car lines) 0) "sig")
1702         (epg-user-id-set-signature-list
1703          (car (epg-key-user-id-list (car keys)))
1704          (cons
1705           (epg-make-key-signature
1706            (if (aref (car lines) 1)
1707                (cdr (assq (string-to-char (aref (car lines) 1))
1708                           epg-key-validity-alist)))
1709            (string-to-number (aref (car lines) 3))
1710            (aref (car lines) 4)
1711            (epg--time-from-seconds (aref (car lines) 5))
1712            (epg--time-from-seconds (aref (car lines) 6))
1713            (aref (car lines) 9)
1714            (string-to-number (aref (car lines) 10) 16)
1715            (eq (aref (aref (car lines) 10) 2) ?x))
1716           (epg-user-id-signature-list
1717            (car (epg-key-user-id-list (car keys))))))))
1718       (setq lines (cdr lines)))
1719     (setq keys (nreverse keys)
1720           pointer keys)
1721     (while pointer
1722       (epg-key-set-sub-key-list
1723        (car pointer)
1724        (nreverse (epg-key-sub-key-list (car pointer))))
1725       (setq pointer-1 (epg-key-set-user-id-list
1726                           (car pointer)
1727                           (nreverse (epg-key-user-id-list (car pointer)))))
1728       (while pointer-1
1729         (epg-user-id-set-signature-list
1730          (car pointer-1)
1731          (nreverse (epg-user-id-signature-list (car pointer-1))))
1732         (setq pointer-1 (cdr pointer-1)))
1733       (setq pointer (cdr pointer)))
1734     keys))
1735
1736 (if (fboundp 'make-temp-file)
1737     (defalias 'epg--make-temp-file 'make-temp-file)
1738   (defvar temporary-file-directory)
1739   ;; stolen from poe.el.
1740   (defun epg--make-temp-file (prefix)
1741     "Create a temporary file.
1742 The returned file name (created by appending some random characters at the end
1743 of PREFIX, and expanding against `temporary-file-directory' if necessary),
1744 is guaranteed to point to a newly created empty file.
1745 You can then use `write-region' to write new data into the file."
1746     (let (tempdir tempfile)
1747       (setq prefix (expand-file-name prefix
1748                                      (if (featurep 'xemacs)
1749                                          (temp-directory)
1750                                        temporary-file-directory)))
1751       (unwind-protect
1752           (let (file)
1753             ;; First, create a temporary directory.
1754             (while (condition-case ()
1755                        (progn
1756                          (setq tempdir (make-temp-name
1757                                         (concat
1758                                          (file-name-directory prefix)
1759                                          "DIR")))
1760                          ;; return nil or signal an error.
1761                          (make-directory tempdir))
1762                      ;; let's try again.
1763                      (file-already-exists t)))
1764             (set-file-modes tempdir 448)
1765             ;; Second, create a temporary file in the tempdir.
1766             ;; There *is* a race condition between `make-temp-name'
1767             ;; and `write-region', but we don't care it since we are
1768             ;; in a private directory now.
1769             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1770             (write-region "" nil tempfile nil 'silent)
1771             (set-file-modes tempfile 384)
1772             ;; Finally, make a hard-link from the tempfile.
1773             (while (condition-case ()
1774                        (progn
1775                          (setq file (make-temp-name prefix))
1776                          ;; return nil or signal an error.
1777                          (add-name-to-file tempfile file))
1778                      ;; let's try again.
1779                      (file-already-exists t)))
1780             file)
1781         ;; Cleanup the tempfile.
1782         (and tempfile
1783              (file-exists-p tempfile)
1784              (delete-file tempfile))
1785         ;; Cleanup the tempdir.
1786         (and tempdir
1787              (file-directory-p tempdir)
1788              (delete-directory tempdir))))))
1789
1790 (if (fboundp 'clear-string)
1791     (defalias 'epg--clear-string 'clear-string)
1792   (defun epg--clear-string (string)
1793     (fillarray string 0)))
1794
1795 (defun epg--args-from-sig-notations (notations)
1796   (apply #'nconc
1797          (mapcar
1798           (lambda (notation)
1799             (if (and (epg-sig-notation-name notation)
1800                      (not (epg-sig-notation-human-readable notation)))
1801                 (error "Unreadable"))
1802             (if (epg-sig-notation-name notation)
1803                 (list "--sig-notation"
1804                       (if (epg-sig-notation-critical notation)
1805                           (concat "!" (epg-sig-notation-name notation)
1806                                   "=" (epg-sig-notation-value notation))
1807                         (concat (epg-sig-notation-name notation)
1808                                 "=" (epg-sig-notation-value notation))))
1809               (list "--sig-policy-url"
1810                     (if (epg-sig-notation-critical notation)
1811                         (concat "!" (epg-sig-notation-value notation))
1812                       (epg-sig-notation-value notation)))))
1813           notations)))
1814
1815 ;;;###autoload
1816 (defun epg-cancel (context)
1817   (if (buffer-live-p (process-buffer (epg-context-process context)))
1818       (save-excursion
1819         (set-buffer (process-buffer (epg-context-process context)))
1820         (epg-context-set-result-for
1821          epg-context 'error
1822          (cons '(quit)
1823                (epg-context-result-for epg-context 'error)))))
1824   (if (eq (process-status (epg-context-process context)) 'run)
1825       (delete-process (epg-context-process context))))
1826
1827 ;;;###autoload
1828 (defun epg-start-decrypt (context cipher)
1829   "Initiate a decrypt operation on CIPHER.
1830 CIPHER must be a file data object.
1831
1832 If you use this function, you will need to wait for the completion of
1833 `epg-gpg-program' by using `epg-wait-for-completion' and call
1834 `epg-reset' to clear a temporaly output file.
1835 If you are unsure, use synchronous version of this function
1836 `epg-decrypt-file' or `epg-decrypt-string' instead."
1837   (unless (epg-data-file cipher)
1838     (error "Not a file"))
1839   (epg-context-set-operation context 'decrypt)
1840   (epg-context-set-result context nil)
1841   (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
1842   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1843   (unless (eq (epg-context-protocol context) 'CMS)
1844     (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1845
1846 (defun epg--check-error-for-decrypt (context)
1847   (if (epg-context-result-for context 'decryption-failed)
1848       (signal 'epg-error (list "Decryption failed")))
1849   (if (epg-context-result-for context 'no-secret-key)
1850       (signal 'epg-error
1851               (list "No secret key"
1852                     (epg-context-result-for context 'no-secret-key))))
1853     (unless (epg-context-result-for context 'decryption-okay)
1854       (let* ((error (epg-context-result-for context 'error)))
1855         (if (assq 'no-data error)
1856             (signal 'epg-error (list "No data")))
1857         (signal 'epg-error (list "Can't decrypt" error)))))
1858
1859 ;;;###autoload
1860 (defun epg-decrypt-file (context cipher plain)
1861   "Decrypt a file CIPHER and store the result to a file PLAIN.
1862 If PLAIN is nil, it returns the result as a string."
1863   (unwind-protect
1864       (progn
1865         (if plain
1866             (epg-context-set-output-file context plain)
1867           (epg-context-set-output-file context
1868                                        (epg--make-temp-file "epg-output")))
1869         (epg-start-decrypt context (epg-make-data-from-file cipher))
1870         (epg-wait-for-completion context)
1871         (epg--check-error-for-decrypt context)
1872         (unless plain
1873           (epg-read-output context)))
1874     (unless plain
1875       (epg-delete-output-file context))
1876     (epg-reset context)))
1877
1878 ;;;###autoload
1879 (defun epg-decrypt-string (context cipher)
1880   "Decrypt a string CIPHER and return the plain text."
1881   (let ((input-file (epg--make-temp-file "epg-input"))
1882         (coding-system-for-write 'binary))
1883     (unwind-protect
1884         (progn
1885           (write-region cipher nil input-file nil 'quiet)
1886           (epg-context-set-output-file context
1887                                        (epg--make-temp-file "epg-output"))
1888           (epg-start-decrypt context (epg-make-data-from-file input-file))
1889           (epg-wait-for-completion context)
1890           (epg--check-error-for-decrypt context)
1891           (epg-read-output context))
1892       (epg-delete-output-file context)
1893       (if (file-exists-p input-file)
1894           (delete-file input-file))
1895       (epg-reset context))))
1896
1897 ;;;###autoload
1898 (defun epg-start-verify (context signature &optional signed-text)
1899   "Initiate a verify operation on SIGNATURE.
1900 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
1901
1902 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
1903 For a normal or a cleartext signature, SIGNED-TEXT should be nil.
1904
1905 If you use this function, you will need to wait for the completion of
1906 `epg-gpg-program' by using `epg-wait-for-completion' and call
1907 `epg-reset' to clear a temporaly output file.
1908 If you are unsure, use synchronous version of this function
1909 `epg-verify-file' or `epg-verify-string' instead."
1910   (epg-context-set-operation context 'verify)
1911   (epg-context-set-result context nil)
1912   (if signed-text
1913       ;; Detached signature.
1914       (if (epg-data-file signed-text)
1915           (epg--start context (list "--verify" "--" (epg-data-file signature)
1916                                    (epg-data-file signed-text)))
1917         (epg--start context (list "--verify" "--" (epg-data-file signature)
1918                                   "-"))
1919         (if (eq (process-status (epg-context-process context)) 'run)
1920             (process-send-string (epg-context-process context)
1921                                  (epg-data-string signed-text)))
1922         (if (eq (process-status (epg-context-process context)) 'run)
1923             (process-send-eof (epg-context-process context))))
1924     ;; Normal (or cleartext) signature.
1925     (if (epg-data-file signature)
1926         (epg--start context (list "--" (epg-data-file signature)))
1927       (epg--start context '("-"))
1928       (if (eq (process-status (epg-context-process context)) 'run)
1929           (process-send-string (epg-context-process context)
1930                                (epg-data-string signature)))
1931       (if (eq (process-status (epg-context-process context)) 'run)
1932           (process-send-eof (epg-context-process context))))))
1933
1934 ;;;###autoload
1935 (defun epg-verify-file (context signature &optional signed-text plain)
1936   "Verify a file SIGNATURE.
1937 SIGNED-TEXT and PLAIN are also a file if they are specified.
1938
1939 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
1940 string.  For a normal or a cleartext signature, SIGNED-TEXT should be
1941 nil.  In the latter case, if PLAIN is specified, the plaintext is
1942 stored into the file after successful verification."
1943   (unwind-protect
1944       (progn
1945         (if plain
1946             (epg-context-set-output-file context plain)
1947           (epg-context-set-output-file context
1948                                        (epg--make-temp-file "epg-output")))
1949         (if signed-text
1950             (epg-start-verify context
1951                               (epg-make-data-from-file signature)
1952                               (epg-make-data-from-file signed-text))
1953           (epg-start-verify context
1954                             (epg-make-data-from-file signature)))
1955         (epg-wait-for-completion context)
1956         (unless plain
1957           (epg-read-output context)))
1958     (unless plain
1959       (epg-delete-output-file context))
1960     (epg-reset context)))
1961
1962 ;;;###autoload
1963 (defun epg-verify-string (context signature &optional signed-text)
1964   "Verify a string SIGNATURE.
1965 SIGNED-TEXT is a string if it is specified.
1966
1967 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
1968 string.  For a normal or a cleartext signature, SIGNED-TEXT should be
1969 nil.  In the latter case, this function returns the plaintext after
1970 successful verification."
1971   (let ((coding-system-for-write 'binary)
1972         input-file)
1973     (unwind-protect
1974         (progn
1975           (epg-context-set-output-file context
1976                                        (epg--make-temp-file "epg-output"))
1977           (if signed-text
1978               (progn
1979                 (setq input-file (epg--make-temp-file "epg-signature"))
1980                 (write-region signature nil input-file nil 'quiet)
1981                 (epg-start-verify context
1982                                   (epg-make-data-from-file input-file)
1983                                   (epg-make-data-from-string signed-text)))
1984             (epg-start-verify context (epg-make-data-from-string signature)))
1985           (epg-wait-for-completion context)
1986           (epg-read-output context))
1987       (epg-delete-output-file context)
1988       (if (and input-file
1989                (file-exists-p input-file))
1990           (delete-file input-file))
1991       (epg-reset context))))
1992
1993 ;;;###autoload
1994 (defun epg-start-sign (context plain &optional mode)
1995   "Initiate a sign operation on PLAIN.
1996 PLAIN is a data object.
1997
1998 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1999 If it is nil or 'normal, it makes a normal signature.
2000 Otherwise, it makes a cleartext signature.
2001
2002 If you use this function, you will need to wait for the completion of
2003 `epg-gpg-program' by using `epg-wait-for-completion' and call
2004 `epg-reset' to clear a temporaly output file.
2005 If you are unsure, use synchronous version of this function
2006 `epg-sign-file' or `epg-sign-string' instead."
2007   (epg-context-set-operation context 'sign)
2008   (epg-context-set-result context nil)
2009   (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
2010     (epg-context-set-armor context nil)
2011     (epg-context-set-textmode context nil))
2012   (epg--start context
2013              (append (list (if (memq mode '(t detached))
2014                                "--detach-sign"
2015                              (if (memq mode '(nil normal))
2016                                  "--sign"
2017                                "--clearsign")))
2018                      (apply #'nconc
2019                             (mapcar
2020                              (lambda (signer)
2021                                (list "-u"
2022                                      (epg-sub-key-id
2023                                       (car (epg-key-sub-key-list signer)))))
2024                              (epg-context-signers context)))
2025                      (epg--args-from-sig-notations
2026                       (epg-context-sig-notations context))
2027                      (if (epg-data-file plain)
2028                          (list "--" (epg-data-file plain)))))
2029   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2030   (unless (eq (epg-context-protocol context) 'CMS)
2031     (epg-wait-for-status context '("BEGIN_SIGNING")))
2032   (when (epg-data-string plain)
2033     (if (eq (process-status (epg-context-process context)) 'run)
2034         (process-send-string (epg-context-process context)
2035                              (epg-data-string plain)))
2036     (if (eq (process-status (epg-context-process context)) 'run)
2037         (process-send-eof (epg-context-process context)))))
2038
2039 ;;;###autoload
2040 (defun epg-sign-file (context plain signature &optional mode)
2041   "Sign a file PLAIN and store the result to a file SIGNATURE.
2042 If SIGNATURE is nil, it returns the result as a string.
2043 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2044 If it is nil or 'normal, it makes a normal signature.
2045 Otherwise, it makes a cleartext signature."
2046   (unwind-protect
2047       (progn
2048         (if signature
2049             (epg-context-set-output-file context signature)
2050           (epg-context-set-output-file context
2051                                        (epg--make-temp-file "epg-output")))
2052         (epg-start-sign context (epg-make-data-from-file plain) mode)
2053         (epg-wait-for-completion context)
2054         (unless (epg-context-result-for context 'sign)
2055           (if (epg-context-result-for context 'error)
2056               (error "Sign failed: %S"
2057                      (epg-context-result-for context 'error))
2058             (error "Sign failed")))
2059         (unless signature
2060           (epg-read-output context)))
2061     (unless signature
2062       (epg-delete-output-file context))
2063     (epg-reset context)))
2064
2065 ;;;###autoload
2066 (defun epg-sign-string (context plain &optional mode)
2067   "Sign a string PLAIN and return the output as string.
2068 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2069 If it is nil or 'normal, it makes a normal signature.
2070 Otherwise, it makes a cleartext signature."
2071   (unwind-protect
2072       (progn
2073         (epg-context-set-output-file context
2074                                      (epg--make-temp-file "epg-output"))
2075         (epg-start-sign context (epg-make-data-from-string plain) mode)
2076         (epg-wait-for-completion context)
2077         (unless (epg-context-result-for context 'sign)
2078           (if (epg-context-result-for context 'error)
2079               (error "Sign failed: %S"
2080                      (epg-context-result-for context 'error))
2081             (error "Sign failed")))
2082         (epg-read-output context))
2083     (epg-delete-output-file context)
2084     (epg-reset context)))
2085
2086 ;;;###autoload
2087 (defun epg-start-encrypt (context plain recipients
2088                                   &optional sign always-trust)
2089   "Initiate an encrypt operation on PLAIN.
2090 PLAIN is a data object.
2091 If RECIPIENTS is nil, it performs symmetric encryption.
2092
2093 If you use this function, you will need to wait for the completion of
2094 `epg-gpg-program' by using `epg-wait-for-completion' and call
2095 `epg-reset' to clear a temporaly output file.
2096 If you are unsure, use synchronous version of this function
2097 `epg-encrypt-file' or `epg-encrypt-string' instead."
2098   (epg-context-set-operation context 'encrypt)
2099   (epg-context-set-result context nil)
2100   (epg--start context
2101              (append (if always-trust '("--always-trust"))
2102                      (if recipients '("--encrypt") '("--symmetric"))
2103                      (if sign '("--sign"))
2104                      (if sign
2105                          (apply #'nconc
2106                                 (mapcar
2107                                  (lambda (signer)
2108                                    (list "-u"
2109                                          (epg-sub-key-id
2110                                           (car (epg-key-sub-key-list
2111                                                 signer)))))
2112                                  (epg-context-signers context))))
2113                      (if sign
2114                          (epg--args-from-sig-notations
2115                           (epg-context-sig-notations context)))
2116                      (apply #'nconc
2117                             (mapcar
2118                              (lambda (recipient)
2119                                (list "-r"
2120                                      (epg-sub-key-id
2121                                       (car (epg-key-sub-key-list recipient)))))
2122                              recipients))
2123                      (if (epg-data-file plain)
2124                          (list "--" (epg-data-file plain)))))
2125   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2126   (unless (eq (epg-context-protocol context) 'CMS)
2127     (if sign
2128         (epg-wait-for-status context '("BEGIN_SIGNING"))
2129       (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
2130   (when (epg-data-string plain)
2131     (if (eq (process-status (epg-context-process context)) 'run)
2132         (process-send-string (epg-context-process context)
2133                              (epg-data-string plain)))
2134     (if (eq (process-status (epg-context-process context)) 'run)
2135         (process-send-eof (epg-context-process context)))))
2136
2137 ;;;###autoload
2138 (defun epg-encrypt-file (context plain recipients
2139                                  cipher &optional sign always-trust)
2140   "Encrypt a file PLAIN and store the result to a file CIPHER.
2141 If CIPHER is nil, it returns the result as a string.
2142 If RECIPIENTS is nil, it performs symmetric encryption."
2143   (unwind-protect
2144       (progn
2145         (if cipher
2146             (epg-context-set-output-file context cipher)
2147           (epg-context-set-output-file context
2148                                        (epg--make-temp-file "epg-output")))
2149         (epg-start-encrypt context (epg-make-data-from-file plain)
2150                            recipients sign always-trust)
2151         (epg-wait-for-completion context)
2152         (if (and sign
2153                  (not (epg-context-result-for context 'sign)))
2154             (if (epg-context-result-for context 'error)
2155                 (error "Sign failed: %S"
2156                        (epg-context-result-for context 'error))
2157                 (error "Sign failed")))
2158         (if (epg-context-result-for context 'error)
2159             (error "Encrypt failed: %S"
2160                    (epg-context-result-for context 'error)))
2161         (unless cipher
2162           (epg-read-output context)))
2163     (unless cipher
2164       (epg-delete-output-file context))
2165     (epg-reset context)))
2166
2167 ;;;###autoload
2168 (defun epg-encrypt-string (context plain recipients
2169                                    &optional sign always-trust)
2170   "Encrypt a string PLAIN.
2171 If RECIPIENTS is nil, it performs symmetric encryption."
2172   (unwind-protect
2173       (progn
2174         (epg-context-set-output-file context
2175                                      (epg--make-temp-file "epg-output"))
2176         (epg-start-encrypt context (epg-make-data-from-string plain)
2177                            recipients sign always-trust)
2178         (epg-wait-for-completion context)
2179         (if (and sign
2180                  (not (epg-context-result-for context 'sign)))
2181             (if (epg-context-result-for context 'error)
2182                 (error "Sign failed: %S"
2183                        (epg-context-result-for context 'error))
2184               (error "Sign failed")))
2185         (if (epg-context-result-for context 'error)
2186             (error "Encrypt failed: %S"
2187                    (epg-context-result-for context 'error)))
2188         (epg-read-output context))
2189     (epg-delete-output-file context)
2190     (epg-reset context)))
2191
2192 ;;;###autoload
2193 (defun epg-start-export-keys (context keys)
2194   "Initiate an export keys operation.
2195
2196 If you use this function, you will need to wait for the completion of
2197 `epg-gpg-program' by using `epg-wait-for-completion' and call
2198 `epg-reset' to clear a temporaly output file.
2199 If you are unsure, use synchronous version of this function
2200 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
2201   (epg-context-set-operation context 'export-keys)
2202   (epg-context-set-result context nil)
2203   (epg--start context (cons "--export"
2204                            (mapcar
2205                             (lambda (key)
2206                               (epg-sub-key-id
2207                                (car (epg-key-sub-key-list key))))
2208                             keys))))
2209
2210 ;;;###autoload
2211 (defun epg-export-keys-to-file (context keys file)
2212   "Extract public KEYS."
2213   (unwind-protect
2214       (progn
2215         (if keys
2216             (epg-context-set-output-file context file)
2217           (epg-context-set-output-file context
2218                                        (epg--make-temp-file "epg-output")))
2219         (epg-start-export-keys context keys)
2220         (epg-wait-for-completion context)
2221         (if (epg-context-result-for context 'error)
2222             (error "Export keys failed: %S"
2223                    (epg-context-result-for context 'error)))
2224         (unless file
2225           (epg-read-output context)))
2226     (unless file
2227       (epg-delete-output-file context))
2228     (epg-reset context)))
2229
2230 ;;;###autoload
2231 (defun epg-export-keys-to-string (context keys)
2232   "Extract public KEYS and return them as a string."
2233   (epg-export-keys-to-file context keys nil))
2234
2235 ;;;###autoload
2236 (defun epg-start-import-keys (context keys)
2237   "Initiate an import keys operation.
2238 KEYS is a data object.
2239
2240 If you use this function, you will need to wait for the completion of
2241 `epg-gpg-program' by using `epg-wait-for-completion' and call
2242 `epg-reset' to clear a temporaly output file.
2243 If you are unsure, use synchronous version of this function
2244 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
2245   (epg-context-set-operation context 'import-keys)
2246   (epg-context-set-result context nil)
2247   (epg--start context (if (epg-data-file keys)
2248                           (list "--import" "--" (epg-data-file keys))
2249                         (list "--import")))
2250   (when (epg-data-string keys)
2251     (if (eq (process-status (epg-context-process context)) 'run)
2252         (process-send-string (epg-context-process context)
2253                              (epg-data-string keys)))
2254     (if (eq (process-status (epg-context-process context)) 'run)
2255         (process-send-eof (epg-context-process context)))))
2256
2257 (defun epg--import-keys-1 (context keys)
2258   (unwind-protect
2259       (progn
2260         (epg-start-import-keys context keys)
2261         (epg-wait-for-completion context)
2262         (if (epg-context-result-for context 'error)
2263             (error "Import keys failed: %S"
2264                    (epg-context-result-for context 'error))))
2265     (epg-reset context)))
2266
2267 ;;;###autoload
2268 (defun epg-import-keys-from-file (context keys)
2269   "Add keys from a file KEYS."
2270   (epg--import-keys-1 context (epg-make-data-from-file keys)))
2271
2272 ;;;###autoload
2273 (defun epg-import-keys-from-string (context keys)
2274   "Add keys from a string KEYS."
2275   (epg--import-keys-1 context (epg-make-data-from-string keys)))
2276
2277 ;;;###autoload
2278 (defun epg-start-receive-keys (context key-id-list)
2279   "Initiate a receive key operation.
2280 KEY-ID-LIST is a list of key IDs.
2281
2282 If you use this function, you will need to wait for the completion of
2283 `epg-gpg-program' by using `epg-wait-for-completion' and call
2284 `epg-reset' to clear a temporaly output file.
2285 If you are unsure, use synchronous version of this function
2286 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2287   (epg-context-set-operation context 'receive-keys)
2288   (epg-context-set-result context nil)
2289   (epg--start context (cons "--recv-keys" key-id-list)))
2290
2291 ;;;###autoload
2292 (defun epg-receive-keys (context keys)
2293   "Add keys from server.
2294 KEYS is a list of key IDs"
2295   (unwind-protect
2296       (progn
2297         (epg-start-receive-keys context keys)
2298         (epg-wait-for-completion context)
2299         (if (epg-context-result-for context 'error)
2300             (error "Receive keys failed: %S"
2301                    (epg-context-result-for context 'error))))
2302     (epg-reset context)))
2303
2304 ;;;###autoload
2305 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
2306
2307 ;;;###autoload
2308 (defun epg-start-delete-keys (context keys &optional allow-secret)
2309   "Initiate an delete keys operation.
2310
2311 If you use this function, you will need to wait for the completion of
2312 `epg-gpg-program' by using `epg-wait-for-completion' and call
2313 `epg-reset' to clear a temporaly output file.
2314 If you are unsure, use synchronous version of this function
2315 `epg-delete-keys' instead."
2316   (epg-context-set-operation context 'delete-keys)
2317   (epg-context-set-result context nil)
2318   (epg--start context (cons (if allow-secret
2319                                "--delete-secret-key"
2320                              "--delete-key")
2321                             (mapcar
2322                              (lambda (key)
2323                                (epg-sub-key-id
2324                                 (car (epg-key-sub-key-list key))))
2325                              keys))))
2326
2327 ;;;###autoload
2328 (defun epg-delete-keys (context keys &optional allow-secret)
2329   "Delete KEYS from the key ring."
2330   (unwind-protect
2331       (progn
2332         (epg-start-delete-keys context keys allow-secret)
2333         (epg-wait-for-completion context)
2334         (let ((entry (assq 'delete-problem
2335                            (epg-context-result-for context 'error))))
2336           (if entry
2337               (if (setq entry (assq (cdr entry)
2338                                     epg-delete-problem-reason-alist))
2339                   (error "Delete keys failed: %s" (cdr entry)))
2340             (error "Delete keys failed" (cdr entry)))))
2341     (epg-reset context)))
2342
2343 ;;;###autoload
2344 (defun epg-start-sign-keys (context keys &optional local)
2345   "Initiate an sign keys operation.
2346
2347 If you use this function, you will need to wait for the completion of
2348 `epg-gpg-program' by using `epg-wait-for-completion' and call
2349 `epg-reset' to clear a temporaly output file.
2350 If you are unsure, use synchronous version of this function
2351 `epg-sign-keys' instead."
2352   (epg-context-set-operation context 'sign-keys)
2353   (epg-context-set-result context nil)
2354   (epg--start context (cons (if local
2355                                "--lsign-key"
2356                              "--sign-key")
2357                            (mapcar
2358                             (lambda (key)
2359                               (epg-sub-key-id
2360                                (car (epg-key-sub-key-list key))))
2361                             keys))))
2362 (make-obsolete 'epg-start-sign-keys "Do not use.")
2363
2364 ;;;###autoload
2365 (defun epg-sign-keys (context keys &optional local)
2366   "Sign KEYS from the key ring."
2367   (unwind-protect
2368       (progn
2369         (epg-start-sign-keys context keys local)
2370         (epg-wait-for-completion context)
2371         (if (epg-context-result-for context 'error)
2372             (error "Sign keys failed: %S"
2373                    (epg-context-result-for context 'error))))
2374     (epg-reset context)))
2375 (make-obsolete 'epg-sign-keys "Do not use.")
2376
2377 ;;;###autoload
2378 (defun epg-start-generate-key (context parameters)
2379   "Initiate a key generation.
2380 PARAMETERS specifies parameters for the key.
2381
2382 If you use this function, you will need to wait for the completion of
2383 `epg-gpg-program' by using `epg-wait-for-completion' and call
2384 `epg-reset' to clear a temporaly output file.
2385 If you are unsure, use synchronous version of this function
2386 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2387   (epg-context-set-operation context 'generate-key)
2388   (epg-context-set-result context nil)
2389   (if (epg-data-file parameters)
2390       (epg--start context (list "--batch" "--genkey" "--"
2391                                (epg-data-file parameters)))
2392     (epg--start context '("--batch" "--genkey"))
2393     (if (eq (process-status (epg-context-process context)) 'run)
2394         (process-send-string (epg-context-process context)
2395                              (epg-data-string parameters)))
2396     (if (eq (process-status (epg-context-process context)) 'run)
2397         (process-send-eof (epg-context-process context)))))
2398
2399 ;;;###autoload
2400 (defun epg-generate-key-from-file (context parameters)
2401   "Generate a new key pair.
2402 PARAMETERS is a file which tells how to create the key."
2403   (unwind-protect
2404       (progn
2405         (epg-start-generate-key context (epg-make-data-from-file parameters))
2406         (epg-wait-for-completion context)
2407         (if (epg-context-result-for context 'error)
2408             (error "Generate key failed: %S"
2409                    (epg-context-result-for context 'error))))
2410     (epg-reset context)))
2411
2412 ;;;###autoload
2413 (defun epg-generate-key-from-string (context parameters)
2414   "Generate a new key pair.
2415 PARAMETERS is a string which tells how to create the key."
2416   (unwind-protect
2417       (progn
2418         (epg-start-generate-key context (epg-make-data-from-string parameters))
2419         (epg-wait-for-completion context)
2420         (if (epg-context-result-for context 'error)
2421             (error "Generate key failed: %S"
2422                    (epg-context-result-for context 'error))))
2423     (epg-reset context)))
2424
2425 (defun epg--decode-hexstring (string)
2426   (let ((index 0))
2427     (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2428       (setq string (replace-match "\\x\\&" t nil string)
2429             index (+ index 4)))
2430     (car (read-from-string (concat "\"" string "\"")))))
2431
2432 (defun epg--decode-quotedstring (string)
2433   (let ((index 0))
2434     (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2435 \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\|\\(.\\)\\)"
2436                          string index)
2437       (if (match-beginning 2)
2438           (setq string (replace-match "\\2" t nil string)
2439                 index (1+ index))
2440         (if (match-beginning 3)
2441             (setq string (replace-match "\\x\\3" t nil string)
2442                   index (+ index 4))
2443           (setq string (replace-match "\\\\\\\\\\4" t nil string)
2444                 index (+ index 3)))))
2445     (car (read-from-string (concat "\"" string "\"")))))
2446
2447 (defun epg-dn-from-string (string)
2448   "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2449 The return value is an alist mapping from types to values."
2450   (let ((index 0)
2451         (length (length string))
2452         alist type value group)
2453     (while (< index length)
2454       (if (eq index (string-match "[ \t\n\r]*" string index))
2455           (setq index (match-end 0)))
2456       (if (eq index (string-match
2457                      "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
2458                      string index))
2459           (setq type (match-string 1 string)
2460                 index (match-end 0))
2461         (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2462                                     string index))
2463             (setq type (match-string 1 string)
2464                   index (match-end 0))))
2465       (unless type
2466         (error "Invalid type"))
2467       (if (eq index (string-match
2468                      "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2469                      string index))
2470           (setq index (match-end 0)
2471                 value (epg--decode-quotedstring (match-string 0 string)))
2472         (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2473             (setq index (match-end 0)
2474                   value (epg--decode-hexstring (match-string 1 string)))
2475           (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2476                                       string index))
2477               (setq index (match-end 0)
2478                     value (epg--decode-quotedstring
2479                            (match-string 0 string))))))
2480       (if group
2481           (if (stringp (car (car alist)))
2482               (setcar alist (list (cons type value) (car alist)))
2483             (setcar alist (cons (cons type value) (car alist))))
2484         (if (consp (car (car alist)))
2485             (setcar alist (nreverse (car alist))))
2486         (setq alist (cons (cons type value) alist)
2487               type nil
2488               value nil))
2489       (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2490           (setq index (match-end 0)
2491                 group (eq (aref string (match-beginning 1)) ?+))))
2492     (nreverse alist)))
2493
2494 (defun epg-decode-dn (alist)
2495   "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2496 Type names are resolved using `epg-dn-type-alist'."
2497   (mapconcat
2498    (lambda (rdn)
2499      (if (stringp (car rdn))
2500          (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2501            (if entry
2502                (format "%s=%s" (cdr entry) (cdr rdn))
2503              (format "%s=%s" (car rdn) (cdr rdn))))
2504        (concat "(" (epg-decode-dn rdn) ")")))
2505    alist
2506    ", "))
2507
2508 (provide 'epg)
2509
2510 ;;; epg.el ends here