1 ;;; epa.el --- the EasyPG Assistant
2 ;; Copyright (C) 2006 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of EasyPG.
9 ;; This program 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 2, or (at your option)
14 ;; This program 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))
34 "The EasyPG Assistant"
37 (defcustom epa-protocol 'OpenPGP
38 "The default protocol."
39 :type '(choice (const :tag "OpenPGP" OpenPGP)
40 (const :tag "CMS" CMS))
43 (defcustom epa-armor nil
44 "If non-nil, epa commands create ASCII armored output."
48 (defcustom epa-textmode nil
49 "If non-nil, epa commands treat input files as text."
53 (defcustom epa-popup-info-window t
54 "If non-nil, status information from epa commands is displayed on
59 (defcustom epa-info-window-height 5
60 "Number of lines used to display status information."
64 (defgroup epa-faces nil
68 (defface epa-validity-high-face
69 '((((class color) (background dark))
70 (:foreground "PaleTurquoise" :bold t))
73 "Face used for displaying the high validity."
75 (defvar epa-validity-high-face 'epa-validity-high-face)
77 (defface epa-validity-medium-face
78 '((((class color) (background dark))
79 (:foreground "PaleTurquoise" :italic t))
82 "Face used for displaying the medium validity."
84 (defvar epa-validity-medium-face 'epa-validity-medium-face)
86 (defface epa-validity-low-face
89 "Face used for displaying the low validity."
91 (defvar epa-validity-low-face 'epa-validity-low-face)
93 (defface epa-validity-disabled-face
95 (:italic t :inverse-video t)))
96 "Face used for displaying the disabled validity."
98 (defvar epa-validity-disabled-face 'epa-validity-disabled-face)
100 (defface epa-string-face
103 (:foreground "lightyellow"))
106 (:foreground "blue4"))
109 "Face used for displaying the string."
111 (defvar epa-string-face 'epa-string-face)
113 (defface epa-mark-face
114 '((((class color) (background dark))
115 (:foreground "orange" :bold t))
117 (:foreground "red" :bold t)))
118 "Face used for displaying the high validity."
120 (defvar epa-mark-face 'epa-mark-face)
122 (defface epa-field-name-face
123 '((((class color) (background dark))
124 (:foreground "PaleTurquoise" :bold t))
126 "Face for the name of the attribute field."
128 (defvar epa-field-name-face 'epa-field-name-face)
130 (defface epa-field-body-face
131 '((((class color) (background dark))
132 (:foreground "turquoise" :italic t))
134 "Face for the body of the attribute field."
136 (defvar epa-field-body-face 'epa-field-body-face)
138 (defcustom epa-validity-face-alist
139 '((unknown . epa-validity-disabled-face)
140 (invalid . epa-validity-disabled-face)
141 (disabled . epa-validity-disabled-face)
142 (revoked . epa-validity-disabled-face)
143 (expired . epa-validity-disabled-face)
144 (none . epa-validity-low-face)
145 (undefined . epa-validity-low-face)
146 (never . epa-validity-low-face)
147 (marginal . epa-validity-medium-face)
148 (full . epa-validity-high-face)
149 (ultimate . epa-validity-high-face))
150 "An alist mapping validity values to faces."
154 (defcustom epa-font-lock-keywords
157 ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
158 (1 epa-field-name-face)
159 (2 epa-field-body-face)))
160 "Default expressions to addon in epa-mode."
161 :type '(repeat (list string))
164 (defconst epa-pubkey-algorithm-letter-alist
172 (defvar epa-keys-buffer nil)
173 (defvar epa-key-buffer-alist nil)
175 (defvar epa-list-keys-arguments nil)
176 (defvar epa-info-buffer nil)
177 (defvar epa-last-coding-system-specified nil)
179 (defvar epa-keys-mode-map
180 (let ((keymap (make-sparse-keymap)))
181 (define-key keymap "m" 'epa-mark)
182 (define-key keymap "u" 'epa-unmark)
183 (define-key keymap "d" 'epa-decrypt-file)
184 (define-key keymap "v" 'epa-verify-file)
185 (define-key keymap "s" 'epa-sign-file)
186 (define-key keymap "e" 'epa-encrypt-file)
187 (define-key keymap "r" 'epa-delete-keys)
188 (define-key keymap "i" 'epa-import-keys)
189 (define-key keymap "o" 'epa-export-keys)
190 (define-key keymap "g" 'epa-list-keys)
191 (define-key keymap "n" 'next-line)
192 (define-key keymap "p" 'previous-line)
193 (define-key keymap " " 'scroll-up)
194 (define-key keymap [delete] 'scroll-down)
195 (define-key keymap "q" 'epa-exit-buffer)
198 (defvar epa-key-mode-map
199 (let ((keymap (make-sparse-keymap)))
200 (define-key keymap "q" 'bury-buffer)
203 (defvar epa-info-mode-map
204 (let ((keymap (make-sparse-keymap)))
205 (define-key keymap "q" 'delete-window)
208 (defvar epa-exit-buffer-function #'bury-buffer)
210 (define-widget 'epa-key 'push-button
211 "Button for representing a epg-key object."
213 :button-face-get 'epa--key-widget-button-face-get
214 :value-create 'epa--key-widget-value-create
215 :action 'epa--key-widget-action
216 :help-echo 'epa--key-widget-help-echo)
218 (defun epa--key-widget-action (widget &optional event)
219 (epa--show-key (widget-get widget :value)))
221 (defun epa--key-widget-value-create (widget)
222 (let* ((key (widget-get widget :value))
223 (primary-sub-key (car (epg-key-sub-key-list key)))
224 (primary-user-id (car (epg-key-user-id-list key))))
225 (insert (format "%c "
226 (if (epg-sub-key-validity primary-sub-key)
227 (car (rassq (epg-sub-key-validity primary-sub-key)
228 epg-key-validity-alist))
230 (epg-sub-key-id primary-sub-key)
233 (if (stringp (epg-user-id-string primary-user-id))
234 (epg-user-id-string primary-user-id)
235 (epg-decode-dn (epg-user-id-string primary-user-id)))
238 (defun epa--key-widget-button-face-get (widget)
239 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
240 (widget-get widget :value))))))
242 (cdr (assq validity epa-validity-face-alist))
245 (defun epa--key-widget-help-echo (widget)
247 (epg-sub-key-id (car (epg-key-sub-key-list
248 (widget-get widget :value))))))
250 (if (fboundp 'encode-coding-string)
251 (defalias 'epa--encode-coding-string 'encode-coding-string)
252 (defalias 'epa--encode-coding-string 'identity))
254 (if (fboundp 'decode-coding-string)
255 (defalias 'epa--decode-coding-string 'decode-coding-string)
256 (defalias 'epa--decode-coding-string 'identity))
258 (defun epa-keys-mode ()
259 "Major mode for `epa-list-keys'."
260 (kill-all-local-variables)
261 (buffer-disable-undo)
262 (setq major-mode 'epa-keys-mode
266 (use-local-map epa-keys-mode-map)
267 (make-local-variable 'font-lock-defaults)
268 (setq font-lock-defaults '(epa-font-lock-keywords t))
269 ;; In XEmacs, auto-initialization of font-lock is not effective
270 ;; if buffer-file-name is not set.
271 (font-lock-set-defaults)
272 (make-local-variable 'epa-exit-buffer-function)
273 (run-hooks 'epa-keys-mode-hook))
275 (defun epa-key-mode ()
276 "Major mode for a key description."
277 (kill-all-local-variables)
278 (buffer-disable-undo)
279 (setq major-mode 'epa-key-mode
283 (use-local-map epa-key-mode-map)
284 (make-local-variable 'font-lock-defaults)
285 (setq font-lock-defaults '(epa-font-lock-keywords t))
286 ;; In XEmacs, auto-initialization of font-lock is not effective
287 ;; if buffer-file-name is not set.
288 (font-lock-set-defaults)
289 (make-local-variable 'epa-exit-buffer-function)
290 (run-hooks 'epa-key-mode-hook))
292 (defun epa-info-mode ()
293 "Major mode for `epa-info-buffer'."
294 (kill-all-local-variables)
295 (buffer-disable-undo)
296 (setq major-mode 'epa-info-mode
300 (use-local-map epa-info-mode-map)
301 (run-hooks 'epa-info-mode-hook))
303 (defun epa-mark (&optional arg)
304 "Mark the current line.
305 If ARG is non-nil, unmark the current line."
307 (let ((inhibit-read-only t)
311 (setq properties (text-properties-at (point)))
313 (insert (if arg " " "*"))
314 (set-text-properties (1- (point)) (point) properties)
317 (defun epa-unmark (&optional arg)
318 "Unmark the current line.
319 If ARG is non-nil, mark the current line."
321 (epa-mark (not arg)))
323 (defun epa-toggle-mark ()
324 "Toggle the mark the current line."
326 (epa-mark (eq (char-after (save-excursion (beginning-of-line) (point))) ?*)))
328 (defun epa-exit-buffer ()
329 "Exit the current buffer.
330 `epa-exit-buffer-function' is called if it is set."
332 (funcall epa-exit-buffer-function))
335 (defun epa-list-keys (&optional name mode)
336 "List all keys matched with NAME from the keyring.
337 If MODE is non-nil, it reads the private keyring. Otherwise, it
338 reads the public keyring."
340 (if current-prefix-arg
341 (let ((name (read-string "Pattern: "
342 (if epa-list-keys-arguments
343 (car epa-list-keys-arguments)))))
344 (list (if (equal name "") nil name)
345 (y-or-n-p "Secret keys? ")))
346 (or epa-list-keys-arguments (list nil nil))))
347 (unless (and epa-keys-buffer
348 (buffer-live-p epa-keys-buffer))
349 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
350 (set-buffer epa-keys-buffer)
351 (let ((inhibit-read-only t)
354 (context (epg-make-context epa-protocol)))
355 (unless (get-text-property point 'epa-list-keys)
356 (setq point (next-single-property-change point 'epa-list-keys)))
359 (or (next-single-property-change point 'epa-list-keys)
362 (epa--insert-keys context name mode)
365 (set-keymap-parent (current-local-map) widget-keymap))
366 (make-local-variable 'epa-list-keys-arguments)
367 (setq epa-list-keys-arguments (list name mode))
368 (goto-char (point-min))
369 (pop-to-buffer (current-buffer)))
371 (defun epa--insert-keys (context name mode)
374 (narrow-to-region (point) (point))
375 (let ((keys (epg-list-keys context name mode))
380 (add-text-properties point (point)
381 (list 'epa-key (car keys)
386 (widget-create 'epa-key :value (car keys))
388 (setq keys (cdr keys))))
389 (add-text-properties (point-min) (point-max)
390 (list 'epa-list-keys t
396 (defun epa--marked-keys ()
398 (set-buffer epa-keys-buffer)
399 (goto-char (point-min))
401 (while (re-search-forward "^\\*" nil t)
402 (if (setq key (get-text-property (match-beginning 0)
404 (setq keys (cons key keys))))
408 (let ((key (get-text-property (point) 'epa-key)))
413 (defun epa-select-keys (context prompt &optional names secret)
414 "Display a user's keyring and ask him to select keys.
415 CONTEXT is an epg-context.
416 PROMPT is a string to prompt with.
417 NAMES is a list of strings to be matched with keys. If it is nil, all
419 If SECRET is non-nil, list secret keys instead of public keys."
421 (unless (and epa-keys-buffer
422 (buffer-live-p epa-keys-buffer))
423 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
424 (let ((inhibit-read-only t)
426 (set-buffer epa-keys-buffer)
430 :notify (lambda (&rest ignore) (abort-recursive-edit))
432 (substitute-command-keys
433 "Click here or \\[abort-recursive-edit] to cancel")
436 :notify (lambda (&rest ignore) (exit-recursive-edit))
438 (substitute-command-keys
439 "Click here or \\[exit-recursive-edit] to finish")
444 (epa--insert-keys context (car names) secret)
445 (if (get-text-property (point) 'epa-list-keys)
447 (goto-char (point-max))
448 (setq names (cdr names)))
451 (epa--insert-keys context nil secret)
452 (if (get-text-property (point) 'epa-list-keys)
454 (epa--insert-keys context nil nil)))
457 (set-keymap-parent (current-local-map) widget-keymap)
458 (setq epa-exit-buffer-function #'abort-recursive-edit)
459 (goto-char (point-min))
460 (pop-to-buffer (current-buffer)))
465 (if (get-buffer-window epa-keys-buffer)
466 (delete-window (get-buffer-window epa-keys-buffer)))
467 (kill-buffer epa-keys-buffer))))
469 (defun epa--format-fingerprint-1 (fingerprint unit-size block-size)
473 (goto-char (point-min))
475 (goto-char (+ (point) unit-size))
477 (setq unit (1+ unit))
478 (insert (if (= (% unit block-size) 0) " " " ")))
481 (defun epa--format-fingerprint (fingerprint)
483 (if (= (length fingerprint) 40)
484 ;; 1234 5678 9ABC DEF0 1234 5678 9ABC DEF0 1234 5678
485 (epa--format-fingerprint-1 fingerprint 4 5)
486 ;; 12 34 56 78 9A BC DE F0 12 34 56 78 9A BC DE F0
487 (epa--format-fingerprint-1 fingerprint 2 8))))
489 (defun epa--show-key (key)
490 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
491 (entry (assoc (epg-sub-key-id primary-sub-key)
492 epa-key-buffer-alist))
493 (inhibit-read-only t)
497 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
498 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
499 (unless (and (cdr entry)
500 (buffer-live-p (cdr entry)))
501 (setcdr entry (generate-new-buffer
502 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
503 (set-buffer (cdr entry))
504 (make-local-variable 'epa-key)
507 (setq pointer (epg-key-user-id-list key))
511 (if (epg-user-id-validity (car pointer))
513 (car (rassq (epg-user-id-validity (car pointer))
514 epg-key-validity-alist)))
517 (if (stringp (epg-user-id-string (car pointer)))
518 (epg-user-id-string (car pointer))
519 (epg-decode-dn (epg-user-id-string (car pointer))))
521 (setq pointer (cdr pointer)))
522 (setq pointer (epg-key-sub-key-list key))
525 (if (epg-sub-key-validity (car pointer))
527 (car (rassq (epg-sub-key-validity (car pointer))
528 epg-key-validity-alist)))
531 (epg-sub-key-id (car pointer))
534 (epg-sub-key-length (car pointer)))
536 (cdr (assq (epg-sub-key-algorithm (car pointer))
537 epg-pubkey-algorithm-alist))
539 (format-time-string "%Y-%m-%d"
540 (epg-sub-key-creation-time (car pointer)))
541 (if (epg-sub-key-expiration-time (car pointer))
542 (format "\n\tExpires: %s"
543 (format-time-string "%Y-%m-%d"
544 (epg-sub-key-expiration-time
548 (mapconcat #'symbol-name
549 (epg-sub-key-capability (car pointer))
552 (epa--format-fingerprint (epg-sub-key-fingerprint (car pointer)))
554 (setq pointer (cdr pointer)))
555 (goto-char (point-min))
556 (pop-to-buffer (current-buffer))
559 (defun epa-display-info (info)
560 (if epa-popup-info-window
561 (save-selected-window
562 (unless epa-info-buffer
563 (setq epa-info-buffer (generate-new-buffer "*Info*")))
565 (set-buffer epa-info-buffer)
566 (let ((inhibit-read-only t)
571 (goto-char (point-min)))
572 (if (> (window-height)
573 epa-info-window-height)
574 (set-window-buffer (split-window nil (- (window-height)
575 epa-info-window-height))
577 (pop-to-buffer epa-info-buffer)
578 (if (> (window-height) epa-info-window-height)
579 (shrink-window (- (window-height) epa-info-window-height)))))
580 (message "%s" info)))
582 (defun epa-display-verify-result (verify-result)
583 (epa-display-info (epg-verify-result-to-string verify-result)))
584 (make-obsolete 'epa-display-verify-result 'epa-display-info)
586 (defun epa-passphrase-callback-function (context key-id handback)
588 (read-passwd "Passphrase for symmetric encryption: "
589 (eq (epg-context-operation context) 'encrypt))
592 "Passphrase for PIN: "
593 (let ((entry (assoc key-id epg-user-id-alist)))
595 (format "Passphrase for %s %s: " key-id (cdr entry))
596 (format "Passphrase for %s: " key-id)))))))
598 (defun epa-progress-callback-function (context what char current total
600 (message "%s: %d%% (%d/%d)" what
601 (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
605 (defun epa-decrypt-file (file)
607 (interactive "fFile: ")
608 (setq file (expand-file-name file))
609 (let* ((default-name (file-name-sans-extension file))
610 (plain (expand-file-name
612 (concat "To file (default "
613 (file-name-nondirectory default-name)
615 (file-name-directory default-name)
617 (context (epg-make-context epa-protocol)))
618 (epg-context-set-passphrase-callback context
619 #'epa-passphrase-callback-function)
620 (epg-context-set-progress-callback context
621 #'epa-progress-callback-function)
622 (message "Decrypting %s..." (file-name-nondirectory file))
623 (epg-decrypt-file context file plain)
624 (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
625 (file-name-nondirectory plain))
626 (if (epg-context-result-for context 'verify)
627 (epa-display-info (epg-verify-result-to-string
628 (epg-context-result-for context 'verify))))))
631 (defun epa-verify-file (file)
633 (interactive "fFile: ")
634 (setq file (expand-file-name file))
635 (let* ((context (epg-make-context epa-protocol))
636 (plain (if (equal (file-name-extension file) "sig")
637 (file-name-sans-extension file))))
638 (epg-context-set-progress-callback context
639 #'epa-progress-callback-function)
640 (message "Verifying %s..." (file-name-nondirectory file))
641 (epg-verify-file context file plain)
642 (message "Verifying %s...done" (file-name-nondirectory file))
643 (if (epg-context-result-for context 'verify)
644 (epa-display-info (epg-verify-result-to-string
645 (epg-context-result-for context 'verify))))))
647 (defun epa--read-signature-type ()
650 (message "Signature type (n,c,d,?) ")
655 (setq type 'detached))
657 (with-output-to-temp-buffer "*Help*"
659 (set-buffer standard-output)
661 n - Create a normal signature
662 c - Create a cleartext signature
663 d - Create a detached signature
667 (setq type 'normal))))))
670 (defun epa-sign-file (file signers mode)
671 "Sign FILE by SIGNERS keys selected."
673 (list (expand-file-name (read-file-name "File: "))
674 (if current-prefix-arg
675 (epa-select-keys (epg-make-context epa-protocol)
676 "Select keys for signing.
677 If no one is selected, default secret key is used. "
679 (if current-prefix-arg
680 (epa--read-signature-type)
682 (let ((signature (concat file
683 (if (eq epa-protocol 'OpenPGP)
686 '(nil t normal detached))))
688 (if (memq mode '(t detached))
691 (if (memq mode '(t detached))
694 (context (epg-make-context epa-protocol)))
695 (epg-context-set-armor context epa-armor)
696 (epg-context-set-textmode context epa-textmode)
697 (epg-context-set-signers context signers)
698 (epg-context-set-passphrase-callback context
699 #'epa-passphrase-callback-function)
700 (epg-context-set-progress-callback context
701 #'epa-progress-callback-function)
702 (message "Signing %s..." (file-name-nondirectory file))
703 (epg-sign-file context file signature mode)
704 (message "Signing %s...wrote %s" (file-name-nondirectory file)
705 (file-name-nondirectory signature))))
708 (defun epa-encrypt-file (file recipients)
709 "Encrypt FILE for RECIPIENTS."
711 (list (expand-file-name (read-file-name "File: "))
712 (epa-select-keys (epg-make-context epa-protocol)
713 "Select recipients for encryption.
714 If no one is selected, symmetric encryption will be performed. ")))
715 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
716 (if epa-armor ".asc" ".gpg")
718 (context (epg-make-context epa-protocol)))
719 (epg-context-set-armor context epa-armor)
720 (epg-context-set-textmode context epa-textmode)
721 (epg-context-set-passphrase-callback context
722 #'epa-passphrase-callback-function)
723 (epg-context-set-progress-callback context
724 #'epa-progress-callback-function)
725 (message "Encrypting %s..." (file-name-nondirectory file))
726 (epg-encrypt-file context file recipients cipher)
727 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
728 (file-name-nondirectory cipher))))
731 (defun epa-decrypt-region (start end)
732 "Decrypt the current region between START and END.
734 Don't use this command in Lisp programs!"
737 (let ((context (epg-make-context epa-protocol))
739 (epg-context-set-passphrase-callback context
740 #'epa-passphrase-callback-function)
741 (epg-context-set-progress-callback context
742 #'epa-progress-callback-function)
743 (message "Decrypting...")
744 (setq plain (epg-decrypt-string context (buffer-substring start end)))
745 (message "Decrypting...done")
746 (delete-region start end)
748 (insert (epa--decode-coding-string plain
749 (or coding-system-for-read
751 start 'epa-coding-system-used))))
752 (if (epg-context-result-for context 'verify)
753 (epa-display-info (epg-verify-result-to-string
754 (epg-context-result-for context 'verify)))))))
757 (defun epa-decrypt-armor-in-region (start end)
758 "Decrypt OpenPGP armors in the current region between START and END.
760 Don't use this command in Lisp programs!"
764 (narrow-to-region start end)
766 (let (armor-start armor-end charset coding-system)
767 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
768 (setq armor-start (match-beginning 0)
769 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
772 (error "No armor tail"))
773 (goto-char armor-start)
774 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
775 (setq charset (match-string 1)))
776 (if coding-system-for-read
777 (setq coding-system coding-system-for-read)
779 (setq coding-system (intern (downcase charset)))
780 (setq coding-system 'utf-8)))
781 (let ((coding-system-for-read coding-system))
782 (epa-decrypt-region armor-start armor-end)))))))
785 (defun epa-decrypt ()
786 "Decrypt OpenPGP armors in the current buffer.
788 Don't use this command in Lisp programs!"
790 (epa-decrypt-armor-in-region (point-min) (point-max)))
792 (if (fboundp 'select-safe-coding-system)
793 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
794 (defun epa--select-safe-coding-system (from to)
795 buffer-file-coding-system))
798 (defun epa-verify-region (start end)
799 "Verify the current region between START and END.
801 Don't use this command in Lisp programs!"
803 (let ((context (epg-make-context epa-protocol)))
804 (epg-context-set-progress-callback context
805 #'epa-progress-callback-function)
806 (epg-verify-string context
807 (epa--encode-coding-string
808 (buffer-substring start end)
809 (or coding-system-for-write
810 (get-text-property start
811 'epa-coding-system-used))))
812 (if (epg-context-result-for context 'verify)
813 (epa-display-info (epg-verify-result-to-string
814 (epg-context-result-for context 'verify))))))
817 (defun epa-verify-cleartext-in-region (start end)
818 "Verify OpenPGP cleartext signed messages in the current region
819 between START and END.
821 Don't use this command in Lisp programs!"
825 (narrow-to-region start end)
827 (let (armor-start armor-end)
828 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
830 (setq armor-start (match-beginning 0))
831 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
833 (error "Invalid cleartext signed message"))
834 (setq armor-end (re-search-forward
835 "^-----END PGP SIGNATURE-----$"
838 (error "No armor tail"))
839 (epa-verify-region armor-start armor-end))))))
843 "Verify OpenPGP cleartext signed messages in the current buffer.
845 Don't use this command in Lisp programs!"
846 (epa-verify-cleartext-in-region (point-min) (point-max)))
849 (defun epa-sign-region (start end signers mode)
850 "Sign the current region between START and END by SIGNERS keys selected.
852 Don't use this command in Lisp programs!"
855 (setq epa-last-coding-system-specified
856 (or coding-system-for-write
857 (epa--select-safe-coding-system
858 (region-beginning) (region-end))))
859 (list (region-beginning) (region-end)
860 (if current-prefix-arg
861 (epa-select-keys (epg-make-context epa-protocol)
862 "Select keys for signing.
863 If no one is selected, default secret key is used. "
865 (if current-prefix-arg
866 (epa--read-signature-type)
869 (let ((context (epg-make-context epa-protocol))
871 ;;(epg-context-set-armor context epa-armor)
872 (epg-context-set-armor context t)
873 ;;(epg-context-set-textmode context epa-textmode)
874 (epg-context-set-textmode context t)
875 (epg-context-set-signers context signers)
876 (epg-context-set-passphrase-callback context
877 #'epa-passphrase-callback-function)
878 (epg-context-set-progress-callback context
879 #'epa-progress-callback-function)
880 (message "Signing...")
881 (setq signature (epg-sign-string context
882 (epa--encode-coding-string
883 (buffer-substring start end)
884 epa-last-coding-system-specified)
886 (message "Signing...done")
887 (delete-region start end)
888 (add-text-properties (point)
890 (insert (epa--decode-coding-string
892 (or coding-system-for-read
893 epa-last-coding-system-specified)))
895 (list 'epa-coding-system-used
896 epa-last-coding-system-specified
903 (defun epa-sign (start end signers mode)
904 "Sign the current buffer.
906 Don't use this command in Lisp programs!"
909 (goto-char (point-min))
910 (if (and (or (eq major-mode 'mail-mode)
911 (eq (derived-mode-class major-mode) 'mail-mode))
912 (search-forward mail-header-separator nil t))
914 (setq epa-last-coding-system-specified
915 (or coding-system-for-write
916 (epa--select-safe-coding-system (point) (point-max))))
917 (list (point) (point-max)
918 (if current-prefix-arg
919 (epa-select-keys (epg-make-context epa-protocol)
920 "Select keys for signing.
921 If no one is selected, default secret key is used. "
923 (if current-prefix-arg
924 (epa--read-signature-type)
926 (epa-sign-region start end signers mode))
929 (defun epa-encrypt-region (start end recipients)
930 "Encrypt the current region between START and END for RECIPIENTS.
932 Don't use this command in Lisp programs!"
935 (setq epa-last-coding-system-specified
936 (or coding-system-for-write
937 (epa--select-safe-coding-system
938 (region-beginning) (region-end))))
939 (list (region-beginning) (region-end)
940 (epa-select-keys (epg-make-context epa-protocol)
941 "Select recipients for encryption.
942 If no one is selected, symmetric encryption will be performed. "))))
944 (let ((context (epg-make-context epa-protocol))
946 ;;(epg-context-set-armor context epa-armor)
947 (epg-context-set-armor context t)
948 ;;(epg-context-set-textmode context epa-textmode)
949 (epg-context-set-textmode context t)
950 (epg-context-set-passphrase-callback context
951 #'epa-passphrase-callback-function)
952 (epg-context-set-progress-callback context
953 #'epa-progress-callback-function)
954 (message "Encrypting...")
955 (setq cipher (epg-encrypt-string context
956 (epa--encode-coding-string
957 (buffer-substring start end)
958 epa-last-coding-system-specified)
960 (message "Encrypting...done")
961 (delete-region start end)
962 (add-text-properties (point)
966 (list 'epa-coding-system-used
967 epa-last-coding-system-specified
974 (defun epa-encrypt (start end recipients)
975 "Encrypt the current buffer.
977 Don't use this command in Lisp programs!"
980 (goto-char (point-min))
981 (when (or (eq major-mode 'mail-mode)
982 (eq (derived-mode-class major-mode) 'mail-mode))
984 (narrow-to-region (point)
986 (search-forward mail-header-separator nil 0)
987 (match-beginning 0)))
989 (mail-strip-quoted-names
990 (mapconcat #'identity
991 (nconc (mail-fetch-field "to" nil nil t)
992 (mail-fetch-field "cc" nil nil t)
993 (mail-fetch-field "bcc" nil nil t))
996 (setq recipients (delete "" (split-string recipients "[ \t\n]+"))))
997 (goto-char (point-min))
998 (if (search-forward mail-header-separator nil t)
1000 (setq epa-last-coding-system-specified
1001 (or coding-system-for-write
1002 (epa--select-safe-coding-system (point) (point-max))))
1003 (list (point) (point-max)
1004 (if current-prefix-arg
1006 (epg-make-context epa-protocol)
1007 "Select recipients for encryption.
1008 If no one is selected, symmetric encryption will be performed. "
1015 (epg-list-keys (epg-make-context epa-protocol)
1016 (concat "<" recipient ">")))
1018 (epa-encrypt-region start end recipients))
1021 (defun epa-delete-keys (keys &optional allow-secret)
1022 "Delete selected KEYS.
1024 Don't use this command in Lisp programs!"
1026 (let ((keys (epa--marked-keys)))
1028 (error "No keys selected"))
1030 (eq (nth 1 epa-list-keys-arguments) t))))
1031 (let ((context (epg-make-context epa-protocol)))
1032 (message "Deleting...")
1033 (epg-delete-keys context keys allow-secret)
1034 (message "Deleting...done")
1035 (apply #'epa-list-keys epa-list-keys-arguments)))
1038 (defun epa-import-keys (file)
1039 "Import keys from FILE.
1041 Don't use this command in Lisp programs!"
1042 (interactive "fFile: ")
1043 (setq file (expand-file-name file))
1044 (let ((context (epg-make-context epa-protocol)))
1045 (message "Importing %s..." (file-name-nondirectory file))
1048 (epg-import-keys-from-file context file)
1049 (message "Importing %s...done" (file-name-nondirectory file)))
1051 (message "Importing %s...failed" (file-name-nondirectory file))))
1052 (if (epg-context-result-for context 'import)
1053 (epa-display-info (epg-import-result-to-string
1054 (epg-context-result-for context 'import))))
1055 (if (eq major-mode 'epa-keys-mode)
1056 (apply #'epa-list-keys epa-list-keys-arguments))))
1059 (defun epa-import-keys-region (start end)
1060 "Import keys from the region.
1062 Don't use this command in Lisp programs!"
1064 (let ((context (epg-make-context epa-protocol)))
1065 (message "Importing...")
1068 (epg-import-keys-from-string context (buffer-substring start end))
1069 (message "Importing...done"))
1071 (message "Importing...failed")))
1072 (if (epg-context-result-for context 'import)
1073 (epa-display-info (epg-import-result-to-string
1074 (epg-context-result-for context 'import))))))
1077 (defun epa-import-armor-in-region (start end)
1078 "Import keys in the OpenPGP armor format in the current region
1079 between START and END.
1081 Don't use this command in Lisp programs!"
1085 (narrow-to-region start end)
1087 (let (armor-start armor-end)
1088 (while (re-search-forward
1089 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1091 (setq armor-start (match-beginning 0)
1092 armor-end (re-search-forward
1093 (concat "^-----END " (match-string 1) "-----$")
1096 (error "No armor tail"))
1097 (epa-import-keys-region armor-start armor-end))))))
1100 (defun epa-import ()
1101 "Import keys in the OpenPGP armor format in the current buffer.
1103 Don't use this command in Lisp programs!"
1105 (epa-import-armor-in-region (point-min) (point-max)))
1108 (defun epa-export-keys (keys file)
1109 "Export selected KEYS to FILE.
1111 Don't use this command in Lisp programs!"
1113 (let ((keys (epa--marked-keys))
1116 (error "No keys selected"))
1119 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1120 (if epa-armor ".asc" ".gpg"))
1125 (concat "To file (default "
1126 (file-name-nondirectory default-name)
1128 (file-name-directory default-name)
1130 (let ((context (epg-make-context epa-protocol)))
1131 (epg-context-set-armor context epa-armor)
1132 (message "Exporting to %s..." (file-name-nondirectory file))
1133 (epg-export-keys-to-file context keys file)
1134 (message "Exporting to %s...done" (file-name-nondirectory file))))
1137 (defun epa-insert-keys (keys)
1138 "Insert selected KEYS after the point.
1140 Don't use this command in Lisp programs!"
1142 (list (epa-select-keys (epg-make-context epa-protocol)
1143 "Select keys to export. ")))
1144 (let ((context (epg-make-context epa-protocol)))
1145 ;;(epg-context-set-armor context epa-armor)
1146 (epg-context-set-armor context t)
1147 (insert (epg-export-keys-to-string context keys))))
1150 (defun epa-sign-keys (keys &optional local)
1151 "Sign selected KEYS.
1152 If a prefix-arg is specified, the signature is marked as non exportable.
1154 Don't use this command in Lisp programs!"
1156 (let ((keys (epa--marked-keys)))
1158 (error "No keys selected"))
1159 (list keys current-prefix-arg)))
1160 (let ((context (epg-make-context epa-protocol)))
1161 (epg-context-set-passphrase-callback context
1162 #'epa-passphrase-callback-function)
1163 (epg-context-set-progress-callback context
1164 #'epa-progress-callback-function)
1165 (message "Signing keys...")
1166 (epg-sign-keys context keys local)
1167 (message "Signing keys...done")))
1168 (make-obsolete 'epa-sign-keys "Do not use.")
1172 ;;; epa.el ends here