From ce167652a1839426a786cc35c4cc85948fee2a02 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 20 May 2021 23:05:25 -0700 Subject: 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 --- src/data.lisp | 38 +++++++++++++++++++++++++++++++++++--- src/package.lisp | 1 + src/property.lisp | 6 +++--- src/property/file.lisp | 6 ++---- 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 -- cgit v1.2.3