From 165f4b2add7f292877d67d58c9f6cf9d1c137e70 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 1 Mar 2014 01:31:18 +0100
Subject: offload: Take the target machine load into account.

* guix/scripts/offload.scm (machine-load, machine-less-loaded?,
  machine-less-loaded-or-faster?): New procedures.
  (choose-build-machine): Use 'machine-less-loaded-or-faster?' when
  sorting.  Return the head of MACHINES unless it's loaded is >= 2.
---
 guix/scripts/offload.scm | 36 +++++++++++++++++++++++++++++++++---
 1 file changed, 33 insertions(+), 3 deletions(-)

(limited to 'guix/scripts')

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 00a145e5e9..e48e31547a 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -268,15 +268,45 @@ (define (machine-faster? m1 m2)
   "Return #t if M1 is faster than M2."
   (> (build-machine-speed m1) (build-machine-speed m2)))
 
+(define (machine-load machine)
+  "Return the load of MACHINE, divided by the number of parallel builds
+allowed on MACHINE."
+  (let* ((pipe (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
+         (line (read-line pipe)))
+    (close-pipe pipe)
+    (if (eof-object? line)
+        1.
+        (match (string-tokenize line)
+          ((one five fifteen . _)
+           (let* ((raw        (string->number five))
+                  (jobs       (build-machine-parallel-builds machine))
+                  (normalized (/ raw jobs)))
+             (format (current-error-port) "load on machine '~a' is ~s\
+ (normalized: ~s)~%"
+                     (build-machine-name machine) raw normalized)
+             normalized))
+          (_
+           1.)))))
+
+(define (machine-less-loaded? m1 m2)
+  "Return #t if the load on M1 is lower than that on M2."
+  (< (machine-load m1) (machine-load m2)))
+
+(define (machine-less-loaded-or-faster? m1 m2)
+  "Return #t if M1 is either less loaded or faster than M2."
+  (or (machine-less-loaded? m1 m2)
+      (machine-faster? m1 m2)))
+
 (define (choose-build-machine requirements machines)
   "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
-  ;; FIXME: Take machine load into account, and/or shuffle MACHINES.
   (let ((machines (sort (filter (cut machine-matches? <> requirements)
                                 machines)
-                        machine-faster?)))
+                        machine-less-loaded-or-faster?)))
     (match machines
       ((head . _)
-       head)
+       ;; Return the best machine unless it's already overloaded.
+       (and (< (machine-load head) 2.)
+            head))
       (_ #f))))
 
 (define* (process-request wants-local? system drv features
-- 
cgit v1.2.3