Merge branch 'master' into staging

5 files changed, 33 insertions, 19 deletions

diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index f0693ed8df..65de42053d 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -109,7 +109,7 @@
   "Return the hash of ITEM, a store item, if ITEM was built locally.
 Otherwise return #f."
   (lambda (store)
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-protocol-error? c)
                (values #f store)))
       (if (locally-built? store item)
           (values (query-path-hash store item) store)
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 145a574dba..8efeef3274 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -299,7 +299,7 @@ this type of graph")))))))
 information available in the local store or using information about
 substitutes."
   (lambda (store)
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-protocol-error? c)
                (match (substitutable-path-info store (list item))
                  ((info)
                   (values (substitutable-references info) store))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 665adcfb8d..ddad5b7fd0 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -833,11 +833,11 @@ descriptions maintained upstream."
   (define (try system)
     (catch #t
       (lambda ()
-        (guard (c ((nix-protocol-error? c)
+        (guard (c ((store-protocol-error? c)
                    (emit-warning package
                                  (format #f (G_ "failed to create ~a derivation: ~a")
                                          system
-                                         (nix-protocol-error-message c))))
+                                         (store-protocol-error-message c))))
                   ((message-condition? c)
                    (emit-warning package
                                  (format #f (G_ "failed to create ~a derivation: ~a")
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 30fe69ad6d..eb02672dbf 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -358,12 +358,12 @@ MACHINE."
   (format (current-error-port) "@ build-remote ~a ~a~%"
           (derivation-file-name drv) (build-machine-name machine))
 
-  (guard (c ((nix-protocol-error? c)
+  (guard (c ((store-protocol-error? c)
              (format (current-error-port)
                      (G_ "derivation '~a' offloaded to '~a' failed: ~a~%")
                      (derivation-file-name drv)
                      (build-machine-name machine)
-                     (nix-protocol-error-message c))
+                     (store-protocol-error-message c))
              (let* ((inferior (false-if-exception (remote-inferior session)))
                     (space (false-if-exception
                             (node-free-disk-space inferior))))
@@ -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)))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index d3a4401a01..41c7fb289a 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -46,6 +46,7 @@
   #:use-module ((gnu packages certs) #:select (le-certs))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)