[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: offload: Add "test" sub-command.
From: |
Ludovic Courtès |
Subject: |
02/02: offload: Add "test" sub-command. |
Date: |
Mon, 5 Dec 2016 17:18:18 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit aebaee95cc26d404a8d7b62aece77dfbddb75836
Author: Ludovic Courtès <address@hidden>
Date: Mon Dec 5 18:16:04 2016 +0100
offload: Add "test" sub-command.
* guix/scripts/offload.scm (assert-node-repl, assert-node-has-guix)
(nonce, assert-node-can-import, assert-node-can-export)
(check-machine-availability): New procedures.
(%random-state): New variable.
(guix-offload): Add case for "test".
* doc/guix.texi (Daemon Offload Setup): Document it. Remove obsolete
bit about remote invocation of 'guix build'.
---
doc/guix.texi | 25 +++++++++++--
guix/scripts/offload.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 109 insertions(+), 3 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 47d0d71..4d7f96d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -941,9 +941,8 @@ name, and they will be scheduled on matching build machines.
@end table
@end deftp
-The @code{guix} command must be in the search path on the build
-machines, since offloading works by invoking the @code{guix archive} and
address@hidden build} commands. In addition, the Guix modules must be in
+The @code{guile} command must be in the search path on the build
+machines. In addition, the Guix modules must be in
@code{$GUILE_LOAD_PATH} on the build machine---you can check whether
this is the case by running:
@@ -978,6 +977,26 @@ the master receives files from a build machine (and
@i{vice versa}), its
build daemon can make sure they are genuine, have not been tampered
with, and that they are signed by an authorized key.
address@hidden offload test
+To test whether your setup is operational, run this command on the
+master node:
+
address@hidden
+# guix offload test
address@hidden example
+
+This will attempt to connect to each of the build machines specified in
address@hidden/etc/guix/machines.scm}, make sure Guile and the Guix modules are
+available on each machine, attempt to export to the machine and import
+from it, and report any error in the process.
+
+If you want to test a different machine file, just specify it on the
+command line:
+
address@hidden
+# guix offload test machines-qualif.scm
address@hidden example
+
@node Invoking guix-daemon
@section Invoking @command{guix-daemon}
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 237a963..4d697f7 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -625,6 +625,86 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;;;
+;;; Installation tests.
+;;;
+
+(define (assert-node-repl node name)
+ "Bail out if NODE is not running Guile."
+ (match (node-guile-version node)
+ (#f
+ (leave (_ "Guile could not be started on '~a'~%")
+ name))
+ ((? string? version)
+ ;; Note: The version string already contains the word "Guile".
+ (info (_ "'~a' is running ~a~%")
+ name (node-guile-version node)))))
+
+(define (assert-node-has-guix node name)
+ "Bail out if NODE lacks the (guix) module, or if its daemon is not running."
+ (match (node-eval node
+ '(begin
+ (use-modules (guix))
+ (with-store store
+ (add-text-to-store store "test"
+ "Hello, build machine!"))))
+ ((? string? str)
+ (info (_ "Guix is usable on '~a' (test returned ~s)~%")
+ name str))
+ (x
+ (leave (_ "failed to use Guix module on '~a' (test returned ~s)~%")
+ name x))))
+
+(define %random-state
+ (delay
+ (seed->random-state (logxor (getpid) (car (gettimeofday))))))
+
+(define (nonce)
+ (string-append (gethostname) "-"
+ (number->string (random 1000000 (force %random-state)))))
+
+(define (assert-node-can-import node name daemon-socket)
+ "Bail out if NODE refuses to import our archives."
+ (let ((session (node-session node)))
+ (with-store store
+ (let* ((item (add-text-to-store store "export-test" (nonce)))
+ (remote (connect-to-remote-daemon session daemon-socket)))
+ (send-files (list item) remote)
+ (if (valid-path? remote item)
+ (info (_ "'~a' successfully imported '~a'~%")
+ name item)
+ (leave (_ "'~a' was not properly imported on '~a'~%")
+ item name))))))
+
+(define (assert-node-can-export node name daemon-socket)
+ "Bail out if we cannot import signed archives from NODE."
+ (let* ((session (node-session node))
+ (remote (connect-to-remote-daemon session daemon-socket))
+ (item (add-text-to-store remote "import-test" (nonce)))
+ (port (store-export-channel session (list item))))
+ (with-store store
+ (if (and (import-paths store port)
+ (valid-path? store item))
+ (info (_ "successfully imported '~a' from '~a'~%")
+ item name)
+ (leave (_ "failed to import '~a' from '~a'~%")
+ item name)))))
+
+(define (check-machine-availability machine-file)
+ "Check that each machine in MACHINE-FILE is usable as a build machine."
+ (let ((machines (build-machines machine-file)))
+ (info (_ "testing ~a build machines defined in '~a'...~%")
+ (length machines) machine-file)
+ (let* ((names (map build-machine-name machines))
+ (sockets (map build-machine-daemon-socket machines))
+ (sessions (map open-ssh-session machines))
+ (nodes (map make-node sessions)))
+ (for-each assert-node-repl nodes names)
+ (for-each assert-node-has-guix nodes names)
+ (for-each assert-node-can-import nodes names sockets)
+ (for-each assert-node-can-export nodes names sockets))))
+
+
+;;;
;;; Entry point.
;;;
@@ -673,6 +753,13 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
(else
(leave (_ "invalid request line: ~s~%") line)))
(loop (read-line)))))))
+ (("test" rest ...)
+ (with-error-handling
+ (let ((file (match rest
+ ((file) file)
+ (() %machine-file)
+ (_ (leave (_ "wrong number of arguments~%"))))))
+ (check-machine-availability (or file %machine-file)))))
(("--version")
(show-version-and-exit "guix offload"))
(("--help")