[PATCH consfigurator v2 1/2] GPG: batch mode and return *ERROR-OUTPUT* in conditions

[Russell Sim]

When the GPG command fails, the *ERROR-OUTPUT* will be included in the
conditions raised from the event.  This helps with debugging since the user
can inspect the GPG output and reason about why GPG failed.

Without this change if there is an error from the subprocess, nothing helpful
is output to understand what is wrong with the underlying GPG
configuration. If for example I have no `default-recipient` SET-DATA will
fail, in this case we will see.

----
CONSFIG> (data.pgp:set-data *pgp-file* 'test 'test131 "foo")
; Evaluation aborted on #<SUBPROCESS-ERROR {1006B3C7E3}>.

Subprocess #<UIOP/LAUNCH-PROGRAM::PROCESS-INFO {1006B3B483}>
 with command ("gpg" "--encrypt")
 exited with error code 2
   [Condition of type SUBPROCESS-ERROR]
----

By running in batch mode and sending stderr to *ERROR-OUTPUT*, users should be
more able to reason about failures.

----
CONSFIG> (data.pgp:set-data *pgp-file* 'test 'test131 "foo")
----

Failed decryption will look like
----
While attempt to decrypt /home/russell/projects/consfig/secrets.gpg, gpg exited with 2
 with gpg error output:
 "gpg: decrypt_message failed: Unknown system error
"
   [Condition of type MISSING-DATA-SOURCE]
----

Failed encryption will look like
----
Subprocess #<UIOP/LAUNCH-PROGRAM::PROCESS-INFO {1002342DF3}>
 with command ("gpg" "-q" "--batch" "--encrypt")
 exited with error code 2

 with error output:
 "gpg: no valid addressees
gpg: [stdin]: encryption failed: No user ID
"
   [Condition of type DATA.UTIL:GPG-ERROR]
----

Signed-off-by: Russell Sim <rsl at simopolis.xyz>
---
 src/data/util.lisp  | 38 ++++++++++++++++++++++++++++----------
 src/package.lisp    |  6 +++++-
 tests/data/pgp.lisp |  9 +++++++++
 3 files changed, 42 insertions(+), 11 deletions(-)

diff --git a/src/data/util.lisp b/src/data/util.lisp
index aa0451f..b6c8685 100644
--- a/src/data/util.lisp
+++ b/src/data/util.lisp
@@ -19,6 +19,15 @@
 (in-package :consfigurator.data.util)
 (named-readtables:in-readtable :consfigurator)
 
+(define-condition gpg-error (subprocess-error)
+  ((output :initform nil :initarg :output :reader gpg-error-output))
+  (:report (lambda (condition stream)
+             (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D~%~]~@[~% with error output:~% ~S~]"
+                     (subprocess-error-process condition)
+                     (subprocess-error-command condition)
+                     (subprocess-error-code condition)
+                     (gpg-error-output condition)))))
+
 (defun literal-data-pathname (base-path iden1 iden2 &key type)
   "Generate a path from BASE-PATH, IDEN1 and IDEN2 by concatentation,
 optionally adding extension TYPE.
@@ -46,19 +55,28 @@ may contain '/' characters to map into multiple levels of directory."
 INPUT and OUTPUT have the same meaning as for RUN-PROGRAM, except that OUTPUT
 defaults to :STRING.  The default return value is thus the output from gnupg,
 as a string."
-  (run-program
-   `("gpg"
-     ,@(and *data-source-gnupghome*
-            (list "--homedir" (namestring *data-source-gnupghome*)))
-     , at args)
-   :input  input
-   :output (or output :string)))
+  (let ((error-output (make-string-output-stream)))
+    (handler-case
+        (run-program
+         `("gpg" "-q" "--batch"
+                 ,@(and *data-source-gnupghome*
+                        (list "--homedir" (namestring *data-source-gnupghome*)))
+                 , at args)
+         :input  input
+         :error-output error-output
+         :output (or output :string))
+      (subprocess-error (error)
+        (error 'gpg-error
+               :code (subprocess-error-code error)
+               :command (subprocess-error-command error)
+               :process (subprocess-error-process error)
+               :output (get-output-stream-string error-output))))))
 
 (defun gpg-file-as-string (location)
   "Decrypt the contents of a gpg encrypted file at LOCATION, return as a
 string."
   (handler-case
       (gpg (list "--decrypt" (unix-namestring location)))
-    (subprocess-error (error)
-      (missing-data-source "While attempt to decrypt ~A, gpg exited with ~A"
-			   location (uiop:subprocess-error-code error)))))
+    (gpg-error (error)
+      (missing-data-source "While attempt to decrypt ~A, gpg exited with ~A~@[~% with gpg error output:~% ~S~]"
+			   location (subprocess-error-code error) (gpg-error-output error)))))
diff --git a/src/package.lisp b/src/package.lisp
index 4b51b70..55b2d1a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1022,7 +1022,11 @@
                              (#:lxc  #:consfigurator.property.lxc)))
 
   (package :consfigurator.data.util
-           (:export #:literal-data-pathname #:gpg-file-as-string #:gpg))
+           (:import-from #:uiop
+                         #:subprocess-error-process
+                         #:subprocess-error-command
+                         #:subprocess-error-code)
+           (:export #:literal-data-pathname #:gpg-file-as-string #:gpg #:gpg-error))
 
   (package :consfigurator.data.asdf)
 
diff --git a/tests/data/pgp.lisp b/tests/data/pgp.lisp
index 21ba60c..0eb7749 100644
--- a/tests/data/pgp.lisp
+++ b/tests/data/pgp.lisp
@@ -19,3 +19,12 @@
 (deftest data.pgp.3
     (get-data-string "host.example.com" "/etc/foo.conf")
   "secret file content")
+
+(deftest data.pgp.4
+    (handler-case (data.pgp:get-data "/dev/null" "_secrets" "test")
+      (missing-data-source (error)
+        (princ-to-string error)))
+  "While attempt to decrypt /dev/null, gpg exited with 2
+ with gpg error output:
+ \"gpg: decrypt_message failed: Unknown system error
+\"")
-- 
2.37.2