[consfigurator] v3 pass data source and test suite changes
David Bremner
david at tethera.net
Sun Mar 13 14:40:03 GMT 2022
Compared to the last version, this takes a cleaner (but arguably more
intrusive) approach to testing, replacing the use of environment variables
with let bound special variables. There is a new function gpg that should be
used by data sources to respect the parameter
*DATA-SOURCE-GNUPGHOME*. data/gpgpubkeys.lisp should probably be converted to
use this function, but this series has had enough scope creep for now.
As part of the refactoring, I added a few tests for the pgp data source.
A reconstructed interdiff follows; this tries to avoid your recent renaming
changes. The series itself was rebased against
2b89cfb8645afb249f6cc21fe3ae588dae5210be.
diff --git a/consfigurator.asd b/consfigurator.asd
index 689b33a..8395202 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -110,9 +110,9 @@
(:feature :sbcl (:require #:sb-rt))
(:feature (:not :sbcl) #:rt))
:components ((:file "tests/package")
- (:file "tests/gnupg")
(:file "tests/runner")
(:file "tests/data/pass")
+ (:file "tests/data/pgp")
(:file "tests/data/util")
(:file "tests/util")
(:file "tests/property/file"))
diff --git a/src/data.lisp b/src/data.lisp
index 1b74338..dd84230 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -146,6 +146,14 @@ This function is typically called at the REPL."
*data-sources* nil
*data-source-registrations* nil))
+(defmacro with-reset-data-sources (&rest body)
+ "Run BODY with initially empty data sources and string data. This macro is
+typically used for testing or debugging."
+ `(let ((*string-data* (make-hash-table))
+ *data-sources*
+ *data-source-registrations*)
+ , at body))
+
(defun get-data-string (iden1 iden2)
"Return the content of an item of prerequisite data as a string.
@@ -507,3 +515,8 @@ chance of those passwords showing up in the clear in the Lisp debugger."
(print-unreadable-object (passphrase stream)
(format stream "PASSPHRASE")))
passphrase)
+
+(defparameter *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/pass.lisp b/src/data/pass.lisp
index e216c76..e9e7ae6 100644
--- a/src/data/pass.lisp
+++ b/src/data/pass.lisp
@@ -18,14 +18,6 @@
(in-package :consfigurator.data.pass)
(named-readtables:in-readtable :consfigurator)
-(defun %read-gpg (location)
- (stripln (gpg-file-as-string location)))
-
-(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)))
-
(defmethod register-data-source ((type (eql :pass))
&key (location "~/.password-store"))
"Provide the contents of a pass(1) store on the machine running the root
@@ -33,14 +25,18 @@ Lisp. Register this data source multiple times to provide multiple stores.
LOCATION specifies the root of the password store.
-LOCATION, IDEN1, and IDEN2 are combined to locate a file in the password
+LOCATION, IDEN1, and IDEN2 are concatenated to locate a file in the password
store.
-When retrieving a password, IDEN1 should be specified as `--user-passwd-HOST'.
-where HOST should be a valid hostname, and IDEN2 a username. Otherwise IDEN1
-should be a valid hostname, unless prefixed by `_'. In the latter case, the
-path without the corresponding `_' is searched if the prefixed path is not
-found."
+For retrieving user account passwords, IDEN1 can be a valid hostname or
+`--user-passwd-HOST' where HOST is a valid hostname, and IDEN2 the username.
+Otherwise, IDEN1 should begin with '_' (see the 'Prerequisite Data' section of
+the Consfigurator user's manual). In the latter case, if the concatenated
+path does not exist in the password store then the search is tried again after
+dropping the '_'. This means that while user consfigs should always prefix
+any IDEN1 that is not a valid hostname with `_', existing pass(1) entries do
+not need to be renamed. Other forms for IDEN1 are not supported by this data
+source."
(let ((base-path (ensure-directory-pathname location)))
(unless (directory-exists-p base-path)
(missing-data-source
@@ -51,9 +47,9 @@ found."
(literal-data-pathname base-path iden1 iden2 :type "gpg")))
(%make-path (iden1 iden2)
(acond
- ((%strip-prefix "--user-passwd-" iden1)
+ ((strip-prefix "--user-passwd-" iden1)
(and (valid-hostname-p it) (%gpg-file-p it iden2)))
- ((%strip-prefix "_" iden1)
+ ((strip-prefix "_" iden1)
(or (%gpg-file-p iden1 iden2) (%gpg-file-p it iden2)))
(t
(and (valid-hostname-p iden1) (%gpg-file-p iden1 iden2)))))
@@ -63,7 +59,7 @@ found."
(extract (iden1 iden2)
(when-let ((file-path (%make-path iden1 iden2)))
(make-instance 'string-data
- :string (%read-gpg file-path)
+ :string (stripln (gpg-file-as-string file-path))
:iden1 iden1
:iden2 iden2
:version (file-write-date file-path)))))
diff --git a/src/data/pgp.lisp b/src/data/pgp.lisp
index 9120759..d0df280 100644
--- a/src/data/pgp.lisp
+++ b/src/data/pgp.lisp
@@ -55,11 +55,11 @@
(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 cd5644c..baf1dde 100644
--- a/src/data/util.lisp
+++ b/src/data/util.lisp
@@ -21,7 +21,11 @@
(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. No escaping of special characters is done."
+optionally adding extension TYPE. No escaping of special characters is done.
+
+The intended use case is to map IDEN1 and IDEN2 to files in a user-maintained
+hierarchy under LOCATION. In particular IDEN2 and (if prefixed by `_') IDEN1
+may contain `/' characters to map into multiple levels of directory."
(merge-pathnames
(uiop:relativize-pathname-directory
(uiop:parse-unix-namestring iden2 :type type))
@@ -31,12 +35,23 @@ optionally adding extension TYPE. No escaping of special characters is done."
(ensure-directory-pathname base-path))
nil))
+(defun gpg (args &key input output)
+ "run gnupg, taking homedir from *DATA-SOURCE-GNUPGHOME* if set. Return value
+is output from gnupg, as a string, INPUT and OUTPUT have the same meaning as
+for RUN-PROGRAM."
+ (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, return as a string."
+ "Decrypt the contents of a gpg encrypted file at LOCATION, return as a
+string."
(handler-case
- (run-program
- (escape-sh-command (list "gpg" "--decrypt" (unix-namestring location)))
- :output :string)
+ (gpg (list "--decrypt" (unix-namestring location)))
(subprocess-error (error)
(missing-data-source "While attempt to decrypt, gpg exited with ~A"
(uiop:subprocess-error-code error)))))
diff --git a/src/package.lisp b/src/package.lisp
index 70144f4..9ea7391 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -106,8 +106,8 @@
#:words
#:unwords
#:noop
- #:starts-with-string
#:symbol-named
+ #:strip-prefix
#:memstring=
#:define-simple-error
#:plist-to-cmd-args
@@ -338,6 +338,9 @@
#:passphrase
#:make-passphrase
#:get-data-protected-string
+ #:*data-source-gnupghome*
+ #:with-reset-data-sources
+ #:missing-data
;; image.lisp
#:eval-in-grandchild
@@ -1007,7 +1010,7 @@
(#:lxc #:consfigurator.property.lxc)))
(package :consfigurator.data.util
- (:export #:literal-data-pathname #:gpg-file-as-string))
+ (:export #:literal-data-pathname #:gpg-file-as-string #:gpg))
(package :consfigurator.data.asdf)
@@ -1015,7 +1018,6 @@
(:use #:consfigurator.data.util)
(:export #:list-data #:get-data #:set-data #:set-data-from-file))
-
(package :consfigurator.data.git-snapshot)
(package :consfigurator.data.gpgpubkeys)
diff --git a/src/util.lisp b/src/util.lisp
index 79d9d0b..d02ba9b 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -77,6 +77,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)))
+
(defmacro symbol-named (name symbol)
`(and (symbolp ,symbol)
(string= (symbol-name ',name) (symbol-name ,symbol))))
@@ -747,7 +752,8 @@ Does not currently establish a PAM session."
;;;; Hostnames
(defun valid-hostname-p (string)
- "Test whether STRING looks like a valid hostname."
+ "Test whether STRING looks like a valid hostname, as defined by RFCs 952 and
+1123."
(and
(<= (length string) 253)
(let ((parts (split-string string :separator ".")))
diff --git a/tests/data/pass.lisp b/tests/data/pass.lisp
dissimilarity index 86%
index 2853935..4f4d279 100644
--- a/tests/data/pass.lisp
+++ b/tests/data/pass.lisp
@@ -?,? +1,41 @@
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+(in-consfig "consfigurator/tests")
+
+(deftest pass-host.1
+ (get-data-string "server.example.org" "account")
+ "hunter2")
+
+(deftest pass-host.2
+ (get-data-string "--user-passwd-server.example.org" "account")
+ "hunter2")
+
+(deftest pass-host.3
+ (get-data-string "server.example.org" "/etc/foo.conf") "[section]
+key=value")
+
+(deftest pass-host.4
+ (handler-case
+ (get-data-string "a.example.com" "/etc/foo.conf")
+ (missing-data (c) "fail"))
+ "fail")
+
+(deftest pass-underscore.1
+ (get-data-string "_server.example.org" "account")
+ "hunter2")
+
+(deftest pass-underscore.2
+ (get-data-string "_foo/bar" "baz") "OK")
+
+(deftest pass-underscore.3
+ (handler-case
+ (get-data-string "foo/bar" "baz")
+ (missing-data (c) "fail"))
+ "fail")
+
+(deftest pass-underscore.4
+ (get-data-string "_valid" "file") "visible")
+
+(deftest pass-underscore.5
+ (get-data-string "_" "toplevel") "sekrit")
+
diff --git a/tests/data/pgp.lisp b/tests/data/pgp.lisp
new file mode 100644
index 0000000..c19ab73
--- /dev/null
+++ b/tests/data/pgp.lisp
@@ -0,0 +1,15 @@
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+(in-consfig "consfigurator/tests")
+
+(deftest data.pgp.1
+ (data.pgp:get-data *test-pgp-file* "_secrets" "test")
+ "this is a sekrit")
+
+(deftest data.pgp.2
+ (get-data-string "_secrets" "test")
+ "this is a sekrit")
+
+(deftest data.pgp.3
+ (get-data-string "host.example.com" "/etc/foo.conf")
+ "secret file content")
diff --git a/tests/data/util.lisp b/tests/data/util.lisp
index 4bb99b5..2c8dab0 100644
--- a/tests/data/util.lisp
+++ b/tests/data/util.lisp
@@ -4,30 +4,41 @@
;; relative parts
(deftest literal-data-pathname.1
- (data-util:literal-data-pathname "/home/user/data/" "foo" "bar")
+ (literal-data-pathname "/home/user/data/" "foo" "bar")
#.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
;; missing trailing / on part 1
(deftest literal-data-pathname.2
- (data-util:literal-data-pathname "/home/user/data" "foo" "bar")
+ (literal-data-pathname "/home/user/data" "foo" "bar")
#.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
;; absolute part 2
(deftest literal-data-pathname.3
- (data-util:literal-data-pathname "/home/user/data/" "/foo" "bar")
+ (literal-data-pathname "/home/user/data/" "/foo" "bar")
#.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
;; relative part 2, "_"
(deftest literal-data-pathname.4
- (data-util:literal-data-pathname "/home/user/data/" "_foo" "bar")
+ (literal-data-pathname "/home/user/data/" "_foo" "bar")
#.(uiop:parse-unix-namestring "/home/user/data/_foo/bar"))
;; absolute part 3
(deftest literal-data-pathname.5
- (data-util:literal-data-pathname "/home/user/" "/data" "/foo/bar")
+ (literal-data-pathname "/home/user/" "/data" "/foo/bar")
#.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
;; with type
(deftest literal-data-pathname.6
- (data-util:literal-data-pathname "/home/user/" "/data" "/foo/bar" :type "txt")
+ (literal-data-pathname "/home/user/" "/data" "/foo/bar" :type "txt")
#.(uiop:parse-unix-namestring "/home/user/data/foo/bar.txt"))
+
+;; base-path is pathname
+
+(deftest literal-data-pathname.7
+ (literal-data-pathname #P"/home/user/data/" "foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+
+;; base-path coerced to directory
+(deftest literal-data-pathname.8
+ (literal-data-pathname #P"/home/user/data" "foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
diff --git a/tests/gnupg-secret-key.asc b/tests/gnupg-secret-key.asc
deleted file mode 100644
index 744361b..0000000
diff --git a/tests/gnupg.lisp b/tests/gnupg.lisp
deleted file mode 100644
index 9ed9eed..0000000
diff --git a/tests/package.lisp b/tests/package.lisp
index 4487d67..47f41e4 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -1,6 +1,7 @@
(in-package :cl-user)
(defpackage :consfigurator/tests
- (:use #:cl #:consfigurator #:alexandria #+sbcl :sb-rt #-sbcl :rtest)
+ (:use #:cl #:consfigurator #:consfigurator.data.util #:alexandria #:anaphora
+ #+sbcl :sb-rt #-sbcl :rtest)
(:local-nicknames (#:file #:consfigurator.property.file)
- (#:data-util #:consfigurator.data.util)))
+ (#:data.pgp #:consfigurator.data.pgp)))
diff --git a/tests/runner.lisp b/tests/runner.lisp
index 47ddcf0..7be865e 100644
--- a/tests/runner.lisp
+++ b/tests/runner.lisp
@@ -1,11 +1,118 @@
+;;; 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))))
+
+(defparameter *test-pgp-file* nil)
+
+(defmacro with-test-pgp-source (base-dir &rest body)
+ "Run BODY with *TEST-PGP-FILE* defined and a corresponding pgp data source
+registered and populated."
+ `(let ((*test-pgp-file* (strcat (namestring ,base-dir) "/pgp-secrets.gpg")))
+ (data.pgp:set-data *test-pgp-file* "_secrets" "test" "this is a sekrit")
+ (data.pgp:set-data *test-pgp-file* "host.example.com" "/etc/foo.conf"
+ "secret file content")
+ (try-register-data-source :pgp :location *test-pgp-file*)
+ , at body))
+
+(defparameter *test-pass-dir* nil
+ "pass(1) store for use in test suite.")
+
+(defun pass (args &key input)
+ (run-program `("env" ,#?"GNUPGHOME=${*data-source-gnupghome*}"
+ ,#?"PASSWORD_STORE_DIR=${*test-pass-dir*}" "pass"
+ , at args)
+ :input (if input (make-string-input-stream input) nil)
+ :output :string :error-output :output))
+
+(defmacro with-test-pass-source (test-home &rest body)
+ "Run BODY with pass(1) data source in TEST-HOME populated and registed."
+ `(let ((*test-pass-dir* (strcat (namestring ,test-home) "/password-store")))
+ (pass (list "init" *test-gnupg-fingerprint*))
+ (pass '("insert" "-m" "server.example.org/account") :input "hunter2")
+ (pass '("insert" "-m" "_foo/bar/baz") :input "OK")
+ (pass '("insert" "-m" "foo/bar/baz") :input "illegal")
+ (pass '("insert" "-m" "valid/file") :input "shadowed")
+ (pass '("insert" "-m" "_valid/file") :input "visible")
+ (pass '("insert" "-m" "toplevel") :input "sekrit")
+ (pass '("insert" "-m" "server.example.org/etc/foo.conf")
+ :input "[section]
+key=value")
+ (try-register-data-source :pass :location *test-pass-dir*)
+ , 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)
+
+(deftest runner.3 (not *test-pgp-file*) nil)
+
+(deftest runner.4
+ (nth-value 0 (pass '("show" "toplevel")))
+ "sekrit")
+
(defun runner ()
"Run tests via (sb-)rt, with setup and teardown"
(with-local-temporary-directory (test-home)
- (reset-data-sources)
- (gpg-setup test-home)
- (pass-setup test-home)
- (do-tests)
- (gpg-cleanup)))
+ (with-test-gnupg-home test-home
+ (with-reset-data-sources
+ (with-test-pgp-source test-home
+ (with-test-pass-source test-home
+ (do-tests)))))))
diff --git a/tests/util.lisp b/tests/util.lisp
index 6b5cb62..fd310a7 100644
--- a/tests/util.lisp
+++ b/tests/util.lisp
@@ -26,14 +26,14 @@
;; case insensitive check
(deftest valid-hostname-p.3 (valid-hostname-p "host.Example.Com") t)
-;; "total length too long"
+;; total length too long
(deftest valid-hostname-p.4
- (valid-hostname-p (format nil "~{~A~^.~}"
- (make-list 128 :initial-element "a"))) nil)
+ (valid-hostname-p (format nil "~127@{a.~}a" nil))
+ nil)
;; label too long
(deftest valid-hostname-p.5
- (valid-hostname-p (strcat (make-string 64 :initial-element #\a) ".com"))
+ (valid-hostname-p (format nil "~64@{a~}a" nil))
nil)
;; valid use of `-'
@@ -46,4 +46,4 @@
(deftest valid-hostname-p.8 (valid-hostname-p "_hostname.example.com") nil)
;; invalid character 2
-(deftest valid-hostname-p.8 (valid-hostname-p "foo/bar") nil)
+(deftest valid-hostname-p.9 (valid-hostname-p "foo/bar") nil)
More information about the sgo-software-discuss
mailing list