diff options
Diffstat (limited to 'lisp/epa.el')
| -rw-r--r-- | lisp/epa.el | 224 |
1 files changed, 165 insertions, 59 deletions
diff --git a/lisp/epa.el b/lisp/epa.el index be439ef241d..07a954511d1 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -44,6 +44,25 @@ :type 'integer :group 'epa) +(defcustom epa-pinentry-mode nil + "The pinentry mode. + +GnuPG 2.1 or later has an option to control the behavior of +Pinentry invocation. Possible modes are: `ask', `cancel', +`error', and `loopback'. See the GnuPG manual for the meanings. + +In epa commands, a particularly useful mode is `loopback', which +redirects all Pinentry queries to the caller, so Emacs can query +passphrase through the minibuffer, instead of external Pinentry +program." + :type '(choice (const nil) + (const ask) + (const cancel) + (const error) + (const loopback)) + :group 'epa + :version "25.1") + (defgroup epa-faces nil "Faces for epa-mode." :version "23.1" @@ -166,6 +185,7 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-key nil) (defvar epa-list-keys-arguments nil) (defvar epa-info-buffer nil) +(defvar epa-error-buffer nil) (defvar epa-last-coding-system-specified nil) (defvar epa-key-list-mode-map @@ -578,6 +598,34 @@ If SECRET is non-nil, list secret keys instead of public keys." (shrink-window (- (window-height) epa-info-window-height))))) (message "%s" info))) +(defun epa-display-error (context) + (unless (equal (epg-context-error-output context) "") + (let ((buffer (get-buffer-create "*Error*"))) + (save-selected-window + (unless (and epa-error-buffer (buffer-live-p epa-error-buffer)) + (setq epa-error-buffer (generate-new-buffer "*Error*"))) + (if (get-buffer-window epa-error-buffer) + (delete-window (get-buffer-window epa-error-buffer))) + (with-current-buffer buffer + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (insert (format + (pcase (epg-context-operation context) + (`decrypt "Error while decrypting with \"%s\":") + (`verify "Error while verifying with \"%s\":") + (`sign "Error while signing with \"%s\":") + (`encrypt "Error while encrypting with \"%s\":") + (`import-keys "Error while importing keys with \"%s\":") + (`export-keys "Error while exporting keys with \"%s\":") + (_ "Error while executing \"%s\":\n\n")) + epg-gpg-program) + "\n\n" + (epg-context-error-output context))) + (epa-info-mode) + (goto-char (point-min))) + (display-buffer buffer))))) + (defun epa-display-verify-result (verify-result) (declare (obsolete epa-display-info "23.1")) (epa-display-info (epg-verify-result-to-string verify-result))) @@ -593,14 +641,14 @@ If SECRET is non-nil, list secret keys instead of public keys." (eq (epg-context-operation context) 'encrypt)) (read-passwd (if (eq key-id 'PIN) - "Passphrase for PIN: " + "Passphrase for PIN: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry (format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s: " key-id))))))) (defun epa-progress-callback-function (_context what _char current total - handback) + handback) (let ((prompt (or handback (format "Processing %s: " what)))) ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that @@ -641,7 +689,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (format "Decrypting %s..." (file-name-nondirectory decrypt-file)))) (message "Decrypting %s..." (file-name-nondirectory decrypt-file)) - (epg-decrypt-file context decrypt-file plain-file) + (condition-case error + (epg-decrypt-file context decrypt-file plain-file) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file) (file-name-nondirectory plain-file)) (if (epg-context-result-for context 'verify) @@ -662,7 +714,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (format "Verifying %s..." (file-name-nondirectory file)))) (message "Verifying %s..." (file-name-nondirectory file)) - (epg-verify-file context file plain) + (condition-case error + (epg-verify-file context file plain) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Verifying %s...done" (file-name-nondirectory file)) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string @@ -717,9 +773,9 @@ If no one is selected, default secret key is used. " ".p7s" ".p7m")))) (context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) - (epg-context-set-textmode context epa-textmode) - (epg-context-set-signers context signers) + (setf (epg-context-armor context) epa-armor) + (setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-signers context) signers) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context @@ -727,8 +783,13 @@ If no one is selected, default secret key is used. " #'epa-progress-callback-function (format "Signing %s..." (file-name-nondirectory file)))) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing %s..." (file-name-nondirectory file)) - (epg-sign-file context file signature mode) + (condition-case error + (epg-sign-file context file signature mode) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Signing %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory signature)))) @@ -744,8 +805,8 @@ If no one is selected, symmetric encryption will be performed. "))) (if epa-armor ".asc" ".gpg") ".p7m"))) (context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) - (epg-context-set-textmode context epa-textmode) + (setf (epg-context-armor context) epa-armor) + (setf (epg-context-textmode context) epa-textmode) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context @@ -753,8 +814,13 @@ If no one is selected, symmetric encryption will be performed. "))) #'epa-progress-callback-function (format "Encrypting %s..." (file-name-nondirectory file)))) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting %s..." (file-name-nondirectory file)) - (epg-encrypt-file context file recipients cipher) + (condition-case error + (epg-encrypt-file context file recipients cipher) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Encrypting %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory cipher)))) @@ -791,8 +857,13 @@ For example: (cons #'epa-progress-callback-function "Decrypting...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Decrypting...") - (setq plain (epg-decrypt-string context (buffer-substring start end))) + (condition-case error + (setq plain (epg-decrypt-string context (buffer-substring start end))) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Decrypting...done") (setq plain (epa--decode-coding-string plain @@ -810,8 +881,8 @@ For example: (insert plain)) (with-output-to-temp-buffer "*Temp*" (set-buffer standard-output) - (insert plain) - (epa-info-mode)))) + (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))))))) @@ -834,6 +905,7 @@ For example: Don't use this command in Lisp programs! See the reason described in the `epa-decrypt-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -873,20 +945,25 @@ For example: (decode-coding-string (epg-verify-string context (buffer-substring start end)) 'utf-8))" + (declare (interactive-only t)) (interactive "r") (let ((context (epg-make-context epa-protocol)) plain) - (epg-context-set-progress-callback context - (cons - #'epa-progress-callback-function - "Verifying...")) + (setf (epg-context-progress-callback context) + (cons + #'epa-progress-callback-function + "Verifying...")) (message "Verifying...") - (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))))) + (condition-case error + (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))))) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Verifying...done") (setq plain (epa--decode-coding-string plain @@ -914,6 +991,7 @@ between START and END. Don't use this command in Lisp programs! See the reason described in the `epa-verify-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -924,11 +1002,11 @@ See the reason described in the `epa-verify-region' documentation." nil t) (setq cleartext-start (match-beginning 0)) (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" - nil t) + nil t) (error "Invalid cleartext signed message")) (setq cleartext-end (re-search-forward - "^-----END PGP SIGNATURE-----$" - nil t)) + "^-----END PGP SIGNATURE-----$" + nil t)) (unless cleartext-end (error "No cleartext tail")) (epa-verify-region cleartext-start cleartext-end)))))) @@ -956,6 +1034,7 @@ For example: (epg-sign-string context (encode-coding-string (buffer-substring start end) 'utf-8)))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg)) (setq epa-last-coding-system-specified @@ -974,23 +1053,28 @@ If no one is selected, default secret key is used. " (save-excursion (let ((context (epg-make-context epa-protocol)) signature) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - ;;(epg-context-set-textmode context epa-textmode) - (epg-context-set-textmode context t) - (epg-context-set-signers context signers) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + ;;(setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-textmode context) t) + (setf (epg-context-signers context) signers) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context (cons #'epa-progress-callback-function "Signing...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing...") - (setq signature (epg-sign-string context - (epa--encode-coding-string - (buffer-substring start end) - epa-last-coding-system-specified) - mode)) + (condition-case error + (setq signature (epg-sign-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + mode)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Signing...done") (delete-region start end) (goto-char start) @@ -1037,6 +1121,7 @@ For example: context (encode-coding-string (buffer-substring start end) 'utf-8) nil))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg) (context (epg-make-context epa-protocol)) @@ -1056,25 +1141,30 @@ If no one is selected, symmetric encryption will be performed. ") (save-excursion (let ((context (epg-make-context epa-protocol)) cipher) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - ;;(epg-context-set-textmode context epa-textmode) - (epg-context-set-textmode context t) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + ;;(setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-textmode context) t) (if sign - (epg-context-set-signers context signers)) + (setf (epg-context-signers context) signers)) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context (cons #'epa-progress-callback-function "Encrypting...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting...") - (setq cipher (epg-encrypt-string context - (epa--encode-coding-string - (buffer-substring start end) - epa-last-coding-system-specified) - recipients - sign)) + (condition-case error + (setq cipher (epg-encrypt-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + recipients + sign)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Encrypting...done") (delete-region start end) (goto-char start) @@ -1100,7 +1190,11 @@ If no one is selected, symmetric encryption will be performed. ") (eq (nth 1 epa-list-keys-arguments) t)))) (let ((context (epg-make-context epa-protocol))) (message "Deleting...") - (epg-delete-keys context keys allow-secret) + (condition-case error + (epg-delete-keys context keys allow-secret) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Deleting...done") (apply #'epa--list-keys epa-list-keys-arguments))) @@ -1116,6 +1210,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file))) (error + (epa-display-error context) (message "Importing %s...failed" (file-name-nondirectory file)))) (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string @@ -1135,6 +1230,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-import-keys-from-string context (buffer-substring start end)) (message "Importing...done")) (error + (epa-display-error context) (message "Importing...failed"))) (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string @@ -1183,9 +1279,13 @@ between START and END." (file-name-directory default-name) default-name))))) (let ((context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) + (setf (epg-context-armor context) epa-armor) (message "Exporting to %s..." (file-name-nondirectory file)) - (epg-export-keys-to-file context keys file) + (condition-case error + (epg-export-keys-to-file context keys file) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Exporting to %s...done" (file-name-nondirectory file)))) ;;;###autoload @@ -1193,18 +1293,23 @@ between START and END." "Insert selected KEYS after the point." (interactive (list (epa-select-keys (epg-make-context epa-protocol) - "Select keys to export. + "Select keys to export. If no one is selected, default public key is exported. "))) (let ((context (epg-make-context epa-protocol))) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - (insert (epg-export-keys-to-string context keys)))) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + (condition-case error + (insert (epg-export-keys-to-string context keys)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))))) ;; (defun epa-sign-keys (keys &optional local) ;; "Sign selected KEYS. ;; If a prefix-arg is specified, the signature is marked as non exportable. ;; Don't use this command in Lisp programs!" +;; (declare (interactive-only t)) ;; (interactive ;; (let ((keys (epa--marked-keys))) ;; (unless keys @@ -1212,11 +1317,12 @@ If no one is selected, default public key is exported. "))) ;; (list keys current-prefix-arg))) ;; (let ((context (epg-make-context epa-protocol))) ;; (epg-context-set-passphrase-callback context -;; #'epa-passphrase-callback-function) +;; #'epa-passphrase-callback-function) ;; (epg-context-set-progress-callback context -;; (cons -;; #'epa-progress-callback-function -;; "Signing keys...")) +;; (cons +;; #'epa-progress-callback-function +;; "Signing keys...")) +;; (setf (epg-context-pinentry-mode context) epa-pinentry-mode) ;; (message "Signing keys...") ;; (epg-sign-keys context keys local) ;; (message "Signing keys...done"))) |