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