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