nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

offload: Adjust 'test' and 'status' to the latest changes. 

This is a followup to ed7b44370f71126087eb953f36aad8dc4c44109f;
following that commit, 'guix offload test' and 'guix offload status'
would abort with a backtrace instead of clearly diagnosing a missing
'guix' command on the build machine.

* guix/scripts/offload.scm (assert-node-has-guix): Call 'leave' when
NODE is not an inferior.  Remove 'catch' blocks for 'node-repl-error'.
(check-machine-availability): Invoke 'assert-node-has-guix' first.
(check-machine-status): Print a warning when 'remote-inferior' returns #f.
This commit is contained in:
Ludovic Courtès 2018-12-25 17:03:37 +01:00
parent 522d1b87bc
commit 10b2834f82
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 45 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
guix/scripts/offload.scm
View File

@ -624,20 +624,18 @@ If TIMEOUT is #f, simply evaluate EXP..."
name (node-guile-version node))))) name (node-guile-version node)))))
(define (assert-node-has-guix node name) (define (assert-node-has-guix node name)
"Bail out if NODE lacks the (guix) module, or if its daemon is not running." "Bail out if NODE if #f or if we fail to use the (guix) module, or if its
(catch 'node-repl-error daemon is not running."
(lambda () (unless (inferior? node)
(leave (G_ "failed to run 'guix repl' on '~a'~%") name))
(match (inferior-eval '(begin (match (inferior-eval '(begin
(use-modules (guix)) (use-modules (guix))
(and add-text-to-store 'alright)) (and add-text-to-store 'alright))
node) node)
('alright #t) ('alright #t)
(_ (report-module-error name)))) (_ (report-module-error name)))
(lambda (key . args)
(report-module-error name)))
(catch 'node-repl-error
(lambda ()
(match (inferior-eval '(begin (match (inferior-eval '(begin
(use-modules (guix)) (use-modules (guix))
(with-store store (with-store store
@ -650,9 +648,6 @@ If TIMEOUT is #f, simply evaluate EXP..."
(x (x
(leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%") (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
name x)))) name x))))
(lambda (key . args)
(leave (G_ "remote evaluation on '~a' failed:~{ ~s~}~%")
name args))))
(define %random-state (define %random-state
(delay (delay
@ -706,8 +701,8 @@ machine."
(sockets (map build-machine-daemon-socket machines)) (sockets (map build-machine-daemon-socket machines))
(sessions (map open-ssh-session machines)) (sessions (map open-ssh-session machines))
(nodes (map remote-inferior sessions))) (nodes (map remote-inferior sessions)))
(for-each assert-node-repl nodes names)
(for-each assert-node-has-guix nodes names) (for-each assert-node-has-guix nodes names)
(for-each assert-node-repl nodes names)
(for-each assert-node-can-import sessions nodes names sockets) (for-each assert-node-can-import sessions nodes names sockets)
(for-each assert-node-can-export sessions nodes names sockets) (for-each assert-node-can-export sessions nodes names sockets)
(for-each close-inferior nodes) (for-each close-inferior nodes)
@ -727,13 +722,18 @@ machine."
(info (G_ "getting status of ~a build machines defined in '~a'...~%") (info (G_ "getting status of ~a build machines defined in '~a'...~%")
(length machines) machine-file) (length machines) machine-file)
(for-each (lambda (machine) (for-each (lambda (machine)
(let* ((session (open-ssh-session machine)) (define session
(inferior (remote-inferior session)) (open-ssh-session machine))
(uts (inferior-eval '(uname) inferior))
(match (remote-inferior session)
(#f
(warning (G_ "failed to run 'guix repl' on machine '~a'~%")
(build-machine-name machine)))
((? inferior? inferior)
(let ((uts (inferior-eval '(uname) inferior))
(load (node-load inferior)) (load (node-load inferior))
(free (node-free-disk-space inferior))) (free (node-free-disk-space inferior)))
(close-inferior inferior) (close-inferior inferior)
(disconnect! session)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\ (format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%" host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%"
(build-machine-name machine) (build-machine-name machine)
@ -741,7 +741,9 @@ machine."
(utsname:machine uts) (utsname:machine uts)
(utsname:nodename uts) (utsname:nodename uts)
(normalized-load machine load) (normalized-load machine load)
(/ free (expt 2 20) 1.)))) (/ free (expt 2 20) 1.)))))
(disconnect! session))
machines))) machines)))