Merge branch 'master' into core-updates

9 files changed, 354 insertions, 171 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 4b0048b54b..7737e39b2d 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -60,6 +60,7 @@
             derivation-input-path
             derivation-input-sub-derivations
             derivation-input-output-paths
+            valid-derivation-input?
 
             &derivation-error
             derivation-error?
@@ -187,12 +188,25 @@ download with a fixed hash (aka. `fetchurl')."
      (map (cut derivation-path->output-path path <>)
           sub-drvs))))
 
-(define (derivation-prerequisites drv)
-  "Return the list of derivation-inputs required to build DRV, recursively."
+(define (valid-derivation-input? store input)
+  "Return true if INPUT is valid--i.e., if all the outputs it requests are in
+the store."
+  (every (cut valid-path? store <>)
+         (derivation-input-output-paths input)))
+
+(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
+  "Return the list of derivation-inputs required to build DRV, recursively.
+
+CUT? is a predicate that is passed a derivation-input and returns true to
+eliminate the given input and its dependencies from the search.  An example of
+search a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
+result is the set of prerequisites of DRV not already in valid."
   (let loop ((drv       drv)
              (result    '())
              (input-set (set)))
-    (let ((inputs (remove (cut set-contains? input-set <>)
+    (let ((inputs (remove (lambda (input)
+                            (or (set-contains? input-set input)
+                                (cut? input)))
                           (derivation-inputs drv))))
       (fold2 loop
              (append inputs result)
@@ -225,22 +239,36 @@ download with a fixed hash (aka. `fetchurl')."
 (define* (substitution-oracle store drv)
   "Return a one-argument procedure that, when passed a store file name,
 returns #t if it's substitutable and #f otherwise.  The returned procedure
-knows about all substitutes for all the derivations listed in DRV and their
-prerequisites.
+knows about all substitutes for all the derivations listed in DRV; it also
+knows about their prerequisites, unless they are themselves substitutable.
 
 Creating a single oracle (thus making a single 'substitutable-paths' call) and
 reusing it is much more efficient than calling 'has-substitutes?' or similar
 repeatedly, because it avoids the costs associated with launching the
 substituter many times."
+  (define valid?
+    (cut valid-path? store <>))
+
+  (define valid-input?
+    (cut valid-derivation-input? store <>))
+
+  (define (dependencies drv)
+    ;; Skip prerequisite sub-trees of DRV whose root is valid.  This allows us
+    ;; to ask the substituter for just as much as needed, instead of asking it
+    ;; for the whole world, which can be significantly faster when substitute
+    ;; info is not already in cache.
+    (append-map derivation-input-output-paths
+                (derivation-prerequisites drv valid-input?)))
+
   (let* ((paths (delete-duplicates
                  (fold (lambda (drv result)
                          (let ((self (match (derivation->output-paths drv)
                                        (((names . paths) ...)
-                                        paths)))
-                               (deps (append-map derivation-input-output-paths
-                                                 (derivation-prerequisites
-                                                  drv))))
-                           (append self deps result)))
+                                        paths))))
+                           (if (every valid? self)
+                               result
+                               (append (append self (dependencies drv))
+                                       result))))
                        '()
                        drv)))
          (subst (list->set (substitutable-paths store paths))))
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 761980ac8f..ab72405df0 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -144,6 +144,11 @@ or a TCP port number), and return it."
 
 (define (ftp-size conn file)
   "Return the size in bytes of FILE."
+
+  ;; Ask for "binary mode", otherwise some servers, such as sourceware.org,
+  ;; fail with 550 ("SIZE not allowed in ASCII mode").
+  (%ftp-command "TYPE I" 200 (ftp-connection-socket conn))
+
   (let ((message (%ftp-command (string-append "SIZE " file) 213
                                (ftp-connection-socket conn))))
     (string->number (string-trim-both message))))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f8646a081c..01290dba18 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -127,6 +127,12 @@ cross-compiling.)"
                        body ...)))
     (register-compiler! name)))
 
