add package CONSFIGURATOR.DATA.UTIL

This package is intended to provide a home for utility functions used by
multiple data sources.  Initially move a local function from
CONSFIGURATOR.DATA.FILES-TREE, and slightly generalize it to support an
extension or TYPE argument.

Note that the goal of LITERAL-DATA-PATHNAME is to map (IDEN1 IDEN2) to
existing paths in a user-maintained file hierarchy.  This is quite different
from DATA-PATHNAME, which escapes various characters to map to a safe internal
filename, effectively flattening a directory hierarchy into a single level.

Signed-off-by: David Bremner <david@tethera.net>

6 files changed, 118 insertions, 13 deletions

diff --git a/consfigurator.asd b/consfigurator.asd
index 4cfa06e..8048c90 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -88,6 +88,7 @@
 	       (:file "src/connection/setuid")
 	       (:file "src/connection/as")
                (:file "src/connection/linux-namespace")
+               (:file "src/data/util")
                (:file "src/data/asdf")
                (:file "src/data/pgp")
 	       (:file "src/data/git-snapshot")
@@ -108,6 +109,7 @@
                (:feature :sbcl (:require #:sb-rt))
                (:feature (:not :sbcl) #:rt))
   :components ((:file "tests/package")
+               (:file "tests/data/util")
                (:file "tests/util")
                (:file "tests/property/file"))
   :perform (test-op (o c) (symbol-call :consfigurator/tests '#:do-tests)))
diff --git a/src/data/files-tree.lisp b/src/data/files-tree.lisp
index 993d9aa..8418a80 100644
--- a/src/data/files-tree.lisp
+++ b/src/data/files-tree.lisp
@@ -37,20 +37,12 @@ IDEN2 an an absolute or relative path are all supported."
     (unless (directory-exists-p base-path)
       (missing-data-source
        "~A does not exist, or is not a directory." base-path))
-    (labels ((%make-path (iden1 iden2)
-               (merge-pathnames
-                (uiop:relativize-pathname-directory
-                 iden2)
-                (merge-pathnames
-                 (uiop:relativize-pathname-directory
-                  (ensure-directory-pathname iden1))
-                 base-path)))
-             (check (iden1 iden2)
-               (let ((file-path (%make-path iden1 iden2)))
+    (labels ((check (iden1 iden2)
+               (let ((file-path (literal-data-pathname base-path iden1 iden2)))
                  (and (file-exists-p file-path)
                       (file-write-date file-path))))
              (extract (iden1 iden2)
-               (let ((file-path (%make-path iden1 iden2)))
+               (let ((file-path (literal-data-pathname base-path iden1 iden2)))
                  (and (file-exists-p file-path)
                       (make-instance 'file-data
                                      :file file-path
diff --git a/src/data/util.lisp b/src/data/util.lisp
new file mode 100644
index 0000000..3fd8895
--- /dev/null
+++ b/src/data/util.lisp
@@ -0,0 +1,40 @@
+;;; Consfigurator -- Lisp declarative configuration management system
+
+;;; Copyright (C) 2022  David Bremner <david@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.data.util)
+(named-readtables:in-readtable :consfigurator)
+
+(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, 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 BASE-PATH.  In particular IDEN2 and (if prefixed by '_') IDEN1
+may contain '/' characters to map into multiple levels of directory."
+  (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))))
diff --git a/src/package.lisp b/src/package.lisp
index 88bfb2f..df59785 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1002,6 +1002,9 @@
            (:local-nicknames (#:user #:consfigurator.property.user)
                              (#:lxc  #:consfigurator.property.lxc)))
 
+  (package :consfigurator.data.util
+           (:export #:literal-data-pathname))
+
   (package :consfigurator.data.asdf)
 
   (package :consfigurator.data.pgp
@@ -1016,4 +1019,5 @@
 
   (package :consfigurator.data.local-file)
 
-  (package :consfigurator.data.files-tree))
+  (package :consfigurator.data.files-tree
+           (:use  #:consfigurator.data.util)))
diff --git a/tests/data/util.lisp b/tests/data/util.lisp
new file mode 100644
index 0000000..a04b8be
--- /dev/null
+++ b/tests/data/util.lisp
@@ -0,0 +1,67 @@
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+(in-consfig "consfigurator/tests")
+
+;; relative parts
+(deftest literal-data-pathname.1
+    (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
+    (unix-namestring (literal-data-pathname "/home/user/data" "foo" "bar"))
+  "/home/user/data/foo/bar")
+
+;; absolute part 2
+(deftest literal-data-pathname.3
+    (unix-namestring (literal-data-pathname "/home/user/data/" "/foo" "bar"))
+  "/home/user/data/foo/bar")
+
+;; relative part 2, "_"
+(deftest literal-data-pathname.4
+    (unix-namestring (literal-data-pathname "/home/user/data/" "_foo" "bar"))
+  "/home/user/data/_foo/bar")
+
+;; absolute part 3
+(deftest literal-data-pathname.5
+    (unix-namestring (literal-data-pathname "/home/user/" "/data" "/foo/bar"))
+  "/home/user/data/foo/bar")
+
+;; with type
+(deftest literal-data-pathname.6
+    (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
+    (unix-namestring (literal-data-pathname #P"/home/user/data/" "foo" "bar"))
+  "/home/user/data/foo/bar")
+
+;; base-path not a directory
+(deftest literal-data-pathname.8
+    (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/package.lisp b/tests/package.lisp
index 286243c..0a303f0 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -1,5 +1,5 @@
 (in-package :cl-user)
 
 (defpackage :consfigurator/tests
-  (:use #:cl #:consfigurator #+sbcl :sb-rt #-sbcl :rtest)
+  (:use #:cl #:consfigurator #:consfigurator.data.util #+sbcl :sb-rt #-sbcl :rtest)
   (:local-nicknames (#:file       #:consfigurator.property.file)))