src/property/file.lisp: unless mode supplied, create missing dirs

This means you can apply properties like FILE:HAS-CONTENT without also having
to explicitly apply FILE:{CONTAINING-,}DIRECTORY-EXISTS or similar.

If missing intermediate directories need to have particular modes or
ownership, it is easy to apply properties to ensure those directories exist
with those attributes before applying the property which will create the file.
Then there are no missing directories for the latter property to create.  In
the case where a mode for the file is supplied, leave it to the caller to
create the directories, as a safety measure (see 487a473390).

In the future we might create missing intermediate directories based on a
supplied mode, such as creating them 0750 when the supplied mode is 0640.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

3 files changed, 7 insertions, 4 deletions

diff --git a/src/property/file.lisp b/src/property/file.lisp
index e6fcf84..bd940f3 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -35,7 +35,8 @@ CONTENT can be a list of lines or a single string."
   (declare (indent 1))
   (:desc (declare (ignore content mode mode-supplied-p))
          #?"${path} has defined content")
-  (:apply (apply #'maybe-writefile-string
+  (:apply (unless mode-supplied-p (containing-directory-exists path))
+          (apply #'maybe-writefile-string
                  path
                  (etypecase content
                    (cons (unlines content))
@@ -62,6 +63,7 @@ replacing the contents of existing files, prefer FILE:HAS-CONTENT."
   "Ensure there is a file at PATH containing each of LINES once."
   (declare (indent 1))
   (:apply
+   (containing-directory-exists path)
    (let ((new-lines (copy-list (ensure-cons lines)))
          (existing-lines (and (remote-exists-p path)
                               (lines (readfile path)))))
@@ -230,7 +232,8 @@ error if FROM is another kind of file, except when unapplying."
        (failed-change "~A exists but is not a symbolic link." from))
      (if (and link (string= (remote-link-target from) to))
          :no-change
-         (mrun "ln" "-sf" to from))))
+         (progn
+           (containing-directory-exists from) (mrun "ln" "-sf" to from)))))
   (:unapply
    (declare (ignore to))
    (if (test "-L" from)
@@ -361,6 +364,7 @@ Other arguments:
             do (simple-program-error
                 "Values passed are not all strings, or list is not even")
           do (setf (gethash k keys) v))
+    (containing-directory-exists file)
     (map-file-lines
      file (apply
            #'config-file-map
@@ -520,6 +524,7 @@ an attempt is made to activate the swap, set up the bind mount, etc."
         (pending (make-hash-table :test #'equal)))
     (dolist (entry entries)
       (setf (gethash (nth target (words entry)) pending) entry))
+    (containing-directory-exists file)
     (map-file-lines
      file
      (lambda (lines)
diff --git a/src/property/lxc.lisp b/src/property/lxc.lisp
index c55cd0b..e914213 100644
--- a/src/property/lxc.lisp
+++ b/src/property/lxc.lisp
@@ -76,7 +76,6 @@ is ~/.config."
   (user:has-account user)
   (systemd:lingering-enabled user)
   (as user
-    (file:directory-exists ".config/systemd/user")
     (file:has-content ".config/systemd/user/lxc-autostart.service"
       '("[Unit]"
         "Description=\"lxc-autostart\""
diff --git a/src/property/ssh.lisp b/src/property/ssh.lisp
index 33d2088..de1f153 100644
--- a/src/property/ssh.lisp
+++ b/src/property/ssh.lisp
@@ -23,7 +23,6 @@
   (:desc (declare (ignore keys))
          (strcat (get-connattr :remote-user) " has authorized_keys"))
   (:apply
-   (file:directory-exists ".ssh")
    (apply #'file:contains-lines ".ssh/authorized_keys" keys))
   (:unapply
    (apply #'file:lacks-lines ".ssh/authorized_keys" keys)))