X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epa.el;h=85421f241456207c2d1a01b8817396b51c2ed34c;hb=0203719739be2984f7fdad74c7fd26bfb2cf73ed;hp=2dab9a193b655ef2dee98487bf8edd0a0be6fc6f;hpb=2d2d32ada3b792c0ea1cdd0d1b5dbb6c5ab08b58;p=elisp%2Fepg.git diff --git a/epa.el b/epa.el index 2dab9a1..85421f2 100644 --- a/epa.el +++ b/epa.el @@ -27,6 +27,7 @@ (require 'font-lock) (require 'widget) (eval-when-compile (require 'wid-edit)) +(require 'derived) (defgroup epa nil "The EasyPG Assistant" @@ -174,7 +175,7 @@ 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) @@ -253,22 +254,22 @@ the separate window." (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)) + (run-hooks 'epa-key-list-mode-hook)) (defun epa-key-mode () "Major mode for a key description." @@ -346,6 +347,7 @@ reads the public keyring." (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)) @@ -358,7 +360,6 @@ reads the public keyring." (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) @@ -419,11 +420,15 @@ If SECRET is non-nil, list secret keys instead of public keys." (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]' to mark a key on the line +- `\\[epa-unmark]' to unmark a key on the line\n")) (widget-create 'link :notify (lambda (&rest ignore) (abort-recursive-edit)) :help-echo @@ -450,7 +455,6 @@ If SECRET is non-nil, list secret keys instead of public keys." (if (get-text-property (point) 'epa-list-keys) (epa-mark))) (epa--insert-keys context nil nil))) - (epa-keys-mode) (widget-setup) (set-keymap-parent (current-local-map) widget-keymap) (setq epa-exit-buffer-function #'abort-recursive-edit) @@ -499,6 +503,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) @@ -551,14 +556,15 @@ 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 (setq epa-info-buffer (generate-new-buffer "*Info*"))) + (if (get-buffer-window epa-info-buffer) + (delete-window (get-buffer-window epa-info-buffer))) (save-excursion (set-buffer epa-info-buffer) (let ((inhibit-read-only t) @@ -595,7 +601,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (defun epa-progress-callback-function (context what char current total handback) - (message "%s: %d%% (%d/%d)" what + (message "%s%d%% (%d/%d)" (or handback + (concat what ": ")) (if (> total 0) (floor (* (/ current (float total)) 100)) 0) current total)) @@ -616,7 +623,9 @@ If SECRET is non-nil, list secret keys instead of public keys." (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + (format "Decrypting %s..." + (file-name-nondirectory file))) (message "Decrypting %s..." (file-name-nondirectory file)) (epg-decrypt-file context file plain) (message "Decrypting %s...wrote %s" (file-name-nondirectory file) @@ -634,7 +643,9 @@ If SECRET is non-nil, list secret keys instead of public keys." (plain (if (equal (file-name-extension file) "sig") (file-name-sans-extension file)))) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + (format "Verifying %s..." + (file-name-nondirectory file))) (message "Verifying %s..." (file-name-nondirectory file)) (epg-verify-file context file plain) (message "Verifying %s...done" (file-name-nondirectory file)) @@ -642,35 +653,42 @@ If SECRET is non-nil, list secret keys instead of public keys." (epa-display-info (epg-verify-result-to-string (epg-context-result-for context 'verify)))))) -;;;###autoload -(defun epa-sign-file (file signers mode) - "Sign FILE by SIGNERS keys selected." - (interactive - (list (expand-file-name (read-file-name "File: ")) - (epa-select-keys (epg-make-context epa-protocol) - "Select keys for signing. -If no one is selected, default secret key is used. " - nil t) - (catch 'done - (while t - (message "Signature type (n,c,d,?) ") - (let ((c (read-char))) - (cond ((eq c ?c) - (throw 'done 'clear)) - ((eq c ?d) - (throw 'done 'detached)) - ((eq c ??) - (with-output-to-temp-buffer "*Help*" - (save-excursion - (set-buffer standard-output) - (insert "\ +(defun epa--read-signature-type () + (let (type c) + (while (null type) + (message "Signature type (n,c,d,?) ") + (setq c (read-char)) + (cond ((eq c ?c) + (setq type 'clear)) + ((eq c ?d) + (setq type 'detached)) + ((eq c ??) + (with-output-to-temp-buffer "*Help*" + (save-excursion + (set-buffer standard-output) + (insert "\ n - Create a normal signature c - Create a cleartext signature d - Create a detached signature ? - Show this help ")))) - (t - (throw 'done nil)))))))) + (t + (setq type 'normal)))))) + +;;;###autoload +(defun epa-sign-file (file signers mode) + "Sign FILE by SIGNERS keys selected." + (interactive + (let ((verbose current-prefix-arg)) + (list (expand-file-name (read-file-name "File: ")) + (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)))) (let ((signature (concat file (if (eq epa-protocol 'OpenPGP) (if (or epa-armor @@ -690,7 +708,9 @@ d - Create a detached signature (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + (format "Signing %s..." + (file-name-nondirectory file))) (message "Signing %s..." (file-name-nondirectory file)) (epg-sign-file context file signature mode) (message "Signing %s...wrote %s" (file-name-nondirectory file) @@ -713,7 +733,9 @@ If no one is selected, symmetric encryption will be performed. "))) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + (format "Encrypting %s..." + (file-name-nondirectory file))) (message "Encrypting %s..." (file-name-nondirectory file)) (epg-encrypt-file context file recipients cipher) (message "Encrypting %s...wrote %s" (file-name-nondirectory file) @@ -731,20 +753,40 @@ Don't use this command in Lisp programs!" (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + "Decrypting...") (message "Decrypting...") (setq plain (epg-decrypt-string context (buffer-substring start end))) (message "Decrypting...done") - (delete-region start end) - (goto-char start) - (insert (epa--decode-coding-string plain - (or coding-system-for-read - (get-text-property - start 'epa-coding-system-used)))) + (setq plain (epa--decode-coding-string + plain + (or coding-system-for-read + (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))))))) +(defun epa--find-coding-system-for-mime-charset (mime-charset) + (if (featurep 'xemacs) + (if (fboundp 'find-coding-system) + (find-coding-system mime-charset)) + (let ((pointer (coding-system-list))) + (while (and pointer + (eq (coding-system-get (car pointer) 'mime-charset) + mime-charset)) + (setq pointer (cdr pointer))) + pointer))) + ;;;###autoload (defun epa-decrypt-armor-in-region (start end) "Decrypt OpenPGP armors in the current region between START and END. @@ -755,7 +797,7 @@ Don't use this command in Lisp programs!" (save-restriction (narrow-to-region start end) (goto-char start) - (let (armor-start armor-end charset coding-system) + (let (armor-start armor-end) (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) (setq armor-start (match-beginning 0) armor-end (re-search-forward "^-----END PGP MESSAGE-----$" @@ -763,20 +805,13 @@ Don't use this command in Lisp programs!" (unless armor-end (error "No armor tail")) (goto-char armor-start) - (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) - (setq charset (match-string 1))) - (if coding-system-for-read - (setq coding-system coding-system-for-read) - (if charset - (setq coding-system (intern (downcase charset))) - (setq coding-system 'utf-8))) - (let ((coding-system-for-read coding-system)) - (epa-decrypt-region start end))))))) - -(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)) + (let ((coding-system-for-read + (or coding-system-for-read + (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) + (epa--find-coding-system-for-mime-charset + (intern (downcase (match-string 1)))))))) + (goto-char armor-end) + (epa-decrypt-region armor-start armor-end))))))) ;;;###autoload (defun epa-verify-region (start end) @@ -786,7 +821,8 @@ Don't use this command in Lisp programs!" (interactive "r") (let ((context (epg-make-context epa-protocol))) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + "Verifying...") (epg-verify-string context (epa--encode-coding-string (buffer-substring start end) @@ -822,42 +858,31 @@ Don't use this command in Lisp programs!" (error "No armor tail")) (epa-verify-region armor-start armor-end)))))) +(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) "Sign the current region between START and END by SIGNERS keys selected. Don't use this command in Lisp programs!" (interactive - (progn + (let ((verbose current-prefix-arg)) (setq epa-last-coding-system-specified (or coding-system-for-write (epa--select-safe-coding-system (region-beginning) (region-end)))) (list (region-beginning) (region-end) - (epa-select-keys (epg-make-context epa-protocol) - "Select keys for signing. + (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) - (catch 'done - (while t - (message "Signature type (n,c,d,?) ") - (let ((c (read-char))) - (cond ((eq c ?c) - (throw 'done 'clear)) - ((eq c ?d) - (throw 'done 'detached)) - ((eq c ??) - (with-output-to-temp-buffer "*Help*" - (save-excursion - (set-buffer standard-output) - (insert "\ -n - Create a normal signature -c - Create a cleartext signature -d - Create a detached signature -? - Show this help -")))) - (t - (throw 'done nil))))))))) + nil t)) + (if verbose + (epa--read-signature-type) + 'clear)))) (save-excursion (let ((context (epg-make-context epa-protocol)) signature) @@ -869,7 +894,8 @@ d - Create a detached signature (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + "Signing...") (message "Signing...") (setq signature (epg-sign-string context (epa--encode-coding-string @@ -878,6 +904,7 @@ d - Create a detached signature mode)) (message "Signing...done") (delete-region start end) + (goto-char start) (add-text-properties (point) (progn (insert (epa--decode-coding-string @@ -892,21 +919,37 @@ d - Create a detached signature '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. +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))) + ;;;###autoload -(defun epa-encrypt-region (start end recipients) +(defun epa-encrypt-region (start end recipients sign signers) "Encrypt the current region between START and END for RECIPIENTS. Don't use this command in Lisp programs!" (interactive - (progn + (let ((verbose current-prefix-arg) + (context (epg-make-context epa-protocol)) + sign) (setq epa-last-coding-system-specified (or coding-system-for-write (epa--select-safe-coding-system (region-beginning) (region-end)))) (list (region-beginning) (region-end) - (epa-select-keys (epg-make-context epa-protocol) + (epa-select-keys context "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. ")))) +If no one is selected, symmetric encryption will be performed. ") + (setq sign (if verbose (y-or-n-p "Sign? "))) + (if sign + (epa-select-keys context + "Select keys for signing. "))))) (save-excursion (let ((context (epg-make-context epa-protocol)) cipher) @@ -914,18 +957,23 @@ If no one is selected, symmetric encryption will be performed. ")))) (epg-context-set-armor context t) ;;(epg-context-set-textmode context epa-textmode) (epg-context-set-textmode context t) + (if sign + (epg-context-set-signers context signers)) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + "Encrypting...") (message "Encrypting...") (setq cipher (epg-encrypt-string context (epa--encode-coding-string (buffer-substring start end) epa-last-coding-system-specified) - recipients)) + recipients + sign)) (message "Encrypting...done") (delete-region start end) + (goto-char start) (add-text-properties (point) (progn (insert cipher) @@ -972,7 +1020,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 @@ -994,6 +1042,29 @@ Don't use this command in Lisp programs!" (epg-context-result-for context 'import)))))) ;;;###autoload +(defun epa-import-armor-in-region (start end) + "Import keys in the OpenPGP armor format in the current region +between START and END. + +Don't use this command in Lisp programs!" + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let (armor-start armor-end) + (while (re-search-forward + "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$" + nil t) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward + (concat "^-----END " (match-string 1) "-----$") + nil t)) + (unless armor-end + (error "No armor tail")) + (epa-import-keys-region armor-start armor-end)))))) + +;;;###autoload (defun epa-export-keys (keys file) "Export selected KEYS to FILE. @@ -1050,7 +1121,8 @@ Don't use this command in Lisp programs!" (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context - #'epa-progress-callback-function) + #'epa-progress-callback-function + "Signing keys...") (message "Signing keys...") (epg-sign-keys context keys local) (message "Signing keys...done")))