offload: 'status' reports the time difference.

* guix/scripts/offload.scm (check-machine-status): Report the time
difference for each MACHINE.
This commit is contained in:
Ludovic Courtès 2019-01-22 17:37:59 +01:00
parent c2dcff41c2
commit 02ec889e6b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 25 additions and 12 deletions

View File

@ -712,18 +712,31 @@ machine."
(warning (G_ "failed to run 'guix repl' on machine '~a'~%") (warning (G_ "failed to run 'guix repl' on machine '~a'~%")
(build-machine-name machine))) (build-machine-name machine)))
((? inferior? inferior) ((? inferior? inferior)
(let ((uts (inferior-eval '(uname) inferior)) (let ((now (car (gettimeofday))))
(load (node-load inferior)) (match (inferior-eval '(list (uname)
(free (node-free-disk-space inferior))) (car (gettimeofday)))
(close-inferior inferior) inferior)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\ ((uts time)
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%" (when (< time now)
(build-machine-name machine) ;; Build machine clocks must not be behind as this
(utsname:sysname uts) (utsname:release uts) ;; could cause timestamp issues.
(utsname:machine uts) (warning (G_ "machine '~a' is ~a seconds behind~%")
(utsname:nodename uts) (build-machine-name machine)
(normalized-load machine load) (- now time)))
(/ free (expt 2 20) 1.)))))
(let ((load (node-load inferior))
(free (node-free-disk-space inferior)))
(close-inferior inferior)
(format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%\
time difference: ~a s~%"
(build-machine-name machine)
(utsname:sysname uts) (utsname:release uts)
(utsname:machine uts)
(utsname:nodename uts)
(normalized-load machine load)
(/ free (expt 2 20) 1.)
(- time now))))))))
(disconnect! session)) (disconnect! session))
machines))) machines)))