Specify defgroup parent.
[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   (epg-context-set-result-for
1044      epg-context
1045      'verify
1046      (cons (epg-make-signature 'no-pubkey string)
1047            (epg-context-result-for epg-context 'verify))))
1048
1049 (defun epg-status-ERRSIG (process string)
1050   (let ((signatures (epg-context-result-for epg-context 'verify)))
1051     (unless signatures
1052       (setq signatures (list (epg-make-signature 'error)))
1053       (epg-context-set-result-for epg-context 'verify signatures))
1054     (when (and (not (eq (epg-signature-status (car signatures)) 'good))
1055                (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1056 \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
1057                              string))
1058       (epg-signature-set-key-id
1059        (car signatures)
1060        (match-string 1 string))
1061       (epg-signature-set-pubkey-algorithm
1062        (car signatures)
1063        (string-to-number (match-string 2 string)))
1064       (epg-signature-set-digest-algorithm
1065        (car signatures)
1066        (string-to-number (match-string 3 string)))
1067       (epg-signature-set-class
1068        (car signatures)
1069        (string-to-number (match-string 4 string) 16))
1070       (epg-signature-set-creation-time
1071        (car signatures)
1072        (match-string 5 string)))))
1073
1074 (defun epg-status-VALIDSIG (process string)
1075   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1076     (when (and signature
1077                (eq (epg-signature-status signature) 'good)
1078                (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
1079 \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
1080 \\(.*\\)"
1081                            string))
1082       (epg-signature-set-fingerprint
1083        signature
1084        (match-string 1 string))
1085       (epg-signature-set-creation-time
1086        signature
1087        (match-string 2 string))
1088       (epg-signature-set-expiration-time
1089        signature
1090        (match-string 3 string))
1091       (epg-signature-set-version
1092        signature
1093        (string-to-number (match-string 4 string)))
1094       (epg-signature-set-pubkey-algorithm
1095        signature 
1096        (string-to-number (match-string 5 string)))
1097       (epg-signature-set-digest-algorithm
1098        signature
1099        (string-to-number (match-string 6 string)))
1100       (epg-signature-set-class
1101        signature
1102        (string-to-number (match-string 7 string) 16)))))
1103
1104 (defun epg-status-TRUST_UNDEFINED (process string)
1105   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1106     (if (and signature
1107              (eq (epg-signature-status signature) 'good))
1108         (epg-signature-set-validity signature 'undefined))))
1109
1110 (defun epg-status-TRUST_NEVER (process string)
1111   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1112     (if (and signature
1113              (eq (epg-signature-status signature) 'good))
1114         (epg-signature-set-validity signature 'never))))
1115
1116 (defun epg-status-TRUST_MARGINAL (process string)
1117   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1118     (if (and signature
1119              (eq (epg-signature-status signature) 'marginal))
1120         (epg-signature-set-validity signature 'marginal))))
1121
1122 (defun epg-status-TRUST_FULLY (process string)
1123   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1124     (if (and signature
1125              (eq (epg-signature-status signature) 'good))
1126         (epg-signature-set-validity signature 'full))))
1127
1128 (defun epg-status-TRUST_ULTIMATE (process string)
1129   (let ((signature (car (epg-context-result-for epg-context 'verify))))
1130     (if (and signature
1131              (eq (epg-signature-status signature) 'good))
1132         (epg-signature-set-validity signature 'ultimate))))
1133
1134 (defun epg-status-PROGRESS (process string)
1135   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1136                     string)
1137       (funcall (if (consp (epg-context-progress-callback epg-context))
1138                    (car (epg-context-progress-callback epg-context))
1139                  (epg-context-progress-callback epg-context))
1140                epg-context
1141                (match-string 1 string)
1142                (match-string 2 string)
1143                (string-to-number (match-string 3 string))
1144                (string-to-number (match-string 4 string))
1145                (if (consp (epg-context-progress-callback epg-context))
1146                    (cdr (epg-context-progress-callback epg-context))))))
1147
1148 (defun epg-status-DECRYPTION_FAILED (process string)
1149   (epg-context-set-result-for
1150    epg-context 'error
1151    (cons '(decryption-failed)
1152          (epg-context-result-for epg-context 'error))))
1153
1154 (defun epg-status-NODATA (process string)
1155   (epg-context-set-result-for
1156    epg-context 'error
1157    (cons (list 'no-data (cons 'reason (string-to-number string)))
1158          (epg-context-result-for epg-context 'error))))
1159
1160 (defun epg-status-UNEXPECTED (process string)
1161   (epg-context-set-result-for
1162    epg-context 'error
1163    (cons (list 'unexpected (cons 'reason (string-to-number string)))
1164          (epg-context-result-for epg-context 'error))))
1165
1166 (defun epg-status-KEYEXPIRED (process string)
1167   (epg-context-set-result-for
1168    epg-context 'error
1169    (cons (list 'key-expired (cons 'expiration-time string))
1170          (epg-context-result-for epg-context 'error))))
1171
1172 (defun epg-status-KEYREVOKED (process string)
1173   (epg-context-set-result-for
1174    epg-context 'error
1175    (cons '(key-revoked)
1176          (epg-context-result-for epg-context 'error))))
1177
1178 (defun epg-status-BADARMOR (process string)
1179   (epg-context-set-result-for
1180    epg-context 'error
1181    (cons '(bad-armor)
1182          (epg-context-result-for epg-context 'error))))
1183
1184 (defun epg-status-INV_RECP (process string)
1185   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1186       (epg-context-set-result-for
1187        epg-context 'error
1188        (cons (list 'invalid-recipient
1189                    (cons 'reason
1190                          (string-to-number (match-string 1 string)))
1191                    (cons 'requested-recipient
1192                          (match-string 2 string)))
1193              (epg-context-result-for epg-context 'error)))))
1194
1195 (defun epg-status-NO_RECP (process string)
1196   (epg-context-set-result-for
1197    epg-context 'error
1198    (cons '(no-recipients)
1199          (epg-context-result-for epg-context 'error))))
1200
1201 (defun epg-status-DELETE_PROBLEM (process string)
1202   (if (string-match "\\`\\([0-9]+\\)" string)
1203       (epg-context-set-result-for
1204        epg-context 'error
1205        (cons (list 'delete-problem
1206                    (cons 'reason (string-to-number (match-string 1 string))))
1207              (epg-context-result-for epg-context 'error)))))
1208
1209 (defun epg-status-SIG_CREATED (process string)
1210   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1211 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1212       (epg-context-set-result-for
1213        epg-context 'sign
1214        (cons (epg-make-new-signature
1215               (cdr (assq (aref (match-string 1 string) 0)
1216                          epg-new-signature-type-alist))
1217               (string-to-number (match-string 2 string))
1218               (string-to-number (match-string 3 string))
1219               (string-to-number (match-string 4 string) 16)
1220               (match-string 5 string)
1221               (substring string (match-end 0)))
1222              (epg-context-result-for epg-context 'sign)))))
1223
1224 (defun epg-status-KEY_CREATED (process string)
1225   (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1226       (epg-context-set-result-for
1227        epg-context 'generate-key
1228        (cons (list (cons 'type (string-to-char (match-string 1 string)))
1229                    (cons 'fingerprint (match-string 2 string)))
1230              (epg-context-result-for epg-context 'generate-key)))))
1231
1232 (defun epg-status-KEY_NOT_CREATED (process string)
1233   (epg-context-set-result-for
1234    epg-context 'error
1235    (cons '(key-not-created)
1236          (epg-context-result-for epg-context 'error))))
1237
1238 (defun epg-status-IMPORTED (process string)
1239   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1240       (let* ((key-id (match-string 1 string))
1241              (user-id (match-string 2 string))
1242              (entry (assoc key-id epg-user-id-alist)))
1243         (if entry
1244             (setcdr entry user-id)
1245           (setq epg-user-id-alist (cons (cons key-id user-id)
1246                                         epg-user-id-alist)))
1247         (epg-context-set-result-for
1248          epg-context 'import
1249          (cons (list (cons 'key-id key-id)
1250                      (cons 'user-id user-id))
1251                (epg-context-result-for epg-context 'import))))))
1252
1253 (defun epg-status-IMPORT_OK (process string)
1254   (let ((result (epg-context-result-for epg-context 'import)))
1255     (if (and result
1256              (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string))
1257         (setcar result
1258                 (append (list (cons 'reason
1259                                     (string-to-number
1260                                      (match-string 1 string))))
1261                         (if (match-beginning 2)
1262                             (list (cons 'fingerprint
1263                                         (match-string 3 string))))
1264                         (car result))))))
1265
1266 (defun epg-status-IMPORT_PROBLEM (process string)
1267   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1268       (epg-context-set-result-for
1269        epg-context 'error
1270        (cons (cons 'import-problem
1271                    (append (list (cons 'reason
1272                                        (string-to-number
1273                                         (match-string 1 string))))
1274                            (if (match-beginning 2)
1275                                (list (cons 'fingerprint
1276                                            (match-string 3 string))))))
1277              (epg-context-result-for epg-context 'error)))))
1278
1279 (defun epg-passphrase-callback-function (context key-id handback)
1280   (if (eq key-id 'SYM)
1281       (read-passwd "Passphrase for symmetric encryption: "
1282                    (eq (epg-context-operation context) 'encrypt))
1283     (read-passwd
1284      (if (eq key-id 'PIN)
1285         "Passphrase for PIN: "
1286        (let ((entry (assoc key-id epg-user-id-alist)))
1287          (if entry
1288              (format "Passphrase for %s %s: " key-id (cdr entry))
1289            (format "Passphrase for %s: " key-id)))))))
1290
1291 (defun epg-progress-callback-function (context what char current total
1292                                                handback)
1293   (message "%s: %d%%/%d%%" what current total))
1294
1295 (defun epg-configuration ()
1296   "Return a list of internal configuration parameters of `epg-gpg-program'."
1297   (let (config type)
1298     (with-temp-buffer
1299       (apply #'call-process epg-gpg-program nil (list t nil) nil
1300              '("--with-colons" "--list-config"))
1301       (goto-char (point-min))
1302       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
1303         (setq type (intern (match-string 1))
1304               config (cons (cons type
1305                                  (if (memq type
1306                                            '(pubkey cipher digest compress))
1307                                      (mapcar #'string-to-number
1308                                              (delete "" (split-string
1309                                                          (match-string 2)
1310                                                          ";")))
1311                                    (match-string 2)))
1312                            config))))
1313     config))
1314
1315 (defun epg-list-keys-1 (context name mode)
1316   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
1317                             "--with-fingerprint"
1318                             "--with-fingerprint"
1319                             (if (memq mode '(t secret))
1320                                 "--list-secret-keys"
1321                               (if (memq mode '(nil public))
1322                                   "--list-keys"
1323                                 "--list-sigs")))
1324                       (unless (eq (epg-context-protocol context) 'CMS)
1325                         '("--fixed-list-mode"))
1326                       (if name (list name))))
1327         keys string field index)
1328     (with-temp-buffer
1329       (apply #'call-process
1330              (if (eq (epg-context-protocol context) 'CMS)
1331                  epg-gpgsm-program
1332                epg-gpg-program)
1333              nil (list t nil) nil args)
1334       (goto-char (point-min))
1335       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1336         (setq keys (cons (make-vector 15 nil) keys)
1337               string (match-string 0)
1338               index 0
1339               field 0)
1340         (while (eq index
1341                    (string-match "\\([^:]+\\)?:" string index))
1342           (setq index (match-end 0))
1343           (aset (car keys) field (match-string 1 string))
1344           (setq field (1+ field))))
1345       (nreverse keys))))
1346
1347 (defun epg-make-sub-key-1 (line)
1348   (epg-make-sub-key
1349    (if (aref line 1)
1350        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1351    (delq nil
1352          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
1353                  (aref line 11)))
1354    (member (aref line 0) '("sec" "ssb"))
1355    (string-to-number (aref line 3))
1356    (string-to-number (aref line 2))
1357    (aref line 4)
1358    (aref line 5)
1359    (aref line 6)))
1360
1361 ;;;###autoload
1362 (defun epg-list-keys (context &optional name mode)
1363   "Return a list of epg-key objects matched with NAME.
1364 If MODE is nil or 'public, only public keyring should be searched.
1365 If MODE is t or 'secret, only secret keyring should be searched. 
1366 Otherwise, only public keyring should be searched and the key
1367 signatures should be included."
1368   (let ((lines (epg-list-keys-1 context name mode))
1369         keys cert pointer pointer-1)
1370     (while lines
1371       (cond
1372        ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1373         (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1374               keys (cons (epg-make-key
1375                           (if (aref (car lines) 8)
1376                               (cdr (assq (string-to-char (aref (car lines) 8))
1377                                          epg-key-validity-alist))))
1378                          keys))
1379         (epg-key-set-sub-key-list
1380          (car keys)
1381          (cons (epg-make-sub-key-1 (car lines))
1382                (epg-key-sub-key-list (car keys)))))
1383        ((member (aref (car lines) 0) '("sub" "ssb"))
1384         (epg-key-set-sub-key-list
1385          (car keys)
1386          (cons (epg-make-sub-key-1 (car lines))
1387                (epg-key-sub-key-list (car keys)))))
1388        ((equal (aref (car lines) 0) "uid")
1389         (epg-key-set-user-id-list
1390          (car keys)
1391          (cons (epg-make-user-id
1392                 (if (aref (car lines) 1)
1393                     (cdr (assq (string-to-char (aref (car lines) 1))
1394                                epg-key-validity-alist)))
1395                 (if cert
1396                     (condition-case nil
1397                         (epg-dn-from-string (aref (car lines) 9))
1398                       (error (aref (car lines) 9)))
1399                   (aref (car lines) 9)))
1400                (epg-key-user-id-list (car keys)))))
1401        ((equal (aref (car lines) 0) "fpr")
1402         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
1403                                      (aref (car lines) 9)))
1404        ((equal (aref (car lines) 0) "sig")
1405         (epg-user-id-set-signature-list
1406          (car (epg-key-user-id-list (car keys)))
1407          (cons
1408           (epg-make-key-signature
1409            (if (aref (car lines) 1)
1410                (cdr (assq (string-to-char (aref (car lines) 1))
1411                           epg-key-validity-alist)))
1412            (string-to-number (aref (car lines) 3))
1413            (aref (car lines) 4)
1414            (aref (car lines) 5)
1415            (aref (car lines) 6)
1416            (aref (car lines) 9)
1417            (string-to-number (aref (car lines) 10) 16)
1418            (eq (aref (aref (car lines) 10) 2) ?x))
1419           (epg-user-id-signature-list
1420            (car (epg-key-user-id-list (car keys))))))))
1421       (setq lines (cdr lines)))
1422     (setq keys (nreverse keys)
1423           pointer keys)
1424     (while pointer
1425       (epg-key-set-sub-key-list
1426        (car pointer)
1427        (nreverse (epg-key-sub-key-list (car pointer))))
1428       (setq pointer-1 (epg-key-set-user-id-list
1429                           (car pointer)
1430                           (nreverse (epg-key-user-id-list (car pointer)))))
1431       (while pointer-1
1432         (epg-user-id-set-signature-list
1433          (car pointer-1)
1434          (nreverse (epg-user-id-signature-list (car pointer-1))))
1435         (setq pointer-1 (cdr pointer-1)))
1436       (setq pointer (cdr pointer)))
1437     keys))
1438
1439 (if (fboundp 'make-temp-file)
1440     (defalias 'epg-make-temp-file 'make-temp-file)
1441   (defvar temporary-file-directory)
1442   ;; stolen from poe.el.
1443   (defun epg-make-temp-file (prefix)
1444     "Create a temporary file.
1445 The returned file name (created by appending some random characters at the end
1446 of PREFIX, and expanding against `temporary-file-directory' if necessary),
1447 is guaranteed to point to a newly created empty file.
1448 You can then use `write-region' to write new data into the file."
1449     (let (tempdir tempfile)
1450       (setq prefix (expand-file-name prefix
1451                                      (if (featurep 'xemacs)
1452                                          (temp-directory)
1453                                        temporary-file-directory)))
1454       (unwind-protect
1455           (let (file)
1456             ;; First, create a temporary directory.
1457             (while (condition-case ()
1458                        (progn
1459                          (setq tempdir (make-temp-name
1460                                         (concat
1461                                          (file-name-directory prefix)
1462                                          "DIR")))
1463                          ;; return nil or signal an error.
1464                          (make-directory tempdir))
1465                      ;; let's try again.
1466                      (file-already-exists t)))
1467             (set-file-modes tempdir 448)
1468             ;; Second, create a temporary file in the tempdir.
1469             ;; There *is* a race condition between `make-temp-name'
1470             ;; and `write-region', but we don't care it since we are
1471             ;; in a private directory now.
1472             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1473             (write-region "" nil tempfile nil 'silent)
1474             (set-file-modes tempfile 384)
1475             ;; Finally, make a hard-link from the tempfile.
1476             (while (condition-case ()
1477                        (progn
1478                          (setq file (make-temp-name prefix))
1479                          ;; return nil or signal an error.
1480                          (add-name-to-file tempfile file))
1481                      ;; let's try again.
1482                      (file-already-exists t)))
1483             file)
1484         ;; Cleanup the tempfile.
1485         (and tempfile
1486              (file-exists-p tempfile)
1487              (delete-file tempfile))
1488         ;; Cleanup the tempdir.
1489         (and tempdir
1490              (file-directory-p tempdir)
1491              (delete-directory tempdir))))))
1492
1493 ;;;###autoload
1494 (defun epg-cancel (context)
1495   (if (buffer-live-p (process-buffer (epg-context-process context)))
1496       (save-excursion
1497         (set-buffer (process-buffer (epg-context-process context)))
1498         (epg-context-set-result-for
1499          epg-context 'error
1500          (cons '(quit)
1501                (epg-context-result-for epg-context 'error)))))
1502   (if (eq (process-status (epg-context-process context)) 'run)
1503       (delete-process (epg-context-process context))))
1504   
1505 ;;;###autoload
1506 (defun epg-start-decrypt (context cipher)
1507   "Initiate a decrypt operation on CIPHER.
1508 CIPHER is a data object.
1509
1510 If you use this function, you will need to wait for the completion of
1511 `epg-gpg-program' by using `epg-wait-for-completion' and call
1512 `epg-reset' to clear a temporaly output file.
1513 If you are unsure, use synchronous version of this function
1514 `epg-decrypt-file' or `epg-decrypt-string' instead."
1515   (unless (epg-data-file cipher)
1516     (error "Not a file"))
1517   (epg-context-set-operation context 'decrypt)
1518   (epg-context-set-result context nil)
1519   (epg-start context (list "--decrypt" (epg-data-file cipher)))
1520   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1521   (unless (eq (epg-context-protocol context) 'CMS)
1522     (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1523
1524 ;;;###autoload
1525 (defun epg-decrypt-file (context cipher plain)
1526   "Decrypt a file CIPHER and store the result to a file PLAIN.
1527 If PLAIN is nil, it returns the result as a string."
1528   (unwind-protect
1529       (progn
1530         (if plain
1531             (epg-context-set-output-file context plain)
1532           (epg-context-set-output-file context
1533                                        (epg-make-temp-file "epg-output")))
1534         (epg-start-decrypt context (epg-make-data-from-file cipher))
1535         (epg-wait-for-completion context)
1536         (if (epg-context-result-for context 'error)
1537             (error "Decrypt failed: %S"
1538                    (epg-context-result-for context 'error)))
1539         (unless plain
1540           (epg-read-output context)))
1541     (unless plain
1542       (epg-delete-output-file context))
1543     (epg-reset context)))
1544
1545 ;;;###autoload
1546 (defun epg-decrypt-string (context cipher)
1547   "Decrypt a string CIPHER and return the plain text."
1548   (let ((input-file (epg-make-temp-file "epg-input"))
1549         (coding-system-for-write 'binary))
1550     (unwind-protect
1551         (progn
1552           (write-region cipher nil input-file nil 'quiet)
1553           (epg-context-set-output-file context
1554                                        (epg-make-temp-file "epg-output"))
1555           (epg-start-decrypt context (epg-make-data-from-file input-file))
1556           (epg-wait-for-completion context)
1557           (if (epg-context-result-for context 'error)
1558               (error "Decrypt failed: %S"
1559                      (epg-context-result-for context 'error)))
1560           (epg-read-output context))
1561       (epg-delete-output-file context)
1562       (if (file-exists-p input-file)
1563           (delete-file input-file))
1564       (epg-reset context))))
1565
1566 ;;;###autoload
1567 (defun epg-start-verify (context signature &optional signed-text)
1568   "Initiate a verify operation on SIGNATURE.
1569 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
1570
1571 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
1572 For a normal or a clear text signature, SIGNED-TEXT should be nil.
1573
1574 If you use this function, you will need to wait for the completion of
1575 `epg-gpg-program' by using `epg-wait-for-completion' and call
1576 `epg-reset' to clear a temporaly output file.
1577 If you are unsure, use synchronous version of this function
1578 `epg-verify-file' or `epg-verify-string' instead."
1579   (epg-context-set-operation context 'verify)
1580   (epg-context-set-result context nil)
1581   (if signed-text
1582       ;; Detached signature.
1583       (if (epg-data-file signed-text)
1584           (epg-start context (list "--verify" (epg-data-file signature)
1585                                    (epg-data-file signed-text)))
1586         (epg-start context (list "--verify" (epg-data-file signature) "-"))
1587         (if (eq (process-status (epg-context-process context)) 'run)
1588             (process-send-string (epg-context-process context)
1589                                  (epg-data-string signed-text)))
1590         (if (eq (process-status (epg-context-process context)) 'run)
1591             (process-send-eof (epg-context-process context))))
1592     ;; Normal (or cleartext) signature.
1593     (if (epg-data-file signature)
1594         (epg-start context (list "--verify" (epg-data-file signature)))
1595       (epg-start context (list "--verify"))
1596       (if (eq (process-status (epg-context-process context)) 'run)
1597           (process-send-string (epg-context-process context)
1598                                (epg-data-string signature)))
1599       (if (eq (process-status (epg-context-process context)) 'run)
1600           (process-send-eof (epg-context-process context))))))
1601
1602 ;;;###autoload
1603 (defun epg-verify-file (context signature &optional signed-text plain)
1604   "Verify a file SIGNATURE.
1605 SIGNED-TEXT and PLAIN are also a file if they are specified.
1606
1607 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1608 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1609   (unwind-protect
1610       (progn
1611         (if plain
1612             (epg-context-set-output-file context plain)
1613           (epg-context-set-output-file context
1614                                        (epg-make-temp-file "epg-output")))
1615         (if signed-text
1616             (epg-start-verify context
1617                               (epg-make-data-from-file signature)
1618                               (epg-make-data-from-file signed-text))
1619           (epg-start-verify context
1620                             (epg-make-data-from-file signature)))
1621         (epg-wait-for-completion context)
1622 ;       (if (epg-context-result-for context 'error)
1623 ;           (error "Verify failed: %S"
1624 ;                  (epg-context-result-for context 'error)))
1625         (unless plain
1626           (epg-read-output context)))
1627     (unless plain
1628       (epg-delete-output-file context))
1629     (epg-reset context)))
1630
1631 ;;;###autoload
1632 (defun epg-verify-string (context signature &optional signed-text)
1633   "Verify a string SIGNATURE.
1634 SIGNED-TEXT is a string if it is specified.
1635
1636 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1637 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1638   (let ((coding-system-for-write 'binary)
1639         input-file)
1640     (unwind-protect
1641         (progn
1642           (epg-context-set-output-file context
1643                                        (epg-make-temp-file "epg-output"))
1644           (if signed-text
1645               (progn
1646                 (setq input-file (epg-make-temp-file "epg-signature"))
1647                 (write-region signature nil input-file nil 'quiet)
1648                 (epg-start-verify context
1649                                   (epg-make-data-from-file input-file)
1650                                   (epg-make-data-from-string signed-text)))
1651             (epg-start-verify context (epg-make-data-from-string signature)))
1652           (epg-wait-for-completion context)
1653 ;         (if (epg-context-result-for context 'error)
1654 ;             (error "Verify failed: %S"
1655 ;                    (epg-context-result-for context 'error)))
1656           (epg-read-output context))
1657       (epg-delete-output-file context)
1658       (if (and input-file
1659                (file-exists-p input-file))
1660           (delete-file input-file))
1661       (epg-reset context))))
1662
1663 ;;;###autoload
1664 (defun epg-start-sign (context plain &optional mode)
1665   "Initiate a sign operation on PLAIN.
1666 PLAIN is a data object.
1667
1668 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1669 If it is nil or 'normal, it makes a normal signature.
1670 Otherwise, it makes a clear text signature.
1671
1672 If you use this function, you will need to wait for the completion of
1673 `epg-gpg-program' by using `epg-wait-for-completion' and call
1674 `epg-reset' to clear a temporaly output file.
1675 If you are unsure, use synchronous version of this function
1676 `epg-sign-file' or `epg-sign-string' instead."
1677   (epg-context-set-operation context 'sign)
1678   (epg-context-set-result context nil)
1679   (epg-start context
1680              (append (list (if (memq mode '(t detached))
1681                                "--detach-sign"
1682                              (if (memq mode '(nil normal))
1683                                  "--sign"
1684                                "--clearsign")))
1685                      (apply #'nconc
1686                             (mapcar
1687                              (lambda (signer)
1688                                (list "-u"
1689                                      (epg-sub-key-id
1690                                       (car (epg-key-sub-key-list signer)))))
1691                              (epg-context-signers context)))
1692                      (if (epg-data-file plain)
1693                          (list (epg-data-file plain)))))
1694   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1695   (unless (eq (epg-context-protocol context) 'CMS)
1696     (epg-wait-for-status context '("BEGIN_SIGNING")))
1697   (when (epg-data-string plain)
1698     (if (eq (process-status (epg-context-process context)) 'run)
1699         (process-send-string (epg-context-process context)
1700                              (epg-data-string plain)))
1701     (if (eq (process-status (epg-context-process context)) 'run)
1702         (process-send-eof (epg-context-process context)))))
1703
1704 ;;;###autoload
1705 (defun epg-sign-file (context plain signature &optional mode)
1706   "Sign a file PLAIN and store the result to a file SIGNATURE.
1707 If SIGNATURE is nil, it returns the result as a string.
1708 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1709 If it is nil or 'normal, it makes a normal signature.
1710 Otherwise, it makes a clear text signature."
1711   (unwind-protect
1712       (progn
1713         (if signature
1714             (epg-context-set-output-file context signature)
1715           (epg-context-set-output-file context
1716                                        (epg-make-temp-file "epg-output")))
1717         (epg-start-sign context (epg-make-data-from-file plain) mode)
1718         (epg-wait-for-completion context)
1719         (unless (epg-context-result-for context 'sign)
1720           (if (epg-context-result-for context 'error)
1721               (error "Sign failed: %S"
1722                      (epg-context-result-for context 'error))
1723             (error "Sign failed")))
1724         (unless signature
1725           (epg-read-output context)))
1726     (unless signature
1727       (epg-delete-output-file context))
1728     (epg-reset context)))
1729
1730 ;;;###autoload
1731 (defun epg-sign-string (context plain &optional mode)
1732   "Sign a string PLAIN and return the output as string.
1733 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1734 If it is nil or 'normal, it makes a normal signature.
1735 Otherwise, it makes a clear text signature."
1736   (unwind-protect
1737       (progn
1738         (epg-context-set-output-file context
1739                                      (epg-make-temp-file "epg-output"))
1740         (epg-start-sign context (epg-make-data-from-string plain) mode)
1741         (epg-wait-for-completion context)
1742         (unless (epg-context-result-for context 'sign)
1743           (if (epg-context-result-for context 'error)
1744               (error "Sign failed: %S"
1745                      (epg-context-result-for context 'error))
1746             (error "Sign failed")))
1747         (epg-read-output context))
1748     (epg-delete-output-file context)
1749     (epg-reset context)))
1750
1751 ;;;###autoload
1752 (defun epg-start-encrypt (context plain recipients
1753                                   &optional sign always-trust)
1754   "Initiate an encrypt operation on PLAIN.
1755 PLAIN is a data object.
1756 If RECIPIENTS is nil, it performs symmetric encryption.
1757
1758 If you use this function, you will need to wait for the completion of
1759 `epg-gpg-program' by using `epg-wait-for-completion' and call
1760 `epg-reset' to clear a temporaly output file.
1761 If you are unsure, use synchronous version of this function
1762 `epg-encrypt-file' or `epg-encrypt-string' instead."
1763   (epg-context-set-operation context 'encrypt)
1764   (epg-context-set-result context nil)
1765   (epg-start context
1766              (append (if always-trust '("--always-trust"))
1767                      (if recipients '("--encrypt") '("--symmetric"))
1768                      (if sign
1769                          (cons "--sign"
1770                                (apply #'nconc
1771                                       (mapcar (lambda (signer)
1772                                                 (list "-u" signer))
1773                                               (epg-context-signers context)))))
1774                      (apply #'nconc
1775                             (mapcar
1776                              (lambda (recipient)
1777                                (list "-r"
1778                                      (epg-sub-key-id
1779                                       (car (epg-key-sub-key-list recipient)))))
1780                              recipients))
1781                      (if (epg-data-file plain)
1782                          (list (epg-data-file plain)))))
1783   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1784   (unless (eq (epg-context-protocol context) 'CMS)
1785     (if sign
1786         (epg-wait-for-status context '("BEGIN_SIGNING"))
1787       (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
1788   (when (epg-data-string plain)
1789     (if (eq (process-status (epg-context-process context)) 'run)
1790         (process-send-string (epg-context-process context)
1791                              (epg-data-string plain)))
1792     (if (eq (process-status (epg-context-process context)) 'run)
1793         (process-send-eof (epg-context-process context)))))
1794
1795 ;;;###autoload
1796 (defun epg-encrypt-file (context plain recipients
1797                                  cipher &optional sign always-trust)
1798   "Encrypt a file PLAIN and store the result to a file CIPHER.
1799 If CIPHER is nil, it returns the result as a string.
1800 If RECIPIENTS is nil, it performs symmetric encryption."
1801   (unwind-protect
1802       (progn
1803         (if cipher
1804             (epg-context-set-output-file context cipher)
1805           (epg-context-set-output-file context
1806                                        (epg-make-temp-file "epg-output")))
1807         (epg-start-encrypt context (epg-make-data-from-file plain)
1808                            recipients sign always-trust)
1809         (epg-wait-for-completion context)
1810         (if (and sign
1811                  (not (epg-context-result-for context 'sign)))
1812             (if (epg-context-result-for context 'error)
1813                 (error "Sign failed: %S"
1814                        (epg-context-result-for context 'error))
1815                 (error "Sign failed")))
1816         (if (epg-context-result-for context 'error)
1817             (error "Encrypt failed: %S"
1818                    (epg-context-result-for context 'error)))
1819         (unless cipher
1820           (epg-read-output context)))
1821     (unless cipher
1822       (epg-delete-output-file context))
1823     (epg-reset context)))
1824
1825 ;;;###autoload
1826 (defun epg-encrypt-string (context plain recipients
1827                                    &optional sign always-trust)
1828   "Encrypt a string PLAIN.
1829 If RECIPIENTS is nil, it performs symmetric encryption."
1830   (unwind-protect
1831       (progn
1832         (epg-context-set-output-file context
1833                                      (epg-make-temp-file "epg-output"))
1834         (epg-start-encrypt context (epg-make-data-from-string plain)
1835                            recipients sign always-trust)
1836         (epg-wait-for-completion context)
1837         (if (and sign
1838                  (not (epg-context-result-for context 'sign)))
1839             (if (epg-context-result-for context 'error)
1840                 (error "Sign failed: %S"
1841                        (epg-context-result-for context 'error))
1842               (error "Sign failed")))
1843         (if (epg-context-result-for context 'error)
1844             (error "Encrypt failed: %S"
1845                    (epg-context-result-for context 'error)))
1846         (epg-read-output context))
1847     (epg-delete-output-file context)
1848     (epg-reset context)))
1849
1850 ;;;###autoload
1851 (defun epg-start-export-keys (context keys)
1852   "Initiate an export keys operation.
1853
1854 If you use this function, you will need to wait for the completion of
1855 `epg-gpg-program' by using `epg-wait-for-completion' and call
1856 `epg-reset' to clear a temporaly output file.
1857 If you are unsure, use synchronous version of this function
1858 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
1859   (epg-context-set-operation context 'export-keys)
1860   (epg-context-set-result context nil)
1861   (epg-start context (cons "--export"
1862                            (mapcar
1863                             (lambda (key)
1864                               (epg-sub-key-id
1865                                (car (epg-key-sub-key-list key))))
1866                             keys))))
1867
1868 ;;;###autoload
1869 (defun epg-export-keys-to-file (context keys file)
1870   "Extract public KEYS."
1871   (unwind-protect
1872       (progn
1873         (if keys
1874             (epg-context-set-output-file context file)
1875           (epg-context-set-output-file context
1876                                        (epg-make-temp-file "epg-output")))
1877         (epg-start-export-keys context keys)
1878         (epg-wait-for-completion context)
1879         (if (epg-context-result-for context 'error)
1880             (error "Export keys failed: %S"
1881                    (epg-context-result-for context 'error)))
1882         (unless file
1883           (epg-read-output context)))
1884     (unless file
1885       (epg-delete-output-file context))
1886     (epg-reset context)))
1887
1888 ;;;###autoload
1889 (defun epg-export-keys-to-string (context keys)
1890   "Extract public KEYS and return them as a string."
1891   (epg-export-keys-to-file context keys nil))
1892
1893 ;;;###autoload
1894 (defun epg-start-import-keys (context keys)
1895   "Initiate an import keys operation.
1896 KEYS is a data object.
1897
1898 If you use this function, you will need to wait for the completion of
1899 `epg-gpg-program' by using `epg-wait-for-completion' and call
1900 `epg-reset' to clear a temporaly output file.
1901 If you are unsure, use synchronous version of this function
1902 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1903   (epg-context-set-operation context 'import-keys)
1904   (epg-context-set-result context nil)
1905   (epg-start context (list "--import" (epg-data-file keys)))
1906   (when (epg-data-string keys)
1907     (if (eq (process-status (epg-context-process context)) 'run)
1908         (process-send-string (epg-context-process context)
1909                              (epg-data-string keys)))
1910     (if (eq (process-status (epg-context-process context)) 'run)
1911         (process-send-eof (epg-context-process context)))))
1912
1913 (defun epg-import-keys-1 (context keys)
1914   (unwind-protect
1915       (progn
1916         (epg-start-import-keys context keys)
1917         (epg-wait-for-completion context)
1918         (if (epg-context-result-for context 'error)
1919             (error "Import keys failed: %S"
1920                    (epg-context-result-for context 'error))))
1921     (epg-reset context)))
1922
1923 ;;;###autoload
1924 (defun epg-import-keys-from-file (context keys)
1925   "Add keys from a file KEYS."
1926   (epg-import-keys-1 context (epg-make-data-from-file keys)))
1927
1928 ;;;###autoload
1929 (defun epg-import-keys-from-string (context keys)
1930   "Add keys from a string KEYS."
1931   (epg-import-keys-1 context (epg-make-data-from-string keys)))
1932
1933 ;;;###autoload
1934 (defun epg-start-receive-keys (context key-id-list)
1935   "Initiate a receive key operation.
1936 KEY-ID-LIST is a list of key IDs.
1937
1938 If you use this function, you will need to wait for the completion of
1939 `epg-gpg-program' by using `epg-wait-for-completion' and call
1940 `epg-reset' to clear a temporaly output file.
1941 If you are unsure, use synchronous version of this function
1942 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
1943   (epg-context-set-operation context 'receive-keys)
1944   (epg-context-set-result context nil)
1945   (epg-start context (cons "--recv-keys" key-id-list)))
1946
1947 ;;;###autoload
1948 (defun epg-receive-keys (context keys)
1949   "Add keys from server.
1950 KEYS is a list of key IDs"
1951   (unwind-protect
1952       (progn
1953         (epg-start-receive-keys context keys)
1954         (epg-wait-for-completion context)
1955         (if (epg-context-result-for context 'error)
1956             (error "Receive keys failed: %S"
1957                    (epg-context-result-for context 'error))))
1958     (epg-reset context)))
1959
1960 ;;;###autoload
1961 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
1962
1963 ;;;###autoload
1964 (defun epg-start-delete-keys (context keys &optional allow-secret)
1965   "Initiate an delete keys operation.
1966
1967 If you use this function, you will need to wait for the completion of
1968 `epg-gpg-program' by using `epg-wait-for-completion' and call
1969 `epg-reset' to clear a temporaly output file.
1970 If you are unsure, use synchronous version of this function
1971 `epg-delete-keys' instead."
1972   (epg-context-set-operation context 'delete-keys)
1973   (epg-context-set-result context nil)
1974   (epg-start context (cons (if allow-secret
1975                                "--delete-secret-key"
1976                              "--delete-key")
1977                            (mapcar
1978                             (lambda (key)
1979                               (epg-sub-key-id
1980                                (car (epg-key-sub-key-list key))))
1981                             keys))))
1982
1983 ;;;###autoload
1984 (defun epg-delete-keys (context keys &optional allow-secret)
1985   "Delete KEYS from the key ring."
1986   (unwind-protect
1987       (progn
1988         (epg-start-delete-keys context keys allow-secret)
1989         (epg-wait-for-completion context)
1990         (if (epg-context-result-for context 'error)
1991             (error "Delete keys failed: %S"
1992                    (epg-context-result-for context 'error))))
1993     (epg-reset context)))
1994
1995 ;;;###autoload
1996 (defun epg-start-sign-keys (context keys &optional local)
1997   "Initiate an sign keys operation.
1998
1999 If you use this function, you will need to wait for the completion of
2000 `epg-gpg-program' by using `epg-wait-for-completion' and call
2001 `epg-reset' to clear a temporaly output file.
2002 If you are unsure, use synchronous version of this function
2003 `epg-sign-keys' instead."
2004   (epg-context-set-operation context 'sign-keys)
2005   (epg-context-set-result context nil)
2006   (epg-start context (cons (if local
2007                                "--lsign-key"
2008                              "--sign-key")
2009                            (mapcar
2010                             (lambda (key)
2011                               (epg-sub-key-id
2012                                (car (epg-key-sub-key-list key))))
2013                             keys))))
2014
2015 ;;;###autoload
2016 (defun epg-sign-keys (context keys &optional local)
2017   "Sign KEYS from the key ring."
2018   (unwind-protect
2019       (progn
2020         (epg-start-sign-keys context keys local)
2021         (epg-wait-for-completion context)
2022         (if (epg-context-result-for context 'error)
2023             (error "Sign keys failed: %S"
2024                    (epg-context-result-for context 'error))))
2025     (epg-reset context)))
2026
2027 ;;;###autoload
2028 (defun epg-start-generate-key (context parameters)
2029   "Initiate a key generation.
2030 PARAMETERS specifies parameters for the key.
2031
2032 If you use this function, you will need to wait for the completion of
2033 `epg-gpg-program' by using `epg-wait-for-completion' and call
2034 `epg-reset' to clear a temporaly output file.
2035 If you are unsure, use synchronous version of this function
2036 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2037   (epg-context-set-operation context 'generate-key)
2038   (epg-context-set-result context nil)
2039   (if (epg-data-file parameters)
2040       (epg-start context (list "--batch" "--genkey"
2041                                (epg-data-file parameters)))
2042     (epg-start context '("--batch" "--genkey"))
2043     (if (eq (process-status (epg-context-process context)) 'run)
2044         (process-send-string (epg-context-process context)
2045                              (epg-data-string parameters)))
2046     (if (eq (process-status (epg-context-process context)) 'run)
2047         (process-send-eof (epg-context-process context)))))
2048
2049 ;;;###autoload
2050 (defun epg-generate-key-from-file (context parameters)
2051   "Generate a new key pair.
2052 PARAMETERS is a file which tells how to create the key."
2053   (unwind-protect
2054       (progn
2055         (epg-start-generate-key context (epg-make-data-from-file parameters))
2056         (epg-wait-for-completion context)
2057         (if (epg-context-result-for context 'error)
2058             (error "Generate key failed: %S"
2059                    (epg-context-result-for context 'error))))
2060     (epg-reset context)))
2061
2062 ;;;###autoload
2063 (defun epg-generate-key-from-string (context parameters)
2064   "Generate a new key pair.
2065 PARAMETERS is a string which tells how to create the key."
2066   (unwind-protect
2067       (progn
2068         (epg-start-generate-key context (epg-make-data-from-string parameters))
2069         (epg-wait-for-completion context)
2070         (if (epg-context-result-for context 'error)
2071             (error "Generate key failed: %S"
2072                    (epg-context-result-for context 'error))))
2073     (epg-reset context)))
2074
2075 (defun epg-decode-hexstring (string)
2076   (let ((index 0))
2077     (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2078       (setq string (replace-match "\\x\\&" t nil string)
2079             index (+ index 4)))
2080     (car (read-from-string (concat "\"" string "\"")))))
2081
2082 (defun epg-decode-quotedstring (string)
2083   (let ((index 0))
2084     (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2085 \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\|\\(.\\)\\)"
2086                          string index)
2087       (if (match-beginning 2)
2088           (setq string (replace-match "\\2" t nil string)
2089                 index (1+ index))
2090         (if (match-beginning 3)
2091             (setq string (replace-match "\\x\\3" t nil string)
2092                   index (+ index 4))
2093           (setq string (replace-match "\\\\\\\\\\4" t nil string)
2094                 index (+ index 3)))))
2095     (car (read-from-string (concat "\"" string "\"")))))
2096
2097 (defun epg-dn-from-string (string)
2098   "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2099 The return value is an alist mapping from types to values."
2100   (let ((index 0)
2101         (length (length string))
2102         alist type value group)
2103     (while (< index length)
2104       (if (eq index (string-match "[ \t\n\r]*" string index))
2105           (setq index (match-end 0)))
2106       (if (eq index (string-match
2107                      "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
2108                      string index))
2109           (setq type (match-string 1 string)
2110                 index (match-end 0))
2111         (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2112                                     string index))
2113             (setq type (match-string 1 string)
2114                   index (match-end 0))))
2115       (unless type
2116         (error "Invalid type"))
2117       (if (eq index (string-match
2118                      "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2119                      string index))
2120           (setq index (match-end 0)
2121                 value (epg-decode-quotedstring (match-string 0 string)))
2122         (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2123             (setq index (match-end 0)
2124                   value (epg-decode-hexstring (match-string 1 string)))
2125           (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2126                                       string index))
2127               (setq index (match-end 0)
2128                     value (epg-decode-quotedstring (match-string 0 string))))))
2129       (if group
2130           (if (stringp (car (car alist)))
2131               (setcar alist (list (cons type value) (car alist)))
2132             (setcar alist (cons (cons type value) (car alist))))
2133         (if (consp (car (car alist)))
2134             (setcar alist (nreverse (car alist))))
2135         (setq alist (cons (cons type value) alist)
2136               type nil
2137               value nil))
2138       (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2139           (setq index (match-end 0)
2140                 group (eq (aref string (match-beginning 1)) ?+))))
2141     (nreverse alist)))
2142
2143 (defun epg-decode-dn (alist)
2144   "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2145 Type names are resolved using `epg-dn-type-alist'."
2146   (mapconcat
2147    (lambda (rdn)
2148      (if (stringp (car rdn))
2149          (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2150            (if entry
2151                (format "%s=%s" (cdr entry) (cdr rdn))
2152              (format "%s=%s" (car rdn) (cdr rdn))))
2153        (concat "(" (epg-decode-dn rdn) ")")))
2154    alist
2155    ", "))
2156
2157 (provide 'epg)
2158
2159 ;;; epg.el ends here