summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-12-05 18:16:04 +0100
committerLudovic Courtès <ludo@gnu.org>2016-12-05 18:18:10 +0100
commitaebaee95cc26d404a8d7b62aece77dfbddb75836 (patch)
treeff690450adf16b6134bd0d9ad7374a08c0dc01e9
parent638ccde1fb47220b50de479dcf9f4273516e83d5 (diff)
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'.
-rw-r--r--doc/guix.texi25
-rw-r--r--guix/scripts/offload.scm87
2 files changed, 109 insertions, 3 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 47d0d7169a..4d7f96d907 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
-@code{guix 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.
+@cindex offload test
+To test whether your setup is operational, run this command on the
+master node:
+
+@example
+# guix offload test
+@end example
+
+This will attempt to connect to each of the build machines specified in
+@file{/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:
+
+@example
+# guix offload test machines-qualif.scm
+@end example
+
@node Invoking guix-daemon
@section Invoking @command{guix-daemon}
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 237a9638d3..4d697f7d00 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")