diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-06 15:02:28 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-06 15:57:19 -0700 |
commit | 17a990340aa1e77b4b2b890032aa171e407739ad (patch) | |
tree | 80f8ef247888df066f34a4f111977e483e15f7d2 | |
parent | c10312f2f603b0be1d82fbcb7bded518f4111810 (diff) | |
download | consfigurator-17a990340aa1e77b4b2b890032aa171e407739ad.tar.gz |
CONNECTION-WRITEFILE: deal in modes rather than umasks
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/connection.lisp | 21 | ||||
-rw-r--r-- | src/connection/local.lisp | 42 | ||||
-rw-r--r-- | src/connection/shell-wrap.lisp | 21 | ||||
-rw-r--r-- | src/package.lisp | 2 |
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 |