From aebaee95cc26d404a8d7b62aece77dfbddb75836 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 5 Dec 2016 18:16:04 +0100 Subject: 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'. --- guix/scripts/offload.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) (limited to 'guix/scripts/offload.scm') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 237a9638d..4d697f7d0 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -623,6 +623,86 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable." ;; Not now, all the machines are busy. (display "# postpone\n"))))))) + +;;; +;;; 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") -- cgit v1.3 From 1d48cf948cfb825a5b080d5cbe3ba3cb69beb7c8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 5 Dec 2016 23:15:17 +0100 Subject: offload: Make the compression methods configurable. * guix/scripts/offload.scm ()[compression] [compression-level]: New fields. (open-ssh-session): Honor them. * doc/guix.texi (Daemon Offload Setup): Document them. --- doc/guix.texi | 7 +++++++ guix/scripts/offload.scm | 10 ++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'guix/scripts/offload.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 5c94a56c0..738b7fb10 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -921,6 +921,13 @@ Port number of SSH server on the machine. The SSH private key file to use when connecting to the machine, in OpenSSH format. +@item @code{compression} (default: @code{"zlib@@openssh.com,zlib"}) +@itemx @code{compression-level} (default: @code{3}) +The SSH-level compression methods and compression level requested. + +Note that offloading relies on SSH compression to reduce bandwidth usage +when transferring files to and from build machines. + @item @code{daemon-socket} (default: @code{"/var/guix/daemon-socket/socket"}) File name of the Unix-domain socket @command{guix-daemon} is listening to on that machine. diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 4d697f7d0..e20da99cb 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -75,6 +75,10 @@ (private-key build-machine-private-key ; file name (default (user-openssh-private-key))) (host-key build-machine-host-key) ; string + (compression build-machine-compression ; string + (default "zlib@openssh.com,zlib")) + (compression-level build-machine-compression-level ;integer + (default 3)) (daemon-socket build-machine-daemon-socket ; string (default "/var/guix/daemon-socket/socket")) (parallel-builds build-machine-parallel-builds ; number @@ -175,8 +179,10 @@ private key from '~a': ~a") ;; We need lightweight compression when ;; exchanging full archives. - #:compression "zlib" - #:compression-level 3))) + #:compression + (build-machine-compression machine) + #:compression-level + (build-machine-compression-level machine)))) (match (connect! session) ('ok ;; Authenticate the server. XXX: Guile-SSH 0.10.1 doesn't know about -- cgit v1.3 From e11c42f297a4e128aa5abd11f379a250146f5cab Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 5 Dec 2016 23:25:29 +0100 Subject: offload: Fix plural of some messages. * guix/scripts/offload.scm (send-files): Use 'N_' for possibly plural message. Write "store item" instead of "store file". (retrieve-files): Likewise. --- guix/scripts/offload.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'guix/scripts/offload.scm') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index e20da99cb..ed70f2267 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -451,9 +451,11 @@ be read." (with-store store (remove (cut valid-path? store <>) ',files))))) + (count (length missing)) (port (store-import-channel session))) - (format #t (_ "sending ~a store files to '~a'...~%") - (length missing) (session-get session 'host)) + (format #t (N_ "sending ~a store item to '~a'...~%" + "sending ~a store items to '~a'...~%" count) + count (session-get session 'host)) ;; Send MISSING in topological order. (export-paths store missing port) @@ -472,9 +474,11 @@ be read." "Retrieve FILES from SESSION's store, and import them." (let* ((session (channel-get-session (nix-server-socket remote))) (host (session-get session 'host)) - (port (store-export-channel session files))) - (format #t (_ "retrieving ~a files from '~a'...~%") - (length files) host) + (port (store-export-channel session files)) + (count (length files))) + (format #t (N_ "retrieving ~a store item from '~a'...~%" + "retrieving ~a store items from '~a'...~%" count) + count host) ;; We cannot use the 'import-paths' RPC here because we already ;; hold the locks for FILES. -- cgit v1.3 From 0237d7971742ccfe5670455debb1feca9a491a0f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 6 Dec 2016 00:50:08 +0100 Subject: offload: Send the build log to the right file descriptor. This fixes a regression introduced in 21531add3205e400707c8fbfd841845f9a71863a whereby the build log would no longer be sent to FD 4, thereby leading the daemon to not see the build log. * guix/scripts/offload.scm (transfer-and-offload): Parameterize CURRENT-BUILD-OUTPUT-PORT. --- guix/scripts/offload.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/scripts/offload.scm') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index ed70f2267..55d4c93c6 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -390,7 +390,8 @@ MACHINE." ;; Use exit code 100 for a permanent build failure. The daemon ;; interprets other non-zero codes as transient build failures. (primitive-exit 100))) - (build-derivations store (list drv))) + (parameterize ((current-build-output-port (build-log-port))) + (build-derivations store (list drv)))) (retrieve-files outputs store) (format (current-error-port) "done with offloaded '~a'~%" -- cgit v1.3 From 8d125cfc2e5cb0825bb40893ec3e940f85f1b235 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 6 Dec 2016 01:00:11 +0100 Subject: offload: Increase the connection timeout. * guix/scripts/offload.scm (open-ssh-session): Set #:timeout to 10. --- guix/scripts/offload.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/scripts/offload.scm') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 55d4c93c6..ebff11664 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -173,7 +173,7 @@ private key from '~a': ~a") (session (make-session #:user (build-machine-user machine) #:host (build-machine-name machine) #:port (build-machine-port machine) - #:timeout 5 ;seconds + #:timeout 10 ;seconds ;; #:log-verbosity 'protocol #:identity (build-machine-private-key machine) -- cgit v1.3