X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epa.el;h=6a6b422a3e3f141fc08af61fae6176c0dfdbe2a8;hb=b32f12ba258eb94b5e158adefe44e6ad2f732214;hp=d5d82982927ead0ebf007bf32af5d6b43776409d;hpb=ca6ded8296b46a09a3de03e07a75414e72e3c315;p=elisp%2Fepg.git diff --git a/epa.el b/epa.el index d5d8298..6a6b422 100644 --- a/epa.el +++ b/epa.el @@ -27,29 +27,12 @@ (require 'font-lock) (require 'widget) (eval-when-compile (require 'wid-edit)) -(require 'mail-utils) (require 'derived) (defgroup epa nil "The EasyPG Assistant" :group 'epg) -(defcustom epa-protocol 'OpenPGP - "The default protocol." - :type '(choice (const :tag "OpenPGP" OpenPGP) - (const :tag "CMS" CMS)) - :group 'epa) - -(defcustom epa-armor nil - "If non-nil, epa commands create ASCII armored output." - :type 'boolean - :group 'epa) - -(defcustom epa-textmode nil - "If non-nil, epa commands treat input files as text." - :type 'boolean - :group 'epa) - (defcustom epa-popup-info-window t "If non-nil, status information from epa commands is displayed on the separate window." @@ -61,11 +44,6 @@ the separate window." :type 'integer :group 'epa) -(defcustom epa-mail-modes '(mail-mode message-mode) - "List of major-modes to compose mails." - :type 'list - :group 'epa) - (defgroup epa-faces nil "Faces for epa-mode." :group 'epa) @@ -174,6 +152,22 @@ the separate window." (17 . ?D) (20 . ?G))) +(defvar epa-protocol 'OpenPGP + "*The default protocol. +The value can be either OpenPGP or CMS. + +You should bind this variable with `let', but do not set it globally.") + +(defvar epa-armor nil + "*If non-nil, epa commands create ASCII armored output. + +You should bind this variable with `let', but do not set it globally.") + +(defvar epa-textmode nil + "*If non-nil, epa commands treat input files as text. + +You should bind this variable with `let', but do not set it globally.") + (defvar epa-keys-buffer nil) (defvar epa-key-buffer-alist nil) (defvar epa-key nil) @@ -181,10 +175,10 @@ the separate window." (defvar epa-info-buffer nil) (defvar epa-last-coding-system-specified nil) -(defvar epa-keys-mode-map +(defvar epa-key-list-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap "m" 'epa-mark) - (define-key keymap "u" 'epa-unmark) + (define-key keymap "m" 'epa-mark-key) + (define-key keymap "u" 'epa-unmark-key) (define-key keymap "d" 'epa-decrypt-file) (define-key keymap "v" 'epa-verify-file) (define-key keymap "s" 'epa-sign-file) @@ -192,7 +186,7 @@ the separate window." (define-key keymap "r" 'epa-delete-keys) (define-key keymap "i" 'epa-import-keys) (define-key keymap "o" 'epa-export-keys) - (define-key keymap "g" 'epa-list-keys) + (define-key keymap "g" 'revert-buffer) (define-key keymap "n" 'next-line) (define-key keymap "p" 'previous-line) (define-key keymap " " 'scroll-up) @@ -202,7 +196,7 @@ the separate window." (defvar epa-key-mode-map (let ((keymap (make-sparse-keymap))) - (define-key keymap "q" 'bury-buffer) + (define-key keymap "q" 'epa-exit-buffer) keymap)) (defvar epa-info-mode-map @@ -252,30 +246,34 @@ the separate window." (epg-sub-key-id (car (epg-key-sub-key-list (widget-get widget :value)))))) -(if (fboundp 'encode-coding-string) - (defalias 'epa--encode-coding-string 'encode-coding-string) - (defalias 'epa--encode-coding-string 'identity)) +(eval-and-compile + (if (fboundp 'encode-coding-string) + (defalias 'epa--encode-coding-string 'encode-coding-string) + (defalias 'epa--encode-coding-string 'identity))) -(if (fboundp 'decode-coding-string) - (defalias 'epa--decode-coding-string 'decode-coding-string) - (defalias 'epa--decode-coding-string 'identity)) +(eval-and-compile + (if (fboundp 'decode-coding-string) + (defalias 'epa--decode-coding-string 'decode-coding-string) + (defalias 'epa--decode-coding-string 'identity))) -(defun epa-keys-mode () +(defun epa-key-list-mode () "Major mode for `epa-list-keys'." (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'epa-keys-mode + (setq major-mode 'epa-key-list-mode mode-name "Keys" truncate-lines t buffer-read-only t) - (use-local-map epa-keys-mode-map) + (use-local-map epa-key-list-mode-map) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(epa-font-lock-keywords t)) ;; In XEmacs, auto-initialization of font-lock is not effective ;; if buffer-file-name is not set. (font-lock-set-defaults) (make-local-variable 'epa-exit-buffer-function) - (run-hooks 'epa-keys-mode-hook)) + (make-local-variable 'revert-buffer-function) + (setq revert-buffer-function 'epa--key-list-revert-buffer) + (run-hooks 'epa-key-list-mode-hook)) (defun epa-key-mode () "Major mode for a key description." @@ -305,30 +303,27 @@ the separate window." (use-local-map epa-info-mode-map) (run-hooks 'epa-info-mode-hook)) -(defun epa-mark (&optional arg) - "Mark the current line. -If ARG is non-nil, unmark the current line." +(defun epa-mark-key (&optional arg) + "Mark a key on the current line. +If ARG is non-nil, unmark the key." (interactive "P") (let ((inhibit-read-only t) buffer-read-only properties) (beginning-of-line) + (unless (get-text-property (point) 'epa-key) + (error "No key on this line")) (setq properties (text-properties-at (point))) (delete-char 1) (insert (if arg " " "*")) (set-text-properties (1- (point)) (point) properties) (forward-line))) -(defun epa-unmark (&optional arg) - "Unmark the current line. -If ARG is non-nil, mark the current line." +(defun epa-unmark-key (&optional arg) + "Unmark a key on the current line. +If ARG is non-nil, mark the key." (interactive "P") - (epa-mark (not arg))) - -(defun epa-toggle-mark () - "Toggle the mark the current line." - (interactive) - (epa-mark (eq (char-after (save-excursion (beginning-of-line) (point))) ?*))) + (epa-mark-key (not arg))) (defun epa-exit-buffer () "Exit the current buffer. @@ -336,49 +331,11 @@ If ARG is non-nil, mark the current line." (interactive) (funcall epa-exit-buffer-function)) -;;;###autoload -(defun epa-list-keys (&optional name mode) - "List all keys matched with NAME from the keyring. -If MODE is non-nil, it reads the private keyring. Otherwise, it -reads the public keyring." - (interactive - (if current-prefix-arg - (let ((name (read-string "Pattern: " - (if epa-list-keys-arguments - (car epa-list-keys-arguments))))) - (list (if (equal name "") nil name) - (y-or-n-p "Secret keys? "))) - (or epa-list-keys-arguments (list nil nil)))) - (unless (and epa-keys-buffer - (buffer-live-p epa-keys-buffer)) - (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) - (set-buffer epa-keys-buffer) - (let ((inhibit-read-only t) - buffer-read-only - (point (point-min)) - (context (epg-make-context epa-protocol))) - (unless (get-text-property point 'epa-list-keys) - (setq point (next-single-property-change point 'epa-list-keys))) - (when point - (delete-region point - (or (next-single-property-change point 'epa-list-keys) - (point-max))) - (goto-char point)) - (epa--insert-keys context name mode) - (epa-keys-mode) - (widget-setup) - (set-keymap-parent (current-local-map) widget-keymap)) - (make-local-variable 'epa-list-keys-arguments) - (setq epa-list-keys-arguments (list name mode)) - (goto-char (point-min)) - (pop-to-buffer (current-buffer))) - -(defun epa--insert-keys (context name mode) +(defun epa--insert-keys (keys) (save-excursion (save-restriction (narrow-to-region (point) (point)) - (let ((keys (epg-list-keys context name mode)) - point) + (let (point) (while keys (setq point (point)) (insert " ") @@ -398,6 +355,58 @@ reads the public keyring." 'start-open t 'end-open t))))) +(defun epa--list-keys (name secret) + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (set-buffer epa-keys-buffer) + (epa-key-list-mode) + (let ((inhibit-read-only t) + buffer-read-only + (point (point-min)) + (context (epg-make-context epa-protocol))) + (unless (get-text-property point 'epa-list-keys) + (setq point (next-single-property-change point 'epa-list-keys))) + (when point + (delete-region point + (or (next-single-property-change point 'epa-list-keys) + (point-max))) + (goto-char point)) + (epa--insert-keys (epg-list-keys context name secret)) + (widget-setup) + (set-keymap-parent (current-local-map) widget-keymap)) + (make-local-variable 'epa-list-keys-arguments) + (setq epa-list-keys-arguments (list name secret)) + (goto-char (point-min)) + (pop-to-buffer (current-buffer))) + +;;;###autoload +(defun epa-list-keys (&optional name) + "List all keys matched with NAME from the public keyring." + (interactive + (if current-prefix-arg + (let ((name (read-string "Pattern: " + (if epa-list-keys-arguments + (car epa-list-keys-arguments))))) + (list (if (equal name "") nil name))) + (list nil))) + (epa--list-keys name nil)) + +;;;###autoload +(defun epa-list-secret-keys (&optional name) + "List all keys matched with NAME from the private keyring." + (interactive + (if current-prefix-arg + (let ((name (read-string "Pattern: " + (if epa-list-keys-arguments + (car epa-list-keys-arguments))))) + (list (if (equal name "") nil name))) + (list nil))) + (epa--list-keys name t)) + +(defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm) + (apply #'epa--list-keys epa-list-keys-arguments)) + (defun epa--marked-keys () (or (save-excursion (set-buffer epa-keys-buffer) @@ -414,23 +423,20 @@ reads the public keyring." (if key (list key)))))) -;;;###autoload -(defun epa-select-keys (context prompt &optional names secret) - "Display a user's keyring and ask him to select keys. -CONTEXT is an epg-context. -PROMPT is a string to prompt with. -NAMES is a list of strings to be matched with keys. If it is nil, all -the keys are listed. -If SECRET is non-nil, list secret keys instead of public keys." +(defun epa--select-keys (prompt keys) (save-excursion (unless (and epa-keys-buffer (buffer-live-p epa-keys-buffer)) (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (set-buffer epa-keys-buffer) + (epa-key-list-mode) (let ((inhibit-read-only t) buffer-read-only) - (set-buffer epa-keys-buffer) (erase-buffer) - (insert prompt "\n") + (insert prompt "\n" + (substitute-command-keys "\ +- `\\[epa-mark-key]' to mark a key on the line +- `\\[epa-unmark-key]' to unmark a key on the line\n")) (widget-create 'link :notify (lambda (&rest ignore) (abort-recursive-edit)) :help-echo @@ -444,20 +450,7 @@ If SECRET is non-nil, list secret keys instead of public keys." "Click here or \\[exit-recursive-edit] to finish") "OK") (insert "\n\n") - (if names - (while names - (epa--insert-keys context (car names) secret) - (if (get-text-property (point) 'epa-list-keys) - (epa-mark)) - (goto-char (point-max)) - (setq names (cdr names))) - (if secret - (progn - (epa--insert-keys context nil secret) - (if (get-text-property (point) 'epa-list-keys) - (epa-mark))) - (epa--insert-keys context nil nil))) - (epa-keys-mode) + (epa--insert-keys keys) (widget-setup) (set-keymap-parent (current-local-map) widget-keymap) (setq epa-exit-buffer-function #'abort-recursive-edit) @@ -471,6 +464,19 @@ If SECRET is non-nil, list secret keys instead of public keys." (delete-window (get-buffer-window epa-keys-buffer))) (kill-buffer epa-keys-buffer)))) +;;;###autoload +(defun epa-select-keys (context prompt &optional names secret) + "Display a user's keyring and ask him to select keys. +CONTEXT is an epg-context. +PROMPT is a string to prompt with. +NAMES is a list of strings to be matched with keys. If it is nil, all +the keys are listed. +If SECRET is non-nil, list secret keys instead of public keys." + (let ((keys (epg-list-keys context names secret))) + (if (> (length keys) 1) + (epa--select-keys prompt keys) + keys))) + (defun epa--format-fingerprint-1 (fingerprint unit-size block-size) (let ((unit 0)) (with-temp-buffer @@ -506,6 +512,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (setcdr entry (generate-new-buffer (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) (set-buffer (cdr entry)) + (epa-key-mode) (make-local-variable 'epa-key) (setq epa-key key) (erase-buffer) @@ -558,13 +565,12 @@ If SECRET is non-nil, list secret keys instead of public keys." "\n") (setq pointer (cdr pointer))) (goto-char (point-min)) - (pop-to-buffer (current-buffer)) - (epa-key-mode))) + (pop-to-buffer (current-buffer)))) (defun epa-display-info (info) (if epa-popup-info-window (save-selected-window - (unless epa-info-buffer + (unless (and epa-info-buffer (buffer-live-p epa-info-buffer)) (setq epa-info-buffer (generate-new-buffer "*Info*"))) (if (get-buffer-window epa-info-buffer) (delete-window (get-buffer-window epa-info-buffer))) @@ -817,35 +823,33 @@ Don't use this command in Lisp programs!" (epa-decrypt-region armor-start armor-end))))))) ;;;###autoload -(defun epa-decrypt-mail () - "Decrypt OpenPGP armors in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" - (interactive) - (epa-decrypt-armor-in-region (point-min) (point-max))) - -(if (fboundp 'select-safe-coding-system) - (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) - (defun epa--select-safe-coding-system (from to) - buffer-file-coding-system)) - -;;;###autoload (defun epa-verify-region (start end) "Verify the current region between START and END. Don't use this command in Lisp programs!" (interactive "r") - (let ((context (epg-make-context epa-protocol))) + (let ((context (epg-make-context epa-protocol)) + plain) (epg-context-set-progress-callback context #'epa-progress-callback-function "Verifying...") - (epg-verify-string context - (epa--encode-coding-string - (buffer-substring start end) - (or coding-system-for-write - (get-text-property start - 'epa-coding-system-used)))) + (setq plain (epg-verify-string + context + (epa--encode-coding-string + (buffer-substring start end) + (or coding-system-for-write + (get-text-property start + 'epa-coding-system-used))))) + (if (y-or-n-p "Replace the original text? ") + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region start end) + (goto-char start) + (insert plain)) + (with-output-to-temp-buffer "*Temp*" + (set-buffer standard-output) + (insert plain) + (epa-info-mode))) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string (epg-context-result-for context 'verify)))))) @@ -861,28 +865,25 @@ Don't use this command in Lisp programs!" (save-restriction (narrow-to-region start end) (goto-char start) - (let (armor-start armor-end) + (let (cleartext-start cleartext-end) (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$" nil t) - (setq armor-start (match-beginning 0)) + (setq cleartext-start (match-beginning 0)) (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" nil t) (error "Invalid cleartext signed message")) - (setq armor-end (re-search-forward + (setq cleartext-end (re-search-forward "^-----END PGP SIGNATURE-----$" nil t)) - (unless armor-end - (error "No armor tail")) - (epa-verify-region armor-start armor-end)))))) - -;;;###autoload -(defun epa-verify-mail () - "Verify OpenPGP cleartext signed messages in the current buffer. -The buffer is expected to contain a mail message. + (unless cleartext-end + (error "No cleartext tail")) + (epa-verify-region cleartext-start cleartext-end)))))) -Don't use this command in Lisp programs!" - (interactive) - (epa-verify-cleartext-in-region (point-min) (point-max))) +(eval-and-compile + (if (fboundp 'select-safe-coding-system) + (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) + (defun epa--select-safe-coding-system (from to) + buffer-file-coding-system))) ;;;###autoload (defun epa-sign-region (start end signers mode) @@ -940,49 +941,16 @@ If no one is selected, default secret key is used. " 'start-open t 'end-open t))))) -(if (fboundp 'derived-mode-p) - (defalias 'epa--derived-mode-p 'derived-mode-p) - (defun epa--derived-mode-p (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. +(eval-and-compile + (if (fboundp 'derived-mode-p) + (defalias 'epa--derived-mode-p 'derived-mode-p) + (defun epa--derived-mode-p (&rest modes) + "Non-nil if the current major mode is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards." - (let ((parent major-mode)) - (while (and (not (memq parent modes)) - (setq parent (get parent 'derived-mode-parent)))) - parent))) - -(defun epa--mail-mode-p () - (let ((pointer epa-mail-modes)) - (while (and pointer - (epa--derived-mode-p (car pointer))) - (setq pointer (cdr pointer))) - pointer)) - -;;;###autoload -(defun epa-sign-mail (start end signers mode) - "Sign the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" - (interactive - (save-excursion - (goto-char (point-min)) - (if (and (epa--mail-mode-p) - (search-forward mail-header-separator nil t)) - (forward-line)) - (setq epa-last-coding-system-specified - (or coding-system-for-write - (epa--select-safe-coding-system (point) (point-max)))) - (let ((verbose current-prefix-arg)) - (list (point) (point-max) - (if verbose - (epa-select-keys (epg-make-context epa-protocol) - "Select keys for signing. -If no one is selected, default secret key is used. " - nil t)) - (if verbose - (epa--read-signature-type) - 'clear))))) - (epa-sign-region start end signers mode)) + (let ((parent major-mode)) + (while (and (not (memq parent modes)) + (setq parent (get parent 'derived-mode-parent)))) + parent)))) ;;;###autoload (defun epa-encrypt-region (start end recipients sign signers) @@ -1041,69 +1009,6 @@ If no one is selected, symmetric encryption will be performed. ") 'end-open t))))) ;;;###autoload -(defun epa-encrypt-mail (start end recipients sign signers) - "Encrypt the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" - (interactive - (save-excursion - (let ((verbose current-prefix-arg) - (context (epg-make-context epa-protocol)) - recipients recipient-keys) - (goto-char (point-min)) - (when (epa--mail-mode-p) - (save-restriction - (narrow-to-region (point) - (if (search-forward mail-header-separator nil 0) - (match-beginning 0) - (point))) - (setq recipients - (mail-strip-quoted-names - (mapconcat #'identity - (nconc (mail-fetch-field "to" nil nil t) - (mail-fetch-field "cc" nil nil t) - (mail-fetch-field "bcc" nil nil t)) - ",")))) - (if recipients - (setq recipients (delete "" - (split-string recipients "[ \t\n]+")))) - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (forward-line))) - (setq epa-last-coding-system-specified - (or coding-system-for-write - (epa--select-safe-coding-system (point) (point-max)))) - (list (point) (point-max) - (if verbose - (epa-select-keys - context - "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - recipients) - (if recipients - (apply #'nconc - (mapcar - (lambda (recipient) - (setq recipient-keys - (epg-list-keys - (epg-make-context epa-protocol) - (concat "<" recipient ">"))) - (unless (or recipient-keys - (y-or-n-p - (format - "No public key for %s; skip it? " - recipient))) - (error "No public key for %s" recipient)) - recipient-keys) - recipients)))) - (setq sign (if verbose (y-or-n-p "Sign? "))) - (if sign - (epa-select-keys context - "Select keys for signing. ")))))) - (epa-encrypt-region start end recipients sign signers)) - -;;;###autoload (defun epa-delete-keys (keys &optional allow-secret) "Delete selected KEYS. @@ -1138,7 +1043,7 @@ Don't use this command in Lisp programs!" (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string (epg-context-result-for context 'import)))) - (if (eq major-mode 'epa-keys-mode) + (if (eq major-mode 'epa-key-list-mode) (apply #'epa-list-keys epa-list-keys-arguments)))) ;;;###autoload @@ -1183,15 +1088,6 @@ Don't use this command in Lisp programs!" (epa-import-keys-region armor-start armor-end)))))) ;;;###autoload -(defun epa-import-mail () - "Import keys in the OpenPGP armor format in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" - (interactive) - (epa-import-armor-in-region (point-min) (point-max))) - -;;;###autoload (defun epa-export-keys (keys file) "Export selected KEYS to FILE.