CONNECTION-WRITEFILE: deal in modes rather than umasks

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

4 files changed, 50 insertions, 36 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index 125f3ff..88c40fe 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -105,20 +105,29 @@ error condition just because EXIT is non-zero."))
 ;; take: a string vs. a path.  for a given connection type, they may have same
 ;; or different implementations.
 
-(defgeneric connection-writefile (connection path input umask)
+(defgeneric connection-writefile (connection path content mode)
   (:documentation
    "Subroutine to replace/create the contents of files on the host.
 
-INPUT is the new contents of the file or a stream which will produce it.
+CONTENT is the new contents of the file or a stream which will produce it.
 
-Implementations can specialise on both the CONNECTION and INPUT arguments, if
-they need to handle streams and strings differently."))
+MODE is the octal mode that the file should have by the time this function
+returns.  Implementations should ensure that CONTENT is not stored on disk
+with a mode greater than MODE, and also that if CONTENT is stored on disk
+outside of (UIOP:PATHNAME-DIRECTORY-PATHNAME PATH), then it does not
+have a mode greater than 700.  It is recommended that implementations write
+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.
+
+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
-					 umask)
-  (declare (ignore path content umask))
+					 mode)
+  (declare (ignore path content mode))
   (let ((*connection* (slot-value connection 'parent)))
     (call-next-method)))
 
diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index a8a967c..f181922 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -44,35 +44,37 @@ root Lisp is running on, as the root Lisp's uid."))
 (defmethod connection-readfile ((connection local-connection) path)
   (read-file-string path))
 
-(defcfun "umask" :int (mode :int))
-
-;; TODO this is not safe if there are multiple threads
-(defmacro with-umask ((umask) &body forms)
-  (with-gensyms (old)
-    `(let ((,old (umask ,umask)))
-       (unwind-protect
-	    (progn ,@forms)
-	 (umask ,old)))))
+;; in the following two functions, 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
 
 (defmethod connection-writefile ((connection local-connection)
 				 path
-				 (contents string)
-				 umask)
-  (with-umask (umask)
-    (with-open-file (stream path :direction :output :if-exists :supersede)
-      (write-string contents stream))))
+				 (content string)
+				 mode)
+  (with-remote-temporary-file
+      (temp :connection connection
+	    :directory (pathname-directory-pathname path))
+    (run-program `("chmod" ,(format nil "~O" mode) ,temp))
+    (with-open-file (stream temp :direction :output :if-exists :supersede)
+      (write-string content stream))
+    (run-program `("mv" ,temp ,path))))
 
 (defmethod connection-writefile ((connection local-connection)
 				 path
-				 (contents stream)
-				 umask
+				 (content stream)
+				 mode
 				 &aux
-				   (type (stream-element-type contents)))
-  (with-umask (umask)
-    (with-open-file (stream path :direction :output
+				   (type (stream-element-type content)))
+  (with-remote-temporary-file
+      (temp :connection connection
+	    :directory (pathname-directory-pathname path))
+    (run-program `("chmod" ,(format nil "~O" mode) ,temp))
+    (with-open-file (stream temp :direction :output
 				 :if-exists :supersede
 				 :element-type type)
-      (copy-stream-to-stream contents stream :element-type type))))
+      (copy-stream-to-stream content stream :element-type type))
+    (run-program `("mv" ,temp ,path))))
 
 (defmethod connection-upload ((connection local-connection) from to)
   (copy-file from to))
diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp
index 99d1735..345a59d 100644
--- a/src/connection/shell-wrap.lisp
+++ b/src/connection/shell-wrap.lisp
@@ -33,16 +33,19 @@
 
 (defmethod connection-writefile ((conn shell-wrap-connection)
 				 path
-				 contents
-				 umask)
-  ;; TODO do we want a CONNECTION-ERROR condition?
-  (with-remote-temporary-file (temp :connection conn)
+				 content
+				 mode)
+  (with-remote-temporary-file
+      (temp :connection conn :directory (pathname-directory-pathname path))
+    ;; TODO do we want a CONNECTION-ERROR condition to tidy this up?
     (multiple-value-bind (out exit)
-	(connection-run conn (if umask
-				 (format nil "( umask ~O; cat >~A )"
-					 umask temp)
-				 #?"cat >${temp}")
-			contents)
+	(connection-run conn
+			(format nil "chmod ~O ~A" mode
+				(escape-sh-token temp))
+			nil)
+      (unless (zerop exit) (error "Failed to chmod ~A: ~A" temp out)))
+    (multiple-value-bind (out exit)
+	(connection-run conn #?"cat >${temp}" content)
       (unless (zerop exit) (error "Failed to write ~A: ~A" temp out)))
     (multiple-value-bind (out exit)
 	(connection-run
diff --git a/src/package.lisp b/src/package.lisp
index 7e2e632..7c8a334 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -153,7 +153,7 @@
 	#:consfigurator.connection.shell-wrap))
 
 (defpackage :consfigurator.connection.local
-  (:use #:cl #:consfigurator #:alexandria #:cffi)
+  (:use #:cl #:consfigurator #:alexandria)
   (:export #:local-connection))
 
 (defpackage :consfigurator.connection.debian-sbcl