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