1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-08 07:20:28 -08:00

epg: Improve error handling

* epa.el (epa-error-buffer): New variable.
(epa-display-error): New function.
(epa-decrypt-file, epa-verify-file, epa-verify-region)
(epa-delete-keys, epa-import-keys): Display output sent to stderr.
(epa-sign-file, epa-sign-region, epa-encrypt-region)
(epa-export-keys, epa-insert-keys): Display output sent to stderr.
Use setf instead of epg-context-set-*.
* epa-file.el (epa-file-insert-file-contents): Use
epa-display-error instead of epa-display-info.  Mimic the behavior
of jka-compr when decryption program is not found.
(epa-file-write-region): Use epa-display-error instead of
epa-display-info.
This commit is contained in:
Daiki Ueno 2014-11-06 12:04:22 +09:00
parent e1418d0e25
commit 9e48a95cf2
3 changed files with 197 additions and 107 deletions

View file

@ -1,3 +1,18 @@
2014-11-06 Daiki Ueno <ueno@gnu.org>
* epa.el (epa-error-buffer): New variable.
(epa-display-error): New function.
(epa-decrypt-file, epa-verify-file, epa-verify-region)
(epa-delete-keys, epa-import-keys): Display output sent to stderr.
(epa-sign-file, epa-sign-region, epa-encrypt-region)
(epa-export-keys, epa-insert-keys): Display output sent to stderr.
Use setf instead of epg-context-set-*.
* epa-file.el (epa-file-insert-file-contents): Use
epa-display-error instead of epa-display-info. Mimic the behavior
of jka-compr when decryption program is not found.
(epa-file-write-region): Use epa-display-error instead of
epa-display-info.
2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca> 2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
* vc/vc.el (vc-region-history): New command. * vc/vc.el (vc-region-history): New command.

View file

