From 02ec889e6b8f6593dd90afcb4d60a43ea67be4b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Jan 2019 17:37:59 +0100 Subject: [PATCH] offload: 'status' reports the time difference. * guix/scripts/offload.scm (check-machine-status): Report the time difference for each MACHINE. --- guix/scripts/offload.scm | 37 +++++++++++++++++++++++++------------ 1 file 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)))