OSDN Git Service

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