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.

lisp/ChangeLog

@@ -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>
 
 	* vc/vc.el (vc-region-history): New command.

lisp/epa-file.el

@@ -151,8 +151,17 @@ encryption is used."
 	  (condition-case error
 	      (setq string (epg-decrypt-file context local-file nil))
 	    (error
+	     (epa-display-error context)
 	     (if (setq entry (assoc file epa-file-passphrase-alist))
 		 (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
 	     ;; when decryption failed (bug#6568).  See the place
 	     ;; where `find-file-not-found-functions' are called in
@@ -162,11 +171,6 @@ encryption is used."
 	       (add-hook 'find-file-not-found-functions
 			 'epa-file--find-file-not-found-function
 			 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
 		     (cons "Opening input file" (cdr error)))))
           (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
@@ -226,7 +230,7 @@ encryption is used."
      context
      (cons #'epa-progress-callback-function
 	   (format "Encrypting %s" file)))
-    (epg-context-set-armor context epa-armor)
+    (setf (epg-context-armor context) epa-armor)
     (condition-case error
 	(setq string
 	      (epg-encrypt-string
@@ -260,13 +264,9 @@ If no one is selected, symmetric encryption will be performed.  "
 		 (if epa-file-encrypt-to
 		     (epg-list-keys context recipients)))))
       (error
+       (epa-display-error context)
        (if (setq entry (assoc file epa-file-passphrase-alist))
 	   (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)))))
     (epa-file-run-real-handler
      #'write-region

lisp/epa.el

@@ -166,6 +166,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 +579,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)))
@@ -641,7 +670,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))
+    (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 +695,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))
+    (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,18 +754,22 @@ 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)
+    (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)
-    (epg-context-set-progress-callback context
+    (setf (epg-context-progress-callback context)
 	  (cons
 	   #'epa-progress-callback-function
 	   (format "Signing %s..."
 		   (file-name-nondirectory file))))
     (message "Signing %s..." (file-name-nondirectory file))
+    (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,17 +785,21 @@ 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)
+    (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)
-    (epg-context-set-progress-callback context
+    (setf (epg-context-progress-callback context)
 	  (cons
 	   #'epa-progress-callback-function
 	   (format "Encrypting %s..."
 		   (file-name-nondirectory file))))
     (message "Encrypting %s..." (file-name-nondirectory file))
+    (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))))
 
@@ -785,14 +830,18 @@ For example:
   (save-excursion
     (let ((context (epg-make-context epa-protocol))
 	  plain)
-      (epg-context-set-passphrase-callback context
+      (setf (epg-context-passphrase-callback context)
 	    #'epa-passphrase-callback-function)
-      (epg-context-set-progress-callback context
+      (setf (epg-context-progress-callback context)
 	    (cons
 	     #'epa-progress-callback-function
 	     "Decrypting..."))
       (message "Decrypting...")
+      (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
@@ -878,17 +927,21 @@ For example:
   (interactive "r")
   (let ((context (epg-make-context epa-protocol))
 	plain)
-    (epg-context-set-progress-callback context
+    (setf (epg-context-progress-callback context)
 	  (cons
 	   #'epa-progress-callback-function
 	   "Verifying..."))
     (message "Verifying...")
+    (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
@@ -978,23 +1031,27 @@ 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)
+      ;;(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)
-      (epg-context-set-progress-callback context
+      (setf (epg-context-progress-callback context)
 	    (cons
 	     #'epa-progress-callback-function
 	     "Signing..."))
       (message "Signing...")
+      (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)
@@ -1061,25 +1118,29 @@ 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)
+      ;;(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
-	  (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)
-      (epg-context-set-progress-callback context
+      (setf (epg-context-progress-callback context)
 	    (cons
 	     #'epa-progress-callback-function
 	     "Encrypting..."))
       (message "Encrypting...")
+      (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)
@@ -1105,7 +1166,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...")
+    (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)))
 
@@ -1121,6 +1186,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
@@ -1140,6 +1206,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
@@ -1188,9 +1255,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))
+    (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
@@ -1201,9 +1272,13 @@ between START and END."
 			  "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)
+    ;;(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)
 ;;   "Sign selected KEYS.
@@ -1217,9 +1292,9 @@ If no one is selected, default public key is exported.  ")))
 ;;        (error "No keys selected"))
 ;;      (list keys current-prefix-arg)))
 ;;   (let ((context (epg-make-context epa-protocol)))
-;;     (epg-context-set-passphrase-callback context
+;;     (setf (epg-context-passphrase-callback context)
 ;; 	     #'epa-passphrase-callback-function)
-;;     (epg-context-set-progress-callback context
+;;     (setf (epg-context-progress-callback context)
 ;; 	     (cons
 ;; 	       #'epa-progress-callback-function
 ;; 	       "Signing keys..."))