mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-16 19:57:39 -05:00
offload: Ignore unreachable machines.
Fixes <http://bugs.gnu.org/18070>. Reported by Andreas Enge <andreas@enge.fr>. * guix/scripts/offload.scm (remote-pipe): Augment docstring. (machine-load): Return +inf.0 instead of 1 if MACHINE does not respond or responds badly.
This commit is contained in:
parent
00b7776c0d
commit
b1e48f222b
1 changed files with 4 additions and 3 deletions
|
@ -181,7 +181,8 @@ (define* (remote-pipe machine mode command
|
|||
#:key (error-port (current-error-port)) (quote? #t))
|
||||
"Run COMMAND (a string list) on MACHINE, assuming an lsh gateway has been
|
||||
set up. When QUOTE? is true, perform shell-quotation of all the elements of
|
||||
COMMAND."
|
||||
COMMAND. Return either a pipe opened with MODE, or #f if the lsh client could
|
||||
not be started."
|
||||
(define (shell-quote str)
|
||||
;; Sort-of shell-quote STR so it can be passed as an argument to the
|
||||
;; shell.
|
||||
|
@ -535,7 +536,7 @@ (define (machine-load machine)
|
|||
(line (read-line pipe)))
|
||||
(close-pipe pipe)
|
||||
(if (eof-object? line)
|
||||
1.
|
||||
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
|
||||
(match (string-tokenize line)
|
||||
((one five fifteen . _)
|
||||
(let* ((raw (string->number five))
|
||||
|
@ -546,7 +547,7 @@ (define (machine-load machine)
|
|||
(build-machine-name machine) raw normalized)
|
||||
normalized))
|
||||
(_
|
||||
1.)))))
|
||||
+inf.0))))) ;something's fishy about MACHINE, so avoid it
|
||||
|
||||
(define (machine-less-loaded? m1 m2)
|
||||
"Return #t if the load on M1 is lower than that on M2."
|
||||
|
|
Loading…
Reference in a new issue