[RFC PATCH consfigurator] WRITEFILE: attempt to create missing intermediate directories

[Sean Whitton]

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

A disadvantage of this is that if there is a mistake in the filename then
Consfigurator might go off and create multiple unwanted directories on the
remote.  As such directories are usually harmless, however, this disadvantage
would seem to be outweighed.

Signed-off-by: Sean Whitton <spwhitton at spwhitton.name>
---
I would be grateful for feedback on the idea of creating missing dirs as 755
unless the file we're writing has zero permissions for one of owner group or
world, in which case switch the permission of that class to 0.  So for example
if we're creating a file with permissions 604 then we'd create any missing
intermediate dirs with permissions 705.  Should we just always use 755 instead?

diff --git a/src/connection.lisp b/src/connection.lisp
index 9a7584f4..44fc2de0 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -127,7 +127,7 @@ time savings add up."))
 ;; take: a string vs. a path.  for a given connection type, they may have same
 ;; or different implementations.
 
-(defgeneric connection-writefile (connection path content mode)
+(defgeneric connection-writefile (connection path content mode mkdir-umask)
   (:documentation
    "Subroutine to replace/create the contents of files on the host.
 
@@ -142,14 +142,19 @@ CONTENT to a temporary file in (UIOP:PATHNAME-DIRECTORY-PATHNAME PATH),
 change the mode of that file to MODE, and then rename to PATH.
 WITH-REMOTE-TEMPORARY-FILE can be used to do this.
 
+If and only if MKDIR-UMASK, then before attempting to write the file, also
+attempt to create any missing intermediate pathname components, in the manner
+of 'mkdir -p'.  The umask during directory creation is set to MKDIR-UMASK.
+
 Implementations can specialise on both the CONNECTION and CONTENT arguments,
 if they need to handle streams and strings differently."))
 
 (defmethod connection-writefile :around ((connection connection)
                                          path
                                          content
-                                         mode)
-  (declare (ignore path content mode))
+                                         mode
+                                         mkdir-umask)
+  (declare (ignore path content mode mkdir-umask))
   (let ((*connection* (slot-value connection 'parent)))
     (call-next-method)))
 
@@ -648,14 +653,19 @@ specification of POSIX ls(1))."
                 (omode (dehyphen (elt groups 2)))
                 (uid (elt groups 3))
                 (gid (elt groups 4)))
-            (connection-writefile *connection* namestring content mode)
+            (connection-writefile *connection* namestring content mode nil)
             (let ((namestring (escape-sh-token namestring)))
               (unless mode-supplied-p
                 ;; assume that if we can write it we can chmod it
                 (mrun #?"chmod u=${umode},g=${gmode},o=${omode} ${namestring}"))
               ;; we may not be able to chown; that's okay
               (mrun :may-fail #?"chown ${uid}:${gid} ${namestring}")))))
-      (connection-writefile *connection* namestring content mode)))
+      (connection-writefile *connection* namestring content mode
+                            ;; If MODE does not grant someone any access at
+                            ;; all, mask out their directory permissions.
+                            (loop for mask in '(#o7 #o70 #o700)
+                                  when (zerop (logand mode mask))
+                                    sum mask))))
 
 (defun get-connattr (k)
   "Get the connattr identified by K for the current connection."
diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index 2c790365..0979b54e 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -51,12 +51,16 @@
 (defmethod connection-writefile ((connection local-connection)
                                  path
                                  content
-                                 mode)
+                                 mode
+                                 mkdir-umask
+                                 &aux (dir (pathname-directory-pathname path)))
+  (when mkdir-umask
+    (run-program
+     (format nil "umask ~O; mkdir -p ~A"
+             mkdir-umask (escape-sh-token (unix-namestring dir)))))
   ;; we cannot use UIOP:WITH-TEMPORARY-FILE etc., because those do not ensure
   ;; the file is only readable by us, and we might be writing a secret key
-  (with-remote-temporary-file
-      (temp :connection connection
-            :directory (pathname-directory-pathname path))
+  (with-remote-temporary-file (temp :connection connection :directory dir)
     (nix:chmod temp mode)
     (etypecase content
       (string
diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp
index 49cfd835..4481cbb2 100644
--- a/src/connection/shell-wrap.lisp
+++ b/src/connection/shell-wrap.lisp
@@ -45,17 +45,22 @@
 (defmethod connection-writefile ((conn shell-wrap-connection)
                                  path
                                  content
-                                 mode)
+                                 mode
+                                 mkdir-umask
+                                 &aux (dir (pathname-directory-pathname path)))
   (let ((cmd
           (format
            nil "set -e
+~@[(~A)~]
 tmpf=$(~A)
 trap \"rm -f '$tmpf'\" EXIT HUP KILL TERM INT
 chmod ~O \"$tmpf\"
 cat >\"$tmpf\"
 mv \"$tmpf\" ~A"
-           (mkstemp-cmd
-            (merge-pathnames "tmp.XXXXXX" (pathname-directory-pathname path)))
+           (and mkdir-umask
+                (format nil "umask ~O; mkdir -p ~A"
+                        mkdir-umask (escape-sh-token (unix-namestring dir))))
+           (mkstemp-cmd (merge-pathnames "tmp.XXXXXX" dir))
            mode
            (escape-sh-token (unix-namestring path)))))
     (multiple-value-bind (out exit) (connection-run conn cmd content)
diff --git a/src/property/file.lisp b/src/property/file.lisp
index 0d89d820..b9513117 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -136,9 +136,7 @@ any of the regular expressions PATTERNS."
   (:hostattrs
    (declare (ignore destination))
    (require-data iden1 iden2))
-  (:apply
-   (containing-directory-exists destination)
-   (maybe-writefile-data destination iden1 iden2)))
+  (:apply (maybe-writefile-data destination iden1 iden2)))
 
 (defproplist host-data-uploaded :posix
     (destination
@@ -152,9 +150,7 @@ any of the regular expressions PATTERNS."
   (:hostattrs
    (declare (ignore destination))
    (require-data iden1 iden2))
-  (:apply
-   (containing-directory-exists destination)
-   (maybe-writefile-data destination iden1 iden2 :mode #o600)))
+  (:apply (maybe-writefile-data destination iden1 iden2 :mode #o600)))
 
 (defproplist host-secret-uploaded :posix
     (destination
-- 
2.30.2