Improve the logging from the agent -> coordinator communication

1 files changed, 30 insertions, 8 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index b5180e2..656cfc3 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -59,7 +59,8 @@
     (let ((received-builds
            (fetch-builds-for-agent coordinator-uri uuid password
                                    systems
-                                   max-count)))
+                                   max-count
+                                   #:log (build-log-procedure lgr))))
       (log-msg lgr 'INFO
                "have " current-count
                " builds, max " max-count
@@ -89,7 +90,8 @@
                          ": setup successful, building: "
                          derivation-name)
                 (report-build-start coordinator-uri uuid password
-                                    build-id)
+                                    build-id
+                                    #:log (build-log-procedure lgr build-id))
                 (let* ((result (perform-build lgr store build-id derivation-name))
                        ;; TODO Check this handles timezones right
                        (end-time (localtime (current-time) "UTC")))
@@ -112,7 +114,9 @@
                          (assq-ref pre-build-status 'failure_reason))
                 (report-setup-failure coordinator-uri uuid password
                                       build-id
-                                      pre-build-status)))))))
+                                      pre-build-status
+                                      #:log (build-log-procedure lgr
+                                                                 build-id))))))))
 
   (add-handler! lgr port-log)
   (open-log! lgr)
@@ -120,7 +124,9 @@
   (let-values (((process-job-with-queue count-jobs)
                 (create-work-queue max-parallel-builds
                                    process-job)))
-    (let ((details (submit-status coordinator-uri uuid password 'idle)))
+    (let ((details (submit-status coordinator-uri uuid password 'idle
+                                  #:log (build-log-procedure
+                                         (assoc-ref build "uuid")))))
       (let* ((builds (vector->list (assoc-ref details "builds")))
              (initial-build-ids (map (lambda (build)
                                        (assoc-ref build "uuid"))
@@ -155,6 +161,18 @@
                   (sleep 3)
                   (loop build-ids)))))))))
 
+(define* (build-log-procedure lgr #:optional build-id)
+  (lambda (level . components)
+    (apply log-msg
+           lgr
+           level
+           (if build-id
+               (cons*
+                build-id
+                ": "
+                components)
+               components))))
+
 (define (agent-submit-log-file lgr uuid coordinator-uri password
                                build-id derivation-name)
   (retry-on-error
@@ -172,7 +190,8 @@
        (submit-log-file
         coordinator-uri uuid password
         build-id
-        log-file)))
+        log-file
+        #:log (build-log-procedure lgr build-id))))
    #:times 6
    #:delay 30))
 
@@ -402,7 +421,8 @@ but the guix-daemon claims it's unavailable")
       (submit-build-result coordinator-uri uuid password
                            build-id
                            `((result   . failure)
-                             (end_time . ,(strftime "%F %T" end-time)))))
+                             (end_time . ,(strftime "%F %T" end-time)))
+                           #:log (build-log-procedure lgr build-id)))
     #:unwind? #t))
 
 (define (post-build-success lgr uuid coordinator-uri password
@@ -486,7 +506,8 @@ but the guix-daemon claims it's unavailable")
          coordinator-uri uuid password build-id
          `((result   . success)
            (end_time . ,(strftime "%F %T" end-time))
-           (outputs  . ,(list->vector output-details)))))
+           (outputs  . ,(list->vector output-details)))
+         #:log (build-log-procedure lgr build-id)))
       #:unwind? #t))
 
   (define (submit-one-output output-name output)
@@ -495,7 +516,8 @@ but the guix-daemon claims it's unavailable")
              (derivation-output-path output))
     (submit-output coordinator-uri uuid password
                    build-id output-name
-                   (derivation-output-path output)))
+                   (derivation-output-path output)
+                   #:log (build-log-procedure lgr build-id)))
 
   (log-msg lgr 'INFO build-id ": build successful, submitting outputs")
   (for-each (match-lambda