mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 14:07:01 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

offload: Do not abort when a machine is unreachable.

Browse source 
* guix/scripts/offload.scm (machine-load): Wrap 'open-ssh-session' call
in 'false-if-exception'; return +inf.0 if it returns #f.
This commit is contained in:
Ludovic Courtès 2016-12-01 23:21:15 +01:00
parent 74afca5dcf
commit 463fb7d0c8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 20 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
guix/scripts/offload.scm
View file

@ -493,10 +493,11 @@ (define (machine-matches? machine requirements)
(define (machine-load machine) (define (machine-load machine)
"Return the load of MACHINE, divided by the number of parallel builds "Return the load of MACHINE, divided by the number of parallel builds
allowed on MACHINE." allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; Note: This procedure is costly since it creates a new SSH session. ;; Note: This procedure is costly since it creates a new SSH session.
(let* ((session (open-ssh-session machine)) (match (false-if-exception (open-ssh-session machine))
(pipe (open-remote-pipe* session OPEN_READ ((? session? session)
(let* ((pipe (open-remote-pipe* session OPEN_READ
"cat" "/proc/loadavg")) "cat" "/proc/loadavg"))
(line (read-line pipe))) (line (read-line pipe)))
(close-port pipe) (close-port pipe)
@ -514,6 +515,8 @@ (define (machine-load machine)
normalized)) normalized))
(_ (_
+inf.0))))) ;something's fishy about MACHINE, so avoid it +inf.0))))) ;something's fishy about MACHINE, so avoid it
(_
+inf.0))) ;failed to connect to MACHINE, so avoid it
(define (machine-lock-file machine hint) (define (machine-lock-file machine hint)
"Return the name of MACHINE's lock file for HINT." "Return the name of MACHINE's lock file for HINT."