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