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