Merge branch 'master' into python-build-system

12 files changed, 669 insertions, 93 deletions

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 2cee6544c4..9386c0f5d0 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -87,12 +87,16 @@
             all-network-interface-names
             network-interface-names
             network-interface-flags
+            network-interface-netmask
             loopback-network-interface?
             network-interface-address
             set-network-interface-flags
             set-network-interface-address
+            set-network-interface-netmask
             set-network-interface-up
             configure-network-interface
+            add-network-route/gateway
+            delete-network-route
 
             interface?
             interface-name
@@ -202,7 +206,7 @@ result is the alignment of the \"most strictly aligned component\"."
                   types ...))))
 
 (define-syntax write-type
-  (syntax-rules (~ array)
+  (syntax-rules (~ array *)
     ((_ bv offset (type ~ order) value)
      (bytevector-uint-set! bv offset value
                            (endianness order) (sizeof* type)))
@@ -215,6 +219,9 @@ result is the alignment of the \"most strictly aligned component\"."
            ((head . tail)
             (write-type bv o type head)
             (loop (+ 1 i) tail (+ o (sizeof* type))))))))
+    ((_ bv offset '* value)
+     (bytevector-uint-set! bv offset (pointer-address value)
+                           (native-endianness) (sizeof* '*)))
     ((_ bv offset type value)
      (bytevector-uint-set! bv offset value
                            (native-endianness) (sizeof* type)))))
@@ -262,6 +269,29 @@ result is the alignment of the \"most strictly aligned component\"."
                                         (align offset type0)
                                         type0))))))
 
