attempt to implement umask support for CONNECTION-WRITEFILE

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

2 files changed, 35 insertions, 15 deletions

diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index 5f5c260..613a827 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -44,20 +44,34 @@ 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))
+
+(defmacro with-umask ((umask) &body forms)
+  (with-gensyms (old)
+    `(let ((,old (umask ,umask)))
+       (unwind-protect
+	    (progn ,@forms)
+	 (umask ,old)))))
+
 (defmethod connection-writefile ((connection local-connection)
 				 path
-				 (contents string))
-  (with-open-file (stream path :direction :output :if-exists :supersede)
-    (write-string contents stream)))
+				 (contents string)
+				 umask)
+  (with-umask (umask)
+    (with-open-file (stream path :direction :output :if-exists :supersede)
+      (write-string contents stream))))
 
 (defmethod connection-writefile ((connection local-connection)
 				 path
-				 (contents stream))
-  (with-open-file (stream path :direction :output
-			       :if-exists :supersede
-			       :element-type (stream-element-type contents))
-    (copy-stream-to-stream contents stream
-			   :element-type (stream-element-type contents))))
+				 (contents stream)
+				 umask
+				 &aux
+				   (type (stream-element-type contents)))
+  (with-umask (umask)
+    (with-open-file (stream path :direction :output
+				 :if-exists :supersede
+				 :element-type type)
+      (copy-stream-to-stream contents stream :element-type type))))
 
 (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 883757b..70d094c 100644
--- a/src/connection/shell-wrap.lisp
+++ b/src/connection/shell-wrap.lisp
@@ -31,10 +31,16 @@
 	(connection-run c #?"test -r ${path} && cat ${path}" nil))
     (if (= 0 exit) out (error "File ~S not readable" path))))
 
-(defmethod connection-writefile ((conn shell-wrap-connection) path contents)
+(defmethod connection-writefile ((conn shell-wrap-connection)
+				 path
+				 contents
+				 umask)
   (with-remote-temporary-file (temp)
-    (connection-run conn #?"cat >${temp}" contents)
-    (connection-run
-     conn
-     #?"mv ${(escape-sh-token temp)} ${(escape-sh-token path)}"
-     nil)))
+    (connection-run conn
+		    (if umask
+			(format nil "( umask ~O; cat >~A )" umask temp)
+			#?"cat >${temp}")
+		    contents)
+    (connection-run conn
+		    #?"mv ${(escape-sh-token temp)} ${(escape-sh-token path)}"
+		    nil)))