diff options
| -rw-r--r-- | doc/guix.texi | 9 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 39 |
2 files changed, 48 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 64f73b38a4..cb6e6b1c6b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1066,6 +1066,15 @@ regular expression like this: # guix offload test machines.scm '\.gnu\.org$' @end example +@cindex offload status +To display the current load of all build hosts, run this command on the +main node: + +@example +# guix offload status +@end example + + @node Invoking guix-daemon @section Invoking @command{guix-daemon} diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index ebd0bf783d..7e114fa2c9 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -629,6 +630,32 @@ machine." (for-each assert-node-can-import nodes names sockets) (for-each assert-node-can-export nodes names sockets)))) +(define (check-machine-status machine-file pred) + "Print the load of each machine matching PRED in MACHINE-FILE." + (define (build-machine=? m1 m2) + (and (string=? (build-machine-name m1) (build-machine-name m2)) + (= (build-machine-port m1) (build-machine-port m2)))) + + ;; A given build machine may appear several times (e.g., once for + ;; "x86_64-linux" and a second time for "i686-linux"); test them only once. + (let ((machines (filter pred + (delete-duplicates (build-machines machine-file) + build-machine=?)))) + (info (G_ "getting status of ~a build machines defined in '~a'...~%") + (length machines) machine-file) + (for-each (lambda (machine) + (let* ((node (make-node (open-ssh-session machine))) + (uts (node-eval node '(uname)))) + (format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\ + host name: ~a~% normalized load: ~a~%" + (build-machine-name machine) + (utsname:sysname uts) (utsname:release uts) + (utsname:machine uts) + (utsname:nodename uts) + (parameterize ((current-error-port (%make-void-port "rw+"))) + (machine-load machine))))) + machines))) + ;;; ;;; Entry point. @@ -691,6 +718,18 @@ machine." (() (values %machine-file (const #t))) (x (leave (G_ "wrong number of arguments~%")))))) (check-machine-availability (or file %machine-file) pred)))) + (("status" rest ...) + (with-error-handling + (let-values (((file pred) + (match rest + ((file regexp) + (values file + (compose (cut string-match regexp <>) + build-machine-name))) + ((file) (values file (const #t))) + (() (values %machine-file (const #t))) + (x (leave (G_ "wrong number of arguments~%")))))) + (check-machine-status (or file %machine-file) pred)))) (("--version") (show-version-and-exit "guix offload")) (("--help") |