+(define-syntax define-c-struct-macro
+  (syntax-rules ()
+    "Define NAME as a macro that can be queried to get information about the C
+struct it represents.  In particular:
+
+  (NAME field-offset FIELD)
+
+returns the offset in bytes of FIELD within the C struct represented by NAME."
+    ((_ name ((fields types) ...))
+     (define-c-struct-macro name
+       (fields ...) 0 ()
+       ((fields types) ...)))
+    ((_ name (fields ...) offset (clauses ...) ((field type) rest ...))
+     (define-c-struct-macro name
+       (fields ...)
+       (+ (align offset type) (type-size type))
+       (clauses ... ((_ field-offset field) (align offset type)))
+       (rest ...)))
+    ((_ name (fields ...) offset (clauses ...) ())
+     (define-syntax name
+       (syntax-rules (field-offset fields ...)
+         clauses ...)))))
+
 (define-syntax define-c-struct
   (syntax-rules ()
     "Define SIZE as the size in bytes of the C structure made of FIELDS.  READ
@@ -269,6 +299,8 @@ as a deserializer and WRITE! as a serializer for the C structure with the
 given TYPES.  READ uses WRAP-FIELDS to return its value."
     ((_ name size wrap-fields read write! (fields types) ...)
      (begin
+       (define-c-struct-macro name
+         ((fields types) ...))
        (define size
          (struct-size 0 () types ...))
        (define (write! bv offset fields ...)
@@ -276,6 +308,12 @@ given TYPES.  READ uses WRAP-FIELDS to return its value."
        (define* (read bv #:optional (offset 0))
          (read-types wrap-fields bv offset (types ...) ()))))))
 
+(define-syntax-rule (c-struct-field-offset type field)
+  "Return the offset in BYTES of FIELD within TYPE, where TYPE is a C struct
+defined with 'define-c-struct' and FIELD is a field identifier.  An
+expansion-time error is raised if FIELD does not exist in TYPE."
+  (type field-offset field))
+
 
 ;;;
 ;;; FFI.
@@ -761,6 +799,22 @@ exception if it's already taken."
   (if (string-contains %host-type "linux")
       #x8916                                      ;GNU/Linux
       -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCGIFNETMASK
+  (if (string-contains %host-type "linux")
+      #x891b                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCSIFNETMASK
+  (if (string-contains %host-type "linux")
+      #x891c                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCADDRT
+  (if (string-contains %host-type "linux")
+      #x890B                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
+(define SIOCDELRT
+  (if (string-contains %host-type "linux")
+      #x890C                                      ;GNU/Linux
+      -1))                                        ;FIXME: GNU/Hurd?
 
 ;; Flags and constants from <net/if.h>.
 
@@ -770,10 +824,13 @@ exception if it's already taken."
 
 (define IF_NAMESIZE 16)                           ;maximum interface name size
 
-(define ifconf-struct
-  ;; 'struct ifconf', from <net/if.h>.
-  (list int                                       ;int ifc_len
-        '*))                                      ;struct ifreq *ifc_ifcu
+(define-c-struct %ifconf-struct
+  sizeof-ifconf
+  list
+  read-ifconf
+  write-ifconf!
+  (length  int)                                   ;int ifc_len
+  (request '*))                                   ;struct ifreq *ifc_ifcu
 
 (define ifreq-struct-size
   ;; 'struct ifreq' begins with an array of IF_NAMESIZE bytes containing the
@@ -865,15 +922,18 @@ to interfaces that are currently up."
          (sock   (or sock (socket SOCK_STREAM AF_INET 0)))
          (len    (* ifreq-struct-size 10))
          (reqs   (make-bytevector len))
-         (conf   (make-c-struct ifconf-struct
-                                (list len (bytevector->pointer reqs)))))
+         (conf   (make-bytevector sizeof-ifconf)))
+    (write-ifconf! conf 0
+                   len (bytevector->pointer reqs))
+
     (let-values (((ret err)
-                  (%ioctl (fileno sock) SIOCGIFCONF conf)))
+                  (%ioctl (fileno sock) SIOCGIFCONF
+                          (bytevector->pointer conf))))
       (when close?
         (close-port sock))
       (if (zero? ret)
           (bytevector->string-list reqs ifreq-struct-size
-                                   (match (parse-c-struct conf ifconf-struct)
+                                   (match (read-ifconf conf)
                                      ((len . _) len)))
           (throw 'system-error "network-interface-list"
                  "network-interface-list: ~A"
@@ -961,6 +1021,22 @@ interface NAME."
                (list name (strerror err))
                (list err))))))
 
+(define (set-network-interface-netmask socket name sockaddr)
+  "Set the network mask of interface NAME to SOCKADDR."
+  (let ((req (make-bytevector ifreq-struct-size)))
+    (bytevector-copy! (string->utf8 name) 0 req 0
+                      (min (string-length name) (- IF_NAMESIZE 1)))
+    ;; Set the 'ifr_addr' field.
+    (write-socket-address! sockaddr req IF_NAMESIZE)
+    (let-values (((ret err)
+                  (%ioctl (fileno socket) SIOCSIFNETMASK
+                          (bytevector->pointer req))))
+      (unless (zero? ret)
+        (throw 'system-error "set-network-interface-netmask"
+               "set-network-interface-netmask on ~A: ~A"
+               (list name (strerror err))
+               (list err))))))
+
 (define (network-interface-address socket name)
   "Return the address of network interface NAME.  The result is an object of
 the same type as that returned by 'make-socket-address'."
@@ -977,15 +1053,35 @@ the same type as that returned by 'make-socket-address'."
                  (list name (strerror err))
                  (list err))))))
 
-(define (configure-network-interface name sockaddr flags)
+(define (network-interface-netmask socket name)
+  "Return the netmask of network interface NAME.  The result is an object of
+the same type as that returned by 'make-socket-address'."
+  (let ((req (make-bytevector ifreq-struct-size)))
+    (bytevector-copy! (string->utf8 name) 0 req 0
+                      (min (string-length name) (- IF_NAMESIZE 1)))
+    (let-values (((ret err)
+                  (%ioctl (fileno socket) SIOCGIFNETMASK
+                          (bytevector->pointer req))))
+      (if (zero? ret)
+          (read-socket-address req IF_NAMESIZE)
+          (throw 'system-error "network-interface-netmask"
+                 "network-interface-netmask on ~A: ~A"
+                 (list name (strerror err))
+                 (list err))))))
+
+(define* (configure-network-interface name sockaddr flags
+                                      #:key netmask)
   "Configure network interface NAME to use SOCKADDR, an address as returned by
-'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants."
+'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants.  If NETMASK
+is true, it must be a socket address to use as the network mask."
   (let ((sock (socket (sockaddr:fam sockaddr) SOCK_STREAM 0)))
     (dynamic-wind
       (const #t)
       (lambda ()
         (set-network-interface-address sock name sockaddr)
-        (set-network-interface-flags sock name flags))
+        (set-network-interface-flags sock name flags)
+        (when netmask
+          (set-network-interface-netmask sock name netmask)))
       (lambda ()
         (close-port sock)))))
 
@@ -1004,6 +1100,106 @@ the same type as that returned by 'make-socket-address'."
 
 
 ;;;
+;;; Network routes.
+;;;
+
+(define-c-struct %rtentry                 ;'struct rtentry' from <net/route.h>
+  sizeof-rtentry
+  list
+  read-rtentry
+  write-rtentry!
+  (pad1            unsigned-long)
+  (destination     (array uint8 16))              ;struct sockaddr
+  (gateway         (array uint8 16))              ;struct sockaddr
+  (genmask         (array uint8 16))              ;struct sockaddr
+  (flags           unsigned-short)
+  (pad2            short)
+  (pad3            long)
+  (tos             uint8)
+  (class           uint8)
+  (pad4            (array uint8 (if (= 8 (sizeof* '*)) 3 1)))
+  (metric          short)
+  (device          '*)
+  (mtu             unsigned-long)
+  (window          unsigned-long)
+  (initial-rtt     unsigned-short))
+
+(define RTF_UP #x0001)                     ;'rtentry' flags from <net/route.h>
+(define RTF_GATEWAY #x0002)
+
+(define %sockaddr-any
+  (make-socket-address AF_INET INADDR_ANY 0))
+
+(define add-network-route/gateway
+  ;; To allow field names to be matched as literals, we need to move them out
+  ;; of the lambda's body since the parameters have the same name.  A lot of
+  ;; fuss for very little.
+  (let-syntax ((gateway-offset (identifier-syntax
+                                (c-struct-field-offset %rtentry gateway)))
+               (destination-offset (identifier-syntax
+                                    (c-struct-field-offset %rtentry destination)))
+               (genmask-offset (identifier-syntax
+                                (c-struct-field-offset %rtentry genmask))))
+    (lambda* (socket gateway
+                     #:key (destination %sockaddr-any) (genmask %sockaddr-any))
+      "Add a network route for DESTINATION (a socket address as returned by
+'make-socket-address') that goes through GATEWAY (a socket address).  For
+instance, the call:
+
+  (add-network-route/gateway sock
+                             (make-socket-address
+                               AF_INET
+                               (inet-pton AF_INET \"192.168.0.1\")
+                               0))
+
+is equivalent to this 'net-tools' command:
+
+  route add -net default gw 192.168.0.1
+
+because the default value of DESTINATION is \"0.0.0.0\"."
+      (let ((route (make-bytevector sizeof-rtentry 0)))
+        (write-socket-address! gateway route gateway-offset)
+        (write-socket-address! destination route destination-offset)
+        (write-socket-address! genmask route genmask-offset)
+        (bytevector-u16-native-set! route
+                                    (c-struct-field-offset %rtentry flags)
+                                    (logior RTF_UP RTF_GATEWAY))
+        (let-values (((ret err)
+                      (%ioctl (fileno socket) SIOCADDRT
+                              (bytevector->pointer route))))
+          (unless (zero? ret)
+            (throw 'system-error "add-network-route/gateway"
+                   "add-network-route/gateway: ~A"
+                   (list (strerror err))
+                   (list err))))))))
+
+(define delete-network-route
+  (let-syntax ((destination-offset (identifier-syntax
+                                    (c-struct-field-offset %rtentry destination))))
+    (lambda* (socket destination)
+      "Delete the network route for DESTINATION.  For instance, the call:
+
+  (delete-network-route sock
+                        (make-socket-address AF_INET INADDR_ANY 0))
+
+is equivalent to the 'net-tools' command:
+
+  route del -net default
+"
+
+      (let ((route (make-bytevector sizeof-rtentry 0)))
+        (write-socket-address! destination route destination-offset)
+        (let-values (((ret err)
+                      (%ioctl (fileno socket) SIOCDELRT
+                              (bytevector->pointer route))))
+          (unless (zero? ret)
+            (throw 'system-error "delete-network-route"
+                   "delete-network-route: ~A"
+                   (list (strerror err))
+                   (list err))))))))
+
+
+;;;
 ;;; Details about network interfaces---aka. 'getifaddrs'.
 ;;;
 
diff --git a/guix/derivations.scm b/guix/derivations.scm
index e378a7cb03..7ed9bd61d3 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -86,6 +86,7 @@
             derivation-path->output-path
             derivation-path->output-paths
             derivation
+            raw-derivation
 
             map-derivation
 
@@ -1306,3 +1307,6 @@ ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
 
 (define built-derivations
   (store-lift build-derivations))
+
+(define raw-derivation
+  (store-lift derivation))
diff --git a/guix/download.scm b/guix/download.scm
index 0c275053c5..e2e5cee777 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -309,27 +309,64 @@
   (let ((module (resolve-interface '(gnu packages tls))))
     (module-ref module 'gnutls)))
 
-(define* (url-fetch url hash-algo hash
-                    #:optional name
-                    #:key (system (%current-system))
-                    (guile (default-guile)))
-  "Return a fixed-output derivation that fetches URL (a string, or a list of
-strings denoting alternate URLs), which is expected to have hash HASH of type
-HASH-ALGO (a symbol).  By default, the file name is the base name of URL;
-optionally, NAME can specify a different file name.
+(define built-in-builders*
+  (let ((cache (make-weak-key-hash-table)))
+    (lambda ()
+      "Return, as a monadic value, the list of built-in builders supported by
+the daemon."
+      (lambda (store)
+        ;; Memoize the result to avoid repeated RPCs.
+        (values (or (hashq-ref cache store)
+                    (let ((result (built-in-builders store)))
+                      (hashq-set! cache store result)
+                      result))
+                store)))))
 
-When one of the URL starts with mirror://, then its host part is
-interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
+(define* (built-in-download file-name url
+                            #:key system hash-algo hash
+                            mirrors content-addressed-mirrors
+                            (guile 'unused))
+  "Download FILE-NAME from URL using the built-in 'download' builder.
 
-Alternately, when URL starts with file://, return the corresponding file name
-in the store."
-  (define file-name
-    (match url
-      ((head _ ...)
-       (basename head))
-      (_
-       (basename url))))
+This is an \"out-of-band\" download in that the returned derivation does not
+explicitly depend on Guile, GnuTLS, etc.  Instead, the daemon performs the
+download by itself using its own dependencies."
+  (mlet %store-monad ((mirrors (lower-object mirrors))
+                      (content-addressed-mirrors
+                       (lower-object content-addressed-mirrors)))
+    (raw-derivation file-name "builtin:download" '()
+                    #:system system
+                    #:hash-algo hash-algo
+                    #:hash hash
+                    #:inputs `((,mirrors)
+                               (,content-addressed-mirrors))
 
+                    ;; Honor the user's proxy and locale settings.
+                    #:leaked-env-vars '("http_proxy" "https_proxy"
+                                        "LC_ALL" "LC_MESSAGES" "LANG"
+                                        "COLUMNS")
+
+                    #:env-vars `(("url" . ,(object->string url))
+                                 ("mirrors" . ,mirrors)
+                                 ("content-addressed-mirrors"
+                                  . ,content-addressed-mirrors))
+
+                    ;; Do not offload this derivation because we cannot be
+                    ;; sure that the remote daemon supports the 'download'
+                    ;; built-in.  We may remove this limitation when support
+                    ;; for that built-in is widespread.
+                    #:local-build? #t)))
+
+(define* (in-band-download file-name url
+                           #:key system hash-algo hash
+                           mirrors content-addressed-mirrors
+                           guile)
+  "Download FILE-NAME from URL using a normal, \"in-band\" fixed-output
+derivation.
+
+This is now deprecated since it has the drawback of causing bootstrapping
+issues: we may need to build GnuTLS just to be able to download the source of
+GnuTLS itself and its dependencies.  See <http://bugs.gnu.org/22774>."
   (define need-gnutls?
     ;; True if any of the URLs need TLS support.
     (let ((https? (cut string-prefix? "https://" <>)))
@@ -366,47 +403,81 @@ in the store."
                                             read))))
             (url-fetch (value-from-environment "guix download url")
                        #$output
-                       #:mirrors (call-with-input-file #$%mirror-file read)
+                       #:mirrors (call-with-input-file #$mirrors read)
 
                        ;; Content-addressed mirrors.
                        #:hashes
                        (value-from-environment "guix download hashes")
                        #:content-addressed-mirrors
-                       (primitive-load #$%content-addressed-mirror-file)
+                       (primitive-load #$content-addressed-mirrors)
 
                        ;; No need to validate certificates since we know the
                        ;; hash of the expected result.
                        #:verify-certificate? #f)))))
 
+  (mlet %store-monad ((guile (package->derivation guile system)))
+    (gexp->derivation file-name builder
+                      #:guile-for-build guile
+                      #:system system
+                      #:hash-algo hash-algo
+                      #:hash hash
+
+                      ;; Use environment variables and a fixed script
+                      ;; name so there's only one script in store for
+                      ;; all the downloads.
+                      #:script-name "download"
+                      #:env-vars
+                      `(("guix download url" . ,(object->string url))
+                        ("guix download hashes"
+                         . ,(object->string `((,hash-algo . ,hash)))))
+
+                      ;; Honor the user's proxy settings.
+                      #:leaked-env-vars '("http_proxy" "https_proxy")
+
+                      ;; In general, offloading downloads is not a good
+                      ;; idea.  Daemons before 0.8.3 would also
+                      ;; interpret this as "do not substitute" (see
+                      ;; <https://bugs.gnu.org/18747>.)
+                      #:local-build? #t)))
+
+(define* (url-fetch url hash-algo hash
+                    #:optional name
+                    #:key (system (%current-system))
+                    (guile (default-guile)))
+  "Return a fixed-output derivation that fetches URL (a string, or a list of
+strings denoting alternate URLs), which is expected to have hash HASH of type
+HASH-ALGO (a symbol).  By default, the file name is the base name of URL;
+optionally, NAME can specify a different file name.
+
+When one of the URL starts with mirror://, then its host part is
+interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
+
+Alternately, when URL starts with file://, return the corresponding file name
+in the store."
+  (define file-name
+    (match url
+      ((head _ ...)
+       (basename head))
+      (_
+       (basename url))))
+
   (let ((uri (and (string? url) (string->uri url))))
     (if (or (and (string? url) (not uri))
             (and uri (memq (uri-scheme uri) '(#f file))))
         (interned-file (if uri (uri-path uri) url)
                        (or name file-name))
-        (mlet %store-monad ((guile (package->derivation guile system)))
-          (gexp->derivation (or name file-name) builder
-                            #:guile-for-build guile
-                            #:system system
-                            #:hash-algo hash-algo
-                            #:hash hash
-
-                            ;; Use environment variables and a fixed script
-                            ;; name so there's only one script in store for
-                            ;; all the downloads.
-                            #:script-name "download"
-                            #:env-vars
-                            `(("guix download url" . ,(object->string url))
-                              ("guix download hashes"
-                               . ,(object->string `((,hash-algo . ,hash)))))
-
-                            ;; Honor the user's proxy settings.
-                            #:leaked-env-vars '("http_proxy" "https_proxy")
-
-                            ;; In general, offloading downloads is not a good
-                            ;; idea.  Daemons before 0.8.3 would also
-                            ;; interpret this as "do not substitute" (see
-                            ;; <https://bugs.gnu.org/18747>.)
-                            #:local-build? #t)))))
+        (mlet* %store-monad ((builtins (built-in-builders*))
+                             (download -> (if (member "download" builtins)
+                                              built-in-download
+                                              in-band-download)))
+          (download (or name file-name) url
+                    #:guile guile
+                    #:system system
+                    #:hash-algo hash-algo
+                    #:hash hash
+                    #:mirrors %mirror-file
+                    #:content-addressed-mirrors
+                    %content-addressed-mirror-file)))))
 
 (define* (url-fetch/tarbomb url hash-algo hash
                             #:optional name
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 05178a5ecc..fd5dc49233 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -453,9 +453,6 @@ whether this should be considered a \"native\" input or not."
                           '()))
                        (gexp-references gexp)))))
 
-(define raw-derivation
-  (store-lift derivation))
-
 (define* (lower-inputs inputs
                        #:key system target)
   "Turn any package from INPUTS into a derivation for SYSTEM; return the
diff --git a/guix/profiles.scm b/guix/profiles.scm
index b56b8f4c79..0b317ef51e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -501,10 +501,6 @@ if not found."
                          #t))))
             items))
 
-    ;; TODO: Factorize.
-    (define references*
-      (store-lift references))
-
     (with-monad %store-monad
       (match (manifest-entry-item entry)
         ((? package? package)
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index ec30b05ac0..dffff79729 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -23,12 +23,15 @@
   #:use-module (guix hash)
   #:use-module (guix utils)
   #:use-module (guix base32)
-  #:use-module (guix download)
-  #:use-module ((guix build download) #:select (current-terminal-columns))
-  #:use-module ((guix build syscalls) #:select (terminal-columns))
+  #:use-module ((guix download) #:hide (url-fetch))
+  #:use-module ((guix build download)
+                #:select (url-fetch current-terminal-columns))
+  #:use-module ((guix build syscalls)
+                #:select (terminal-columns))
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
@@ -39,15 +42,31 @@
 ;;; Command-line options.
 ;;;
 
+(define (download-to-file url file)
+  "Download the file at URI to FILE.  Return FILE."
+  (let ((uri (string->uri url)))
+    (match (uri-scheme uri)
+      ((or 'file #f)
+       (copy-file (uri-path uri) file))
+      (_
+       (url-fetch url file)))
+    file))
+
+(define* (download-to-store* url #:key (verify-certificate? #t))
+  (with-store store
+    (download-to-store store url
+                       #:verify-certificate? verify-certificate?)))
+
 (define %default-options
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)
-    (verify-certificate? . #t)))
+    (verify-certificate? . #t)
+    (download-proc . ,download-to-store*)))
 
 (define (show-help)
   (display (_ "Usage: guix download [OPTION] URL
-Download the file at URL, add it to the store, and print its store path
-and the hash of its contents.
+Download the file at URL to the store or to the given file, and print its
+file name and the hash of its contents.
 
 Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 ('hex' and 'hexadecimal' can be used as well).\n"))
@@ -56,6 +75,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
   (format #t (_ "
       --no-check-certificate
                          do not validate the certificate of HTTPS servers "))
+  (format #f (_ "
+  -o, --output=FILE      download to FILE"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -84,6 +105,12 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
         (option '("no-check-certificate") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verify-certificate? #f result)))
+        (option '(#\o "output") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'download-proc
+                              (lambda* (url #:key verify-certificate?)
+                                (download-to-file url arg))
+                              (alist-delete 'download result))))
 
         (option '(#\h "help") #f #f
                 (lambda args
@@ -113,24 +140,17 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 
   (with-error-handling
     (let* ((opts  (parse-options))
-           (store (open-connection))
            (arg   (or (assq-ref opts 'argument)
                       (leave (_ "no download URI was specified~%"))))
            (uri   (or (string->uri arg)
                       (leave (_ "~a: failed to parse URI~%")
                              arg)))
-           (path  (case (uri-scheme uri)
-                    ((file)
-                     (add-to-store store (basename (uri-path uri))
-                                   #f "sha256" (uri-path uri)))
-                    (else
-                     (parameterize ((current-terminal-columns
-                                     (terminal-columns)))
-                       (download-to-store store (uri->string uri)
-                                          (basename (uri-path uri))
-                                          #:verify-certificate?
-                                          (assoc-ref opts
-                                                     'verify-certificate?))))))
+           (fetch (assq-ref opts 'download-proc))
+           (path  (parameterize ((current-terminal-columns
+                                  (terminal-columns)))
+                    (fetch arg
+                           #:verify-certificate?
+                           (assq-ref opts 'verify-certificate?))))
            (hash  (call-with-input-file
                       (or path
                           (leave (_ "~a: download failed~%")
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index be29e36ce1..9b991786c3 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -67,6 +67,7 @@
             check-home-page
             check-source
             check-source-file-name
+            check-mirror-url
             check-license
             check-vulnerabilities
             check-formatting
@@ -600,6 +601,14 @@ descriptions maintained upstream."
                  (location->string loc) (package-full-name package)
                  (fill-paragraph (escape-quotes upstream) 77 7)))))))
 
+(define (origin-uris origin)
+  "Return the list of URIs (strings) for ORIGIN."
+  (match (origin-uri origin)
+    ((? string? uri)
+     (list uri))
+    ((uris ...)
+     uris)))
+
 (define (check-source package)
   "Emit a warning if PACKAGE has an invalid 'source' field, or if that
 'source' is not reachable."
@@ -616,10 +625,7 @@ descriptions maintained upstream."
   (let ((origin (package-source package)))
     (when (and origin
                (eqv? (origin-method origin) url-fetch))
-      (let* ((strings (origin-uri origin))
-             (uris (if (list? strings)
-                       (map string->uri strings)
-                       (list (string->uri strings)))))
+      (let ((uris (map string->uri (origin-uris origin))))
 
         ;; Just make sure that at least one of the URIs is valid.
         (call-with-values
@@ -659,6 +665,31 @@ descriptions maintained upstream."
                     (_ "the source file name should contain the package name")
                     'source))))
 
+(define (check-mirror-url package)
+  "Check whether PACKAGE uses source URLs that should be 'mirror://'."
+  (define (check-mirror-uri uri)                  ;XXX: could be optimized
+    (let loop ((mirrors %mirrors))
+      (match mirrors
+        (()
+         #t)
+        (((mirror-id mirror-urls ...) rest ...)
+         (match (find (cut string-prefix? <> uri) mirror-urls)
+           (#f
+            (loop rest))
+           (prefix
+            (emit-warning package
+                          (format #f (_ "URL should be \
+'mirror://~a/~a'")
+                                  mirror-id
+                                  (string-drop uri (string-length prefix)))
+                          'source)))))))
+
+  (let ((origin (package-source package)))
+    (when (and (origin? origin)
+               (eqv? (origin-method origin) url-fetch))
+      (let ((uris (origin-uris origin)))
+        (for-each check-mirror-uri uris)))))
+
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
   (catch #t
@@ -901,6 +932,10 @@ or a list thereof")
      (description "Validate source URLs")
      (check       check-source))
    (lint-checker
+     (name        'mirror-url)
+     (description "Suggest 'mirror://' URLs")
+     (check       check-mirror-url))
+   (lint-checker
      (name        'source-file-name)
      (description "Validate file names of sources")
      (check       check-source-file-name))
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
new file mode 100644
index 0000000000..0d2e7089aa
--- /dev/null
+++ b/guix/scripts/perform-download.scm
@@ -0,0 +1,113 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 perform-download)
+  #:use-module (guix ui)
+  #:use-module (guix derivations)
+  #:use-module ((guix store) #:select (derivation-path?))
+  #:use-module (guix build download)
+  #:use-module (ice-9 match)
+  #:export (guix-perform-download))
+
+;; This program is a helper for the daemon's 'download' built-in builder.
+
+(define-syntax derivation-let
+  (syntax-rules ()
+    ((_ drv ((id name) rest ...) body ...)
+     (let ((id (assoc-ref (derivation-builder-environment-vars drv)
+                          name)))
+       (derivation-let drv (rest ...) body ...)))
+    ((_ drv () body ...)
+     (begin body ...))))
+
+(define %user-module
+  ;; Module in which content-address mirror procedures are evaluated.
+  (let ((module (make-fresh-user-module)))
+    (module-use! module (resolve-interface '(guix base32)))
+    module))
+
+(define (perform-download drv)
+  "Perform the download described by DRV, a fixed-output derivation."
+  (derivation-let drv ((url "url")
+                       (output "out")
+                       (executable "executable")
+                       (mirrors "mirrors")
+                       (content-addressed-mirrors "content-addressed-mirrors"))
+    (unless url
+      (leave (_ "~a: missing URL~%") (derivation-file-name drv)))
+
+    (let* ((url        (call-with-input-string url read))
+           (drv-output (assoc-ref (derivation-outputs drv) "out"))
+           (algo       (derivation-output-hash-algo drv-output))
+           (hash       (derivation-output-hash drv-output)))
+      (unless (and algo hash)
+        (leave (_ "~a is not a fixed-output derivation~%")
+               (derivation-file-name drv)))
+
+      ;; We're invoked by the daemon, which gives us write access to OUTPUT.
+      (when (url-fetch url output
+                       #:mirrors (if mirrors
+                                     (call-with-input-file mirrors read)
+                                     '())
+                       #:content-addressed-mirrors
+                       (if content-addressed-mirrors
+                           (call-with-input-file content-addressed-mirrors
+                             (lambda (port)
+                               (eval (read port) %user-module)))
+                           '())
+                       #:hashes `((,algo . ,hash))
+
+                       ;; Since DRV's output hash is known, X.509 certificate
+                       ;; validation is pointless.
+                       #:verify-certificate? #f)
+        (when (and executable (string=? executable "1"))
+          (chmod output #o755))))))
+
+(define (assert-low-privileges)
+  (when (zero? (getuid))
+    (leave (_ "refusing to run with elevated privileges (UID ~a)~%")
+           (getuid))))
+
+(define (guix-perform-download . args)
+  "Perform the download described by the given fixed-output derivation.
+
+This is an \"out-of-band\" download in that this code is executed directly by
+the daemon and not explicitly described as an input of the derivation.  This
+allows us to sidestep bootstrapping problems, such downloading the source code
+of GnuTLS over HTTPS, before we have built GnuTLS.  See
+<http://bugs.gnu.org/22774>."
+  (with-error-handling
+    (match args
+      (((? derivation-path? drv))
+       ;; This program must be invoked by guix-daemon under an unprivileged
+       ;; UID to prevent things downloading from 'file:///etc/shadow' or
+       ;; arbitrary code execution via the content-addressed mirror
+       ;; procedures.  (That means we exclude users who did not pass
+       ;; '--build-users-group'.)
+       (assert-low-privileges)
+       (perform-download (call-with-input-file drv read-derivation)))
+      (("--version")
+       (show-version-and-exit))
+      (x
+       (leave (_ "fixed-output derivation name expected~%"))))))
+
+;; Local Variables:
+;; eval: (put 'derivation-let 'scheme-indent-function 2)
+;; End:
+
+;; perform-download.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 71ddccfa61..bb373a6726 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -77,9 +77,6 @@
 ;;; Installation.
 ;;;
 
-;; TODO: Factorize.
-(define references*
-  (store-lift references))
 (define topologically-sorted*
   (store-lift topologically-sorted))
 
diff --git a/guix/store.scm b/guix/store.scm
index 43cfda9214..7f54b87db1 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -95,8 +95,10 @@
             path-info-registration-time
             path-info-nar-size
 
+            built-in-builders
             references
             references/substitutes
+            references*
             requisites
             referrers
             optimize-store
@@ -187,7 +189,8 @@
   (query-substitutable-paths 32)
   (query-valid-derivers 33)
   (optimize-store 34)
-  (verify-store 35))
+  (verify-store 35)
+  (built-in-builders 80))
 
 (define-enumerate-type hash-algo
   ;; hash.hh
@@ -283,7 +286,7 @@
      (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path store-path-list
+  (syntax-rules (integer boolean string store-path store-path-list string-list
                  substitutable-path-list path-info base16)
     ((_ integer p)
      (read-int p))
@@ -295,6 +298,8 @@
      (read-store-path p))
     ((_ store-path-list p)
      (read-store-path-list p))
+    ((_ string-list p)
+     (read-string-list p))
     ((_ substitutable-path-list p)
      (read-substitutable-path-list p))
     ((_ path-info p)
@@ -914,6 +919,23 @@ that there is no guarantee that the order of the resulting list matches the
 order of PATHS."
              substitutable-path-list))
 
+(define built-in-builders
+  (let ((builders (operation (built-in-builders)
+                             "Return the built-in builders."
+                             string-list)))
+    (lambda (store)
+      "Return the names of the supported built-in derivation builders
+supported by STORE."
+      ;; Check whether STORE's version supports this RPC and built-in
+      ;; derivation builders in general, which appeared in Guix > 0.11.0.
+      ;; Return the empty list if it doesn't.  Note that this RPC does not
+      ;; exist in 'nix-daemon'.
+      (if (or (> (nix-server-major-version store) #x100)
+              (and (= (nix-server-major-version store) #x100)
+                   (>= (nix-server-minor-version store) #x60)))
+          (builders store)
+          '()))))
+
 (define-operation (optimize-store)
   "Optimize the store by hard-linking identical files (\"deduplication\".)
 Return #t on success."
@@ -1149,6 +1171,9 @@ where FILE is the entry's absolute file name and STAT is the result of
 (define set-build-options*
   (store-lift set-build-options))
 
+(define references*
+  (store-lift references))
+
 (define-inlinable (current-system)
   ;; Consult the %CURRENT-SYSTEM fluid at bind time.  This is equivalent to
   ;; (lift0 %current-system %store-monad), but inlinable, thus avoiding
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
new file mode 100644
index 0000000000..fe1e120c5d
--- /dev/null
+++ b/guix/tests/http.scm
@@ -0,0 +1,120 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 tests http)
+  #:use-module (ice-9 threads)
+  #:use-module (web server)
+  #:use-module (web server http)
+  #:use-module (web response)
+  #:use-module (srfi srfi-39)
+  #:export (with-http-server
+            call-with-http-server
+            %http-server-port
+            %http-server-socket
+            %local-url))
+
+;;; Commentary:
+;;;
+;;; Code to spawn a Web server for testing purposes.
+;;;
+;;; Code:
+
+(define %http-server-port
+  ;; TCP port to use for the stub HTTP server.
+  (make-parameter 9999))
+
+(define (%local-url)
+  ;; URL to use for 'home-page' tests.
+  (string-append "http://localhost:" (number->string (%http-server-port))
+                 "/foo/bar"))
+
+(define %http-server-socket
+  ;; Listening socket for the web server.  It is useful to export it so that
+  ;; tests can check whether we succeeded opening the socket and tests skip if
+  ;; needed.
+  (delay
+    (catch 'system-error
+      (lambda ()
+        (let ((sock (socket PF_INET SOCK_STREAM 0)))
+          (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+          (bind sock
+                (make-socket-address AF_INET INADDR_LOOPBACK
+                                     (%http-server-port)))
+          sock))
+      (lambda args
+        (let ((err (system-error-errno args)))
+          (format (current-error-port)
+                  "warning: cannot run Web server for tests: ~a~%"
+                  (strerror err))
+          #f)))))
+
+(define (http-write server client response body)
+  "Write RESPONSE."
+  (let* ((response (write-response response client))
+         (port     (response-port response)))
+    (cond
+     ((not body))                                 ;pass
+     (else
+      (write-response-body response body)))
+    (close-port port)
+    (quit #t)                                     ;exit the server thread
+    (values)))
+
+;; Mutex and condition variable to synchronize with the HTTP server.
+(define %http-server-lock (make-mutex))
+(define %http-server-ready (make-condition-variable))
+
+(define (http-open . args)
+  "Start listening for HTTP requests and signal %HTTP-SERVER-READY."
+  (with-mutex %http-server-lock
+    (let ((result (apply (@@ (web server http) http-open) args)))
+      (signal-condition-variable %http-server-ready)
+      result)))
+
+(define-server-impl stub-http-server
+  ;; Stripped-down version of Guile's built-in HTTP server.
+  http-open
+  (@@ (web server http) http-read)
+  http-write
+  (@@ (web server http) http-close))
+
+(define (call-with-http-server code data thunk)
+  "Call THUNK with an HTTP server running and returning CODE and DATA (a
+string) on HTTP requests."
+  (define (server-body)
+    (define (handle request body)
+      (values (build-response #:code code
+                              #:reason-phrase "Such is life")
+              data))
+
+    (catch 'quit
+      (lambda ()
+        (run-server handle stub-http-server
+                    `(#:socket ,(force %http-server-socket))))
+      (const #t)))
+
+  (with-mutex %http-server-lock
+    (let ((server (make-thread server-body)))
+      (wait-condition-variable %http-server-ready %http-server-lock)
+      ;; Normally SERVER exits automatically once it has received a request.
+      (thunk))))
+
+(define-syntax-rule (with-http-server code data body ...)
+  (call-with-http-server code data (lambda () body ...)))
+
+;;; http.scm ends here
diff --git a/guix/ui.scm b/guix/ui.scm
index 9af8648211..cafb3c6705 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1094,7 +1094,8 @@ DURATION-RELATION with the current time."
           (removed (lset-difference
                     equal-entry? (list-entries old) (list-entries new))))
       (for-each (cut display-entry <> "+") added)
-      (for-each (cut display-entry <> "-") removed)))
+      (for-each (cut display-entry <> "-") removed)
+      (newline)))
 
   (display-diff profile gen1 gen2))
 
@@ -1184,7 +1185,8 @@ optionally contain a version number and an output name, as in these examples:
 
 (define (show-guix-help)
   (define (internal? command)
-    (member command '("substitute" "authenticate" "offload")))
+    (member command '("substitute" "authenticate" "offload"
+                      "perform-download")))
 
   (format #t (_ "Usage: guix COMMAND ARGS...
 Run COMMAND with ARGS.\n"))