843e4636d9d655f4edfb66ce0b2345d6ad7b3b3c
[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 (defconst epg-version-number "0.0.0")
37
38 (defvar epg-user-id nil
39   "GnuPG ID of your default identity.")
40
41 (defvar epg-user-id-alist nil
42   "An alist mapping from key ID to user ID.")
43
44 (defvar epg-read-point nil)
45 (defvar epg-pending-status-list nil)
46 (defvar epg-key-id nil)
47 (defvar epg-context nil)
48 (defvar epg-debug nil)
49 (defvar epg-debug-buffer nil)
50
51 ;; from gnupg/include/cipher.h
52 (defconst epg-cipher-algorithm-alist
53   '((0 . "NONE")
54     (1 . "IDEA")
55     (2 . "3DES")
56     (3 . "CAST5")
57     (4 . "BLOWFISH")
58     (7 . "AES")
59     (8 . "AES192")
60     (9 . "AES256")
61     (10 . "TWOFISH")
62     (110 . "DUMMY")))
63
64 ;; from gnupg/include/cipher.h
65 (defconst epg-pubkey-algorithm-alist
66   '((1 . "RSA")
67     (2 . "RSA_E")
68     (3 . "RSA_S")
69     (16 . "ELGAMAL_E")
70     (17 . "DSA")
71     (20 . "ELGAMAL")))
72
73 ;; from gnupg/include/cipher.h
74 (defconst epg-digest-algorithm-alist
75   '((1 . "MD5")
76     (2 . "SHA1")
77     (3 . "RMD160")
78     (8 . "SHA256")
79     (9 . "SHA384")
80     (10 . "SHA512")))
81
82 ;; from gnupg/include/cipher.h
83 (defconst epg-compress-algorithm-alist
84   '((0 . "NONE")
85     (1 . "ZIP")
86     (2 . "ZLIB")
87     (3 . "BZIP2")))
88
89 (defconst epg-invalid-recipients-alist
90   '((0 . "No specific reason given")
91     (1 . "Not Found")
92     (2 . "Ambigious specification")
93     (3 . "Wrong key usage")
94     (4 . "Key revoked")
95     (5 . "Key expired")
96     (6 . "No CRL known")
97     (7 . "CRL too old")
98     (8 . "Policy mismatch")
99     (9 . "Not a secret key")
100     (10 . "Key not trusted")))
101
102 (defconst epg-delete-problem-alist
103   '((1 . "No such key")
104     (2 . "Must delete secret key first")
105     (3 . "Ambigious specification")))
106
107 (defvar epg-key-validity-alist
108   '((?o . unknown)
109     (?i . invalid)
110     (?d . disabled)
111     (?r . revoked)
112     (?e . expired)
113     (?- . none)
114     (?q . undefined)
115     (?n . never)
116     (?m . marginal)
117     (?f . full)
118     (?u . ultimate)))
119
120 (defvar epg-key-capablity-alist
121   '((?e . encrypt)
122     (?s . sign)
123     (?c . certify)
124     (?a . authentication)))
125
126 (defvar epg-prompt-alist nil)
127
128 (defun epg-make-data-from-file (file)
129   "Make a data object from FILE."
130   (vector file nil))
131
132 (defun epg-make-data-from-string (string)
133   "Make a data object from STRING."
134   (vector nil string))
135
136 (defun epg-data-file (data)
137   "Return the file of DATA."
138   (aref data 0))
139
140 (defun epg-data-string (data)
141   "Return the string of DATA."
142   (aref data 1))
143
144 (defun epg-make-context (&optional protocol armor textmode include-certs
145                                    cipher-algorithm digest-algorithm
146                                    compress-algorithm)
147   "Return a context object."
148   (vector protocol armor textmode include-certs
149           cipher-algorithm digest-algorithm compress-algorithm
150           #'epg-passphrase-callback-function
151           #'epg-progress-callback-function
152           nil nil nil nil))
153
154 (defun epg-context-protocol (context)
155   "Return the protocol used within CONTEXT."
156   (aref context 0))
157
158 (defun epg-context-armor (context)
159   "Return t if the output shouled be ASCII armored in CONTEXT."
160   (aref context 1))
161
162 (defun epg-context-textmode (context)
163   "Return t if canonical text mode should be used in CONTEXT."
164   (aref context 2))
165
166 (defun epg-context-include-certs (context)
167   "Return how many certificates should be included in an S/MIME signed
168 message."
169   (aref context 3))
170
171 (defun epg-context-cipher-algorithm (context)
172   "Return the cipher algorithm in CONTEXT."
173   (aref context 4))
174
175 (defun epg-context-digest-algorithm (context)
176   "Return the digest algorithm in CONTEXT."
177   (aref context 5))
178
179 (defun epg-context-compress-algorithm (context)
180   "Return the compress algorithm in CONTEXT."
181   (aref context 6))
182
183 (defun epg-context-passphrase-callback (context)
184   "Return the function used to query passphrase."
185   (aref context 7))
186
187 (defun epg-context-progress-callback (context)
188   "Return the function which handles progress update."
189   (aref context 8))
190
191 (defun epg-context-signers (context)
192   "Return the list of key-id for singning."
193   (aref context 9))
194
195 (defun epg-context-process (context)
196   "Return the process object of `epg-gpg-program'.
197 This function is for internal use only."
198   (aref context 10))
199
200 (defun epg-context-output-file (context)
201   "Return the output file of `epg-gpg-program'.
202 This function is for internal use only."
203   (aref context 11))
204
205 (defun epg-context-result (context)
206   "Return the result of the previous cryptographic operation."
207   (aref context 12))
208
209 (defun epg-context-set-protocol (context protocol)
210   "Set the protocol used within CONTEXT."
211   (aset context 0 protocol))
212
213 (defun epg-context-set-armor (context armor)
214   "Specify if the output shouled be ASCII armored in CONTEXT."
215   (aset context 1 armor))
216
217 (defun epg-context-set-textmode (context textmode)
218   "Specify if canonical text mode should be used in CONTEXT."
219   (aset context 2 textmode))
220
221 (defun epg-context-set-include-certs (context include-certs)
222  "Set how many certificates should be included in an S/MIME signed message."
223   (aset context 3 include-certs))
224
225 (defun epg-context-set-cipher-algorithm (context cipher-algorithm)
226  "Set the cipher algorithm in CONTEXT."
227   (aset context 4 cipher-algorithm))
228
229 (defun epg-context-set-digest-algorithm (context digest-algorithm)
230  "Set the digest algorithm in CONTEXT."
231   (aset context 5 digest-algorithm))
232
233 (defun epg-context-set-compress-algorithm (context compress-algorithm)
234  "Set the compress algorithm in CONTEXT."
235   (aset context 6 compress-algorithm))
236
237 (defun epg-context-set-passphrase-callback (context
238                                                  passphrase-callback)
239   "Set the function used to query passphrase."
240   (aset context 7 passphrase-callback))
241
242 (defun epg-context-set-progress-callback (context progress-callback)
243   "Set the function which handles progress update."
244   (aset context 8 progress-callback))
245
246 (defun epg-context-set-signers (context signers)
247  "Set the list of key-id for singning."
248   (aset context 9 signers))
249
250 (defun epg-context-set-process (context process)
251   "Set the process object of `epg-gpg-program'.
252 This function is for internal use only."
253   (aset context 10 process))
254
255 (defun epg-context-set-output-file (context output-file)
256   "Set the output file of `epg-gpg-program'.
257 This function is for internal use only."
258   (aset context 11 output-file))
259
260 (defun epg-context-set-result (context result)
261   "Set the result of the previous cryptographic operation."
262   (aset context 12 result))
263
264 (defun epg-make-signature (status key-id user-id)
265   "Return a signature object."
266   (vector status key-id user-id nil nil))
267
268 (defun epg-signature-status (signature)
269   "Return the status code of SIGNATURE."
270   (aref signature 0))
271
272 (defun epg-signature-key-id (signature)
273   "Return the key-id of SIGNATURE."
274   (aref signature 1))
275
276 (defun epg-signature-user-id (signature)
277   "Return the user-id of SIGNATURE."
278   (aref signature 2))
279   
280 (defun epg-signature-validity (signature)
281   "Return the validity of SIGNATURE."
282   (aref signature 3))
283
284 (defun epg-signature-fingerprint (signature)
285   "Return the fingerprint of SIGNATURE."
286   (aref signature 4))
287
288 (defun epg-signature-set-status (signature status)
289  "Set the status code of SIGNATURE."
290   (aset signature 0 status))
291
292 (defun epg-signature-set-key-id (signature key-id)
293  "Set the key-id of SIGNATURE."
294   (aset signature 1 key-id))
295
296 (defun epg-signature-set-user-id (signature user-id)
297  "Set the user-id of SIGNATURE."
298   (aset signature 2 user-id))
299   
300 (defun epg-signature-set-validity (signature validity)
301  "Set the validity of SIGNATURE."
302   (aset signature 3 validity))
303
304 (defun epg-signature-set-fingerprint (signature fingerprint)
305  "Set the fingerprint of SIGNATURE."
306   (aset signature 4 fingerprint))
307
308 (defun epg-make-key (owner-trust)
309   "Return a key object."
310   (vector owner-trust nil nil))
311
312 (defun epg-key-owner-trust (key)
313   "Return the owner trust of KEY."
314   (aref key 0))
315
316 (defun epg-key-sub-key-list (key)
317   "Return the sub key list of KEY."
318   (aref key 1))
319
320 (defun epg-key-user-id-list (key)
321   "Return the user ID list of KEY."
322   (aref key 2))
323
324 (defun epg-key-set-sub-key-list (key sub-key-list)
325   "Set the sub key list of KEY."
326   (aset key 1 sub-key-list))
327
328 (defun epg-key-set-user-id-list (key user-id-list)
329   "Set the user ID list of KEY."
330   (aset key 2 user-id-list))
331
332 (defun epg-make-sub-key (validity capability secret algorithm length id
333                                   creation-time expiration-time)
334   "Return a sub key object."
335   (vector validity capability secret algorithm length id creation-time
336           expiration-time nil))
337
338 (defun epg-sub-key-validity (sub-key)
339   "Return the validity of SUB-KEY."
340   (aref sub-key 0))
341
342 (defun epg-sub-key-capability (sub-key)
343   "Return the capability of SUB-KEY."
344   (aref sub-key 1))
345
346 (defun epg-sub-key-secret (sub-key)
347   "Return non-nil if SUB-KEY is a secret key."
348   (aref sub-key 2))
349
350 (defun epg-sub-key-algorithm (sub-key)
351   "Return the algorithm of SUB-KEY."
352   (aref sub-key 3))
353
354 (defun epg-sub-key-length (sub-key)
355   "Return the length of SUB-KEY."
356   (aref sub-key 4))
357
358 (defun epg-sub-key-id (sub-key)
359   "Return the ID of SUB-KEY."
360   (aref sub-key 5))
361
362 (defun epg-sub-key-creation-time (sub-key)
363   "Return the creation time of SUB-KEY."
364   (aref sub-key 6))
365
366 (defun epg-sub-key-expiration-time (sub-key)
367   "Return the expiration time of SUB-KEY."
368   (aref sub-key 7))
369
370 (defun epg-sub-key-fingerprint (sub-key)
371   "Return the fingerprint of SUB-KEY."
372   (aref sub-key 8))
373
374 (defun epg-sub-key-set-fingerprint (sub-key fingerprint)
375   "Set the fingerprint of SUB-KEY.
376 This function is for internal use only."
377   (aset sub-key 8 fingerprint))
378
379 (defun epg-make-user-id (validity name)
380   "Return a user ID object."
381   (vector validity name nil))
382
383 (defun epg-user-id-validity (user-id)
384   "Return the validity of USER-ID."
385   (aref user-id 0))
386
387 (defun epg-user-id-name (user-id)
388   "Return the name of USER-ID."
389   (aref user-id 1))
390
391 (defun epg-user-id-signature-list (user-id)
392   "Return the signature list of USER-ID."
393   (aref user-id 2))
394
395 (defun epg-user-id-set-signature-list (user-id signature-list)
396   "Set the signature list of USER-ID."
397   (aset user-id 2 signature-list))
398
399 (defun epg-context-result-for (context name)
400   (cdr (assq name (epg-context-result context))))
401
402 (defun epg-context-set-result-for (context name value)
403   (let* ((result (epg-context-result context))
404          (entry (assq name result)))
405     (if entry
406         (setcdr entry value)
407       (epg-context-set-result context (cons (cons name value) result)))))
408
409 (defun epg-signature-to-string (signature)
410   (format "%s signature from %s %s%s"
411           (capitalize (symbol-name (epg-signature-status signature)))
412           (epg-signature-key-id signature)
413           (epg-signature-user-id signature)
414           (if (epg-signature-validity signature)
415               (format " (trust %s)"
416                       (epg-signature-validity signature))
417             "")))
418
419 (defun epg-verify-result-to-string (verify-result)
420   (mapconcat #'epg-signature-to-string verify-result "\n"))
421
422 (defun epg-start (context args)
423   "Start `epg-gpg-program' in a subprocess with given ARGS."
424   (let* ((args (append (list "--no-tty"
425                              "--status-fd" "1"
426                              "--command-fd" "0"
427                              "--yes")
428                        (if (epg-context-armor context) '("--armor"))
429                        (if (epg-context-textmode context) '("--textmode"))
430                        (if (epg-context-output-file context)
431                            (list "--output" (epg-context-output-file context)))
432                        args))
433          (coding-system-for-write 'binary)
434          process-connection-type
435          (orig-mode (default-file-modes))
436          (buffer (generate-new-buffer " *epg*"))
437          process)
438     (if epg-debug
439         (save-excursion
440           (unless epg-debug-buffer
441             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
442           (set-buffer epg-debug-buffer)
443           (goto-char (point-max))
444           (insert (format "%s %s\n" epg-gpg-program
445                           (mapconcat #'identity args " ")))))
446     (with-current-buffer buffer
447       (make-local-variable 'epg-read-point)
448       (setq epg-read-point (point-min))
449       (make-local-variable 'epg-pending-status-list)
450       (setq epg-pending-status-list nil)
451       (make-local-variable 'epg-key-id)
452       (setq epg-key-id nil)
453       (make-local-variable 'epg-context)
454       (setq epg-context context))
455     (unwind-protect
456         (progn
457           (set-default-file-modes 448)
458           (setq process
459                 (apply #'start-process "epg" buffer epg-gpg-program args)))
460       (set-default-file-modes orig-mode))
461     (set-process-filter process #'epg-process-filter)
462     (epg-context-set-process context process)))
463
464 (defun epg-process-filter (process input)
465   (if epg-debug
466       (save-excursion
467         (unless epg-debug-buffer
468           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
469         (set-buffer epg-debug-buffer)
470         (goto-char (point-max))
471         (insert input)))
472   (if (buffer-live-p (process-buffer process))
473       (save-excursion
474         (set-buffer (process-buffer process))
475         (goto-char (point-max))
476         (insert input)
477         (goto-char epg-read-point)
478         (beginning-of-line)
479         (while (looking-at ".*\n")      ;the input line finished
480           (save-excursion
481             (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
482                 (let* ((status (match-string 1))
483                        (string (match-string 2))
484                        (symbol (intern-soft (concat "epg-status-" status))))
485                   (if (member status epg-pending-status-list)
486                       (setq epg-pending-status-list nil))
487                   (if (and symbol
488                            (fboundp symbol))
489                       (funcall symbol process string)))))
490           (forward-line))
491         (setq epg-read-point (point)))))
492
493 (defun epg-read-output (context)
494   (with-temp-buffer
495     (if (fboundp 'set-buffer-multibyte)
496         (set-buffer-multibyte nil))
497     (if (file-exists-p (epg-context-output-file context))
498         (let ((coding-system-for-read (if (epg-context-textmode context)
499                                           'raw-text
500                                         'binary)))
501           (insert-file-contents (epg-context-output-file context))
502           (buffer-string)))))
503
504 (defun epg-wait-for-status (context status-list)
505   (with-current-buffer (process-buffer (epg-context-process context))
506     (setq epg-pending-status-list status-list)
507     (while (and (eq (process-status (epg-context-process context)) 'run)
508                 epg-pending-status-list)
509       (accept-process-output (epg-context-process context) 1))))
510
511 (defun epg-wait-for-completion (context)
512   (while (eq (process-status (epg-context-process context)) 'run)
513     ;; We can't use accept-process-output instead of sit-for here
514     ;; because it may cause an interrupt during the sentinel execution.
515     (sit-for 0.1)))
516
517 (defun epg-flush (context)
518   (if (eq (process-status (epg-context-process context)) 'run)
519       (process-send-eof (epg-context-process context))))
520
521 (defun epg-reset (context)
522   (if (and (epg-context-process context)
523            (buffer-live-p (process-buffer (epg-context-process context))))
524       (kill-buffer (process-buffer (epg-context-process context))))
525   (epg-context-set-process context nil))
526
527 (defun epg-delete-output-file (context)
528   (if (and (epg-context-output-file context)
529            (file-exists-p (epg-context-output-file context)))
530       (delete-file (epg-context-output-file context))))
531
532 (defun epg-status-USERID_HINT (process string)
533   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
534       (let* ((key-id (match-string 1 string))
535              (user-id (match-string 2 string))
536              (entry (assoc key-id epg-user-id-alist)))
537         (if entry
538             (setcdr entry user-id)
539           (setq epg-user-id-alist (cons (cons key-id user-id)
540                                         epg-user-id-alist))))))
541
542 (defun epg-status-NEED_PASSPHRASE (process string)
543   (if (string-match "\\`\\([^ ]+\\)" string)
544       (setq epg-key-id (match-string 1 string))))
545
546 (defun epg-status-NEED_PASSPHRASE_SYM (process string)
547   (setq epg-key-id 'SYM))
548
549 (defun epg-status-NEED_PASSPHRASE_PIN (process string)
550   (setq epg-key-id 'PIN))
551
552 (defun epg-status-GET_HIDDEN (process string)
553   (if (and epg-key-id
554            (string-match "\\`passphrase\\." string))
555       (let (inhibit-quit
556             passphrase
557             passphrase-with-new-line)
558         (unwind-protect
559             (condition-case nil
560                 (progn
561                   (setq passphrase
562                         (funcall
563                          (if (consp (epg-context-passphrase-callback
564                                      epg-context))
565                              (car (epg-context-passphrase-callback
566                                    epg-context))
567                            (epg-context-passphrase-callback epg-context))
568                          epg-key-id
569                          (if (consp (epg-context-passphrase-callback
570                                      epg-context))
571                              (cdr (epg-context-passphrase-callback
572                                    epg-context)))))
573                   (when passphrase
574                     (setq passphrase-with-new-line (concat passphrase "\n"))
575                     (fillarray passphrase 0)
576                     (setq passphrase nil)
577                     (process-send-string process passphrase-with-new-line)))
578               (quit
579                (epg-context-set-result-for
580                 epg-context 'error
581                 (cons 'quit
582                       (epg-context-result-for epg-context 'error)))
583                (delete-process process)))
584           (if passphrase
585               (fillarray passphrase 0))
586           (if passphrase-with-new-line
587               (fillarray passphrase-with-new-line 0))))))
588
589 (defun epg-status-GET_BOOL (process string)
590   (let ((entry (assoc string epg-prompt-alist))
591         inhibit-quit)
592     (condition-case nil
593       (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
594           (process-send-string process "y\n")
595         (process-send-string process "n\n"))
596       (quit
597        (epg-context-set-result-for
598         epg-context 'error
599         (cons 'quit
600               (epg-context-result-for epg-context 'error)))
601        (delete-process process)))))
602
603 (defun epg-status-GET_LINE (process string)
604   (let ((entry (assoc string epg-prompt-alist))
605         inhibit-quit)
606     (condition-case nil
607         (process-send-string
608          process
609          (concat (read-string (if entry (cdr entry) (concat string ": ")))
610                  "\n"))
611       (quit
612        (epg-context-set-result-for
613         epg-context 'error
614         (cons 'quit
615               (epg-context-result-for epg-context 'error)))
616        (delete-process process)))))
617
618 (defun epg-status-GOODSIG (process string)
619   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
620       (epg-context-set-result-for
621        epg-context
622        'verify
623        (cons (epg-make-signature 'good
624                                  (match-string 1 string)
625                                  (match-string 2 string))
626              (epg-context-result-for epg-context 'verify)))))
627
628 (defun epg-status-EXPSIG (process string)
629   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
630       (epg-context-set-result-for
631        epg-context
632        'verify
633        (cons (epg-make-signature 'expired
634                                  (match-string 1 string)
635                                  (match-string 2 string))
636              (epg-context-result-for epg-context 'verify)))))
637
638 (defun epg-status-EXPKEYSIG (process string)
639   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
640       (epg-context-set-result-for
641        epg-context
642        'verify
643        (cons (epg-make-signature 'expired-key
644                                  (match-string 1 string)
645                                  (match-string 2 string))
646              (epg-context-result-for epg-context 'verify)))))
647
648 (defun epg-status-REVKEYSIG (process string)
649   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
650       (epg-context-set-result-for
651        epg-context
652        'verify
653        (cons (epg-make-signature 'revoked-key
654                                  (match-string 1 string)
655                                  (match-string 2 string))
656              (epg-context-result-for epg-context 'verify)))))
657
658 (defun epg-status-BADSIG (process string)
659   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
660       (epg-context-set-result-for
661        epg-context
662        'verify
663        (cons (epg-make-signature 'bad
664                                  (match-string 1 string)
665                                  (match-string 2 string))
666              (epg-context-result-for epg-context 'verify)))))
667
668 (defun epg-status-VALIDSIG (process string)
669   (let ((signature (car (epg-context-result-for epg-context 'verify))))
670     (if (and signature
671              (eq (epg-signature-status signature) 'good)
672              (string-match "\\`\\([^ ]+\\) " string))
673         (epg-signature-set-fingerprint signature (match-string 1 string)))))
674
675 (defun epg-status-TRUST_UNDEFINED (process string)
676   (let ((signature (car (epg-context-result-for epg-context 'verify))))
677     (if (and signature
678              (eq (epg-signature-status signature) 'good))
679         (epg-signature-set-validity signature 'undefined))))
680
681 (defun epg-status-TRUST_NEVER (process string)
682   (let ((signature (car (epg-context-result-for epg-context 'verify))))
683     (if (and signature
684              (eq (epg-signature-status signature) 'good))
685         (epg-signature-set-validity signature 'never))))
686
687 (defun epg-status-TRUST_MARGINAL (process string)
688   (let ((signature (car (epg-context-result-for epg-context 'verify))))
689     (if (and signature
690              (eq (epg-signature-status signature) 'marginal))
691         (epg-signature-set-validity signature 'marginal))))
692
693 (defun epg-status-TRUST_FULLY (process string)
694   (let ((signature (car (epg-context-result-for epg-context 'verify))))
695     (if (and signature
696              (eq (epg-signature-status signature) 'good))
697         (epg-signature-set-validity signature 'full))))
698
699 (defun epg-status-TRUST_ULTIMATE (process string)
700   (let ((signature (car (epg-context-result-for epg-context 'verify))))
701     (if (and signature
702              (eq (epg-signature-status signature) 'good))
703         (epg-signature-set-validity signature 'ultimate))))
704
705 (defun epg-status-PROGRESS (process string)
706   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
707                     string)
708       (funcall (if (consp (epg-context-progress-callback epg-context))
709                    (car (epg-context-progress-callback epg-context))
710                  (epg-context-progress-callback epg-context))
711                (match-string 1 string)
712                (match-string 2 string)
713                (string-to-number (match-string 3 string))
714                (string-to-number (match-string 4 string))
715                (if (consp (epg-context-progress-callback epg-context))
716                    (cdr (epg-context-progress-callback epg-context))))))
717
718 (defun epg-status-DECRYPTION_FAILED (process string)
719   (epg-context-set-result-for
720    epg-context 'error
721    (cons 'decryption-failed
722          (epg-context-result-for epg-context 'error))))
723
724 (defun epg-status-NODATA (process string)
725   (epg-context-set-result-for
726    epg-context 'error
727    (cons (cons 'no-data (string-to-number string))
728          (epg-context-result-for epg-context 'error))))
729
730 (defun epg-status-UNEXPECTED (process string)
731   (epg-context-set-result-for
732    epg-context 'error
733    (cons (cons 'unexpected (string-to-number string))
734          (epg-context-result-for epg-context 'error))))
735
736 (defun epg-status-KEYEXPIRED (process string)
737   (epg-context-set-result-for
738    epg-context 'error
739    (cons (cons 'key-expired string)
740          (epg-context-result-for epg-context 'error))))
741
742 (defun epg-status-KEYREVOKED (process string)
743   (epg-context-set-result-for
744    epg-context 'error
745    (cons 'key-revoked
746          (epg-context-result-for epg-context 'error))))
747
748 (defun epg-status-BADARMOR (process string)
749   (epg-context-set-result-for
750    epg-context 'error
751    (cons 'bad-armor
752          (epg-context-result-for epg-context 'error))))
753
754 (defun epg-status-INV_RECP (process string)
755   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
756       (epg-context-set-result-for
757        epg-context 'error
758        (cons (list 'invalid-recipient
759                    (string-to-number (match-string 1 string))
760                    (match-string 2 string))
761              (epg-context-result-for epg-context 'error)))))
762
763 (defun epg-status-NO_RECP (process string)
764   (epg-context-set-result-for
765    epg-context 'error
766    (cons 'no-recipients
767          (epg-context-result-for epg-context 'error))))
768
769 (defun epg-status-DELETE_PROBLEM (process string)
770   (if (string-match "\\`\\([0-9]+\\)" string)
771       (epg-context-set-result-for
772        epg-context 'error
773        (cons (cons 'delete-problem (string-to-number (match-string 1 string)))
774              (epg-context-result-for epg-context 'error)))))
775
776 (defun epg-status-SIG_CREATED (process string)
777   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
778 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
779       (epg-context-set-result-for
780        epg-context 'sign
781        (cons (list (cons 'type (string-to-char (match-string 1 string)))
782                    (cons 'pubkey-algorithm
783                          (string-to-number (match-string 2 string)))
784                    (cons 'digest-algorithm
785                          (string-to-number (match-string 3 string)))
786                    (cons 'class (string-to-number (match-string 4 string) 16))
787                    (cons 'creation-time (match-string 5 string))
788                    (cons 'fingerprint (substring string (match-end 0))))
789              (epg-context-result-for epg-context 'sign)))))
790
791 (defun epg-passphrase-callback-function (key-id handback)
792   (read-passwd
793    (if (eq key-id 'SYM)
794        "Passphrase for symmetric encryption: "
795      (if (eq key-id 'PIN)
796          "Passphrase for PIN: "
797        (let ((entry (assoc key-id epg-user-id-alist)))
798          (if entry
799              (format "Passphrase for %s %s: " key-id (cdr entry))
800            (format "Passphrase for %s: " key-id)))))))
801
802 (defun epg-progress-callback-function (what char current total handback)
803   (message "%s: %d%%/%d%%" what current total))
804
805 (defun epg-configuration ()
806   "Return a list of internal configuration parameters of `epg-gpg-program'."
807   (let (config type)
808     (with-temp-buffer
809       (apply #'call-process epg-gpg-program nil (list t nil) nil
810              '("--with-colons" "--list-config"))
811       (goto-char (point-min))
812       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
813         (setq type (intern (match-string 1))
814               config (cons (cons type
815                                  (if (memq type
816                                            '(pubkey cipher digest compress))
817                                      (mapcar #'string-to-number
818                                              (delete "" (split-string
819                                                          (match-string 2)
820                                                          ";")))
821                                    (match-string 2)))
822                            config))))
823     config))
824
825 (defun epg-list-keys-1 (name mode)
826   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
827                             "--fixed-list-mode" "--with-fingerprint"
828                             "--with-fingerprint"
829                             (if mode "--list-secret-keys" "--list-keys"))
830                       (if name (list name))))
831         keys string field index)
832     (with-temp-buffer
833       (apply #'call-process epg-gpg-program nil (list t nil) nil args)
834       (goto-char (point-min))
835       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
836         (setq keys (cons (make-vector 15 nil) keys)
837               string (match-string 0)
838               index 0
839               field 0)
840         (while (eq index
841                    (string-match "\\([^:]+\\)?:" string index))
842           (setq index (match-end 0))
843           (aset (car keys) field (match-string 1 string))
844           (setq field (1+ field))))
845       (nreverse keys))))
846
847 (defun epg-make-sub-key-1 (line)
848   (epg-make-sub-key
849    (if (aref line 1)
850        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
851    (delq nil
852          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
853                  (aref line 11)))
854    (member (aref line 0) '("sec" "ssb"))
855    (string-to-number (aref line 3))
856    (string-to-number (aref line 2))
857    (aref line 4)
858    (aref line 5)
859    (aref line 6)))
860
861 (defun epg-list-keys (&optional name mode)
862   (let ((lines (epg-list-keys-1 name mode))
863         keys)
864     (while lines
865       (cond
866        ((member (aref (car lines) 0) '("pub" "sec"))
867         (when (car keys)
868           (epg-key-set-sub-key-list
869            (car keys)
870            (nreverse (epg-key-sub-key-list (car keys))))
871           (epg-key-set-user-id-list
872            (car keys)
873            (nreverse (epg-key-user-id-list (car keys)))))
874         (setq keys (cons (epg-make-key
875                           (if (aref (car lines) 8)
876                               (cdr (assq (string-to-char (aref (car lines) 8))
877                                          epg-key-validity-alist))))
878                          keys))
879         (epg-key-set-sub-key-list
880          (car keys)
881          (cons (epg-make-sub-key-1 (car lines))
882                (epg-key-sub-key-list (car keys)))))
883        ((member (aref (car lines) 0) '("sub" "ssb"))
884         (epg-key-set-sub-key-list
885          (car keys)
886          (cons (epg-make-sub-key-1 (car lines))
887                (epg-key-sub-key-list (car keys)))))
888        ((equal (aref (car lines) 0) "uid")
889         (epg-key-set-user-id-list
890          (car keys)
891          (cons (epg-make-user-id
892                 (if (aref (car lines) 1)
893                     (cdr (assq (string-to-char (aref (car lines) 1))
894                                epg-key-validity-alist)))
895                 (aref (car lines) 9))
896                (epg-key-user-id-list (car keys)))))
897        ((equal (aref (car lines) 0) "fpr")
898         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
899                                      (aref (car lines) 9))))
900       (setq lines (cdr lines)))
901     (nreverse keys)))
902
903 (if (fboundp 'make-temp-file)
904     (defalias 'epg-make-temp-file 'make-temp-file)
905   ;; stolen from poe.el.
906   (defun epg-make-temp-file (prefix)
907     "Create a temporary file.
908 The returned file name (created by appending some random characters at the end
909 of PREFIX, and expanding against `temporary-file-directory' if necessary),
910 is guaranteed to point to a newly created empty file.
911 You can then use `write-region' to write new data into the file."
912     (let (tempdir tempfile)
913       (unwind-protect
914           (let (file)
915             ;; First, create a temporary directory.
916             (while (condition-case ()
917                        (progn
918                          (setq tempdir (make-temp-name
919                                         (concat
920                                          (file-name-directory prefix)
921                                          "DIR")))
922                          ;; return nil or signal an error.
923                          (make-directory tempdir))
924                      ;; let's try again.
925                      (file-already-exists t)))
926             (set-file-modes tempdir 448)
927             ;; Second, create a temporary file in the tempdir.
928             ;; There *is* a race condition between `make-temp-name'
929             ;; and `write-region', but we don't care it since we are
930             ;; in a private directory now.
931             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
932             (write-region "" nil tempfile nil 'silent)
933             (set-file-modes tempfile 384)
934             ;; Finally, make a hard-link from the tempfile.
935             (while (condition-case ()
936                        (progn
937                          (setq file (make-temp-name prefix))
938                          ;; return nil or signal an error.
939                          (add-name-to-file tempfile file))
940                      ;; let's try again.
941                      (file-already-exists t)))
942             file)
943         ;; Cleanup the tempfile.
944         (and tempfile
945              (file-exists-p tempfile)
946              (delete-file tempfile))
947         ;; Cleanup the tempdir.
948         (and tempdir
949              (file-directory-p tempdir)
950              (delete-directory tempdir))))))
951
952 ;;;###autoload
953 (defun epg-start-decrypt (context cipher)
954   "Initiate a decrypt operation on CIPHER.
955 CIPHER is a data object.
956
957 If you use this function, you will need to wait for the completion of
958 `epg-gpg-program' by using `epg-wait-for-completion' and call
959 `epg-reset' to clear a temporaly output file.
960 If you are unsure, use synchronous version of this function
961 `epg-decrypt-file' or `epg-decrypt-string' instead."
962   (unless (epg-data-file cipher)
963     (error "Not a file"))
964   (epg-context-set-result context nil)
965   (epg-start context (list "--decrypt" (epg-data-file cipher)))
966   (epg-wait-for-status context '("BEGIN_DECRYPTION")))
967
968 ;;;###autoload
969 (defun epg-decrypt-file (context cipher plain)
970   "Decrypt a file CIPHER and store the result to a file PLAIN.
971 If PLAIN is nil, it returns the result as a string."
972   (unwind-protect
973       (progn
974         (if plain
975             (epg-context-set-output-file context plain)
976           (epg-context-set-output-file context
977                                        (epg-make-temp-file "epg-output")))
978         (epg-start-decrypt context (epg-make-data-from-file cipher))
979         (epg-wait-for-completion context)
980         (if (epg-context-result-for context 'error)
981             (error "Decrypt failed: %S"
982                    (epg-context-result-for context 'error)))
983         (unless plain
984           (epg-read-output context)))
985     (unless plain
986       (epg-delete-output-file context))
987     (epg-reset context)))
988
989 ;;;###autoload
990 (defun epg-decrypt-string (context cipher)
991   "Decrypt a string CIPHER and return the plain text."
992   (let ((input-file (epg-make-temp-file "epg-input"))
993         (coding-system-for-write 'binary))
994     (unwind-protect
995         (progn
996           (write-region cipher nil input-file nil 'quiet)
997           (epg-context-set-output-file context
998                                        (epg-make-temp-file "epg-output"))
999           (epg-start-decrypt context (epg-make-data-from-file input-file))
1000           (epg-flush context)
1001           (epg-wait-for-completion context)
1002           (if (epg-context-result-for context 'error)
1003               (error "Decrypt failed: %S"
1004                      (epg-context-result-for context 'error)))
1005           (epg-read-output context))
1006       (epg-delete-output-file context)
1007       (if (file-exists-p input-file)
1008           (delete-file input-file))
1009       (epg-reset context))))
1010
1011 ;;;###autoload
1012 (defun epg-start-verify (context signature &optional signed-text)
1013   "Initiate a verify operation on SIGNATURE.
1014 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
1015
1016 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
1017 For a normal or a clear text signature, SIGNED-TEXT should be nil.
1018
1019 If you use this function, you will need to wait for the completion of
1020 `epg-gpg-program' by using `epg-wait-for-completion' and call
1021 `epg-reset' to clear a temporaly output file.
1022 If you are unsure, use synchronous version of this function
1023 `epg-verify-file' or `epg-verify-string' instead."
1024   (epg-context-set-result context nil)
1025   (if signed-text
1026       ;; Detached signature.
1027       (if (epg-data-file signed-text)
1028           (epg-start context (list "--verify" (epg-data-file signature)
1029                                    (epg-data-file signed-text)))
1030         (epg-start context (list "--verify" (epg-data-file signature) "-"))
1031         (if (eq (process-status (epg-context-process context)) 'run)
1032             (process-send-string (epg-context-process context)
1033                                  (epg-data-string signed-text))))
1034     ;; Normal (or cleartext) signature.
1035     (if (epg-data-file signature)
1036         (epg-start context (list "--verify" (epg-data-file signature)))
1037       (epg-start context (list "--verify"))
1038       (if (eq (process-status (epg-context-process context)) 'run)
1039           (process-send-string (epg-context-process context)
1040                                (epg-data-string signature))))))
1041
1042 ;;;###autoload
1043 (defun epg-verify-file (context signature &optional signed-text plain)
1044   "Verify a file SIGNATURE.
1045 SIGNED-TEXT and PLAIN are also a file if they are specified.
1046
1047 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1048 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1049   (unwind-protect
1050       (progn
1051         (if plain
1052             (epg-context-set-output-file context plain)
1053           (epg-context-set-output-file context
1054                                        (epg-make-temp-file "epg-output")))
1055         (if signed-text
1056             (epg-start-verify context
1057                               (epg-make-data-from-file signature)
1058                               (epg-make-data-from-file signed-text))
1059           (epg-start-verify context
1060                             (epg-make-data-from-file signature)))
1061         (epg-wait-for-completion context)
1062         (unless plain
1063           (epg-read-output context)))
1064     (unless plain
1065       (epg-delete-output-file context))
1066     (epg-reset context)))
1067
1068 ;;;###autoload
1069 (defun epg-verify-string (context signature &optional signed-text)
1070   "Verify a string SIGNATURE.
1071 SIGNED-TEXT is a string if it is specified.
1072
1073 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1074 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1075   (let ((coding-system-for-write 'binary)
1076         input-file)
1077     (unwind-protect
1078         (progn
1079           (epg-context-set-output-file context
1080                                        (epg-make-temp-file "epg-output"))
1081           (if signed-text
1082               (progn
1083                 (setq input-file (epg-make-temp-file "epg-signature"))
1084                 (write-region signature nil input-file nil 'quiet)
1085                 (epg-start-verify context
1086                                   (epg-make-data-from-file input-file)
1087                                   (epg-make-data-from-string signed-text)))
1088             (epg-start-verify context (epg-make-data-from-string signature)))
1089           (epg-flush context)
1090           (epg-wait-for-completion context)
1091           (epg-read-output context))
1092       (epg-delete-output-file context)
1093       (if (and input-file
1094                (file-exists-p input-file))
1095           (delete-file input-file))
1096       (epg-reset context))))
1097
1098 ;;;###autoload
1099 (defun epg-start-sign (context plain &optional mode)
1100   "Initiate a sign operation on PLAIN.
1101 PLAIN is a data object.
1102
1103 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1104 If MODE is t or 'detached, it makes a detached signature.
1105 Otherwise, it makes a normal signature.
1106
1107 If you use this function, you will need to wait for the completion of
1108 `epg-gpg-program' by using `epg-wait-for-completion' and call
1109 `epg-reset' to clear a temporaly output file.
1110 If you are unsure, use synchronous version of this function
1111 `epg-sign-file' or `epg-sign-string' instead."
1112   (epg-context-set-result context nil)
1113   (epg-start context
1114              (append (list (if (eq mode 'clearsign)
1115                                "--clearsign"
1116                              (if (or (eq mode t) (eq mode 'detached))
1117                                  "--detach-sign"
1118                                "--sign")))
1119                      (apply #'nconc
1120                             (mapcar
1121                              (lambda (signer)
1122                                (list "-u"
1123                                      (epg-sub-key-id
1124                                       (car (epg-key-sub-key-list signer)))))
1125                              (epg-context-signers context)))
1126                      (if (epg-data-file plain)
1127                          (list (epg-data-file plain)))))
1128   (epg-wait-for-status context '("BEGIN_SIGNING"))
1129   (if (and (epg-data-string plain)
1130            (eq (process-status (epg-context-process context)) 'run))
1131       (process-send-string (epg-context-process context)
1132                            (epg-data-string plain))))
1133
1134 ;;;###autoload
1135 (defun epg-sign-file (context plain signature &optional mode)
1136   "Sign a file PLAIN and store the result to a file SIGNATURE.
1137 If SIGNATURE is nil, it returns the result as a string.
1138 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1139 If MODE is t or 'detached, it makes a detached signature.
1140 Otherwise, it makes a normal signature."
1141   (unwind-protect
1142       (progn
1143         (if signature
1144             (epg-context-set-output-file context signature)
1145           (epg-context-set-output-file context
1146                                        (epg-make-temp-file "epg-output")))
1147         (epg-start-sign context (epg-make-data-from-file plain) mode)
1148         (epg-wait-for-completion context)
1149         (if (epg-context-result-for context 'error)
1150             (error "Sign failed: %S"
1151                    (epg-context-result-for context 'error)))
1152         (unless signature
1153           (epg-read-output context)))
1154     (unless signature
1155       (epg-delete-output-file context))
1156     (epg-reset context)))
1157
1158 ;;;###autoload
1159 (defun epg-sign-string (context plain &optional mode)
1160   "Sign a string PLAIN and return the output as string.
1161 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1162 If MODE is t or 'detached, it makes a detached signature.
1163 Otherwise, it makes a normal signature."
1164   (unwind-protect
1165       (progn
1166         (epg-context-set-output-file context
1167                                      (epg-make-temp-file "epg-output"))
1168         (epg-start-sign context (epg-make-data-from-string plain) mode)
1169         (epg-flush context)
1170         (epg-wait-for-completion context)
1171         (if (epg-context-result-for context 'error)
1172             (error "Sign failed: %S"
1173                    (epg-context-result-for context 'error)))
1174         (epg-read-output context))
1175     (epg-delete-output-file context)
1176     (epg-reset context)))
1177
1178 ;;;###autoload
1179 (defun epg-start-encrypt (context plain recipients
1180                                   &optional sign always-trust)
1181   "Initiate an encrypt operation on PLAIN.
1182 PLAIN is a data object.
1183 If RECIPIENTS is nil, it performs symmetric encryption.
1184
1185 If you use this function, you will need to wait for the completion of
1186 `epg-gpg-program' by using `epg-wait-for-completion' and call
1187 `epg-reset' to clear a temporaly output file.
1188 If you are unsure, use synchronous version of this function
1189 `epg-encrypt-file' or `epg-encrypt-string' instead."
1190   (epg-context-set-result context nil)
1191   (epg-start context
1192              (append (if always-trust '("--always-trust"))
1193                      (if recipients '("--encrypt") '("--symmetric"))
1194                      (if sign
1195                          (cons "--sign"
1196                                (apply #'nconc
1197                                       (mapcar (lambda (signer)
1198                                                 (list "-u" signer))
1199                                               (epg-context-signers context)))))
1200                      (apply #'nconc
1201                             (mapcar
1202                              (lambda (recipient)
1203                                (list "-r"
1204                                      (epg-sub-key-id
1205                                       (car (epg-key-sub-key-list recipient)))))
1206                              recipients))
1207                      (if (epg-data-file plain)
1208                          (list (epg-data-file plain)))))
1209   (if sign
1210       (epg-wait-for-status context '("BEGIN_SIGNING"))
1211     (epg-wait-for-status context '("BEGIN_ENCRYPTION")))
1212   (if (and (epg-data-string plain)
1213            (eq (process-status (epg-context-process context)) 'run))
1214       (process-send-string (epg-context-process context)
1215                            (epg-data-string plain))))
1216
1217 ;;;###autoload
1218 (defun epg-encrypt-file (context plain recipients
1219                                  cipher &optional sign always-trust)
1220   "Encrypt a file PLAIN and store the result to a file CIPHER.
1221 If CIPHER is nil, it returns the result as a string.
1222 If RECIPIENTS is nil, it performs symmetric encryption."
1223   (unwind-protect
1224       (progn
1225         (if cipher
1226             (epg-context-set-output-file context cipher)
1227           (epg-context-set-output-file context
1228                                        (epg-make-temp-file "epg-output")))
1229         (epg-start-encrypt context (epg-make-data-from-file plain)
1230                            recipients sign always-trust)
1231         (epg-wait-for-completion context)
1232         (if (epg-context-result-for context 'error)
1233             (error "Encrypt failed: %S"
1234                    (epg-context-result-for context 'error)))
1235         (unless cipher
1236           (epg-read-output context)))
1237     (unless cipher
1238       (epg-delete-output-file context))
1239     (epg-reset context)))
1240
1241 ;;;###autoload
1242 (defun epg-encrypt-string (context plain recipients
1243                                    &optional sign always-trust)
1244   "Encrypt a string PLAIN.
1245 If RECIPIENTS is nil, it performs symmetric encryption."
1246   (unwind-protect
1247       (progn
1248         (epg-context-set-output-file context
1249                                      (epg-make-temp-file "epg-output"))
1250         (epg-start-encrypt context (epg-make-data-from-string plain)
1251                            recipients sign always-trust)
1252         (epg-flush context)
1253         (epg-wait-for-completion context)
1254         (if (epg-context-result-for context 'error)
1255             (error "Encrypt failed: %S"
1256                    (epg-context-result-for context 'error)))
1257         (epg-read-output context))
1258     (epg-delete-output-file context)
1259     (epg-reset context)))
1260
1261 ;;;###autoload
1262 (defun epg-start-export-keys (context keys)
1263   "Initiate an export keys operation.
1264
1265 If you use this function, you will need to wait for the completion of
1266 `epg-gpg-program' by using `epg-wait-for-completion' and call
1267 `epg-reset' to clear a temporaly output file.
1268 If you are unsure, use synchronous version of this function
1269 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
1270   (epg-context-set-result context nil)
1271   (epg-start context (cons "--export"
1272                            (mapcar
1273                             (lambda (key)
1274                               (epg-sub-key-id
1275                                (car (epg-key-sub-key-list key))))
1276                             keys))))
1277
1278 ;;;###autoload
1279 (defun epg-export-keys-to-file (context keys file)
1280   "Extract public KEYS."
1281   (unwind-protect
1282       (progn
1283         (if keys
1284             (epg-context-set-output-file context file)
1285           (epg-context-set-output-file context
1286                                        (epg-make-temp-file "epg-output")))
1287         (epg-start-export-keys context keys)
1288         (epg-wait-for-completion context)
1289         (if (epg-context-result-for context 'error)
1290             (error "Export keys failed: %S"
1291                    (epg-context-result-for context 'error)))
1292         (unless file
1293           (epg-read-output context)))
1294     (unless file
1295       (epg-delete-output-file context))
1296     (epg-reset context)))
1297
1298 ;;;###autoload
1299 (defun epg-export-keys-to-string (context keys)
1300   "Extract public KEYS and return them as a string."
1301   (epg-export-keys-to-file context keys nil))
1302
1303 ;;;###autoload
1304 (defun epg-start-import-keys (context keys)
1305   "Initiate an import keys operation.
1306 KEYS is a data object.
1307
1308 If you use this function, you will need to wait for the completion of
1309 `epg-gpg-program' by using `epg-wait-for-completion' and call
1310 `epg-reset' to clear a temporaly output file.
1311 If you are unsure, use synchronous version of this function
1312 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1313   (epg-context-set-result context nil)
1314   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
1315   (epg-start context (list "--import" (epg-data-file keys)))
1316   (if (and (epg-data-string keys)
1317            (eq (process-status (epg-context-process context)) 'run))
1318       (process-send-string (epg-context-process context)
1319                            (epg-data-string keys))))
1320   
1321 (defun epg-import-keys-1 (context keys)
1322   (unwind-protect
1323       (progn
1324         (epg-start-import-keys context keys)
1325         (if (epg-data-file keys)
1326             (epg-flush context))
1327         (epg-wait-for-completion context)
1328         (if (epg-context-result-for context 'error)
1329             (error "Import keys failed: %S"
1330                    (epg-context-result-for context 'error)))
1331         (epg-read-output context))
1332     (epg-reset context)))
1333
1334 ;;;###autoload
1335 (defun epg-import-keys-from-file (context keys)
1336   "Add keys from a file KEYS."
1337   (epg-import-keys-1 context (epg-make-data-from-file keys)))
1338
1339 ;;;###autoload
1340 (defun epg-import-keys-from-string (context keys)
1341   "Add keys from a string KEYS."
1342   (epg-import-keys-1 context (epg-make-data-from-string keys)))
1343
1344 ;;;###autoload
1345 (defun epg-start-delete-keys (context keys &optional allow-secret)
1346   "Initiate an delete keys operation.
1347
1348 If you use this function, you will need to wait for the completion of
1349 `epg-gpg-program' by using `epg-wait-for-completion' and call
1350 `epg-reset' to clear a temporaly output file.
1351 If you are unsure, use synchronous version of this function
1352 `epg-delete-keys' instead."
1353   (epg-context-set-result context nil)
1354   (epg-start context (cons (if allow-secret
1355                                "--delete-secret-key"
1356                              "--delete-key")
1357                            (mapcar
1358                             (lambda (key)
1359                               (epg-sub-key-id
1360                                (car (epg-key-sub-key-list key))))
1361                             keys))))
1362
1363 ;;;###autoload
1364 (defun epg-delete-keys (context keys &optional allow-secret)
1365   "Delete KEYS from the key ring."
1366   (unwind-protect
1367       (progn
1368         (epg-start-delete-keys context keys allow-secret)
1369         (epg-wait-for-completion context)
1370         (if (epg-context-result-for context 'error)
1371             (error "Delete keys failed: %S"
1372                    (epg-context-result-for context 'error))))
1373     (epg-reset context)))
1374
1375 ;;;###autoload
1376 (defun epg-start-sign-keys (context keys &optional local)
1377   "Initiate an sign keys operation.
1378
1379 If you use this function, you will need to wait for the completion of
1380 `epg-gpg-program' by using `epg-wait-for-completion' and call
1381 `epg-reset' to clear a temporaly output file.
1382 If you are unsure, use synchronous version of this function
1383 `epg-sign-keys' instead."
1384   (epg-context-set-result context nil)
1385   (epg-start context (cons (if local
1386                                "--lsign-key"
1387                              "--sign-key")
1388                            (mapcar
1389                             (lambda (key)
1390                               (epg-sub-key-id
1391                                (car (epg-key-sub-key-list key))))
1392                             keys))))
1393
1394 ;;;###autoload
1395 (defun epg-sign-keys (context keys &optional local)
1396   "Sign KEYS from the key ring."
1397   (unwind-protect
1398       (progn
1399         (epg-start-sign-keys context keys local)
1400         (epg-wait-for-completion context)
1401         (if (epg-context-result-for context 'error)
1402             (error "Sign keys failed: %S"
1403                    (epg-context-result-for context 'error))))
1404     (epg-reset context)))
1405
1406 (provide 'epg)
1407
1408 ;;; epg.el ends here