Better instrument the utility thread pool

2 files changed, 42 insertions, 1 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 0d7b4db..5d55f0b 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -149,7 +149,11 @@ INTERVAL (a time-duration object), otherwise does nothing and returns #f."
   (define datastore-metrics-updater
     (base-datastore-metrics-updater build-coordinator))
 
+  (define (build-coordinator-metrics-updater)
+    (build-coordinator-update-metrics build-coordinator))
+
   (define (update-managed-metrics!)
+    (call-with-delay-logging build-coordinator-metrics-updater)
     (call-with-delay-logging gc-metrics-updater)
     (call-with-delay-logging process-metrics-updater)
     (call-with-delay-logging datastore-metrics-updater))
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 986fb54..0beafab 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -110,6 +110,8 @@
             build-coordinator-prompt-hook-processing-for-event
             start-hook-processing-threads
 
+            build-coordinator-update-metrics
+
             build-coordinator-allocation-plan-stats
             build-coordinator-trigger-build-allocation
             build-coordinator-list-allocation-plan-builds
@@ -160,7 +162,9 @@
   (get-state-id         build-coordinator-get-state-id-proc
                         set-build-coordinator-get-state-id-proc!)
   (scheduler            build-coordinator-scheduler
-                        set-build-coordinator-scheduler!))
+                        set-build-coordinator-scheduler!)
+  (utility-thread-pool  build-coordinator-utility-thread-pool
+                        set-build-coordinator-utility-thread-pool!))
 
 (set-record-type-printer!
  <build-coordinator>
@@ -359,6 +363,27 @@
 (define (build-coordinator-get-state-id build-coordinator)
   ((build-coordinator-get-state-id-proc build-coordinator)))
 
+(define (build-coordinator-update-metrics build-coordinator)
+  (define metrics-registry
+    (build-coordinator-metrics-registry build-coordinator))
+
+  (let ((utility-thread-pool-used-thread-metric
+         (or (metrics-registry-fetch-metric
+              metrics-registry
+              "utility_thread_pool_used_thread_total")
+             (make-gauge-metric
+              metrics-registry
+              "utility_thread_pool_used_thread_total"))))
+
+    (and=> (build-coordinator-utility-thread-pool build-coordinator)
+           (lambda (utility-thread-pool)
+             (metric-set
+              utility-thread-pool-used-thread-metric
+              (vector-count
+               (lambda (_ proc)
+                 (->bool proc))
+               (thread-pool-proc-vector utility-thread-pool)))))))
+
 (define* (make-build-coordinator
           #:key
           database-uri-string
@@ -555,6 +580,18 @@
                    "warning: utility thread channel delayed by ~1,2f seconds~%"
                    seconds-delayed)))))))
 
+      (let ((metric
+             (make-gauge-metric
+              (build-coordinator-metrics-registry build-coordinator)
+              "utility_thread_pool_thread_total")))
+        (metric-set metric
+                    (vector-length
+                     (thread-pool-proc-vector utility-thread-pool))))
+
+      (set-build-coordinator-utility-thread-pool!
+       build-coordinator
+       utility-thread-pool)
+
       (let ((finished? (make-condition)))
         (call-with-sigint
          (lambda ()