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