+(define-gexp-compiler (derivation-compiler (drv derivation?) system target)
+  ;; Derivations are the lowest-level representation, so this is the identity
+  ;; compiler.
+  (with-monad %store-monad
+    (return drv)))
+
 
 ;;;
 ;;; Inputs & outputs.
@@ -165,8 +171,6 @@ the cross-compilation target triplet."
   (with-monad %store-monad
     (sequence %store-monad
               (map (match-lambda
-                    ((and ((? derivation?) sub-drv ...) input)
-                     (return input))
                     ((and ((? struct? thing) sub-drv ...) input)
                      (mlet* %store-monad ((lower -> (lookup-compiler thing))
                                           (drv (lower thing system target)))
@@ -197,6 +201,11 @@ names and file names suitable for the #:allowed-references argument to
       (match-lambda
        ((? string? output)
         (return output))
+       (($ <gexp-input> thing output native?)
+        (mlet* %store-monad ((lower -> (lookup-compiler thing))
+                             (drv      (lower thing system
+                                              (if native? #f target))))
+          (return (derivation->output-path drv output))))
        (thing
         (mlet* %store-monad ((lower -> (lookup-compiler thing))
                              (drv      (lower thing system target)))
@@ -262,6 +271,7 @@ The other arguments are as for 'derivation'."
   (define (graphs-file-names graphs)
     ;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
     (map (match-lambda
+          ;; TODO: Remove 'derivation?' special cases.
            ((file-name (? derivation? drv))
             (cons file-name (derivation->output-path drv)))
            ((file-name (? derivation? drv) sub-drv)
@@ -343,15 +353,23 @@ The other arguments are as for 'derivation'."
                       #:allowed-references allowed
                       #:local-build? local-build?))))
 
-(define* (gexp-inputs exp #:optional (references gexp-references))
-  "Return the input list for EXP, using REFERENCES to get its list of
-references."
+(define* (gexp-inputs exp #:key native?)
+  "Return the input list for EXP.  When NATIVE? is true, return only native
+references; otherwise, return only non-native references."
   (define (add-reference-inputs ref result)
     (match ref
-      (($ <gexp-input> (? derivation? drv) output)
-       (cons `(,drv ,output) result))
-      (($ <gexp-input> (? gexp? exp))
-       (append (gexp-inputs exp references) result))
+      (($ <gexp-input> (? gexp? exp) _ #t)
+       (if native?
+           (append (gexp-inputs exp)
+                   (gexp-inputs exp #:native? #t)
+                   result)
+           result))
+      (($ <gexp-input> (? gexp? exp) _ #f)
+       (if native?
+           (append (gexp-inputs exp #:native? #t)
+                   result)
+           (append (gexp-inputs exp)
+                   result)))
       (($ <gexp-input> (? string? str))
        (if (direct-store-path? str)
            (cons `(,str) result)
@@ -361,13 +379,13 @@ references."
            ;; THING is a derivation, or a package, or an origin, etc.
            (cons `(,thing ,output) result)
            result))
-      (($ <gexp-input> (lst ...) output native?)
+      (($ <gexp-input> (lst ...) output n?)
        (fold-right add-reference-inputs result
                    ;; XXX: For now, automatically convert LST to a list of
                    ;; gexp-inputs.
                    (map (match-lambda
                          ((? gexp-input? x) x)
-                         (x (%gexp-input x "out" native?)))
+                         (x (%gexp-input x "out" (or n? native?))))
                         lst)))
       (_
        ;; Ignore references to other kinds of objects.
@@ -375,10 +393,12 @@ references."
 
   (fold-right add-reference-inputs
               '()
-              (references exp)))
+              (if native?
+                  (gexp-native-references exp)
+                  (gexp-references exp))))
 
 (define gexp-native-inputs
-  (cut gexp-inputs <> gexp-native-references))
+  (cut gexp-inputs <> #:native? #t))
 
 (define (gexp-outputs exp)
   "Return the outputs referred to by EXP as a list of strings."
@@ -411,8 +431,6 @@ and in the current monad setting (system type, etc.)"
   (define* (reference->sexp ref #:optional native?)
     (with-monad %store-monad
       (match ref
-        (($ <gexp-input> (? derivation? drv) output)
-         (return (derivation->output-path drv output)))
         (($ <gexp-output> output)
          ;; Output file names are not known in advance but the daemon defines
          ;; an environment variable for each of them at build time, so use
@@ -468,13 +486,20 @@ and in the current monad setting (system type, etc.)"
       ;; Return all the 'ungexp' present in EXP.
       (let loop ((exp    exp)
                  (result '()))
-        (syntax-case exp (ungexp ungexp-splicing)
+        (syntax-case exp (ungexp
+                          ungexp-splicing
+                          ungexp-native
+                          ungexp-native-splicing)
           ((ungexp _)
            (cons exp result))
           ((ungexp _ _)
            (cons exp result))
           ((ungexp-splicing _ ...)
            (cons exp result))
+          ((ungexp-native _ ...)
+           result)
+          ((ungexp-native-splicing _ ...)
+           result)
           ((exp0 exp ...)
            (let ((result (loop #'exp0 result)))
              (fold loop result #'(exp ...))))
@@ -485,13 +510,20 @@ and in the current monad setting (system type, etc.)"
       ;; Return all the 'ungexp-native' forms present in EXP.
       (let loop ((exp    exp)
                  (result '()))
-        (syntax-case exp (ungexp-native ungexp-native-splicing)
+        (syntax-case exp (ungexp
+                          ungexp-splicing
+                          ungexp-native
+                          ungexp-native-splicing)
           ((ungexp-native _)
            (cons exp result))
           ((ungexp-native _ _)
            (cons exp result))
           ((ungexp-native-splicing _ ...)
            (cons exp result))
+          ((ungexp _ ...)
+           result)
+          ((ungexp-splicing _ ...)
+           result)
           ((exp0 exp ...)
            (let ((result (loop #'exp0 result)))
              (fold loop result #'(exp ...))))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 69717b6317..c40d76b558 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -259,20 +259,20 @@ response from URI, and additional details, such as the actual HTTP response."
       ('ftp
        (catch #t
          (lambda ()
-           (let ((port (ftp-open (uri-host uri) 21)))
+           (let ((conn (ftp-open (uri-host uri) 21)))
              (define response
                (dynamic-wind
                  (const #f)
                  (lambda ()
-                   (ftp-chdir port (dirname (uri-path uri)))
-                   (ftp-size port (basename (uri-path uri))))
+                   (ftp-chdir conn (dirname (uri-path uri)))
+                   (ftp-size conn (basename (uri-path uri))))
                  (lambda ()
-                   (ftp-close port))))
-             (values 'ftp-response #t)))
+                   (ftp-close conn))))
+             (values 'ftp-response '(ok))))
          (lambda (key . args)
            (case key
-             ((or ftp-error)
-              (values 'ftp-response #f))
+             ((ftp-error)
+              (values 'ftp-response `(error ,@args)))
              ((getaddrinfo-error system-error gnutls-error)
               (values key args))
              (else
@@ -296,11 +296,14 @@ warning for PACKAGE mentionning the FIELD."
                                  (response-reason-phrase argument))
                          field)))
       ((ftp-response)
-       (when (not argument)
-         (emit-warning package
-                       (format #f
-                               (_ "URI ~a not reachable")
-                               (uri->string uri)))))
+       (match argument
+         (('ok) #t)
+         (('error port command code message)
+          (emit-warning package
+                        (format #f
+                                (_ "URI ~a not reachable: ~a (~s)")
+                                (uri->string uri)
+                                code (string-trim-both message))))))
       ((getaddrinfo-error)
        (emit-warning package
                      (format #f
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index a24c657ef6..3cc7ae760f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -240,28 +240,27 @@ DURATION-RELATION with the current time."
 (define (find-packages-by-description rx)
   "Return the list of packages whose name, synopsis, or description matches
 RX."
-  (define (same-location? p1 p2)
-    ;; Compare locations of two packages.
-    (equal? (package-location p1) (package-location p2)))
-
-  (delete-duplicates
-   (sort
-    (fold-packages (lambda (package result)
-                     (define matches?
-                       (cut regexp-exec rx <>))
-
-                     (if (or (matches? (package-name package))
-                             (and=> (package-synopsis package)
-                                    (compose matches? P_))
-                             (and=> (package-description package)
-                                    (compose matches? P_)))
-                         (cons package result)
-                         result))
-                   '())
-    (lambda (p1 p2)
-      (string<? (package-name p1)
-                (package-name p2))))
-   same-location?))
+  (define version<? (negate version>=?))
+
+  (sort
+   (fold-packages (lambda (package result)
+                    (define matches?
+                      (cut regexp-exec rx <>))
+
+                    (if (or (matches? (package-name package))
+                            (and=> (package-synopsis package)
+                                   (compose matches? P_))
+                            (and=> (package-description package)
+                                   (compose matches? P_)))
+                        (cons package result)
+                        result))
+                  '())
+   (lambda (p1 p2)
+     (case (string-compare (package-name p1) (package-name p2)
+                           (const '<) (const '=) (const '>))
+       ((=)  (version<? (package-version p1) (package-version p2)))
+       ((<)  #t)
+       (else #f)))))
 
 (define-syntax-rule (leave-on-EPIPE exp ...)
   "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute.scm
index 50e3db2fb9..adf94a7ac3 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute.scm
@@ -17,7 +17,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (guix scripts substitute-binary)
+(define-module (guix scripts substitute)
   #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix utils)
@@ -28,13 +28,12 @@
   #:use-module (guix base64)
   #:use-module (guix pk-crypto)
   #:use-module (guix pki)
-  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 threads)
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
@@ -48,11 +47,13 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (web uri)
+  #:use-module (web request)
+  #:use-module (web response)
   #:use-module (guix http-client)
   #:export (narinfo-signature->canonical-sexp
             read-narinfo
             write-narinfo
-            guix-substitute-binary))
+            guix-substitute))
 
 ;;; Comment:
 ;;;
@@ -68,8 +69,8 @@
 (define %narinfo-cache-directory
   ;; A local cache of narinfos, to avoid going to the network.
   (or (and=> (getenv "XDG_CACHE_HOME")
-             (cut string-append <> "/guix/substitute-binary"))
-      (string-append %state-directory "/substitute-binary/cache")))
+             (cut string-append <> "/guix/substitute"))
+      (string-append %state-directory "/substitute/cache")))
 
 (define %allow-unauthenticated-substitutes?
   ;; Whether to allow unchecked substitutes.  This is useful for testing
@@ -94,15 +95,6 @@ disabled!~%"))
   ;; How often we want to remove files corresponding to expired cache entries.
   (* 7 24 3600))
 
-;; In Guile 2.0.9, `regexp-exec' is thread-unsafe, so work around it.
-;; See <http://bugs.gnu.org/14404>.
-(set! regexp-exec
-      (let ((real regexp-exec)
-            (lock (make-mutex)))
-        (lambda (rx str . rest)
-          (with-mutex lock
-            (apply real rx str rest)))))
-
 (define fields->alist
   ;; The narinfo format is really just like recutils.
   recutils->alist)
@@ -218,7 +210,7 @@ failure."
 gonna have to wait."
   (delay (begin
            (format (current-error-port)
-                   (_ "updating list of substitutes from '~a'...~%")
+                   (_ "updating list of substitutes from '~a'...\r")
                    url)
            (open-cache url))))
 
@@ -309,12 +301,16 @@ NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
       (corrupt-signature
        (leave (_ "signature on '~a' is corrupt~%") uri)))))
 
-(define* (read-narinfo port #:optional url)
+(define* (read-narinfo port #:optional url
+                       #:key size)
   "Read a narinfo from PORT.  If URL is true, it must be a string used to
-build full URIs from relative URIs found while reading PORT.
+build full URIs from relative URIs found while reading PORT.  When SIZE is
+true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
 
 No authentication and authorization checks are performed here!"
-  (let ((str (utf8->string (get-bytevector-all port))))
+  (let ((str (utf8->string (if size
+                               (get-bytevector-n port size)
+                               (get-bytevector-all port)))))
     (alist->record (call-with-input-string str fields->alist)
                    (narinfo-maker str url)
                    '("StorePath" "URL" "Compression"
@@ -376,40 +372,56 @@ or is signed by an unauthorized key."
 the cache STR originates form."
   (call-with-input-string str (cut read-narinfo <> cache-uri)))
 
-(define (fetch-narinfo cache path)
-  "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
-  (define (download url)
-    ;; Download the .narinfo from URL, and return its contents as a list of
-    ;; key/value pairs.  Don't emit an error message upon 404.
-    (false-if-exception (fetch (string->uri url)
-                               #:quiet-404? #t)))
-
-  (and (string=? (cache-store-directory cache) (%store-prefix))
-       (and=> (download (string-append (cache-url cache) "/"
-                                       (store-path-hash-part path)
-                                       ".narinfo"))
-              (cute read-narinfo <> (cache-url cache)))))
-
 (define (obsolete? date now ttl)
   "Return #t if DATE is obsolete compared to NOW + TTL seconds."
   (time>? (subtract-duration now (make-time time-duration 0 ttl))
           (make-time time-monotonic 0 date)))
 
-(define %lookup-threads
-  ;; Number of threads spawned to perform lookup operations.  This means we
-  ;; can have this many simultaneous HTTP GET requests to the server, which
-  ;; limits the impact of connection latency.
-  20)
 
-(define (lookup-narinfo cache path)
-  "Check locally if we have valid info about PATH, otherwise go to CACHE and
-check what it has."
+(define (narinfo-cache-file path)
+  "Return the name of the local file that contains an entry for PATH."
+  (string-append %narinfo-cache-directory "/"
+                 (store-path-hash-part path)))
+
+(define (cached-narinfo path)
+  "Check locally if we have valid info about PATH.  Return two values: a
+Boolean indicating whether we have valid cached info, and that info, which may
+be either #f (when PATH is unavailable) or the narinfo for PATH."
   (define now
     (current-time time-monotonic))
 
   (define cache-file
-    (string-append %narinfo-cache-directory "/"
-                   (store-path-hash-part path)))
+    (narinfo-cache-file path))
+
+  (catch 'system-error
+    (lambda ()
+      (call-with-input-file cache-file
+        (lambda (p)
+          (match (read p)
+            (('narinfo ('version 1)
+                       ('cache-uri cache-uri)
+                       ('date date) ('value #f))
+             ;; A cached negative lookup.
+             (if (obsolete? date now %narinfo-negative-ttl)
+                 (values #f #f)
+                 (values #t #f)))
+            (('narinfo ('version 1)
+                       ('cache-uri cache-uri)
+                       ('date date) ('value value))
+             ;; A cached positive lookup
+             (if (obsolete? date now %narinfo-ttl)
+                 (values #f #f)
+                 (values #t (string->narinfo value cache-uri))))
+            (('narinfo ('version v) _ ...)
+             (values #f #f))))))
+    (lambda _
+      (values #f #f))))
+
+(define (cache-narinfo! cache path narinfo)
+  "Cache locally NARNIFO for PATH, which originates from CACHE.  NARINFO may
+be #f, in which case it indicates that PATH is unavailable at CACHE."
+  (define now
+    (current-time time-monotonic))
 
   (define (cache-entry cache-uri narinfo)
     `(narinfo (version 1)
@@ -417,43 +429,153 @@ check what it has."
               (date ,(time-second now))
               (value ,(and=> narinfo narinfo->string))))
 
-  (let*-values (((valid? cached)
-                 (catch 'system-error
-                   (lambda ()
-                     (call-with-input-file cache-file
-                       (lambda (p)
-                         (match (read p)
-                           (('narinfo ('version 1)
-                                      ('cache-uri cache-uri)
-                                      ('date date) ('value #f))
-                            ;; A cached negative lookup.
-                            (if (obsolete? date now %narinfo-negative-ttl)
-                                (values #f #f)
-                                (values #t #f)))
-                           (('narinfo ('version 1)
-                                      ('cache-uri cache-uri)
-                                      ('date date) ('value value))
-                            ;; A cached positive lookup
-                            (if (obsolete? date now %narinfo-ttl)
-                                (values #f #f)
-                                (values #t (string->narinfo value
-                                                            cache-uri))))
-                           (('narinfo ('version v) _ ...)
-                            (values #f #f))))))
-                   (lambda _
-                     (values #f #f)))))
-    (if valid?
-        cached                                    ; including negative caches
+  (with-atomic-file-output (narinfo-cache-file path)
+    (lambda (out)
+      (write (cache-entry (cache-url cache) narinfo) out)))
+  narinfo)
+
+(define (narinfo-request cache-url path)
+  "Return an HTTP request for the narinfo of PATH at CACHE-URL."
+  (let ((url (string-append cache-url "/" (store-path-hash-part path)
+                            ".narinfo")))
+    (build-request (string->uri url) #:method 'GET)))
+
+(define (http-multiple-get base-url requests proc)
+  "Send all of REQUESTS to the server at BASE-URL.  Call PROC for each
+response, passing it the request object, the response, and a port from which
+to read the response body.  Return the list of results."
+  (let connect ((requests requests)
+                (result   '()))
+    ;; (format (current-error-port) "connecting (~a requests left)..."
+    ;;         (length requests))
+    (let ((p (open-socket-for-uri base-url)))
+      ;; Send all of REQUESTS in a row.
+      (setvbuf p _IOFBF (expt 2 16))
+      (for-each (cut write-request <> p) requests)
+      (force-output p)
+
+      ;; Now start processing responses.
+      (let loop ((requests requests)
+                 (result   result))
+        (match requests
+          (()
+           (reverse result))
+          ((head tail ...)
+           (let* ((resp (read-response p))
+                  (body (response-body-port resp)))
+             ;; The server can choose to stop responding at any time, in which
+             ;; case we have to try again.  Check whether that is the case.
+             (match (assq 'connection (response-headers resp))
+               (('connection 'close)
+                (connect requests result))        ;try again
+               (_
+                (loop tail                        ;keep going
+                      (cons (proc head resp body) result)))))))))))
+
+(define (read-to-eof port)
+  "Read from PORT until EOF is reached.  The data are discarded."
+  (dump-port port (%make-void-port "w")))
+
+(define (narinfo-from-file file url)
+  "Attempt to read a narinfo from FILE, using URL as the cache URL.  Return #f
+if file doesn't exist, and the narinfo otherwise."
+  (catch 'system-error
+    (lambda ()
+      (call-with-input-file file
+        (cut read-narinfo <> url)))
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          #f
+          (apply throw args)))))
+
+(define (fetch-narinfos cache paths)
+  "Retrieve all the narinfos for PATHS from CACHE and return them."
+  (define url
+    (cache-url cache))
+
+  (define update-progress!
+    (let ((done 0))
+      (lambda ()
+        (display #\cr (current-error-port))
+        (force-output (current-error-port))
+        (format (current-error-port)
+                (_ "updating list of substitutes from '~a'... ~5,1f%")
+                url (* 100. (/ done (length paths))))
+        (set! done (+ 1 done)))))
+
+  (define (handle-narinfo-response request response port)
+    (let ((len (response-content-length response)))
+      ;; Make sure to read no more than LEN bytes since subsequent bytes may
+      ;; belong to the next response.
+      (case (response-code response)
+        ((200)                                     ; hit
+         (let ((narinfo (read-narinfo port url #:size len)))
+           (cache-narinfo! cache (narinfo-path narinfo) narinfo)
+           (update-progress!)
+           narinfo))
+        ((404)                                     ; failure
+         (let* ((path      (uri-path (request-uri request)))
+                (hash-part (string-drop-right path 8))) ; drop ".narinfo"
+           (if len
+               (get-bytevector-n port len)
+               (read-to-eof port))
+           (cache-narinfo! cache
+                           (find (cut string-contains <> hash-part) paths)
+                           #f)
+           (update-progress!))
+         #f)
+        (else                                      ; transient failure
+         (if len
+             (get-bytevector-n port len)
+             (read-to-eof port))
+         #f))))
+
+  (and (string=? (cache-store-directory cache) (%store-prefix))
+       (let ((uri (string->uri url)))
+         (case (and=> uri uri-scheme)
+           ((http)
+            (let ((requests (map (cut narinfo-request url <>) paths)))
+              (update-progress!)
+              (let ((result (http-multiple-get url requests
+                                               handle-narinfo-response)))
+                (newline (current-error-port))
+                result)))
+           ((file #f)
+            (let* ((base  (string-append (uri-path uri) "/"))
+                   (files (map (compose (cut string-append base <> ".narinfo")
+                                        store-path-hash-part)
+                               paths)))
+              (filter-map (cut narinfo-from-file <> url) files)))
+           (else
+            (leave (_ "~s: unsupported server URI scheme~%")
+                   (if uri (uri-scheme uri) url)))))))
+
+(define (lookup-narinfos cache paths)
+  "Return the narinfos for PATHS, invoking the server at CACHE when no
+information is available locally."
+  (let-values (((cached missing)
+                (fold2 (lambda (path cached missing)
+                         (let-values (((valid? value)
+                                       (cached-narinfo path)))
+                           (if valid?
+                               (values (cons value cached) missing)
+                               (values cached (cons path missing)))))
+                       '()
+                       '()
+                       paths)))
+    (if (null? missing)
+        cached
         (let* ((cache   (force cache))
-               (narinfo (and cache (fetch-narinfo cache path))))
-          ;; Cache NARINFO only when CACHE was actually accessible.  This
-          ;; avoids caching negative hits when in fact we just lacked network
-          ;; access.
-          (when cache
-            (with-atomic-file-output cache-file
-              (lambda (out)
-                (write (cache-entry (cache-url cache) narinfo) out))))
-          narinfo))))
+               (missing (if cache
+                            (fetch-narinfos cache missing)
+                            '())))
+          (append cached missing)))))
+
+(define (lookup-narinfo cache path)
+  "Return the narinfo for PATH in CACHE, or #f when no substitute for PATH was
+found."
+  (match (lookup-narinfos cache (list path))
+    ((answer) answer)))
 
 (define (remove-expired-cached-narinfos)
   "Remove expired narinfo entries from the cache.  The sole purpose of this
@@ -553,7 +675,7 @@ PORT.  REPORT-PROGRESS is a two-argument procedure such as that returned by
 ;;;
 
 (define (show-help)
-  (display (_ "Usage: guix substitute-binary [OPTION]...
+  (display (_ "Usage: guix substitute [OPTION]...
 Internal tool to substitute a pre-built binary to a local build.\n"))
   (display (_ "
       --query            report on the availability of substitutes for the
@@ -576,16 +698,6 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
 ;;; Entry point.
 ;;;
 
-(define n-par-map*
-  ;; We want the ability to run many threads in parallel, regardless of the
-  ;; number of cores.  However, Guile 2.0.5 has a bug whereby 'n-par-map' ends
-  ;; up consuming a lot of memory, possibly leading to death.  Thus, resort to
-  ;; 'par-map' on 2.0.5.
-  (if (guile-version>? "2.0.5")
-      n-par-map
-      (lambda (n proc lst)
-        (par-map proc lst))))
-
 (define (check-acl-initialized)
   "Warn if the ACL is uninitialized."
   (define (singleton? acl)
@@ -631,12 +743,11 @@ found."
   (assoc-ref (daemon-options) option))
 
 (define %cache-url
-  (match (and=> (string-append
-                 ;; TODO: Uncomment the following lines when multiple
-                 ;; substitute sources are supported.
-                 ;; (find-daemon-option "untrusted-substitute-urls") ;client
-                 ;; " "
-                 (find-daemon-option "substitute-urls"))          ;admin
+  (match (and=> ;; TODO: Uncomment the following lines when multiple
+                ;; substitute sources are supported.
+                ;; (find-daemon-option "untrusted-substitute-urls") ;client
+                ;; " "
+                (find-daemon-option "substitute-urls")          ;admin
                 string-tokenize)
     ((url)
      url)
@@ -650,7 +761,7 @@ found."
      ;; daemon.
      "http://hydra.gnu.org")))
 
-(define (guix-substitute-binary . args)
+(define (guix-substitute . args)
   "Implement the build daemon's substituter protocol."
   (mkdir-p %narinfo-cache-directory)
   (maybe-remove-expired-cached-narinfo)
@@ -695,9 +806,7 @@ substituter disabled~%")
                      ;; Return the subset of PATHS available in CACHE.
                      (let ((substitutable
                             (if cache
-                                (n-par-map* %lookup-threads
-                                            (cut lookup-narinfo cache <>)
-                                            paths)
+                                (lookup-narinfos cache paths)
                                 '())))
                        (for-each (lambda (narinfo)
                                    (format #t "~a~%" (narinfo-path narinfo)))
@@ -707,9 +816,7 @@ substituter disabled~%")
                      ;; Reply info about PATHS if it's in CACHE.
                      (let ((substitutable
                             (if cache
-                                (n-par-map* %lookup-threads
-                                            (cut lookup-narinfo cache <>)
-                                            paths)
+                                (lookup-narinfos cache paths)
                                 '())))
                        (for-each (lambda (narinfo)
                                    (format #t "~a\n~a\n~a\n"
@@ -775,7 +882,7 @@ substituter disabled~%")
 
             (every (compose zero? cdr waitpid) pids))))
        (("--version")
-        (show-version-and-exit "guix substitute-binary"))
+        (show-version-and-exit "guix substitute"))
        (("--help")
         (show-help))
        (opts
@@ -786,4 +893,4 @@ substituter disabled~%")
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
 ;;; End:
 
-;;; substitute-binary.scm ends here
+;;; substitute.scm ends here
diff --git a/guix/store.scm b/guix/store.scm
index 45c555b12c..3d6b06989c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -447,6 +447,10 @@ encoding conversion errors."
                               (message "invalid error code")
                               (status   k))))))))
 
+(define %default-substitute-urls
+  ;; Default list of substituters.
+  '("http://hydra.gnu.org"))
+
 (define* (set-build-options server
                             #:key keep-failed? keep-going? fallback?
                             (verbosity 0)
@@ -459,7 +463,12 @@ encoding conversion errors."
                             (print-build-trace #t)
                             (build-cores (current-processor-count))
                             (use-substitutes? #t)
-                            (substitute-urls '())) ; client "untrusted" cache URLs
+
+                            ;; Client-provided substitute URLs.  For
+                            ;; unprivileged clients, these are considered
+                            ;; "untrusted"; for root, they override the
+                            ;; daemon's settings.
+                            (substitute-urls %default-substitute-urls))
   ;; Must be called after `open-connection'.
 
   (define socket
diff --git a/guix/tests.scm b/guix/tests.scm
index 0896e842da..080ee9cc74 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -126,7 +126,7 @@ Deriver: ~a~%"
 (define* (call-with-derivation-narinfo drv thunk
                                        #:key (sha256 (make-bytevector 32 0)))
   "Call THUNK in a context where fake substituter data, as read by 'guix
-substitute-binary', has been installed for DRV.  SHA256 is the hash of the
+substitute', has been installed for DRV.  SHA256 is the hash of the
 expected output of DRV."
   (let* ((output  (derivation->output-path drv))
          (dir     (%substitute-directory))
@@ -178,7 +178,7 @@ CONTENTS."
     (lambda ()
       (let ((hash (call-with-input-file (string-append dir "/example.nar")
                     port-sha256)))
-        ;; Create fake substituter data, to be read by `substitute-binary'.
+        ;; Create fake substituter data, to be read by 'guix substitute'.
         (call-with-derivation-narinfo drv
           thunk
           #:sha256 (or sha256 hash))))
diff --git a/guix/ui.scm b/guix/ui.scm
index ae37c8e6ca..4929f93590 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -815,7 +815,7 @@ parameter of 'args-fold'."
 
 (define (show-guix-help)
   (define (internal? command)
-    (member command '("substitute-binary" "authenticate" "offload")))
+    (member command '("substitute" "authenticate" "offload")))
 
   (format #t (_ "Usage: guix COMMAND ARGS...
 Run COMMAND with ARGS.\n"))