diff options
| -rw-r--r-- | doc/connections.rst | 8 | ||||
| -rw-r--r-- | doc/ideas.rst | 8 | ||||
| -rw-r--r-- | doc/properties.rst | 16 | ||||
| -rw-r--r-- | src/connection.lisp | 79 | ||||
| -rw-r--r-- | src/connection/local.lisp | 12 | ||||
| -rw-r--r-- | src/connection/shell-wrap.lisp | 12 | ||||
| -rw-r--r-- | src/connection/sudo.lisp | 6 | ||||
| -rw-r--r-- | src/data.lisp | 22 | ||||
| -rw-r--r-- | src/package.lisp | 14 | ||||
| -rw-r--r-- | src/property.lisp | 11 | ||||
| -rw-r--r-- | src/property/disk.lisp | 4 | ||||
| -rw-r--r-- | src/property/file.lisp | 17 | ||||
| -rw-r--r-- | src/property/sshd.lisp | 2 | ||||
| -rw-r--r-- | src/property/user.lisp | 2 |
14 files changed, 111 insertions, 102 deletions
diff --git a/doc/connections.rst b/doc/connections.rst index 236df5b..d03d3a8 100644 --- a/doc/connections.rst +++ b/doc/connections.rst @@ -37,10 +37,10 @@ Defining connection types The code which establishes connections (i.e., implementations of the ``ESTABLISH-CONNECTION`` generic) is like code in ``:posix`` properties -- it -should restrict its I/O to ``RUN``, ``RUNLINES``, ``READFILE`` and -``WRITEFILE``, functions which access the currently active connection. This -is in order to permit the arbitrary nesting of connections. If establishing a -connection really does require more I/O, such as in the case of +should restrict its I/O to ``RUN``, ``RUNLINES``, ``READ-REMOTE-FILE`` and +``WRITE-REMOTE-FILE``, functions which access the currently active connection. +This is in order to permit the arbitrary nesting of connections. If +establishing a connection really does require more I/O, such as in the case of ``:CHROOT.FORK`` connections, code can call ``LISP-CONNECTION-P``, and either signal an error, or fall back to another connection type. diff --git a/doc/ideas.rst b/doc/ideas.rst index 80dbcc7..2b9fa25 100644 --- a/doc/ideas.rst +++ b/doc/ideas.rst @@ -14,10 +14,10 @@ Connections - Basic infrastructure for connections which work with just input and output streams connected to an interactive POSIX sh somewhere, like TRAMP, and - probably using ``base64 -d`` for WRITEFILE. Probably the basic connection - type will take a command to start up the shell as a keyword argument, and - then we can have more specific connection types which take other arguments - and construct the full command. + probably using ``base64 -d`` for WRITE-REMOTE-FILE. Probably the basic + connection type will take a command to start up the shell as a keyword + argument, and then we can have more specific connection types which take + other arguments and construct the full command. - It might be possible to write an implementation of CONNECTION-UPLOAD for SSH-CONNECTION which can optimise a common case. If it can see that it is diff --git a/doc/properties.rst b/doc/properties.rst index 01a5919..ccd40dd 100644 --- a/doc/properties.rst +++ b/doc/properties.rst @@ -18,9 +18,10 @@ Except where specified otherwise in property docstrings, relative paths are relative to the remote home directory. ``:LISP`` properties may assume they will be executed in the remote home directory, and ``:POSIX`` properties may assume that commands will be executed in the remote home directory, and that -relative paths passed to ``READFILE`` and ``WRITEFILE`` are relative to the -remote home directory. Use ``WITH-REMOTE-CURRENT-DIRECTORY`` to change the -remote working directory in a way which ensures it will get changed back. +relative paths passed to ``READ-REMOTE-FILE`` and ``WRITE-REMOTE-FILE`` are +relative to the remote home directory. Use ``WITH-REMOTE-CURRENT-DIRECTORY`` +to change the remote working directory in a way which ensures it will get +changed back. Property subroutines -------------------- @@ -98,14 +99,15 @@ Errors in attempting to apply a property are indicated by signalling a ``:posix`` properties should not make any assumptions about what localhost is -- they may be running in the root Lisp, but they might be running in a Lisp image running on an intermediary host, or even on the host to be configured. -They should perform I/O only by calling ``RUN``, ``RUNLINES``, ``READFILE``, -``WRITEFILE``, requesting prerequisite data, and applying or unapplying other -``:posix`` properties. Otherwise, they should be pure functions. +They should perform I/O only by calling ``RUN``, ``RUNLINES``, +``READ-REMOTE-FILE``, ``WRITE-REMOTE-FILE``, requesting prerequisite data, and +applying or unapplying other ``:posix`` properties. Otherwise, they should be +pure functions. ``:lisp`` properties, by contrast, may (and should) assume that they are running in a Lisp image on the host to which they are to be applied, so they can perform arbitrary I/O in that context. They can also make use of ``RUN``, -``RUNLINES``, ``READFILE`` and ``WRITEFILE`` if desired. +``RUNLINES``, ``READ-REMOTE-FILE`` and ``WRITE-REMOTE-FILE`` if desired. ``:posix`` properties are characterised by the limited set of ways in which they perform I/O, not by the use of only facilities defined in the Single UNIX diff --git a/src/connection.lisp b/src/connection.lisp index 914c197..2253e08 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -98,36 +98,36 @@ error condition just because EXIT is non-zero.")) (let ((*connection* (slot-value connection 'parent))) (call-next-method))) -(defgeneric connection-readfile (connection path) +(defgeneric connection-read-file (connection path) (:documentation "Subroutine to read the contents of files on the host.")) -(defmethod connection-readfile :around ((connection connection) path) +(defmethod connection-read-file :around ((connection connection) path) (declare (ignore path)) (let ((*connection* (slot-value connection 'parent))) (call-next-method))) -(defgeneric connection-readfile-and-remove (connection path) - (:documentation "As READFILE and then delete the file. +(defgeneric connection-read-and-remove-file (connection path) + (:documentation "As READ-REMOTE-FILE and then delete the file. For some connection types, when latency is high, combining these two operations is noticeably faster than doing one after the other. For every use of RUN we read and delete the file containing the command's stdout, so the time savings add up.")) -(defmethod connection-readfile-and-remove +(defmethod connection-read-and-remove-file :around ((connection connection) path) (let ((*connection* (slot-value connection 'parent))) (call-next-method))) -(defmethod connection-readfile-and-remove ((connection connection) path) - (prog1 (connection-readfile connection path) +(defmethod connection-read-and-remove-file ((connection connection) path) + (prog1 (connection-read-file connection path) (connection-run connection (strcat "rm " (sh-escape path)) nil))) -;; only functional difference between WRITEFILE and UPLOAD is what args they -;; take: a string vs. a path. for a given connection type, they may have same -;; or different implementations. +;; only functional difference between WRITE-REMOTE-FILE and UPLOAD is what +;; args they 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-write-file (connection path content mode) (:documentation "Subroutine to replace/create the contents of files on the host. @@ -145,10 +145,10 @@ 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 - mode) +(defmethod connection-write-file :around ((connection connection) + path + content + mode) (declare (ignore path content mode)) (let ((*connection* (slot-value connection 'parent))) (call-next-method))) @@ -261,9 +261,9 @@ login(1)). Tilde expansion works correctly." ;;;; Functions to access the slots of the current connection ;; Used by properties and by implementations of ESTABLISH-CONNECTION. This is -;; the only code that ever call CONNECTION-RUN, CONNECTION-READFILE and -;; CONNECTION-WRITEFILE directly (except that it might make sense for -;; implementations of CONNECTION-READFILE and CONNECTION-WRITEFILE to call +;; the only code that ever call CONNECTION-RUN, CONNECTION-READ-FILE and +;; CONNECTION-WRITE-FILE directly (except that it might make sense for +;; implementations of CONNECTION-READ-FILE and CONNECTION-WRITE-FILE to call ;; their corresponding implementation of CONNECTION-RUN). (define-condition run-failed (error) @@ -357,9 +357,10 @@ fi") (defmacro with-remote-current-directory ((dir) &body forms) "Execute FORMS with the current working directory DIR. This affects the working directory for commands run using RUN and MRUN, and -the resolution of relative pathnames passed as the first argument of READFILE -and WRITEFILE. For Lisp-type connections, it additionally temporarily sets -the working directory of the Lisp process using UIOP:WITH-CURRENT-DIRECTORY." +the resolution of relative pathnames passed as the first argument of +READ-REMOTE-FILE and WRITE-REMOTE-FILE. For Lisp-type connections, it +additionally temporarily sets the working directory of the Lisp process using +UIOP:WITH-CURRENT-DIRECTORY." (with-gensyms (previous new) `(let ((,previous (get-connattr 'current-directory)) (,new (ensure-pathname ,dir @@ -479,7 +480,7 @@ case return only the exit code." (multiple-value-bind (err exit) (connection-run *connection* wrapped input) (setq err (lines err) stdout (car err) err (unlines (cdr err))) - (let ((out (connection-readfile-and-remove *connection* stdout))) + (let ((out (connection-read-and-remove-file *connection* stdout))) (when inform (informat 1 "~& % ~A~%~{ ~A~%~}" (if (> *consfigurator-debug-level* 4) wrapped cmd) @@ -496,7 +497,7 @@ that this might mean interleaved or simply concatenated, depending on the connection chain). Some (but not all) connection types will want to use this when implementing -ESTABLISH-CONNECTION, CONNECTION-RUN, CONNECTION-WRITEFILE etc. to avoid the +ESTABLISH-CONNECTION, CONNECTION-RUN, CONNECTION-WRITE-FILE etc. to avoid the overhead of splitting the output streams only to immediately recombine them. Code in property definitions which will not examine command output should @@ -611,8 +612,8 @@ specification of POSIX ls(1))." (defun remote-executable-find (executable) (zerop (mrun :for-exit "command" "-v" executable))) -(defun readfile (path) - (connection-readfile +(defun read-remote-file (path) + (connection-read-file *connection* (unix-namestring (ensure-pathname path @@ -620,17 +621,18 @@ specification of POSIX ls(1))." :defaults (pwd) :ensure-absolute t)))) -(defun writefile (path content - &key (mode #o644 mode-supplied-p) - &aux (pathname (ensure-pathname path - :namestring :unix - :defaults (pwd) - :ensure-absolute t)) - (namestring (unix-namestring pathname))) +(defun write-remote-file (path content + &key (mode #o644 mode-supplied-p) + &aux (pathname (ensure-pathname path + :namestring :unix + :defaults (pwd) + :ensure-absolute t)) + (namestring (unix-namestring pathname))) ;; 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. + ;; us, we could (have a keyword argument to) bypass CONNECTION-WRITE-FILE + ;; 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 (remote-exists-p pathname) @@ -642,20 +644,21 @@ specification of POSIX ls(1))." (run :env '(:LOCALE "C") "ls" "-nd" pathname)) (unless match (error - "WRITEFILE could not determine ownership and mode of ~A" pathname)) + "WRITE-REMOTE-FILE could not determine ownership and mode of ~A" + pathname)) (let ((umode (dehyphen (elt groups 0))) (gmode (dehyphen (elt groups 1))) (omode (dehyphen (elt groups 2))) (uid (elt groups 3)) (gid (elt groups 4))) - (connection-writefile *connection* namestring content mode) + (connection-write-file *connection* namestring content mode) (let ((namestring (sh-escape 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-write-file *connection* namestring content mode))) (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 2c79036..d8a6880 100644 --- a/src/connection/local.lisp +++ b/src/connection/local.lisp @@ -42,16 +42,16 @@ (declare (ignore _)) (values output exit-code))) -(defmethod connection-readfile ((connection local-connection) path) +(defmethod connection-read-file ((connection local-connection) path) (read-file-string path)) -(defmethod connection-readfile-and-remove ((connection local-connection) path) +(defmethod connection-read-and-remove-file ((connection local-connection) path) (prog1 (read-file-string path) (delete-file path))) -(defmethod connection-writefile ((connection local-connection) - path - content - mode) +(defmethod connection-write-file ((connection local-connection) + path + content + mode) ;; 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 diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp index 2867e20..51591b8 100644 --- a/src/connection/shell-wrap.lisp +++ b/src/connection/shell-wrap.lisp @@ -36,16 +36,16 @@ out (error "Could not read~:[~; and/or remove~] ~S" delete path)))) -(defmethod connection-readfile ((c shell-wrap-connection) path) +(defmethod connection-read-file ((c shell-wrap-connection) path) (%readfile c path)) -(defmethod connection-readfile-and-remove ((c shell-wrap-connection) path) +(defmethod connection-read-and-remove-file ((c shell-wrap-connection) path) (%readfile c path t)) -(defmethod connection-writefile ((conn shell-wrap-connection) - path - content - mode) +(defmethod connection-write-file ((conn shell-wrap-connection) + path + content + mode) (let ((cmd (format nil "set -e diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp index a8fa3dc..cbdf259 100644 --- a/src/connection/sudo.lisp +++ b/src/connection/sudo.lisp @@ -66,9 +66,9 @@ ;; We'll send the password followed by ^M, then the ;; real stdin. Use CODE-CHAR in this way so that we ;; can be sure ASCII ^M is what will get emitted. - (writefile it (strcat (passphrase password) - (string (code-char 13))) - :mode #o600))))) + (write-remote-file it (strcat (passphrase password) + (string (code-char 13))) + :mode #o600))))) (defmethod connection-tear-down :after ((connection sudo-connection)) (when-let ((file (slot-value connection 'password-file))) diff --git a/src/data.lisp b/src/data.lisp index 492c886..36dc0ce 100644 --- a/src/data.lisp +++ b/src/data.lisp @@ -261,14 +261,16 @@ This function is for implementation of REGISTER-DATA-SOURCE to check for clashes. It should not be called by properties." (if (query-data-sources iden1 iden2) t nil)) -(defun maybe-writefile-data (path iden1 iden2 &key (mode nil mode-supplied-p)) - "Wrapper around WRITEFILE which returns :NO-CHANGE and avoids touching PATH if -PATH's content is already the prerequisite data identified by IDEN1 and IDEN2 -and PATH has mode MODE." +(defun maybe-write-remote-file-data + (path iden1 iden2 &key (mode nil mode-supplied-p)) + "Wrapper around WRITE-REMOTE-FILE which returns :NO-CHANGE and avoids touching +PATH if PATH's content is already the prerequisite data identified by IDEN1 +and IDEN2 and PATH has mode MODE." (let ((data (funcall (%get-data iden1 iden2)))) (etypecase data - (string-data (apply #'maybe-writefile-string path (data-string data) - (and mode-supplied-p `(:mode ,mode)))) + (string-data + (apply #'maybe-write-remote-file-string path (data-string data) + (and mode-supplied-p `(:mode ,mode)))) (file-data (let ((stream (%get-data-stream data))) (if (and (remote-exists-p path) @@ -278,21 +280,21 @@ and PATH has mode MODE." (= (file-length stream) existing-size) (= (data-cksum data) (cksum path))))) :no-change - (apply #'writefile path stream + (apply #'write-remote-file path stream (and mode-supplied-p `(:mode ,mode))))))))) (defgeneric connection-upload (connection data) (:documentation "Subroutine to upload an item of prerequisite data to the remote cache. The default implementation will work for any connection which implements -CONNECTION-WRITEFILE and CONNECTION-RUN, but connection types which work by +CONNECTION-WRITE-FILE and CONNECTION-RUN, but connection types which work by calling CONTINUE-DEPLOY* or CONTINUE-DEPLOY*-PROGRAM will need their own implementation.")) (defmethod connection-upload ((connection connection) (data data)) (flet ((upload (from to) (with-open-file (stream from :element-type '(unsigned-byte 8)) - (writefile to stream)))) + (write-remote-file to stream)))) (with-slots (iden1 iden2 data-version) data (informat 1 "~&Uploading (~@{~S~^ ~}) ... " iden1 iden2 data-version) (let* ((*connection* connection) @@ -303,7 +305,7 @@ implementation.")) (with-remote-current-directory (destdir) (etypecase data (string-data - (writefile destfile (data-string data))) + (write-remote-file destfile (data-string data))) (file-data (let ((source (unix-namestring (data-file data)))) (if (string-prefix-p "text/" (data-mime data)) diff --git a/src/package.lisp b/src/package.lisp index 3c8c52a..77d3295 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -158,9 +158,9 @@ #:connection-parent #:lisp-connection-p #:connection-run - #:connection-readfile - #:connection-readfile-and-remove - #:connection-writefile + #:connection-read-file + #:connection-read-and-remove-file + #:connection-write-file #:connection-tear-down #:connection-connattr #:propagate-connattr @@ -185,8 +185,8 @@ #:remote-mount-point-p #:delete-remote-trees #:empty-remote-directory - #:readfile - #:writefile + #:read-remote-file + #:write-remote-file #:get-connattr #:with-connattrs @@ -217,7 +217,7 @@ #:failed-change #:aborted-change #:assert-euid-root - #:maybe-writefile-string + #:maybe-write-remote-file-string #:with-change-if-changes-file #:with-change-if-changes-files #:with-change-if-changes-file-content @@ -301,7 +301,7 @@ #:file-data #:data-file #:data-source-providing-p - #:maybe-writefile-data + #:maybe-write-remote-file-data #:missing-data-source #:data-pathname #:local-data-pathname diff --git a/src/property.lisp b/src/property.lisp index 587f757..3987764 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -575,17 +575,18 @@ the actual state of the host but without making any changes. Not to be confused with INAPPLICABLE-PROPERTY.") -(defun maybe-writefile-string (path content &key (mode nil mode-supplied-p)) - "Wrapper around WRITEFILE which returns :NO-CHANGE and avoids writing PATH if -PATH already has the specified CONTENT and MODE." +(defun maybe-write-remote-file-string + (path content &key (mode nil mode-supplied-p)) + "Wrapper around WRITE-REMOTE-FILE which returns :NO-CHANGE and avoids writing +PATH if PATH already has the specified CONTENT and MODE." (if (and (remote-exists-p path) (multiple-value-bind (existing-mode existing-size) (remote-file-stats path) (and (or (not mode-supplied-p) (= mode existing-mode)) (and (>= (* 4 (length content)) existing-size) - (string= (readfile path) content))))) + (string= (read-remote-file path) content))))) :no-change - (apply #'writefile + (apply #'write-remote-file path content (and mode-supplied-p `(:mode ,mode))))) (defun assert-euid-root () diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 5616bd9..fd0df1b 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -948,8 +948,8 @@ filesystems will be incrementally updated when other properties change." (:apply (file:does-not-exist image) (with-remote-temporary-file (excludes) - (writefile excludes - (format nil "~@{~&~A~}" "/boot" "/proc" "/dev" "/sys" "/run")) + (write-remote-file + excludes (format nil "~@{~&~A~}" "/boot" "/proc" "/dev" "/sys" "/run")) (run :inform "nice" "mksquashfs" chroot image "-no-progress" "-comp" compression "-ef" excludes)))) diff --git a/src/property/file.lisp b/src/property/file.lisp index 51f7083..324049b 100644 --- a/src/property/file.lisp +++ b/src/property/file.lisp @@ -22,12 +22,13 @@ "Apply FUNCTION to the lines of FILE. Safe to use in a :POSIX property. For efficiency, a :LISP property might want to use streams, but there's no -point in doing that here because WRITEFILE is synchronous." - (let* ((orig-lines (and (remote-exists-p file) (lines (readfile file)))) +point in doing that here because WRITE-REMOTE-FILE is synchronous." + (let* ((orig-lines (and (remote-exists-p file) + (lines (read-remote-file file)))) (new-lines (funcall function orig-lines))) (if (equal orig-lines new-lines) :no-change - (writefile file (unlines new-lines))))) + (write-remote-file file (unlines new-lines))))) (defprop has-content :posix (path content &key (mode nil mode-supplied-p)) "Ensure there is a file at PATH whose content is CONTENT. @@ -36,7 +37,7 @@ CONTENT can be a list of lines or a single string." (:desc (declare (ignore content mode mode-supplied-p)) #?"${path} has defined content") (:apply (unless mode-supplied-p (containing-directory-exists path)) - (apply #'maybe-writefile-string + (apply #'maybe-write-remote-file-string path (etypecase content (list @@ -71,11 +72,11 @@ replacing the contents of existing files, prefer FILE:HAS-CONTENT." (containing-directory-exists path) (let ((new-lines (copy-list (ensure-cons lines))) (existing-lines (and (remote-exists-p path) - (lines (readfile path))))) + (lines (read-remote-file path))))) (dolist (existing-line existing-lines) (deletef new-lines existing-line :test #'string=)) (if new-lines - (writefile path (unlines (nconc existing-lines new-lines))) + (write-remote-file path (unlines (nconc existing-lines new-lines))) :no-change)))) (defprop lacks-lines :posix (path &rest lines) @@ -146,7 +147,7 @@ any of the regular expressions PATTERNS." (require-data iden1 iden2)) (:apply (containing-directory-exists destination) - (maybe-writefile-data destination iden1 iden2))) + (maybe-write-remote-file-data destination iden1 iden2))) (defproplist host-data-uploaded :posix (destination @@ -162,7 +163,7 @@ any of the regular expressions PATTERNS." (declare (ignore destination)) (require-data iden1 iden2)) (:apply - (maybe-writefile-data destination iden1 iden2 :mode #o600))) + (maybe-write-remote-file-data destination iden1 iden2 :mode #o600))) (defproplist host-secret-uploaded :posix (destination diff --git a/src/property/sshd.lisp b/src/property/sshd.lisp index e4c1061..ba224e0 100644 --- a/src/property/sshd.lisp +++ b/src/property/sshd.lisp @@ -43,7 +43,7 @@ refuses to proceed if root has no authorized_keys." (:apply (assert-euid-root) (unless (and (remote-exists-p ".ssh/authorized_keys") - (plusp (length (readfile ".ssh/authorized_keys")))) + (plusp (length (read-remote-file ".ssh/authorized_keys")))) (failed-change "root has no authorized_keys")) (configured "PermitRootLogin" "prohibit-password" "PasswordAuthentication" "no"))) diff --git a/src/property/user.lisp b/src/property/user.lisp index 6bc87d8..1a49e5d 100644 --- a/src/property/user.lisp +++ b/src/property/user.lisp @@ -77,7 +77,7 @@ the installation of other software." (:hostattrs (os:required 'os:debianlike)) (:apply (let ((existing-groups - (loop for line in (lines (readfile "/etc/group")) + (loop for line in (lines (read-remote-file "/etc/group")) collect (car (split-string line :separator ":"))))) (apply #'has-groups username (loop for group in *desktop-groups* when (memstr= group existing-groups) |