simplify WRITEFILE file attribute preservation

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

2 files changed, 22 insertions, 18 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index 88c40fe..178157f 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -319,17 +319,25 @@ start with RUN."
 (defun readfile (&rest args)
   (apply #'connection-readfile *connection* args))
 
-(defun writefile (path content &key try-preserve (umask #o022))
-  (if (and try-preserve (test "-f" path))
-      (destructuring-bind (umode gmode wmode uid gid)
-	  ;; seems there is nothing like stat(1) in POSIX
-	  (re:all-matches-as-strings
-	   #?/^.(...)(...)(...).[0-9]+ ([0-9]+) ([0-9]+) /
-	   (mrun "ls" "-nd" path))
-	(connection-writefile *connection* path content umask)
+(defun writefile (path content &key (mode #o644 mode-supplied-p))
+  ;; If (lisp-connection-p), the file already exists, and it's not owned by
+  ;; us, we could (have a keyword argument to) bypass CONNECTION-WRITEFILE and
+  ;; just WRITE-STRING to the file.  That way we don't replace the file with
+  ;; one owned by us, which we might not be able to chown back as non-root.
+  ;;
+  ;; The following, simpler behaviour should fit most sysadmin needs.
+  (if (test "-f" path)
+      ;; seems there is nothing like stat(1) in POSIX, and note that
+      ;; --reference for chmod(1) and chown(1) is not POSIX
+      (re:register-groups-bind
+	  (((lambda (s) (remove #\- s)) umode gmode omode) uid gid)
+	  (#?/^.(...)(...)(...).[0-9]+ ([0-9]+) ([0-9]+) /
+	   (mrun "ls" "-nd" path) :sharedp t)
+	(connection-writefile *connection* path content mode)
 	(let ((path (escape-sh-token path)))
-	  ;; assume that if we can write it we can chmod it
-	  (mrun #?"chmod u=${umode},g=${gmode},w=${wmode} ${path}")
+	  (unless mode-supplied-p
+	    ;; assume that if we can write it we can chmod it
+	    (mrun #?"chmod u=${umode},g=${gmode},o=${omode} ${path}"))
 	  ;; we may not be able to chown; that's okay
 	  (mrun :may-fail #?"chown ${uid}:${gid} ${path}")))
-      (connection-writefile *connection* path content umask)))
+      (connection-writefile *connection* path content mode)))
diff --git a/src/property/file.lisp b/src/property/file.lisp
index 45eb176..cce1f1b 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -26,7 +26,7 @@ point in doing that here because WRITEFILE is synchronous."
 	 (new-lines (funcall function orig-lines)))
     (if (equal orig-lines new-lines)
 	:no-change
-	(writefile file (unlines new-lines) :try-preserve t))))
+	(writefile file (unlines new-lines)))))
 
 (defprop has-content :posix (path content)
   "Ensure there is a file at PATH whose content is CONTENT.
@@ -40,8 +40,7 @@ CONTENT can be a list of lines or a single string."
 	 (existing-lines (lines (readfile path))))
      (dolist (existing-line existing-lines)
        (deletef new-lines existing-line :test #'string=))
-     (writefile path (unlines (nconc existing-lines new-lines))
-		:try-preserve t))))
+     (writefile path (unlines (nconc existing-lines new-lines))))))
 
 (defprop data-uploaded :posix (iden1 iden2 destination)
   (:hostattrs
@@ -61,10 +60,7 @@ CONTENT can be a list of lines or a single string."
    (declare (ignore destination))
    (require-data iden1 iden2))
   (:apply
-   (when (test "-e" destination)
-     (mrun "chmod" "600" destination))
-   (writefile destination (get-data-stream iden1 iden2)
-	      :try-preserve t :umask #o077)))
+   (writefile destination (get-data-stream iden1 iden2) :mode #o600)))
 
 (defprop host-secret-uploaded :posix (destination)
   (:hostattrs