summaryrefslogtreecommitdiff
path: root/guix/scripts/offload.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-22 17:37:59 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-22 23:04:05 +0100
commit02ec889e6b8f6593dd90afcb4d60a43ea67be4b8 (patch)
treee9b16ef35537f173c414d0264210a043adee2b0a /guix/scripts/offload.scm
parentc2dcff41c2e47f5f978f467864d5ed7829939884 (diff)
downloadguix-patches-02ec889e6b8f6593dd90afcb4d60a43ea67be4b8.tar
guix-patches-02ec889e6b8f6593dd90afcb4d60a43ea67be4b8.tar.gz
offload: 'status' reports the time difference.
* guix/scripts/offload.scm (check-machine-status): Report the time difference for each MACHINE.
Diffstat (limited to 'guix/scripts/offload.scm')
-rw-r--r--guix/scripts/offload.scm37
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)))