nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
guix/scripts/offload.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -191,25 +191,19 @@ not be started."
(lambda () (lambda ()
(write str)))) (write str))))
(catch 'system-error ;; Let the child inherit ERROR-PORT.
(lambda () (with-error-to-port error-port
;; Let the child inherit ERROR-PORT. (apply open-pipe* mode %lshg-command
(with-error-to-port error-port "-l" (build-machine-user machine)
(apply open-pipe* mode %lshg-command "-p" (number->string (build-machine-port machine))
"-l" (build-machine-user machine)
"-p" (number->string (build-machine-port machine))
;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg.
"-i" (build-machine-private-key machine) "-i" (build-machine-private-key machine)
(build-machine-name machine) (build-machine-name machine)
(if quote? (if quote?
(map shell-quote command) (map shell-quote command)
command)))) command))))
(lambda args
(warning (_ "failed to execute '~a': ~a~%")
%lshg-command (strerror (system-error-errno args)))
#f)))
;;; ;;;
@ -533,9 +527,14 @@ success, #f otherwise."
(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."
(let* ((pipe (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg"))) (let* ((pipe (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
(line (read-line pipe))) (line (read-line pipe))
(close-pipe 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) (if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line) (match (string-tokenize line)