Have the coordinator report on the outputs that are being hashed

As this is useful to observe since it can take a long time for large outputs.

1 files changed, 48 insertions, 1 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 8e27f53..9d7482c 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -19,6 +19,7 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-build-coordinator agent-messaging http server)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-71)
@@ -276,6 +277,16 @@ port. Also, the port used can be changed by passing the --port option.\n"
                               `((event . ,(assq-ref event-count 'event)))))
                 (datastore-count-unprocessed-hook-events datastore)))))
 
+
+(define-record-type <hash-progress>
+  (make-hash-progress build-uuid file size bytes-hashed)
+  hash-progress?
+  (build-uuid    hash-progress-build-uuid)
+  (file          hash-progress-file)
+  (size          hash-progress-size)
+  (bytes-hashed  hash-progress-bytes-hashed
+                 set-hash-progress-bytes-hashed!))
+
 (define (make-output-hash-channel build-coordinator)
   (define logger
     (build-coordinator-logger build-coordinator))
@@ -341,7 +352,29 @@ port. Also, the port used can be changed by passing the --port option.\n"
 
   (let ((channel (make-channel))
         (update-channels-by-filename
+         (make-hash-table))
+        (hash-progress-by-filename
          (make-hash-table)))
+    (define display-info
+      (rate-limited
+       (lambda ()
+         (hash-for-each
+          (lambda (filename progress)
+            (match progress
+              (($ <hash-progress> build-uuid filename size
+                                  bytes-hashed)
+               (log-msg logger 'DEBUG build-uuid ": hashing " filename
+                        (if (= size bytes-hashed)
+                            " finished"
+                            "")
+                        (format
+                         #f
+                         " ~2,2f/~2,2fMB"
+                         (/ bytes-hashed 1000000)
+                         (/ size 1000000))))))
+          hash-progress-by-filename))
+       (make-time time-duration 0 30)))
+
     (call-with-new-thread
      (lambda ()
        (while #t
@@ -349,6 +382,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (lambda (exn)
                (log-msg 'ERROR "exception in output hash thread: " exn))
            (lambda ()
+             (display-info)
+
              (match (get-message channel)
                (('request build-uuid filename output-filename update-channel)
                 (or (and=>
@@ -364,6 +399,14 @@ port. Also, the port used can be changed by passing the --port option.\n"
                                  filename
                                  (list update-channel))
 
+                      (hash-set! hash-progress-by-filename
+                                 filename
+                                 (make-hash-progress
+                                  build-uuid
+                                  filename
+                                  (stat:size (stat filename))
+                                  0))
+
                       (call-with-new-thread
                        (lambda ()
                          (set-thread-name "hash output")
@@ -377,6 +420,9 @@ port. Also, the port used can be changed by passing the --port option.\n"
                                                                  filename
                                                                  output-filename))))))))
                (('update filename bytes-processed)
+                (set-hash-progress-bytes-hashed!
+                 (hash-ref hash-progress-by-filename filename)
+                 bytes-processed)
                 (for-each
                  (lambda (update-channel)
                    (spawn-fiber
@@ -401,7 +447,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     #:parallel? #t))
                  (hash-ref update-channels-by-filename filename))
 
-                (hash-remove! update-channels-by-filename filename))))
+                (hash-remove! update-channels-by-filename filename)
+                (hash-remove! hash-progress-by-filename filename))))
            #:unwind? #t))))
     channel))