1 ;;; epa.el --- the EasyPG Assistant
2 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
29 (eval-when-compile (require 'wid-edit
))
33 "The EasyPG Assistant"
37 (defcustom epa-popup-info-window t
38 "If non-nil, status information from epa commands is displayed on
43 (defcustom epa-info-window-height
5
44 "Number of lines used to display status information."
48 (defcustom epa-global-minor-modes
'(epa-global-dired-mode
51 "Globally defined minor modes to hook into other modes."
52 :type
'(repeat symbol
)
55 (defgroup epa-faces nil
60 (defface epa-validity-high
61 `((((class color
) (background dark
))
62 (:foreground
"PaleTurquoise"
63 ,@(if (assq ':weight custom-face-attributes
)
67 (,@(if (assq ':weight custom-face-attributes
)
70 "Face used for displaying the high validity."
73 (defface epa-validity-medium
74 `((((class color
) (background dark
))
75 (:foreground
"PaleTurquoise"
76 ,@(if (assq ':slant custom-face-attributes
)
80 (,@(if (assq ':slant custom-face-attributes
)
83 "Face used for displaying the medium validity."
86 (defface epa-validity-low
88 (,@(if (assq ':slant custom-face-attributes
)
91 "Face used for displaying the low validity."
94 (defface epa-validity-disabled
96 (,@(if (assq ':slant custom-face-attributes
)
100 "Face used for displaying the disabled validity."
104 '((((class color
) (background dark
))
105 (:foreground
"lightyellow"))
106 (((class color
) (background light
))
107 (:foreground
"blue4")))
108 "Face used for displaying the string."
112 `((((class color
) (background dark
))
113 (:foreground
"orange"
114 ,@(if (assq ':weight custom-face-attributes
)
117 (((class color
) (background light
))
119 ,@(if (assq ':weight custom-face-attributes
)
123 (,@(if (assq ':weight custom-face-attributes
)
126 "Face used for displaying the high validity."
129 (defface epa-field-name
130 `((((class color
) (background dark
))
131 (:foreground
"PaleTurquoise"
132 ,@(if (assq ':weight custom-face-attributes
)
136 (,@(if (assq ':weight custom-face-attributes
)
139 "Face for the name of the attribute field."
142 (defface epa-field-body
143 `((((class color
) (background dark
))
144 (:foreground
"turquoise"
145 ,@(if (assq ':slant custom-face-attributes
)
149 (,@(if (assq ':slant custom-face-attributes
)
152 "Face for the body of the attribute field."
155 (defcustom epa-validity-face-alist
156 '((unknown . epa-validity-disabled
)
157 (invalid . epa-validity-disabled
)
158 (disabled . epa-validity-disabled
)
159 (revoked . epa-validity-disabled
)
160 (expired . epa-validity-disabled
)
161 (none . epa-validity-low
)
162 (undefined . epa-validity-low
)
163 (never . epa-validity-low
)
164 (marginal . epa-validity-medium
)
165 (full . epa-validity-high
)
166 (ultimate . epa-validity-high
))
167 "An alist mapping validity values to faces."
168 :type
'(repeat (cons symbol face
))
171 (defvar epa-font-lock-keywords
174 ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
176 (2 'epa-field-body
)))
177 "Default expressions to addon in epa-mode.")
179 (defconst epa-pubkey-algorithm-letter-alist
187 (defvar epa-protocol
'OpenPGP
188 "*The default protocol.
189 The value can be either OpenPGP or CMS.
191 You should bind this variable with `let', but do not set it globally.")
193 (defvar epa-armor nil
194 "*If non-nil, epa commands create ASCII armored output.
196 You should bind this variable with `let', but do not set it globally.")
198 (defvar epa-textmode nil
199 "*If non-nil, epa commands treat input files as text.
201 You should bind this variable with `let', but do not set it globally.")
203 (defvar epa-keys-buffer nil
)
204 (defvar epa-key-buffer-alist nil
)
206 (defvar epa-list-keys-arguments nil
)
207 (defvar epa-info-buffer nil
)
208 (defvar epa-last-coding-system-specified nil
)
210 (defvar epa-key-list-mode-map
211 (let ((keymap (make-sparse-keymap)))
212 (define-key keymap
"m" 'epa-mark-key
)
213 (define-key keymap
"u" 'epa-unmark-key
)
214 (define-key keymap
"d" 'epa-decrypt-file
)
215 (define-key keymap
"v" 'epa-verify-file
)
216 (define-key keymap
"s" 'epa-sign-file
)
217 (define-key keymap
"e" 'epa-encrypt-file
)
218 (define-key keymap
"r" 'epa-delete-keys
)
219 (define-key keymap
"i" 'epa-import-keys
)
220 (define-key keymap
"o" 'epa-export-keys
)
221 (define-key keymap
"g" 'revert-buffer
)
222 (define-key keymap
"n" 'next-line
)
223 (define-key keymap
"p" 'previous-line
)
224 (define-key keymap
" " 'scroll-up
)
225 (define-key keymap
[delete] 'scroll-down)
226 (define-key keymap "q" 'epa-exit-buffer)
229 (defvar epa-key-mode-map
230 (let ((keymap (make-sparse-keymap)))
231 (define-key keymap "q" 'epa-exit-buffer)
234 (defvar epa-info-mode-map
235 (let ((keymap (make-sparse-keymap)))
236 (define-key keymap "q" 'delete-window)
239 (defvar epa-menu nil)
241 (defconst epa-menu-items
242 '("Encryption/Decryption"
244 ["File" epa-decrypt-file
245 :help "Decrypt a file"]
246 ["Region" epa-decrypt-region
247 :help "Decrypt the current region"])
249 ["File" epa-verify-file
250 :help "Verify digital signature of a file"]
251 ["Region" epa-verify-region
252 :help "Verify digital signature of the current region"])
254 ["File" epa-sign-file
255 :help "Create digital signature of a file"]
256 ["Region" epa-sign-region
257 :help "Create digital signature of the current region"])
259 ["File" epa-encrypt-file
260 :help "Encrypt a file"]
261 ["Region" epa-encrypt-region
262 :help "Encrypt the current region"])
264 ["Browse keyring" epa-list-keys
265 :help "Browse your public keyring"]
267 ["File" epa-import-keys
268 :help "Import public keys from a file"]
269 ["Region" epa-import-keys-region
270 :help "Import public keys from the current region"])
272 ["To a File" epa-export-keys
273 :help "Export public keys to a file"]
274 ["To a Buffer" epa-insert-keys
275 :help "Insert public keys after the current point"])))
277 (defvar epa-exit-buffer-function #'bury-buffer)
279 (define-widget 'epa-key 'push-button
280 "Button for representing a epg-key object."
282 :button-face-get 'epa--key-widget-button-face-get
283 :value-create 'epa--key-widget-value-create
284 :action 'epa--key-widget-action
285 :help-echo 'epa--key-widget-help-echo)
287 (defun epa--key-widget-action (widget &optional event)
288 (epa--show-key (widget-get widget :value)))
290 (defun epa--key-widget-value-create (widget)
291 (let* ((key (widget-get widget :value))
292 (primary-sub-key (car (epg-key-sub-key-list key)))
293 (primary-user-id (car (epg-key-user-id-list key))))
294 (insert (format "%c "
295 (if (epg-sub-key-validity primary-sub-key)
296 (car (rassq (epg-sub-key-validity primary-sub-key)
297 epg-key-validity-alist))
299 (epg-sub-key-id primary-sub-key)
302 (if (stringp (epg-user-id-string primary-user-id))
303 (epg-user-id-string primary-user-id)
304 (epg-decode-dn (epg-user-id-string primary-user-id)))
307 (defun epa--key-widget-button-face-get (widget)
308 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
309 (widget-get widget :value))))))
311 (cdr (assq validity epa-validity-face-alist))
314 (defun epa--key-widget-help-echo (widget)
316 (epg-sub-key-id (car (epg-key-sub-key-list
317 (widget-get widget :value))))))
320 (if (fboundp 'encode-coding-string)
321 (defalias 'epa--encode-coding-string 'encode-coding-string)
322 (defalias 'epa--encode-coding-string 'identity)))
325 (if (fboundp 'decode-coding-string)
326 (defalias 'epa--decode-coding-string 'decode-coding-string)
327 (defalias 'epa--decode-coding-string 'identity)))
329 (defun epa-key-list-mode ()
330 "Major mode for `epa-list-keys'."
331 (kill-all-local-variables)
332 (buffer-disable-undo)
333 (setq major-mode 'epa-key-list-mode
337 (use-local-map epa-key-list-mode-map)
338 (make-local-variable 'font-lock-defaults)
339 (setq font-lock-defaults '(epa-font-lock-keywords t))
340 ;; In XEmacs, auto-initialization of font-lock is not effective
341 ;; if buffer-file-name is not set.
342 (font-lock-set-defaults)
343 (make-local-variable 'epa-exit-buffer-function)
344 (make-local-variable 'revert-buffer-function)
345 (setq revert-buffer-function 'epa--key-list-revert-buffer)
346 (run-hooks 'epa-key-list-mode-hook))
348 (defun epa-key-mode ()
349 "Major mode for a key description."
350 (kill-all-local-variables)
351 (buffer-disable-undo)
352 (setq major-mode 'epa-key-mode
356 (use-local-map epa-key-mode-map)
357 (make-local-variable 'font-lock-defaults)
358 (setq font-lock-defaults '(epa-font-lock-keywords t))
359 ;; In XEmacs, auto-initialization of font-lock is not effective
360 ;; if buffer-file-name is not set.
361 (font-lock-set-defaults)
362 (make-local-variable 'epa-exit-buffer-function)
363 (run-hooks 'epa-key-mode-hook))
365 (defun epa-info-mode ()
366 "Major mode for `epa-info-buffer'."
367 (kill-all-local-variables)
368 (buffer-disable-undo)
369 (setq major-mode 'epa-info-mode
373 (use-local-map epa-info-mode-map)
374 (run-hooks 'epa-info-mode-hook))
376 (defun epa-mark-key (&optional arg)
377 "Mark a key on the current line.
378 If ARG is non-nil, unmark the key."
380 (let ((inhibit-read-only t)
384 (unless (get-text-property (point) 'epa-key)
385 (error "No key on this line"))
386 (setq properties (text-properties-at (point)))
388 (insert (if arg " " "*"))
389 (set-text-properties (1- (point)) (point) properties)
392 (defun epa-unmark-key (&optional arg)
393 "Unmark a key on the current line.
394 If ARG is non-nil, mark the key."
396 (epa-mark-key (not arg)))
398 (defun epa-exit-buffer ()
399 "Exit the current buffer.
400 `epa-exit-buffer-function' is called if it is set."
402 (funcall epa-exit-buffer-function))
404 (defun epa--insert-keys (keys)
407 (narrow-to-region (point) (point))
412 (add-text-properties point (point)
413 (list 'epa-key (car keys)
418 (widget-create 'epa-key :value (car keys))
420 (setq keys (cdr keys))))
421 (add-text-properties (point-min) (point-max)
422 (list 'epa-list-keys t
428 (defun epa--list-keys (name secret)
429 (unless (and epa-keys-buffer
430 (buffer-live-p epa-keys-buffer))
431 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
432 (set-buffer epa-keys-buffer)
434 (let ((inhibit-read-only t)
437 (context (epg-make-context epa-protocol)))
438 (unless (get-text-property point 'epa-list-keys)
439 (setq point (next-single-property-change point 'epa-list-keys)))
442 (or (next-single-property-change point 'epa-list-keys)
445 (epa--insert-keys (epg-list-keys context name secret))
447 (set-keymap-parent (current-local-map) widget-keymap))
448 (make-local-variable 'epa-list-keys-arguments)
449 (setq epa-list-keys-arguments (list name secret))
450 (goto-char (point-min))
451 (pop-to-buffer (current-buffer)))
454 (defun epa-list-keys (&optional name)
455 "List all keys matched with NAME from the public keyring."
457 (if current-prefix-arg
458 (let ((name (read-string "Pattern: "
459 (if epa-list-keys-arguments
460 (car epa-list-keys-arguments)))))
461 (list (if (equal name "") nil name)))
463 (epa--list-keys name nil))
466 (defun epa-list-secret-keys (&optional name)
467 "List all keys matched with NAME from the private keyring."
469 (if current-prefix-arg
470 (let ((name (read-string "Pattern: "
471 (if epa-list-keys-arguments
472 (car epa-list-keys-arguments)))))
473 (list (if (equal name "") nil name)))
475 (epa--list-keys name t))
477 (defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm)
478 (apply #'epa--list-keys epa-list-keys-arguments))
480 (defun epa--marked-keys ()
482 (set-buffer epa-keys-buffer)
483 (goto-char (point-min))
485 (while (re-search-forward "^\\*" nil t)
486 (if (setq key (get-text-property (match-beginning 0)
488 (setq keys (cons key keys))))
492 (let ((key (get-text-property (point) 'epa-key)))
496 (defun epa--select-keys (prompt keys)
498 (unless (and epa-keys-buffer
499 (buffer-live-p epa-keys-buffer))
500 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
501 (set-buffer epa-keys-buffer)
503 (let ((inhibit-read-only t)
507 (substitute-command-keys "\
508 - `\\[epa-mark-key]' to mark a key on the line
509 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
511 :notify (lambda (&rest ignore) (abort-recursive-edit))
513 (substitute-command-keys
514 "Click here or \\[abort-recursive-edit] to cancel")
517 :notify (lambda (&rest ignore) (exit-recursive-edit))
519 (substitute-command-keys
520 "Click here or \\[exit-recursive-edit] to finish")
523 (epa--insert-keys keys)
525 (set-keymap-parent (current-local-map) widget-keymap)
526 (setq epa-exit-buffer-function #'abort-recursive-edit)
527 (goto-char (point-min))
528 (pop-to-buffer (current-buffer)))
533 (if (get-buffer-window epa-keys-buffer)
534 (delete-window (get-buffer-window epa-keys-buffer)))
535 (kill-buffer epa-keys-buffer))))
538 (defun epa-select-keys (context prompt &optional names secret)
539 "Display a user's keyring and ask him to select keys.
540 CONTEXT is an epg-context.
541 PROMPT is a string to prompt with.
542 NAMES is a list of strings to be matched with keys. If it is nil, all
544 If SECRET is non-nil, list secret keys instead of public keys."
545 (let ((keys (epg-list-keys context names secret)))
546 (epa--select-keys prompt keys)))
548 (defun epa--show-key (key)
549 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
550 (entry (assoc (epg-sub-key-id primary-sub-key)
551 epa-key-buffer-alist))
552 (inhibit-read-only t)
556 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
557 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
558 (unless (and (cdr entry)
559 (buffer-live-p (cdr entry)))
560 (setcdr entry (generate-new-buffer
561 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
562 (set-buffer (cdr entry))
564 (make-local-variable 'epa-key)
567 (setq pointer (epg-key-user-id-list key))
571 (if (epg-user-id-validity (car pointer))
573 (car (rassq (epg-user-id-validity (car pointer))
574 epg-key-validity-alist)))
577 (if (stringp (epg-user-id-string (car pointer)))
578 (epg-user-id-string (car pointer))
579 (epg-decode-dn (epg-user-id-string (car pointer))))
581 (setq pointer (cdr pointer)))
582 (setq pointer (epg-key-sub-key-list key))
585 (if (epg-sub-key-validity (car pointer))
587 (car (rassq (epg-sub-key-validity (car pointer))
588 epg-key-validity-alist)))
591 (epg-sub-key-id (car pointer))
594 (epg-sub-key-length (car pointer)))
596 (cdr (assq (epg-sub-key-algorithm (car pointer))
597 epg-pubkey-algorithm-alist))
600 (format-time-string "%Y-%m-%d"
601 (epg-sub-key-creation-time (car pointer)))
602 (error "????-??-??"))
603 (if (epg-sub-key-expiration-time (car pointer))
604 (format "\n\tExpires: %s"
606 (format-time-string "%Y-%m-%d"
607 (epg-sub-key-expiration-time
609 (error "????-??-??")))
612 (mapconcat #'symbol-name
613 (epg-sub-key-capability (car pointer))
616 (epg-sub-key-fingerprint (car pointer))
618 (setq pointer (cdr pointer)))
619 (goto-char (point-min))
620 (pop-to-buffer (current-buffer))))
622 (defun epa-display-info (info)
623 (if epa-popup-info-window
624 (save-selected-window
625 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
626 (setq epa-info-buffer (generate-new-buffer "*Info*")))
627 (if (get-buffer-window epa-info-buffer)
628 (delete-window (get-buffer-window epa-info-buffer)))
630 (set-buffer epa-info-buffer)
631 (let ((inhibit-read-only t)
636 (goto-char (point-min)))
637 (if (> (window-height)
638 epa-info-window-height)
639 (set-window-buffer (split-window nil (- (window-height)
640 epa-info-window-height))
642 (pop-to-buffer epa-info-buffer)
643 (if (> (window-height) epa-info-window-height)
644 (shrink-window (- (window-height) epa-info-window-height)))))
645 (message "%s" info)))
647 (defun epa-display-verify-result (verify-result)
648 (epa-display-info (epg-verify-result-to-string verify-result)))
649 (make-obsolete 'epa-display-verify-result 'epa-display-info)
651 (defun epa-passphrase-callback-function (context key-id handback)
653 (read-passwd "Passphrase for symmetric encryption: "
654 (eq (epg-context-operation context) 'encrypt))
657 "Passphrase for PIN: "
658 (let ((entry (assoc key-id epg-user-id-alist)))
660 (format "Passphrase for %s %s: " key-id (cdr entry))
661 (format "Passphrase for %s: " key-id)))))))
663 (defun epa-progress-callback-function (context what char current total
665 (message "%s%d%% (%d/%d)" (or handback
667 (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
671 (defun epa-decrypt-file (file)
673 (interactive "fFile: ")
674 (setq file (expand-file-name file))
675 (let* ((default-name (file-name-sans-extension file))
676 (plain (expand-file-name
678 (concat "To file (default "
679 (file-name-nondirectory default-name)
681 (file-name-directory default-name)
683 (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
688 #'epa-progress-callback-function
689 (format "Decrypting %s..."
690 (file-name-nondirectory file))))
691 (message "Decrypting %s..." (file-name-nondirectory file))
692 (epg-decrypt-file context file plain)
693 (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
694 (file-name-nondirectory plain))
695 (if (epg-context-result-for context 'verify)
696 (epa-display-info (epg-verify-result-to-string
697 (epg-context-result-for context 'verify))))))
700 (defun epa-verify-file (file)
702 (interactive "fFile: ")
703 (setq file (expand-file-name file))
704 (let* ((context (epg-make-context epa-protocol))
705 (plain (if (equal (file-name-extension file) "sig")
706 (file-name-sans-extension file))))
707 (epg-context-set-progress-callback context
709 #'epa-progress-callback-function
710 (format "Verifying %s..."
711 (file-name-nondirectory file))))
712 (message "Verifying %s..." (file-name-nondirectory file))
713 (epg-verify-file context file plain)
714 (message "Verifying %s...done" (file-name-nondirectory file))
715 (if (epg-context-result-for context 'verify)
716 (epa-display-info (epg-verify-result-to-string
717 (epg-context-result-for context 'verify))))))
719 (defun epa--read-signature-type ()
722 (message "Signature type (n,c,d,?) ")
727 (setq type 'detached))
729 (with-output-to-temp-buffer "*Help*"
731 (set-buffer standard-output)
733 n - Create a normal signature
734 c - Create a cleartext signature
735 d - Create a detached signature
739 (setq type 'normal))))))
742 (defun epa-sign-file (file signers mode)
743 "Sign FILE by SIGNERS keys selected."
745 (let ((verbose current-prefix-arg))
746 (list (expand-file-name (read-file-name "File: "))
748 (epa-select-keys (epg-make-context epa-protocol)
749 "Select keys for signing.
750 If no one is selected, default secret key is used. "
753 (epa--read-signature-type)
755 (let ((signature (concat file
756 (if (eq epa-protocol 'OpenPGP)
759 '(nil t normal detached))))
761 (if (memq mode '(t detached))
764 (if (memq mode '(t detached))
767 (context (epg-make-context epa-protocol)))
768 (epg-context-set-armor context epa-armor)
769 (epg-context-set-textmode context epa-textmode)
770 (epg-context-set-signers context signers)
771 (epg-context-set-passphrase-callback context
772 #'epa-passphrase-callback-function)
773 (epg-context-set-progress-callback context
775 #'epa-progress-callback-function
776 (format "Signing %s..."
777 (file-name-nondirectory file))))
778 (message "Signing %s..." (file-name-nondirectory file))
779 (epg-sign-file context file signature mode)
780 (message "Signing %s...wrote %s" (file-name-nondirectory file)
781 (file-name-nondirectory signature))))
784 (defun epa-encrypt-file (file recipients)
785 "Encrypt FILE for RECIPIENTS."
787 (list (expand-file-name (read-file-name "File: "))
788 (epa-select-keys (epg-make-context epa-protocol)
789 "Select recipients for encryption.
790 If no one is selected, symmetric encryption will be performed. ")))
791 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
792 (if epa-armor ".asc" ".gpg")
794 (context (epg-make-context epa-protocol)))
795 (epg-context-set-armor context epa-armor)
796 (epg-context-set-textmode context epa-textmode)
797 (epg-context-set-passphrase-callback context
798 #'epa-passphrase-callback-function)
799 (epg-context-set-progress-callback context
801 #'epa-progress-callback-function
802 (format "Encrypting %s..."
803 (file-name-nondirectory file))))
804 (message "Encrypting %s..." (file-name-nondirectory file))
805 (epg-encrypt-file context file recipients cipher)
806 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
807 (file-name-nondirectory cipher))))
810 (defun epa-decrypt-region (start end)
811 "Decrypt the current region between START and END.
813 Don't use this command in Lisp programs!
814 Since this function operates on regions, it does some tricks such
815 as coding-system detection and unibyte/multibyte conversion. If
816 you are sure how the data in the region should be treated, you
817 should consider using the string based counterpart
818 `epg-decrypt-string', or the file based counterpart
819 `epg-decrypt-file' instead.
823 \(let ((context (epg-make-context 'OpenPGP)))
824 (decode-coding-string
825 (epg-decrypt-string context (buffer-substring start end))
829 (let ((context (epg-make-context epa-protocol))
831 (epg-context-set-passphrase-callback context
832 #'epa-passphrase-callback-function)
833 (epg-context-set-progress-callback context
835 #'epa-progress-callback-function
837 (message "Decrypting...")
838 (setq plain (epg-decrypt-string context (buffer-substring start end)))
839 (message "Decrypting...done")
840 (setq plain (epa--decode-coding-string
842 (or coding-system-for-read
843 (get-text-property start 'epa-coding-system-used))))
844 (if (y-or-n-p "Replace the original text? ")
845 (let ((inhibit-read-only t)
847 (delete-region start end)
850 (with-output-to-temp-buffer "*Temp*"
851 (set-buffer standard-output)
854 (if (epg-context-result-for context 'verify)
855 (epa-display-info (epg-verify-result-to-string
856 (epg-context-result-for context 'verify)))))))
858 (defun epa--find-coding-system-for-mime-charset (mime-charset)
859 (if (featurep 'xemacs)
860 (if (fboundp 'find-coding-system)
861 (find-coding-system mime-charset))
862 (let ((pointer (coding-system-list)))
864 (eq (coding-system-get (car pointer) 'mime-charset)
866 (setq pointer (cdr pointer)))
870 (defun epa-decrypt-armor-in-region (start end)
871 "Decrypt OpenPGP armors in the current region between START and END.
873 Don't use this command in Lisp programs!
874 See the reason described in the `epa-decrypt-region' documentation."
878 (narrow-to-region start end)
880 (let (armor-start armor-end)
881 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
882 (setq armor-start (match-beginning 0)
883 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
886 (error "No armor tail"))
887 (goto-char armor-start)
888 (let ((coding-system-for-read
889 (or coding-system-for-read
890 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
891 (epa--find-coding-system-for-mime-charset
892 (intern (downcase (match-string 1))))))))
893 (goto-char armor-end)
894 (epa-decrypt-region armor-start armor-end)))))))
897 (defun epa-verify-region (start end)
898 "Verify the current region between START and END.
900 Don't use this command in Lisp programs!
901 Since this function operates on regions, it does some tricks such
902 as coding-system detection and unibyte/multibyte conversion. If
903 you are sure how the data in the region should be treated, you
904 should consider using the string based counterpart
905 `epg-verify-string', or the file based counterpart
906 `epg-verify-file' instead.
910 \(let ((context (epg-make-context 'OpenPGP)))
911 (decode-coding-string
912 (epg-verify-string context (buffer-substring start end))
915 (let ((context (epg-make-context epa-protocol))
917 (epg-context-set-progress-callback context
919 #'epa-progress-callback-function
921 (message "Verifying...")
922 (setq plain (epg-verify-string
924 (epa--encode-coding-string
925 (buffer-substring start end)
926 (or coding-system-for-write
927 (get-text-property start 'epa-coding-system-used)))))
928 (message "Verifying...done")
929 (setq plain (epa--decode-coding-string
931 (or coding-system-for-read
932 (get-text-property start 'epa-coding-system-used))))
933 (if (y-or-n-p "Replace the original text? ")
934 (let ((inhibit-read-only t)
936 (delete-region start end)
939 (with-output-to-temp-buffer "*Temp*"
940 (set-buffer standard-output)
943 (if (epg-context-result-for context 'verify)
944 (epa-display-info (epg-verify-result-to-string
945 (epg-context-result-for context 'verify))))))
948 (defun epa-verify-cleartext-in-region (start end)
949 "Verify OpenPGP cleartext signed messages in the current region
950 between START and END.
952 Don't use this command in Lisp programs!
953 See the reason described in the `epa-verify-region' documentation."
957 (narrow-to-region start end)
959 (let (cleartext-start cleartext-end)
960 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
962 (setq cleartext-start (match-beginning 0))
963 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
965 (error "Invalid cleartext signed message"))
966 (setq cleartext-end (re-search-forward
967 "^-----END PGP SIGNATURE-----$"
969 (unless cleartext-end
970 (error "No cleartext tail"))
971 (epa-verify-region cleartext-start cleartext-end))))))
974 (if (fboundp 'select-safe-coding-system)
975 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
976 (defun epa--select-safe-coding-system (from to)
977 buffer-file-coding-system)))
980 (defun epa-sign-region (start end signers mode)
981 "Sign the current region between START and END by SIGNERS keys selected.
983 Don't use this command in Lisp programs!
984 Since this function operates on regions, it does some tricks such
985 as coding-system detection and unibyte/multibyte conversion. If
986 you are sure how the data should be treated, you should consider
987 using the string based counterpart `epg-sign-string', or the file
988 based counterpart `epg-sign-file' instead.
992 \(let ((context (epg-make-context 'OpenPGP)))
995 (encode-coding-string (buffer-substring start end) 'utf-8)))"
997 (let ((verbose current-prefix-arg))
998 (setq epa-last-coding-system-specified
999 (or coding-system-for-write
1000 (epa--select-safe-coding-system
1001 (region-beginning) (region-end))))
1002 (list (region-beginning) (region-end)
1004 (epa-select-keys (epg-make-context epa-protocol)
1005 "Select keys for signing.
1006 If no one is selected, default secret key is used. "
1009 (epa--read-signature-type)
1012 (let ((context (epg-make-context epa-protocol))
1014 ;;(epg-context-set-armor context epa-armor)
1015 (epg-context-set-armor context t)
1016 ;;(epg-context-set-textmode context epa-textmode)
1017 (epg-context-set-textmode context t)
1018 (epg-context-set-signers context signers)
1019 (epg-context-set-passphrase-callback context
1020 #'epa-passphrase-callback-function)
1021 (epg-context-set-progress-callback context
1023 #'epa-progress-callback-function
1025 (message "Signing...")
1026 (setq signature (epg-sign-string context
1027 (epa--encode-coding-string
1028 (buffer-substring start end)
1029 epa-last-coding-system-specified)
1031 (message "Signing...done")
1032 (delete-region start end)
1034 (add-text-properties (point)
1036 (insert (epa--decode-coding-string
1038 (or coding-system-for-read
1039 epa-last-coding-system-specified)))
1041 (list 'epa-coding-system-used
1042 epa-last-coding-system-specified
1049 (if (fboundp 'derived-mode-p)
1050 (defalias 'epa--derived-mode-p 'derived-mode-p)
1051 (defun epa--derived-mode-p (&rest modes)
1052 "Non-nil if the current major mode is derived from one of MODES.
1053 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1054 (let ((parent major-mode))
1055 (while (and (not (memq parent modes))
1056 (setq parent (get parent 'derived-mode-parent))))
1060 (defun epa-encrypt-region (start end recipients sign signers)
1061 "Encrypt the current region between START and END for RECIPIENTS.
1063 Don't use this command in Lisp programs!
1064 Since this function operates on regions, it does some tricks such
1065 as coding-system detection and unibyte/multibyte conversion. If
1066 you are sure how the data should be treated, you should consider
1067 using the string based counterpart `epg-encrypt-string', or the
1068 file based counterpart `epg-encrypt-file' instead.
1072 \(let ((context (epg-make-context 'OpenPGP)))
1075 (encode-coding-string (buffer-substring start end) 'utf-8)
1078 (let ((verbose current-prefix-arg)
1079 (context (epg-make-context epa-protocol))
1081 (setq epa-last-coding-system-specified
1082 (or coding-system-for-write
1083 (epa--select-safe-coding-system
1084 (region-beginning) (region-end))))
1085 (list (region-beginning) (region-end)
1086 (epa-select-keys context
1087 "Select recipients for encryption.
1088 If no one is selected, symmetric encryption will be performed. ")
1089 (setq sign (if verbose (y-or-n-p "Sign? ")))
1091 (epa-select-keys context
1092 "Select keys for signing. ")))))
1094 (let ((context (epg-make-context epa-protocol))
1096 ;;(epg-context-set-armor context epa-armor)
1097 (epg-context-set-armor context t)
1098 ;;(epg-context-set-textmode context epa-textmode)
1099 (epg-context-set-textmode context t)
1101 (epg-context-set-signers context signers))
1102 (epg-context-set-passphrase-callback context
1103 #'epa-passphrase-callback-function)
1104 (epg-context-set-progress-callback context
1106 #'epa-progress-callback-function
1108 (message "Encrypting...")
1109 (setq cipher (epg-encrypt-string context
1110 (epa--encode-coding-string
1111 (buffer-substring start end)
1112 epa-last-coding-system-specified)
1115 (message "Encrypting...done")
1116 (delete-region start end)
1118 (add-text-properties (point)
1122 (list 'epa-coding-system-used
1123 epa-last-coding-system-specified
1130 (defun epa-delete-keys (keys &optional allow-secret)
1131 "Delete selected KEYS."
1133 (let ((keys (epa--marked-keys)))
1135 (error "No keys selected"))
1137 (eq (nth 1 epa-list-keys-arguments) t))))
1138 (let ((context (epg-make-context epa-protocol)))
1139 (message "Deleting...")
1140 (epg-delete-keys context keys allow-secret)
1141 (message "Deleting...done")
1142 (apply #'epa-list-keys epa-list-keys-arguments)))
1145 (defun epa-import-keys (file)
1146 "Import keys from FILE."
1147 (interactive "fFile: ")
1148 (setq file (expand-file-name file))
1149 (let ((context (epg-make-context epa-protocol)))
1150 (message "Importing %s..." (file-name-nondirectory file))
1153 (epg-import-keys-from-file context file)
1154 (message "Importing %s...done" (file-name-nondirectory file)))
1156 (message "Importing %s...failed" (file-name-nondirectory file))))
1157 (if (epg-context-result-for context 'import)
1158 (epa-display-info (epg-import-result-to-string
1159 (epg-context-result-for context 'import))))
1160 (if (eq major-mode 'epa-key-list-mode)
1161 (apply #'epa-list-keys epa-list-keys-arguments))))
1164 (defun epa-import-keys-region (start end)
1165 "Import keys from the region."
1167 (let ((context (epg-make-context epa-protocol)))
1168 (message "Importing...")
1171 (epg-import-keys-from-string context (buffer-substring start end))
1172 (message "Importing...done"))
1174 (message "Importing...failed")))
1175 (if (epg-context-result-for context 'import)
1176 (epa-display-info (epg-import-result-to-string
1177 (epg-context-result-for context 'import))))))
1180 (defun epa-import-armor-in-region (start end)
1181 "Import keys in the OpenPGP armor format in the current region
1182 between START and END."
1186 (narrow-to-region start end)
1188 (let (armor-start armor-end)
1189 (while (re-search-forward
1190 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1192 (setq armor-start (match-beginning 0)
1193 armor-end (re-search-forward
1194 (concat "^-----END " (match-string 1) "-----$")
1197 (error "No armor tail"))
1198 (epa-import-keys-region armor-start armor-end))))))
1201 (defun epa-export-keys (keys file)
1202 "Export selected KEYS to FILE."
1204 (let ((keys (epa--marked-keys))
1207 (error "No keys selected"))
1210 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1211 (if epa-armor ".asc" ".gpg"))
1216 (concat "To file (default "
1217 (file-name-nondirectory default-name)
1219 (file-name-directory default-name)
1221 (let ((context (epg-make-context epa-protocol)))
1222 (epg-context-set-armor context epa-armor)
1223 (message "Exporting to %s..." (file-name-nondirectory file))
1224 (epg-export-keys-to-file context keys file)
1225 (message "Exporting to %s...done" (file-name-nondirectory file))))
1228 (defun epa-insert-keys (keys)
1229 "Insert selected KEYS after the point."
1231 (list (epa-select-keys (epg-make-context epa-protocol)
1232 "Select keys to export. ")))
1233 (let ((context (epg-make-context epa-protocol)))
1234 ;;(epg-context-set-armor context epa-armor)
1235 (epg-context-set-armor context t)
1236 (insert (epg-export-keys-to-string context keys))))
1238 ;; (defun epa-sign-keys (keys &optional local)
1239 ;; "Sign selected KEYS.
1240 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1242 ;; Don't use this command in Lisp programs!"
1244 ;; (let ((keys (epa--marked-keys)))
1246 ;; (error "No keys selected"))
1247 ;; (list keys current-prefix-arg)))
1248 ;; (let ((context (epg-make-context epa-protocol)))
1249 ;; (epg-context-set-passphrase-callback context
1250 ;; #'epa-passphrase-callback-function)
1251 ;; (epg-context-set-progress-callback context
1253 ;; #'epa-progress-callback-function
1254 ;; "Signing keys..."))
1255 ;; (message "Signing keys...")
1256 ;; (epg-sign-keys context keys local)
1257 ;; (message "Signing keys...done")))
1258 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1261 (define-minor-mode epa-mode
1262 "Minor mode to hook EasyPG into various modes.
1263 See `epa-global-minor-modes'."
1264 :global t :init-value nil :group 'epa :version "23.1"
1266 (easy-menu-define epa-menu nil "EasyPG Assistant global menu"
1268 (easy-menu-remove-item nil '("Tools") "Encryption/Decryption")
1270 (easy-menu-add-item nil '("Tools") epa-menu))
1271 (let ((modes epa-global-minor-modes)
1274 (setq symbol (car modes))
1277 (funcall symbol epa-mode)
1278 (message "`%S' not found" (car modes)))
1279 (setq modes (cdr modes)))))
1283 ;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7
1284 ;;; epa.el ends here