offload: Warn about SSH client issues.

Suggested by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.

* guix/scripts/offload.scm (remote-pipe): Remove unneeded 'catch'.
  (machine-load): Check the exit value  upon (close-pipe pipe).  Call
  'warning' when it is non-zero.
This commit is contained in:
Ludovic Courtès 2015-02-05 22:16:59 +01:00
parent bf26b8ddab
commit fc61b641c2
1 changed files with 20 additions and 21 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -191,8 +191,6 @@ not be started."
(lambda ()
(write str))))
(catch 'system-error
(lambda ()
;; Let the child inherit ERROR-PORT.
(with-error-to-port error-port
(apply open-pipe* mode %lshg-command
@ -206,10 +204,6 @@ not be started."
(if quote?
(map shell-quote command)
command))))
(lambda args
(warning (_ "failed to execute '~a': ~a~%")
%lshg-command (strerror (system-error-errno args)))
#f)))
;;;
@ -534,8 +528,13 @@ success, #f otherwise."
"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)
(line (read-line pipe))
(status (close-pipe pipe)))
(unless (eqv? 0 (status:exit-val status))
(warning (_ "failed to obtain load of '~a': SSH client exited with ~a~%")
(build-machine-name machine)
(status:exit-val status)))
(if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line)