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