From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:44066) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ePFlz-0004Sa-Rv for guix-patches@gnu.org; Wed, 13 Dec 2017 17:45:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ePFlv-0000hW-R3 for guix-patches@gnu.org; Wed, 13 Dec 2017 17:45:07 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:52253) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ePFlv-0000hM-NX for guix-patches@gnu.org; Wed, 13 Dec 2017 17:45:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ePFlu-0000IS-Q7 for guix-patches@gnu.org; Wed, 13 Dec 2017 17:45:03 -0500 Subject: [bug#29699] [PATCH] guix: offload: Add "status" sub-command. Resent-Message-ID: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43973) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ePFlg-0004SD-Ha for guix-patches@gnu.org; Wed, 13 Dec 2017 17:44:49 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ePFlc-0000Qk-EY for guix-patches@gnu.org; Wed, 13 Dec 2017 17:44:48 -0500 Received: from sender-of-o51.zoho.com ([135.84.80.216]:21109) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1ePFlc-0000GA-6O for guix-patches@gnu.org; Wed, 13 Dec 2017 17:44:44 -0500 From: Ricardo Wurmus Date: Wed, 13 Dec 2017 23:44:09 +0100 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Message-ID: <20171213224409.417-1-rekado@elephly.net> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 29699@debbugs.gnu.org Cc: Ricardo Wurmus * guix/scripts/offload.scm (check-machine-load): New procedure. (guix-offload): Call it when the argument is "status". * doc/guix.texi (Daemon Offload Setup): Document it. --- doc/guix.texi | 9 +++++++++ guix/scripts/offload.scm | 26 ++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 92ac45b1c..6845a4271 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 =20 +@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} =20 diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index ebd0bf783..40bc68b11 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2014, 2015, 2016, 2017 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -629,6 +630,19 @@ machine." (for-each assert-node-can-import nodes names sockets) (for-each assert-node-can-export nodes names sockets)))) =20 +(define (check-machine-load machine-file pred) + "Print the load of each machine matching PRED in MACHINE-FILE." + (define (build-machine=3D? m1 m2) + (and (string=3D? (build-machine-name m1) (build-machine-name m2)) + (=3D (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 on= ce. + (let ((machines (filter pred + (delete-duplicates (build-machines machine-file) + build-machine=3D?)))) + (for-each machine-load machines))) + =0C ;;; ;;; Entry point. @@ -691,6 +705,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-load (or file %machine-file) pred)))) (("--version") (show-version-and-exit "guix offload")) (("--help") --=20 2.15.0