[consfigurator] v4 pass data source
David Bremner
david at tethera.net
Thu May 5 12:29:19 BST 2022
I think I adopted all of the suggestions, except for moving the "," in 8/8. I
might have misunderstood something but
(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* (merge-pathnames #P"password-store/" ,test-home)))
+ `(let ((*test-pass-dir* ,(merge-pathnames #P"password-store/" test-home)))
(pass (list "init" *test-gnupg-fingerprint*))
(populate-data-pass)
(handler-case
resulted in
; caught ERROR:
; during macroexpansion of (WITH-TEST-PASS-SOURCE TEST-HOME (DO-TESTS)). Use
; *BREAK-ON-SIGNALS* to intercept.
;
; The value
; TEST-HOME
; is not of type
; (OR STRING PATHNAME SYNONYM-STREAM FILE-STREAM)
; when binding SB-IMPL::DEFAULTS
I guess this has to do with nested macro expansion, but I'm unclear on the
details.
Interdiff follows
diff --git a/src/data.lisp b/src/data.lisp
index 58b1557..d5d9d4c 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -143,9 +143,10 @@ 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."
+(defmacro with-reset-data-sources (&body 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*)
@@ -519,7 +520,8 @@ chance of those passwords showing up in the clear in the Lisp debugger."
(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.")
+(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/pass.lisp b/src/data/pass.lisp
index e9e7ae6..aaba698 100644
--- a/src/data/pass.lisp
+++ b/src/data/pass.lisp
@@ -34,9 +34,9 @@ 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."
+any IDEN1 that is not a valid hostname or of the form `--user-passwd-HOST'
+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
diff --git a/src/data/util.lisp b/src/data/util.lisp
index baf1dde..a04df02 100644
--- a/src/data/util.lisp
+++ b/src/data/util.lisp
@@ -21,24 +21,31 @@
(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, but extra `/' characters between
+pathname components are removed.
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
+hierarchy under BASE-PATH. 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))
- (merge-pathnames
- (uiop:relativize-pathname-directory
- (ensure-directory-pathname iden1))
- (ensure-directory-pathname base-path))
- nil))
+ (let ((base-dir (uiop:parse-unix-namestring base-path :ensure-directory t)))
+ (unless (uiop:directory-pathname-p base-dir)
+ (simple-program-error "~A does not specify a directory" base-dir))
+ (merge-pathnames
+ (uiop:relativize-pathname-directory
+ (uiop:parse-unix-namestring iden2 :type type))
+ (merge-pathnames
+ (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. Return value
-is output from gnupg, as a string, INPUT and OUTPUT have the same meaning as
-for RUN-PROGRAM."
+ "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*
@@ -53,5 +60,5 @@ string."
(handler-case
(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)))))
+ (missing-data-source "While attempt to decrypt ~A, gpg exited with ~A"
+ location (uiop:subprocess-error-code error)))))
diff --git a/src/util.lisp b/src/util.lisp
index 961a477..e20b113 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -734,17 +734,3 @@ Does not currently establish a PAM session."
(when-let ((output-stream (stream->output-stream stream)))
(when (open-stream-p output-stream)
(funcall function output-stream)))))
-
-
-;;;; Hostnames
-
-(defun valid-hostname-p (string)
- "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 ".")))
- (every (lambda (part)
- (and (<= (length part) 63)
- (re:scan "^[a-zA-Z0-9][a-zA-Z0-9-]*$" part)))
- parts))))
diff --git a/tests/data/pass.lisp b/tests/data/pass.lisp
index 4f4d279..62eb944 100644
--- a/tests/data/pass.lisp
+++ b/tests/data/pass.lisp
@@ -2,6 +2,18 @@
(named-readtables:in-readtable :consfigurator)
(in-consfig "consfigurator/tests")
+(defun populate-data-pass ()
+ "Invoked by test runner before data source is registered."
+ (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"))
+
(deftest pass-host.1
(get-data-string "server.example.org" "account")
"hunter2")
@@ -30,7 +42,7 @@ key=value")
(deftest pass-underscore.3
(handler-case
(get-data-string "foo/bar" "baz")
- (missing-data (c) "fail"))
+ (simple-program-error (c) "fail"))
"fail")
(deftest pass-underscore.4
diff --git a/tests/data/pgp.lisp b/tests/data/pgp.lisp
index c19ab73..21ba60c 100644
--- a/tests/data/pgp.lisp
+++ b/tests/data/pgp.lisp
@@ -2,6 +2,12 @@
(named-readtables:in-readtable :consfigurator)
(in-consfig "consfigurator/tests")
+(defun populate-data-pgp ()
+ "Invoked by test runner before data source is registered."
+ (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"))
+
(deftest data.pgp.1
(data.pgp:get-data *test-pgp-file* "_secrets" "test")
"this is a sekrit")
diff --git a/tests/data/util.lisp b/tests/data/util.lisp
index 2c8dab0..a04b8be 100644
--- a/tests/data/util.lisp
+++ b/tests/data/util.lisp
@@ -4,41 +4,64 @@
;; relative parts
(deftest literal-data-pathname.1
- (literal-data-pathname "/home/user/data/" "foo" "bar")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+ (unix-namestring (literal-data-pathname "/home/user/data/" "foo" "bar"))
+ "/home/user/data/foo/bar")
;; missing trailing / on part 1
(deftest literal-data-pathname.2
- (literal-data-pathname "/home/user/data" "foo" "bar")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+ (unix-namestring (literal-data-pathname "/home/user/data" "foo" "bar"))
+ "/home/user/data/foo/bar")
;; absolute part 2
(deftest literal-data-pathname.3
- (literal-data-pathname "/home/user/data/" "/foo" "bar")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+ (unix-namestring (literal-data-pathname "/home/user/data/" "/foo" "bar"))
+ "/home/user/data/foo/bar")
;; relative part 2, "_"
(deftest literal-data-pathname.4
- (literal-data-pathname "/home/user/data/" "_foo" "bar")
- #.(uiop:parse-unix-namestring "/home/user/data/_foo/bar"))
+ (unix-namestring (literal-data-pathname "/home/user/data/" "_foo" "bar"))
+ "/home/user/data/_foo/bar")
;; absolute part 3
(deftest literal-data-pathname.5
- (literal-data-pathname "/home/user/" "/data" "/foo/bar")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+ (unix-namestring (literal-data-pathname "/home/user/" "/data" "/foo/bar"))
+ "/home/user/data/foo/bar")
;; with type
(deftest literal-data-pathname.6
- (literal-data-pathname "/home/user/" "/data" "/foo/bar" :type "txt")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar.txt"))
+ (unix-namestring
+ (literal-data-pathname "/home/user/" "/data" "/foo/bar" :type "txt"))
+ "/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"))
+ (unix-namestring (literal-data-pathname #P"/home/user/data/" "foo" "bar"))
+ "/home/user/data/foo/bar")
-;; base-path coerced to directory
+;; base-path not a directory
(deftest literal-data-pathname.8
- (literal-data-pathname #P"/home/user/data" "foo" "bar")
- #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+ (handler-case
+ (literal-data-pathname #P"/home/user/data" "foo" "bar")
+ (simple-program-error (c) "fail"))
+ "fail")
+
+;; extra '/' at end
+(deftest literal-data-pathname.9
+ (unix-namestring (literal-data-pathname "/home/user/data//" "foo" "bar"))
+ "/home/user/data/foo/bar")
+
+;; extra '/' in middle
+(deftest literal-data-pathname.10
+ (unix-namestring (literal-data-pathname "/home/user//data/" "foo" "bar"))
+ "/home/user/data/foo/bar")
+
+;; extra '/' part 2
+(deftest literal-data-pathname.11
+ (unix-namestring (literal-data-pathname "/home/user/data/" "foo//" "bar"))
+ "/home/user/data/foo/bar")
+
+;; extra '/' part 3
+(deftest literal-data-pathname.12
+ (unix-namestring (literal-data-pathname "/home/user/data/" "foo" "//bar"))
+ "/home/user/data/foo/bar")
diff --git a/tests/runner.lisp b/tests/runner.lisp
index 7be865e..aafeafa 100644
--- a/tests/runner.lisp
+++ b/tests/runner.lisp
@@ -22,47 +22,49 @@
"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."
+ "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")))
+(defun make-test-gnupghome ()
+ "Create and populate *DATA-SOURCE-GNUPGHOME* for tests."
+ (unless (nth-value 1 (ensure-directories-exist
+ *data-source-gnupghome* :mode #o700))
+ (error "~s already exists" *data-source-gnupghome*))
+ (gpg '("--batch" "--pinentry-mode" "loopback" "--passphrase" "" "--yes"
+ "--quick-generate-key" "consfig at example.org (insecure!)"))
+ (with-open-file (stream #?"${*data-source-gnupghome*}/gpg.conf"
+ :direction :output)
+ (format stream "default-key ~a~%default-recipient-self~%"
+ *test-gnupg-fingerprint*)))
(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))))
+*DATA-SOURCE-GNUPGHOME* and *TEST-GNUPG-FINGERPRINT* set appropriately."
+ `(let ((*data-source-gnupghome* (merge-pathnames #P"gnupg/" ,base-dir)))
+ (unwind-protect
+ (progn
+ (make-test-gnupghome)
+ (let ((*test-gnupg-fingerprint* (first-gpg-fingerprint)))
+ , at body))
+ (run-program "gpgconf" "--homedir" *data-source-gnupghome*
+ "--kill" "all"))))
(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*)
+ `(let ((*test-pgp-file* (merge-pathnames "pgp-secrets.gpg" ,base-dir)))
+ (populate-data-pgp)
+ (handler-case
+ (try-register-data-source :pgp :location *test-pgp-file*)
+ (missing-data-source ()
+ (error "Test setup failure for pgp file ~a" *test-pgp-file*)))
, at body))
(defparameter *test-pass-dir* nil
@@ -77,21 +79,26 @@ registered and populated."
(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")))
+ `(let ((*test-pass-dir* (merge-pathnames #P"password-store/" ,test-home)))
(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*)
+ (populate-data-pass)
+ (handler-case
+ (try-register-data-source :pass :location *test-pass-dir*)
+ (missing-data-source ()
+ (error "Test setup failure for pass directory ~a" *test-pass-dir*)))
, at body))
-;; tests for test runner machinery
+(defun runner ()
+ "Run tests via (sb-)rt, with setup and teardown."
+ (with-local-temporary-directory (test-home)
+ (with-test-gnupg-home test-home
+ (with-reset-data-sources
+ (with-test-pgp-source test-home
+ (with-test-pass-source test-home
+ (do-tests)))))))
+
+
+;;;; tests for test runner machinery
(deftest runner.0 (not *data-source-gnupghome*) nil)
(deftest runner.1
@@ -104,15 +111,4 @@ key=value")
(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)
- (with-test-gnupg-home test-home
- (with-reset-data-sources
- (with-test-pgp-source test-home
- (with-test-pass-source test-home
- (do-tests)))))))
+(deftest runner.4 (nth-value 2 (pass '("list"))) 0)
More information about the sgo-software-discuss
mailing list