@ -105,9 +105,9 @@ encryption is used."
(insert (if enable-multibyte-characters (insert (if enable-multibyte-characters
(string-to-multibyte string) (string-to-multibyte string)
string)) string))
(decode-coding-inserted-region (decode-coding-inserted-region
(point-min) (point-max) (point-min) (point-max)
(substring file 0 (string-match epa-file-name-regexp file)) (substring file 0 (string-match epa-file-name-regexp file))
visit beg end replace)) visit beg end replace))
(insert (epa-file--decode-coding-string string (or coding-system-for-read (insert (epa-file--decode-coding-string string (or coding-system-for-read
'undecided))))) 'undecided)))))
@ -151,8 +151,17 @@ encryption is used."
(condition-case error (condition-case error
(setq string (epg-decrypt-file context local-file nil)) (setq string (epg-decrypt-file context local-file nil))
(error (error
(epa-display-error context)
(if (setq entry (assoc file epa-file-passphrase-alist)) (if (setq entry (assoc file epa-file-passphrase-alist))
(setcdr entry nil)) (setcdr entry nil))
;; If the decryption program can't be found,
;; signal that as a non-file error
;; so that find-file-noselect-1 won't handle it.
;; Borrowed from jka-compr.el.
(if (and (eq (car error) 'file-error)
(equal (cadr error) "Searching for program"))
(error "Decryption program `%s' not found"
(nth 3 error)))
;; Hack to prevent find-file from opening empty buffer ;; Hack to prevent find-file from opening empty buffer
;; when decryption failed (bug#6568). See the place ;; when decryption failed (bug#6568). See the place
;; where `find-file-not-found-functions' are called in ;; where `find-file-not-found-functions' are called in
@ -162,11 +171,6 @@ encryption is used."
(add-hook 'find-file-not-found-functions (add-hook 'find-file-not-found-functions
'epa-file--find-file-not-found-function 'epa-file--find-file-not-found-function
nil t)) nil t))
(if (epg-context-error-output context)
(epa-display-info
(concat (format "Error while executing \"%s\":\n\n"
epg-gpg-program)
(epg-context-error-output context))))
(signal 'file-error (signal 'file-error
(cons "Opening input file" (cdr error))))) (cons "Opening input file" (cdr error)))))
(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
@ -226,7 +230,7 @@ encryption is used."
context context
(cons #'epa-progress-callback-function (cons #'epa-progress-callback-function
(format "Encrypting %s" file))) (format "Encrypting %s" file)))
(epg-context-set-armor context epa-armor) (setf (epg-context-armor context) epa-armor)
(condition-case error (condition-case error
(setq string (setq string
(epg-encrypt-string (epg-encrypt-string
@ -260,13 +264,9 @@ If no one is selected, symmetric encryption will be performed. "
(if epa-file-encrypt-to (if epa-file-encrypt-to
(epg-list-keys context recipients))))) (epg-list-keys context recipients)))))
(error (error
(epa-display-error context)
(if (setq entry (assoc file epa-file-passphrase-alist)) (if (setq entry (assoc file epa-file-passphrase-alist))
(setcdr entry nil)) (setcdr entry nil))
(if (epg-context-error-output context)
(epa-display-info
(concat (format "Error while executing \"%s\":\n\n"
epg-gpg-program)
(epg-context-error-output context))))
(signal 'file-error (cons "Opening output file" (cdr error))))) (signal 'file-error (cons "Opening output file" (cdr error)))))
(epa-file-run-real-handler (epa-file-run-real-handler
#'write-region #'write-region

View file

@ -166,6 +166,7 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-key nil) (defvar epa-key nil)
(defvar epa-list-keys-arguments nil) (defvar epa-list-keys-arguments nil)
(defvar epa-info-buffer nil) (defvar epa-info-buffer nil)
(defvar epa-error-buffer nil)
(defvar epa-last-coding-system-specified nil) (defvar epa-last-coding-system-specified nil)
(defvar epa-key-list-mode-map (defvar epa-key-list-mode-map
@ -578,6 +579,34 @@ If SECRET is non-nil, list secret keys instead of public keys."
(shrink-window (- (window-height) epa-info-window-height))))) (shrink-window (- (window-height) epa-info-window-height)))))
(message "%s" info))) (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) (defun epa-display-verify-result (verify-result)
(declare (obsolete epa-display-info "23.1")) (declare (obsolete epa-display-info "23.1"))
(epa-display-info (epg-verify-result-to-string verify-result))) (epa-display-info (epg-verify-result-to-string verify-result)))
@ -593,14 +622,14 @@ If SECRET is non-nil, list secret keys instead of public keys."
(eq (epg-context-operation context) 'encrypt)) (eq (epg-context-operation context) 'encrypt))
(read-passwd (read-passwd
(if (eq key-id 'PIN) (if (eq key-id 'PIN)
"Passphrase for PIN: " "Passphrase for PIN: "
(let ((entry (assoc key-id epg-user-id-alist))) (let ((entry (assoc key-id epg-user-id-alist)))
(if entry (if entry
(format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s %s: " key-id (cdr entry))
(format "Passphrase for %s: " key-id))))))) (format "Passphrase for %s: " key-id)))))))
(defun epa-progress-callback-function (_context what _char current total (defun epa-progress-callback-function (_context what _char current total
handback) handback)
(let ((prompt (or handback (let ((prompt (or handback
(format "Processing %s: " what)))) (format "Processing %s: " what))))
;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
@ -641,7 +670,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use."
(format "Decrypting %s..." (format "Decrypting %s..."
(file-name-nondirectory decrypt-file)))) (file-name-nondirectory decrypt-file))))
(message "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) (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file)
(file-name-nondirectory plain-file)) (file-name-nondirectory plain-file))
(if (epg-context-result-for context 'verify) (if (epg-context-result-for context 'verify)
@ -662,7 +695,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use."
(format "Verifying %s..." (format "Verifying %s..."
(file-name-nondirectory file)))) (file-name-nondirectory file))))
(message "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)) (message "Verifying %s...done" (file-name-nondirectory file))
(if (epg-context-result-for context 'verify) (if (epg-context-result-for context 'verify)
(epa-display-info (epg-verify-result-to-string (epa-display-info (epg-verify-result-to-string
@ -717,18 +754,22 @@ If no one is selected, default secret key is used. "
".p7s" ".p7s"
".p7m")))) ".p7m"))))
(context (epg-make-context epa-protocol))) (context (epg-make-context epa-protocol)))
(epg-context-set-armor context epa-armor) (setf (epg-context-armor context) epa-armor)
(epg-context-set-textmode context epa-textmode) (setf (epg-context-textmode context) epa-textmode)
(epg-context-set-signers context signers) (setf (epg-context-signers context) signers)
(epg-context-set-passphrase-callback context (setf (epg-context-passphrase-callback context)
#'epa-passphrase-callback-function) #'epa-passphrase-callback-function)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
(format "Signing %s..." (format "Signing %s..."
(file-name-nondirectory file)))) (file-name-nondirectory file))))
(message "Signing %s..." (file-name-nondirectory file)) (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) (message "Signing %s...wrote %s" (file-name-nondirectory file)
(file-name-nondirectory signature)))) (file-name-nondirectory signature))))
@ -744,17 +785,21 @@ If no one is selected, symmetric encryption will be performed. ")))
(if epa-armor ".asc" ".gpg") (if epa-armor ".asc" ".gpg")
".p7m"))) ".p7m")))
(context (epg-make-context epa-protocol))) (context (epg-make-context epa-protocol)))
(epg-context-set-armor context epa-armor) (setf (epg-context-armor context) epa-armor)
(epg-context-set-textmode context epa-textmode) (setf (epg-context-textmode context) epa-textmode)
(epg-context-set-passphrase-callback context (setf (epg-context-passphrase-callback context)
#'epa-passphrase-callback-function) #'epa-passphrase-callback-function)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
(format "Encrypting %s..." (format "Encrypting %s..."
(file-name-nondirectory file)))) (file-name-nondirectory file))))
(message "Encrypting %s..." (file-name-nondirectory file)) (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) (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
(file-name-nondirectory cipher)))) (file-name-nondirectory cipher))))
@ -785,14 +830,18 @@ For example:
(save-excursion (save-excursion
(let ((context (epg-make-context epa-protocol)) (let ((context (epg-make-context epa-protocol))
plain) plain)
(epg-context-set-passphrase-callback context (setf (epg-context-passphrase-callback context)
#'epa-passphrase-callback-function) #'epa-passphrase-callback-function)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
"Decrypting...")) "Decrypting..."))
(message "Decrypting...") (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") (message "Decrypting...done")
(setq plain (epa--decode-coding-string (setq plain (epa--decode-coding-string
plain plain
@ -810,8 +859,8 @@ For example:
(insert plain)) (insert plain))
(with-output-to-temp-buffer "*Temp*" (with-output-to-temp-buffer "*Temp*"
(set-buffer standard-output) (set-buffer standard-output)
(insert plain) (insert plain)
(epa-info-mode)))) (epa-info-mode))))
(if (epg-context-result-for context 'verify) (if (epg-context-result-for context 'verify)
(epa-display-info (epg-verify-result-to-string (epa-display-info (epg-verify-result-to-string
(epg-context-result-for context 'verify))))))) (epg-context-result-for context 'verify)))))))
@ -878,17 +927,21 @@ For example:
(interactive "r") (interactive "r")
(let ((context (epg-make-context epa-protocol)) (let ((context (epg-make-context epa-protocol))
plain) plain)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
"Verifying...")) "Verifying..."))
(message "Verifying...") (message "Verifying...")
(setq plain (epg-verify-string (condition-case error
context (setq plain (epg-verify-string
(epa--encode-coding-string context
(buffer-substring start end) (epa--encode-coding-string
(or coding-system-for-write (buffer-substring start end)
(get-text-property start 'epa-coding-system-used))))) (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") (message "Verifying...done")
(setq plain (epa--decode-coding-string (setq plain (epa--decode-coding-string
plain plain
@ -927,11 +980,11 @@ See the reason described in the `epa-verify-region' documentation."
nil t) nil t)
(setq cleartext-start (match-beginning 0)) (setq cleartext-start (match-beginning 0))
(unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
nil t) nil t)
(error "Invalid cleartext signed message")) (error "Invalid cleartext signed message"))
(setq cleartext-end (re-search-forward (setq cleartext-end (re-search-forward
"^-----END PGP SIGNATURE-----$" "^-----END PGP SIGNATURE-----$"
nil t)) nil t))
(unless cleartext-end (unless cleartext-end
(error "No cleartext tail")) (error "No cleartext tail"))
(epa-verify-region cleartext-start cleartext-end)))))) (epa-verify-region cleartext-start cleartext-end))))))
@ -978,23 +1031,27 @@ If no one is selected, default secret key is used. "
(save-excursion (save-excursion
(let ((context (epg-make-context epa-protocol)) (let ((context (epg-make-context epa-protocol))
signature) signature)
;;(epg-context-set-armor context epa-armor) ;;(setf (epg-context-armor context) epa-armor)
(epg-context-set-armor context t) (setf (epg-context-armor context) t)
;;(epg-context-set-textmode context epa-textmode) ;;(setf (epg-context-textmode context) epa-textmode)
(epg-context-set-textmode context t) (setf (epg-context-textmode context) t)
(epg-context-set-signers context signers) (setf (epg-context-signers context) signers)
(epg-context-set-passphrase-callback context (setf (epg-context-passphrase-callback context)
#'epa-passphrase-callback-function) #'epa-passphrase-callback-function)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
"Signing...")) "Signing..."))
(message "Signing...") (message "Signing...")
(setq signature (epg-sign-string context (condition-case error
(epa--encode-coding-string (setq signature (epg-sign-string context
(buffer-substring start end) (epa--encode-coding-string
epa-last-coding-system-specified) (buffer-substring start end)
mode)) epa-last-coding-system-specified)
mode))
(error
(epa-display-error context)
(signal (car error) (cdr error))))
(message "Signing...done") (message "Signing...done")
(delete-region start end) (delete-region start end)
(goto-char start) (goto-char start)
@ -1061,25 +1118,29 @@ If no one is selected, symmetric encryption will be performed. ")
(save-excursion (save-excursion
(let ((context (epg-make-context epa-protocol)) (let ((context (epg-make-context epa-protocol))
cipher) cipher)
;;(epg-context-set-armor context epa-armor) ;;(setf (epg-context-armor context) epa-armor)
(epg-context-set-armor context t) (setf (epg-context-armor context) t)
;;(epg-context-set-textmode context epa-textmode) ;;(setf (epg-context-textmode context) epa-textmode)
(epg-context-set-textmode context t) (setf (epg-context-textmode context) t)
(if sign (if sign
(epg-context-set-signers context signers)) (setf (epg-context-signers context) signers))
(epg-context-set-passphrase-callback context (setf (epg-context-passphrase-callback context)
#'epa-passphrase-callback-function) #'epa-passphrase-callback-function)
(epg-context-set-progress-callback context (setf (epg-context-progress-callback context)
(cons (cons
#'epa-progress-callback-function #'epa-progress-callback-function
"Encrypting...")) "Encrypting..."))
(message "Encrypting...") (message "Encrypting...")
(setq cipher (epg-encrypt-string context (condition-case error
(epa--encode-coding-string (setq cipher (epg-encrypt-string context
(buffer-substring start end) (epa--encode-coding-string
epa-last-coding-system-specified) (buffer-substring start end)
recipients epa-last-coding-system-specified)
sign)) recipients
sign))
(error
(epa-display-error context)
(signal (car error) (cdr error))))
(message "Encrypting...done") (message "Encrypting...done")
(delete-region start end) (delete-region start end)
(goto-char start) (goto-char start)
@ -1105,7 +1166,11 @@ If no one is selected, symmetric encryption will be performed. ")
(eq (nth 1 epa-list-keys-arguments) t)))) (eq (nth 1 epa-list-keys-arguments) t))))
(let ((context (epg-make-context epa-protocol))) (let ((context (epg-make-context epa-protocol)))
(message "Deleting...") (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") (message "Deleting...done")
(apply #'epa--list-keys epa-list-keys-arguments))) (apply #'epa--list-keys epa-list-keys-arguments)))
@ -1121,6 +1186,7 @@ If no one is selected, symmetric encryption will be performed. ")
(epg-import-keys-from-file context file) (epg-import-keys-from-file context file)
(message "Importing %s...done" (file-name-nondirectory file))) (message "Importing %s...done" (file-name-nondirectory file)))
(error (error
(epa-display-error context)
(message "Importing %s...failed" (file-name-nondirectory file)))) (message "Importing %s...failed" (file-name-nondirectory file))))
(if (epg-context-result-for context 'import) (if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string (epa-display-info (epg-import-result-to-string
@ -1140,6 +1206,7 @@ If no one is selected, symmetric encryption will be performed. ")
(epg-import-keys-from-string context (buffer-substring start end)) (epg-import-keys-from-string context (buffer-substring start end))
(message "Importing...done")) (message "Importing...done"))
(error (error
(epa-display-error context)
(message "Importing...failed"))) (message "Importing...failed")))
(if (epg-context-result-for context 'import) (if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string (epa-display-info (epg-import-result-to-string
@ -1188,9 +1255,13 @@ between START and END."
(file-name-directory default-name) (file-name-directory default-name)
default-name))))) default-name)))))
(let ((context (epg-make-context epa-protocol))) (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)) (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)))) (message "Exporting to %s...done" (file-name-nondirectory file))))
;;;###autoload ;;;###autoload
@ -1198,12 +1269,16 @@ between START and END."
"Insert selected KEYS after the point." "Insert selected KEYS after the point."
(interactive (interactive
(list (epa-select-keys (epg-make-context epa-protocol) (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. "))) If no one is selected, default public key is exported. ")))
(let ((context (epg-make-context epa-protocol))) (let ((context (epg-make-context epa-protocol)))
;;(epg-context-set-armor context epa-armor) ;;(setf (epg-context-armor context) epa-armor)
(epg-context-set-armor context t) (setf (epg-context-armor context) t)
(insert (epg-export-keys-to-string context keys)))) (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) ;; (defun epa-sign-keys (keys &optional local)
;; "Sign selected KEYS. ;; "Sign selected KEYS.
@ -1217,12 +1292,12 @@ If no one is selected, default public key is exported. ")))
;; (error "No keys selected")) ;; (error "No keys selected"))
;; (list keys current-prefix-arg))) ;; (list keys current-prefix-arg)))
;; (let ((context (epg-make-context epa-protocol))) ;; (let ((context (epg-make-context epa-protocol)))
;; (epg-context-set-passphrase-callback context ;; (setf (epg-context-passphrase-callback context)
;; #'epa-passphrase-callback-function) ;; #'epa-passphrase-callback-function)
;; (epg-context-set-progress-callback context ;; (setf (epg-context-progress-callback context)
;; (cons ;; (cons
;; #'epa-progress-callback-function ;; #'epa-progress-callback-function
;; "Signing keys...")) ;; "Signing keys..."))
;; (message "Signing keys...") ;; (message "Signing keys...")
;; (epg-sign-keys context keys local) ;; (epg-sign-keys context keys local)
;; (message "Signing keys...done"))) ;; (message "Signing keys...done")))