diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-20 23:03:01 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-20 23:03:01 -0700 |
commit | df8a09e78b92aa04bd2a95232c23670c573d5460 (patch) | |
tree | ddb4830102d1a9264084bb196d175a6b14d042ef | |
parent | b9cb1eafb5b5ad4b081730ee7e5f05687b126e45 (diff) | |
download | consfigurator-df8a09e78b92aa04bd2a95232c23670c573d5460.tar.gz |
factor out MAYBE-WRITEFILE-STRING
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/package.lisp | 1 | ||||
-rw-r--r-- | src/property.lisp | 13 | ||||
-rw-r--r-- | src/property/file.lisp | 19 |
3 files changed, 20 insertions, 13 deletions
diff --git a/src/package.lisp b/src/package.lisp index a0a5f9f..b90654f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -151,6 +151,7 @@ #:assert-euid-root #:get-user #:assert-connection-supports + #:maybe-writefile-string #:call-with-os #:with-change-if-changes-file #:with-change-if-changes-file-content diff --git a/src/property.lisp b/src/property.lisp index 49e1a6a..cf97e58 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -485,6 +485,19 @@ Called by property subroutines." "Signal problems with the connection and errors while actually attempting to apply or unapply properties.") +(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." + (if (and (remote-exists-p path) + (multiple-value-bind (existing-mode existing-size) + (remote-file-mode-and-size path) + (and (or (not mode-supplied-p) (= mode existing-mode)) + (and (>= (* 4 (length content)) existing-size) + (string= (readfile path) content))))) + :no-change + (apply #'writefile + path content (and mode-supplied-p `(:mode ,mode))))) + (defun call-with-os (f &rest args) (apply (ensure-function f) (get-hostattrs-car :os) args)) diff --git a/src/property/file.lisp b/src/property/file.lisp index 9d23446..c49a703 100644 --- a/src/property/file.lisp +++ b/src/property/file.lisp @@ -35,19 +35,12 @@ CONTENT can be a list of lines or a single string." (declare (indent 1)) (:desc (declare (ignore content mode mode-supplied-p)) #?"${path} has defined content") - (:apply (let ((content (etypecase content - (cons (unlines content)) - (string (format nil "~A~&" content))))) - (if (and (remote-exists-p path) - (multiple-value-bind (existing-mode existing-size) - (remote-file-mode-and-size path) - (and (or (not mode-supplied-p) (= existing-mode mode)) - ;; Avoid downloading arbitrarily large files. - (>= (* 4 (length content)) existing-size) - (string= (readfile path) content)))) - :no-change - (apply #'writefile - path content (and mode-supplied-p `(:mode ,mode))))))) + (:apply (apply #'maybe-writefile-string + path + (etypecase content + (cons (unlines content)) + (string (format nil "~A~&" content))) + (and mode-supplied-p `(:mode ,mode))))) (defprop contains-lines :posix (path &rest lines) "Ensure there is a file at PATH containing each of LINES once." |