diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-01-22 17:37:59 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-22 23:04:05 +0100 |
| commit | 02ec889e6b8f6593dd90afcb4d60a43ea67be4b8 (patch) | |
| tree | e9b16ef35537f173c414d0264210a043adee2b0a | |
| parent | c2dcff41c2e47f5f978f467864d5ed7829939884 (diff) | |
| download | guix-02ec889e6b8f6593dd90afcb4d60a43ea67be4b8.tar.gz | |
offload: 'status' reports the time difference.
* guix/scripts/offload.scm (check-machine-status): Report the time difference for each MACHINE.
| -rw-r--r-- | guix/scripts/offload.scm | 37 |
1 files changed, 25 insertions, 12 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 2116b38425..eb02672dbf 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -712,18 +712,31 @@ machine." (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)) - (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~%" - (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.))))) + (let ((now (car (gettimeofday)))) + (match (inferior-eval '(list (uname) + (car (gettimeofday))) + inferior) + ((uts time) + (when (< time now) + ;; Build machine clocks must not be behind as this + ;; could cause timestamp issues. + (warning (G_ "machine '~a' is ~a seconds behind~%") + (build-machine-name machine) + (- now time))) + + (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)) machines))) |