(gnus-blocked-images): Clarify privacy implications
[emacs.git] / lisp / epg.el
blob091021936ad524ff4f56f6aae13bcfa43b4d6a3a
1 ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
2 ;; Copyright (C) 1999-2000, 2002-2018 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
6 ;; Version: 1.0.0
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23 ;;; Code:
25 (require 'epg-config)
26 (eval-when-compile (require 'cl-lib))
28 (defvar epg-user-id nil
29 "GnuPG ID of your default identity.")
31 (defvar epg-user-id-alist nil
32 "An alist mapping from key ID to user ID.")
34 (defvar epg-last-status nil)
35 (defvar epg-read-point nil)
36 (defvar epg-process-filter-running nil)
37 (defvar epg-pending-status-list nil)
38 (defvar epg-key-id nil)
39 (defvar epg-context nil)
40 (defvar epg-debug-buffer nil)
41 (defvar epg-agent-file nil)
42 (defvar epg-agent-mtime nil)
44 ;; from gnupg/include/cipher.h
45 (defconst epg-cipher-algorithm-alist
46 '((0 . "NONE")
47 (1 . "IDEA")
48 (2 . "3DES")
49 (3 . "CAST5")
50 (4 . "BLOWFISH")
51 (7 . "AES")
52 (8 . "AES192")
53 (9 . "AES256")
54 (10 . "TWOFISH")
55 (11 . "CAMELLIA128")
56 (12 . "CAMELLIA256")
57 (110 . "DUMMY")))
59 ;; from gnupg/include/cipher.h
60 (defconst epg-pubkey-algorithm-alist
61 '((1 . "RSA")
62 (2 . "RSA_E")
63 (3 . "RSA_S")
64 (16 . "ELGAMAL_E")
65 (17 . "DSA")
66 (20 . "ELGAMAL")))
68 ;; from gnupg/include/cipher.h
69 (defconst epg-digest-algorithm-alist
70 '((1 . "MD5")
71 (2 . "SHA1")
72 (3 . "RIPEMD160")
73 (8 . "SHA256")
74 (9 . "SHA384")
75 (10 . "SHA512")
76 (11 . "SHA224")))
78 ;; from gnupg/include/cipher.h
79 (defconst epg-compress-algorithm-alist
80 '((0 . "NONE")
81 (1 . "ZIP")
82 (2 . "ZLIB")
83 (3 . "BZIP2")))
85 (defconst epg-invalid-recipients-reason-alist
86 '((0 . "No specific reason given")
87 (1 . "Not Found")
88 (2 . "Ambiguous specification")
89 (3 . "Wrong key usage")
90 (4 . "Key revoked")
91 (5 . "Key expired")
92 (6 . "No CRL known")
93 (7 . "CRL too old")
94 (8 . "Policy mismatch")
95 (9 . "Not a secret key")
96 (10 . "Key not trusted")))
98 (defconst epg-delete-problem-reason-alist
99 '((1 . "No such key")
100 (2 . "Must delete secret key first")
101 (3 . "Ambiguous specification")))
103 (defconst epg-import-ok-reason-alist
104 '((0 . "Not actually changed")
105 (1 . "Entirely new key")
106 (2 . "New user IDs")
107 (4 . "New signatures")
108 (8 . "New subkeys")
109 (16 . "Contains private key")))
111 (defconst epg-import-problem-reason-alist
112 '((0 . "No specific reason given")
113 (1 . "Invalid Certificate")
114 (2 . "Issuer Certificate missing")
115 (3 . "Certificate Chain too long")
116 (4 . "Error storing certificate")))
118 (defconst epg-no-data-reason-alist
119 '((1 . "No armored data")
120 (2 . "Expected a packet but did not found one")
121 (3 . "Invalid packet found, this may indicate a non OpenPGP message")
122 (4 . "Signature expected but not found")))
124 (defconst epg-unexpected-reason-alist nil)
126 (defvar epg-key-validity-alist
127 '((?o . unknown)
128 (?i . invalid)
129 (?d . disabled)
130 (?r . revoked)
131 (?e . expired)
132 (?- . none)
133 (?q . undefined)
134 (?n . never)
135 (?m . marginal)
136 (?f . full)
137 (?u . ultimate)))
139 (defvar epg-key-capability-alist
140 '((?e . encrypt)
141 (?s . sign)
142 (?c . certify)
143 (?a . authentication)
144 (?D . disabled)))
146 (defvar epg-new-signature-type-alist
147 '((?D . detached)
148 (?C . clear)
149 (?S . normal)))
151 (defvar epg-dn-type-alist
152 '(("1.2.840.113549.1.9.1" . "EMail")
153 ("2.5.4.12" . "T")
154 ("2.5.4.42" . "GN")
155 ("2.5.4.4" . "SN")
156 ("0.2.262.1.10.7.20" . "NameDistinguisher")
157 ("2.5.4.16" . "ADDR")
158 ("2.5.4.15" . "BC")
159 ("2.5.4.13" . "D")
160 ("2.5.4.17" . "PostalCode")
161 ("2.5.4.65" . "Pseudo")
162 ("2.5.4.5" . "SerialNumber")))
164 (defvar epg-prompt-alist nil)
166 (define-error 'epg-error "GPG error")
168 (cl-defstruct (epg-data
169 (:constructor nil)
170 (:constructor epg-make-data-from-file (file))
171 (:constructor epg-make-data-from-string (string))
172 (:copier nil)
173 (:predicate nil))
174 (file nil :read-only t)
175 (string nil :read-only t))
177 (cl-defstruct (epg-context
178 (:constructor nil)
179 (:constructor epg-context--make
180 (protocol &optional armor textmode include-certs
181 cipher-algorithm digest-algorithm
182 compress-algorithm
183 &aux
184 (program
185 (let ((configuration (epg-find-configuration protocol)))
186 (unless configuration
187 (signal 'epg-error
188 (list "no usable configuration" protocol)))
189 (alist-get 'program configuration)))))
190 (:copier nil)
191 (:predicate nil))
192 protocol
193 program
194 (home-directory epg-gpg-home-directory)
195 armor
196 textmode
197 include-certs
198 cipher-algorithm
199 digest-algorithm
200 compress-algorithm
201 (passphrase-callback (list #'epg-passphrase-callback-function))
202 progress-callback
203 edit-callback
204 signers
205 sig-notations
206 process
207 output-file
208 result
209 operation
210 pinentry-mode
211 (error-output "")
212 error-buffer)
214 ;; This is not an alias, just so we can mark it as autoloaded.
215 ;;;###autoload
216 (defun epg-make-context (&optional protocol armor textmode include-certs
217 cipher-algorithm digest-algorithm
218 compress-algorithm)
219 "Return a context object."
220 (epg-context--make (or protocol 'OpenPGP)
221 armor textmode include-certs
222 cipher-algorithm digest-algorithm
223 compress-algorithm))
225 (defun epg-context-set-armor (context armor)
226 "Specify if the output should be ASCII armored in CONTEXT."
227 (declare (obsolete setf "25.1"))
228 (setf (epg-context-armor context) armor))
230 (defun epg-context-set-textmode (context textmode)
231 "Specify if canonical text mode should be used in CONTEXT."
232 (declare (obsolete setf "25.1"))
233 (setf (epg-context-textmode context) textmode))
235 (defun epg-context-set-passphrase-callback (context
236 passphrase-callback)
237 "Set the function used to query passphrase.
239 PASSPHRASE-CALLBACK is either a function, or a cons-cell whose
240 car is a function and cdr is a callback data.
242 The function gets three arguments: the context, the key-id in
243 question, and the callback data (if any).
245 The callback may not be called if you use GnuPG 2.x, which relies
246 on the external program called `gpg-agent' for passphrase query.
247 If you really want to intercept passphrase query, consider
248 installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase
249 query by itself and Emacs can intercept them."
250 ;; (declare (obsolete setf "25.1"))
251 (setf (epg-context-passphrase-callback context)
252 (if (functionp passphrase-callback)
253 (list passphrase-callback)
254 passphrase-callback)))
256 (defun epg-context-set-progress-callback (context
257 progress-callback)
258 "Set the function which handles progress update.
260 PROGRESS-CALLBACK is either a function, or a cons-cell whose
261 car is a function and cdr is a callback data.
263 The function gets six arguments: the context, the operation
264 description, the character to display a progress unit, the
265 current amount done, the total amount to be done, and the
266 callback data (if any)."
267 (setf (epg-context-progress-callback context)
268 (if (functionp progress-callback)
269 (list progress-callback)
270 progress-callback)))
272 (defun epg-context-set-signers (context signers)
273 "Set the list of key-id for signing."
274 (declare (obsolete setf "25.1"))
275 (setf (epg-context-signers context) signers))
277 (cl-defstruct (epg-signature
278 (:constructor nil)
279 (:constructor epg-make-signature
280 (status &optional key-id))
281 (:copier nil)
282 (:predicate nil))
283 status
284 key-id
285 validity
286 fingerprint
287 creation-time
288 expiration-time
289 pubkey-algorithm
290 digest-algorithm
291 class
292 version
293 notations)
295 (cl-defstruct (epg-new-signature
296 (:constructor nil)
297 (:constructor epg-make-new-signature
298 (type pubkey-algorithm digest-algorithm
299 class creation-time fingerprint))
300 (:copier nil)
301 (:predicate nil))
302 (type nil :read-only t)
303 (pubkey-algorithm nil :read-only t)
304 (digest-algorithm nil :read-only t)
305 (class nil :read-only t)
306 (creation-time nil :read-only t)
307 (fingerprint nil :read-only t))
309 (cl-defstruct (epg-key
310 (:constructor nil)
311 (:constructor epg-make-key (owner-trust))
312 (:copier nil)
313 (:predicate nil))
314 (owner-trust nil :read-only t)
315 sub-key-list user-id-list)
317 (cl-defstruct (epg-sub-key
318 (:constructor nil)
319 (:constructor epg-make-sub-key
320 (validity capability secret-p algorithm length id
321 creation-time expiration-time))
322 (:copier nil)
323 (:predicate nil))
324 validity capability secret-p algorithm length id
325 creation-time expiration-time fingerprint)
327 (cl-defstruct (epg-user-id
328 (:constructor nil)
329 (:constructor epg-make-user-id (validity string))
330 (:copier nil)
331 (:predicate nil))
332 validity string signature-list)
334 (cl-defstruct (epg-key-signature
335 (:constructor nil)
336 (:constructor epg-make-key-signature
337 (validity pubkey-algorithm key-id creation-time
338 expiration-time user-id class
339 exportable-p))
340 (:copier nil)
341 (:predicate nil))
342 validity pubkey-algorithm key-id creation-time
343 expiration-time user-id class
344 exportable-p)
346 (cl-defstruct (epg-sig-notation
347 (:constructor nil)
348 (:constructor epg-make-sig-notation
349 (name value &optional human-readable critical))
350 (:copier nil)
351 (:predicate nil))
352 name value human-readable critical)
354 (cl-defstruct (epg-import-status
355 (:constructor nil)
356 (:constructor epg-make-import-status
357 (fingerprint
358 &optional reason new user-id signature sub-key secret))
359 (:copier nil)
360 (:predicate nil))
361 fingerprint reason new user-id signature sub-key secret)
363 (cl-defstruct (epg-import-result
364 (:constructor nil)
365 (:constructor epg-make-import-result
366 (considered no-user-id imported imported-rsa
367 unchanged new-user-ids new-sub-keys
368 new-signatures new-revocations
369 secret-read secret-imported
370 secret-unchanged not-imported
371 imports))
372 (:copier nil)
373 (:predicate nil))
374 considered no-user-id imported imported-rsa
375 unchanged new-user-ids new-sub-keys
376 new-signatures new-revocations
377 secret-read secret-imported
378 secret-unchanged not-imported
379 imports)
381 (defun epg-context-result-for (context name)
382 "Return the result of CONTEXT associated with NAME."
383 (cdr (assq name (epg-context-result context))))
385 (defun epg-context-set-result-for (context name value)
386 "Set the result of CONTEXT associated with NAME to VALUE."
387 (let* ((result (epg-context-result context))
388 (entry (assq name result)))
389 (if entry
390 (setcdr entry value)
391 (setf (epg-context-result context) (cons (cons name value) result)))))
393 (defun epg-signature-to-string (signature)
394 "Convert SIGNATURE to a human readable string."
395 (let* ((user-id (cdr (assoc (epg-signature-key-id signature)
396 epg-user-id-alist)))
397 (pubkey-algorithm (epg-signature-pubkey-algorithm signature))
398 (key-id (epg-signature-key-id signature)))
399 (concat
400 (cond ((eq (epg-signature-status signature) 'good)
401 "Good signature from ")
402 ((eq (epg-signature-status signature) 'bad)
403 "Bad signature from ")
404 ((eq (epg-signature-status signature) 'expired)
405 "Expired signature from ")
406 ((eq (epg-signature-status signature) 'expired-key)
407 "Signature made by expired key ")
408 ((eq (epg-signature-status signature) 'revoked-key)
409 "Signature made by revoked key ")
410 ((eq (epg-signature-status signature) 'no-pubkey)
411 "No public key for "))
412 key-id
413 (if user-id
414 (concat " "
415 (if (stringp user-id)
416 user-id
417 (epg-decode-dn user-id)))
419 (if (epg-signature-validity signature)
420 (format " (trust %s)" (epg-signature-validity signature))
422 (if (epg-signature-creation-time signature)
423 (format-time-string " created at %Y-%m-%dT%T%z"
424 (epg-signature-creation-time signature))
426 (if pubkey-algorithm
427 (concat " using "
428 (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
429 (format "(unknown algorithm %d)" pubkey-algorithm)))
430 ""))))
432 (defun epg-verify-result-to-string (verify-result)
433 "Convert VERIFY-RESULT to a human readable string."
434 (mapconcat #'epg-signature-to-string verify-result "\n"))
436 (defun epg-new-signature-to-string (new-signature)
437 "Convert NEW-SIGNATURE to a human readable string."
438 (concat
439 (cond ((eq (epg-new-signature-type new-signature) 'detached)
440 "Detached signature ")
441 ((eq (epg-new-signature-type new-signature) 'clear)
442 "Cleartext signature ")
444 "Signature "))
445 (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
446 epg-pubkey-algorithm-alist))
448 (cdr (assq (epg-new-signature-digest-algorithm new-signature)
449 epg-digest-algorithm-alist))
451 (format "%02X " (epg-new-signature-class new-signature))
452 (epg-new-signature-fingerprint new-signature)))
454 (defun epg-import-result-to-string (import-result)
455 "Convert IMPORT-RESULT to a human readable string."
456 (concat (format "Total number processed: %d\n"
457 (epg-import-result-considered import-result))
458 (if (> (epg-import-result-not-imported import-result) 0)
459 (format " skipped new keys: %d\n"
460 (epg-import-result-not-imported import-result)))
461 (if (> (epg-import-result-no-user-id import-result) 0)
462 (format " w/o user IDs: %d\n"
463 (epg-import-result-no-user-id import-result)))
464 (if (> (epg-import-result-imported import-result) 0)
465 (concat (format " imported: %d"
466 (epg-import-result-imported import-result))
467 (if (> (epg-import-result-imported-rsa import-result) 0)
468 (format " (RSA: %d)"
469 (epg-import-result-imported-rsa
470 import-result)))
471 "\n"))
472 (if (> (epg-import-result-unchanged import-result) 0)
473 (format " unchanged: %d\n"
474 (epg-import-result-unchanged import-result)))
475 (if (> (epg-import-result-new-user-ids import-result) 0)
476 (format " new user IDs: %d\n"
477 (epg-import-result-new-user-ids import-result)))
478 (if (> (epg-import-result-new-sub-keys import-result) 0)
479 (format " new subkeys: %d\n"
480 (epg-import-result-new-sub-keys import-result)))
481 (if (> (epg-import-result-new-signatures import-result) 0)
482 (format " new signatures: %d\n"
483 (epg-import-result-new-signatures import-result)))
484 (if (> (epg-import-result-new-revocations import-result) 0)
485 (format " new key revocations: %d\n"
486 (epg-import-result-new-revocations import-result)))
487 (if (> (epg-import-result-secret-read import-result) 0)
488 (format " secret keys read: %d\n"
489 (epg-import-result-secret-read import-result)))
490 (if (> (epg-import-result-secret-imported import-result) 0)
491 (format " secret keys imported: %d\n"
492 (epg-import-result-secret-imported import-result)))
493 (if (> (epg-import-result-secret-unchanged import-result) 0)
494 (format " secret keys unchanged: %d\n"
495 (epg-import-result-secret-unchanged import-result)))))
497 (defun epg-error-to-string (error)
498 (cond
499 ((eq (car error) 'exit)
500 "Exit")
501 ((eq (car error) 'quit)
502 "Canceled")
503 ((eq (car error) 'no-data)
504 (let ((entry (assq (cdr error) epg-no-data-reason-alist)))
505 (if entry
506 (format "No data (%s)" (downcase (cdr entry)))
507 "No data")))
508 ((eq (car error) 'unexpected)
509 (let ((entry (assq (cdr error) epg-unexpected-reason-alist)))
510 (if entry
511 (format "Unexpected (%s)" (downcase (cdr entry)))
512 "Unexpected")))
513 ((eq (car error) 'bad-armor)
514 "Bad armor")
515 ((memq (car error) '(invalid-recipient invalid-signer))
516 (concat
517 (if (eq (car error) 'invalid-recipient)
518 "Unusable public key"
519 "Unusable secret key")
520 (let ((entry (assq 'requested (cdr error))))
521 (if entry
522 (format ": %s" (cdr entry))
523 ": <unknown>"))
524 (let ((entry (assq 'reason (cdr error))))
525 (if (and entry
526 (> (cdr entry) 0) ;no specific reason given
527 (setq entry (assq (cdr entry)
528 epg-invalid-recipients-reason-alist)))
529 (format " (%s)" (downcase (cdr entry)))
530 ""))))
531 ((eq (car error) 'no-pubkey)
532 (format "No public key: %s" (cdr error)))
533 ((eq (car error) 'no-seckey)
534 (format "No secret key: %s" (cdr error)))
535 ((eq (car error) 'no-recipients)
536 "No recipients")
537 ((eq (car error) 'no-signers)
538 "No signers")
539 ((eq (car error) 'delete-problem)
540 (let ((entry (assq (cdr error) epg-delete-problem-reason-alist)))
541 (if entry
542 (format "Delete problem (%s)" (downcase (cdr entry)))
543 "Delete problem")))
544 ((eq (car error) 'key-not-created)
545 "Key not created")))
547 (defun epg-errors-to-string (errors)
548 (mapconcat #'epg-error-to-string errors "; "))
550 (defun epg--start (context args)
551 "Start `epg-gpg-program' in a subprocess with given ARGS."
552 (if (and (epg-context-process context)
553 (eq (process-status (epg-context-process context)) 'run))
554 (error "%s is already running in this context"
555 (epg-context-program context)))
556 (let* ((agent-info (getenv "GPG_AGENT_INFO"))
557 (args (append (list "--no-tty"
558 "--status-fd" "1"
559 "--yes")
560 (if (and (not (eq (epg-context-protocol context) 'CMS))
561 (string-match ":" (or agent-info "")))
562 '("--use-agent"))
563 (if (and (not (eq (epg-context-protocol context) 'CMS))
564 (epg-context-progress-callback context))
565 '("--enable-progress-filter"))
566 (if (epg-context-home-directory context)
567 (list "--homedir"
568 (epg-context-home-directory context)))
569 (unless (eq (epg-context-protocol context) 'CMS)
570 '("--command-fd" "0"))
571 (if (epg-context-armor context) '("--armor"))
572 (if (epg-context-textmode context) '("--textmode"))
573 (if (epg-context-output-file context)
574 (list "--output" (epg-context-output-file context)))
575 (if (epg-context-pinentry-mode context)
576 (list "--pinentry-mode"
577 (symbol-name (epg-context-pinentry-mode
578 context))))
579 args))
580 (process-environment process-environment)
581 (buffer (generate-new-buffer " *epg*"))
582 error-process
583 process
584 terminal-name
585 agent-file
586 (agent-mtime '(0 0 0 0)))
587 ;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't
588 ;; use `terminal-name' here to get the real pty name for the child
589 ;; process, though /dev/fd/0" is not portable.
590 (unless (memq system-type '(ms-dos windows-nt))
591 (with-temp-buffer
592 (condition-case nil
593 (when (= (call-process "tty" "/dev/fd/0" t) 0)
594 (delete-char -1)
595 (setq terminal-name (buffer-string)))
596 (file-error))))
597 (when terminal-name
598 (setq process-environment
599 (cons (concat "GPG_TTY=" terminal-name)
600 (cons "TERM=xterm" process-environment))))
601 (setq process-environment
602 (cons (format "INSIDE_EMACS=%s,epg" emacs-version)
603 process-environment))
604 ;; Record modified time of gpg-agent socket to restore the Emacs
605 ;; frame on text terminal in `epg-wait-for-completion'.
606 ;; See
607 ;; <https://lists.gnu.org/r/emacs-devel/2007-02/msg00755.html>
608 ;; for more details.
609 (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info))
610 (setq agent-file (match-string 1 agent-info)
611 agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0))))
612 (if epg-debug
613 (save-excursion
614 (unless epg-debug-buffer
615 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
616 (set-buffer epg-debug-buffer)
617 (goto-char (point-max))
618 (insert (if agent-info
619 (format "GPG_AGENT_INFO=%s\n" agent-info)
620 "GPG_AGENT_INFO is not set\n")
621 (format "%s %s\n"
622 (epg-context-program context)
623 (mapconcat #'identity args " ")))))
624 (with-current-buffer buffer
625 (if (fboundp 'set-buffer-multibyte)
626 (set-buffer-multibyte nil))
627 (make-local-variable 'epg-last-status)
628 (setq epg-last-status nil)
629 (make-local-variable 'epg-read-point)
630 (setq epg-read-point (point-min))
631 (make-local-variable 'epg-process-filter-running)
632 (setq epg-process-filter-running nil)
633 (make-local-variable 'epg-pending-status-list)
634 (setq epg-pending-status-list nil)
635 (make-local-variable 'epg-key-id)
636 (setq epg-key-id nil)
637 (make-local-variable 'epg-context)
638 (setq epg-context context)
639 (make-local-variable 'epg-agent-file)
640 (setq epg-agent-file agent-file)
641 (make-local-variable 'epg-agent-mtime)
642 (setq epg-agent-mtime agent-mtime))
643 (setq error-process
644 (make-pipe-process :name "epg-error"
645 :buffer (generate-new-buffer " *epg-error*")
646 ;; Suppress "XXX finished" line.
647 :sentinel #'ignore
648 :noquery t))
649 (setf (epg-context-error-buffer context) (process-buffer error-process))
650 (with-file-modes 448
651 (setq process (make-process :name "epg"
652 :buffer buffer
653 :command (cons (epg-context-program context)
654 args)
655 :connection-type 'pipe
656 :coding '(binary . binary)
657 :filter #'epg--process-filter
658 :stderr error-process
659 :noquery t)))
660 (setf (epg-context-process context) process)))
662 (defun epg--process-filter (process input)
663 (if epg-debug
664 (with-current-buffer
665 (or epg-debug-buffer
666 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
667 (goto-char (point-max))
668 (insert input)))
669 (if (buffer-live-p (process-buffer process))
670 (with-current-buffer (process-buffer process)
671 (save-excursion
672 (goto-char (point-max))
673 (insert input)
674 (unless epg-process-filter-running
675 (let ((epg-process-filter-running t))
676 (goto-char epg-read-point)
677 (beginning-of-line)
678 (while (looking-at ".*\n") ;the input line finished
679 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
680 (let ((status (match-string 1))
681 (string (match-string 2))
682 symbol)
683 (if (member status epg-pending-status-list)
684 (setq epg-pending-status-list nil))
685 ;; When editing a key, delegate all interaction
686 ;; to edit-callback.
687 (if (eq (epg-context-operation epg-context) 'edit-key)
688 (funcall (car (epg-context-edit-callback
689 epg-context))
690 epg-context
691 status
692 string
693 (cdr (epg-context-edit-callback
694 epg-context)))
695 ;; Otherwise call epg--status-STATUS function.
696 (setq symbol (intern-soft (concat "epg--status-"
697 status)))
698 (if (and symbol
699 (fboundp symbol))
700 (funcall symbol epg-context string)))
701 (setq epg-last-status (cons status string))))
702 (forward-line)
703 (setq epg-read-point (point)))))))))
705 (defun epg-read-output (context)
706 "Read the output file CONTEXT and return the content as a string."
707 (with-temp-buffer
708 (if (fboundp 'set-buffer-multibyte)
709 (set-buffer-multibyte nil))
710 (if (file-exists-p (epg-context-output-file context))
711 (let ((coding-system-for-read 'binary))
712 (insert-file-contents (epg-context-output-file context))
713 (buffer-string)))))
715 (defun epg-wait-for-status (context status-list)
716 "Wait until one of elements in STATUS-LIST arrives."
717 (with-current-buffer (process-buffer (epg-context-process context))
718 (setq epg-pending-status-list status-list)
719 (while (and (eq (process-status (epg-context-process context)) 'run)
720 epg-pending-status-list)
721 (accept-process-output (epg-context-process context) 1))
722 (if epg-pending-status-list
723 (epg-context-set-result-for
724 context 'error
725 (cons '(exit)
726 (epg-context-result-for context 'error))))))
728 (defun epg-wait-for-completion (context)
729 "Wait until the `epg-gpg-program' process completes."
730 (while (eq (process-status (epg-context-process context)) 'run)
731 (accept-process-output (epg-context-process context) 1))
732 ;; This line is needed to run the process-filter right now.
733 (sleep-for 0.1)
734 ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
735 (if (with-current-buffer (process-buffer (epg-context-process context))
736 (and epg-agent-file
737 (time-less-p epg-agent-mtime
738 (or (nth 5 (file-attributes epg-agent-file)) 0))))
739 (redraw-frame))
740 (epg-context-set-result-for
741 context 'error
742 (nreverse (epg-context-result-for context 'error)))
743 (setf (epg-context-error-output context)
744 (with-current-buffer (epg-context-error-buffer context)
745 (buffer-string))))
747 (defun epg-reset (context)
748 "Reset the CONTEXT."
749 (if (and (epg-context-process context)
750 (buffer-live-p (process-buffer (epg-context-process context))))
751 (kill-buffer (process-buffer (epg-context-process context))))
752 (if (buffer-live-p (epg-context-error-buffer context))
753 (kill-buffer (epg-context-error-buffer context)))
754 (setf (epg-context-process context) nil)
755 (setf (epg-context-edit-callback context) nil))
757 (defun epg-delete-output-file (context)
758 "Delete the output file of CONTEXT."
759 (if (and (epg-context-output-file context)
760 (file-exists-p (epg-context-output-file context)))
761 (delete-file (epg-context-output-file context))))
763 (eval-and-compile
764 (if (fboundp 'decode-coding-string)
765 (defalias 'epg--decode-coding-string 'decode-coding-string)
766 (defalias 'epg--decode-coding-string 'identity)))
768 (defun epg--status-USERID_HINT (_context string)
769 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
770 (let* ((key-id (match-string 1 string))
771 (user-id (match-string 2 string))
772 (entry (assoc key-id epg-user-id-alist)))
773 (condition-case nil
774 (setq user-id (epg--decode-coding-string
775 (epg--decode-percent-escape user-id)
776 'utf-8))
777 (error))
778 (if entry
779 (setcdr entry user-id)
780 (setq epg-user-id-alist (cons (cons key-id user-id)
781 epg-user-id-alist))))))
783 (defun epg--status-NEED_PASSPHRASE (_context string)
784 (if (string-match "\\`\\([^ ]+\\)" string)
785 (setq epg-key-id (match-string 1 string))))
787 (defun epg--status-NEED_PASSPHRASE_SYM (_context _string)
788 (setq epg-key-id 'SYM))
790 (defun epg--status-NEED_PASSPHRASE_PIN (_context _string)
791 (setq epg-key-id 'PIN))
793 (eval-and-compile
794 (if (fboundp 'clear-string)
795 (defalias 'epg--clear-string 'clear-string)
796 (defun epg--clear-string (string)
797 (fillarray string 0))))
799 (eval-and-compile
800 (if (fboundp 'encode-coding-string)
801 (defalias 'epg--encode-coding-string 'encode-coding-string)
802 (defalias 'epg--encode-coding-string 'identity)))
804 (defun epg--status-GET_HIDDEN (context string)
805 (when (and epg-key-id
806 (string-match "\\`passphrase\\." string))
807 (unless (epg-context-passphrase-callback context)
808 (error "passphrase-callback not set"))
809 (let (inhibit-quit
810 passphrase
811 passphrase-with-new-line
812 encoded-passphrase-with-new-line)
813 (unwind-protect
814 (condition-case nil
815 (progn
816 (setq passphrase
817 (funcall
818 (car (epg-context-passphrase-callback context))
819 context
820 epg-key-id
821 (cdr (epg-context-passphrase-callback context))))
822 (when passphrase
823 (setq passphrase-with-new-line (concat passphrase "\n"))
824 (epg--clear-string passphrase)
825 (setq passphrase nil)
826 (if epg-passphrase-coding-system
827 (progn
828 (setq encoded-passphrase-with-new-line
829 (epg--encode-coding-string
830 passphrase-with-new-line
831 (coding-system-change-eol-conversion
832 epg-passphrase-coding-system 'unix)))
833 (epg--clear-string passphrase-with-new-line)
834 (setq passphrase-with-new-line nil))
835 (setq encoded-passphrase-with-new-line
836 passphrase-with-new-line
837 passphrase-with-new-line nil))
838 (process-send-string (epg-context-process context)
839 encoded-passphrase-with-new-line)))
840 (quit
841 (epg-context-set-result-for
842 context 'error
843 (cons '(quit)
844 (epg-context-result-for context 'error)))
845 (delete-process (epg-context-process context))))
846 (if passphrase
847 (epg--clear-string passphrase))
848 (if passphrase-with-new-line
849 (epg--clear-string passphrase-with-new-line))
850 (if encoded-passphrase-with-new-line
851 (epg--clear-string encoded-passphrase-with-new-line))))))
853 (defun epg--prompt-GET_BOOL (_context string)
854 (let ((entry (assoc string epg-prompt-alist)))
855 (y-or-n-p (if entry (cdr entry) (concat string "? ")))))
857 (defun epg--prompt-GET_BOOL-untrusted_key.override (_context _string)
858 (y-or-n-p (if (and (equal (car epg-last-status) "USERID_HINT")
859 (string-match "\\`\\([^ ]+\\) \\(.*\\)"
860 (cdr epg-last-status)))
861 (let* ((key-id (match-string 1 (cdr epg-last-status)))
862 (user-id (match-string 2 (cdr epg-last-status)))
863 (entry (assoc key-id epg-user-id-alist)))
864 (if entry
865 (setq user-id (cdr entry)))
866 (format "Untrusted key %s %s. Use anyway? " key-id user-id))
867 "Use untrusted key anyway? ")))
869 (defun epg--status-GET_BOOL (context string)
870 (let (inhibit-quit)
871 (condition-case nil
872 (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string))
873 #'epg--prompt-GET_BOOL)
874 context string)
875 (process-send-string (epg-context-process context) "y\n")
876 (process-send-string (epg-context-process context) "n\n"))
877 (quit
878 (epg-context-set-result-for
879 context 'error
880 (cons '(quit)
881 (epg-context-result-for context 'error)))
882 (delete-process (epg-context-process context))))))
884 (defun epg--status-GET_LINE (context string)
885 (let ((entry (assoc string epg-prompt-alist))
886 inhibit-quit)
887 (condition-case nil
888 (process-send-string (epg-context-process context)
889 (concat (read-string
890 (if entry
891 (cdr entry)
892 (concat string ": ")))
893 "\n"))
894 (quit
895 (epg-context-set-result-for
896 context 'error
897 (cons '(quit)
898 (epg-context-result-for context 'error)))
899 (delete-process (epg-context-process context))))))
901 (defun epg--status-*SIG (context status string)
902 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
903 (let* ((key-id (match-string 1 string))
904 (user-id (match-string 2 string))
905 (entry (assoc key-id epg-user-id-alist)))
906 (epg-context-set-result-for
907 context
908 'verify
909 (cons (epg-make-signature status key-id)
910 (epg-context-result-for context 'verify)))
911 (condition-case nil
912 (if (eq (epg-context-protocol context) 'CMS)
913 (setq user-id (epg-dn-from-string user-id))
914 (setq user-id (epg--decode-coding-string
915 (epg--decode-percent-escape user-id)
916 'utf-8)))
917 (error))
918 (if entry
919 (setcdr entry user-id)
920 (setq epg-user-id-alist
921 (cons (cons key-id user-id) epg-user-id-alist))))
922 (epg-context-set-result-for
923 context
924 'verify
925 (cons (epg-make-signature status)
926 (epg-context-result-for context 'verify)))))
928 (defun epg--status-GOODSIG (context string)
929 (epg--status-*SIG context 'good string))
931 (defun epg--status-EXPSIG (context string)
932 (epg--status-*SIG context 'expired string))
934 (defun epg--status-EXPKEYSIG (context string)
935 (epg--status-*SIG context 'expired-key string))
937 (defun epg--status-REVKEYSIG (context string)
938 (epg--status-*SIG context 'revoked-key string))
940 (defun epg--status-BADSIG (context string)
941 (epg--status-*SIG context 'bad string))
943 (defun epg--status-NO_PUBKEY (context string)
944 (if (eq (epg-context-operation context) 'verify)
945 (let ((signature (car (epg-context-result-for context 'verify))))
946 (if (and signature
947 (eq (epg-signature-status signature) 'error)
948 (equal (epg-signature-key-id signature) string))
949 (setf (epg-signature-status signature) 'no-pubkey)))
950 (epg-context-set-result-for
951 context 'error
952 (cons (cons 'no-pubkey string)
953 (epg-context-result-for context 'error)))))
955 (defun epg--status-NO_SECKEY (context string)
956 (epg-context-set-result-for
957 context 'error
958 (cons (cons 'no-seckey string)
959 (epg-context-result-for context 'error))))
961 (defun epg--time-from-seconds (seconds)
962 (let ((number-seconds (string-to-number (concat seconds ".0"))))
963 (cons (floor (/ number-seconds 65536))
964 (floor (mod number-seconds 65536)))))
966 (defun epg--status-ERRSIG (context string)
967 (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
968 \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
969 string)
970 (let ((signature (epg-make-signature 'error)))
971 (epg-context-set-result-for
972 context
973 'verify
974 (cons signature
975 (epg-context-result-for context 'verify)))
976 (setf (epg-signature-key-id signature)
977 (match-string 1 string))
978 (setf (epg-signature-pubkey-algorithm signature)
979 (string-to-number (match-string 2 string)))
980 (setf (epg-signature-digest-algorithm signature)
981 (string-to-number (match-string 3 string)))
982 (setf (epg-signature-class signature)
983 (string-to-number (match-string 4 string) 16))
984 (setf (epg-signature-creation-time signature)
985 (epg--time-from-seconds (match-string 5 string))))))
987 (defun epg--status-VALIDSIG (context string)
988 (let ((signature (car (epg-context-result-for context 'verify))))
989 (when (and signature
990 (eq (epg-signature-status signature) 'good)
991 (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
992 \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
993 \\(.*\\)"
994 string))
995 (setf (epg-signature-fingerprint signature)
996 (match-string 1 string))
997 (setf (epg-signature-creation-time signature)
998 (epg--time-from-seconds (match-string 2 string)))
999 (unless (equal (match-string 3 string) "0")
1000 (setf (epg-signature-expiration-time signature)
1001 (epg--time-from-seconds (match-string 3 string))))
1002 (setf (epg-signature-version signature)
1003 (string-to-number (match-string 4 string)))
1004 (setf (epg-signature-pubkey-algorithm signature)
1005 (string-to-number (match-string 5 string)))
1006 (setf (epg-signature-digest-algorithm signature)
1007 (string-to-number (match-string 6 string)))
1008 (setf (epg-signature-class signature)
1009 (string-to-number (match-string 7 string) 16)))))
1011 (defun epg--status-TRUST_UNDEFINED (context _string)
1012 (let ((signature (car (epg-context-result-for context 'verify))))
1013 (if (and signature
1014 (eq (epg-signature-status signature) 'good))
1015 (setf (epg-signature-validity signature) 'undefined))))
1017 (defun epg--status-TRUST_NEVER (context _string)
1018 (let ((signature (car (epg-context-result-for context 'verify))))
1019 (if (and signature
1020 (eq (epg-signature-status signature) 'good))
1021 (setf (epg-signature-validity signature) 'never))))
1023 (defun epg--status-TRUST_MARGINAL (context _string)
1024 (let ((signature (car (epg-context-result-for context 'verify))))
1025 (if (and signature
1026 (eq (epg-signature-status signature) 'good))
1027 (setf (epg-signature-validity signature) 'marginal))))
1029 (defun epg--status-TRUST_FULLY (context _string)
1030 (let ((signature (car (epg-context-result-for context 'verify))))
1031 (if (and signature
1032 (eq (epg-signature-status signature) 'good))
1033 (setf (epg-signature-validity signature) 'full))))
1035 (defun epg--status-TRUST_ULTIMATE (context _string)
1036 (let ((signature (car (epg-context-result-for context 'verify))))
1037 (if (and signature
1038 (eq (epg-signature-status signature) 'good))
1039 (setf (epg-signature-validity signature) 'ultimate))))
1041 (defun epg--status-NOTATION_NAME (context string)
1042 (let ((signature (car (epg-context-result-for context 'verify))))
1043 (if signature
1044 (push (epg-make-sig-notation string nil t nil)
1045 (epg-signature-notations signature)))))
1047 (defun epg--status-NOTATION_DATA (context string)
1048 (let ((signature (car (epg-context-result-for context 'verify)))
1049 notation)
1050 (if (and signature
1051 (setq notation (car (epg-signature-notations signature))))
1052 (setf (epg-sig-notation-value notation) string))))
1054 (defun epg--status-POLICY_URL (context string)
1055 (let ((signature (car (epg-context-result-for context 'verify))))
1056 (if signature
1057 (push (epg-make-sig-notation nil string t nil)
1058 (epg-signature-notations signature)))))
1060 (defun epg--status-PROGRESS (context string)
1061 (if (and (epg-context-progress-callback context)
1062 (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1063 string))
1064 (funcall (car (epg-context-progress-callback context))
1065 context
1066 (match-string 1 string)
1067 (match-string 2 string)
1068 (string-to-number (match-string 3 string))
1069 (string-to-number (match-string 4 string))
1070 (cdr (epg-context-progress-callback context)))))
1072 (defun epg--status-ENC_TO (context string)
1073 (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1074 (epg-context-set-result-for
1075 context 'encrypted-to
1076 (cons (list (match-string 1 string)
1077 (string-to-number (match-string 2 string))
1078 (string-to-number (match-string 3 string)))
1079 (epg-context-result-for context 'encrypted-to)))))
1081 (defun epg--status-DECRYPTION_FAILED (context _string)
1082 (epg-context-set-result-for context 'decryption-failed t))
1084 (defun epg--status-DECRYPTION_OKAY (context _string)
1085 (epg-context-set-result-for context 'decryption-okay t))
1087 (defun epg--status-NODATA (context string)
1088 (epg-context-set-result-for
1089 context 'error
1090 (cons (cons 'no-data (string-to-number string))
1091 (epg-context-result-for context 'error))))
1093 (defun epg--status-UNEXPECTED (context string)
1094 (epg-context-set-result-for
1095 context 'error
1096 (cons (cons 'unexpected (string-to-number string))
1097 (epg-context-result-for context 'error))))
1099 (defun epg--status-KEYEXPIRED (context string)
1100 (epg-context-set-result-for
1101 context 'key
1102 (cons (list 'key-expired (cons 'expiration-time
1103 (epg--time-from-seconds string)))
1104 (epg-context-result-for context 'key))))
1106 (defun epg--status-KEYREVOKED (context _string)
1107 (epg-context-set-result-for
1108 context 'key
1109 (cons '(key-revoked)
1110 (epg-context-result-for context 'key))))
1112 (defun epg--status-BADARMOR (context _string)
1113 (epg-context-set-result-for
1114 context 'error
1115 (cons '(bad-armor)
1116 (epg-context-result-for context 'error))))
1118 (defun epg--status-INV_RECP (context string)
1119 (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1120 (epg-context-set-result-for
1121 context 'error
1122 (cons (list 'invalid-recipient
1123 (cons 'reason
1124 (string-to-number (match-string 1 string)))
1125 (cons 'requested
1126 (match-string 2 string)))
1127 (epg-context-result-for context 'error)))))
1129 (defun epg--status-INV_SGNR (context string)
1130 (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1131 (epg-context-set-result-for
1132 context 'error
1133 (cons (list 'invalid-signer
1134 (cons 'reason
1135 (string-to-number (match-string 1 string)))
1136 (cons 'requested
1137 (match-string 2 string)))
1138 (epg-context-result-for context 'error)))))
1140 (defun epg--status-NO_RECP (context _string)
1141 (epg-context-set-result-for
1142 context 'error
1143 (cons '(no-recipients)
1144 (epg-context-result-for context 'error))))
1146 (defun epg--status-NO_SGNR (context _string)
1147 (epg-context-set-result-for
1148 context 'error
1149 (cons '(no-signers)
1150 (epg-context-result-for context 'error))))
1152 (defun epg--status-DELETE_PROBLEM (context string)
1153 (if (string-match "\\`\\([0-9]+\\)" string)
1154 (epg-context-set-result-for
1155 context 'error
1156 (cons (cons 'delete-problem
1157 (string-to-number (match-string 1 string)))
1158 (epg-context-result-for context 'error)))))
1160 (defun epg--status-SIG_CREATED (context string)
1161 (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1162 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1163 (epg-context-set-result-for
1164 context 'sign
1165 (cons (epg-make-new-signature
1166 (cdr (assq (aref (match-string 1 string) 0)
1167 epg-new-signature-type-alist))
1168 (string-to-number (match-string 2 string))
1169 (string-to-number (match-string 3 string))
1170 (string-to-number (match-string 4 string) 16)
1171 (epg--time-from-seconds (match-string 5 string))
1172 (substring string (match-end 0)))
1173 (epg-context-result-for context 'sign)))))
1175 (defun epg--status-KEY_CREATED (context string)
1176 (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1177 (epg-context-set-result-for
1178 context 'generate-key
1179 (cons (list (cons 'type (string-to-char (match-string 1 string)))
1180 (cons 'fingerprint (match-string 2 string)))
1181 (epg-context-result-for context 'generate-key)))))
1183 (defun epg--status-KEY_NOT_CREATED (context _string)
1184 (epg-context-set-result-for
1185 context 'error
1186 (cons '(key-not-created)
1187 (epg-context-result-for context 'error))))
1189 (defun epg--status-IMPORTED (_context string)
1190 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1191 (let* ((key-id (match-string 1 string))
1192 (user-id (match-string 2 string))
1193 (entry (assoc key-id epg-user-id-alist)))
1194 (condition-case nil
1195 (setq user-id (epg--decode-coding-string
1196 (epg--decode-percent-escape user-id)
1197 'utf-8))
1198 (error))
1199 (if entry
1200 (setcdr entry user-id)
1201 (setq epg-user-id-alist (cons (cons key-id user-id)
1202 epg-user-id-alist))))))
1204 (defun epg--status-IMPORT_OK (context string)
1205 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1206 (let ((reason (string-to-number (match-string 1 string))))
1207 (epg-context-set-result-for
1208 context 'import-status
1209 (cons (epg-make-import-status (if (match-beginning 2)
1210 (match-string 3 string))
1212 (/= (logand reason 1) 0)
1213 (/= (logand reason 2) 0)
1214 (/= (logand reason 4) 0)
1215 (/= (logand reason 8) 0)
1216 (/= (logand reason 16) 0))
1217 (epg-context-result-for context 'import-status))))))
1219 (defun epg--status-IMPORT_PROBLEM (context string)
1220 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1221 (epg-context-set-result-for
1222 context 'import-status
1223 (cons (epg-make-import-status
1224 (if (match-beginning 2)
1225 (match-string 3 string))
1226 (string-to-number (match-string 1 string)))
1227 (epg-context-result-for context 'import-status)))))
1229 (defun epg--status-IMPORT_RES (context string)
1230 (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1231 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1232 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1233 (epg-context-set-result-for
1234 context 'import
1235 (epg-make-import-result (string-to-number (match-string 1 string))
1236 (string-to-number (match-string 2 string))
1237 (string-to-number (match-string 3 string))
1238 (string-to-number (match-string 4 string))
1239 (string-to-number (match-string 5 string))
1240 (string-to-number (match-string 6 string))
1241 (string-to-number (match-string 7 string))
1242 (string-to-number (match-string 8 string))
1243 (string-to-number (match-string 9 string))
1244 (string-to-number (match-string 10 string))
1245 (string-to-number (match-string 11 string))
1246 (string-to-number (match-string 12 string))
1247 (string-to-number (match-string 13 string))
1248 (epg-context-result-for context 'import-status)))
1249 (epg-context-set-result-for context 'import-status nil)))
1251 (defun epg-passphrase-callback-function (context key-id _handback)
1252 (declare (obsolete epa-passphrase-callback-function "23.1"))
1253 (if (eq key-id 'SYM)
1254 (read-passwd "Passphrase for symmetric encryption: "
1255 (eq (epg-context-operation context) 'encrypt))
1256 (read-passwd
1257 (if (eq key-id 'PIN)
1258 "Passphrase for PIN: "
1259 (let ((entry (assoc key-id epg-user-id-alist)))
1260 (if entry
1261 (format "Passphrase for %s %s: " key-id (cdr entry))
1262 (format "Passphrase for %s: " key-id)))))))
1264 (defun epg--list-keys-1 (context name mode)
1265 (let ((args (append (if (epg-context-home-directory context)
1266 (list "--homedir"
1267 (epg-context-home-directory context)))
1268 '("--with-colons" "--no-greeting" "--batch"
1269 "--with-fingerprint" "--with-fingerprint")
1270 (unless (eq (epg-context-protocol context) 'CMS)
1271 '("--fixed-list-mode"))))
1272 (list-keys-option (if (memq mode '(t secret))
1273 "--list-secret-keys"
1274 (if (memq mode '(nil public))
1275 "--list-keys"
1276 "--list-sigs")))
1277 (coding-system-for-read 'binary)
1278 keys string field index)
1279 (if name
1280 (progn
1281 (unless (listp name)
1282 (setq name (list name)))
1283 (while name
1284 (setq args (append args (list list-keys-option (car name)))
1285 name (cdr name))))
1286 (setq args (append args (list list-keys-option))))
1287 (with-temp-buffer
1288 (apply #'call-process
1289 (epg-context-program context)
1290 nil (list t nil) nil args)
1291 (goto-char (point-min))
1292 (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1293 (setq keys (cons (make-vector 15 nil) keys)
1294 string (match-string 0)
1295 index 0
1296 field 0)
1297 (while (and (< field (length (car keys)))
1298 (eq index
1299 (string-match "\\([^:]+\\)?:" string index)))
1300 (setq index (match-end 0))
1301 (aset (car keys) field (match-string 1 string))
1302 (setq field (1+ field))))
1303 (nreverse keys))))
1305 (defun epg--make-sub-key-1 (line)
1306 (epg-make-sub-key
1307 (if (aref line 1)
1308 (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1309 (delq nil
1310 (mapcar (lambda (char) (cdr (assq char epg-key-capability-alist)))
1311 (aref line 11)))
1312 (member (aref line 0) '("sec" "ssb"))
1313 (string-to-number (aref line 3))
1314 (string-to-number (aref line 2))
1315 (aref line 4)
1316 (epg--time-from-seconds (aref line 5))
1317 (if (aref line 6)
1318 (epg--time-from-seconds (aref line 6)))))
1320 (defun epg-list-keys (context &optional name mode)
1321 "Return a list of epg-key objects matched with NAME.
1322 If MODE is nil or `public', only public keyring should be searched.
1323 If MODE is t or `secret', only secret keyring should be searched.
1324 Otherwise, only public keyring should be searched and the key
1325 signatures should be included.
1326 NAME is either a string or a list of strings."
1327 (let ((lines (epg--list-keys-1 context name mode))
1328 keys cert pointer pointer-1 index string)
1329 (while lines
1330 (cond
1331 ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1332 (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1333 keys (cons (epg-make-key
1334 (if (aref (car lines) 8)
1335 (cdr (assq (string-to-char (aref (car lines) 8))
1336 epg-key-validity-alist))))
1337 keys))
1338 (push (epg--make-sub-key-1 (car lines))
1339 (epg-key-sub-key-list (car keys))))
1340 ((member (aref (car lines) 0) '("sub" "ssb"))
1341 (push (epg--make-sub-key-1 (car lines))
1342 (epg-key-sub-key-list (car keys))))
1343 ((equal (aref (car lines) 0) "uid")
1344 ;; Decode the UID name as a backslash escaped UTF-8 string,
1345 ;; generated by GnuPG/GpgSM.
1346 (setq string (copy-sequence (aref (car lines) 9))
1347 index 0)
1348 (while (string-match "\"" string index)
1349 (setq string (replace-match "\\\"" t t string)
1350 index (1+ (match-end 0))))
1351 (condition-case nil
1352 (setq string (epg--decode-coding-string
1353 (car (read-from-string (concat "\"" string "\"")))
1354 'utf-8))
1355 (error
1356 (setq string (aref (car lines) 9))))
1357 (push (epg-make-user-id
1358 (if (aref (car lines) 1)
1359 (cdr (assq (string-to-char (aref (car lines) 1))
1360 epg-key-validity-alist)))
1361 (if cert
1362 (condition-case nil
1363 (epg-dn-from-string string)
1364 (error string))
1365 string))
1366 (epg-key-user-id-list (car keys))))
1367 ((equal (aref (car lines) 0) "fpr")
1368 (setf (epg-sub-key-fingerprint (car (epg-key-sub-key-list (car keys))))
1369 (aref (car lines) 9)))
1370 ((equal (aref (car lines) 0) "sig")
1371 (push
1372 (epg-make-key-signature
1373 (if (aref (car lines) 1)
1374 (cdr (assq (string-to-char (aref (car lines) 1))
1375 epg-key-validity-alist)))
1376 (string-to-number (aref (car lines) 3))
1377 (aref (car lines) 4)
1378 (epg--time-from-seconds (aref (car lines) 5))
1379 (epg--time-from-seconds (aref (car lines) 6))
1380 (aref (car lines) 9)
1381 (string-to-number (aref (car lines) 10) 16)
1382 (eq (aref (aref (car lines) 10) 2) ?x))
1383 (epg-user-id-signature-list
1384 (car (epg-key-user-id-list (car keys)))))))
1385 (setq lines (cdr lines)))
1386 (setq keys (nreverse keys)
1387 pointer keys)
1388 (while pointer
1389 (cl-callf nreverse (epg-key-sub-key-list (car pointer)))
1390 (setq pointer-1 (cl-callf nreverse (epg-key-user-id-list (car pointer))))
1391 (while pointer-1
1392 (cl-callf nreverse (epg-user-id-signature-list (car pointer-1)))
1393 (setq pointer-1 (cdr pointer-1)))
1394 (setq pointer (cdr pointer)))
1395 keys))
1397 (eval-and-compile
1398 (if (fboundp 'make-temp-file)
1399 (defalias 'epg--make-temp-file 'make-temp-file)
1400 (defvar temporary-file-directory)
1401 ;; stolen from poe.el.
1402 (defun epg--make-temp-file (prefix)
1403 "Create a temporary file.
1404 The returned file name (created by appending some random characters at the end
1405 of PREFIX, and expanding against `temporary-file-directory' if necessary),
1406 is guaranteed to point to a newly created empty file.
1407 You can then use `write-region' to write new data into the file."
1408 (let ((orig-modes (default-file-modes))
1409 tempdir tempfile)
1410 (setq prefix (expand-file-name prefix
1411 (if (featurep 'xemacs)
1412 (temp-directory)
1413 temporary-file-directory)))
1414 (unwind-protect
1415 (let (file)
1416 ;; First, create a temporary directory.
1417 (set-default-file-modes #o700)
1418 (while (condition-case ()
1419 (progn
1420 (setq tempdir (make-temp-name
1421 (concat
1422 (file-name-directory prefix)
1423 "DIR")))
1424 ;; return nil or signal an error.
1425 (make-directory tempdir))
1426 ;; let's try again.
1427 (file-already-exists t)))
1428 ;; Second, create a temporary file in the tempdir.
1429 ;; There *is* a race condition between `make-temp-name'
1430 ;; and `write-region', but we don't care it since we are
1431 ;; in a private directory now.
1432 (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1433 (write-region "" nil tempfile nil 'silent)
1434 ;; Finally, make a hard-link from the tempfile.
1435 (while (condition-case ()
1436 (progn
1437 (setq file (make-temp-name prefix))
1438 ;; return nil or signal an error.
1439 (add-name-to-file tempfile file))
1440 ;; let's try again.
1441 (file-already-exists t)))
1442 file)
1443 (set-default-file-modes orig-modes)
1444 ;; Cleanup the tempfile.
1445 (and tempfile
1446 (file-exists-p tempfile)
1447 (delete-file tempfile))
1448 ;; Cleanup the tempdir.
1449 (and tempdir
1450 (file-directory-p tempdir)
1451 (delete-directory tempdir)))))))
1453 (defun epg--args-from-sig-notations (notations)
1454 (apply #'nconc
1455 (mapcar
1456 (lambda (notation)
1457 (if (and (epg-sig-notation-name notation)
1458 (not (epg-sig-notation-human-readable notation)))
1459 (error "Unreadable"))
1460 (if (epg-sig-notation-name notation)
1461 (list "--sig-notation"
1462 (if (epg-sig-notation-critical notation)
1463 (concat "!" (epg-sig-notation-name notation)
1464 "=" (epg-sig-notation-value notation))
1465 (concat (epg-sig-notation-name notation)
1466 "=" (epg-sig-notation-value notation))))
1467 (list "--sig-policy-url"
1468 (if (epg-sig-notation-critical notation)
1469 (concat "!" (epg-sig-notation-value notation))
1470 (epg-sig-notation-value notation)))))
1471 notations)))
1473 (defun epg-cancel (context)
1474 (if (buffer-live-p (process-buffer (epg-context-process context)))
1475 (with-current-buffer (process-buffer (epg-context-process context))
1476 (epg-context-set-result-for
1477 epg-context 'error
1478 (cons '(quit)
1479 (epg-context-result-for epg-context 'error)))))
1480 (if (eq (process-status (epg-context-process context)) 'run)
1481 (delete-process (epg-context-process context))))
1483 (defun epg-start-decrypt (context cipher)
1484 "Initiate a decrypt operation on CIPHER.
1485 CIPHER must be a file data object.
1487 If you use this function, you will need to wait for the completion of
1488 `epg-gpg-program' by using `epg-wait-for-completion' and call
1489 `epg-reset' to clear a temporary output file.
1490 If you are unsure, use synchronous version of this function
1491 `epg-decrypt-file' or `epg-decrypt-string' instead."
1492 (unless (epg-data-file cipher)
1493 (error "Not a file"))
1494 (setf (epg-context-operation context) 'decrypt)
1495 (setf (epg-context-result context) nil)
1496 (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
1497 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1498 (unless (eq (epg-context-protocol context) 'CMS)
1499 (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1501 (defun epg--check-error-for-decrypt (context)
1502 (let ((errors (epg-context-result-for context 'error)))
1503 (if (epg-context-result-for context 'decryption-failed)
1504 (signal 'epg-error
1505 (list "Decryption failed" (epg-errors-to-string errors))))
1506 (unless (epg-context-result-for context 'decryption-okay)
1507 (signal 'epg-error
1508 (list "Can't decrypt" (epg-errors-to-string errors))))))
1510 (defun epg-decrypt-file (context cipher plain)
1511 "Decrypt a file CIPHER and store the result to a file PLAIN.
1512 If PLAIN is nil, it returns the result as a string."
1513 (unwind-protect
1514 (progn
1515 (setf (epg-context-output-file context)
1516 (or plain (epg--make-temp-file "epg-output")))
1517 (epg-start-decrypt context (epg-make-data-from-file cipher))
1518 (epg-wait-for-completion context)
1519 (epg--check-error-for-decrypt context)
1520 (unless plain
1521 (epg-read-output context)))
1522 (unless plain
1523 (epg-delete-output-file context))
1524 (epg-reset context)))
1526 (defun epg-decrypt-string (context cipher)
1527 "Decrypt a string CIPHER and return the plain text."
1528 (let ((input-file (epg--make-temp-file "epg-input"))
1529 (coding-system-for-write 'binary))
1530 (unwind-protect
1531 (progn
1532 (write-region cipher nil input-file nil 'quiet)
1533 (setf (epg-context-output-file context)
1534 (epg--make-temp-file "epg-output"))
1535 (epg-start-decrypt context (epg-make-data-from-file input-file))
1536 (epg-wait-for-completion context)
1537 (epg--check-error-for-decrypt context)
1538 (epg-read-output context))
1539 (epg-delete-output-file context)
1540 (if (file-exists-p input-file)
1541 (delete-file input-file))
1542 (epg-reset context))))
1544 (defun epg-start-verify (context signature &optional signed-text)
1545 "Initiate a verify operation on SIGNATURE.
1546 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
1548 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
1549 For a normal or a cleartext signature, SIGNED-TEXT should be nil.
1551 If you use this function, you will need to wait for the completion of
1552 `epg-gpg-program' by using `epg-wait-for-completion' and call
1553 `epg-reset' to clear a temporary output file.
1554 If you are unsure, use synchronous version of this function
1555 `epg-verify-file' or `epg-verify-string' instead."
1556 (setf (epg-context-operation context) 'verify)
1557 (setf (epg-context-result context) nil)
1558 (if signed-text
1559 ;; Detached signature.
1560 (if (epg-data-file signed-text)
1561 (epg--start context (list "--verify" "--" (epg-data-file signature)
1562 (epg-data-file signed-text)))
1563 (epg--start context (list "--verify" "--" (epg-data-file signature)
1564 "-"))
1565 (if (eq (process-status (epg-context-process context)) 'run)
1566 (process-send-string (epg-context-process context)
1567 (epg-data-string signed-text)))
1568 (if (eq (process-status (epg-context-process context)) 'run)
1569 (process-send-eof (epg-context-process context))))
1570 ;; Normal (or cleartext) signature.
1571 (if (epg-data-file signature)
1572 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
1573 (list "--verify" "--" (epg-data-file signature))
1574 (list "--" (epg-data-file signature))))
1575 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
1576 '("--verify" "-")
1577 '("-")))
1578 (if (eq (process-status (epg-context-process context)) 'run)
1579 (process-send-string (epg-context-process context)
1580 (epg-data-string signature)))
1581 (if (eq (process-status (epg-context-process context)) 'run)
1582 (process-send-eof (epg-context-process context))))))
1584 (defun epg-verify-file (context signature &optional signed-text plain)
1585 "Verify a file SIGNATURE.
1586 SIGNED-TEXT and PLAIN are also a file if they are specified.
1588 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
1589 string. For a normal or a cleartext signature, SIGNED-TEXT should be
1590 nil. In the latter case, if PLAIN is specified, the plaintext is
1591 stored into the file after successful verification.
1593 Note that this function does not return verification result as t
1594 or nil, nor signal error on failure. That's a design decision to
1595 handle the case where SIGNATURE has multiple signature.
1597 To check the verification results, use `epg-context-result-for' as follows:
1599 \(epg-context-result-for context \\='verify)
1601 which will return a list of `epg-signature' object."
1602 (unwind-protect
1603 (progn
1604 (setf (epg-context-output-file context)
1605 (or plain (epg--make-temp-file "epg-output")))
1606 (if signed-text
1607 (epg-start-verify context
1608 (epg-make-data-from-file signature)
1609 (epg-make-data-from-file signed-text))
1610 (epg-start-verify context
1611 (epg-make-data-from-file signature)))
1612 (epg-wait-for-completion context)
1613 (unless plain
1614 (epg-read-output context)))
1615 (unless plain
1616 (epg-delete-output-file context))
1617 (epg-reset context)))
1619 (defun epg-verify-string (context signature &optional signed-text)
1620 "Verify a string SIGNATURE.
1621 SIGNED-TEXT is a string if it is specified.
1623 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
1624 string. For a normal or a cleartext signature, SIGNED-TEXT should be
1625 nil. In the latter case, this function returns the plaintext after
1626 successful verification.
1628 Note that this function does not return verification result as t
1629 or nil, nor signal error on failure. That's a design decision to
1630 handle the case where SIGNATURE has multiple signature.
1632 To check the verification results, use `epg-context-result-for' as follows:
1634 \(epg-context-result-for context \\='verify)
1636 which will return a list of `epg-signature' object."
1637 (let ((coding-system-for-write 'binary)
1638 input-file)
1639 (unwind-protect
1640 (progn
1641 (setf (epg-context-output-file context)
1642 (epg--make-temp-file "epg-output"))
1643 (if signed-text
1644 (progn
1645 (setq input-file (epg--make-temp-file "epg-signature"))
1646 (write-region signature nil input-file nil 'quiet)
1647 (epg-start-verify context
1648 (epg-make-data-from-file input-file)
1649 (epg-make-data-from-string signed-text)))
1650 (epg-start-verify context (epg-make-data-from-string signature)))
1651 (epg-wait-for-completion context)
1652 (epg-read-output context))
1653 (epg-delete-output-file context)
1654 (if (and input-file
1655 (file-exists-p input-file))
1656 (delete-file input-file))
1657 (epg-reset context))))
1659 (defun epg-start-sign (context plain &optional mode)
1660 "Initiate a sign operation on PLAIN.
1661 PLAIN is a data object.
1663 If optional 3rd argument MODE is t or `detached', it makes a detached signature.
1664 If it is nil or `normal', it makes a normal signature.
1665 Otherwise, it makes a cleartext signature.
1667 If you use this function, you will need to wait for the completion of
1668 `epg-gpg-program' by using `epg-wait-for-completion' and call
1669 `epg-reset' to clear a temporary output file.
1670 If you are unsure, use synchronous version of this function
1671 `epg-sign-file' or `epg-sign-string' instead."
1672 (setf (epg-context-operation context) 'sign)
1673 (setf (epg-context-result context) nil)
1674 (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
1675 (setf (epg-context-armor context) nil)
1676 (setf (epg-context-textmode context) nil))
1677 (epg--start context
1678 (append (list (if (memq mode '(t detached))
1679 "--detach-sign"
1680 (if (memq mode '(nil normal))
1681 "--sign"
1682 "--clearsign")))
1683 (apply #'nconc
1684 (mapcar
1685 (lambda (signer)
1686 (list "-u"
1687 (epg-sub-key-id
1688 (car (epg-key-sub-key-list signer)))))
1689 (epg-context-signers context)))
1690 (epg--args-from-sig-notations
1691 (epg-context-sig-notations context))
1692 (if (epg-data-file plain)
1693 (list "--" (epg-data-file plain)))))
1694 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1695 (unless (eq (epg-context-protocol context) 'CMS)
1696 (epg-wait-for-status context '("BEGIN_SIGNING")))
1697 (when (epg-data-string plain)
1698 (if (eq (process-status (epg-context-process context)) 'run)
1699 (process-send-string (epg-context-process context)
1700 (epg-data-string plain)))
1701 (if (eq (process-status (epg-context-process context)) 'run)
1702 (process-send-eof (epg-context-process context)))))
1704 (defun epg-sign-file (context plain signature &optional mode)
1705 "Sign a file PLAIN and store the result to a file SIGNATURE.
1706 If SIGNATURE is nil, it returns the result as a string.
1707 If optional 3rd argument MODE is t or `detached', it makes a detached signature.
1708 If it is nil or `normal', it makes a normal signature.
1709 Otherwise, it makes a cleartext signature."
1710 (unwind-protect
1711 (progn
1712 (setf (epg-context-output-file context)
1713 (or signature (epg--make-temp-file "epg-output")))
1714 (epg-start-sign context (epg-make-data-from-file plain) mode)
1715 (epg-wait-for-completion context)
1716 (unless (epg-context-result-for context 'sign)
1717 (let ((errors (epg-context-result-for context 'error)))
1718 (signal 'epg-error
1719 (list "Sign failed" (epg-errors-to-string errors)))))
1720 (unless signature
1721 (epg-read-output context)))
1722 (unless signature
1723 (epg-delete-output-file context))
1724 (epg-reset context)))
1726 (defun epg-sign-string (context plain &optional mode)
1727 "Sign a string PLAIN and return the output as string.
1728 If optional 3rd argument MODE is t or `detached', it makes a detached signature.
1729 If it is nil or `normal', it makes a normal signature.
1730 Otherwise, it makes a cleartext signature."
1731 (let ((input-file
1732 (unless (eq (epg-context-protocol context) 'CMS)
1733 (epg--make-temp-file "epg-input")))
1734 (coding-system-for-write 'binary))
1735 (unwind-protect
1736 (progn
1737 (setf (epg-context-output-file context)
1738 (epg--make-temp-file "epg-output"))
1739 (if input-file
1740 (write-region plain nil input-file nil 'quiet))
1741 (epg-start-sign context
1742 (if input-file
1743 (epg-make-data-from-file input-file)
1744 (epg-make-data-from-string plain))
1745 mode)
1746 (epg-wait-for-completion context)
1747 (unless (epg-context-result-for context 'sign)
1748 (if (epg-context-result-for context 'error)
1749 (let ((errors (epg-context-result-for context 'error)))
1750 (signal 'epg-error
1751 (list "Sign failed" (epg-errors-to-string errors))))))
1752 (epg-read-output context))
1753 (epg-delete-output-file context)
1754 (if input-file
1755 (delete-file input-file))
1756 (epg-reset context))))
1758 (defun epg-start-encrypt (context plain recipients
1759 &optional sign always-trust)
1760 "Initiate an encrypt operation on PLAIN.
1761 PLAIN is a data object.
1762 If RECIPIENTS is nil, it performs symmetric encryption.
1764 If you use this function, you will need to wait for the completion of
1765 `epg-gpg-program' by using `epg-wait-for-completion' and call
1766 `epg-reset' to clear a temporary output file.
1767 If you are unsure, use synchronous version of this function
1768 `epg-encrypt-file' or `epg-encrypt-string' instead."
1769 (setf (epg-context-operation context) 'encrypt)
1770 (setf (epg-context-result context) nil)
1771 (epg--start context
1772 (append (if always-trust '("--always-trust"))
1773 (if recipients '("--encrypt") '("--symmetric"))
1774 (if sign '("--sign"))
1775 (if sign
1776 (apply #'nconc
1777 (mapcar
1778 (lambda (signer)
1779 (list "-u"
1780 (epg-sub-key-id
1781 (car (epg-key-sub-key-list
1782 signer)))))
1783 (epg-context-signers context))))
1784 (if sign
1785 (epg--args-from-sig-notations
1786 (epg-context-sig-notations context)))
1787 (apply #'nconc
1788 (mapcar
1789 (lambda (recipient)
1790 (list "-r"
1791 (epg-sub-key-id
1792 (car (epg-key-sub-key-list recipient)))))
1793 recipients))
1794 (if (epg-data-file plain)
1795 (list "--" (epg-data-file plain)))))
1796 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1797 (unless (eq (epg-context-protocol context) 'CMS)
1798 (epg-wait-for-status context
1799 (if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION"))))
1800 (when (epg-data-string plain)
1801 (if (eq (process-status (epg-context-process context)) 'run)
1802 (process-send-string (epg-context-process context)
1803 (epg-data-string plain)))
1804 (if (eq (process-status (epg-context-process context)) 'run)
1805 (process-send-eof (epg-context-process context)))))
1807 (defun epg-encrypt-file (context plain recipients
1808 cipher &optional sign always-trust)
1809 "Encrypt a file PLAIN and store the result to a file CIPHER.
1810 If CIPHER is nil, it returns the result as a string.
1811 If RECIPIENTS is nil, it performs symmetric encryption."
1812 (unwind-protect
1813 (progn
1814 (setf (epg-context-output-file context)
1815 (or cipher (epg--make-temp-file "epg-output")))
1816 (epg-start-encrypt context (epg-make-data-from-file plain)
1817 recipients sign always-trust)
1818 (epg-wait-for-completion context)
1819 (let ((errors (epg-context-result-for context 'error)))
1820 (if (and sign
1821 (not (epg-context-result-for context 'sign)))
1822 (signal 'epg-error
1823 (list "Sign failed" (epg-errors-to-string errors))))
1824 (if errors
1825 (signal 'epg-error
1826 (list "Encrypt failed" (epg-errors-to-string errors)))))
1827 (unless cipher
1828 (epg-read-output context)))
1829 (unless cipher
1830 (epg-delete-output-file context))
1831 (epg-reset context)))
1833 (defun epg-encrypt-string (context plain recipients
1834 &optional sign always-trust)
1835 "Encrypt a string PLAIN.
1836 If RECIPIENTS is nil, it performs symmetric encryption."
1837 (let ((input-file
1838 (unless (or (not sign)
1839 (eq (epg-context-protocol context) 'CMS))
1840 (epg--make-temp-file "epg-input")))
1841 (coding-system-for-write 'binary))
1842 (unwind-protect
1843 (progn
1844 (setf (epg-context-output-file context)
1845 (epg--make-temp-file "epg-output"))
1846 (if input-file
1847 (write-region plain nil input-file nil 'quiet))
1848 (epg-start-encrypt context
1849 (if input-file
1850 (epg-make-data-from-file input-file)
1851 (epg-make-data-from-string plain))
1852 recipients sign always-trust)
1853 (epg-wait-for-completion context)
1854 (let ((errors (epg-context-result-for context 'error)))
1855 (if (and sign
1856 (not (epg-context-result-for context 'sign)))
1857 (signal 'epg-error
1858 (list "Sign failed" (epg-errors-to-string errors))))
1859 (if errors
1860 (signal 'epg-error
1861 (list "Encrypt failed" (epg-errors-to-string errors)))))
1862 (epg-read-output context))
1863 (epg-delete-output-file context)
1864 (if input-file
1865 (delete-file input-file))
1866 (epg-reset context))))
1868 (defun epg-start-export-keys (context keys)
1869 "Initiate an export keys operation.
1871 If you use this function, you will need to wait for the completion of
1872 `epg-gpg-program' by using `epg-wait-for-completion' and call
1873 `epg-reset' to clear a temporary output file.
1874 If you are unsure, use synchronous version of this function
1875 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
1876 (setf (epg-context-operation context) 'export-keys)
1877 (setf (epg-context-result context) nil)
1878 (epg--start context (cons "--export"
1879 (mapcar
1880 (lambda (key)
1881 (epg-sub-key-id
1882 (car (epg-key-sub-key-list key))))
1883 keys))))
1885 (defun epg-export-keys-to-file (context keys file)
1886 "Extract public KEYS."
1887 (unwind-protect
1888 (progn
1889 (setf (epg-context-output-file context)
1890 (or file (epg--make-temp-file "epg-output")))
1891 (epg-start-export-keys context keys)
1892 (epg-wait-for-completion context)
1893 (let ((errors (epg-context-result-for context 'error)))
1894 (if errors
1895 (signal 'epg-error
1896 (list "Export keys failed"
1897 (epg-errors-to-string errors)))))
1898 (unless file
1899 (epg-read-output context)))
1900 (unless file
1901 (epg-delete-output-file context))
1902 (epg-reset context)))
1904 (defun epg-export-keys-to-string (context keys)
1905 "Extract public KEYS and return them as a string."
1906 (epg-export-keys-to-file context keys nil))
1908 (defun epg-start-import-keys (context keys)
1909 "Initiate an import keys operation.
1910 KEYS is a data object.
1912 If you use this function, you will need to wait for the completion of
1913 `epg-gpg-program' by using `epg-wait-for-completion' and call
1914 `epg-reset' to clear a temporary output file.
1915 If you are unsure, use synchronous version of this function
1916 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1917 (setf (epg-context-operation context) 'import-keys)
1918 (setf (epg-context-result context) nil)
1919 (epg--start context (if (epg-data-file keys)
1920 (list "--import" "--" (epg-data-file keys))
1921 (list "--import")))
1922 (when (epg-data-string keys)
1923 (if (eq (process-status (epg-context-process context)) 'run)
1924 (process-send-string (epg-context-process context)
1925 (epg-data-string keys)))
1926 (if (eq (process-status (epg-context-process context)) 'run)
1927 (process-send-eof (epg-context-process context)))))
1929 (defun epg--import-keys-1 (context keys)
1930 (unwind-protect
1931 (progn
1932 (epg-start-import-keys context keys)
1933 (epg-wait-for-completion context)
1934 (let ((errors (epg-context-result-for context 'error)))
1935 (if errors
1936 (signal 'epg-error
1937 (list "Import keys failed"
1938 (epg-errors-to-string errors))))))
1939 (epg-reset context)))
1941 (defun epg-import-keys-from-file (context keys)
1942 "Add keys from a file KEYS."
1943 (epg--import-keys-1 context (epg-make-data-from-file keys)))
1945 (defun epg-import-keys-from-string (context keys)
1946 "Add keys from a string KEYS."
1947 (epg--import-keys-1 context (epg-make-data-from-string keys)))
1949 (defun epg-start-receive-keys (context key-id-list)
1950 "Initiate a receive key operation.
1951 KEY-ID-LIST is a list of key IDs.
1953 If you use this function, you will need to wait for the completion of
1954 `epg-gpg-program' by using `epg-wait-for-completion' and call
1955 `epg-reset' to clear a temporary output file.
1956 If you are unsure, use synchronous version of this function
1957 `epg-receive-keys' instead."
1958 (setf (epg-context-operation context) 'receive-keys)
1959 (setf (epg-context-result context) nil)
1960 (epg--start context (cons "--recv-keys" key-id-list)))
1962 (defun epg-receive-keys (context keys)
1963 "Add keys from server.
1964 KEYS is a list of key IDs"
1965 (unwind-protect
1966 (progn
1967 (epg-start-receive-keys context keys)
1968 (epg-wait-for-completion context)
1969 (let ((errors (epg-context-result-for context 'error)))
1970 (if errors
1971 (signal 'epg-error
1972 (list "Receive keys failed"
1973 (epg-errors-to-string errors))))))
1974 (epg-reset context)))
1976 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
1978 (defun epg-start-delete-keys (context keys &optional allow-secret)
1979 "Initiate a delete keys operation.
1981 If you use this function, you will need to wait for the completion of
1982 `epg-gpg-program' by using `epg-wait-for-completion' and call
1983 `epg-reset' to clear a temporary output file.
1984 If you are unsure, use synchronous version of this function
1985 `epg-delete-keys' instead."
1986 (setf (epg-context-operation context) 'delete-keys)
1987 (setf (epg-context-result context) nil)
1988 (epg--start context (cons (if allow-secret
1989 "--delete-secret-key"
1990 "--delete-key")
1991 (mapcar
1992 (lambda (key)
1993 (epg-sub-key-id
1994 (car (epg-key-sub-key-list key))))
1995 keys))))
1997 (defun epg-delete-keys (context keys &optional allow-secret)
1998 "Delete KEYS from the key ring."
1999 (unwind-protect
2000 (progn
2001 (epg-start-delete-keys context keys allow-secret)
2002 (epg-wait-for-completion context)
2003 (let ((errors (epg-context-result-for context 'error)))
2004 (if errors
2005 (signal 'epg-error
2006 (list "Delete keys failed"
2007 (epg-errors-to-string errors))))))
2008 (epg-reset context)))
2010 (defun epg-start-sign-keys (context keys &optional local)
2011 "Initiate a sign keys operation.
2013 If you use this function, you will need to wait for the completion of
2014 `epg-gpg-program' by using `epg-wait-for-completion' and call
2015 `epg-reset' to clear a temporary output file.
2016 If you are unsure, use synchronous version of this function
2017 `epg-sign-keys' instead."
2018 (declare (obsolete nil "23.1"))
2019 (setf (epg-context-operation context) 'sign-keys)
2020 (setf (epg-context-result context) nil)
2021 (epg--start context (cons (if local
2022 "--lsign-key"
2023 "--sign-key")
2024 (mapcar
2025 (lambda (key)
2026 (epg-sub-key-id
2027 (car (epg-key-sub-key-list key))))
2028 keys))))
2030 (defun epg-sign-keys (context keys &optional local)
2031 "Sign KEYS from the key ring."
2032 (declare (obsolete nil "23.1"))
2033 (unwind-protect
2034 (progn
2035 (epg-start-sign-keys context keys local)
2036 (epg-wait-for-completion context)
2037 (let ((errors (epg-context-result-for context 'error)))
2038 (if errors
2039 (signal 'epg-error
2040 (list "Sign keys failed"
2041 (epg-errors-to-string errors))))))
2042 (epg-reset context)))
2044 (defun epg-start-generate-key (context parameters)
2045 "Initiate a key generation.
2046 PARAMETERS is a string which specifies parameters of the generated key.
2047 See Info node `(gnupg) Unattended GPG key generation' in the
2048 GnuPG manual for the format.
2050 If you use this function, you will need to wait for the completion of
2051 `epg-gpg-program' by using `epg-wait-for-completion' and call
2052 `epg-reset' to clear a temporary output file.
2053 If you are unsure, use synchronous version of this function
2054 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2055 (setf (epg-context-operation context) 'generate-key)
2056 (setf (epg-context-result context) nil)
2057 (if (epg-data-file parameters)
2058 (epg--start context (list "--batch" "--gen-key" "--"
2059 (epg-data-file parameters)))
2060 (epg--start context '("--batch" "--gen-key"))
2061 (if (eq (process-status (epg-context-process context)) 'run)
2062 (process-send-string (epg-context-process context)
2063 (epg-data-string parameters)))
2064 (if (eq (process-status (epg-context-process context)) 'run)
2065 (process-send-eof (epg-context-process context)))))
2067 (defun epg-generate-key-from-file (context parameters)
2068 "Generate a new key pair.
2069 PARAMETERS is a file which tells how to create the key."
2070 (unwind-protect
2071 (progn
2072 (epg-start-generate-key context (epg-make-data-from-file parameters))
2073 (epg-wait-for-completion context)
2074 (let ((errors (epg-context-result-for context 'error)))
2075 (if errors
2076 (signal 'epg-error
2077 (list "Generate key failed"
2078 (epg-errors-to-string errors))))))
2079 (epg-reset context)))
2081 (defun epg-generate-key-from-string (context parameters)
2082 "Generate a new key pair.
2083 PARAMETERS is a string which tells how to create the key."
2084 (unwind-protect
2085 (progn
2086 (epg-start-generate-key context (epg-make-data-from-string parameters))
2087 (epg-wait-for-completion context)
2088 (let ((errors (epg-context-result-for context 'error)))
2089 (if errors
2090 (signal 'epg-error
2091 (list "Generate key failed"
2092 (epg-errors-to-string errors))))))
2093 (epg-reset context)))
2095 (defun epg-start-edit-key (context key edit-callback handback)
2096 "Initiate an edit operation on KEY.
2098 EDIT-CALLBACK is called from process filter and takes 3
2099 arguments: the context, a status, an argument string, and the
2100 handback argument.
2102 If you use this function, you will need to wait for the completion of
2103 `epg-gpg-program' by using `epg-wait-for-completion' and call
2104 `epg-reset' to clear a temporary output file.
2105 If you are unsure, use synchronous version of this function
2106 `epg-edit-key' instead."
2107 (setf (epg-context-operation context) 'edit-key)
2108 (setf (epg-context-result context) nil)
2109 (setf (epg-context-edit-callback context) (cons edit-callback handback))
2110 (epg--start context (list "--edit-key"
2111 (epg-sub-key-id
2112 (car (epg-key-sub-key-list key))))))
2114 (defun epg-edit-key (context key edit-callback handback)
2115 "Edit KEY in the keyring."
2116 (unwind-protect
2117 (progn
2118 (epg-start-edit-key context key edit-callback handback)
2119 (epg-wait-for-completion context)
2120 (let ((errors (epg-context-result-for context 'error)))
2121 (if errors
2122 (signal 'epg-error
2123 (list "Edit key failed"
2124 (epg-errors-to-string errors))))))
2125 (epg-reset context)))
2127 (defun epg--decode-percent-escape (string)
2128 (let ((index 0))
2129 (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2130 string index)
2131 (if (match-beginning 2)
2132 (setq string (replace-match "%" t t string)
2133 index (1- (match-end 0)))
2134 (setq string (replace-match
2135 (string (string-to-number (match-string 3 string) 16))
2136 t t string)
2137 index (- (match-end 0) 2))))
2138 string))
2140 (defun epg--decode-hexstring (string)
2141 (let ((index 0))
2142 (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2143 (setq string (replace-match (string (string-to-number
2144 (match-string 0 string) 16))
2145 t t string)
2146 index (1- (match-end 0))))
2147 string))
2149 (defun epg--decode-quotedstring (string)
2150 (let ((index 0))
2151 (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2152 \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2153 string index)
2154 (if (match-beginning 2)
2155 (setq string (replace-match "\\2" t nil string)
2156 index (1- (match-end 0)))
2157 (if (match-beginning 3)
2158 (setq string (replace-match (string (string-to-number
2159 (match-string 0 string) 16))
2160 t t string)
2161 index (- (match-end 0) 2)))))
2162 string))
2164 (defun epg-dn-from-string (string)
2165 "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2166 The return value is an alist mapping from types to values."
2167 (let ((index 0)
2168 (length (length string))
2169 alist type value group)
2170 (while (< index length)
2171 (if (eq index (string-match "[ \t\n\r]*" string index))
2172 (setq index (match-end 0)))
2173 (if (eq index (string-match
2174 "\\([0-9]+\\(\\.[0-9]+\\)*\\)[ \t\n\r]*=[ \t\n\r]*"
2175 string index))
2176 (setq type (match-string 1 string)
2177 index (match-end 0))
2178 (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2179 string index))
2180 (setq type (match-string 1 string)
2181 index (match-end 0))))
2182 (unless type
2183 (error "Invalid type"))
2184 (if (eq index (string-match
2185 "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2186 string index))
2187 (setq index (match-end 0)
2188 value (epg--decode-quotedstring (match-string 0 string)))
2189 (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2190 (setq index (match-end 0)
2191 value (epg--decode-hexstring (match-string 1 string)))
2192 (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2193 string index))
2194 (setq index (match-end 0)
2195 value (epg--decode-quotedstring
2196 (match-string 0 string))))))
2197 (if group
2198 (if (stringp (car (car alist)))
2199 (setcar alist (list (cons type value) (car alist)))
2200 (setcar alist (cons (cons type value) (car alist))))
2201 (if (consp (car (car alist)))
2202 (setcar alist (nreverse (car alist))))
2203 (setq alist (cons (cons type value) alist)
2204 type nil
2205 value nil))
2206 (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2207 (setq index (match-end 0)
2208 group (eq (aref string (match-beginning 1)) ?+))))
2209 (nreverse alist)))
2211 (defun epg-decode-dn (alist)
2212 "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2213 Type names are resolved using `epg-dn-type-alist'."
2214 (mapconcat
2215 (lambda (rdn)
2216 (if (stringp (car rdn))
2217 (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2218 (if entry
2219 (format "%s=%s" (cdr entry) (cdr rdn))
2220 (format "%s=%s" (car rdn) (cdr rdn))))
2221 (concat "(" (epg-decode-dn rdn) ")")))
2222 alist
2223 ", "))
2225 (provide 'epg)
2227 ;;; epg.el ends here