diff options
| -rw-r--r-- | doc/guix.texi | 25 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 87 |
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") |