aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2022-04-02 14:06:53 -0700
committerSean Whitton <spwhitton@spwhitton.name>2022-04-02 14:08:56 -0700
commit159ff0bda5c67767599509313468c157118ad70e (patch)
treec53e8a3cbfbb879afa2f49407d3c8bfdb38d9aac /src
parent8f8c59341e7f420397f79d47af2787ca55fba07b (diff)
downloadconsfigurator-159ff0bda5c67767599509313468c157118ad70e.tar.gz
rename READFILE, WRITEFILE, corresponding generics and some wrappers
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src')
-rw-r--r--src/connection.lisp79
-rw-r--r--src/connection/local.lisp12
-rw-r--r--src/connection/shell-wrap.lisp12
-rw-r--r--src/connection/sudo.lisp6
-rw-r--r--src/data.lisp22
-rw-r--r--src/package.lisp14
-rw-r--r--src/property.lisp11
-rw-r--r--src/property/disk.lisp4
-rw-r--r--src/property/file.lisp17
-rw-r--r--src/property/sshd.lisp2
-rw-r--r--src/property/user.lisp2
11 files changed, 94 insertions, 87 deletions
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)