summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-01 01:31:18 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-01 01:31:18 +0100
commit165f4b2add7f292877d67d58c9f6cf9d1c137e70 (patch)
tree85267cc09908eb0c5a3a05d71b18e9d3993bcde3
parent36b56f081b5c84c48d2d5e47cab16ef2fefcc11a (diff)
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.
-rw-r--r--guix/scripts/offload.scm36
1 files changed, 33 insertions, 3 deletions
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 @@ success, #f otherwise."
"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