[PATCH consfigurator v4 2/7] refactor use of gnupg in consfigurator.data.pgp

[David Bremner]

Add a new low level function GPG, and a function GPG-FILE-AS-STRING intended
for use in the pgp data source and the future pass(1) data source.  Both of
these functions support a new parameter *DATA-SOURCE-GNUPGHOME*, which allows
the user (or test suite) to control where key material is stored for accessing
data sources.

Signed-off-by: David Bremner <david at tethera.net>
---
 src/data.lisp      |  6 ++++++
 src/data/pgp.lisp  | 19 +++++++------------
 src/data/util.lisp | 24 ++++++++++++++++++++++++
 src/package.lisp   |  4 +++-
 4 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/src/data.lisp b/src/data.lisp
index 7bdc0f3..9a219c3 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -510,3 +510,9 @@ chance of those passwords showing up in the clear in the Lisp debugger."
       (print-unreadable-object (passphrase stream)
         (format stream "PASSPHRASE")))
   passphrase)
+
+(defvar *data-source-gnupghome* nil
+  "Home directory for gnupg when used in a data source.
+
+Because gnupg uses Unix domain sockets internally, this path should be short
+enough to avoid the 108 char limit on socket paths.")
diff --git a/src/data/pgp.lisp b/src/data/pgp.lisp
index ef258d3..d0df280 100644
--- a/src/data/pgp.lisp
+++ b/src/data/pgp.lisp
@@ -51,20 +51,15 @@
       (cons #'check #'extract))))
 
 (defun read-store (location)
-  (handler-case
-      (safe-read-from-string
-       (run-program
-        (sh-escape (list "gpg" "--decrypt" location)) :output :string))
-    (subprocess-error (error)
-      (missing-data-source "While attempt to decrypt, gpg exited with ~A"
-			   (uiop:subprocess-error-code error)))))
+  (safe-read-from-string
+   (gpg-file-as-string location)))
 
 (defun put-store (location data)
-  (run-program (list "gpg" "--encrypt")
-               :input (make-string-input-stream
-                       (with-standard-io-syntax
-                         (prin1-to-string data)))
-               :output (unix-namestring location)))
+  (gpg '("--encrypt")
+       :input (make-string-input-stream
+               (with-standard-io-syntax
+                 (prin1-to-string data)))
+       :output (unix-namestring location)))
 
 (defun data-assoc (iden1 iden2 data)
   (assoc (cons iden1 iden2) data
diff --git a/src/data/util.lisp b/src/data/util.lisp
index 76bb20a..a04df02 100644
--- a/src/data/util.lisp
+++ b/src/data/util.lisp
@@ -1,6 +1,7 @@
 ;;; Consfigurator -- Lisp declarative configuration management system
 
 ;;; Copyright (C) 2022 David Bremner <david at tethera.net>
+;;; Copyright (C) 2021  Sean Whitton <spwhitton at spwhitton.name>
 
 ;;; This file is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -38,3 +39,26 @@ may contain `/' characters to map into multiple levels of directory."
       (uiop:relativize-pathname-directory
        (ensure-directory-pathname iden1))
       base-dir))))
+
+(defun gpg (args &key input output)
+  "Run gnupg, taking homedir from *DATA-SOURCE-GNUPGHOME* if set.
+
+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)))
+
+(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)))))
diff --git a/src/package.lisp b/src/package.lisp
index df59785..0ea8241 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -323,6 +323,7 @@
            #:wrap-passphrase
            #:unwrap-passphrase
            #:get-data-protected-string
+           #:*data-source-gnupghome*
 
            ;; image.lisp
            #:eval-in-grandchild
@@ -1003,11 +1004,12 @@
                              (#:lxc  #:consfigurator.property.lxc)))
 
   (package :consfigurator.data.util
-           (:export #:literal-data-pathname))
+           (:export #:literal-data-pathname #:gpg-file-as-string #:gpg))
 
   (package :consfigurator.data.asdf)
 
   (package :consfigurator.data.pgp
+           (:use  #:consfigurator.data.util)
            (:export #:list-data #:get-data #:set-data #:set-data-from-file))
 
   (package :consfigurator.data.git-snapshot)
-- 
2.35.2