factor out MAYBE-WRITEFILE-STRING

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

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."