me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2014-08-29 14:37:58 +02:00
parent 00b7776c0d
commit b1e48f222b
1 changed files with 4 additions and 3 deletions

View File

@ -181,7 +181,8 @@ determined."
#:key (error-port (current-error-port)) (quote? #t)) #:key (error-port (current-error-port)) (quote? #t))
"Run COMMAND (a string list) on MACHINE, assuming an lsh gateway has been "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 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) (define (shell-quote str)
;; Sort-of shell-quote STR so it can be passed as an argument to the ;; Sort-of shell-quote STR so it can be passed as an argument to the
;; shell. ;; shell.
@ -535,7 +536,7 @@ allowed on MACHINE."
(line (read-line pipe))) (line (read-line pipe)))
(close-pipe pipe) (close-pipe pipe)
(if (eof-object? line) (if (eof-object? line)
1. +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line) (match (string-tokenize line)
((one five fifteen . _) ((one five fifteen . _)
(let* ((raw (string->number five)) (let* ((raw (string->number five))
@ -546,7 +547,7 @@ allowed on MACHINE."
(build-machine-name machine) raw normalized) (build-machine-name machine) raw normalized)
normalized)) normalized))
(_ (_
1.))))) +inf.0))))) ;something's fishy about MACHINE, so avoid it
(define (machine-less-loaded? m1 m2) (define (machine-less-loaded? m1 m2)
"Return #t if the load on M1 is lower than that on M2." "Return #t if the load on M1 is lower than that on M2."