ssh: 'send-files' displays a progress bar.

* guix/store.scm (export-paths): Add #:start, #:progress, and #:finish
parameters and honor them.
* guix/ssh.scm (prepare-to-send, notify-transfer-progress)
(notify-transfer-completion): New procedures.
(send-files): Pass #:start, #:progress, and #:finish to 'export-paths'.

1 files changed, 20 insertions, 4 deletions

diff --git a/guix/store.scm b/guix/store.scm
index 495dc1692c..6bb6f43f56 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1728,10 +1728,20 @@ is raised if the set of paths read from PORT is not signed (as per
       (or done? (loop (process-stderr server port))))
     (= 1 (read-int s))))
 
-(define* (export-paths server paths port #:key (sign? #t) recursive?)
+(define* (export-paths server paths port #:key (sign? #t) recursive?
+                       (start (const #f))
+                       (progress (const #f))
+                       (finish (const #f)))
   "Export the store paths listed in PATHS to PORT, in topological order,
 signing them if SIGN? is true.  When RECURSIVE? is true, export the closure of
-PATHS---i.e., PATHS and all their dependencies."
+PATHS---i.e., PATHS and all their dependencies.
+
+START, PROGRESS, and FINISH are used to track progress of the data transfer.
+START is a one-argument that is passed the list of store items that will be
+transferred; it returns values that are then used as the initial state
+threaded through PROGRESS calls.  PROGRESS is passed the store item about to
+be sent, along with the values previously return by START or by PROGRESS
+itself.  FINISH is called when the last store item has been called."
   (define ordered
     (let ((sorted (topologically-sorted server paths)))
       ;; When RECURSIVE? is #f, filter out the references of PATHS.
@@ -1739,14 +1749,20 @@ PATHS---i.e., PATHS and all their dependencies."
           sorted
           (filter (cut member <> paths) sorted))))
 
-  (let loop ((paths ordered))
+  (let loop ((paths ordered)
+             (state (call-with-values (lambda () (start ordered))
+                      list)))
     (match paths
       (()
+       (apply finish state)
        (write-int 0 port))
       ((head tail ...)
        (write-int 1 port)
        (and (export-path server head port #:sign? sign?)
-            (loop tail))))))
+            (loop tail
+                  (call-with-values
+                      (lambda () (apply progress head state))
+                    list)))))))
 
 (define-operation (query-failed-paths)
   "Return the list of store items for which a build failure is cached.