[PATCH consfigurator v3 3/8] run tests with temporary gpg home

[David Bremner]

The big picture change here is the introduction of a custom test runner which
allows setting up and tearing down various data sources (or other resources)
for the test suite.

In order to parse the output of gpg, provide a new exported function
consfigurator:strip-prefix.

Signed-off-by: David Bremner <david at tethera.net>
---
 consfigurator.asd  |  3 +-
 src/package.lisp   |  1 +
 src/util.lisp      |  5 ++++
 tests/package.lisp |  3 +-
 tests/runner.lisp  | 72 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 82 insertions(+), 2 deletions(-)
 create mode 100644 tests/runner.lisp

diff --git a/consfigurator.asd b/consfigurator.asd
index d01e089..721d2b1 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -109,7 +109,8 @@
                (:feature :sbcl (:require #:sb-rt))
                (:feature (:not :sbcl) #:rt))
   :components ((:file "tests/package")
+               (:file "tests/runner")
                (:file "tests/data/util")
                (:file "tests/util")
                (:file "tests/property/file"))
-  :perform (test-op (o c) (symbol-call :consfigurator/tests '#:do-tests)))
+  :perform (test-op (o c) (symbol-call :consfigurator/tests '#:runner)))
diff --git a/src/package.lisp b/src/package.lisp
index 90b96dd..cc6f42b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -105,6 +105,7 @@
            #:unlines
            #:words
            #:unwords
+           #:strip-prefix
            #:memstr=
            #:define-simple-error
            #:plist->long-options
diff --git a/src/util.lisp b/src/util.lisp
index aefe01c..1f74ca0 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -72,6 +72,11 @@
 (defun unwords (words)
   (format nil "~{~A~^ ~}" words))
 
+(defun strip-prefix (prefix string)
+  "If STRING is prefixed by PREFIX, return the rest of STRING,
+otherwise return NIL."
+  (nth-value 1 (starts-with-subseq prefix string :return-suffix t)))
+
 (defun memstr= (string list)
   (member string list :test #'string=))
 
diff --git a/tests/package.lisp b/tests/package.lisp
index 0a303f0..fcb912c 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -1,5 +1,6 @@
 (in-package :cl-user)
 
 (defpackage :consfigurator/tests
-  (:use #:cl #:consfigurator #:consfigurator.data.util #+sbcl :sb-rt #-sbcl :rtest)
+  (:use #:cl #:consfigurator #:consfigurator.data.util #:alexandria #:anaphora
+   #+sbcl :sb-rt #-sbcl :rtest)
   (:local-nicknames (#:file       #:consfigurator.property.file)))
diff --git a/tests/runner.lisp b/tests/runner.lisp
new file mode 100644
index 0000000..0a9867b
--- /dev/null
+++ b/tests/runner.lisp
@@ -0,0 +1,72 @@
+;;; Consfigurator -- Lisp declarative configuration management system
+
+;;; Copyright (C) 2022  David Bremner <david at tethera.net>
+
+;;; 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
+;;; the Free Software Foundation; either version 3, or (at your option)
+;;; any later version.
+
+;;; This file is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+
+(defparameter *test-gnupg-fingerprint* nil
+  "Fingerprint of trusted gpg key usable for encryption and signing.")
+
+(defun first-gpg-fingerprint ()
+  "Return the fingerprint of the first (primary) key listed by gpg.  This is
+mainly useful when there is a single primary key."
+  (some
+   (lambda (line) (aand (strip-prefix "fpr:::::::::" line)
+                        (string-trim ":" it)))
+   (lines (gpg '("--with-colons" "--list-keys")))))
+
+(defun with-test-gnupg-home-func (base-dir thunk)
+  "Implementation for macro WITH-TEST-GNUPG-HOME."
+  (let ((*data-source-gnupghome*
+          (ensure-directory-pathname #?"${base-dir}/gnupg")))
+    (unless (nth-value 1
+             (ensure-directories-exist *data-source-gnupghome* :mode #o700))
+      (error "~s already exists" *data-source-gnupghome*))
+    ;; Create a passwordless key using gnupg's defaults.
+    (gpg '("--batch" "--pinentry-mode" "loopback" "--passphrase" "" "--yes"
+           "--quick-generate-key" "consfig at example.org (insecure!)"))
+    (let ((*test-gnupg-fingerprint* (first-gpg-fingerprint)))
+      (with-open-file (stream #?"${*data-source-gnupghome*}/gpg.conf"
+                              :direction :output)
+        (format stream "default-key ~a~%default-recipient-self~%"
+                *test-gnupg-fingerprint*))
+      (funcall thunk))
+    (run-program "gpgconf" "--homedir" *data-source-gnupghome*
+                 "--kill" "all")))
+
+(defmacro with-test-gnupg-home (base-dir &rest body)
+  "Set up gnupg homedir for test suite under BASE-DIR and run BODY with
+*DATA-SOURCE-GNUPGHOME* set appropriately."
+  `(with-test-gnupg-home-func ,base-dir (lambda () (progn , at body))))
+
+;; tests for test runner machinery
+(deftest runner.0 (not *data-source-gnupghome*) nil)
+
+(deftest runner.1
+    (count-if
+     (lambda (line) (string-prefix-p "pub" line))
+     (lines (gpg '("--with-colons" "--list-keys"))))
+  1)
+
+(deftest runner.2 (not *test-gnupg-fingerprint*) nil)
+
+(defun runner ()
+  "Run tests via (sb-)rt, with setup and teardown"
+  (with-local-temporary-directory (test-home)
+    (with-test-gnupg-home test-home
+      (do-tests))))
+
-- 
2.35.1