In display-buffer-record-window record selected window if necessary.
[emacs.git] / lisp / epa.el
blobd3fec73ecf487ca72fb0153716c59e54649ebe14
1 ;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
3 ;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
5 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: PGP, GnuPG
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 <http://www.gnu.org/licenses/>.
23 ;;; Code:
25 (require 'epg)
26 (require 'font-lock)
27 (require 'widget)
28 (eval-when-compile (require 'wid-edit))
29 (require 'derived)
31 (defgroup epa nil
32 "The EasyPG Assistant"
33 :version "23.1"
34 :link '(custom-manual "(epa) Top")
35 :group 'epg)
37 (defcustom epa-popup-info-window t
38 "If non-nil, display status information from epa commands in another window."
39 :type 'boolean
40 :group 'epa)
42 (defcustom epa-info-window-height 5
43 "Number of lines used to display status information."
44 :type 'integer
45 :group 'epa)
47 (defcustom epa-pinentry-mode nil
48 "The pinentry mode.
50 GnuPG 2.1 or later has an option to control the behavior of
51 Pinentry invocation. Possible modes are: `ask', `cancel',
52 `error', and `loopback'. See the GnuPG manual for the meanings.
54 In epa commands, a particularly useful mode is `loopback', which
55 redirects all Pinentry queries to the caller, so Emacs can query
56 passphrase through the minibuffer, instead of external Pinentry
57 program."
58 :type '(choice (const nil)
59 (const ask)
60 (const cancel)
61 (const error)
62 (const loopback))
63 :group 'epa
64 :version "25.1")
66 (defgroup epa-faces nil
67 "Faces for epa-mode."
68 :version "23.1"
69 :group 'epa)
71 (defcustom epa-mail-aliases nil
72 "Alist of aliases of email addresses that stand for encryption keys.
73 Each element is a list of email addresses (ALIAS EXPANSIONS...).
74 When one of the recipients of a message being encrypted is ALIAS,
75 instead of encrypting it for ALIAS, encrypt it for EXPANSIONS...
77 If EXPANSIONS is empty, ignore ALIAS as regards encryption.
78 This is a handy way to avoid warnings about addresses that you don't
79 have any key for.
81 The command `epa-mail-encrypt' uses this."
82 :type '(repeat (cons (string :tag "Alias") (repeat (string :tag "Expansion"))))
83 :group 'epa
84 :version "24.4")
86 (defface epa-validity-high
87 '((default :weight bold)
88 (((class color) (background dark)) :foreground "PaleTurquoise"))
89 "Face for high validity EPA information."
90 :group 'epa-faces)
92 (defface epa-validity-medium
93 '((default :slant italic)
94 (((class color) (background dark)) :foreground "PaleTurquoise"))
95 "Face for medium validity EPA information."
96 :group 'epa-faces)
98 (defface epa-validity-low
99 '((t :slant italic))
100 "Face used for displaying the low validity."
101 :group 'epa-faces)
103 (defface epa-validity-disabled
104 '((t :slant italic :inverse-video t))
105 "Face used for displaying the disabled validity."
106 :group 'epa-faces)
108 (defface epa-string
109 '((((class color) (background dark))
110 :foreground "lightyellow")
111 (((class color) (background light))
112 :foreground "blue4"))
113 "Face used for displaying the string."
114 :group 'epa-faces)
116 (defface epa-mark
117 '((default :weight bold)
118 (((class color) (background dark)) :foreground "orange")
119 (((class color) (background light)) :foreground "red"))
120 "Face used for displaying the high validity."
121 :group 'epa-faces)
123 (defface epa-field-name
124 '((default :weight bold)
125 (((class color) (background dark)) :foreground "PaleTurquoise"))
126 "Face for the name of the attribute field."
127 :group 'epa)
129 (defface epa-field-body
130 '((default :slant italic)
131 (((class color) (background dark)) :foreground "turquoise"))
132 "Face for the body of the attribute field."
133 :group 'epa)
135 (defcustom epa-validity-face-alist
136 '((unknown . epa-validity-disabled)
137 (invalid . epa-validity-disabled)
138 (disabled . epa-validity-disabled)
139 (revoked . epa-validity-disabled)
140 (expired . epa-validity-disabled)
141 (none . epa-validity-low)
142 (undefined . epa-validity-low)
143 (never . epa-validity-low)
144 (marginal . epa-validity-medium)
145 (full . epa-validity-high)
146 (ultimate . epa-validity-high))
147 "An alist mapping validity values to faces."
148 :type '(repeat (cons symbol face))
149 :group 'epa)
151 (defvar epa-font-lock-keywords
152 '(("^\\*"
153 (0 'epa-mark))
154 ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
155 (1 'epa-field-name)
156 (2 'epa-field-body)))
157 "Default expressions to addon in epa-mode.")
159 (defconst epa-pubkey-algorithm-letter-alist
160 '((1 . ?R)
161 (2 . ?r)
162 (3 . ?s)
163 (16 . ?g)
164 (17 . ?D)
165 (20 . ?G)))
167 (defvar epa-protocol 'OpenPGP
168 "The default protocol.
169 The value can be either OpenPGP or CMS.
171 You should bind this variable with `let', but do not set it globally.")
173 (defvar epa-armor nil
174 "If non-nil, epa commands create ASCII armored output.
176 You should bind this variable with `let', but do not set it globally.")
178 (defvar epa-textmode nil
179 "If non-nil, epa commands treat input files as text.
181 You should bind this variable with `let', but do not set it globally.")
183 (defvar epa-keys-buffer nil)
184 (defvar epa-key-buffer-alist nil)
185 (defvar epa-key nil)
186 (defvar epa-list-keys-arguments nil)
187 (defvar epa-info-buffer nil)
188 (defvar epa-error-buffer nil)
189 (defvar epa-last-coding-system-specified nil)
191 (defvar epa-key-list-mode-map
192 (let ((keymap (make-sparse-keymap))
193 (menu-map (make-sparse-keymap)))
194 (define-key keymap "m" 'epa-mark-key)
195 (define-key keymap "u" 'epa-unmark-key)
196 (define-key keymap "d" 'epa-decrypt-file)
197 (define-key keymap "v" 'epa-verify-file)
198 (define-key keymap "s" 'epa-sign-file)
199 (define-key keymap "e" 'epa-encrypt-file)
200 (define-key keymap "r" 'epa-delete-keys)
201 (define-key keymap "i" 'epa-import-keys)
202 (define-key keymap "o" 'epa-export-keys)
203 (define-key keymap "g" 'revert-buffer)
204 (define-key keymap "n" 'next-line)
205 (define-key keymap "p" 'previous-line)
206 (define-key keymap " " 'scroll-up-command)
207 (define-key keymap [?\S-\ ] 'scroll-down-command)
208 (define-key keymap [delete] 'scroll-down-command)
209 (define-key keymap "q" 'epa-exit-buffer)
210 (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
211 (define-key menu-map [epa-key-list-unmark-key]
212 '(menu-item "Unmark Key" epa-unmark-key
213 :help "Unmark a key"))
214 (define-key menu-map [epa-key-list-mark-key]
215 '(menu-item "Mark Key" epa-mark-key
216 :help "Mark a key"))
217 (define-key menu-map [separator-epa-file] '(menu-item "--"))
218 (define-key menu-map [epa-verify-file]
219 '(menu-item "Verify File..." epa-verify-file
220 :help "Verify FILE"))
221 (define-key menu-map [epa-sign-file]
222 '(menu-item "Sign File..." epa-sign-file
223 :help "Sign FILE by SIGNERS keys selected"))
224 (define-key menu-map [epa-decrypt-file]
225 '(menu-item "Decrypt File..." epa-decrypt-file
226 :help "Decrypt FILE"))
227 (define-key menu-map [epa-encrypt-file]
228 '(menu-item "Encrypt File..." epa-encrypt-file
229 :help "Encrypt FILE for RECIPIENTS"))
230 (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
231 (define-key menu-map [epa-key-list-delete-keys]
232 '(menu-item "Delete Keys" epa-delete-keys
233 :help "Delete Marked Keys"))
234 (define-key menu-map [epa-key-list-import-keys]
235 '(menu-item "Import Keys" epa-import-keys
236 :help "Import keys from a file"))
237 (define-key menu-map [epa-key-list-export-keys]
238 '(menu-item "Export Keys" epa-export-keys
239 :help "Export marked keys to a file"))
240 keymap))
242 (defvar epa-key-mode-map
243 (let ((keymap (make-sparse-keymap)))
244 (define-key keymap "q" 'epa-exit-buffer)
245 keymap))
247 (defvar epa-info-mode-map
248 (let ((keymap (make-sparse-keymap)))
249 (define-key keymap "q" 'delete-window)
250 keymap))
252 (defvar epa-exit-buffer-function #'bury-buffer)
254 (define-widget 'epa-key 'push-button
255 "Button for representing a epg-key object."
256 :format "%[%v%]"
257 :button-face-get 'epa--key-widget-button-face-get
258 :value-create 'epa--key-widget-value-create
259 :action 'epa--key-widget-action
260 :help-echo 'epa--key-widget-help-echo)
262 (defun epa--key-widget-action (widget &optional _event)
263 (save-selected-window
264 (epa--show-key (widget-get widget :value))))
266 (defun epa--key-widget-value-create (widget)
267 (let* ((key (widget-get widget :value))
268 (primary-sub-key (car (epg-key-sub-key-list key)))
269 (primary-user-id (car (epg-key-user-id-list key))))
270 (insert (format "%c "
271 (if (epg-sub-key-validity primary-sub-key)
272 (car (rassq (epg-sub-key-validity primary-sub-key)
273 epg-key-validity-alist))
274 ? ))
275 (epg-sub-key-id primary-sub-key)
277 (if primary-user-id
278 (if (stringp (epg-user-id-string primary-user-id))
279 (epg-user-id-string primary-user-id)
280 (epg-decode-dn (epg-user-id-string primary-user-id)))
281 ""))))
283 (defun epa--key-widget-button-face-get (widget)
284 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
285 (widget-get widget :value))))))
286 (if validity
287 (cdr (assq validity epa-validity-face-alist))
288 'default)))
290 (defun epa--key-widget-help-echo (widget)
291 (format "Show %s"
292 (epg-sub-key-id (car (epg-key-sub-key-list
293 (widget-get widget :value))))))
295 (defalias 'epa--encode-coding-string
296 (if (fboundp 'encode-coding-string) #'encode-coding-string #'identity))
298 (defalias 'epa--decode-coding-string
299 (if (fboundp 'decode-coding-string) #'decode-coding-string #'identity))
301 (define-derived-mode epa-key-list-mode special-mode "Keys"
302 "Major mode for `epa-list-keys'."
303 (buffer-disable-undo)
304 (setq truncate-lines t
305 buffer-read-only t)
306 (setq-local font-lock-defaults '(epa-font-lock-keywords t))
307 ;; In XEmacs, auto-initialization of font-lock is not effective
308 ;; if buffer-file-name is not set.
309 (font-lock-set-defaults)
310 (make-local-variable 'epa-exit-buffer-function)
311 (setq-local revert-buffer-function #'epa--key-list-revert-buffer))
313 (define-derived-mode epa-key-mode special-mode "Key"
314 "Major mode for a key description."
315 (buffer-disable-undo)
316 (setq truncate-lines t
317 buffer-read-only t)
318 (setq-local font-lock-defaults '(epa-font-lock-keywords t))
319 ;; In XEmacs, auto-initialization of font-lock is not effective
320 ;; if buffer-file-name is not set.
321 (font-lock-set-defaults)
322 (make-local-variable 'epa-exit-buffer-function))
324 (define-derived-mode epa-info-mode special-mode "Info"
325 "Major mode for `epa-info-buffer'."
326 (buffer-disable-undo)
327 (setq truncate-lines t
328 buffer-read-only t))
330 (defun epa-mark-key (&optional arg)
331 "Mark a key on the current line.
332 If ARG is non-nil, unmark the key."
333 (interactive "P")
334 (let ((inhibit-read-only t)
335 buffer-read-only
336 properties)
337 (beginning-of-line)
338 (unless (get-text-property (point) 'epa-key)
339 (error "No key on this line"))
340 (setq properties (text-properties-at (point)))
341 (delete-char 1)
342 (insert (if arg " " "*"))
343 (set-text-properties (1- (point)) (point) properties)
344 (forward-line)))
346 (defun epa-unmark-key (&optional arg)
347 "Unmark a key on the current line.
348 If ARG is non-nil, mark the key."
349 (interactive "P")
350 (epa-mark-key (not arg)))
352 (defun epa-exit-buffer ()
353 "Exit the current buffer.
354 `epa-exit-buffer-function' is called if it is set."
355 (interactive)
356 (funcall epa-exit-buffer-function))
358 (defun epa--insert-keys (keys)
359 (save-excursion
360 (save-restriction
361 (narrow-to-region (point) (point))
362 (let (point)
363 (while keys
364 (setq point (point))
365 (insert " ")
366 (add-text-properties point (point)
367 (list 'epa-key (car keys)
368 'front-sticky nil
369 'rear-nonsticky t
370 'start-open t
371 'end-open t))
372 (widget-create 'epa-key :value (car keys))
373 (insert "\n")
374 (setq keys (cdr keys))))
375 (add-text-properties (point-min) (point-max)
376 (list 'epa-list-keys t
377 'front-sticky nil
378 'rear-nonsticky t
379 'start-open t
380 'end-open t)))))
382 (defun epa--list-keys (name secret)
383 (unless (and epa-keys-buffer
384 (buffer-live-p epa-keys-buffer))
385 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
386 (set-buffer epa-keys-buffer)
387 (epa-key-list-mode)
388 (let ((inhibit-read-only t)
389 buffer-read-only
390 (point (point-min))
391 (context (epg-make-context epa-protocol)))
392 (unless (get-text-property point 'epa-list-keys)
393 (setq point (next-single-property-change point 'epa-list-keys)))
394 (when point
395 (delete-region point
396 (or (next-single-property-change point 'epa-list-keys)
397 (point-max)))
398 (goto-char point))
399 (epa--insert-keys (epg-list-keys context name secret))
400 (widget-setup)
401 (set-keymap-parent (current-local-map) widget-keymap))
402 (make-local-variable 'epa-list-keys-arguments)
403 (setq epa-list-keys-arguments (list name secret))
404 (goto-char (point-min))
405 (pop-to-buffer (current-buffer)))
407 ;;;###autoload
408 (defun epa-list-keys (&optional name)
409 "List all keys matched with NAME from the public keyring."
410 (interactive
411 (if current-prefix-arg
412 (let ((name (read-string "Pattern: "
413 (if epa-list-keys-arguments
414 (car epa-list-keys-arguments)))))
415 (list (if (equal name "") nil name)))
416 (list nil)))
417 (epa--list-keys name nil))
419 ;;;###autoload
420 (defun epa-list-secret-keys (&optional name)
421 "List all keys matched with NAME from the private keyring."
422 (interactive
423 (if current-prefix-arg
424 (let ((name (read-string "Pattern: "
425 (if epa-list-keys-arguments
426 (car epa-list-keys-arguments)))))
427 (list (if (equal name "") nil name)))
428 (list nil)))
429 (epa--list-keys name t))
431 (defun epa--key-list-revert-buffer (&optional _ignore-auto _noconfirm)
432 (apply #'epa--list-keys epa-list-keys-arguments))
434 (defun epa--marked-keys ()
435 (or (with-current-buffer epa-keys-buffer
436 (goto-char (point-min))
437 (let (keys key)
438 (while (re-search-forward "^\\*" nil t)
439 (if (setq key (get-text-property (match-beginning 0)
440 'epa-key))
441 (setq keys (cons key keys))))
442 (nreverse keys)))
443 (let ((key (get-text-property (point-at-bol) 'epa-key)))
444 (if key
445 (list key)))))
447 (defun epa--select-keys (prompt keys)
448 (unless (and epa-keys-buffer
449 (buffer-live-p epa-keys-buffer))
450 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
451 (with-current-buffer epa-keys-buffer
452 (epa-key-list-mode)
453 ;; C-c C-c is the usual way to finish the selection (bug#11159).
454 (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
455 (let ((inhibit-read-only t)
456 buffer-read-only)
457 (erase-buffer)
458 (insert prompt "\n"
459 (substitute-command-keys "\
460 - `\\[epa-mark-key]' to mark a key on the line
461 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
462 (widget-create 'link
463 :notify (lambda (&rest _ignore) (abort-recursive-edit))
464 :help-echo
465 (substitute-command-keys
466 "Click here or \\[abort-recursive-edit] to cancel")
467 "Cancel")
468 (widget-create 'link
469 :notify (lambda (&rest _ignore) (exit-recursive-edit))
470 :help-echo
471 (substitute-command-keys
472 "Click here or \\[exit-recursive-edit] to finish")
473 "OK")
474 (insert "\n\n")
475 (epa--insert-keys keys)
476 (widget-setup)
477 (set-keymap-parent (current-local-map) widget-keymap)
478 (setq epa-exit-buffer-function #'abort-recursive-edit)
479 (goto-char (point-min))
480 (let ((display-buffer-mark-dedicated 'soft))
481 (pop-to-buffer (current-buffer))))
482 (unwind-protect
483 (progn
484 (recursive-edit)
485 (epa--marked-keys))
486 (kill-buffer epa-keys-buffer))))
488 ;;;###autoload
489 (defun epa-select-keys (context prompt &optional names secret)
490 "Display a user's keyring and ask him to select keys.
491 CONTEXT is an epg-context.
492 PROMPT is a string to prompt with.
493 NAMES is a list of strings to be matched with keys. If it is nil, all
494 the keys are listed.
495 If SECRET is non-nil, list secret keys instead of public keys."
496 (let ((keys (epg-list-keys context names secret)))
497 (epa--select-keys prompt keys)))
499 (defun epa--show-key (key)
500 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
501 (entry (assoc (epg-sub-key-id primary-sub-key)
502 epa-key-buffer-alist))
503 (inhibit-read-only t)
504 buffer-read-only
505 pointer)
506 (unless entry
507 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
508 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
509 (unless (and (cdr entry)
510 (buffer-live-p (cdr entry)))
511 (setcdr entry (generate-new-buffer
512 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
513 (set-buffer (cdr entry))
514 (epa-key-mode)
515 (make-local-variable 'epa-key)
516 (setq epa-key key)
517 (erase-buffer)
518 (setq pointer (epg-key-user-id-list key))
519 (while pointer
520 (if (car pointer)
521 (insert " "
522 (if (epg-user-id-validity (car pointer))
523 (char-to-string
524 (car (rassq (epg-user-id-validity (car pointer))
525 epg-key-validity-alist)))
526 " ")
528 (if (stringp (epg-user-id-string (car pointer)))
529 (epg-user-id-string (car pointer))
530 (epg-decode-dn (epg-user-id-string (car pointer))))
531 "\n"))
532 (setq pointer (cdr pointer)))
533 (setq pointer (epg-key-sub-key-list key))
534 (while pointer
535 (insert " "
536 (if (epg-sub-key-validity (car pointer))
537 (char-to-string
538 (car (rassq (epg-sub-key-validity (car pointer))
539 epg-key-validity-alist)))
540 " ")
542 (epg-sub-key-id (car pointer))
544 (format "%dbits"
545 (epg-sub-key-length (car pointer)))
547 (cdr (assq (epg-sub-key-algorithm (car pointer))
548 epg-pubkey-algorithm-alist))
549 "\n\tCreated: "
550 (condition-case nil
551 (format-time-string "%Y-%m-%d"
552 (epg-sub-key-creation-time (car pointer)))
553 (error "????-??-??"))
554 (if (epg-sub-key-expiration-time (car pointer))
555 (format (if (time-less-p (current-time)
556 (epg-sub-key-expiration-time
557 (car pointer)))
558 "\n\tExpires: %s"
559 "\n\tExpired: %s")
560 (condition-case nil
561 (format-time-string "%Y-%m-%d"
562 (epg-sub-key-expiration-time
563 (car pointer)))
564 (error "????-??-??")))
566 "\n\tCapabilities: "
567 (mapconcat #'symbol-name
568 (epg-sub-key-capability (car pointer))
569 " ")
570 "\n\tFingerprint: "
571 (epg-sub-key-fingerprint (car pointer))
572 "\n")
573 (setq pointer (cdr pointer)))
574 (goto-char (point-min))
575 (pop-to-buffer (current-buffer))))
577 (defun epa-display-info (info)
578 (if epa-popup-info-window
579 (save-selected-window
580 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
581 (setq epa-info-buffer (generate-new-buffer "*Info*")))
582 (if (get-buffer-window epa-info-buffer)
583 (delete-window (get-buffer-window epa-info-buffer)))
584 (with-current-buffer epa-info-buffer
585 (let ((inhibit-read-only t)
586 buffer-read-only)
587 (erase-buffer)
588 (insert info))
589 (epa-info-mode)
590 (goto-char (point-min)))
591 (if (> (window-height)
592 epa-info-window-height)
593 (set-window-buffer (split-window nil (- (window-height)
594 epa-info-window-height))
595 epa-info-buffer)
596 (pop-to-buffer epa-info-buffer)
597 (if (> (window-height) epa-info-window-height)
598 (shrink-window (- (window-height) epa-info-window-height)))))
599 (message "%s" info)))
601 (defun epa-display-error (context)
602 (unless (equal (epg-context-error-output context) "")
603 (let ((buffer (get-buffer-create "*Error*")))
604 (save-selected-window
605 (unless (and epa-error-buffer (buffer-live-p epa-error-buffer))
606 (setq epa-error-buffer (generate-new-buffer "*Error*")))
607 (if (get-buffer-window epa-error-buffer)
608 (delete-window (get-buffer-window epa-error-buffer)))
609 (with-current-buffer buffer
610 (let ((inhibit-read-only t)
611 buffer-read-only)
612 (erase-buffer)
613 (insert (format
614 (pcase (epg-context-operation context)
615 (`decrypt "Error while decrypting with \"%s\":")
616 (`verify "Error while verifying with \"%s\":")
617 (`sign "Error while signing with \"%s\":")
618 (`encrypt "Error while encrypting with \"%s\":")
619 (`import-keys "Error while importing keys with \"%s\":")
620 (`export-keys "Error while exporting keys with \"%s\":")
621 (_ "Error while executing \"%s\":\n\n"))
622 epg-gpg-program)
623 "\n\n"
624 (epg-context-error-output context)))
625 (epa-info-mode)
626 (goto-char (point-min)))
627 (display-buffer buffer)))))
629 (defun epa-display-verify-result (verify-result)
630 (declare (obsolete epa-display-info "23.1"))
631 (epa-display-info (epg-verify-result-to-string verify-result)))
633 (defun epa-passphrase-callback-function (context key-id handback)
634 (if (eq key-id 'SYM)
635 (read-passwd
636 (format "Passphrase for symmetric encryption%s: "
637 ;; Add the file name to the prompt, if any.
638 (if (stringp handback)
639 (format " for %s" handback)
640 ""))
641 (eq (epg-context-operation context) 'encrypt))
642 (read-passwd
643 (if (eq key-id 'PIN)
644 "Passphrase for PIN: "
645 (let ((entry (assoc key-id epg-user-id-alist)))
646 (if entry
647 (format "Passphrase for %s %s: " key-id (cdr entry))
648 (format "Passphrase for %s: " key-id)))))))
650 (defun epa-progress-callback-function (_context what _char current total
651 handback)
652 (let ((prompt (or handback
653 (format "Processing %s: " what))))
654 ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
655 ;; the total amount is not known. The condition TOTAL && CUR ==
656 ;; TOTAL may be used to detect the end of an operation.
657 (if (> total 0)
658 (if (= current total)
659 (message "%s...done" prompt)
660 (message "%s...%d%%" prompt
661 (floor (* (/ current (float total)) 100))))
662 (message "%s..." prompt))))
664 (defun epa-read-file-name (input)
665 "Interactively read an output file name based on INPUT file name."
666 (setq input (file-name-sans-extension (expand-file-name input)))
667 (expand-file-name
668 (read-file-name
669 (concat "To file (default " (file-name-nondirectory input) ") ")
670 (file-name-directory input)
671 input)))
673 ;;;###autoload
674 (defun epa-decrypt-file (decrypt-file &optional plain-file)
675 "Decrypt DECRYPT-FILE into PLAIN-FILE.
676 If you do not specify PLAIN-FILE, this functions prompts for the value to use."
677 (interactive
678 (let* ((file (read-file-name "File to decrypt: "))
679 (plain (epa-read-file-name file)))
680 (list file plain)))
681 (or plain-file (setq plain-file (epa-read-file-name decrypt-file)))
682 (setq decrypt-file (expand-file-name decrypt-file))
683 (let ((context (epg-make-context epa-protocol)))
684 (epg-context-set-passphrase-callback context
685 #'epa-passphrase-callback-function)
686 (epg-context-set-progress-callback context
687 (cons
688 #'epa-progress-callback-function
689 (format "Decrypting %s..."
690 (file-name-nondirectory decrypt-file))))
691 (message "Decrypting %s..." (file-name-nondirectory decrypt-file))
692 (condition-case error
693 (epg-decrypt-file context decrypt-file plain-file)
694 (error
695 (epa-display-error context)
696 (signal (car error) (cdr error))))
697 (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file)
698 (file-name-nondirectory plain-file))
699 (if (epg-context-result-for context 'verify)
700 (epa-display-info (epg-verify-result-to-string
701 (epg-context-result-for context 'verify))))))
703 ;;;###autoload
704 (defun epa-verify-file (file)
705 "Verify FILE."
706 (interactive "fFile: ")
707 (setq file (expand-file-name file))
708 (let* ((context (epg-make-context epa-protocol))
709 (plain (if (equal (file-name-extension file) "sig")
710 (file-name-sans-extension file))))
711 (epg-context-set-progress-callback context
712 (cons
713 #'epa-progress-callback-function
714 (format "Verifying %s..."
715 (file-name-nondirectory file))))
716 (message "Verifying %s..." (file-name-nondirectory file))
717 (condition-case error
718 (epg-verify-file context file plain)
719 (error
720 (epa-display-error context)
721 (signal (car error) (cdr error))))
722 (message "Verifying %s...done" (file-name-nondirectory file))
723 (if (epg-context-result-for context 'verify)
724 (epa-display-info (epg-verify-result-to-string
725 (epg-context-result-for context 'verify))))))
727 (defun epa--read-signature-type ()
728 (let (type c)
729 (while (null type)
730 (message "Signature type (n,c,d,?) ")
731 (setq c (read-char))
732 (cond ((eq c ?c)
733 (setq type 'clear))
734 ((eq c ?d)
735 (setq type 'detached))
736 ((eq c ??)
737 (with-output-to-temp-buffer "*Help*"
738 (with-current-buffer standard-output
739 (insert "\
740 n - Create a normal signature
741 c - Create a cleartext signature
742 d - Create a detached signature
743 ? - Show this help
744 "))))
746 (setq type 'normal))))
747 type))
749 ;;;###autoload
750 (defun epa-sign-file (file signers mode)
751 "Sign FILE by SIGNERS keys selected."
752 (interactive
753 (let ((verbose current-prefix-arg))
754 (list (expand-file-name (read-file-name "File: "))
755 (if verbose
756 (epa-select-keys (epg-make-context epa-protocol)
757 "Select keys for signing.
758 If no one is selected, default secret key is used. "
759 nil t))
760 (if verbose
761 (epa--read-signature-type)
762 'clear))))
763 (let ((signature (concat file
764 (if (eq epa-protocol 'OpenPGP)
765 (if (or epa-armor
766 (not (memq mode
767 '(nil t normal detached))))
768 ".asc"
769 (if (memq mode '(t detached))
770 ".sig"
771 ".gpg"))
772 (if (memq mode '(t detached))
773 ".p7s"
774 ".p7m"))))
775 (context (epg-make-context epa-protocol)))
776 (setf (epg-context-armor context) epa-armor)
777 (setf (epg-context-textmode context) epa-textmode)
778 (setf (epg-context-signers context) signers)
779 (epg-context-set-passphrase-callback context
780 #'epa-passphrase-callback-function)
781 (epg-context-set-progress-callback context
782 (cons
783 #'epa-progress-callback-function
784 (format "Signing %s..."
785 (file-name-nondirectory file))))
786 (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
787 (message "Signing %s..." (file-name-nondirectory file))
788 (condition-case error
789 (epg-sign-file context file signature mode)
790 (error
791 (epa-display-error context)
792 (signal (car error) (cdr error))))
793 (message "Signing %s...wrote %s" (file-name-nondirectory file)
794 (file-name-nondirectory signature))))
796 ;;;###autoload
797 (defun epa-encrypt-file (file recipients)
798 "Encrypt FILE for RECIPIENTS."
799 (interactive
800 (list (expand-file-name (read-file-name "File: "))
801 (epa-select-keys (epg-make-context epa-protocol)
802 "Select recipients for encryption.
803 If no one is selected, symmetric encryption will be performed. ")))
804 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
805 (if epa-armor ".asc" ".gpg")
806 ".p7m")))
807 (context (epg-make-context epa-protocol)))
808 (setf (epg-context-armor context) epa-armor)
809 (setf (epg-context-textmode context) epa-textmode)
810 (epg-context-set-passphrase-callback context
811 #'epa-passphrase-callback-function)
812 (epg-context-set-progress-callback context
813 (cons
814 #'epa-progress-callback-function
815 (format "Encrypting %s..."
816 (file-name-nondirectory file))))
817 (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
818 (message "Encrypting %s..." (file-name-nondirectory file))
819 (condition-case error
820 (epg-encrypt-file context file recipients cipher)
821 (error
822 (epa-display-error context)
823 (signal (car error) (cdr error))))
824 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
825 (file-name-nondirectory cipher))))
827 ;;;###autoload
828 (defun epa-decrypt-region (start end &optional make-buffer-function)
829 "Decrypt the current region between START and END.
831 If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
832 It should return that buffer. If it copies the input, it should
833 delete the text now being decrypted. It should leave point at the
834 proper place to insert the plaintext.
836 Be careful about using this command in Lisp programs!
837 Since this function operates on regions, it does some tricks such
838 as coding-system detection and unibyte/multibyte conversion. If
839 you are sure how the data in the region should be treated, you
840 should consider using the string based counterpart
841 `epg-decrypt-string', or the file based counterpart
842 `epg-decrypt-file' instead.
844 For example:
846 \(let ((context (epg-make-context 'OpenPGP)))
847 (decode-coding-string
848 (epg-decrypt-string context (buffer-substring start end))
849 'utf-8))"
850 (interactive "r")
851 (save-excursion
852 (let ((context (epg-make-context epa-protocol))
853 plain)
854 (epg-context-set-passphrase-callback context
855 #'epa-passphrase-callback-function)
856 (epg-context-set-progress-callback context
857 (cons
858 #'epa-progress-callback-function
859 "Decrypting..."))
860 (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
861 (message "Decrypting...")
862 (condition-case error
863 (setq plain (epg-decrypt-string context (buffer-substring start end)))
864 (error
865 (epa-display-error context)
866 (signal (car error) (cdr error))))
867 (message "Decrypting...done")
868 (setq plain (epa--decode-coding-string
869 plain
870 (or coding-system-for-read
871 (get-text-property start 'epa-coding-system-used)
872 'undecided)))
873 (if make-buffer-function
874 (with-current-buffer (funcall make-buffer-function)
875 (let ((inhibit-read-only t))
876 (insert plain)))
877 (if (y-or-n-p "Replace the original text? ")
878 (let ((inhibit-read-only t))
879 (delete-region start end)
880 (goto-char start)
881 (insert plain))
882 (with-output-to-temp-buffer "*Temp*"
883 (set-buffer standard-output)
884 (insert plain)
885 (epa-info-mode))))
886 (if (epg-context-result-for context 'verify)
887 (epa-display-info (epg-verify-result-to-string
888 (epg-context-result-for context 'verify)))))))
890 (defun epa--find-coding-system-for-mime-charset (mime-charset)
891 (if (featurep 'xemacs)
892 (if (fboundp 'find-coding-system)
893 (find-coding-system mime-charset))
894 ;; Find the first coding system which corresponds to MIME-CHARSET.
895 (let ((pointer (coding-system-list)))
896 (while (and pointer
897 (not (eq (coding-system-get (car pointer) 'mime-charset)
898 mime-charset)))
899 (setq pointer (cdr pointer)))
900 (car pointer))))
902 ;;;###autoload
903 (defun epa-decrypt-armor-in-region (start end)
904 "Decrypt OpenPGP armors in the current region between START and END.
906 Don't use this command in Lisp programs!
907 See the reason described in the `epa-decrypt-region' documentation."
908 (declare (interactive-only t))
909 (interactive "r")
910 (save-excursion
911 (save-restriction
912 (narrow-to-region start end)
913 (goto-char start)
914 (let (armor-start armor-end)
915 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
916 (setq armor-start (match-beginning 0)
917 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
918 nil t))
919 (unless armor-end
920 (error "Encryption armor beginning has no matching end"))
921 (goto-char armor-start)
922 (let ((coding-system-for-read
923 (or coding-system-for-read
924 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
925 (epa--find-coding-system-for-mime-charset
926 (intern (downcase (match-string 1))))))))
927 (goto-char armor-end)
928 (epa-decrypt-region armor-start armor-end)))))))
930 ;;;###autoload
931 (defun epa-verify-region (start end)
932 "Verify the current region between START and END.
934 Don't use this command in Lisp programs!
935 Since this function operates on regions, it does some tricks such
936 as coding-system detection and unibyte/multibyte conversion. If
937 you are sure how the data in the region should be treated, you
938 should consider using the string based counterpart
939 `epg-verify-string', or the file based counterpart
940 `epg-verify-file' instead.
942 For example:
944 \(let ((context (epg-make-context 'OpenPGP)))
945 (decode-coding-string
946 (epg-verify-string context (buffer-substring start end))
947 'utf-8))"
948 (declare (interactive-only t))
949 (interactive "r")
950 (let ((context (epg-make-context epa-protocol))
951 plain)
952 (setf (epg-context-progress-callback context)
953 (cons
954 #'epa-progress-callback-function
955 "Verifying..."))
956 (message "Verifying...")
957 (condition-case error
958 (setq plain (epg-verify-string
959 context
960 (epa--encode-coding-string
961 (buffer-substring start end)
962 (or coding-system-for-write
963 (get-text-property start 'epa-coding-system-used)))))
964 (error
965 (epa-display-error context)
966 (signal (car error) (cdr error))))
967 (message "Verifying...done")
968 (setq plain (epa--decode-coding-string
969 plain
970 (or coding-system-for-read
971 (get-text-property start 'epa-coding-system-used)
972 'undecided)))
973 (if (y-or-n-p "Replace the original text? ")
974 (let ((inhibit-read-only t)
975 buffer-read-only)
976 (delete-region start end)
977 (goto-char start)
978 (insert plain))
979 (with-output-to-temp-buffer "*Temp*"
980 (set-buffer standard-output)
981 (insert plain)
982 (epa-info-mode)))
983 (if (epg-context-result-for context 'verify)
984 (epa-display-info (epg-verify-result-to-string
985 (epg-context-result-for context 'verify))))))
987 ;;;###autoload
988 (defun epa-verify-cleartext-in-region (start end)
989 "Verify OpenPGP cleartext signed messages in the current region
990 between START and END.
992 Don't use this command in Lisp programs!
993 See the reason described in the `epa-verify-region' documentation."
994 (declare (interactive-only t))
995 (interactive "r")
996 (save-excursion
997 (save-restriction
998 (narrow-to-region start end)
999 (goto-char start)
1000 (let (cleartext-start cleartext-end)
1001 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
1002 nil t)
1003 (setq cleartext-start (match-beginning 0))
1004 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
1005 nil t)
1006 (error "Invalid cleartext signed message"))
1007 (setq cleartext-end (re-search-forward
1008 "^-----END PGP SIGNATURE-----$"
1009 nil t))
1010 (unless cleartext-end
1011 (error "No cleartext tail"))
1012 (epa-verify-region cleartext-start cleartext-end))))))
1014 (defalias 'epa--select-safe-coding-system
1015 (if (fboundp 'select-safe-coding-system)
1016 #'select-safe-coding-system
1017 (lambda (_from _to)
1018 buffer-file-coding-system)))
1020 ;;;###autoload
1021 (defun epa-sign-region (start end signers mode)
1022 "Sign the current region between START and END by SIGNERS keys selected.
1024 Don't use this command in Lisp programs!
1025 Since this function operates on regions, it does some tricks such
1026 as coding-system detection and unibyte/multibyte conversion. If
1027 you are sure how the data should be treated, you should consider
1028 using the string based counterpart `epg-sign-string', or the file
1029 based counterpart `epg-sign-file' instead.
1031 For example:
1033 \(let ((context (epg-make-context 'OpenPGP)))
1034 (epg-sign-string
1035 context
1036 (encode-coding-string (buffer-substring start end) 'utf-8)))"
1037 (declare (interactive-only t))
1038 (interactive
1039 (let ((verbose current-prefix-arg))
1040 (setq epa-last-coding-system-specified
1041 (or coding-system-for-write
1042 (epa--select-safe-coding-system
1043 (region-beginning) (region-end))))
1044 (list (region-beginning) (region-end)
1045 (if verbose
1046 (epa-select-keys (epg-make-context epa-protocol)
1047 "Select keys for signing.
1048 If no one is selected, default secret key is used. "
1049 nil t))
1050 (if verbose
1051 (epa--read-signature-type)
1052 'clear))))
1053 (save-excursion
1054 (let ((context (epg-make-context epa-protocol))
1055 signature)
1056 ;;(setf (epg-context-armor context) epa-armor)
1057 (setf (epg-context-armor context) t)
1058 ;;(setf (epg-context-textmode context) epa-textmode)
1059 (setf (epg-context-textmode context) t)
1060 (setf (epg-context-signers context) signers)
1061 (epg-context-set-passphrase-callback context
1062 #'epa-passphrase-callback-function)
1063 (epg-context-set-progress-callback context
1064 (cons
1065 #'epa-progress-callback-function
1066 "Signing..."))
1067 (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
1068 (message "Signing...")
1069 (condition-case error
1070 (setq signature (epg-sign-string context
1071 (epa--encode-coding-string
1072 (buffer-substring start end)
1073 epa-last-coding-system-specified)
1074 mode))
1075 (error
1076 (epa-display-error context)
1077 (signal (car error) (cdr error))))
1078 (message "Signing...done")
1079 (delete-region start end)
1080 (goto-char start)
1081 (add-text-properties (point)
1082 (progn
1083 (insert (epa--decode-coding-string
1084 signature
1085 (or coding-system-for-read
1086 epa-last-coding-system-specified)))
1087 (point))
1088 (list 'epa-coding-system-used
1089 epa-last-coding-system-specified
1090 'front-sticky nil
1091 'rear-nonsticky t
1092 'start-open t
1093 'end-open t)))))
1095 (defalias 'epa--derived-mode-p
1096 (if (fboundp 'derived-mode-p)
1097 #'derived-mode-p
1098 (lambda (&rest modes)
1099 "Non-nil if the current major mode is derived from one of MODES.
1100 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1101 (let ((parent major-mode))
1102 (while (and (not (memq parent modes))
1103 (setq parent (get parent 'derived-mode-parent))))
1104 parent))))
1106 ;;;###autoload
1107 (defun epa-encrypt-region (start end recipients sign signers)
1108 "Encrypt the current region between START and END for RECIPIENTS.
1110 Don't use this command in Lisp programs!
1111 Since this function operates on regions, it does some tricks such
1112 as coding-system detection and unibyte/multibyte conversion. If
1113 you are sure how the data should be treated, you should consider
1114 using the string based counterpart `epg-encrypt-string', or the
1115 file based counterpart `epg-encrypt-file' instead.
1117 For example:
1119 \(let ((context (epg-make-context 'OpenPGP)))
1120 (epg-encrypt-string
1121 context
1122 (encode-coding-string (buffer-substring start end) 'utf-8)
1123 nil))"
1124 (declare (interactive-only t))
1125 (interactive
1126 (let ((verbose current-prefix-arg)
1127 (context (epg-make-context epa-protocol))
1128 sign)
1129 (setq epa-last-coding-system-specified
1130 (or coding-system-for-write
1131 (epa--select-safe-coding-system
1132 (region-beginning) (region-end))))
1133 (list (region-beginning) (region-end)
1134 (epa-select-keys context
1135 "Select recipients for encryption.
1136 If no one is selected, symmetric encryption will be performed. ")
1137 (setq sign (if verbose (y-or-n-p "Sign? ")))
1138 (if sign
1139 (epa-select-keys context
1140 "Select keys for signing. ")))))
1141 (save-excursion
1142 (let ((context (epg-make-context epa-protocol))
1143 cipher)
1144 ;;(setf (epg-context-armor context) epa-armor)
1145 (setf (epg-context-armor context) t)
1146 ;;(setf (epg-context-textmode context) epa-textmode)
1147 (setf (epg-context-textmode context) t)
1148 (if sign
1149 (setf (epg-context-signers context) signers))
1150 (epg-context-set-passphrase-callback context
1151 #'epa-passphrase-callback-function)
1152 (epg-context-set-progress-callback context
1153 (cons
1154 #'epa-progress-callback-function
1155 "Encrypting..."))
1156 (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
1157 (message "Encrypting...")
1158 (condition-case error
1159 (setq cipher (epg-encrypt-string context
1160 (epa--encode-coding-string
1161 (buffer-substring start end)
1162 epa-last-coding-system-specified)
1163 recipients
1164 sign))
1165 (error
1166 (epa-display-error context)
1167 (signal (car error) (cdr error))))
1168 (message "Encrypting...done")
1169 (delete-region start end)
1170 (goto-char start)
1171 (add-text-properties (point)
1172 (progn
1173 (insert cipher)
1174 (point))
1175 (list 'epa-coding-system-used
1176 epa-last-coding-system-specified
1177 'front-sticky nil
1178 'rear-nonsticky t
1179 'start-open t
1180 'end-open t)))))
1182 ;;;###autoload
1183 (defun epa-delete-keys (keys &optional allow-secret)
1184 "Delete selected KEYS."
1185 (interactive
1186 (let ((keys (epa--marked-keys)))
1187 (unless keys
1188 (error "No keys selected"))
1189 (list keys
1190 (eq (nth 1 epa-list-keys-arguments) t))))
1191 (let ((context (epg-make-context epa-protocol)))
1192 (message "Deleting...")
1193 (condition-case error
1194 (epg-delete-keys context keys allow-secret)
1195 (error
1196 (epa-display-error context)
1197 (signal (car error) (cdr error))))
1198 (message "Deleting...done")
1199 (apply #'epa--list-keys epa-list-keys-arguments)))
1201 ;;;###autoload
1202 (defun epa-import-keys (file)
1203 "Import keys from FILE."
1204 (interactive "fFile: ")
1205 (setq file (expand-file-name file))
1206 (let ((context (epg-make-context epa-protocol)))
1207 (message "Importing %s..." (file-name-nondirectory file))
1208 (condition-case nil
1209 (progn
1210 (epg-import-keys-from-file context file)
1211 (message "Importing %s...done" (file-name-nondirectory file)))
1212 (error
1213 (epa-display-error context)
1214 (message "Importing %s...failed" (file-name-nondirectory file))))
1215 (if (epg-context-result-for context 'import)
1216 (epa-display-info (epg-import-result-to-string
1217 (epg-context-result-for context 'import))))
1218 ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
1219 (if (eq major-mode 'epa-key-list-mode)
1220 (apply #'epa--list-keys epa-list-keys-arguments))))
1222 ;;;###autoload
1223 (defun epa-import-keys-region (start end)
1224 "Import keys from the region."
1225 (interactive "r")
1226 (let ((context (epg-make-context epa-protocol)))
1227 (message "Importing...")
1228 (condition-case nil
1229 (progn
1230 (epg-import-keys-from-string context (buffer-substring start end))
1231 (message "Importing...done"))
1232 (error
1233 (epa-display-error context)
1234 (message "Importing...failed")))
1235 (if (epg-context-result-for context 'import)
1236 (epa-display-info (epg-import-result-to-string
1237 (epg-context-result-for context 'import))))))
1239 ;;;###autoload
1240 (defun epa-import-armor-in-region (start end)
1241 "Import keys in the OpenPGP armor format in the current region
1242 between START and END."
1243 (interactive "r")
1244 (save-excursion
1245 (save-restriction
1246 (narrow-to-region start end)
1247 (goto-char start)
1248 (let (armor-start armor-end)
1249 (while (re-search-forward
1250 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1251 nil t)
1252 (setq armor-start (match-beginning 0)
1253 armor-end (re-search-forward
1254 (concat "^-----END " (match-string 1) "-----$")
1255 nil t))
1256 (unless armor-end
1257 (error "No armor tail"))
1258 (epa-import-keys-region armor-start armor-end))))))
1260 ;;;###autoload
1261 (defun epa-export-keys (keys file)
1262 "Export selected KEYS to FILE."
1263 (interactive
1264 (let ((keys (epa--marked-keys))
1265 default-name)
1266 (unless keys
1267 (error "No keys selected"))
1268 (setq default-name
1269 (expand-file-name
1270 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1271 (if epa-armor ".asc" ".gpg"))
1272 default-directory))
1273 (list keys
1274 (expand-file-name
1275 (read-file-name
1276 (concat "To file (default "
1277 (file-name-nondirectory default-name)
1278 ") ")
1279 (file-name-directory default-name)
1280 default-name)))))
1281 (let ((context (epg-make-context epa-protocol)))
1282 (setf (epg-context-armor context) epa-armor)
1283 (message "Exporting to %s..." (file-name-nondirectory file))
1284 (condition-case error
1285 (epg-export-keys-to-file context keys file)
1286 (error
1287 (epa-display-error context)
1288 (signal (car error) (cdr error))))
1289 (message "Exporting to %s...done" (file-name-nondirectory file))))
1291 ;;;###autoload
1292 (defun epa-insert-keys (keys)
1293 "Insert selected KEYS after the point."
1294 (interactive
1295 (list (epa-select-keys (epg-make-context epa-protocol)
1296 "Select keys to export.
1297 If no one is selected, default public key is exported. ")))
1298 (let ((context (epg-make-context epa-protocol)))
1299 ;;(setf (epg-context-armor context) epa-armor)
1300 (setf (epg-context-armor context) t)
1301 (condition-case error
1302 (insert (epg-export-keys-to-string context keys))
1303 (error
1304 (epa-display-error context)
1305 (signal (car error) (cdr error))))))
1307 ;; (defun epa-sign-keys (keys &optional local)
1308 ;; "Sign selected KEYS.
1309 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1311 ;; Don't use this command in Lisp programs!"
1312 ;; (declare (interactive-only t))
1313 ;; (interactive
1314 ;; (let ((keys (epa--marked-keys)))
1315 ;; (unless keys
1316 ;; (error "No keys selected"))
1317 ;; (list keys current-prefix-arg)))
1318 ;; (let ((context (epg-make-context epa-protocol)))
1319 ;; (epg-context-set-passphrase-callback context
1320 ;; #'epa-passphrase-callback-function)
1321 ;; (epg-context-set-progress-callback context
1322 ;; (cons
1323 ;; #'epa-progress-callback-function
1324 ;; "Signing keys..."))
1325 ;; (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
1326 ;; (message "Signing keys...")
1327 ;; (epg-sign-keys context keys local)
1328 ;; (message "Signing keys...done")))
1329 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1331 (provide 'epa)
1333 ;;; epa.el ends here