FILE:DATA-UPLOADED, FILE:SECRET-UPLOADED: use MAYBE-WRITEFILE-DATA

This avoids writing the file every deploy, even when unchanged.

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

4 files changed, 41 insertions, 10 deletions

diff --git a/src/data.lisp b/src/data.lisp
index eb1458f..aa78711 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -49,12 +49,24 @@ prerequisite data."))
    "An item of prerequisite data directly accessible to Lisp."))
 
 (defclass file-data (data)
-  ((data-file
-    :initarg :file
-    :reader data-file))
+  ((data-cksum :initarg :cksum)
+   (data-file :initarg :file :reader data-file))
   (:documentation
    "An item of prerequisite data accessible via the filesystem."))
 
+(defgeneric data-cksum (data)
+  (:documentation
+   "Return a CRC checksum for the data as calculated by POSIX cksum(1).")
+  (:method ((data file-data))
+    (if (slot-boundp data 'data-cksum)
+        (slot-value data 'data-cksum)
+        (setf (slot-value data 'data-cksum)
+              (parse-integer
+               (car
+                (split-string
+                 (run-program
+                  `("cksum" ,(data-file data)) :output :string))))))))
+
 ;; If this proves to be inadequate then an alternative would be to maintain a
 ;; mapping of ASDF systems to data sources, and then DEPLOY* could look up the
 ;; data sources registered for the systems in (slot-value (slot-value host
@@ -247,6 +259,26 @@ 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."
+  (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))))
+      (file-data
+       (let ((stream (%get-data-stream data)))
+         (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))
+                         (= (file-length stream) existing-size)
+                         (= (data-cksum data) (cksum path)))))
+             :no-change
+             (apply #'writefile 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.
diff --git a/src/package.lisp b/src/package.lisp
index 8ec1f9e..4afd998 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -225,6 +225,7 @@
            #:file-data
            #:data-file
 	   #:data-source-providing-p
+           #:maybe-writefile-data
            #:missing-data-source
            #:data-pathname
 	   #:local-data-pathname
diff --git a/src/property.lisp b/src/property.lisp
index cf97e58..cf213b8 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -527,13 +527,13 @@ PATH already has the specified CONTENT and MODE."
      "Cannot apply :LISP properties using a POSIX-type connection")))
 
 (defun cksum (file)
-  (ignore-errors (parse-integer (car (split-string (run "cksum" file))))))
+  (parse-integer (car (split-string (run "cksum" file)))))
 
 ;; this is a safe parse of ls(1) output given its POSIX specification
 (defun ls-cksum (file)
   (let ((ls (ignore-errors
              (split-string (run :env '(:LOCALE "C") "ls" "-dlL" file))))
-        (cksum (cksum file)))
+        (cksum (ignore-errors (cksum file))))
     (when (and ls cksum)
       (list* (car ls) cksum (subseq ls 2 8)))))
 
@@ -553,7 +553,7 @@ changes in properties which will change the file but not the output of `ls
 (defmacro with-change-if-changes-file-content ((file) &body forms)
   "Execute FORMS and yield :NO-CHANGE if FILE has the same content afterwards."
   (with-gensyms (before)
-    `(let* ((,before (cksum ,file))
+    `(let* ((,before (ignore-errors (cksum ,file)))
             (result (progn ,@forms)))
        (if (and ,before (eql ,before (cksum ,file)))
            :no-change result))))
diff --git a/src/property/file.lisp b/src/property/file.lisp
index 7136db9..7418855 100644
--- a/src/property/file.lisp
+++ b/src/property/file.lisp
@@ -83,8 +83,7 @@ CONTENT can be a list of lines or a single string."
   (:apply
    (let ((destination (ensure-pathname destination :namestring :unix)))
      (directory-exists (pathname-directory-pathname destination))
-     (with-change-if-changes-file-content (destination)
-       (writefile destination (get-data-stream iden1 iden2))))))
+     (maybe-writefile-data destination iden1 iden2))))
 
 (defprop host-data-uploaded :posix (destination)
   (:hostattrs
@@ -99,8 +98,7 @@ CONTENT can be a list of lines or a single string."
   (:apply
    (let ((destination (ensure-pathname destination :namestring :unix)))
      (directory-exists (pathname-directory-pathname destination))
-     (with-change-if-changes-file-content (destination)
-       (writefile destination (get-data-stream iden1 iden2) :mode #o600)))))
+     (maybe-writefile-data destination iden1 iden2 :mode #o600))))
 
 (defprop host-secret-uploaded :posix (destination)
   (:hostattrs