Merge branch 'master' into core-updates

12 files changed, 259 insertions, 213 deletions

diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index fba0f73826..3318ef0889 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -55,7 +55,7 @@
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 9ad7379bbe..a853ac6c7d 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -504,7 +504,7 @@ options handled by 'set-build-options-from-command-line', and listed in
   (display (G_ "
       --no-grafts        do not graft packages"))
   (display (G_ "
-      --no-build-hook    do not attempt to offload builds via the build hook"))
+      --no-offload       do not attempt to offload builds"))
   (display (G_ "
       --max-silent-time=SECONDS
                          mark the build as failed after SECONDS of silence"))
@@ -545,7 +545,8 @@ talking to a remote daemon\n")))
                      #:fallback? (assoc-ref opts 'fallback?)
                      #:use-substitutes? (assoc-ref opts 'substitutes?)
                      #:substitute-urls (assoc-ref opts 'substitute-urls)
-                     #:use-build-hook? (assoc-ref opts 'build-hook?)
+                     #:offload? (and (assoc-ref opts 'offload?)
+                                     (not (assoc-ref opts 'keep-failed?)))
                      #:max-silent-time (assoc-ref opts 'max-silent-time)
                      #:timeout (assoc-ref opts 'timeout)
                      #:print-build-trace (assoc-ref opts 'print-build-trace?)
@@ -610,11 +611,15 @@ talking to a remote daemon\n")))
                          (alist-cons 'graft? #f
                                      (alist-delete 'graft? result eq?))
                          rest)))
-        (option '("no-build-hook") #f #f
+        (option '("no-offload" "no-build-hook") #f #f
                 (lambda (opt name arg result . rest)
+                  (when (string=? name "no-build-hook")
+                    (warning (G_ "'--no-build-hook' is deprecated; \
+use '--no-offload' instead~%")))
+
                   (apply values
-                         (alist-cons 'build-hook? #f
-                                     (alist-delete 'build-hook? result))
+                         (alist-cons 'offload? #f
+                                     (alist-delete 'offload? result))
                          rest)))
         (option '("max-silent-time") #t #f
                 (lambda (opt name arg result . rest)
@@ -659,7 +664,7 @@ talking to a remote daemon\n")))
   `((build-mode . ,(build-mode normal))
     (graft? . #t)
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)
@@ -802,7 +807,15 @@ build---packages, gexps, derivations, and so on."
   (append-map (match-lambda
                 (('argument . (? string? spec))
                  (cond ((derivation-path? spec)
-                        (list (read-derivation-from-file spec)))
+                        (catch 'system-error
+                          (lambda ()
+                            (list (read-derivation-from-file spec)))
+                          (lambda args
+                            ;; Non-existent .drv files can be substituted down
+                            ;; the road, so don't error out.
+                            (if (= ENOENT (system-error-errno args))
+                                '()
+                                (apply throw args)))))
                        ((store-path? spec)
                         ;; Nothing to do; maybe for --log-file.
                         '())
@@ -934,7 +947,11 @@ needed."
                                    '())))
                    (items (filter-map (match-lambda
                                         (('argument . (? store-path? file))
-                                         (and (not (derivation-path? file))
+                                         ;; If FILE is a .drv that's not in
+                                         ;; store, keep it so that it can be
+                                         ;; substituted.
+                                         (and (or (not (derivation-path? file))
+                                                  (not (file-exists? file)))
                                               file))
                                         (_ #f))
                                       opts))
@@ -965,7 +982,8 @@ needed."
                                (map (compose list derivation-file-name) drv)
                                roots))
                     ((not (assoc-ref opts 'dry-run?))
-                     (and (build-derivations store drv mode)
+                     (and (build-derivations store (append drv items)
+                                             mode)
                           (for-each show-derivation-outputs drv)
                           (for-each (cut register-root store <> <>)
                                     (map (lambda (drv)
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index ce70f2f0b3..664cb32b7c 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -158,7 +158,7 @@ Copy ITEMS to or from the specified host over SSH.\n"))
 (define %default-options
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index f311587ec3..bc0ceabd3f 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -62,6 +62,10 @@ Perform the deployment specified by FILE.\n"))
                  (lambda args
                    (show-help)
                    (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix deploy")))
+
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -80,7 +84,7 @@ Perform the deployment specified by FILE.\n"))
     (debug . 0)
     (graft? . #t)
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index d78ca0f303..f04363750e 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -191,7 +191,7 @@ COMMAND or an interactive shell in that environment.\n"))
 (define %default-options
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 1384f6b41d..e81b6c25f2 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -60,7 +60,7 @@
 ;;; retrieving the build output(s) over SSH upon success.
 ;;;
 ;;; This command should not be used directly; instead, it is called on-demand
-;;; by the daemon, unless it was started with '--no-build-hook' or a client
+;;; by the daemon, unless it was started with '--no-offload' or a client
 ;;; inhibited build hooks.
 ;;;
 ;;; Code:
@@ -149,19 +149,6 @@ ignoring it~%")
          (leave (G_ "failed to load machine file '~a': ~s~%")
                 file args))))))
 
-(define (host-key->type+key host-key)
-  "Destructure HOST-KEY, an OpenSSH host key string, and return two values:
-its key type as a symbol, and the actual base64-encoded string."
-  (define (type->symbol type)
-    (and (string-prefix? "ssh-" type)
-         (string->symbol (string-drop type 4))))
-
-  (match (string-tokenize host-key)
-    ((type key x)
-     (values (type->symbol type) key))
-    ((type key)
-     (values (type->symbol type) key))))
-
 (define (private-key-from-file* file)
   "Like 'private-key-from-file', but raise an error that 'with-error-handling'
 can interpret meaningfully."
@@ -203,21 +190,8 @@ private key from '~a': ~a")
                                (build-machine-compression-level machine))))
     (match (connect! session)
       ('ok
-       ;; Authenticate the server.  XXX: Guile-SSH 0.10.1 doesn't know about
-       ;; ed25519 keys and 'get-key-type' returns #f in that case.
-       (let-values (((server)   (get-server-public-key session))
-                    ((type key) (host-key->type+key
-                                 (build-machine-host-key machine))))
-         (unless (and (or (not (get-key-type server))
-                          (eq? (get-key-type server) type))
-                      (string=? (public-key->string server) key))
-           ;; Key mismatch: something's wrong.  XXX: It could be that the server
-           ;; provided its Ed25519 key when we where expecting its RSA key.
-           (leave (G_ "server at '~a' returned host key '~a' of type '~a' \
-instead of '~a' of type '~a'~%")
-                  (build-machine-name machine)
-                  (public-key->string server) (get-key-type server)
-                  key type)))
+       ;; Make sure the server's key is what we expect.
+       (authenticate-server* session (build-machine-host-key machine))
 
        (let ((auth (userauth-public-key! session private)))
          (unless (eq? 'success auth)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 920d6c01fe..61d18e2609 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -759,7 +759,7 @@ last resort for relocation."
     (profile-name . "guix-profile")
     (system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
@@ -800,6 +800,10 @@ last resort for relocation."
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+         (option '(#\d "derivation") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'derivation-only? #t result)))
+
          (option '(#\f "format") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'format (string->symbol arg) result)))
@@ -918,6 +922,8 @@ Create a bundle of PACKAGE.\n"))
   -r, --root=FILE        make FILE a symlink to the result, and register it
                          as a garbage collector root"))
   (display (G_ "
+  -d, --derivation       return the derivation of the pack"))
+  (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
       --bootstrap        use the bootstrap binaries to build the pack"))
@@ -959,7 +965,10 @@ Create a bundle of PACKAGE.\n"))
                                   (list (transform store package) "out")))
                                (reverse
                                 (filter-map maybe-package-argument opts))))
-           (manifest-file (assoc-ref opts 'manifest)))
+           (manifests     (filter-map (match-lambda
+                                        (('manifest . file) file)
+                                        (_ #f))
+                                      opts)))
       (define properties
         (if (assoc-ref opts 'save-provenance?)
             (lambda (package)
@@ -973,11 +982,15 @@ Create a bundle of PACKAGE.\n"))
             (const '())))
 
       (cond
-       ((and manifest-file (not (null? packages)))
+       ((and (not (null? manifests)) (not (null? packages)))
         (leave (G_ "both a manifest and a package list were given~%")))
-       (manifest-file
-        (let ((user-module (make-user-module '((guix profiles) (gnu)))))
-          (load* manifest-file user-module)))
+       ((not (null? manifests))
+        (concatenate-manifests
+         (map (lambda (file)
+                (let ((user-module (make-user-module
+                                    '((guix profiles) (gnu)))))
+                  (load* file user-module)))
+              manifests)))
        (else
         (manifest
          (map (match-lambda
@@ -1002,6 +1015,7 @@ Create a bundle of PACKAGE.\n"))
                                           (assoc-ref opts 'system)
                                           #:graft? (assoc-ref opts 'graft?))))
           (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+                 (derivation? (assoc-ref opts 'derivation-only?))
                  (relocatable? (assoc-ref opts 'relocatable?))
                  (proot?      (eq? relocatable? 'proot))
                  (manifest    (let ((manifest (manifest-from-args store opts)))
@@ -1070,11 +1084,15 @@ Create a bundle of PACKAGE.\n"))
                                                      #:archiver
                                                      archiver)))
                 (mbegin %store-monad
-                  (show-what-to-build* (list drv)
-                                       #:use-substitutes?
-                                       (assoc-ref opts 'substitutes?)
-                                       #:dry-run? dry-run?)
-                  (munless dry-run?
+                  (munless derivation?
+                    (show-what-to-build* (list drv)
+                                         #:use-substitutes?
+                                         (assoc-ref opts 'substitutes?)
+                                         #:dry-run? dry-run?))
+                  (mwhen derivation?
+                    (return (format #t "~a~%"
+                                    (derivation-file-name drv))))
+                  (munless (or derivation? dry-run?)
                     (built-derivations (list drv))
                     (mwhen gc-root
                       (register-root* (match (derivation->output-paths drv)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index bcd03a1df9..92c6e34194 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -318,7 +318,7 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
     (debug . 0)
     (graft? . #t)
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)))
@@ -832,32 +832,17 @@ processed, #f otherwise."
   (unless dry-run?
     (delete-matching-generations store profile pattern)))
 
-(define* (manifest-action store profile file opts
-                          #:key dry-run?)
-  "Change PROFILE to contain the packages specified in FILE."
-  (let* ((user-module  (make-user-module '((guix profiles) (gnu))))
-         (manifest     (load* file user-module))
-         (bootstrap?   (assoc-ref opts 'bootstrap?))
-         (substitutes? (assoc-ref opts 'substitutes?))
-         (allow-collisions? (assoc-ref opts 'allow-collisions?)))
-    (if dry-run?
-        (format #t (G_ "would install new manifest from '~a' with ~d entries~%")
-                file (length (manifest-entries manifest)))
-        (format #t (G_ "installing new manifest from '~a' with ~d entries~%")
-                file (length (manifest-entries manifest))))
-    (build-and-use-profile store profile manifest
-                           #:allow-collisions? allow-collisions?
-                           #:bootstrap? bootstrap?
-                           #:use-substitutes? substitutes?
-                           #:dry-run? dry-run?)))
+(define (load-manifest file)
+  "Load the user-profile manifest (Scheme code) from FILE and return it."
+  (let ((user-module (make-user-module '((guix profiles) (gnu)))))
+    (load* file user-module)))
 
 (define %actions
   ;; List of actions that may be processed.  The car of each pair is the
   ;; action's symbol in the option list; the cdr is the action's procedure.
   `((roll-back? . ,roll-back-action)
     (switch-generation . ,switch-generation-action)
-    (delete-generations . ,delete-generations-action)
-    (manifest . ,manifest-action)))
+    (delete-generations . ,delete-generations-action)))
 
 (define (process-actions store opts)
   "Process any install/remove/upgrade action from OPTS."
@@ -881,11 +866,7 @@ processed, #f otherwise."
 
   ;; First, acquire a lock on the profile, to ensure only one guix process
   ;; is modifying it at a time.
-  (with-file-lock/no-wait (string-append profile ".lock")
-    (lambda (key . args)
-      (leave (G_ "profile ~a is locked by another process~%")
-                 profile))
-
+  (with-profile-lock profile
     ;; Then, process roll-backs, generation removals, etc.
     (for-each (match-lambda
                 ((key . arg)
@@ -896,7 +877,13 @@ processed, #f otherwise."
               opts)
 
     ;; Then, process normal package removal/installation/upgrade.
-    (let* ((manifest (profile-manifest profile))
+    (let* ((files    (filter-map (match-lambda
+                                   (('manifest . file) file)
+                                   (_ #f))
+                                 opts))
+           (manifest (match files
+                       (() (profile-manifest profile))
+                       (_  (concatenate-manifests (map load-manifest files)))))
            (step1    (options->removable opts manifest
                                          (manifest-transaction)))
            (step2    (options->installable opts manifest step1))
@@ -904,12 +891,23 @@ processed, #f otherwise."
                       (inherit step2)
                       (install (map transform-entry
                                     (manifest-transaction-install step2)))))
-           (new      (manifest-perform-transaction manifest step3)))
+           (new      (manifest-perform-transaction manifest step3))
+           (trans    (if (null? files)
+                         step3
+                         (fold manifest-transaction-install-entry
+                               step3
+                               (manifest-entries manifest)))))
 
       (warn-about-old-distro)
 
-      (unless (manifest-transaction-null? step3)
-        (show-manifest-transaction store manifest step3
+      (unless (manifest-transaction-null? trans)
+        ;; When '--manifest' is used, display information about TRANS as if we
+        ;; were starting from an empty profile.
+        (show-manifest-transaction store
+                                   (if (null? files)
+                                       manifest
+                                       (make-manifest '()))
+                                   trans
                                    #:dry-run? dry-run?)
         (build-and-use-profile store profile new
                                #:allow-collisions? allow-collisions?
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 0ab688ac24..19410ad141 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -36,6 +36,8 @@
   #:autoload   (guix inferior) (open-inferior)
   #:use-module (guix scripts build)
   #:autoload   (guix build utils) (which)
+  #:use-module ((guix build syscalls)
+                #:select (with-file-lock/no-wait))
   #:use-module (guix git)
   #:use-module (git)
   #:use-module (gnu packages)
@@ -52,6 +54,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
+  #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
@@ -69,7 +72,7 @@
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)
@@ -182,6 +185,42 @@ Download and deploy the latest version of Guix.\n"))
 
          %standard-build-options))
 
+(define %vcs-web-views
+  ;; Hard-coded list of host names and corresponding web view URL templates.
+  ;; TODO: Allow '.guix-channel' files to specify a URL template.
+  (let ((labhub-url (lambda (repository-url commit)
+                      (string-append
+                       (if (string-suffix? ".git" repository-url)
+                           (string-drop-right repository-url 4)
+                           repository-url)
+                       "/commit/" commit))))
+    `(("git.savannah.gnu.org"
+       ,(lambda (repository-url commit)
+          (string-append (string-replace-substring repository-url
+                                                   "/git/" "/cgit/")
+                         "/commit/?id=" commit)))
+      ("notabug.org" ,labhub-url)
+      ("framagit.org" ,labhub-url)
+      ("gitlab.com" ,labhub-url)
+      ("gitlab.inria.fr" ,labhub-url)
+      ("github.com" ,labhub-url))))
+
+(define* (channel-commit-hyperlink channel
+                                   #:optional
+                                   (commit (channel-commit channel)))
+  "Return a hyperlink for COMMIT in CHANNEL, using COMMIT as the hyperlink's
+text.  The hyperlink links to a web view of COMMIT, when available."
+  (let* ((url  (channel-url channel))
+         (uri  (string->uri url))
+         (host (and uri (uri-host uri))))
+    (if host
+        (match (assoc host %vcs-web-views)
+          (#f
+           commit)
+          ((_ template)
+           (hyperlink (template url commit) commit)))
+        commit)))
+
 (define* (display-profile-news profile #:key concise?
                                current-is-newer?)
   "Display what's up in PROFILE--new packages, and all that.  If
@@ -245,15 +284,20 @@ purposes."
                 ;; When Texinfo markup is invalid, display it as-is.
                 (const title)))))))
 
-(define (display-news-entry entry language port)
-  "Display ENTRY, a <channel-news-entry>, in LANGUAGE, a language code, to
-PORT."
+(define (display-news-entry entry channel language port)
+  "Display ENTRY, a <channel-news-entry> from CHANNEL, in LANGUAGE, a language
+code, to PORT."
   (define body
     (channel-news-entry-body entry))
 
+  (define commit
+    (channel-news-entry-commit entry))
+
   (display-news-entry-title entry language port)
   (format port (dim (G_ "    commit ~a~%"))
-          (channel-news-entry-commit entry))
+          (if (supports-hyperlinks?)
+              (channel-commit-hyperlink channel commit)
+              commit))
   (newline port)
   (let ((body (or (assoc-ref body language)
                   (assoc-ref body (%default-message-language))
@@ -291,7 +335,7 @@ to display."
                    (channel-name channel))
            (for-each (if concise?
                          (cut display-news-entry-title <> language port)
-                         (cut display-news-entry <> language port))
+                         (cut display-news-entry <> channel language port))
                      entries)
            (newline port)
            #t))))))
@@ -526,10 +570,17 @@ way and displaying details about the channel's source code."
                                        ('branch branch)
                                        ('commit commit)
                                        _ ...))
-                 (format #t (G_ "    repository URL: ~a~%") url)
-                 (when branch
-                   (format #t (G_ "    branch: ~a~%") branch))
-                 (format #t (G_ "    commit: ~a~%") commit))
+                 (let ((channel (channel (name 'nameless)
+                                         (url url)
+                                         (branch branch)
+                                         (commit commit))))
+                   (format #t (G_ "    repository URL: ~a~%") url)
+                   (when branch
+                     (format #t (G_ "    branch: ~a~%") branch))
+                   (format #t (G_ "    commit: ~a~%")
+                           (if (supports-hyperlinks?)
+                               (channel-commit-hyperlink channel commit)
+                               commit))))
                 (_ #f)))
 
             ;; Show most recently installed packages last.
@@ -815,11 +866,12 @@ Use '~/.config/guix/channels.scm' instead."))
                                        (if (assoc-ref opts 'bootstrap?)
                                            %bootstrap-guile
                                            (canonical-package guile-2.2)))))
-                        (run-with-store store
-                          (build-and-install instances profile
-                                             #:dry-run?
-                                             (assoc-ref opts 'dry-run?)
-                                             #:use-substitutes?
-                                             (assoc-ref opts 'substitutes?))))))))))))))
+                        (with-profile-lock profile
+                          (run-with-store store
+                            (build-and-install instances profile
+                                               #:dry-run?
+                                               (assoc-ref opts 'dry-run?)
+                                               #:use-substitutes?
+                                               (assoc-ref opts 'substitutes?)))))))))))))))
 
 ;;; pull.scm ends here
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index dba08edf50..b6034a75d2 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -86,6 +86,8 @@
             read-narinfo
             write-narinfo
 
+            %allow-unauthenticated-substitutes?
+
             substitute-urls
             guix-substitute))
 
@@ -118,15 +120,21 @@
           (string-append %state-directory "/substitute/cache"))
       (string-append (cache-directory #:ensure? #f) "/substitute")))
 
+(define (warn-about-missing-authentication)
+  (warning (G_ "authentication and authorization of substitutes \
+disabled!~%"))
+  #t)
+
 (define %allow-unauthenticated-substitutes?
   ;; Whether to allow unchecked substitutes.  This is useful for testing
   ;; purposes, and should be avoided otherwise.
-  (and (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES")
-              (cut string-ci=? <> "yes"))
-       (begin
-         (warning (G_ "authentication and authorization of substitutes \
-disabled!~%"))
-         #t)))
+  (make-parameter
+   (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES")
+          (cut string-ci=? <> "yes"))
+   (lambda (value)
+     (when value
+       (warn-about-missing-authentication))
+     value)))
 
 (define %narinfo-ttl
   ;; Number of seconds during which cached narinfo lookups are considered
@@ -227,58 +235,6 @@ provide."
      (leave (G_ "unsupported substitute URI scheme: ~a~%")
             (uri->string uri)))))
 
-(define-record-type <cache-info>
-  (%make-cache-info url store-directory wants-mass-query?)
-  cache-info?
-  (url               cache-info-url)
-  (store-directory   cache-info-store-directory)
-  (wants-mass-query? cache-info-wants-mass-query?))
-
-(define (download-cache-info url)
-  "Download the information for the cache at URL.  On success, return a
-<cache-info> object and a port on which to send further HTTP requests.  On
-failure, return #f and #f."
-  (define uri
-    (string->uri (string-append url "/nix-cache-info")))
-
-  (define (read-cache-info port)
-    (alist->record (fields->alist port)
-                   (cut %make-cache-info url <...>)
-                   '("StoreDir" "WantMassQuery")))
-
-  (catch #t
-    (lambda ()
-      (case (uri-scheme uri)
-        ((file)
-         (values (call-with-input-file (uri-path uri)
-                   read-cache-info)
-                 #f))
-        ((http https)
-         (let ((port (guix:open-connection-for-uri
-                      uri
-                      #:verify-certificate? #f
-                      #:timeout %fetch-timeout)))
-           (guard (c ((http-get-error? c)
-                      (warning (G_ "while fetching '~a': ~a (~s)~%")
-                               (uri->string (http-get-error-uri c))
-                               (http-get-error-code c)
-                               (http-get-error-reason c))
-                      (close-connection port)
-                      (warning (G_ "ignoring substitute server at '~s'~%") url)
-                      (values #f #f)))
-             (values (read-cache-info (http-fetch uri
-                                                  #:verify-certificate? #f
-                                                  #:port port
-                                                  #:keep-alive? #t))
-                     port))))))
-    (lambda (key . args)
-      (case key
-        ((getaddrinfo-error system-error)
-         ;; Silently ignore the error: probably due to lack of network access.
-         (values #f #f))
-        (else
-         (apply throw key args))))))
-
 
 (define-record-type <narinfo>
   (%make-narinfo path uri-base uris compressions file-sizes file-hashes
@@ -366,22 +322,6 @@ must contain the original contents of a narinfo file."
                     (and=> signature narinfo-signature->canonical-sexp))
                    str)))
 
-(define* (assert-valid-signature narinfo signature hash
-                                 #:optional (acl (current-acl)))
-  "Bail out if SIGNATURE, a canonical sexp representing the signature of
-NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
-  (let ((uri (uri->string (first (narinfo-uris narinfo)))))
-    (signature-case (signature hash acl)
-      (valid-signature #t)
-      (invalid-signature
-       (leave (G_ "invalid signature for '~a'~%") uri))
-      (hash-mismatch
-       (leave (G_ "hash mismatch for '~a'~%") uri))
-      (unauthorized-key
-       (leave (G_ "'~a' is signed with an unauthorized key~%") uri))
-      (corrupt-signature
-       (leave (G_ "signature on '~a' is corrupt~%") uri)))))
-
 (define* (read-narinfo port #:optional url
                        #:key size)
   "Read a narinfo from PORT.  If URL is true, it must be a string used to
@@ -422,7 +362,7 @@ No authentication and authorization checks are performed here!"
 (define* (valid-narinfo? narinfo #:optional (acl (current-acl))
                          #:key verbose?)
   "Return #t if NARINFO's signature is not valid."
-  (or %allow-unauthenticated-substitutes?
+  (or (%allow-unauthenticated-substitutes?)
       (let ((hash      (narinfo-sha256 narinfo))
             (signature (narinfo-signature narinfo))
             (uri       (uri->string (first (narinfo-uris narinfo)))))
@@ -570,6 +510,9 @@ initial connection on which HTTP requests are sent."
   (let connect ((port     port)
                 (requests requests)
                 (result   seed))
+    (define batch
+      (at-most 1000 requests))
+
     ;; (format (current-error-port) "connecting (~a requests left)..."
     ;;         (length requests))
     (let ((p (or port (guix:open-connection-for-uri
@@ -580,7 +523,7 @@ initial connection on which HTTP requests are sent."
       (when (file-port? p)
         (setvbuf p 'block (expt 2 16)))
 
-      ;; Send REQUESTS, up to a certain number, in a row.
+      ;; Send BATCH in a row.
       ;; XXX: Do our own caching to work around inefficiencies when
       ;; communicating over TLS: <http://bugs.gnu.org/22966>.
       (let-values (((buffer get) (open-bytevector-output-port)))
@@ -588,16 +531,21 @@ initial connection on which HTTP requests are sent."
         (set-http-proxy-port?! buffer (http-proxy-port? p))
 
         (for-each (cut write-request <> buffer)
-                  (at-most 1000 requests))
+                  batch)
         (put-bytevector p (get))
         (force-output p))
 
       ;; Now start processing responses.
-      (let loop ((requests requests)
-                 (result   result))
-        (match requests
+      (let loop ((sent      batch)
+                 (processed 0)
+                 (result    result))
+        (match sent
           (()
-           (reverse result))
+           (match (drop requests processed)
+             (()
+              (reverse result))
+             (remainder
+              (connect port remainder result))))
           ((head tail ...)
            (let* ((resp   (read-response p))
                   (body   (response-body-port resp))
@@ -608,9 +556,11 @@ initial connection on which HTTP requests are sent."
              (match (assq 'connection (response-headers resp))
                (('connection 'close)
                 (close-connection p)
-                (connect #f tail result))         ;try again
+                (connect #f                       ;try again
+                         (append tail (drop requests processed))
+                         result))
                (_
-                (loop tail result))))))))))       ;keep going
+                (loop tail (+ 1 processed) result)))))))))) ;keep going
 
 (define (read-to-eof port)
   "Read from PORT until EOF is reached.  The data are discarded."
@@ -628,6 +578,41 @@ if file doesn't exist, and the narinfo otherwise."
           #f
           (apply throw args)))))
 
+(define %unreachable-hosts
+  ;; Set of names of unreachable hosts.
+  (make-hash-table))
+
+(define* (open-connection-for-uri/maybe uri
+                                        #:key
+                                        (verify-certificate? #f)
+                                        (time %fetch-timeout))
+  "Open a connection to URI and return a port to it, or, if connection failed,
+print a warning and return #f."
+  (define host
+    (uri-host uri))
+
+  (catch #t
+    (lambda ()
+      (guix:open-connection-for-uri uri
+                                    #:verify-certificate? verify-certificate?
+                                    #:timeout time))
+    (match-lambda*
+      (('getaddrinfo-error error)
+       (unless (hash-ref %unreachable-hosts host)
+         (hash-set! %unreachable-hosts host #t)   ;warn only once
+         (warning (G_ "~a: host not found: ~a~%")
+                  host (gai-strerror error)))
+       #f)
+      (('system-error . args)
+       (unless (hash-ref %unreachable-hosts host)
+         (hash-set! %unreachable-hosts host #t)
+         (warning (G_ "~a: connection failed: ~a~%") host
+                  (strerror
+                   (system-error-errno `(system-error ,@args)))))
+       #f)
+      (args
+       (apply throw args)))))
+
 (define (fetch-narinfos url paths)
   "Retrieve all the narinfos for PATHS from the cache at URL and return them."
   (define update-progress!
@@ -657,13 +642,18 @@ if file doesn't exist, and the narinfo otherwise."
            (len    (response-content-length response))
            (cache  (response-cache-control response))
            (ttl    (and cache (assoc-ref cache 'max-age))))
+      (update-progress!)
+
       ;; Make sure to read no more than LEN bytes since subsequent bytes may
       ;; belong to the next response.
       (if (= code 200)                            ; hit
           (let ((narinfo (read-narinfo port url #:size len)))
-            (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
-            (update-progress!)
-            (cons narinfo result))
+            (if (string=? (dirname (narinfo-path narinfo))
+                          (%store-prefix))
+                (begin
+                  (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
+                  (cons narinfo result))
+                result))
           (let* ((path      (uri-path (request-uri request)))
                  (hash-part (basename
                              (string-drop-right path 8)))) ;drop ".narinfo"
@@ -674,26 +664,28 @@ if file doesn't exist, and the narinfo otherwise."
                             (if (= 404 code)
                                 ttl
                                 %narinfo-transient-error-ttl))
-            (update-progress!)
             result))))
 
-  (define (do-fetch uri port)
+  (define (do-fetch uri)
     (case (and=> uri uri-scheme)
       ((http https)
        (let ((requests (map (cut narinfo-request url <>) paths)))
-         (update-progress!)
-
-         ;; Note: Do not check HTTPS server certificates to avoid depending on
-         ;; the X.509 PKI.  We can do it because we authenticate narinfos,
-         ;; which provides a much stronger guarantee.
-         (let ((result (http-multiple-get uri
-                                          handle-narinfo-response '()
-                                          requests
-                                          #:verify-certificate? #f
-                                          #:port port)))
-           (close-connection port)
-           (newline (current-error-port))
-           result)))
+         (match (open-connection-for-uri/maybe uri)
+           (#f
+            '())
+           (port
+            (update-progress!)
+            ;; Note: Do not check HTTPS server certificates to avoid depending
+            ;; on the X.509 PKI.  We can do it because we authenticate
+            ;; narinfos, which provides a much stronger guarantee.
+            (let ((result (http-multiple-get uri
+                                             handle-narinfo-response '()
+                                             requests
+                                             #:verify-certificate? #f
+                                             #:port port)))
+              (close-port port)
+              (newline (current-error-port))
+              result)))))
       ((file #f)
        (let* ((base  (string-append (uri-path uri) "/"))
               (files (map (compose (cut string-append base <> ".narinfo")
@@ -704,17 +696,7 @@ if file doesn't exist, and the narinfo otherwise."
        (leave (G_ "~s: unsupported server URI scheme~%")
               (if uri (uri-scheme uri) url)))))
 
-  (let-values (((cache-info port)
-                (download-cache-info url)))
-    (and cache-info
-         (if (string=? (cache-info-store-directory cache-info)
-                       (%store-prefix))
-             (do-fetch (string->uri url) port)    ;reuse PORT
-             (begin
-               (warning (G_ "'~a' uses different store '~a'; ignoring it~%")
-                        url (cache-info-store-directory cache-info))
-               (close-connection port)
-               #f)))))
+  (do-fetch (string->uri url)))
 
 (define (lookup-narinfos cache paths)
   "Return the narinfos for PATHS, invoking the server at CACHE when no
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d3e10b6dc7..5f0dce2093 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1020,7 +1020,7 @@ Some ACTIONS support additional ARGS.\n"))
   `((system . ,(%current-system))
     (target . #f)
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 19e635555a..1e800e160f 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -94,7 +94,7 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (build-hook? . #t)
+    (offload? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)