Added docstring.
[elisp/epg.git] / epg.el
1 (defgroup epg ()
2   "EasyPG, yet another GnuPG interface.")
3
4 (defcustom epg-gpg-program "gpg"
5   "The `gpg' executable."
6   :group 'epg
7   :type 'string)
8
9 (defvar epg-user-id nil
10   "GnuPG ID of your default identity.")
11
12 (defvar epg-user-id-alist nil
13   "An alist mapping from key ID to user ID.")
14
15 (defvar epg-read-point nil)
16 (defvar epg-pending-status-list nil)
17 (defvar epg-key-id nil)
18 (defvar epg-context nil)
19 (defvar epg-debug nil)
20
21 (defvar epg-colons-pub-spec
22   '((trust "[^:]")
23     (length "[0-9]+" 0 string-to-number)
24     (algorithm "[0-9]+" 0 string-to-number)
25     (key-id "[^:]+")
26     (creation-date "[0-9]+")
27     (expiration-date "[0-9]+")
28     nil
29     (ownertrust "[^:]")
30     nil
31     nil
32     (capability "[escaESCA]*"))
33   "The schema of keylisting output whose type is \"pub\".
34 This is used by `epg-list-keys'.")
35
36 (defvar epg-colons-sec-spec
37   '((trust "[^:]")
38     (length "[0-9]+" 0 string-to-number)
39     (algorithm "[0-9]+" 0 string-to-number)
40     (key-id "[^:]+")
41     (creation-date "[0-9]+")
42     (expiration-date "[0-9]+")
43     nil
44     (ownertrust "[^:]"))
45 "The schema of keylisting output whose type is \"sec\".
46 This is used by `epg-list-keys'.")
47
48 (defvar epg-colons-uid-spec
49   '((trust "[^:]")
50     nil
51     nil
52     nil
53     (creation-date "[0-9]+")
54     (expiration-date "[0-9]+")
55     (hash "[^:]+")
56     nil
57     (user-id "[^:]+"))
58   "The schema of keylisting output whose type is \"uid\".
59 This is used by `epg-list-keys'.")
60     
61 (defun epg-make-context (&optional protocol armor textmode include-certs)
62   "Return a context object."
63   (vector protocol armor textmode include-certs
64           (cons #'epg-passphrase-callback-function nil)
65           (cons #'epg-progress-callback-function nil)
66           nil nil nil nil))
67
68 (defun epg-context-protocol (context)
69   "Return the protocol used within the context."
70   (aref context 0))
71
72 (defun epg-context-armor (context)
73   "Return t if the output shouled be ASCII armored in the CONTEXT context."
74   (aref context 1))
75
76 (defun epg-context-textmode (context)
77   "Return t if canonical text mode should be used in the CONTEXT context."
78   (aref context 2))
79
80 (defun epg-context-include-certs (context)
81   "Return how many certificates should be included in an S/MIME signed
82 message."
83   (aref context 3))
84
85 (defun epg-context-passphrase-callback-info (context)
86   "Return the function used to query passphrase."
87   (aref context 4))
88
89 (defun epg-context-progress-callback-info (context)
90   "Return the function which handles progress update."
91   (aref context 5))
92
93 (defun epg-context-signers (context)
94   "Return the list of key-id for singning."
95   (aref context 6))
96
97 (defun epg-context-process (context)
98   "Return the process object of `epg-gpg-program'.
99 This function is for internal use only."
100   (aref context 7))
101
102 (defun epg-context-output-file (context)
103   "Return the output file of `epg-gpg-program'.
104 This function is for internal use only."
105   (aref context 8))
106
107 (defun epg-context-result (context)
108   "Return the result of the previous cryptographic operation."
109   (aref context 9))
110
111 (defun epg-context-set-protocol (context protocol)
112   "Set the protocol used within the context."
113   (aset context 0 protocol))
114
115 (defun epg-context-set-armor (context armor)
116   "Specify if the output shouled be ASCII armored in the CONTEXT context."
117   (aset context 1 armor))
118
119 (defun epg-context-set-textmode (context textmode)
120   "Specify if canonical text mode should be used in the CONTEXT context."
121   (aset context 2 textmode))
122
123 (defun epg-context-set-include-certs (context include-certs)
124  "Set how many certificates should be included in an S/MIME signed message."
125   (aset context 3 include-certs))
126
127 (defun epg-context-set-passphrase-callback-info (context
128                                                  passphrase-callback-info)
129   "Set the function used to query passphrase."
130   (aset context 4 passphrase-callback-info))
131
132 (defun epg-context-set-progress-callback-info (context progress-callback-info)
133   "Set the function which handles progress update."
134   (aset context 5 progress-callback-info))
135
136 (defun epg-context-set-signers (context signers)
137  "Set the list of key-id for singning."
138   (aset context 6 signers))
139
140 (defun epg-context-set-process (context process)
141   "Set the process object of `epg-gpg-program'.
142 This function is for internal use only."
143   (aset context 7 process))
144
145 (defun epg-context-set-output-file (context output-file)
146   "Set the output file of `epg-gpg-program'.
147 This function is for internal use only."
148   (aset context 8 output-file))
149
150 (defun epg-context-set-result (context result)
151   "Set the result of the previous cryptographic operation."
152   (aset context 9 result))
153
154 (defun epg-make-signature (status key-id user-id)
155   "Return a signature object."
156   (vector status key-id user-id nil))
157
158 (defun epg-signature-status (signature)
159   "Return the status code of SIGNATURE."
160   (aref signature 0))
161
162 (defun epg-signature-key-id (signature)
163   "Return the key-id of SIGNATURE."
164   (aref signature 1))
165
166 (defun epg-signature-user-id (signature)
167   "Return the user-id of SIGNATURE."
168   (aref signature 2))
169   
170 (defun epg-signature-validity (signature)
171   "Return the validity of SIGNATURE."
172   (aref signature 3))
173
174 (defun epg-signature-set-status (signature status)
175  "Set the status code of SIGNATURE."
176   (aset signature 0 status))
177
178 (defun epg-signature-set-key-id (signature key-id)
179  "Set the key-id of SIGNATURE."
180   (aset signature 1 key-id))
181
182 (defun epg-signature-set-user-id (signature user-id)
183  "Set the user-id of SIGNATURE."
184   (aset signature 2 user-id))
185   
186 (defun epg-signature-set-validity (signature validity)
187  "Set the validity of SIGNATURE."
188   (aset signature 3 validity))
189
190 (defun epg-context-result-for (context name)
191   (cdr (assq name (epg-context-result context))))
192
193 (defun epg-context-set-result-for (context name value)
194   (let* ((result (epg-context-result context))
195          (entry (assq name result)))
196     (if entry
197         (setcdr entry value)
198       (epg-context-set-result context (cons (cons name value) result)))))
199
200 (defun epg-start (context args)
201   "Start `epg-gpg-program' in a subprocess with given ARGS."
202   (let* ((args (append (list "--no-tty"
203                              "--status-fd" "1"
204                              "--command-fd" "0"
205                              "--yes") ; overwrite
206                        (if (epg-context-armor context) '("--armor"))
207                        (if (epg-context-textmode context) '("--textmode"))
208                        (if (epg-context-output-file context)
209                            (list "--output" (epg-context-output-file context)))
210                        args))
211          (coding-system-for-write 'binary)
212          process-connection-type
213          (orig-mode (default-file-modes))
214          (buffer (generate-new-buffer " *epg*"))
215          process)
216     (with-current-buffer buffer
217       (make-local-variable 'epg-read-point)
218       (setq epg-read-point (point-min))
219       (make-local-variable 'epg-pending-status-list)
220       (setq epg-pending-status-list nil)
221       (make-local-variable 'epg-key-id)
222       (setq epg-key-id nil)
223       (make-local-variable 'epg-context)
224       (setq epg-context context))
225     (unwind-protect
226         (progn
227           (set-default-file-modes 448)
228           (setq process
229                 (apply #'start-process "epg" buffer epg-gpg-program args)))
230       (set-default-file-modes orig-mode))
231     (set-process-filter process #'epg-process-filter)
232     (epg-context-set-process context process)))
233
234 (defun epg-process-filter (process input)
235   (if epg-debug
236       (save-excursion
237         (set-buffer (get-buffer-create  " *epg-debug*"))
238         (goto-char (point-max))
239         (insert input)))
240   (if (buffer-live-p (process-buffer process))
241       (save-excursion
242         (set-buffer (process-buffer process))
243         (goto-char (point-max))
244         (insert input)
245         (goto-char epg-read-point)
246         (beginning-of-line)
247         (while (looking-at ".*\n")      ;the input line is finished
248           (save-excursion
249             (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
250                 (let* ((status (match-string 1))
251                        (string (match-string 2))
252                        (symbol (intern-soft (concat "epg-status-" status))))
253                   (if (member status epg-pending-status-list)
254                       (setq epg-pending-status-list nil))
255                   (if (and symbol
256                            (fboundp symbol))
257                       (funcall symbol process string)))))
258           (forward-line))
259         (setq epg-read-point (point)))))
260
261 (defun epg-read-output (context)
262   (with-temp-buffer
263     (set-buffer-multibyte nil)
264     (if (file-exists-p (epg-context-output-file context))
265         (let ((coding-system-for-read (if (epg-context-output-file context)
266                                           'raw-text
267                                       'binary)))
268           (insert-file-contents (epg-context-output-file context))
269           (buffer-string)))))
270
271 (defun epg-wait-for-status (context status-list)
272   (with-current-buffer (process-buffer (epg-context-process context))
273     (setq epg-pending-status-list status-list)
274     (while (and (eq (process-status (epg-context-process context)) 'run)
275                 epg-pending-status-list)
276       (accept-process-output (epg-context-process context) 1))))
277
278 (defun epg-wait-for-completion (context)
279   (process-send-eof (epg-context-process context))
280   (while (eq (process-status (epg-context-process context)) 'run)
281     ;; We can't use accept-process-output instead of sit-for here
282     ;; because it may cause an interrupt during the sentinel execution.
283     (sit-for 0.1)))
284
285 (defun epg-reset (context)
286   (if (and (epg-context-process context)
287            (buffer-live-p (process-buffer (epg-context-process context))))
288       (kill-buffer (process-buffer (epg-context-process context))))
289   (epg-context-set-process context nil)
290   (if (file-exists-p (epg-context-output-file context))
291       (delete-file (epg-context-output-file context)))
292   (aset context 9 nil))
293
294 (defun epg-status-USERID_HINT (process string)
295   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
296       (let* ((key-id (match-string 1 string))
297              (user-id (match-string 2 string))
298              (entry (assoc key-id epg-user-id-alist)))
299         (if entry
300             (setcdr entry user-id)
301           (setq epg-user-id-alist (cons (cons key-id user-id)
302                                         epg-user-id-alist))))))
303
304 (defun epg-status-NEED_PASSPHRASE (process string)
305   (if (string-match "\\`\\([^ ]+\\)" string)
306       (setq epg-key-id (match-string 1 string))))
307
308 (defun epg-status-NEED_PASSPHRASE_SYM (process string)
309   (setq epg-key-id 'SYM))
310
311 (defun epg-status-NEED_PASSPHRASE_PIN (process string)
312   (setq epg-key-id 'PIN))
313
314 (defun epg-status-GET_HIDDEN (process string)
315   (let ((passphrase
316          (funcall (car (epg-context-passphrase-callback-info epg-context))
317                   epg-key-id
318                   (cdr (epg-context-passphrase-callback-info epg-context)))))
319     (unwind-protect
320         (if passphrase
321             (process-send-string process (concat passphrase "\n")))
322       (fillarray passphrase 0))))
323
324 (defun epg-status-GOODSIG (process string)
325   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
326       (epg-context-set-result-for
327        epg-context
328        'verify
329        (cons (epg-make-signature 'good
330                                  (match-string 1 string)
331                                  (match-string 2 string))
332              (epg-context-result-for epg-context 'verify)))))
333
334 (defun epg-status-EXPSIG (process string)
335   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
336       (epg-context-set-result-for
337        epg-context
338        'verify
339        (cons (epg-make-signature 'expired
340                                  (match-string 1 string)
341                                  (match-string 2 string))
342              (epg-context-result-for epg-context 'verify)))))
343
344 (defun epg-status-EXPKEYSIG (process string)
345   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
346       (epg-context-set-result-for
347        epg-context
348        'verify
349        (cons (epg-make-signature 'expired-key
350                                  (match-string 1 string)
351                                  (match-string 2 string))
352              (epg-context-result-for epg-context 'verify)))))
353
354 (defun epg-status-REVKEYSIG (process string)
355   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
356       (epg-context-set-result-for
357        epg-context
358        'verify
359        (cons (epg-make-signature 'revoked-key
360                                  (match-string 1 string)
361                                  (match-string 2 string))
362              (epg-context-result-for epg-context 'verify)))))
363
364 (defun epg-status-BADSIG (process string)
365   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
366       (epg-context-set-result-for
367        epg-context
368        'verify
369        (cons (epg-make-signature 'bad
370                                  (match-string 1 string)
371                                  (match-string 2 string))
372              (epg-context-result-for epg-context 'verify)))))
373
374 (defun epg-status-TRUST_UNDEFINED (process string)
375   (let ((signature (car (epg-context-result-for-for epg-context 'verify))))
376     (if (and signature
377              (eq (epg-signature-status signature) 'good))
378         (epg-signature-set-validity signature 'unknown))))
379
380 (defun epg-status-TRUST_NEVER (process string)
381   (let ((signature (car (epg-context-result-for epg-context 'verify))))
382     (if (and signature
383              (eq (epg-signature-status signature) 'good))
384         (epg-signature-set-validity signature 'never))))
385
386 (defun epg-status-TRUST_MARGINAL (process string)
387   (let ((signature (car (epg-context-result-for epg-context 'verify))))
388     (if (and signature
389              (eq (epg-signature-status signature) 'marginal))
390         (epg-signature-set-validity signature 'marginal))))
391
392 (defun epg-status-TRUST_FULLY (process string)
393   (let ((signature (car (epg-context-result-for epg-context 'verify))))
394     (if (and signature
395              (eq (epg-signature-status signature) 'good))
396         (epg-signature-set-validity signature 'full))))
397
398 (defun epg-status-TRUST_ULTIMATE (process string)
399   (let ((signature (car (epg-context-result-for epg-context 'verify))))
400     (if (and signature
401              (eq (epg-signature-status signature) 'good))
402         (epg-signature-set-validity signature 'full))))
403
404 (defun epg-status-DECRYPTION_FAILED (process string)
405   (epg-context-set-result-for epg-context 'decrypt 'failed))
406
407 (defun epg-status-PROGRESS (process string)
408   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
409                     string)
410       (funcall (car (epg-context-progress-callback-info epg-context))
411                (match-string 1 string)
412                (match-string 2 string)
413                (string-to-number (match-string 3 string))
414                (string-to-number (match-string 4 string))
415                (cdr (epg-context-progress-callback-info epg-context)))))
416
417 (defun epg-passphrase-callback-function (key-id handback)
418   (read-passwd
419    (if (eq key-id 'SYM)
420        "GnuPG passphrase for symmetric encryption: "
421      (if (eq key-id 'PIN)
422          "GnuPG passphrase for PIN: "
423        (format "GnuPG passphrase for %s: "
424                (let ((entry (assoc key-id epg-user-id-alist)))
425                  (if entry
426                      (cdr entry)
427                    key-id)))))))
428
429 (defun epg-progress-callback-function (what char current total handback)
430   (message "%s: %d%%/%d%%" what current total))
431
432 (defun epg-list-keys (name &optional secret)
433   "List keys associated with STRING."
434   (let ((args (list "--with-colons" "--no-greeting" "--batch"
435                     "--fixed-list-mode"
436                     (if secret "--list-secret-keys" "--list-keys")
437                     name))
438         keys type symbol pointer)
439     (with-temp-buffer
440       (apply #'call-process epg-gpg-program nil (list t nil) nil args)
441       (goto-char (point-min))
442       (while (looking-at "\\([a-z][a-z][a-z]\\):\\(.*\\)")
443         (setq type (match-string 1)
444               symbol (intern-soft (format "epg-colons-%s-spec" type)))
445         (if (member type '("pub" "sec"))
446             (setq keys (cons nil keys)))
447         (if (and symbol
448                  (boundp symbol))
449             (setcar keys (cons (cons (intern type)
450                                      (epg-parse-colons
451                                       (symbol-value symbol)
452                                       (match-string 2)))
453                                (car keys))))
454         (forward-line)))
455     (setq pointer keys)
456     (while pointer
457       (setcar pointer (nreverse (car pointer)))
458       (setq pointer (cdr pointer)))
459     (nreverse keys)))
460
461 (defun epg-parse-colons (alist string)
462   (let ((index 0)
463         result)
464     (while (and alist
465                 (or (null (car alist))
466                     (eq index
467                         (string-match
468                          (concat "\\(" (nth 1 (car alist)) "\\)?:")
469                          string index))))
470       (if (car alist)
471           (progn
472             (setq index (match-end 0))
473             (if (match-beginning 1)
474                 (setq result
475                       (cons (cons (car (car alist))
476                                   (funcall (or (nth 3 (car alist)) #'identity)
477                                            (match-string
478                                             (1+ (or (nth 2 (car alist)) 0))
479                                             string)))
480                             result))))
481         (setq index (1+ index)))
482       (setq alist (cdr alist)))
483     (nreverse result)))
484
485 ;;;###autoload
486 (defun epg-decrypt-start (context input-file)
487   "Initiate a decrypt operation on INPUT-FILE.
488
489 If you use this function, you will need to wait for the completion of
490 `epg-gpg-program' by using `epg-wait-for-completion' and call
491 `epg-reset' to clear a temporaly output file.
492 If you are unsure, use synchronous version of this function
493 `epg-decrypt-string' instead."
494   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
495   (epg-start context
496              (list "--decrypt" input-file))
497   (epg-wait-for-status context '("BEGIN_DECRYPTION")))
498
499 ;;;###autoload
500 (defun epg-decrypt-string (context string)
501   "Decrypt STRING and return the plain text."
502   (let ((input-file (epg-make-temp-file "epg-input"))
503         (coding-system-for-write 'binary))
504     (unwind-protect
505         (progn
506           (write-region string nil input-file)
507           (epg-decrypt-start context input-file)
508           (epg-wait-for-completion context)
509           (unless (epg-context-result-for context 'decrypt)
510             (epg-read-output context)))
511       (epg-reset context)
512       (if (file-exists-p input-file)
513           (delete-file input-file)))))
514
515 ;;;###autoload
516 (defun epg-verify-start (context signature &optional string)
517   "Initiate a verify operation on SIGNATURE.
518
519 For a detached signature, both SIGNATURE and STRING should be string.
520 For a normal or a clear text signature, STRING should be nil.
521
522 If you use this function, you will need to wait for the completion of
523 `epg-gpg-program' by using `epg-wait-for-completion' and call
524 `epg-reset' to clear a temporaly output file.
525 If you are unsure, use synchronous version of this function
526 `epg-verify-string' instead."
527   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
528   (if string
529       ;; Detached signature.
530       (progn
531         (epg-start context
532                    (append (list "--verify")
533                            (list signature "-")))
534         (if (eq (process-status (epg-context-process context)) 'run)
535             (process-send-string (epg-context-process context) string)))
536     ;; Normal (or cleartext) signature.
537     (epg-start context
538                (list "--verify"))
539     (if (eq (process-status (epg-context-process context)) 'run)
540         (process-send-string (epg-context-process context) signature))))
541
542 ;;;###autoload
543 (defun epg-verify-string (context signature &optional string)
544   "Verify SIGNATURE.
545
546 For a detached signature, both SIGNATURE and STRING should be string.
547 For a normal or a clear text signature, STRING should be nil."
548   (let ((input-file (epg-make-temp-file "epg-input"))
549         (coding-system-for-write 'binary))
550     (unwind-protect
551         (progn
552           (if string
553               (write-region signature nil input-file))
554           (epg-verify-start context input-file string)
555           (epg-wait-for-completion context)
556           (epg-context-result-for context 'verify))
557       (epg-reset context)
558       (if (file-exists-p input-file)
559           (delete-file input-file)))))
560
561 ;;;###autoload
562 (defun epg-sign-start (context string &optional mode)
563   "Initiate a sign operation on STRING.
564
565 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
566 If MODE is t or 'detached, it makes a detached signature.
567 Otherwise, it makes a normal signature.
568
569 If you use this function, you will need to wait for the completion of
570 `epg-gpg-program' by using `epg-wait-for-completion' and call
571 `epg-reset' to clear a temporaly output file.
572 If you are unsure, use synchronous version of this function
573 `epg-sign-string' instead."
574   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
575   (epg-start context
576              (append (list (if (eq 'clearsign)
577                                "--clearsign"
578                              (if (or (eq mode t) (eq mode 'detached))
579                                  "--detach-sign"
580                                "--sign")))
581                      (apply #'nconc
582                             (mapcar (lambda (signer)
583                                       (list "-u" signer))
584                                     (epg-context-signers context)))))
585   (epg-wait-for-status context '("BEGIN_SIGNING"))
586   (if (eq (process-status (epg-context-process context)) 'run)
587       (process-send-string (epg-context-process context) string)))
588
589 ;;;###autoload
590 (defun epg-sign-string (context string &optional mode)
591   "Sign STRING and return the output as string.
592 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
593 If MODE is t or 'detached, it makes a detached signature.
594 Otherwise, it makes a normal signature."
595   (unwind-protect
596       (progn
597         (epg-sign-start context string mode)
598         (epg-wait-for-completion context)
599         (epg-read-output context))
600     (epg-reset context)))
601
602 ;;;###autoload
603 (defun epg-encrypt-start (context string recipients
604                                   &optional sign always-trust)
605   "Initiate a encrypt operation on STRING.
606 If RECIPIENTS is nil, it does symmetric encryption.
607
608 If you use this function, you will need to wait for the completion of
609 `epg-gpg-program' by using `epg-wait-for-completion' and call
610 `epg-reset' to clear a temporaly output file.
611 If you are unsure, use synchronous version of this function
612 `epg-encrypt-string' instead."
613   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
614   (epg-start context
615              (append (if always-trust '("--always-trust"))
616                      (if recipients '("--encrypt") '("--symmetric"))
617                      (if sign
618                          (cons "--sign"
619                                (apply #'nconc
620                                       (mapcar (lambda (signer)
621                                                 (list "-u" signer))
622                                               (epg-context-signers context)))))
623                      (apply #'nconc
624                             (mapcar (lambda (recipient)
625                                       (list "-r" recipient))
626                                     recipients))))
627   (if sign
628       (epg-wait-for-status context '("BEGIN_SIGNING")))
629   (if (eq (process-status (epg-context-process context)) 'run)
630       (process-send-string (epg-context-process context) string)))
631
632 ;;;###autoload
633 (defun epg-encrypt-string (context string recipients
634                                    &optional sign always-trust)
635   "Encrypt STRING.
636 If RECIPIENTS is nil, it does symmetric encryption."
637   (unwind-protect
638       (progn
639         (epg-encrypt-start context string recipients sign always-trust)
640         (epg-wait-for-completion context)
641         (epg-read-output context))
642     (epg-reset context)))
643
644 (provide 'epg)
645
646 ;;; epg.el ends here