Avoid starting builds if the system load is high

3 files changed, 45 insertions, 4 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 9ace7d3..f80cb10 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -45,7 +45,8 @@
                    max-parallel-builds
                    derivation-substitute-urls
                    non-derivation-substitute-urls
-                   metrics-file)
+                   metrics-file
+                   max-5min-load-average)
   (define lgr (make <logger>))
   (define port-log (make <port-log>
                      #:port (current-output-port)
@@ -90,6 +91,15 @@
       (write-textfile metrics-registry
                       metrics-file)))
 
+  (define (wait-for-low-load build-id)
+    (let ((current-load (get-load-average)))
+      (when (>= current-load max-5min-load-average)
+        (log-msg lgr 'INFO
+                 build-id
+                 ": holding build start due to high load")
+        (sleep 30)
+        (wait-for-low-load build-id))))
+
   (define (process-job build)
     (let ((build-id (assoc-ref build "uuid"))
           (derivation-name (assoc-ref build "derivation-name")))
@@ -113,6 +123,7 @@
           (write-metrics)
           (if (eq? (assq-ref pre-build-status 'result) 'success)
               (begin
+                (wait-for-low-load build-id)
                 (log-msg lgr 'INFO
                          build-id
                          ": setup successful, building: "
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 0334811..5fd98f5 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -52,7 +52,10 @@
 
             create-work-queue
 
-            with-timeout))
+            with-timeout
+
+            get-load-average
+            get-available-processing-units))
 
 (define (random-v4-uuid)
   ;; https://tools.ietf.org/html/rfc4122#page-14
@@ -682,3 +685,21 @@ again."
         (alarm 0)
         (sigaction SIGALRM SIG_DFL)
         (apply values result)))))
+
+(define* (get-load-average #:key (period 5))
+  (if (file-exists? "/proc/loadavg")
+      (let ((line (call-with-input-file "/proc/loadavg" get-line)))
+        (match (string-split line #\space)
+          ((1min 5min 15min _ _)
+           (string->number
+            (cond
+             ((= period 1) 1min)
+             ((= period 5) 5min)
+             ((= period 15) 15min))))))
+      #f))
+
+(define (get-available-processing-units)
+  (let* ((port (open-input-pipe "nproc --all"))
+         (str  (read-line port)))
+    (close-pipe port)
+    (string->number str)))
diff --git a/scripts/guix-build-coordinator-agent.in b/scripts/guix-build-coordinator-agent.in
index 55e8e92..ce4742e 100644
--- a/scripts/guix-build-coordinator-agent.in
+++ b/scripts/guix-build-coordinator-agent.in
@@ -26,6 +26,7 @@
              (srfi srfi-37)
              (ice-9 textual-ports)
              ((guix config) #:prefix guix-config:)
+             (guix-build-coordinator utils)
              (guix-build-coordinator agent))
 
 (define %options
@@ -56,6 +57,11 @@
                   (alist-cons 'max-parallel-builds
                               (string->number arg)
                               result)))
+        (option '("max-5min-load-average") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-5min-load-average
+                              (string->number arg)
+                              result)))
         (option '("substitute-urls") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'substitute-urls
@@ -89,7 +95,9 @@
     (max-parallel-builds . 1)
     (systems             . (,guix-config:%system))
     (metrics-file
-     . "/var/lib/prometheus/node-exporter/guix-build-coordinator-agent.prom")))
+     . "/var/lib/prometheus/node-exporter/guix-build-coordinator-agent.prom")
+    (max-5min-load-average
+     . ,(get-available-processing-units))))
 
 (define (parse-options options defaults args)
   (args-fold
@@ -115,4 +123,5 @@
                  (assq-ref opts 'substitute-urls))
              (or (assq-ref opts 'non-derivation-substitute-urls)
                  (assq-ref opts 'substitute-urls))
-             (assq-ref opts 'metrics-file)))
+             (assq-ref opts 'metrics-file)
+             (assq-ref opts 'max-5min-load-average)))