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