From 51c318b99b7ff2203be7924fc5ff626a113f252c Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 22 Mar 2023 15:17:49 +0000
Subject: Have agents send their status every 30 seconds

---
 guix-build-coordinator/agent-messaging/http.scm |  8 +++++--
 guix-build-coordinator/agent.scm                | 29 ++++++++++++++++++++++---
 2 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index b7b1877..74f7c9c 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -258,13 +258,17 @@
                 .
                 args)
   (apply
-   (lambda* (status #:key (log default-log))
+   (lambda* (status #:key 1min-load-average (log default-log))
      (coordinator-http-request
       log
       interface
       (string-append "/agent/" (slot-ref interface 'agent-uuid))
       #:method 'PUT                     ; TODO Should be PATCH
-      #:body `((status . ,status))))
+      #:body `((status . ,status)
+               ,@(if 1min-load-average
+                     `((load_average
+                        . ((1 . ,1min-load-average))))
+                     '()))))
    args))
 
 (define-method (submit-output
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index de28211..696c1ee 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -448,9 +448,9 @@
 
     (let ((details (submit-status coordinator-interface
                                   'idle
-                                  #:log (build-log-procedure
-                                         lgr
-                                         (assoc-ref build "uuid")))))
+                                  #:1min-load-average
+                                  (get-load-average #:period 1)
+                                  #:log (build-log-procedure lgr))))
       (for-each
        (lambda (job-args)
          (process-job-with-queue job-args))
@@ -476,6 +476,29 @@
                (display-info)
                (loop (get-line (current-input-port))))))))
 
+      (unless (running-on-the-hurd?)
+        (call-with-new-thread
+         (lambda ()
+           (set-thread-name "gbc submit status")
+
+           (while #t
+             (with-exception-handler
+                 (lambda (exn)
+                   (log-msg lgr 'WARN "exception submitting status: " exn))
+               (lambda ()
+                 (submit-status coordinator-interface
+                                (if (= (+ (count-jobs)
+                                          (count-post-build-jobs))
+                                       0)
+                                    'idle
+                                    'active)
+                                #:1min-load-average
+                                (get-load-average #:period 1)
+                                #:log (build-log-procedure lgr)))
+               #:unwind? #t)
+
+             (sleep 30)))))
+
       (while #t
         (let ((current-threads (count-threads))
               (job-count (count-jobs)))
-- 
cgit v1.2.3