Merge branch 'master' into core-updates

40 files changed, 3018 insertions, 1472 deletions

diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index aeb04c83a4..2532210a49 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -31,7 +31,8 @@
   #:export (%python-build-system-modules
             package-with-python2
             python-build
-            python-build-system))
+            python-build-system
+            pypi-uri))
 
 ;; Commentary:
 ;;
@@ -40,6 +41,13 @@
 ;;
 ;; Code:
 
+(define (pypi-uri name version)
+  "Return a URI string for the Python package hosted on the Python Package
+Index (PyPI) corresponding to NAME and VERSION."
+  (string-append "https://pypi.python.org/packages/source/"
+                 (string-take name 1) "/" name "/"
+                 name "-" version ".tar.gz"))
+
 (define %python-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build python-build-system)
@@ -84,6 +92,7 @@ NEW-PREFIX; otherwise, NEW-PREFIX is prepended to the name."
          (if (eq? (package-build-system p) python-build-system)
              (package
                (inherit p)
+               (location (package-location p))
                (name (let ((name (package-name p)))
                        (string-append new-prefix
                                       (if (string-prefix? old-prefix name)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 240e79ee8d..8843804c40 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -20,6 +20,7 @@
 
 (define-module (guix build download)
   #:use-module (web uri)
+  #:use-module (web http)
   #:use-module ((web client) #:hide (open-socket-for-uri))
   #:use-module (web response)
   #:use-module (guix ftp-client)
@@ -277,26 +278,65 @@ host name without trailing dot."
       (add-weak-reference record port)
       record)))
 
-(define (open-socket-for-uri uri)
-  "Return an open port for URI.  This variant works around
-<http://bugs.gnu.org/15368> which affects Guile's 'open-socket-for-uri' up to
-2.0.11 included."
-  (define rmem-max
-    ;; The maximum size for a receive buffer on Linux, see socket(7).
-    "/proc/sys/net/core/rmem_max")
-
-  (define buffer-size
-    (if (file-exists? rmem-max)
-        (call-with-input-file rmem-max read)
-        126976))                    ;the default for Linux, per 'rmem_default'
-
-  (let ((s ((@ (web client) open-socket-for-uri) uri)))
-    ;; Work around <http://bugs.gnu.org/15368> by restoring a decent
-    ;; buffer size.
-    (setsockopt s SOL_SOCKET SO_RCVBUF buffer-size)
-    s))
-
-(define (open-connection-for-uri uri)
+(define (ensure-uri uri-or-string)                ;XXX: copied from (web http)
+  (cond
+   ((string? uri-or-string) (string->uri uri-or-string))
+   ((uri? uri-or-string) uri-or-string)
+   (else (error "Invalid URI" uri-or-string))))
+
+(define current-http-proxy
+  ;; XXX: Add a dummy definition for Guile < 2.0.10; this is used in
+  ;; 'open-socket-for-uri'.
+  (or (and=> (module-variable (resolve-interface '(web client))
+                              'current-http-proxy)
+             variable-ref)
+      (const #f)))
+
+(define* (open-socket-for-uri uri-or-string #:key timeout)
+  "Return an open input/output port for a connection to URI.  When TIMEOUT is
+not #f, it must be a (possibly inexact) number denoting the maximum duration
+in seconds to wait for the connection to complete; passed TIMEOUT, an
+ETIMEDOUT error is raised."
+  ;; Includes a fix for <http://bugs.gnu.org/15368> which affects Guile's
+  ;; 'open-socket-for-uri' up to 2.0.11 included, uses 'connect*' instead
+  ;; of 'connect', and uses AI_ADDRCONFIG.
+
+  (define http-proxy (current-http-proxy))
+  (define uri (ensure-uri (or http-proxy uri-or-string)))
+  (define addresses
+    (let ((port (uri-port uri)))
+      (delete-duplicates
+       (getaddrinfo (uri-host uri)
+                    (cond (port => number->string)
+                          (else (symbol->string (uri-scheme uri))))
+                    (if (number? port)
+                        (logior AI_ADDRCONFIG AI_NUMERICSERV)
+                        AI_ADDRCONFIG))
+       (lambda (ai1 ai2)
+         (equal? (addrinfo:addr ai1) (addrinfo:addr ai2))))))
+
+  (let loop ((addresses addresses))
+    (let* ((ai (car addresses))
+           (s  (with-fluids ((%default-port-encoding #f))
+                 ;; Restrict ourselves to TCP.
+                 (socket (addrinfo:fam ai) SOCK_STREAM IPPROTO_IP))))
+      (catch 'system-error
+        (lambda ()
+          (connect* s (addrinfo:addr ai) timeout)
+
+          ;; Buffer input and output on this port.
+          (setvbuf s _IOFBF)
+          ;; If we're using a proxy, make a note of that.
+          (when http-proxy (set-http-proxy-port?! s #t))
+          s)
+        (lambda args
+          ;; Connection failed, so try one of the other addresses.
+          (close s)
+          (if (null? (cdr addresses))
+              (apply throw args)
+              (loop (cdr addresses))))))))
+
+(define* (open-connection-for-uri uri #:key timeout)
   "Like 'open-socket-for-uri', but also handle HTTPS connections."
   (define https?
     (eq? 'https (uri-scheme uri)))
@@ -319,7 +359,7 @@ host name without trailing dot."
                            (thunk))
                          (thunk)))))))
     (with-https-proxy
-     (let ((s (open-socket-for-uri uri)))
+     (let ((s (open-socket-for-uri uri #:timeout timeout)))
        ;; Buffer input and output on this port.
        (setvbuf s _IOFBF %http-receive-buffer-size)
 
diff --git a/guix/build/graft.scm b/guix/build/graft.scm
index 55f0f9410d..0a9cd3260c 100644
--- a/guix/build/graft.scm
+++ b/guix/build/graft.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +21,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 threads)
   #:export (replace-store-references
             rewrite-directory))
 
@@ -93,38 +93,32 @@ file name pairs."
   (define (destination file)
     (string-append output (string-drop file prefix-len)))
 
-  (define (rewrite-leaf file stat result)
-    (case (stat:type stat)
-      ((symlink)
-       (let ((target (readlink file)))
-         (symlink (call-with-output-string
-                   (lambda (output)
-                     (replace-store-references (open-input-string target)
-                                               output mapping
-                                               store)))
-                  (destination file))))
-      ((regular)
-       (with-fluids ((%default-port-encoding #f))
-         (call-with-input-file file
-           (lambda (input)
-             (call-with-output-file (destination file)
-               (lambda (output)
-                 (replace-store-references input output mapping
-                                           store)
-                 (chmod output (stat:perms stat))))))))
-      (else
-       (error "unsupported file type" stat))))
+  (define (rewrite-leaf file)
+    (let ((stat (lstat file))
+          (dest (destination file)))
+      (mkdir-p (dirname dest))
+      (case (stat:type stat)
+        ((symlink)
+         (let ((target (readlink file)))
+           (symlink (call-with-output-string
+                      (lambda (output)
+                        (replace-store-references (open-input-string target)
+                                                  output mapping
+                                                  store)))
+                    dest)))
+        ((regular)
+         (with-fluids ((%default-port-encoding #f))
+           (call-with-input-file file
+             (lambda (input)
+               (call-with-output-file dest
+                 (lambda (output)
+                   (replace-store-references input output mapping
+                                             store)
+                   (chmod output (stat:perms stat))))))))
+        (else
+         (error "unsupported file type" stat)))))
 
-  (file-system-fold (const #t)
-                    rewrite-leaf
-                    (lambda (directory stat result) ;down
-                      (mkdir (destination directory)))
-                    (const #t)                      ;up
-                    (const #f)                      ;skip
-                    (lambda (file stat errno result) ;error
-                      (error "read error" file stat errno))
-                    #f
-                    directory
-                    lstat))
+  (n-par-for-each (parallel-job-count)
+                  rewrite-leaf (find-files directory)))
 
 ;;; graft.scm ends here
diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm
index 34e5247e07..8e2aee381d 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -102,7 +103,17 @@ and parameters ~s~%"
     ;; Cabal errors if GHC_PACKAGE_PATH is set during 'configure', so unset
     ;; and restore it.
     (unsetenv "GHC_PACKAGE_PATH")
+
+    ;; For packages where the Cabal build-type is set to "Configure",
+    ;; ./configure will be executed.  In these cases, the following
+    ;; environment variable is needed to be able to find the shell executable.
+    ;; For other package types, the configure script isn't present.  For more
+    ;; information, see the Build Information section of
+    ;; <https://www.haskell.org/cabal/users-guide/developing-packages.html>.
+    (when (file-exists? "configure")
+      (setenv "CONFIG_SHELL" "sh"))
     (run-setuphs "configure" params)
+
     (setenv "GHC_PACKAGE_PATH" ghc-path)))
 
 (define* (build #:rest empty)
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 1ae42c00b4..8025b7fec6 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -136,11 +136,18 @@ installed with setuptools."
                #t))
     #t))
 
+(define* (set-SOURCE-DATE-EPOCH #:rest _)
+  "Set the 'SOURCE_DATE_EPOCH' environment variable."
+  ;; Use zero as the timestamp in .pyc files so that builds are deterministic.
+  ;; TODO: Remove it when this variable is set in GNU:%STANDARD-PHASES.
+  (setenv "SOURCE_DATE_EPOCH" "1"))
+
 (define %standard-phases
   ;; 'configure' and 'build' phases are not needed.  Everything is done during
   ;; 'install'.
   (modify-phases gnu:%standard-phases
     (add-after 'unpack 'ensure-no-mtimes-pre-1980 ensure-no-mtimes-pre-1980)
+    (add-after 'unpack 'set-SOURCE-DATE-EPOCH set-SOURCE-DATE-EPOCH)
     (delete 'configure)
     (replace 'install install)
     (replace 'check check)
diff --git a/guix/cve.scm b/guix/cve.scm
new file mode 100644
index 0000000000..a7b0bde6dc
--- /dev/null
+++ b/guix/cve.scm
@@ -0,0 +1,177 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 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 cve)
+  #:use-module (guix utils)
+  #:use-module (guix http-client)
+  #:use-module (sxml ssax)
+  #:use-module (web uri)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
+  #:export (vulnerability?
+            vulnerability-id
+            vulnerability-packages
+
+            xml->vulnerabilities
+            current-vulnerabilities
+            vulnerabilities->lookup-proc))
+
+;;; Commentary:
+;;;
+;;; This modules provides the tools to fetch, parse, and digest part of the
+;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST
+;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>.
+;;;
+;;; Code:
+
+(define-record-type <vulnerability>
+  (vulnerability id packages)
+  vulnerability?
+  (id         vulnerability-id)
+  (packages   vulnerability-packages))
+
+(define %cve-feed-uri
+  (string->uri
+   "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-Modified.xml.gz"))
+
+(define %ttl
+  ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
+  ;; updated "approximately every two hours."
+  (* 3600 3))
+
+(define (call-with-cve-port proc)
+  "Pass PROC an input port from which to read the CVE stream."
+  (let ((port (http-fetch/cached %cve-feed-uri #:ttl %ttl)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (call-with-decompressed-port 'gzip port
+          proc))
+      (lambda ()
+        (close-port port)))))
+
+(define %cpe-package-rx
+  ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION".
+  (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)"))
+
+(define (cpe->package-name cpe)
+  "Converts the Common Platform Enumeration (CPE) string CPE to a package
+name, in a very naive way.  Return #f if CPE does not look like an application
+CPE string."
+  (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
+         (lambda (matches)
+           (cons (match:substring matches 2)
+                 (match:substring matches 3)))))
+
+(define %parse-vulnerability-feed
+  ;; Parse the XML vulnerability feed from
+  ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
+  ;; vulnerability objects.
+  (ssax:make-parser NEW-LEVEL-SEED
+                    (lambda (elem-gi attributes namespaces expected-content
+                                     seed)
+                      (match elem-gi
+                        ((name-space . 'entry)
+                         (cons (assoc-ref attributes 'id) seed))
+                        ((name-space . 'vulnerable-software-list)
+                         (cons '() seed))
+                        ((name-space . 'product)
+                         (cons 'product seed))
+                        (x seed)))
+
+                    FINISH-ELEMENT
+                    (lambda (elem-gi attributes namespaces parent-seed
+                                     seed)
+                      (match elem-gi
+                        ((name-space . 'entry)
+                         (match seed
+                           (((? string? id) . rest)
+                            ;; Some entries have no vulnerable-software-list.
+                            rest)
+                           ((products id . rest)
+                            (match (filter-map cpe->package-name products)
+                              (()
+                               ;; No application among PRODUCTS.
+                               rest)
+                              (packages
+                               (cons (vulnerability id (reverse packages))
+                                     rest))))))
+                        (x
+                         seed)))
+
+                    CHAR-DATA-HANDLER
+                    (lambda (str _ seed)
+                      (match seed
+                        (('product software-list . rest)
+                         ;; Add STR to the vulnerable software list this
+                         ;; <product> tag is part of.
+                         (cons (cons str software-list) rest))
+                        (x x)))))
+
+(define (xml->vulnerabilities port)
+  "Read from PORT an XML feed of vulnerabilities and return a list of
+vulnerability objects."
+  (reverse (%parse-vulnerability-feed port '())))
+
+(define (current-vulnerabilities)
+  "Return the current list of Common Vulnerabilities and Exposures (CVE) as
+published by the US NIST."
+  (call-with-cve-port
+   (lambda (port)
+     ;; XXX: The SSAX "error port" is used to send pointless warnings such as
+     ;; "warning: Skipping PI".  Turn that off.
+     (parameterize ((current-ssax-error-port (%make-void-port "w")))
+       (xml->vulnerabilities port)))))
+
+(define (vulnerabilities->lookup-proc vulnerabilities)
+  "Return a lookup procedure built from VULNERABILITIES that takes a package
+name and optionally a version number.  When the version is omitted, the lookup
+procedure returns a list of version/vulnerability pairs; otherwise, it returns
+a list of vulnerabilities affection the given package version."
+  (define table
+    ;; Map package names to lists of version/vulnerability pairs.
+    (fold (lambda (vuln table)
+            (match vuln
+              (($ <vulnerability> id packages)
+               (fold (lambda (package table)
+                       (match package
+                         ((name . version)
+                          (vhash-cons name (cons version vuln)
+                                      table))))
+                     table
+                     packages))))
+          vlist-null
+          vulnerabilities))
+
+  (lambda* (package #:optional version)
+    (vhash-fold* (if version
+                     (lambda (pair result)
+                       (match pair
+                         ((v . vuln)
+                          (if (string=? v version)
+                              (cons vuln result)
+                              result))))
+                     cons)
+                 '()
+                 package table)))
+
+;;; cve.scm ends here
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 342a6c83f3..5db739a97d 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -239,7 +239,8 @@ result is the set of prerequisites of DRV not already in valid."
             (derivation-output-path (assoc-ref outputs sub-drv)))
           sub-drvs))))
 
-(define* (substitution-oracle store drv)
+(define* (substitution-oracle store drv
+                              #:key (mode (build-mode normal)))
   "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, *except*
@@ -271,9 +272,12 @@ substituter many times."
                           (let ((self (match (derivation->output-paths drv)
                                         (((names . paths) ...)
                                          paths))))
-                            (if (every valid? self)
-                                result
-                                (cons* self (dependencies drv) result))))
+                            (cond ((eqv? mode (build-mode check))
+                                   (cons (dependencies drv) result))
+                                  ((every valid? self)
+                                   result)
+                                  (else
+                                   (cons* self (dependencies drv) result)))))
                         '()
                         drv))))
          (subst (list->set (substitutable-paths store paths))))
@@ -281,11 +285,13 @@ substituter many times."
 
 (define* (derivation-prerequisites-to-build store drv
                                             #:key
+                                            (mode (build-mode normal))
                                             (outputs
                                              (derivation-output-names drv))
                                             (substitutable?
                                              (substitution-oracle store
-                                                                  (list drv))))
+                                                                  (list drv)
+                                                                  #:mode mode)))
   "Return two values: the list of derivation-inputs required to build the
 OUTPUTS of DRV and not already available in STORE, recursively, and the list
 of required store paths that can be substituted.  SUBSTITUTABLE? must be a
@@ -301,8 +307,11 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
     ;; least one is missing, then everything must be rebuilt.
     (compose (cut every substitutable? <>) derivation-input-output-paths))
 
-  (define (derivation-built? drv sub-drvs)
-    (every built? (derivation-output-paths drv sub-drvs)))
+  (define (derivation-built? drv* sub-drvs)
+    ;; In 'check' mode, assume that DRV is not built.
+    (and (not (and (eqv? mode (build-mode check))
+                   (eq? drv* drv)))
+         (every built? (derivation-output-paths drv* sub-drvs))))
 
   (define (derivation-substitutable? drv sub-drvs)
     (and (substitutable-derivation? drv)
@@ -963,13 +972,16 @@ recursively."
 ;;; Store compatibility layer.
 ;;;
 
-(define (build-derivations store derivations)
-  "Build DERIVATIONS, a list of <derivation> objects or .drv file names."
+(define* (build-derivations store derivations
+                            #:optional (mode (build-mode normal)))
+  "Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
+the specified MODE."
   (build-things store (map (match-lambda
                             ((? string? file) file)
                             ((and drv ($ <derivation>))
                              (derivation-file-name drv)))
-                           derivations)))
+                           derivations)
+                mode))
 
 
 ;;;
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 37feb895a5..22d4c7dde2 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -30,6 +30,7 @@
   #:export (ftp-connection?
             ftp-connection-addrinfo
 
+            connect*
             ftp-open
             ftp-close
             ftp-chdir
@@ -82,42 +83,91 @@
         ((331) (%ftp-command (string-append "PASS " pass) 230 port))
         (else  (throw 'ftp-error port command code message))))))
 
-(define* (ftp-open host #:optional (port 21))
+(define-syntax-rule (catch-EINPROGRESS body ...)
+  (catch 'system-error
+    (lambda ()
+      body ...)
+    (lambda args
+      (unless (= (system-error-errno args) EINPROGRESS)
+        (apply throw args)))))
+
+;; XXX: For lack of a better place.
+(define* (connect* s sockaddr #:optional timeout)
+  "When TIMEOUT is omitted or #f, this procedure is equivalent to 'connect'.
+When TIMEOUT is a number, it is the (possibly inexact) maximum number of
+seconds to wait for the connection to succeed."
+  (define (raise-error errno)
+    (throw 'system-error 'connect* "~A"
+           (list (strerror errno))
+           (list errno)))
+
+  (if timeout
+      (let ((flags (fcntl s F_GETFL)))
+        (fcntl s F_SETFL (logior flags O_NONBLOCK))
+        (catch-EINPROGRESS (connect s sockaddr))
+        (match (select '() (list s) (list s) timeout)
+          ((() () ())
+           ;; Time is up!
+           (raise-error ETIMEDOUT))
+          ((() (write) ())
+           ;; Check for ECONNREFUSED and the likes.
+           (fcntl s F_SETFL flags)
+           (let ((errno (getsockopt s SOL_SOCKET SO_ERROR)))
+             (unless (zero? errno)
+               (raise-error errno))))
+          ((() () (except))
+           ;; Seems like this cannot really happen, but who knows.
+           (let ((errno (getsockopt s SOL_SOCKET SO_ERROR)))
+             (raise-error errno)))))
+      (connect s sockaddr)))
+
+(define* (ftp-open host #:optional (port "ftp") #:key timeout)
   "Open an FTP connection to HOST on PORT (a service-identifying string,
-or a TCP port number), and return it."
-  ;; Use 21 as the default PORT instead of "ftp", to avoid depending on
-  ;; libc's NSS, which is not available during bootstrap.
+or a TCP port number), and return it.
+
+When TIMEOUT is not #f, it must be a (possibly inexact) number denoting the
+maximum duration in seconds to wait for the connection to complete; passed
+TIMEOUT, an ETIMEDOUT error is raised."
+  ;; Using "ftp" for PORT instead of 21 allows 'getaddrinfo' to return only
+  ;; TCP/IP addresses (otherwise it would return SOCK_DGRAM and SOCK_RAW
+  ;; addresses as well.)  With our bootstrap Guile, which includes a
+  ;; statically-linked NSS, resolving "ftp" works well, as long as
+  ;; /etc/services is available.
 
   (define addresses
     (getaddrinfo host
                  (if (number? port) (number->string port) port)
-                 (if (number? port) AI_NUMERICSERV 0)))
+                 (if (number? port)
+                     (logior AI_ADDRCONFIG AI_NUMERICSERV)
+                     AI_ADDRCONFIG)))
 
   (let loop ((addresses addresses))
-    (let* ((ai (car addresses))
-           (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)
-                       (addrinfo:protocol ai))))
-
-      (catch 'system-error
-        (lambda ()
-          (connect s (addrinfo:addr ai))
-          (setvbuf s _IOLBF)
-          (let-values (((code message) (%ftp-listen s)))
-            (if (eqv? code 220)
-                (begin
-                  ;;(%ftp-command "OPTS UTF8 ON" 200 s)
-                  (%ftp-login "anonymous" "guix@example.com" s)
-                  (%make-ftp-connection s ai))
-                (begin
-                  (close s)
-                  (throw 'ftp-error s "log-in" code message)))))
-
-        (lambda args
-          ;; Connection failed, so try one of the other addresses.
-          (close s)
-          (if (null? addresses)
-              (apply throw args)
-              (loop (cdr addresses))))))))
+    (match addresses
+      ((ai rest ...)
+       (let ((s (socket (addrinfo:fam ai)
+                        ;; TCP/IP only
+                        SOCK_STREAM IPPROTO_IP)))
+
+         (catch 'system-error
+           (lambda ()
+             (connect* s (addrinfo:addr ai) timeout)
+             (setvbuf s _IOLBF)
+             (let-values (((code message) (%ftp-listen s)))
+               (if (eqv? code 220)
+                   (begin
+                     ;;(%ftp-command "OPTS UTF8 ON" 200 s)
+                     (%ftp-login "anonymous" "guix@example.com" s)
+                     (%make-ftp-connection s ai))
+                   (begin
+                     (close s)
+                     (throw 'ftp-error s "log-in" code message)))))
+
+           (lambda args
+             ;; Connection failed, so try one of the other addresses.
+             (close s)
+             (if (null? rest)
+                 (apply throw args)
+                 (loop rest)))))))))
 
 (define (ftp-close conn)
   (close (ftp-connection-socket conn)))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 27bccc6206..14ced747b2 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -980,7 +980,8 @@ its search path."
                      (call-with-output-file (ungexp output)
                        (lambda (port)
                          (write '(ungexp exp) port))))
-                    #:local-build? #t))
+                    #:local-build? #t
+                    #:substitutable? #f))
 
 (define* (text-file* name #:rest text)
   "Return as a monadic value a derivation that builds a text file containing
@@ -992,7 +993,9 @@ resulting store file holds references to all these."
             (lambda (port)
               (display (string-append (ungexp-splicing text)) port)))))
 
-  (gexp->derivation name builder))
+  (gexp->derivation name builder
+                    #:local-build? #t
+                    #:substitutable? #f))
 
 (define* (mixed-text-file name #:rest text)
   "Return an object representing store file NAME containing TEXT.  TEXT is a
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 5af1b884ce..96fbfb76b4 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -50,12 +50,14 @@
             find-packages
             gnu-package?
 
+            release-file?
             releases
             latest-release
             gnu-release-archive-types
             gnu-package-name->name+version
 
-            %gnu-updater))
+            %gnu-updater
+            %gnome-updater))
 
 ;;; Commentary:
 ;;;
@@ -220,8 +222,10 @@ stored."
       ("mit-scheme"   "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
       ("icecat"       "ftp.gnu.org" "/gnu/gnuzilla")
       ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
-      ("glib"         "ftp.gnome.org" "/pub/gnome/sources/glib")
       ("gnutls"       "ftp.gnutls.org" "/gcrypt/gnutls")
+
+      ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to
+      ;; its own http URL instead.
       ("TeXmacs"      "ftp.texmacs.org" "/TeXmacs/targz")))
 
   (match (assoc project quirks)
@@ -237,8 +241,10 @@ stored."
     (substring tarball 0 end)))
 
 (define %tarball-rx
-  ;; Note: .zip files are notably used for freefont-ttf.
-  (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.(tar\\.|zip$)"))
+  ;; The .zip extensions is notably used for freefont-ttf.
+  ;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz".
+  ;; The "-gnu[0-9]" pattern is for "icecat-38.4.0-gnu1.tar.bz2".
+  (make-regexp "^([^.]+)-([0-9]|[^-])+(-(src|gnu[0-9]))?\\.(tar\\.|zip$)"))
 
 (define %alpha-tarball-rx
   (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
@@ -250,7 +256,10 @@ true."
        (and=> (regexp-exec %tarball-rx file)
               (lambda (match)
                 ;; Filter out unrelated files, like `guile-www-1.1.1'.
-                (equal? project (match:substring match 1))))
+                ;; Case-insensitive for things like "TeXmacs" vs. "texmacs".
+                (and=> (match:substring match 1)
+                       (lambda (name)
+                         (string-ci=? name project)))))
        (not (regexp-exec %alpha-tarball-rx file))
        (let ((s (sans-extension file)))
          (regexp-exec %package-name-rx s))))
@@ -308,10 +317,22 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                               files)
                   result))))))))
 
-(define* (latest-release project
-                         #:key (ftp-open ftp-open) (ftp-close ftp-close))
-  "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f.  Use FTP-OPEN and FTP-CLOSE to
-open (resp. close) FTP connections; this can be useful to reuse connections."
+(define* (latest-ftp-release project
+                             #:key
+                             (server "ftp.gnu.org")
+                             (directory (string-append "/gnu/" project))
+                             (keep-file? (const #t))
+                             (file->signature (cut string-append <> ".sig"))
+                             (ftp-open ftp-open) (ftp-close ftp-close))
+  "Return an <upstream-source> for the latest release of PROJECT on SERVER
+under DIRECTORY, or #f.  Use FTP-OPEN and FTP-CLOSE to open (resp. close) FTP
+connections; this can be useful to reuse connections.
+
+KEEP-FILE? is a predicate to decide whether to enter a directory and to
+consider a given file (source tarball) as a valid candidate based on its name.
+
+FILE->SIGNATURE must be a procedure; it is passed a source file URL and must
+return the corresponding signature URL, or #f it signatures are unavailable."
   (define (latest a b)
     (if (version>? a b) a b))
 
@@ -326,74 +347,94 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
     ;; Return #t for patch directory names such as 'bash-4.2-patches'.
     (cut string-suffix? "patches" <>))
 
-  (let-values (((server directory) (ftp-server/directory project)))
-    (define conn (ftp-open server))
-
-    (define (file->url file)
-      (string-append "ftp://" server directory "/" file))
-
-    (define (file->source file)
-      (let ((url (file->url file)))
-        (upstream-source
-         (package project)
-         (version (tarball->version file))
-         (urls (list url))
-         (signature-urls (list (string-append url ".sig"))))))
-
-    (let loop ((directory directory)
-               (result    #f))
-      (let* ((entries (ftp-list conn directory))
-
-             ;; Filter out sub-directories that do not contain digits---e.g.,
-             ;; /gnuzilla/lang and /gnupg/patches.
-             (subdirs (filter-map (match-lambda
-                                    (((? patch-directory-name? dir)
-                                      'directory . _)
-                                     #f)
-                                    (((? contains-digit? dir) 'directory . _)
-                                     dir)
-                                    (_ #f))
-                                  entries))
-
-             ;; Whether or not SUBDIRS is empty, compute the latest releases
-             ;; for the current directory.  This is necessary for packages
-             ;; such as 'sharutils' that have a sub-directory that contains
-             ;; only an older release.
-             (releases (filter-map (match-lambda
-                                     ((file 'file . _)
-                                      (and (release-file? project file)
-                                           (file->source file)))
-                                     (_ #f))
-                                   entries)))
-
-        ;; Assume that SUBDIRS correspond to versions, and jump into the
-        ;; one with the highest version number.
-        (let* ((release  (reduce latest-release #f
-                                 (coalesce-sources releases)))
-               (result   (if (and result release)
-                             (latest-release release result)
-                             (or release result)))
-               (target   (reduce latest #f subdirs)))
-          (if target
-              (loop (string-append directory "/" target)
-                    result)
-              (begin
-                (ftp-close conn)
-                result)))))))
-
-(define (latest-release* package)
-  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
-is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
-name (this is the case for \"emacs-auctex\", for instance.)"
+  (define conn (ftp-open server))
+
+  (define (file->url directory file)
+    (string-append "ftp://" server directory "/" file))
+
+  (define (file->source directory file)
+    (let ((url (file->url directory file)))
+      (upstream-source
+       (package project)
+       (version (tarball->version file))
+       (urls (list url))
+       (signature-urls (match (file->signature url)
+                         (#f #f)
+                         (sig (list sig)))))))
+
+  (let loop ((directory directory)
+             (result    #f))
+    (let* ((entries (ftp-list conn directory))
+
+           ;; Filter out sub-directories that do not contain digits---e.g.,
+           ;; /gnuzilla/lang and /gnupg/patches.  Filter out "w32"
+           ;; directories as found on ftp.gnutls.org.
+           (subdirs (filter-map (match-lambda
+                                  (((? patch-directory-name? dir)
+                                    'directory . _)
+                                   #f)
+                                  (("w32" 'directory . _)
+                                   #f)
+                                  (((? contains-digit? dir) 'directory . _)
+                                   (and (keep-file? dir) dir))
+                                  (_ #f))
+                                entries))
+
+           ;; Whether or not SUBDIRS is empty, compute the latest releases
+           ;; for the current directory.  This is necessary for packages
+           ;; such as 'sharutils' that have a sub-directory that contains
+           ;; only an older release.
+           (releases (filter-map (match-lambda
+                                   ((file 'file . _)
+                                    (and (release-file? project file)
+                                         (keep-file? file)
+                                         (file->source directory file)))
+                                   (_ #f))
+                                 entries)))
+
+      ;; Assume that SUBDIRS correspond to versions, and jump into the
+      ;; one with the highest version number.
+      (let* ((release  (reduce latest-release #f
+                               (coalesce-sources releases)))
+             (result   (if (and result release)
+                           (latest-release release result)
+                           (or release result)))
+             (target   (reduce latest #f subdirs)))
+        (if target
+            (loop (string-append directory "/" target)
+                  result)
+            (begin
+              (ftp-close conn)
+              result))))))
+
+(define (latest-release package . rest)
+  "Return the <upstream-source> for the latest version of PACKAGE or #f.
+PACKAGE is the name of a GNU package.  This procedure automatically uses the
+right FTP server and directory for PACKAGE."
+  (let-values (((server directory) (ftp-server/directory package)))
+    (apply latest-ftp-release package
+           #:server server
+           #:directory directory
+           rest)))
+
+(define-syntax-rule (false-if-ftp-error exp)
+  "Return #f if an FTP error is raise while evaluating EXP; return the result
+of EXP otherwise."
   (catch 'ftp-error
     (lambda ()
-      (latest-release package))
+      exp)
     (lambda (key port . rest)
       (if (ftp-connection? port)
           (ftp-close port)
           (close-port port))
       #f)))
 
+(define (latest-release* package)
+  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
+is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
+name (this is the case for \"emacs-auctex\", for instance.)"
+  (false-if-ftp-error (latest-release package)))
+
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
   ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed.
@@ -406,15 +447,79 @@ name (this is the case for \"emacs-auctex\", for instance.)"
         (values name+version #f)
         (values (match:substring match 1) (match:substring match 2)))))
 
-(define (non-emacs-gnu-package? package)
-  "Return true if PACKAGE is a non-Emacs GNU package.  This excludes AucTeX,
-for instance, whose releases are now uploaded to elpa.gnu.org."
+(define (pure-gnu-package? package)
+  "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package.  This
+excludes AucTeX, for instance, whose releases are now uploaded to
+elpa.gnu.org, and all the GNOME packages."
   (and (not (string-prefix? "emacs-" (package-name package)))
+       (not (gnome-package? package))
        (gnu-package? package)))
 
+(define (gnome-package? package)
+  "Return true if PACKAGE is a GNOME package, hosted on gnome.org."
+  (define gnome-uri?
+    (match-lambda
+      ((? string? uri)
+       (string-prefix? "mirror://gnome/" uri))
+      (_
+       #f)))
+
+  (match (package-source package)
+    ((? origin? origin)
+     (match (origin-uri origin)
+       ((? gnome-uri?) #t)
+       (_              #f)))
+    (_ #f)))
+
+(define (latest-gnome-release package)
+  "Return the latest release of PACKAGE, the name of a GNOME package."
+  (define %not-dot
+    (char-set-complement (char-set #\.)))
+
+  (define (even-minor-version? version)
+    (match (string-tokenize version %not-dot)
+      (((= string->number major) (= string->number minor) . rest)
+       (and minor (even? minor)))
+      (_
+       #t)))                                      ;cross fingers
+
+  (define (even-numbered? file)
+    ;; Return true if FILE somehow denotes an even-numbered file name.  The
+    ;; trick here is that we want this to match both directories such as
+    ;; "3.18.6" and actual file names such as "gtk+-3.18.6.tar.bz2".
+    (let-values (((name version) (package-name->name+version file)))
+      (even-minor-version? (or version name))))
+
+  (false-if-ftp-error
+   (latest-ftp-release package
+                       #:server "ftp.gnome.org"
+                       #:directory (string-append "/pub/gnome/sources/"
+                                                  (match package
+                                                    ("gconf" "GConf")
+                                                    (x       x)))
+
+
+                       ;; <https://www.gnome.org/gnome-3/source/> explains
+                       ;; that odd minor version numbers represent development
+                       ;; releases, which we are usually not interested in.
+                       #:keep-file? even-numbered?
+
+                       ;; ftp.gnome.org provides no signatures, only
+                       ;; checksums.
+                       #:file->signature (const #f))))
+
 (define %gnu-updater
-  (upstream-updater 'gnu
-                    non-emacs-gnu-package?
-                    latest-release*))
+  (upstream-updater
+   (name 'gnu)
+   (description "Updater for GNU packages")
+   (pred pure-gnu-package?)
+   (latest latest-release*)))
+
+(define %gnome-updater
+  (upstream-updater
+   (name 'gnome)
+   (description "Updater for GNOME packages")
+   (pred gnome-package?)
+   (latest latest-gnome-release)))
 
 ;;; gnu-maintenance.scm ends here
diff --git a/guix/graph.scm b/guix/graph.scm
new file mode 100644
index 0000000000..a39208e7f9
--- /dev/null
+++ b/guix/graph.scm
@@ -0,0 +1,187 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 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 graph)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix records)
+  #:use-module (guix sets)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:export (node-type
+            node-type?
+            node-type-identifier
+            node-type-label
+            node-type-edges
+            node-type-convert
+            node-type-name
+            node-type-description
+
+            node-edges
+            node-back-edges
+            node-transitive-edges
+
+            %graphviz-backend
+            graph-backend?
+            graph-backend
+
+            export-graph))
+
+;;; Commentary:
+;;;
+;;; This module provides an abstract way to represent graphs and to manipulate
+;;; them.  It comes with several such representations for packages,
+;;; derivations, and store items.  It also provides a generic interface for
+;;; exporting graphs in an external format, including a Graphviz
+;;; implementation thereof.
+;;;
+;;; Code:
+
+
+;;;
+;;; Node types.
+;;;
+
+(define-record-type* <node-type> node-type make-node-type
+  node-type?
+  (identifier  node-type-identifier)              ;node -> M identifier
+  (label       node-type-label)                   ;node -> string
+  (edges       node-type-edges)                   ;node -> M list of nodes
+  (convert     node-type-convert                  ;package -> M list of nodes
+               (default (lift1 list %store-monad)))
+  (name        node-type-name)                    ;string
+  (description node-type-description))            ;string
+
+(define (%node-edges type nodes cons-edge)
+  (with-monad %store-monad
+    (match type
+      (($ <node-type> identifier label node-edges)
+       (define (add-edge node edges)
+         (>>= (node-edges node)
+              (lambda (nodes)
+                (return (fold (cut cons-edge node <> <>)
+                              edges nodes)))))
+
+       (mlet %store-monad ((edges (foldm %store-monad
+                                         add-edge vlist-null nodes)))
+         (return (lambda (node)
+                   (reverse (vhash-foldq* cons '() node edges)))))))))
+
+(define (node-edges type nodes)
+  "Return, as a monadic value, a one-argument procedure that, given a node of TYPE,
+returns its edges.  NODES is taken to be the sinks of the global graph."
+  (%node-edges type nodes
+               (lambda (source target edges)
+                 (vhash-consq source target edges))))
+
+(define (node-back-edges type nodes)
+  "Return, as a monadic value, a one-argument procedure that, given a node of TYPE,
+returns its back edges.  NODES is taken to be the sinks of the global graph."
+  (%node-edges type nodes
+               (lambda (source target edges)
+                 (vhash-consq target source edges))))
+
+(define (node-transitive-edges nodes node-edges)
+  "Return the list of nodes directly or indirectly connected to NODES
+according to the NODE-EDGES procedure.  NODE-EDGES must be a one-argument
+procedure that, given a node, returns its list of direct dependents; it is
+typically returned by 'node-edges' or 'node-back-edges'."
+  (let loop ((nodes   (append-map node-edges nodes))
+             (result  '())
+             (visited (setq)))
+    (match nodes
+      (()
+       result)
+      ((head . tail)
+       (if (set-contains? visited head)
+           (loop tail result visited)
+           (let ((edges (node-edges head)))
+             (loop (append edges tail)
+                   (cons head result)
+                   (set-insert head visited))))))))
+
+
+;;;
+;;; Graphviz export.
+;;;
+
+(define-record-type <graph-backend>
+  (graph-backend prologue epilogue node edge)
+  graph-backend?
+  (prologue graph-backend-prologue)
+  (epilogue graph-backend-epilogue)
+  (node     graph-backend-node)
+  (edge     graph-backend-edge))
+
+(define (emit-prologue name port)
+  (format port "digraph \"Guix ~a\" {\n"
+          name))
+(define (emit-epilogue port)
+  (display "\n}\n" port))
+(define (emit-node id label port)
+  (format port "  \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%"
+          id label))
+(define (emit-edge id1 id2 port)
+  (format port "  \"~a\" -> \"~a\" [color = red];~%"
+          id1 id2))
+
+(define %graphviz-backend
+  (graph-backend emit-prologue emit-epilogue
+                 emit-node emit-edge))
+
+(define* (export-graph sinks port
+                       #:key
+                       reverse-edges? node-type
+                       (backend %graphviz-backend))
+  "Write to PORT the representation of the DAG with the given SINKS, using the
+given BACKEND.  Use NODE-TYPE to traverse the DAG.  When REVERSE-EDGES? is
+true, draw reverse arrows."
+  (match backend
+    (($ <graph-backend> emit-prologue emit-epilogue emit-node emit-edge)
+     (emit-prologue (node-type-name node-type) port)
+
+     (match node-type
+       (($ <node-type> node-identifier node-label node-edges)
+        (let loop ((nodes   sinks)
+                   (visited (set)))
+          (match nodes
+            (()
+             (with-monad %store-monad
+               (emit-epilogue port)
+               (store-return #t)))
+            ((head . tail)
+             (mlet %store-monad ((id (node-identifier head)))
+               (if (set-contains? visited id)
+                   (loop tail visited)
+                   (mlet* %store-monad ((dependencies (node-edges head))
+                                        (ids          (mapm %store-monad
+                                                            node-identifier
+                                                            dependencies)))
+                     (emit-node id (node-label head) port)
+                     (for-each (lambda (dependency dependency-id)
+                                 (if reverse-edges?
+                                     (emit-edge dependency-id id port)
+                                     (emit-edge id dependency-id port)))
+                               dependencies ids)
+                     (loop (append dependencies tail)
+                           (set-insert id visited)))))))))))))
+
+;;; graph.scm ends here
diff --git a/guix/http-client.scm b/guix/http-client.scm
index bee8cdc834..eb2c3f4d5f 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -35,7 +35,8 @@
   #:use-module ((guix build utils)
                 #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
-                #:select (open-socket-for-uri resolve-uri-reference))
+                #:select (open-socket-for-uri
+                          open-connection-for-uri resolve-uri-reference))
   #:re-export (open-socket-for-uri)
   #:export (&http-get-error
             http-get-error?
@@ -206,8 +207,10 @@ textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
 unbuffered port, suitable for use in `filtered-port'.
 
 Raise an '&http-get-error' condition if downloading fails."
-  (let loop ((uri uri))
-    (let ((port (or port (open-socket-for-uri uri))))
+  (let loop ((uri (if (string? uri)
+                      (string->uri uri)
+                      uri)))
+    (let ((port (or port (open-connection-for-uri uri))))
       (unless buffered?
         (setvbuf port _IONBF))
       (let*-values (((resp data)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 45d644a2c7..c20e074e18 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -30,6 +30,7 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (system base lalr)
   #:use-module (rnrs enums)
+  #:use-module (guix utils)
   #:export (read-cabal
             eval-cabal
             
@@ -138,7 +139,7 @@ to the stack."
   "Generate a parser for Cabal files."
   (lalr-parser
    ;; --- token definitions
-   (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION
+   (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE
            (right: IF FLAG EXEC TEST-SUITE SOURCE-REPO BENCHMARK LIB OCURLY)
            (left: OR)
            (left: PROPERTY AND)
@@ -206,6 +207,8 @@ to the stack."
    (if-then     (IF tests OCURLY exprs CCURLY) : `(if ,$2 ,$4 ())
                 (IF tests open exprs close)    : `(if ,$2 ,$4 ()))
    (tests       (TEST OPAREN ID CPAREN)        : `(,$1 ,$3)
+                (TRUE)                         : 'true
+                (FALSE)                        : 'false
                 (TEST OPAREN ID RELATION VERSION CPAREN)
                 : `(,$1 ,(string-append $3 " " $4 " " $5))
                 (TEST OPAREN ID RELATION VERSION AND RELATION VERSION CPAREN)
@@ -224,19 +227,24 @@ to the stack."
   "This function can be called when the next character on PORT is #\newline
 and returns the indentation of the line starting after the #\newline
 character.  Discard (and consume) empty and comment lines."
-  (let ((initial-newline (string (read-char port))))
-    (let loop ((char (peek-char port))
-               (word ""))
-      (cond ((eqv? char #\newline) (read-char port)
-             (loop (peek-char port) ""))
-            ((or (eqv? char #\space) (eqv? char #\tab))
-             (let ((c (read-char port)))
-               (loop (peek-char port) (string-append word (string c)))))
-            ((comment-line port char) (loop (peek-char port) ""))
-            (else
-             (let ((len (string-length word)))
-               (unread-string (string-append initial-newline word) port)
-               len))))))
+  (if (eof-object? (peek-char port))
+      ;; If the file is missing the #\newline on the last line, add it and act
+      ;; as if it were there. This is needed for proper operation of
+      ;; indentation based block recognition (based on ‘port-column’).
+      (begin (unread-char #\newline port) (read-char port) 0)
+      (let ((initial-newline (string (read-char port))))
+        (let loop ((char (peek-char port))
+                   (word ""))
+          (cond ((eqv? char #\newline) (read-char port)
+                 (loop (peek-char port) ""))
+                ((or (eqv? char #\space) (eqv? char #\tab))
+                 (let ((c (read-char port)))
+                   (loop (peek-char port) (string-append word (string c)))))
+                ((comment-line port char) (loop (peek-char port) ""))
+                (else
+                 (let ((len (string-length word)))
+                   (unread-string (string-append initial-newline word) port)
+                   len)))))))
 
 (define* (read-value port value min-indent #:optional (separator " "))
   "The next character on PORT must be #\newline.  Append to VALUE the
@@ -325,7 +333,7 @@ matching a string against the created regexp."
                 (make-regexp pat))))
     (cut regexp-exec rx <>)))
 
-(define is-property (make-rx-matcher "([a-z0-9-]+):[ \t]*(\\w?.*)$"
+(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$"
                                      regexp/icase))
 
 (define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
@@ -350,21 +358,32 @@ matching a string against the created regexp."
 
 (define (is-if s) (string-ci=? s "if"))
 
+(define (is-true s) (string-ci=? s "true"))
+
+(define (is-false s) (string-ci=? s "false"))
+
 (define (is-and s) (string=? s "&&"))
 
 (define (is-or s) (string=? s "||"))
 
-(define (is-id s)
+(define (is-id s port)
   (let ((cabal-reserved-words
          '("if" "else" "library" "flag" "executable" "test-suite"
-           "source-repository" "benchmark")))
+           "source-repository" "benchmark"))
+        (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
+        (c (peek-char port)))
+    (unread-string spaces port)
     (and (every (cut string-ci<> s <>) cabal-reserved-words)
-         (not (char=? (last (string->list s)) #\:)))))
+         (and (not (char=? (last (string->list s)) #\:))
+              (not (char=? #\: c))))))
 
 (define (is-test s port)
   (let ((tests-rx (make-regexp "os|arch|flag|impl"))
+        (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
         (c (peek-char port)))
-    (and (regexp-exec tests-rx s) (char=? #\( c))))
+    (if (and (regexp-exec tests-rx s) (char=? #\( c))
+        #t
+        (begin (unread-string spaces port) #f))))
 
 ;; Lexers for individual tokens.
 
@@ -424,6 +443,10 @@ string with the read characters."
 
 (define (lex-if loc) (make-lexical-token 'IF loc #f))
 
+(define (lex-true loc) (make-lexical-token 'TRUE loc #t))
+
+(define (lex-false loc) (make-lexical-token 'FALSE loc #f))
+
 (define (lex-and loc) (make-lexical-token 'AND loc #f))
 
 (define (lex-or loc) (make-lexical-token 'OR loc #f))
@@ -486,12 +509,14 @@ location."
 (define (lex-word port loc)
   "Process tokens which can be recognized by reading the next word form PORT.
 LOC is the current port location."
-  (let* ((w (read-delimited " ()\t\n" port 'peek)))
+  (let* ((w (read-delimited " <>=()\t\n" port 'peek)))
     (cond ((is-if w) (lex-if loc))
           ((is-test w port) (lex-test w loc))
+          ((is-true w) (lex-true loc))
+          ((is-false w) (lex-false loc))
           ((is-and w) (lex-and loc))
           ((is-or w) (lex-or loc))
-          ((is-id w) (lex-id w loc))
+          ((is-id w port) (lex-id w loc))
           (else (unread-string w port) #f))))
 
 (define (lex-line port loc)
@@ -684,11 +709,18 @@ the ordering operation and the version."
                   ((spec-name spec-op spec-ver)
                    (comp-spec-name+op+version haskell)))
       (if (and spec-ver comp-ver)
-          (eval-string
-           (string-append "(string" spec-op " \"" comp-name "\""
-                          " \"" spec-name "-" spec-ver "\")"))
+          (cond
+           ((not (string= spec-name comp-name)) #f)
+           ((string= spec-op "==") (string= spec-ver comp-ver))
+           ((string= spec-op ">=") (version>=? comp-ver spec-ver))
+           ((string= spec-op ">") (version>? comp-ver spec-ver))
+           ((string= spec-op "<=") (not (version>? comp-ver spec-ver)))
+           ((string= spec-op "<") (not (version>=? comp-ver spec-ver)))
+           (else
+            (raise (condition
+                    (&message (message "Failed to evaluate 'impl' test."))))))
           (string-match spec-name comp-name))))
-  
+
   (define (cabal-flags)
     (make-cabal-section cabal-sexp 'flag))
   
@@ -714,6 +746,8 @@ the ordering operation and the version."
       (('os name) (os name))
       (('arch name) (arch name))
       (('impl name) (impl name))
+      ('true #t)
+      ('false #f)
       (('not name) (not (eval name)))
       ;; 'and' and 'or' aren't functions, thus we can't use apply
       (('and args ...) (fold (lambda (e s) (and e s)) #t (eval args)))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 6284c9eef3..845ecb5832 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -20,26 +20,26 @@
 (define-module (guix import cran)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module ((ice-9 rdelim) #:select (read-string))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:use-module (sxml simple)
-  #:use-module (sxml match)
-  #:use-module (sxml xpath)
   #:use-module (guix http-client)
   #:use-module (guix hash)
   #:use-module (guix store)
   #:use-module (guix base32)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
+  #:use-module ((guix build-system r) #:select (cran-uri))
   #:use-module (guix upstream)
   #:use-module (guix packages)
+  #:use-module (gnu packages)
   #:export (cran->guix-package
             %cran-updater))
 
 ;;; Commentary:
 ;;;
 ;;; Generate a package declaration template for the latest version of an R
-;;; package on CRAN, using the HTML description downloaded from
+;;; package on CRAN, using the DESCRIPTION file downloaded from
 ;;; cran.r-project.org.
 ;;;
 ;;; Code:
@@ -51,16 +51,47 @@
    ("Apache License 2.0" 'asl2.0)
    ("BSD_2_clause" 'bsd-2)
    ("BSD_3_clause" 'bsd-3)
+   ("GPL" (list 'gpl2+ 'gpl3+))
+   ("GPL (>= 2)" 'gpl2+)
+   ("GPL (>= 3)" 'gpl3+)
    ("GPL-2" 'gpl2+)
    ("GPL-3" 'gpl3+)
    ("LGPL-2" 'lgpl2.0+)
    ("LGPL-2.1" 'lgpl2.1+)
    ("LGPL-3" 'lgpl3+)
+   ("LGPL (>= 2)" 'lgpl2.0+)
+   ("LGPL (>= 3)" 'lgpl3+)
    ("MIT" 'x11)
+   ("MIT + file LICENSE" 'x11)
    ((x) (string->license x))
    ((lst ...) `(list ,@(map string->license lst)))
    (_ #f)))
 
+
+(define (description->alist description)
+  "Convert a DESCRIPTION string into an alist."
+  (let ((lines (string-split description #\newline))
+        (parse (lambda (line acc)
+                 (if (string-null? line) acc
+                     ;; Keys usually start with a capital letter and end with
+                     ;; ":".  There are some exceptions, unfortunately (such
+                     ;; as "biocViews").  There are no blanks in a key.
+                     (if (string-match "^[A-Za-z][^ :]+:( |\n|$)" line)
+                         ;; New key/value pair
+                         (let* ((pos   (string-index line #\:))
+                                (key   (string-take line pos))
+                                (value (string-drop line (+ 1 pos))))
+                           (cons (cons key
+                                       (string-trim-both value))
+                                 acc))
+                         ;; This is a continuation of the previous pair
+                         (match-let ((((key . value) . rest) acc))
+                           (cons (cons key (string-join
+                                            (list value
+                                                  (string-trim-both line))))
+                                 rest)))))))
+    (fold parse '() lines)))
+
 (define (format-inputs names)
   "Generate a sorted list of package inputs from a list of package NAMES."
   (map (lambda (name)
@@ -76,125 +107,94 @@ package definition."
     ((package-inputs ...)
      `((,type (,'quasiquote ,(format-inputs package-inputs)))))))
 
-(define (table-datum tree label)
-  "Extract the datum node following a LABEL in the sxml table TREE.  Only the
-first cell of a table row is considered a label cell."
-  ((node-pos 1)
-   ((sxpath `(xhtml:tr
-              (xhtml:td 1)        ; only first cell can contain label
-              (equal? ,label)
-              ,(node-parent tree) ; go up to label cell
-              ,(node-parent tree) ; go up to matching row
-              (xhtml:td 2)))      ; select second cell
-    tree)))
-
 (define %cran-url "http://cran.r-project.org/web/packages/")
 
 (define (cran-fetch name)
-  "Return an sxml representation of the CRAN page for the R package NAME,
-or #f on failure.  NAME is case-sensitive."
+  "Return an alist of the contents of the DESCRIPTION file for the R package
+NAME, or #f on failure.  NAME is case-sensitive."
   ;; This API always returns the latest release of the module.
-  (let ((cran-url (string-append %cran-url name "/")))
-    (false-if-exception
-     (xml->sxml (http-fetch cran-url)
-                #:trim-whitespace? #t
-                #:namespaces '((xhtml . "http://www.w3.org/1999/xhtml"))
-                #:default-entity-handler
-                (lambda (port name)
-                  (case name
-                    ((nbsp) " ")
-                    ((ge) ">=")
-                    ((gt) ">")
-                    ((lt) "<")
-                    (else
-                     (format (current-warning-port)
-                             "~a:~a:~a: undefined entitity: ~a\n"
-                             cran-url (port-line port) (port-column port)
-                             name)
-                     (symbol->string name))))))))
-
-(define (downloads->url downloads)
-  "Extract from DOWNLOADS, the downloads item of the CRAN sxml tree, the
-download URL."
-  (string-append "mirror://cran/"
-                 ;; Remove double dots, because we want an
-                 ;; absolute path.
-                 (regexp-substitute/global
-                  #f "\\.\\./"
-                  (string-join ((sxpath '((xhtml:a 1) @ href *text*))
-                                (table-datum downloads " Package source: ")))
-                  'pre 'post)))
-
-(define (nodes->text nodeset)
-  "Return the concatenation of the text nodes among NODESET."
-  (string-join ((sxpath '(// *text*)) nodeset) " "))
-
-(define (cran-sxml->sexp sxml)
-  "Return the `package' s-expression for a CRAN package from the SXML
-representation of the package page."
+  (let ((url (string-append %cran-url name "/DESCRIPTION")))
+    (description->alist (read-string (http-fetch url)))))
+
+(define (listify meta field)
+  "Look up FIELD in the alist META.  If FIELD contains a comma-separated
+string, turn it into a list and strip off parenthetic expressions.  Return the
+empty list when the FIELD cannot be found."
+  (let ((value (assoc-ref meta field)))
+    (if (not value)
+        '()
+        ;; Strip off parentheses
+        (let ((items (string-split (regexp-substitute/global
+                                    #f "( *\\([^\\)]+\\)) *"
+                                    value 'pre 'post)
+                                   #\,)))
+          ;; When there is whitespace inside of items it is probably because
+          ;; this was not an actual list to begin with.
+          (remove (cut string-any char-set:whitespace <>)
+                  (map string-trim-both items))))))
+
+(define (beautify-description description)
+  "Improve the package DESCRIPTION by turning a beginning sentence fragment
+into a proper sentence and by using two spaces between sentences."
+  (let ((cleaned (if (string-prefix? "A " description)
+                     (string-append "This package provides a"
+                                    (substring description 1))
+                     description)))
+    ;; Use double spacing between sentences
+    (regexp-substitute/global #f "\\. \\b"
+                              cleaned 'pre ".  " 'post)))
+
+(define (description->package meta)
+  "Return the `package' s-expression for a CRAN package from the alist META,
+which was derived from the R package's DESCRIPTION file."
   (define (guix-name name)
     (if (string-prefix? "r-" name)
         (string-downcase name)
         (string-append "r-" (string-downcase name))))
 
-  (sxml-match-let*
-   (((*TOP* (xhtml:html
-             ,head
-             (xhtml:body
-              (xhtml:h2 ,name-and-synopsis)
-              (xhtml:p ,description)
-              ,summary
-              (xhtml:h4 "Downloads:") ,downloads
-              . ,rest)))
-     sxml))
-   (let* ((name       (match:prefix (string-match ": " name-and-synopsis)))
-          (synopsis   (match:suffix (string-match ": " name-and-synopsis)))
-          (version    (nodes->text (table-datum summary "Version:")))
-          (license    ((compose string->license nodes->text)
-                       (table-datum summary "License:")))
-          (home-page  (nodes->text ((sxpath '((xhtml:a 1)))
-                                    (table-datum summary "URL:"))))
-          (source-url (downloads->url downloads))
-          (tarball    (with-store store (download-to-store store source-url)))
-          (sysdepends (map match:substring
-                           (list-matches
-                            "[^ ]+"
-                            ;; Strip off comma and parenthetical
-                            ;; expressions.
-                            (regexp-substitute/global
-                             #f "(,|\\([^\\)]+\\))"
-                             (nodes->text (table-datum summary
-                                                       "SystemRequirements:"))
-                             'pre 'post))))
-          (imports    (map guix-name
-                           ((sxpath '(// xhtml:a *text*))
-                            (table-datum summary "Imports:")))))
-     `(package
-        (name ,(guix-name name))
-        (version ,version)
-        (source (origin
-                  (method url-fetch)
-                  (uri (cran-uri ,name version))
-                  (sha256
-                   (base32
-                    ,(bytevector->nix-base32-string (file-sha256 tarball))))))
-        (build-system r-build-system)
-        ,@(maybe-inputs sysdepends)
-        ,@(maybe-inputs imports 'propagated-inputs)
-        (home-page ,(if (string-null? home-page)
-                        (string-append %cran-url name)
-                        home-page))
-        (synopsis ,synopsis)
-        ;; Use double spacing
-        (description ,(regexp-substitute/global #f "\\. \\b" description
-                                                'pre ".  " 'post))
-        (license ,license)))))
+  (let* ((name       (assoc-ref meta "Package"))
+         (synopsis   (assoc-ref meta "Title"))
+         (version    (assoc-ref meta "Version"))
+         (license    (string->license (assoc-ref meta "License")))
+         ;; Some packages have multiple home pages.  Some have none.
+         (home-page  (match (listify meta "URL")
+                       ((url rest ...) url)
+                       (_ (string-append %cran-url name))))
+         (source-url (match (cran-uri name version)
+                       ((url rest ...) url)
+                       (_ #f)))
+         (tarball    (with-store store (download-to-store store source-url)))
+         (sysdepends (map string-downcase (listify meta "SystemRequirements")))
+         (propagate  (map guix-name (lset-union equal?
+                                                (listify meta "Imports")
+                                                (listify meta "LinkingTo")
+                                                (delete "R"
+                                                        (listify meta "Depends"))))))
+    `(package
+       (name ,(guix-name name))
+       (version ,version)
+       (source (origin
+                 (method url-fetch)
+                 (uri (cran-uri ,name version))
+                 (sha256
+                  (base32
+                   ,(bytevector->nix-base32-string (file-sha256 tarball))))))
+       (properties ,`(,'quasiquote ((,'upstream-name . ,name))))
+       (build-system r-build-system)
+       ,@(maybe-inputs sysdepends)
+       ,@(maybe-inputs propagate 'propagated-inputs)
+       (home-page ,(if (string-null? home-page)
+                       (string-append %cran-url name)
+                       home-page))
+       (synopsis ,synopsis)
+       (description ,(beautify-description (assoc-ref meta "Description")))
+       (license ,license))))
 
 (define (cran->guix-package package-name)
   "Fetch the metadata for PACKAGE-NAME from cran.r-project.org, and return the
 `package' s-expression corresponding to that package, or #f on failure."
   (let ((module-meta (cran-fetch package-name)))
-    (and=> module-meta cran-sxml->sexp)))
+    (and=> module-meta description->package)))
 
 
 ;;;
@@ -203,32 +203,33 @@ representation of the package page."
 
 (define (latest-release package)
   "Return an <upstream-source> for the latest release of PACKAGE."
-  (define name
-    (if (string-prefix? "r-" package)
-        (string-drop package 2)
-        package))
-
-  (define sxml
-    (cran-fetch name))
-
-  (and sxml
-       (sxml-match-let*
-        (((*TOP* (xhtml:html
-                  ,head
-                  (xhtml:body
-                   (xhtml:h2 ,name-and-synopsis)
-                   (xhtml:p ,description)
-                   ,summary
-                   (xhtml:h4 "Downloads:") ,downloads
-                   . ,rest)))
-          sxml))
-        (let ((version (nodes->text (table-datum summary "Version:")))
-              (url     (downloads->url downloads)))
-          ;; CRAN does not provide signatures.
-          (upstream-source
-           (package package)
-           (version version)
-           (urls (list url)))))))
+
+  (define (package->cran-name package)
+    (match (package-source package)
+      ((? origin? origin)
+       (match (origin-uri origin)
+         ((url rest ...)
+          (let ((end   (string-rindex url #\_))
+                (start (string-rindex url #\/)))
+            ;; The URL ends on
+            ;; (string-append "/" name "_" version ".tar.gz")
+            (substring url start end)))
+         (_ #f)))
+    (_ #f)))
+
+  (define cran-name
+    (package->cran-name (specification->package package)))
+
+  (define meta
+    (cran-fetch cran-name))
+
+  (and meta
+       (let ((version (assoc-ref meta "Version")))
+         ;; CRAN does not provide signatures.
+         (upstream-source
+          (package package)
+          (version version)
+          (urls (cran-uri cran-name version))))))
 
 (define (cran-package? package)
   "Return true if PACKAGE is an R package from CRAN."
@@ -236,8 +237,10 @@ representation of the package page."
   (string-prefix? "r-" (package-name package)))
 
 (define %cran-updater
-  (upstream-updater 'cran
-                    cran-package?
-                    latest-release))
+  (upstream-updater
+   (name 'cran)
+   (description "Updater for CRAN packages")
+   (pred cran-package?)
+   (latest latest-release)))
 
 ;;; cran.scm ends here
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 37fc2b80fe..8c10668293 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -272,8 +272,10 @@ as \"debbugs\"."
 (define %elpa-updater
   ;; The ELPA updater.  We restrict it to packages hosted on elpa.gnu.org
   ;; because for other repositories, we typically grab the source elsewhere.
-  (upstream-updater 'elpa
-                    package-from-gnu.org?
-                    latest-release))
+  (upstream-updater
+   (name 'elpa)
+   (description "Updater for ELPA packages")
+   (pred package-from-gnu.org?)
+   (latest latest-release)))
 
 ;;; elpa.scm ends here
diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm
index 7160fcf7ba..834f0ae5cf 100644
--- a/guix/import/gnu.scm
+++ b/guix/import/gnu.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,11 +23,13 @@
   #:use-module (guix store)
   #:use-module (guix hash)
   #:use-module (guix base32)
+  #:use-module (guix upstream)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:export (gnu->guix-package))
@@ -47,7 +49,7 @@
 
 (define (preferred-archive-type release)
   "Return the preferred type of archive for downloading RELEASE."
-  (find (cute member <> (gnu-release-archive-types release))
+  (find (cute member <> (upstream-source-archive-types release))
         '("xz" "lz" "bz2" "tbz2" "gz" "tgz" "Z")))
 
 (define* (gnu-package->sexp package release
@@ -60,21 +62,29 @@
 
   (define url-base
     ;; XXX: We assume that RELEASE's directory starts with "/gnu".
-    (string-append "mirror:/" (gnu-release-directory release)
+    (string-append "mirror:/"
+                   (match (upstream-source-urls release)
+                     ((url rest ...)
+                      (dirname (uri-path (string->uri url)))))
                    "/" name "-"))
 
   (define archive-type
     (preferred-archive-type release))
 
+  (define url
+    (find (cut string-suffix? archive-type <>)
+          (upstream-source-urls release)))
+
+  (define sig-url
+    (find (cute string-suffix? (string-append archive-type ".sig") <>)
+          (upstream-source-signature-urls release)))
+
   (let ((tarball (with-store store
-                   (download-tarball store name
-                                     (gnu-release-directory release)
-                                     (gnu-release-version release)
-                                     #:archive-type archive-type
+                   (download-tarball store url sig-url
                                      #:key-download key-download))))
     `(package
        (name ,name)
-       (version ,(gnu-release-version release))
+       (version ,(upstream-source-version release))
        (source (origin
                  (method url-fetch)
                  (uri (string-append ,url-base version
@@ -95,8 +105,8 @@
 KEY-DOWNLOAD as the OpenPGP key download policy (see 'download-tarball' for
 details.)"
   (match (latest-release name)
-    ((? gnu-release? release)
-     (let ((version (gnu-release-version release)))
+    ((? upstream-source? release)
+     (let ((version (upstream-source-version release)))
        (match (find-packages (regexp-quote name))
          ((info . _)
           (gnu-package->sexp info release #:key-download key-download))
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index b5574a8d9f..8725ffa0df 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -22,7 +22,8 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-1)
   #:use-module ((guix download) #:select (download-to-store))
-  #:use-module ((guix utils) #:select (package-name->name+version))
+  #:use-module ((guix utils) #:select (package-name->name+version
+                                       canonical-newline-port))
   #:use-module (guix import utils)
   #:use-module (guix import cabal)
   #:use-module (guix store)
@@ -32,37 +33,35 @@
   #:export (hackage->guix-package))
 
 (define ghc-standard-libraries
-  ;; List of libraries distributed with ghc (7.8.4). We include GHC itself as
+  ;; List of libraries distributed with ghc (7.10.2). We include GHC itself as
   ;; some packages list it.
-  '("ghc"
-    "haskell98"
-    "hoopl"
+  '("array"
     "base"
-    "transformers"
-    "deepseq"
-    "array"
+    "bin-package-db"
     "binary"
     "bytestring"
+    "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
+            ;; hackage-name->package-name takes this into account.
     "containers"
-    "time"
-    "cabal"
-    "bin-package-db"
+    "deepseq"
+    "directory"
+    "filepath"
+    "ghc"
     "ghc-prim"
+    "haskeline"
+    "hoopl"
+    "hpc"
     "integer-gmp"
-    "integer-simple"
-    "win32"
-    "template-haskell"
+    "pretty"
     "process"
-    "haskeline"
+    "rts"
+    "template-haskell"
     "terminfo"
-    "directory"
-    "filepath"
-    "old-locale"
+    "time"
+    "transformers"
     "unix"
-    "old-time"
-    "pretty"
-    "xhtml"
-    "hpc"))
+    "win32"
+    "xhtml"))
 
 (define package-name-prefix "ghc-")
 
@@ -86,7 +85,8 @@ version."
     (call-with-temporary-output-file
      (lambda (temp port)
        (and (url-fetch url temp)
-            (call-with-input-file temp read-cabal))))))
+            (call-with-input-file temp
+              (compose read-cabal canonical-newline-port)))))))
 
 (define string->license
   ;; List of valid values from
@@ -218,7 +218,7 @@ to the Cabal file format definition.  The default value associated with the
 keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
 respectively."
   (let ((cabal-meta (if port
-                        (read-cabal port)
+                        (read-cabal (canonical-newline-port port))
                         (hackage-fetch package-name))))
     (and=> cabal-meta (compose (cut hackage-module->sexp <>
                                     #:include-test-dependencies? 
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index d04a68524d..d54bb9fbba 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,23 +26,41 @@
   #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (rnrs bytevectors)
   #:use-module (json)
   #:use-module (web uri)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix import utils)
+  #:use-module ((guix download) #:prefix download:)
   #:use-module (guix import json)
   #:use-module (guix packages)
+  #:use-module (guix upstream)
   #:use-module (guix licenses)
   #:use-module (guix build-system python)
+  #:use-module (gnu packages)
   #:use-module (gnu packages python)
-  #:export (pypi->guix-package))
+  #:export (pypi->guix-package
+            %pypi-updater))
 
 (define (pypi-fetch name)
   "Return an alist representation of the PyPI metadata for the package NAME,
 or #f on failure."
-  (json-fetch (string-append "https://pypi.python.org/pypi/" name "/json")))
+  ;; XXX: We want to silence the download progress report, which is especially
+  ;; annoying for 'guix refresh', but we have to use a file port.
+  (call-with-output-file "/dev/null"
+    (lambda (null)
+      (with-error-to-port null
+        (lambda ()
+          (json-fetch (string-append "https://pypi.python.org/pypi/"
+                                     name "/json")))))))
+
+;; For packages found on PyPI that lack a source distribution.
+(define-condition-type &missing-source-error &error
+  missing-source-error?
+  (package  missing-source-error-package))
 
 (define (latest-source-release pypi-package)
   "Return the latest source release for PYPI-PACKAGE."
@@ -49,9 +69,8 @@ or #f on failure."
     (or (find (lambda (release)
                 (string=? "sdist" (assoc-ref release "packagetype")))
               releases)
-        (error "No source release found for pypi package: "
-               (assoc-ref* pypi-package "info" "name")
-               (assoc-ref* pypi-package "info" "version")))))
+        (raise (condition (&missing-source-error
+                           (package pypi-package)))))))
 
 (define (python->package-name name)
   "Given the NAME of a package on PyPI, return a Guix-compliant name for the
@@ -60,6 +79,16 @@ package."
       (snake-case name)
       (string-append "python-" (snake-case name))))
 
+(define (guix-package->pypi-name package)
+  "Given a Python PACKAGE built from pypi.python.org, return the name of the
+package on PyPI."
+  (let ((source-url (and=> (package-source package) origin-uri)))
+    ;; The URL has the form:
+    ;; 'https://pypi.python.org/packages/source/' +
+    ;; first letter of the package name +
+    ;; '/' + package name + '/' + ...
+    (substring source-url 42 (string-rindex source-url #\/))))
+
 (define (maybe-inputs package-inputs)
   "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
 package definition."
@@ -165,7 +194,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
              (version ,version)
              (source (origin
                        (method url-fetch)
-                       (uri (string-append ,@(factorize-uri source-url version)))
+                       (uri (pypi-uri ,name version))
                        (sha256
                         (base32
                          ,(guix-hash-url temp)))))
@@ -181,12 +210,52 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
 `package' s-expression corresponding to that package, or #f on failure."
   (let ((package (pypi-fetch package-name)))
     (and package
-         (let ((name (assoc-ref* package "info" "name"))
-               (version (assoc-ref* package "info" "version"))
-               (release (assoc-ref (latest-source-release package) "url"))
-               (synopsis (assoc-ref* package "info" "summary"))
-               (description (assoc-ref* package "info" "summary"))
-               (home-page (assoc-ref* package "info" "home_page"))
-               (license (string->license (assoc-ref* package "info" "license"))))
-           (make-pypi-sexp name version release home-page synopsis
-                           description license)))))
+         (guard (c ((missing-source-error? c)
+                    (let ((package (missing-source-error-package c)))
+                      (leave (_ "no source release for pypi package ~a ~a~%")
+                             (assoc-ref* package "info" "name")
+                             (assoc-ref* package "info" "version")))))
+           (let ((name (assoc-ref* package "info" "name"))
+                 (version (assoc-ref* package "info" "version"))
+                 (release (assoc-ref (latest-source-release package) "url"))
+                 (synopsis (assoc-ref* package "info" "summary"))
+                 (description (assoc-ref* package "info" "summary"))
+                 (home-page (assoc-ref* package "info" "home_page"))
+                 (license (string->license (assoc-ref* package "info" "license"))))
+             (make-pypi-sexp name version release home-page synopsis
+                             description license))))))
+
+(define (pypi-package? package)
+  "Return true if PACKAGE is a Python package from PyPI."
+
+  (define (pypi-url? url)
+    (string-prefix? "https://pypi.python.org/" url))
+
+  (let ((source-url (and=> (package-source package) origin-uri))
+        (fetch-method (and=> (package-source package) origin-method)))
+    (and (eq? fetch-method download:url-fetch)
+         (match source-url
+           ((? string?)
+            (pypi-url? source-url))
+           ((source-url ...)
+            (any pypi-url? source-url))))))
+
+(define (latest-release guix-package)
+  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
+  (guard (c ((missing-source-error? c) #f))
+    (let* ((pypi-name (guix-package->pypi-name
+                       (specification->package guix-package)))
+           (metadata (pypi-fetch pypi-name))
+           (version (assoc-ref* metadata "info" "version"))
+           (url (assoc-ref (latest-source-release metadata) "url")))
+      (upstream-source
+       (package guix-package)
+       (version version)
+       (urls (list url))))))
+
+(define %pypi-updater
+  (upstream-updater
+   (name 'pypi)
+   (description "Updater for PyPI packages")
+   (pred pypi-package?)
+   (latest latest-release)))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index fac322bbab..c222f4115d 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -84,13 +84,17 @@
             packages->manifest
             %default-profile-hooks
             profile-derivation
+
             generation-number
             generation-numbers
             profile-generations
             relative-generation
             previous-generation-number
             generation-time
-            generation-file-name))
+            generation-file-name
+            switch-to-generation
+            roll-back
+            delete-generation))
 
 ;;; Commentary:
 ;;;
@@ -654,7 +658,8 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
 
             ;; Union all the icons.
             (mkdir-p (string-append #$output "/share"))
-            (union-build destdir icondirs)
+            (union-build destdir icondirs
+                         #:log-port (%make-void-port "w"))
 
             ;; Update the 'icon-theme.cache' file for each icon theme.
             (for-each
@@ -664,7 +669,7 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
                  ;; "abiword_48.png".  Ignore these.
                  (when (file-is-directory? dir)
                    (ensure-writable-directory dir)
-                   (system* update-icon-cache "-t" dir))))
+                   (system* update-icon-cache "-t" dir "--quiet"))))
              (scandir destdir (negate (cut member <> '("." ".."))))))))
 
     ;; Don't run the hook when there's nothing to do.
@@ -844,4 +849,78 @@ case when generations have been deleted (there are \"holes\")."
   (make-time time-utc 0
              (stat:ctime (stat (generation-file-name profile number)))))
 
+(define (link-to-empty-profile store generation)
+  "Link GENERATION, a string, to the empty profile.  An error is raised if
+that fails."
+  (let* ((drv  (run-with-store store
+                 (profile-derivation (manifest '()))))
+         (prof (derivation->output-path drv "out")))
+    (build-derivations store (list drv))
+    (switch-symlinks generation prof)))
+
+(define (switch-to-generation profile number)
+  "Atomically switch PROFILE to the generation NUMBER.  Return the number of
+the generation that was current before switching."
+  (let ((current    (generation-number profile))
+        (generation (generation-file-name profile number)))
+    (cond ((not (file-exists? profile))
+           (raise (condition (&profile-not-found-error
+                              (profile profile)))))
+          ((not (file-exists? generation))
+           (raise (condition (&missing-generation-error
+                              (profile profile)
+                              (generation number)))))
+          (else
+           (switch-symlinks profile generation)
+           current))))
+
+(define (switch-to-previous-generation profile)
+  "Atomically switch PROFILE to the previous generation.  Return the former
+generation number and the current one."
+  (let ((previous (previous-generation-number profile)))
+    (values (switch-to-generation profile previous)
+            previous)))
+
+(define (roll-back store profile)
+  "Roll back to the previous generation of PROFILE.  Return the number of the
+generation that was current before switching and the new generation number."
+  (let* ((number              (generation-number profile))
+         (previous-number     (previous-generation-number profile number))
+         (previous-generation (generation-file-name profile previous-number)))
+    (cond ((not (file-exists? profile))           ;invalid profile
+           (raise (condition (&profile-not-found-error
+                              (profile profile)))))
+          ((zero? number)                         ;empty profile
+           (values number number))
+          ((or (zero? previous-number)            ;going to emptiness
+               (not (file-exists? previous-generation)))
+           (link-to-empty-profile store previous-generation)
+           (switch-to-previous-generation profile))
+          (else                                   ;anything else
+           (switch-to-previous-generation profile)))))
+
+(define (delete-generation store profile number)
+  "Delete generation with NUMBER from PROFILE.  Return the file name of the
+generation that has been deleted, or #f if nothing was done (for instance
+because the NUMBER is zero.)"
+  (define (delete-and-return)
+    (let ((generation (generation-file-name profile number)))
+      (delete-file generation)
+      generation))
+
+  (let* ((current-number      (generation-number profile))
+         (previous-number     (previous-generation-number profile number))
+         (previous-generation (generation-file-name profile previous-number)))
+    (cond ((zero? number) #f)                     ;do not delete generation 0
+          ((and (= number current-number)
+                (not (file-exists? previous-generation)))
+           (link-to-empty-profile store previous-generation)
+           (switch-to-previous-generation profile)
+           (delete-and-return))
+          ((= number current-number)
+           (roll-back store profile)
+           (delete-and-return))
+          (else
+           (delete-and-return)))))
+
 ;;; profiles.scm ends here
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a357cf8aa4..8ecd9560ed 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -171,6 +171,8 @@ options handled by 'set-build-options-from-command-line', and listed in
   (display (_ "
       --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (_ "
+      --rounds=N         build N times in a row to detect non-determinism"))
+  (display (_ "
   -c, --cores=N          allow the use of up to N CPU cores for the build"))
   (display (_ "
   -M, --max-jobs=N       allow at most N build jobs")))
@@ -181,12 +183,12 @@ options handled by 'set-build-options-from-command-line', and listed in
   ;; TODO: Add more options.
   (set-build-options store
                      #:keep-failed? (assoc-ref opts 'keep-failed?)
+                     #:rounds (assoc-ref opts 'rounds)
                      #:build-cores (or (assoc-ref opts 'cores) 0)
                      #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
                      #:fallback? (assoc-ref opts 'fallback?)
                      #:use-substitutes? (assoc-ref opts 'substitutes?)
-                     #:substitute-urls (or (assoc-ref opts 'substitute-urls)
-                                           %default-substitute-urls)
+                     #:substitute-urls (assoc-ref opts 'substitute-urls)
                      #:use-build-hook? (assoc-ref opts 'build-hook?)
                      #:max-silent-time (assoc-ref opts 'max-silent-time)
                      #:timeout (assoc-ref opts 'timeout)
@@ -211,6 +213,12 @@ options handled by 'set-build-options-from-command-line', and listed in
                   (apply values
                          (alist-cons 'keep-failed? #t result)
                          rest)))
+        (option '("rounds") #t #f
+                (lambda (opt name arg result . rest)
+                  (apply values
+                         (alist-cons 'rounds (string->number* arg)
+                                     result)
+                         rest)))
         (option '("fallback") #f #f
                 (lambda (opt name arg result . rest)
                   (apply values
@@ -277,6 +285,7 @@ options handled by 'set-build-options-from-command-line', and listed in
 (define %default-options
   ;; Alist of default option values.
   `((system . ,(%current-system))
+    (build-mode . ,(build-mode normal))
     (graft? . #t)
     (substitutes? . #t)
     (build-hook? . #t)
@@ -290,6 +299,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
   -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
   (display (_ "
+  -f, --file=FILE        build the package or derivation that the code within
+                         FILE evaluates to"))
+  (display (_ "
   -S, --source           build the packages' source derivations"))
   (display (_ "
       --sources[=TYPE]   build source derivations; TYPE may optionally be one
@@ -306,6 +318,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
   -d, --derivations      return the derivation paths of the given packages"))
   (display (_ "
+      --check            rebuild items to check for non-determinism issues"))
+  (display (_ "
   -r, --root=FILE        make FILE a symlink to the result, and register it
                          as a garbage collector root"))
   (display (_ "
@@ -345,6 +359,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                       (leave (_ "invalid argument: '~a' option argument: ~a, ~
 must be one of 'package', 'all', or 'transitive'~%")
                              name arg)))))
+        (option '("check") #f #f
+                (lambda (opt name arg result . rest)
+                  (apply values
+                         (alist-cons 'build-mode (build-mode check)
+                                     result)
+                         rest)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -359,6 +379,9 @@ must be one of 'package', 'all', or 'transitive'~%")
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
+         (option '(#\f "file") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file arg result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
@@ -378,9 +401,40 @@ must be one of 'package', 'all', or 'transitive'~%")
 
          %standard-build-options))
 
+(define (options->things-to-build opts)
+  "Read the arguments from OPTS and return a list of high-level objects to
+build---packages, gexps, derivations, and so on."
+  (define ensure-list
+    (match-lambda
+      ((x ...) x)
+      (x       (list x))))
+
+  (append-map (match-lambda
+                (('argument . (? string? spec))
+                 (cond ((derivation-path? spec)
+                        (list (call-with-input-file spec read-derivation)))
+                       ((store-path? spec)
+                        ;; Nothing to do; maybe for --log-file.
+                        '())
+                       (else
+                        (list (specification->package spec)))))
+                (('file . file)
+                 (ensure-list (load* file (make-user-module '()))))
+                (('expression . str)
+                 (ensure-list (read/eval str)))
+                (('argument . (? derivation? drv))
+                 drv)
+                (('argument . (? derivation-path? drv))
+                 (list ))
+                (_ '()))
+              opts))
+
 (define (options->derivations store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
 build."
+  (define transform
+    (options->transformation opts))
+
   (define package->derivation
     (match (assoc-ref opts 'target)
       (#f package-derivation)
@@ -388,101 +442,99 @@ build."
        (cut package-cross-derivation <> <> triplet <>))))
 
   (define src    (assoc-ref opts 'source))
-  (define sys    (assoc-ref opts 'system))
+  (define system (assoc-ref opts 'system))
   (define graft? (assoc-ref opts 'graft?))
 
   (parameterize ((%graft? graft?))
-    (let ((opts (options/with-source store
-                                     (options/resolve-packages store opts))))
-      (concatenate
-       (filter-map (match-lambda
-                    (('argument . (? package? p))
-                     (match src
-                       (#f
-                        (list (package->derivation store p sys)))
-                       (#t
-                        (let ((s (package-source p)))
-                          (list (package-source-derivation store s))))
-                       (proc
-                        (map (cut package-source-derivation store <>)
-                             (proc p)))))
-                    (('argument . (? derivation? drv))
-                     (list drv))
-                    (('argument . (? derivation-path? drv))
-                     (list (call-with-input-file drv read-derivation)))
-                    (('argument . (? store-path?))
-                     ;; Nothing to do; maybe for --log-file.
-                     #f)
-                    (_ #f))
-                   opts)))))
-
-(define (options/resolve-packages store opts)
-  "Return OPTS with package specification strings replaced by actual
-packages."
-  (define system
-    (or (assoc-ref opts 'system) (%current-system)))
-
-  (map (match-lambda
-        (('argument . (? string? spec))
-         (if (store-path? spec)
-             `(argument . ,spec)
-             `(argument . ,(specification->package spec))))
-        (('expression . str)
-         (match (read/eval str)
-           ((? package? p)
-            `(argument . ,p))
-           ((? procedure? proc)
-            (let ((drv (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (proc))
-                         #:system system)))
-              `(argument . ,drv)))
-           ((? gexp? gexp)
-            (let ((drv (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (gexp->derivation "gexp" gexp
-                                             #:system system)))))
-              `(argument . ,drv)))))
-        (opt opt))
-       opts))
-
-(define (options/with-source store opts)
-  "Process with 'with-source' options in OPTS, replacing the relevant package
-arguments with packages that use the specified source."
+    (append-map (match-lambda
+                  ((? package? p)
+                   (match src
+                     (#f
+                      (list (package->derivation store p system)))
+                     (#t
+                      (let ((s (package-source p)))
+                        (list (package-source-derivation store s))))
+                     (proc
+                      (map (cut package-source-derivation store <>)
+                           (proc p)))))
+                  ((? derivation? drv)
+                   (list drv))
+                  ((? procedure? proc)
+                   (list (run-with-store store
+                           (mbegin %store-monad
+                             (set-guile-for-build (default-guile))
+                             (proc))
+                           #:system system)))
+                  ((? gexp? gexp)
+                   (list (run-with-store store
+                           (mbegin %store-monad
+                             (set-guile-for-build (default-guile))
+                             (gexp->derivation "gexp" gexp
+                                               #:system system))))))
+                (transform store (options->things-to-build opts)))))
+
+(define (transform-package-source sources)
+  "Return a transformation procedure that uses replaces package sources with
+the matching URIs given in SOURCES."
   (define new-sources
-    (filter-map (match-lambda
-                 (('with-source . uri)
-                  (cons (package-name->name+version (basename uri))
-                        uri))
-                 (_ #f))
-                opts))
-
-  (let loop ((opts    opts)
-             (sources new-sources)
-             (result  '()))
-    (match opts
-      (()
-       (unless (null? sources)
-         (warning (_ "sources do not match any package:~{ ~a~}~%")
-                  (match sources
-                    (((name . uri) ...)
-                     uri))))
-       (reverse result))
-      ((('argument . (? package? p)) tail ...)
-       (let ((source (assoc-ref sources (package-name p))))
-         (loop tail
-               (alist-delete (package-name p) sources)
-               (alist-cons 'argument
-                           (if source
-                               (package-with-source store p source)
-                               p)
-                           result))))
-      ((('with-source . _) tail ...)
-       (loop tail sources result))
-      ((head tail ...)
-       (loop tail sources (cons head result))))))
+    (map (lambda (uri)
+           (cons (package-name->name+version (basename uri))
+                 uri))
+         sources))
+
+  (lambda (store packages)
+    (let loop ((packages packages)
+               (sources  new-sources)
+               (result   '()))
+      (match packages
+        (()
+         (unless (null? sources)
+           (warning (_ "sources do not match any package:~{ ~a~}~%")
+                    (match sources
+                      (((name . uri) ...)
+                       uri))))
+         (reverse result))
+        (((? package? p) tail ...)
+         (let ((source (assoc-ref sources (package-name p))))
+           (loop tail
+                 (alist-delete (package-name p) sources)
+                 (cons (if source
+                           (package-with-source store p source)
+                           p)
+                       result))))
+        ((thing tail ...)
+         (loop tail sources result))))))
+
+(define %transformations
+  ;; Transformations that can be applied to things to build.  The car is the
+  ;; key used in the option alist, and the cdr is the transformation
+  ;; procedure; it is called with two arguments: the store, and a list of
+  ;; things to build.
+  `((with-source . ,transform-package-source)))
+
+(define (options->transformation opts)
+  "Return a procedure that, when passed a list of things to build (packages,
+derivations, etc.), applies the transformations specified by OPTS."
+  (apply compose
+         (map (match-lambda
+                ((key . transform)
+                 (let ((args (filter-map (match-lambda
+                                           ((k . arg)
+                                            (and (eq? k key) arg)))
+                                         opts)))
+                   (if (null? args)
+                       (lambda (store things) things)
+                       (transform args)))))
+              %transformations)))
+
+(define (show-build-log store file urls)
+  "Show the build log for FILE, falling back to remote logs from URLS if
+needed."
+  (let ((log (or (log-file store file)
+                 (log-url store file #:base-urls urls))))
+    (if log
+        (format #t "~a~%" log)
+        (leave (_ "no build log for '~a'~%") file))))
 
 
 ;;;
@@ -497,47 +549,44 @@ arguments with packages that use the specified source."
       (let* ((opts  (parse-command-line args %options
                                         (list %default-options)))
              (store (open-connection))
+             (mode  (assoc-ref opts 'build-mode))
              (drv   (options->derivations store opts))
              (urls  (map (cut string-append <> "/log")
                          (if (assoc-ref opts 'substitutes?)
                              (or (assoc-ref opts 'substitute-urls)
+                                 ;; XXX: This does not necessarily match the
+                                 ;; daemon's substitute URLs.
                                  %default-substitute-urls)
                              '())))
+             (items (filter-map (match-lambda
+                                  (('argument . (? store-path? file))
+                                   file)
+                                  (_ #f))
+                                opts))
              (roots (filter-map (match-lambda
-                                 (('gc-root . root) root)
-                                 (_ #f))
+                                  (('gc-root . root) root)
+                                  (_ #f))
                                 opts)))
 
         (set-build-options-from-command-line store opts)
         (unless (assoc-ref opts 'log-file?)
           (show-what-to-build store drv
                               #:use-substitutes? (assoc-ref opts 'substitutes?)
-                              #:dry-run? (assoc-ref opts 'dry-run?)))
+                              #:dry-run? (assoc-ref opts 'dry-run?)
+                              #:mode mode))
 
         (cond ((assoc-ref opts 'log-file?)
-               (for-each (lambda (file)
-                           (let ((log (or (log-file store file)
-                                          (log-url store file
-                                                   #:base-urls urls))))
-                             (if log
-                                 (format #t "~a~%" log)
-                                 (leave (_ "no build log for '~a'~%")
-                                        file))))
+               (for-each (cut show-build-log store <> urls)
                          (delete-duplicates
                           (append (map derivation-file-name drv)
-                                  (filter-map (match-lambda
-                                               (('argument
-                                                 . (? store-path? file))
-                                                file)
-                                               (_ #f))
-                                              opts)))))
+                                  items))))
               ((assoc-ref opts 'derivations-only?)
                (format #t "~{~a~%~}" (map derivation-file-name drv))
                (for-each (cut register-root store <> <>)
                          (map (compose list derivation-file-name) drv)
                          roots))
               ((not (assoc-ref opts 'dry-run?))
-               (and (build-derivations store drv)
+               (and (build-derivations store drv mode)
                     (for-each show-derivation-outputs drv)
                     (for-each (cut register-root store <> <>)
                               (map (lambda (drv)
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 19a9b061b8..4a0c865b07 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -125,10 +125,8 @@ taken since we do not import the archives."
                                               servers))
                        ;; No 'assert-valid-narinfo' on purpose.
                        (narinfos -> (fold (lambda (narinfo vhash)
-                                            (if narinfo
-                                                (vhash-cons (narinfo-path narinfo) narinfo
-                                                            vhash)
-                                                vhash))
+                                            (vhash-cons (narinfo-path narinfo) narinfo
+                                                        vhash))
                                           vlist-null
                                           remote)))
     (return (filter-map (lambda (item local)
diff --git a/guix/scripts/container.scm b/guix/scripts/container.scm
new file mode 100644
index 0000000000..cd9f345b68
--- /dev/null
+++ b/guix/scripts/container.scm
@@ -0,0 +1,63 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <davet@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 container)
+  #:use-module (ice-9 match)
+  #:use-module (guix ui)
+  #:export (guix-container))
+
+(define (show-help)
+  (display (_ "Usage: guix container ACTION ARGS...
+Build and manipulate Linux containers.\n"))
+  (newline)
+  (display (_ "The valid values for ACTION are:\n"))
+  (newline)
+  (display (_ "\
+   exec            execute a command inside of an existing container\n"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %actions '("exec"))
+
+(define (resolve-action name)
+  (let ((module (resolve-interface
+                 `(guix scripts container ,(string->symbol name))))
+        (proc (string->symbol (string-append "guix-container-" name))))
+    (module-ref module proc)))
+
+(define (guix-container . args)
+  (with-error-handling
+    (match args
+      (()
+       (format (current-error-port)
+               (_ "guix container: missing action~%")))
+      ((or ("-h") ("--help"))
+       (show-help)
+       (exit 0))
+      (("--version")
+       (show-version-and-exit "guix container"))
+      ((action args ...)
+       (if (member action %actions)
+           (apply (resolve-action action) args)
+           (format (current-error-port)
+                   (_ "guix container: invalid action~%")))))))
diff --git a/guix/scripts/container/exec.scm b/guix/scripts/container/exec.scm
new file mode 100644
index 0000000000..10e70568cc
--- /dev/null
+++ b/guix/scripts/container/exec.scm
@@ -0,0 +1,94 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <davet@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 container exec)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (gnu build linux-container)
+  #:export (guix-container-exec))
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix container exec")))))
+
+(define (show-help)
+  (display (_ "Usage: guix container exec PID COMMAND [ARGS...]
+Execute COMMMAND within the container process PID.\n"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define (partition-args args)
+  "Split ARGS into two lists; one containing the arguments for this program,
+and the other containing arguments for the command to be executed."
+  (define (number-string? str)
+    (false-if-exception (string->number str)))
+
+  (let loop ((a '())
+             (b args))
+    (match b
+      (()
+       (values (reverse a) '()))
+      (((? number-string? head) . tail)
+       (values (reverse (cons head a)) tail))
+      ((head . tail)
+       (loop (cons head a) tail)))))
+
+(define (guix-container-exec . args)
+  (define (handle-argument arg result)
+    (if (assoc-ref result 'pid)
+        (leave (_ "~a: extraneous argument~%") arg)
+        (alist-cons 'pid (string->number* arg) result)))
+
+  (with-error-handling
+    (let-values (((args command) (partition-args args)))
+      (let* ((opts (parse-command-line args %options '(())
+                                       #:argument-handler
+                                       handle-argument))
+             (pid  (assoc-ref opts 'pid)))
+
+        (unless pid
+          (leave (_ "no pid specified~%")))
+
+        (when (null? command)
+          (leave (_ "no command specified~%")))
+
+        (unless (file-exists? (string-append "/proc/" (number->string pid)))
+          (leave (_ "no such process ~d~%") pid))
+
+        (let ((result (container-excursion pid
+                        (lambda ()
+                          (match command
+                            ((program . program-args)
+                             (apply execlp program program program-args)))))))
+          (unless (zero? result)
+            (leave (_ "exec failed with status ~d~%") result)))))))
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 533970ffbb..6ebc14f573 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -96,13 +96,17 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                 (lambda (opt name arg result)
                   (leave (_ "~A: unrecognized option~%") name))
                 (lambda (arg result)
+                  (when (assq 'argument result)
+                    (leave (_ "~A: extraneous argument~%") arg))
+
                   (alist-cons 'argument arg result))
                 %default-options))
 
   (with-error-handling
     (let* ((opts  (parse-options))
            (store (open-connection))
-           (arg   (assq-ref opts 'argument))
+           (arg   (or (assq-ref opts 'argument)
+                      (leave (_ "no download URI was specified~%"))))
            (uri   (or (string->uri arg)
                       (leave (_ "~a: failed to parse URI~%")
                              arg)))
diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm
index 30146af10b..ce3ac4146d 100644
--- a/guix/scripts/edit.scm
+++ b/guix/scripts/edit.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,7 +39,7 @@
 
 (define (show-help)
   (display (_ "Usage: guix edit PACKAGE...
-Start $EDITOR to edit the definitions of PACKAGE...\n"))
+Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -48,7 +49,10 @@ Start $EDITOR to edit the definitions of PACKAGE...\n"))
   (show-bug-report-information))
 
 (define %editor
-  (make-parameter (or (getenv "EDITOR") "emacsclient")))
+  ;; XXX: It would be better to default to something more likely to be
+  ;; pre-installed on an average GNU system.  Since Nano is not suited for
+  ;; editing Scheme, Emacs is used instead.
+  (make-parameter (or (getenv "VISUAL") (getenv "EDITOR") "emacs")))
 
 (define (search-path* path file)
   "Like 'search-path' but exit if FILE is not found."
@@ -59,6 +63,15 @@ Start $EDITOR to edit the definitions of PACKAGE...\n"))
              file path))
     absolute-file-name))
 
+(define (package->location-specification package)
+  "Return the location specification for PACKAGE for a typical editor command
+line."
+  (let ((loc (package-location package)))
+    (list (string-append "+"
+                         (number->string
+                          (location-line loc)))
+          (search-path* %load-path (location-file loc)))))
+
 
 (define (guix-edit . args)
   (with-error-handling
@@ -70,11 +83,15 @@ Start $EDITOR to edit the definitions of PACKAGE...\n"))
                     (leave (_ "source location of package '~a' is unknown~%")
                            (package-full-name package))))
                 packages)
-      (apply execlp (%editor) (%editor)
-             (append-map (lambda (package)
-                           (let ((loc (package-location package)))
-                             (list (string-append "+"
-                                                  (number->string
-                                                   (location-line loc)))
-                                   (search-path* %load-path (location-file loc)))))
-                         packages)))))
+
+      (catch 'system-error
+        (lambda ()
+          (let ((file-names (append-map package->location-specification
+                                        packages)))
+            ;; Use `system' instead of `exec' in order to sanely handle
+            ;; possible command line arguments in %EDITOR.
+            (exit (system (string-join (cons (%editor) file-names))))))
+        (lambda args
+          (let ((errno (system-error-errno args)))
+            (leave (_ "failed to launch '~a': ~a~%")
+                   (%editor) (strerror errno))))))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 2408420e18..2cc5f366a7 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -25,13 +25,19 @@
   #:use-module (guix profiles)
   #:use-module (guix search-paths)
   #:use-module (guix utils)
+  #:use-module (guix build utils)
   #:use-module (guix monads)
   #:use-module ((guix gexp) #:select (lower-inputs))
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (gnu build linux-container)
+  #:use-module (gnu system linux-container)
+  #:use-module (gnu system file-systems)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bash)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -60,6 +66,12 @@ OUTPUT) tuples."
 (define %default-shell
   (or (getenv "SHELL") "/bin/sh"))
 
+(define %network-configuration-files
+  '("/etc/resolv.conf"
+    "/etc/nsswitch.conf"
+    "/etc/services"
+    "/etc/hosts"))
+
 (define (purify-environment)
   "Unset almost all environment variables.  A small number of variables such
 as 'HOME' and 'USER' are left untouched."
@@ -124,6 +136,18 @@ COMMAND or an interactive shell in that environment.\n"))
       --search-paths     display needed environment variable definitions"))
   (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
+  (display (_ "
+  -C, --container        run command within an isolated container"))
+  (display (_ "
+  -N, --network          allow containers to access the network"))
+  (display (_ "
+      --share=SPEC       for containers, share writable host file system
+                         according to SPEC"))
+  (display (_ "
+      --expose=SPEC      for containers, expose read-only host file system
+                         according to SPEC"))
+  (display (_ "
+      --bootstrap        use bootstrap binaries to build the environment"))
   (newline)
   (show-build-options-help)
   (newline)
@@ -136,12 +160,21 @@ COMMAND or an interactive shell in that environment.\n"))
 
 (define %default-options
   ;; Default to opening a new shell.
-  `((exec . (,%default-shell))
-    (system . ,(%current-system))
+  `((system . ,(%current-system))
     (substitutes? . #t)
     (max-silent-time . 3600)
     (verbosity . 0)))
 
+(define (tag-package-arg opts arg)
+  "Return a two-element list with the form (TAG ARG) that tags ARG with either
+'ad-hoc' in OPTS has the 'ad-hoc?' key set to #t, or 'inputs' otherwise."
+  ;; Normally, the transitive inputs to a package are added to an environment,
+  ;; but the ad-hoc? flag changes the meaning of a package argument such that
+  ;; the package itself is added to the environment instead.
+  (if (assoc-ref opts 'ad-hoc?)
+      `(ad-hoc-package ,arg)
+      `(package ,arg)))
+
 (define %options
   ;; Specification of the command-line options.
   (cons* (option '(#\h "help") #f #f
@@ -162,10 +195,14 @@ COMMAND or an interactive shell in that environment.\n"))
                    (alist-cons 'search-paths #t result)))
          (option '(#\l "load") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'load arg result)))
+                   (alist-cons 'load
+                               (tag-package-arg result arg)
+                               result)))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'expression arg result)))
+                   (alist-cons 'expression
+                               (tag-package-arg result arg)
+                               result)))
          (option '("ad-hoc") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'ad-hoc? #t result)))
@@ -176,6 +213,25 @@ COMMAND or an interactive shell in that environment.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
                                (alist-delete 'system result eq?))))
+         (option '(#\C "container") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container? #t result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'network? #t result)))
+         (option '("share") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file-system-mapping
+                               (specification->file-system-mapping arg #t)
+                               result)))
+         (option '("expose") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file-system-mapping
+                               (specification->file-system-mapping arg #f)
+                               result)))
+         (option '("bootstrap") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'bootstrap? #t result)))
          %standard-build-options))
 
 (define (pick-all alist key)
@@ -189,29 +245,40 @@ COMMAND or an interactive shell in that environment.\n"))
             (_ memo)))
         '() alist))
 
+(define (compact lst)
+  "Remove all #f elements from LST."
+  (filter identity lst))
+
 (define (options/resolve-packages opts)
   "Return OPTS with package specification strings replaced by actual
 packages."
-  (append-map (match-lambda
-                (('package . (? string? spec))
-                 (let-values (((package output)
-                               (specification->package+output spec)))
-                   `((package ,package ,output))))
-                (('expression . str)
-                 ;; Add all the outputs of the package STR evaluates to.
-                 (match (read/eval str)
-                   ((? package? package)
-                    (map (lambda (output)
-                           `(package ,package ,output))
-                         (package-outputs package)))))
-                (('load . file)
-                 ;; Add all the outputs of the package defined in FILE.
-                 (let ((package (load* file (make-user-module '()))))
-                   (map (lambda (output)
-                          `(package ,package ,output))
-                        (package-outputs package))))
-                (opt (list opt)))
-              opts))
+  (define (package->outputs package mode)
+    (map (lambda (output)
+           (list mode package output))
+         (package-outputs package)))
+
+  (define (packages->outputs packages mode)
+    (match packages
+      ((? package? package)
+       (package->outputs package mode))
+      (((? package? packages) ...)
+       (append-map (cut package->outputs <> mode) packages))))
+
+  (compact
+   (append-map (match-lambda
+                 (('package mode (? string? spec))
+                  (let-values (((package output)
+                                (specification->package+output spec)))
+                    (list (list mode package output))))
+                 (('expression mode str)
+                  ;; Add all the outputs of the package STR evaluates to.
+                  (packages->outputs (read/eval str) mode))
+                 (('load mode file)
+                  ;; Add all the outputs of the package defined in FILE.
+                  (let ((module (make-user-module '())))
+                    (packages->outputs (load* file module) mode)))
+                 (_ '(#f)))
+               opts)))
 
 (define (build-inputs inputs opts)
   "Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION
@@ -227,14 +294,145 @@ OUTPUT) tuples, using the build options in OPTS."
          (if dry-run?
              (return #f)
              (mbegin %store-monad
-               (set-build-options-from-command-line* opts)
                (built-derivations derivations)
                (return derivations))))))))
 
+(define requisites* (store-lift requisites))
+
+(define (inputs->requisites inputs)
+  "Convert INPUTS, a list of input tuples or store path strings, into a set of
+requisite store items i.e. the union closure of all the inputs."
+  (define (input->requisites input)
+    (requisites*
+     (match input
+       ((drv output)
+        (derivation->output-path drv output))
+       ((drv)
+        (derivation->output-path drv))
+       ((? direct-store-path? path)
+        path))))
+
+  (mlet %store-monad ((reqs (sequence %store-monad
+                                      (map input->requisites inputs))))
+    (return (delete-duplicates (concatenate reqs)))))
+
+(define (status->exit-code status)
+  "Compute the exit code made from STATUS, a value as returned by 'waitpid',
+and suitable for 'exit'."
+  ;; See <bits/waitstatus.h>.
+  (or (status:exit-val status)
+      (logior #x80 (status:term-sig status))))
+
+(define exit/status (compose exit status->exit-code))
+(define primitive-exit/status (compose primitive-exit status->exit-code))
+
+(define (launch-environment command inputs paths pure?)
+  "Run COMMAND in a new environment containing INPUTS, using the native search
+paths defined by the list PATHS.  When PURE?, pre-existing environment
+variables are cleared before setting the new ones."
+  (create-environment inputs paths pure?)
+  (apply system* command))
+
+(define* (launch-environment/container #:key command bash user-mappings
+                                       inputs paths network?)
+  "Run COMMAND within a Linux container.  The environment features INPUTS, a
+list of derivations to be shared from the host system.  Environment variables
+are set according to PATHS, a list of native search paths.  The global shell
+is BASH, a file name for a GNU Bash binary in the store.  When NETWORK?,
+access to the host system network is permitted.  USER-MAPPINGS, a list of file
+system mappings, contains the user-specified host file systems to mount inside
+the container."
+  (mlet %store-monad ((reqs (inputs->requisites
+                             (cons (direct-store-path bash) inputs))))
+    (return
+     (let* ((cwd (getcwd))
+            ;; Bind-mount all requisite store items, user-specified mappings,
+            ;; /bin/sh, the current working directory, and possibly networking
+            ;; configuration files within the container.
+            (mappings
+             (append user-mappings
+                     ;; Current working directory.
+                     (list (file-system-mapping
+                            (source cwd)
+                            (target cwd)
+                            (writable? #t)))
+                     ;; When in Rome, do as Nix build.cc does: Automagically
+                     ;; map common network configuration files.
+                     (if network?
+                         (filter-map (lambda (file)
+                                       (and (file-exists? file)
+                                            (file-system-mapping
+                                             (source file)
+                                             (target file)
+                                             (writable? #f))))
+                                     %network-configuration-files)
+                         '())
+                     ;; Mappings for the union closure of all inputs.
+                     (map (lambda (dir)
+                            (file-system-mapping
+                             (source dir)
+                             (target dir)
+                             (writable? #f)))
+                          reqs)))
+            (file-systems (append %container-file-systems
+                                  (map mapping->file-system mappings))))
+       (exit/status
+        (call-with-container (map file-system->spec file-systems)
+          (lambda ()
+            ;; Setup global shell.
+            (mkdir-p "/bin")
+            (symlink bash "/bin/sh")
+
+            ;; Setup directory for temporary files.
+            (mkdir-p "/tmp")
+            (for-each (lambda (var)
+                        (setenv var "/tmp"))
+                      ;; The same variables as in Nix's 'build.cc'.
+                      '("TMPDIR" "TEMPDIR" "TMP" "TEMP"))
+
+            ;; From Nix build.cc:
+            ;;
+            ;; Set HOME to a non-existing path to prevent certain
+            ;; programs from using /etc/passwd (or NIS, or whatever)
+            ;; to locate the home directory (for example, wget looks
+            ;; for ~/.wgetrc).  I.e., these tools use /etc/passwd if
+            ;; HOME is not set, but they will just assume that the
+            ;; settings file they are looking for does not exist if
+            ;; HOME is set but points to some non-existing path.
+            (setenv "HOME" "/homeless-shelter")
+
+            ;; For convenience, start in the user's current working
+            ;; directory rather than the root directory.
+            (chdir cwd)
+
+            (primitive-exit/status
+             ;; A container's environment is already purified, so no need to
+             ;; request it be purified again.
+             (launch-environment command inputs paths #f)))
+          #:namespaces (if network?
+                           (delq 'net %namespaces) ; share host network
+                           %namespaces)))))))
+
+(define (environment-bash container? bootstrap? system)
+  "Return a monadic value in the store monad for the version of GNU Bash
+needed in the environment for SYSTEM, if any.  If CONTAINER? is #f, return #f.
+If CONTAINER? and BOOTSTRAP?, return the store path for the bootstrap Bash.
+Otherwise, return the derivation for the Bash package."
+  (with-monad %store-monad
+    (cond
+     ((and container? (not bootstrap?))
+      (package->derivation bash))
+     ;; Use the bootstrap Bash instead.
+     ((and container? bootstrap?)
+      (interned-file
+       (search-bootstrap-binary "bash" system)))
+     (else
+      (return #f)))))
+
 (define (parse-args args)
   "Parse the list of command line arguments ARGS."
   (define (handle-argument arg result)
-    (alist-cons 'package arg result))
+    (alist-cons 'package (tag-package-arg result arg) result))
 
   ;; The '--' token is used to separate the command to run from the rest of
   ;; the operands.
@@ -245,55 +443,103 @@ OUTPUT) tuples, using the build options in OPTS."
           opts
           (alist-cons 'exec command opts)))))
 
+(define (assert-container-features)
+  "Check if containers can be created and exit with an informative error
+message if any test fails."
+  (unless (user-namespace-supported?)
+    (report-error (_ "cannot create container: user namespaces unavailable\n"))
+    (leave (_ "is your kernel version < 3.10?\n")))
+
+  (unless (unprivileged-user-namespace-supported?)
+    (report-error (_ "cannot create container: unprivileged user cannot create user namespaces\n"))
+    (leave (_ "please set /proc/sys/kernel/unprivileged_userns_clone to \"1\"\n")))
+
+  (unless (setgroups-supported?)
+    (report-error (_ "cannot create container: /proc/self/setgroups does not exist\n"))
+    (leave (_ "is your kernel version < 3.19?\n"))))
+
 ;; Entry point.
 (define (guix-environment . args)
   (with-error-handling
-    (let* ((opts     (parse-args args))
-           (pure?    (assoc-ref opts 'pure))
-           (ad-hoc?  (assoc-ref opts 'ad-hoc?))
-           (command  (assoc-ref opts 'exec))
-           (packages (pick-all (options/resolve-packages opts) 'package))
-           (inputs   (if ad-hoc?
-                         (append-map (match-lambda
-                                       ((package output)
-                                        (package+propagated-inputs package
-                                                                   output)))
-                                     packages)
-                         (append-map (compose bag-transitive-inputs
-                                              package->bag
-                                              first)
-                                     packages)))
-           (paths    (delete-duplicates
-                      (cons $PATH
-                            (append-map (match-lambda
-                                          ((label (? package? p) _ ...)
-                                           (package-native-search-paths p))
-                                          (_
-                                           '()))
-                                        inputs))
-                      eq?)))
+    (let* ((opts       (parse-args args))
+           (pure?      (assoc-ref opts 'pure))
+           (container? (assoc-ref opts 'container?))
+           (network?   (assoc-ref opts 'network?))
+           (bootstrap? (assoc-ref opts 'bootstrap?))
+           (system     (assoc-ref opts 'system))
+           (command    (or (assoc-ref opts 'exec)
+                           ;; Spawn a shell if the user didn't specify
+                           ;; anything in particular.
+                           (if container?
+                               ;; The user's shell is likely not available
+                               ;; within the container.
+                               '("/bin/sh")
+                               (list %default-shell))))
+           (packages   (options/resolve-packages opts))
+           (mappings   (pick-all opts 'file-system-mapping))
+           (inputs     (delete-duplicates
+                        (append-map (match-lambda
+                                      (('ad-hoc-package package output)
+                                       (package+propagated-inputs package
+                                                                  output))
+                                      (('package package output)
+                                       (bag-transitive-inputs
+                                        (package->bag package))))
+                                    packages)))
+           (paths      (delete-duplicates
+                        (cons $PATH
+                              (append-map (match-lambda
+                                           ((label (? package? p) _ ...)
+                                            (package-native-search-paths p))
+                                           (_
+                                            '()))
+                                          inputs))
+                        eq?)))
+
+      (when container? (assert-container-features))
+
       (with-store store
+        (set-build-options-from-command-line store opts)
         (run-with-store store
-          (mlet %store-monad ((inputs (lower-inputs
-                                       (map (match-lambda
+          (mlet* %store-monad ((inputs (lower-inputs
+                                        (map (match-lambda
                                               ((label item)
                                                (list item))
                                               ((label item output)
                                                (list item output)))
-                                            inputs)
-                                       #:system (assoc-ref opts 'system))))
+                                             inputs)
+                                        #:system system))
+                               ;; Containers need a Bourne shell at /bin/sh.
+                               (bash (environment-bash container?
+                                                       bootstrap?
+                                                       system)))
             (mbegin %store-monad
-              ;; First build INPUTS.  This is necessary even for
-              ;; --search-paths.
-              (build-inputs inputs opts)
-              (cond ((assoc-ref opts 'dry-run?)
-                     (return #t))
-                    ((assoc-ref opts 'search-paths)
-                     (show-search-paths inputs paths pure?)
-                     (return #t))
-                    (else
-                     (create-environment inputs paths pure?)
-                     (return
-                      (exit
-                       (status:exit-val
-                        (apply system* command)))))))))))))
+              ;; First build the inputs.  This is necessary even for
+              ;; --search-paths.  Additionally, we might need to build bash
+              ;; for a container.
+              (build-inputs (if (derivation? bash)
+                                `((,bash "out") ,@inputs)
+                                inputs)
+                            opts)
+              (cond
+               ((assoc-ref opts 'dry-run?)
+                (return #t))
+               ((assoc-ref opts 'search-paths)
+                (show-search-paths inputs paths pure?)
+                (return #t))
+               (container?
+                (let ((bash-binary
+                       (if bootstrap?
+                           bash
+                           (string-append (derivation->output-path bash)
+                                          "/bin/sh"))))
+                  (launch-environment/container #:command command
+                                                #:bash bash-binary
+                                                #:user-mappings mappings
+                                                #:inputs inputs
+                                                #:paths paths
+                                                #:network? network?)))
+               (else
+                (return
+                 (exit/status
+                  (launch-environment command inputs paths pure?))))))))))))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 89a68d51d0..fe1bb93f7f 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -182,6 +182,10 @@ Invoke the garbage collector.\n"))
                                (('argument . arg) arg)
                                (_ #f))
                               opts)))
+      (define (assert-no-extra-arguments)
+        (unless (null? paths)
+          (leave (_ "extraneous arguments: ~{~a ~}~%") paths)))
+
       (define (list-relatives relatives)
         (for-each (compose (lambda (path)
                              (for-each (cut simple-format #t "~a~%" <>)
@@ -192,6 +196,7 @@ Invoke the garbage collector.\n"))
 
       (case (assoc-ref opts 'action)
         ((collect-garbage)
+         (assert-no-extra-arguments)
          (let ((min-freed (assoc-ref opts 'min-freed)))
            (if min-freed
                (collect-garbage store min-freed)
@@ -205,8 +210,10 @@ Invoke the garbage collector.\n"))
         ((list-referrers)
          (list-relatives referrers))
         ((optimize)
+         (assert-no-extra-arguments)
          (optimize-store store))
         ((verify)
+         (assert-no-extra-arguments)
          (let ((options (assoc-ref opts 'verify-options)))
            (exit
             (verify-store store
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 734a47719a..9255f0018a 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts graph)
   #:use-module (guix ui)
+  #:use-module (guix graph)
   #:use-module (guix scripts)
   #:use-module (guix utils)
   #:use-module (guix packages)
@@ -28,53 +29,23 @@
   #:use-module ((guix build-system gnu) #:select (standard-packages))
   #:use-module (gnu packages)
   #:use-module (guix sets)
-  #:use-module (guix records)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:export (%package-node-type
             %bag-node-type
+            %bag-with-origins-node-type
             %bag-emerged-node-type
             %derivation-node-type
             %reference-node-type
             %node-types
 
-            node-type
-            node-type?
-            node-type-identifier
-            node-type-label
-            node-type-edges
-            node-type-convert
-            node-type-name
-            node-type-description
-
-            %graphviz-backend
-            graph-backend?
-            graph-backend
-
-            export-graph
-
             guix-graph))
 
 
 ;;;
-;;; Node types.
-;;;
-
-(define-record-type* <node-type> node-type make-node-type
-  node-type?
-  (identifier  node-type-identifier)              ;node -> M identifier
-  (label       node-type-label)                   ;node -> string
-  (edges       node-type-edges)                   ;node -> M list of nodes
-  (convert     node-type-convert                  ;package -> M list of nodes
-               (default (lift1 list %store-monad)))
-  (name        node-type-name)                    ;string
-  (description node-type-description))            ;string
-
-
-;;;
 ;;; Package DAG.
 ;;;
 
@@ -135,17 +106,23 @@ file name."
                       low))))))
 
 (define (bag-node-edges thing)
-  "Return the list of dependencies of THING, a package or origin, etc."
-  (if (package? thing)
-      (match (bag-direct-inputs (package->bag thing))
-        (((labels things . outputs) ...)
-         (filter-map (match-lambda
-                       ((? package? p) p)
-                       ;; XXX: Here we choose to filter out origins, files,
-                       ;; etc.  Replace "#f" with "x" to reinstate them.
-                       (x #f))
-                     things)))
-      '()))
+  "Return the list of dependencies of THING, a package or origin.
+Dependencies may include packages, origin, and file names."
+  (cond ((package? thing)
+         (match (bag-direct-inputs (package->bag thing))
+           (((labels things . outputs) ...)
+            things)))
+        ((origin? thing)
+         (cons (origin-patch-guile thing)
+               (if (or (pair? (origin-patches thing))
+                       (origin-snippet thing))
+                   (match (origin-patch-inputs thing)
+                     (#f '())
+                     (((labels dependencies _ ...) ...)
+                      (delete-duplicates dependencies eq?)))
+                   '())))
+        (else
+         '())))
 
 (define %bag-node-type
   ;; Type for the traversal of package nodes via the "bag" representation,
@@ -155,7 +132,22 @@ file name."
    (description "the DAG of packages, including implicit inputs")
    (identifier bag-node-identifier)
    (label node-full-name)
-   (edges (lift1 bag-node-edges %store-monad))))
+   (edges (lift1 (compose (cut filter package? <>) bag-node-edges)
+                 %store-monad))))
+
+(define %bag-with-origins-node-type
+  (node-type
+   (name "bag-with-origins")
+   (description "the DAG of packages and origins, including implicit inputs")
+   (identifier bag-node-identifier)
+   (label node-full-name)
+   (edges (lift1 (lambda (thing)
+                   (filter (match-lambda
+                             ((? package?) #t)
+                             ((? origin?)  #t)
+                             (_            #f))
+                           (bag-node-edges thing)))
+                 %store-monad))))
 
 (define standard-package-set
   (memoize
@@ -270,6 +262,7 @@ substitutes."
   ;; List of all the node types.
   (list %package-node-type
         %bag-node-type
+        %bag-with-origins-node-type
         %bag-emerged-node-type
         %derivation-node-type
         %reference-node-type))
@@ -293,73 +286,6 @@ substitutes."
 
 
 ;;;
-;;; Graphviz export.
-;;;
-
-(define-record-type <graph-backend>
-  (graph-backend prologue epilogue node edge)
-  graph-backend?
-  (prologue graph-backend-prologue)
-  (epilogue graph-backend-epilogue)
-  (node     graph-backend-node)
-  (edge     graph-backend-edge))
-
-(define (emit-prologue name port)
-  (format port "digraph \"Guix ~a\" {\n"
-          name))
-(define (emit-epilogue port)
-  (display "\n}\n" port))
-(define (emit-node id label port)
-  (format port "  \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%"
-          id label))
-(define (emit-edge id1 id2 port)
-  (format port "  \"~a\" -> \"~a\" [color = red];~%"
-          id1 id2))
-
-(define %graphviz-backend
-  (graph-backend emit-prologue emit-epilogue
-                 emit-node emit-edge))
-
-(define* (export-graph sinks port
-                       #:key
-                       reverse-edges?
-                       (node-type %package-node-type)
-                       (backend %graphviz-backend))
-  "Write to PORT the representation of the DAG with the given SINKS, using the
-given BACKEND.  Use NODE-TYPE to traverse the DAG.  When REVERSE-EDGES? is
-true, draw reverse arrows."
-  (match backend
-    (($ <graph-backend> emit-prologue emit-epilogue emit-node emit-edge)
-     (emit-prologue (node-type-name node-type) port)
-
-     (match node-type
-       (($ <node-type> node-identifier node-label node-edges)
-        (let loop ((nodes   sinks)
-                   (visited (set)))
-          (match nodes
-            (()
-             (with-monad %store-monad
-               (emit-epilogue port)
-               (store-return #t)))
-            ((head . tail)
-             (mlet %store-monad ((id (node-identifier head)))
-               (if (set-contains? visited id)
-                   (loop tail visited)
-                   (mlet* %store-monad ((dependencies (node-edges head))
-                                        (ids          (mapm %store-monad
-                                                            node-identifier
-                                                            dependencies)))
-                     (emit-node id (node-label head) port)
-                     (for-each (lambda (dependency dependency-id)
-                                 (if reverse-edges?
-                                     (emit-edge dependency-id id port)
-                                     (emit-edge id dependency-id port)))
-                               dependencies ids)
-                     (loop (append dependencies tail)
-                           (set-insert id visited)))))))))))))
-
-
-;;;
 ;;; Command-line options.
 ;;;
 
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 8d31128c47..4e84278a78 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -19,6 +19,7 @@
 (define-module (guix scripts import hackage)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix packages)
   #:use-module (guix scripts)
   #:use-module (guix import hackage)
   #:use-module (guix scripts import)
@@ -34,10 +35,13 @@
 ;;; Command-line options.
 ;;;
 
+(define ghc-default-version
+  (string-append "ghc-" (package-version (@ (gnu packages haskell) ghc))))
+
 (define %default-options
-  '((include-test-dependencies? . #t)
+  `((include-test-dependencies? . #t)
     (read-from-stdin? . #f)
-    ('cabal-environment . '())))
+    (cabal-environment . ,`(("impl" . ,ghc-default-version)))))
 
 (define (show-help)
   (display (_ "Usage: guix import hackage PACKAGE-NAME
@@ -55,7 +59,7 @@ version.\n"))
   (display (_ "
   -s, --stdin                  read from standard input"))
   (display (_ "
-  -t, --no-test-dependencies   don't include test only dependencies"))
+  -t, --no-test-dependencies   don't include test-only dependencies"))
   (display (_ "
   -V, --version                display version information and exit"))
   (newline)
@@ -134,9 +138,9 @@ from standard input~%")))))
           ((package-name)
            (run-importer package-name opts
                          (lambda ()
-                           (leave
-                            (_ "failed to download cabal file for package '~a'~%"))
-                           package-name)))
+                           (leave (_ "failed to download cabal file \
+for package '~a'~%")
+                                  package-name))))
           (()
            (leave (_ "too few arguments~%")))
           ((many ...)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index b1707ade44..338c7e827d 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -32,6 +32,7 @@
   #:use-module (guix scripts)
   #:use-module (guix gnu-maintenance)
   #:use-module (guix monads)
+  #:use-module (guix cve)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -61,6 +62,7 @@
             check-source
             check-source-file-name
             check-license
+            check-vulnerabilities
             check-formatting
             run-checkers
 
@@ -266,10 +268,13 @@ the synopsis")
      (check-start-with-package-name synopsis)
      (check-synopsis-length synopsis))))
 
-(define (probe-uri uri)
+(define* (probe-uri uri #:key timeout)
   "Probe URI, a URI object, and return two values: a symbol denoting the
 probing status, such as 'http-response' when we managed to get an HTTP
-response from URI, and additional details, such as the actual HTTP response."
+response from URI, and additional details, such as the actual HTTP response.
+
+TIMEOUT is the maximum number of seconds (possibly an inexact number) to wait
+for connections to complete; when TIMEOUT is #f, wait as long as needed."
   (define headers
     '((User-Agent . "GNU Guile")
       (Accept . "*/*")))
@@ -280,7 +285,7 @@ response from URI, and additional details, such as the actual HTTP response."
       ((or 'http 'https)
        (catch #t
          (lambda ()
-           (let ((port    (open-connection-for-uri uri))
+           (let ((port    (open-connection-for-uri uri #:timeout timeout))
                  (request (build-request uri #:headers headers)))
              (define response
                (dynamic-wind
@@ -313,7 +318,7 @@ response from URI, and additional details, such as the actual HTTP response."
       ('ftp
        (catch #t
          (lambda ()
-           (let ((conn (ftp-open (uri-host uri) 21)))
+           (let ((conn (ftp-open (uri-host uri) #:timeout timeout)))
              (define response
                (dynamic-wind
                  (const #f)
@@ -338,7 +343,7 @@ response from URI, and additional details, such as the actual HTTP response."
   "Return #t if the given URI can be reached, otherwise return #f and emit a
 warning for PACKAGE mentionning the FIELD."
   (let-values (((status argument)
-                (probe-uri uri)))
+                (probe-uri uri #:timeout 3)))     ;wait at most 3 seconds
     (case status
       ((http-response)
        (or (= 200 (response-code argument))
@@ -568,6 +573,53 @@ descriptions maintained upstream."
      (emit-warning package (_ "invalid license field")
                    'license))))
 
+(define (patch-file-name patch)
+  "Return the basename of PATCH's file name, or #f if the file name could not
+be determined."
+  (match patch
+    ((? string?)
+     (basename patch))
+    ((? origin?)
+     (and=> (origin-actual-file-name patch) basename))))
+
+(define (package-name->cpe-name name)
+  "Do a basic conversion of NAME, a Guix package name, to the corresponding
+Common Platform Enumeration (CPE) name."
+  (match name
+    ("icecat"   "firefox")                        ;or "firefox_esr"
+    ;; TODO: Add more.
+    (_          name)))
+
+(define package-vulnerabilities
+  (let ((lookup (delay (vulnerabilities->lookup-proc
+                        (current-vulnerabilities)))))
+    (lambda (package)
+      "Return a list of vulnerabilities affecting PACKAGE."
+      ((force lookup)
+       (package-name->cpe-name (package-name package))
+       (package-version package)))))
+
+(define (check-vulnerabilities package)
+  "Check for known vulnerabilities for PACKAGE."
+  (match (package-vulnerabilities package)
+    (()
+     #t)
+    ((vulnerabilities ...)
+     (let* ((patches   (filter-map patch-file-name
+                                   (or (and=> (package-source package)
+                                              origin-patches)
+                                       '())))
+            (unpatched (remove (lambda (vuln)
+                                 (find (cute string-contains
+                                         <> (vulnerability-id vuln))
+                                       patches))
+                               vulnerabilities)))
+       (unless (null? unpatched)
+         (emit-warning package
+                       (format #f (_ "probably vulnerable to ~a")
+                               (string-join (map vulnerability-id unpatched)
+                                            ", "))))))))
+
 
 ;;;
 ;;; Source code formatting.
@@ -706,6 +758,11 @@ or a list thereof")
      (description "Validate package synopses")
      (check       check-synopsis-style))
    (lint-checker
+     (name        'cve)
+     (description "Check the Common Vulnerabilities and Exposures\
+ (CVE) database")
+     (check       check-vulnerabilities))
+   (lint-checker
      (name        'formatting)
      (description "Look for formatting issues in the source")
      (check       check-formatting))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index e0fe1ddb27..c62daee9a7 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -32,27 +32,21 @@
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module ((guix build utils)
-                #:select (directory-exists? mkdir-p search-path-as-list))
+                #:select (directory-exists? mkdir-p))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
-  #:use-module (gnu packages base)
-  #:use-module (gnu packages guile)
-  #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
-  #:export (switch-to-generation
-            switch-to-previous-generation
-            roll-back
-            delete-generation
-            delete-generations
+  #:autoload   (gnu packages base) (canonical-package)
+  #:autoload   (gnu packages guile) (guile-2.0)
+  #:autoload   (gnu packages bootstrap) (%bootstrap-guile)
+  #:export (delete-generations
             display-search-paths
             guix-package))
 
@@ -100,149 +94,59 @@ indirectly, or PROFILE."
       %user-profile-directory
       profile))
 
-(define (link-to-empty-profile store generation)
-  "Link GENERATION, a string, to the empty profile."
-  (let* ((drv  (run-with-store store
-                 (profile-derivation (manifest '()))))
-         (prof (derivation->output-path drv "out")))
-    (when (not (build-derivations store (list drv)))
-          (leave (_ "failed to build the empty profile~%")))
-
-    (switch-symlinks generation prof)))
-
-(define (switch-to-generation profile number)
-  "Atomically switch PROFILE to the generation NUMBER."
-  (let ((current    (generation-number profile))
-        (generation (generation-file-name profile number)))
-    (cond ((not (file-exists? profile))
-           (raise (condition (&profile-not-found-error
-                              (profile profile)))))
-          ((not (file-exists? generation))
-           (raise (condition (&missing-generation-error
-                              (profile profile)
-                              (generation number)))))
-          (else
-           (format #t (_ "switching from generation ~a to ~a~%")
-                   current number)
-           (switch-symlinks profile generation)))))
-
-(define (switch-to-previous-generation profile)
-  "Atomically switch PROFILE to the previous generation."
-  (switch-to-generation profile
-                        (previous-generation-number profile)))
-
-(define (roll-back store profile)
-  "Roll back to the previous generation of PROFILE."
-  (let* ((number              (generation-number profile))
-         (previous-number     (previous-generation-number profile number))
-         (previous-generation (generation-file-name profile previous-number)))
-    (cond ((not (file-exists? profile))                 ; invalid profile
-           (raise (condition (&profile-not-found-error
-                              (profile profile)))))
-          ((zero? number)                               ; empty profile
-           (format (current-error-port)
-                   (_ "nothing to do: already at the empty profile~%")))
-          ((or (zero? previous-number)                  ; going to emptiness
-               (not (file-exists? previous-generation)))
-           (link-to-empty-profile store previous-generation)
-           (switch-to-previous-generation profile))
-          (else
-           (switch-to-previous-generation profile)))))  ; anything else
-
-(define (delete-generation store profile number)
-  "Delete generation with NUMBER from PROFILE."
-  (define (display-and-delete)
-    (let ((generation (generation-file-name profile number)))
-      (format #t (_ "deleting ~a~%") generation)
-      (delete-file generation)))
-
-  (let* ((current-number      (generation-number profile))
-         (previous-number     (previous-generation-number profile number))
-         (previous-generation (generation-file-name profile previous-number)))
-    (cond ((zero? number))              ; do not delete generation 0
-          ((and (= number current-number)
-                (not (file-exists? previous-generation)))
-           (link-to-empty-profile store previous-generation)
-           (switch-to-previous-generation profile)
-           (display-and-delete))
-          ((= number current-number)
-           (roll-back store profile)
-           (display-and-delete))
-          (else
-           (display-and-delete)))))
+(define (ensure-default-profile)
+  "Ensure the default profile symlink and directory exist and are writable."
+
+  (define (rtfm)
+    (format (current-error-port)
+            (_ "Try \"info '(guix) Invoking guix package'\" for \
+more information.~%"))
+    (exit 1))
+
+  ;; Create ~/.guix-profile if it doesn't exist yet.
+  (when (and %user-profile-directory
+             %current-profile
+             (not (false-if-exception
+                   (lstat %user-profile-directory))))
+    (symlink %current-profile %user-profile-directory))
+
+  (let ((s (stat %profile-directory #f)))
+    ;; Attempt to create /…/profiles/per-user/$USER if needed.
+    (unless (and s (eq? 'directory (stat:type s)))
+      (catch 'system-error
+        (lambda ()
+          (mkdir-p %profile-directory))
+        (lambda args
+          ;; Often, we cannot create %PROFILE-DIRECTORY because its
+          ;; parent directory is root-owned and we're running
+          ;; unprivileged.
+          (format (current-error-port)
+                  (_ "error: while creating directory `~a': ~a~%")
+                  %profile-directory
+                  (strerror (system-error-errno args)))
+          (format (current-error-port)
+                  (_ "Please create the `~a' directory, with you as the owner.~%")
+                  %profile-directory)
+          (rtfm))))
+
+    ;; Bail out if it's not owned by the user.
+    (unless (or (not s) (= (stat:uid s) (getuid)))
+      (format (current-error-port)
+              (_ "error: directory `~a' is not owned by you~%")
+              %profile-directory)
+      (format (current-error-port)
+              (_ "Please change the owner of `~a' to user ~s.~%")
+              %profile-directory (or (getenv "USER")
+                                     (getenv "LOGNAME")
+                                     (getuid)))
+      (rtfm))))
 
 (define (delete-generations store profile generations)
   "Delete GENERATIONS from PROFILE.
 GENERATIONS is a list of generation numbers."
-  (for-each (cut delete-generation store profile <>)
+  (for-each (cut delete-generation* store profile <>)
             generations))
 
-(define* (matching-generations str #:optional (profile %current-profile)
-                               #:key (duration-relation <=))
-  "Return the list of available generations matching a pattern in STR.  See
-'string->generations' and 'string->duration' for the list of valid patterns.
-When STR is a duration pattern, return all the generations whose ctime has
-DURATION-RELATION with the current time."
-  (define (valid-generations lst)
-    (define (valid-generation? n)
-      (any (cut = n <>) (generation-numbers profile)))
-
-    (fold-right (lambda (x acc)
-                  (if (valid-generation? x)
-                      (cons x acc)
-                      acc))
-                '()
-                lst))
-
-  (define (filter-generations generations)
-    (match generations
-      (() '())
-      (('>= n)
-       (drop-while (cut > n <>)
-                   (generation-numbers profile)))
-      (('<= n)
-       (valid-generations (iota n 1)))
-      ((lst ..1)
-       (valid-generations lst))
-      (_ #f)))
-
-  (define (filter-by-duration duration)
-    (define (time-at-midnight time)
-      ;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and
-      ;; hours to zeros.
-      (let ((d (time-utc->date time)))
-         (date->time-utc
-          (make-date 0 0 0 0
-                     (date-day d) (date-month d)
-                     (date-year d) (date-zone-offset d)))))
-
-    (define generation-ctime-alist
-      (map (lambda (number)
-             (cons number
-                   (time-second
-                    (time-at-midnight
-                     (generation-time profile number)))))
-           (generation-numbers profile)))
-
-    (match duration
-      (#f #f)
-      (res
-       (let ((s (time-second
-                 (subtract-duration (time-at-midnight (current-time))
-                                    duration))))
-         (delete #f (map (lambda (x)
-                           (and (duration-relation s (cdr x))
-                                (first x)))
-                         generation-ctime-alist))))))
-
-  (cond ((string->generations str)
-         =>
-         filter-generations)
-        ((string->duration str)
-         =>
-         filter-by-duration)
-        (else #f)))
-
 (define (delete-matching-generations store profile pattern)
   "Delete from PROFILE all the generations matching PATTERN.  PATTERN must be
 a string denoting a set of generations: the empty list means \"all generations
@@ -253,7 +157,7 @@ denote ranges as interpreted by 'matching-derivations'."
            (raise (condition (&profile-not-found-error
                               (profile profile)))))
           ((string-null? pattern)
-           (delete-generations (%store) profile
+           (delete-generations store profile
                                (delv current (profile-generations profile))))
           ;; Do not delete the zeroth generation.
           ((equal? 0 (string->number pattern))
@@ -274,10 +178,53 @@ denote ranges as interpreted by 'matching-derivations'."
              (let ((numbers (delv current numbers)))
                (when (null-list? numbers)
                  (leave (_ "no matching generation~%")))
-               (delete-generations (%store) profile numbers))))
+               (delete-generations store profile numbers))))
           (else
            (leave (_ "invalid syntax: ~a~%") pattern)))))
 
+(define* (build-and-use-profile store profile manifest
+                                #:key
+                                bootstrap? use-substitutes?
+                                dry-run?)
+  "Build a new generation of PROFILE, a file name, using the packages
+specified in MANIFEST, a manifest object."
+  (when (equal? profile %current-profile)
+    (ensure-default-profile))
+
+  (let* ((prof-drv (run-with-store store
+                     (profile-derivation manifest
+                                         #:hooks (if bootstrap?
+                                                     '()
+                                                     %default-profile-hooks))))
+         (prof     (derivation->output-path prof-drv)))
+    (show-what-to-build store (list prof-drv)
+                        #:use-substitutes? use-substitutes?
+                        #:dry-run? dry-run?)
+
+    (cond
+     (dry-run? #t)
+     ((and (file-exists? profile)
+           (and=> (readlink* profile) (cut string=? prof <>)))
+      (format (current-error-port) (_ "nothing to be done~%")))
+     (else
+      (let* ((number (generation-number profile))
+
+             ;; Always use NUMBER + 1 for the new profile, possibly
+             ;; overwriting a "previous future generation".
+             (name   (generation-file-name profile (+ 1 number))))
+        (and (build-derivations store (list prof-drv))
+             (let* ((entries (manifest-entries manifest))
+                    (count   (length entries)))
+               (switch-symlinks name prof)
+               (switch-symlinks profile name)
+               (unless (string=? profile %current-profile)
+                 (register-gc-root store name))
+               (format #t (N_ "~a package in profile~%"
+                              "~a packages in profile~%"
+                              count)
+                       count)
+               (display-search-paths entries (list profile)))))))))
+
 
 ;;;
 ;;; Package specifications.
@@ -327,11 +274,11 @@ an output path different than CURRENT-PATH."
 ;;; Search paths.
 ;;;
 
-(define* (search-path-environment-variables entries profile
+(define* (search-path-environment-variables entries profiles
                                             #:optional (getenv getenv)
                                             #:key (kind 'exact))
   "Return environment variable definitions that may be needed for the use of
-ENTRIES, a list of manifest entries, in PROFILE.  Use GETENV to determine the
+ENTRIES, a list of manifest entries, in PROFILES.  Use GETENV to determine the
 current settings and report only settings not already effective.  KIND
 must be one of 'exact, 'prefix, or 'suffix, depending on the kind of search
 path definition to be returned."
@@ -346,15 +293,15 @@ path definition to be returned."
                      (environment-variable-definition variable value
                                                       #:separator sep
                                                       #:kind kind))))
-                (evaluate-search-paths search-paths (list profile)
+                (evaluate-search-paths search-paths profiles
                                        getenv))))
 
-(define* (display-search-paths entries profile
+(define* (display-search-paths entries profiles
                                #:key (kind 'exact))
   "Display the search path environment variables that may need to be set for
 ENTRIES, a list of manifest entries, in the context of PROFILE."
-  (let* ((profile  (user-friendly-profile profile))
-         (settings (search-path-environment-variables entries profile
+  (let* ((profiles (map user-friendly-profile profiles))
+         (settings (search-path-environment-variables entries profiles
                                                       #:kind kind)))
     (unless (null? settings)
       (format #t (_ "The following environment variable definitions may be needed:~%"))
@@ -367,8 +314,7 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
 
 (define %default-options
   ;; Alist of default option values.
-  `((profile . ,%current-profile)
-    (max-silent-time . 3600)
+  `((max-silent-time . 3600)
     (verbosity . 0)
     (substitutes? . #t)))
 
@@ -527,7 +473,7 @@ kind of search path~%")
          (option '(#\p "profile") #t #f
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'profile (canonicalize-profile arg)
-                                       (alist-delete 'profile result))
+                                       result)
                            #f)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result arg-handler)
@@ -564,87 +510,76 @@ kind of search path~%")
 
          %standard-build-options))
 
-(define (options->installable opts manifest)
-  "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
-return the new list of manifest entries."
-  (define (package->manifest-entry* package output)
-    (check-package-freshness package)
-    ;; When given a package via `-e', install the first of its
-    ;; outputs (XXX).
-    (package->manifest-entry package output))
-
+(define (options->upgrade-predicate opts)
+  "Return a predicate based on the upgrade/do-not-upgrade regexps in OPTS
+that, given a package name, returns true if the package is a candidate for
+upgrading, #f otherwise."
   (define upgrade-regexps
     (filter-map (match-lambda
-                 (('upgrade . regexp)
-                  (make-regexp (or regexp "")))
-                 (_ #f))
+                  (('upgrade . regexp)
+                   (make-regexp* (or regexp "")))
+                  (_ #f))
                 opts))
 
   (define do-not-upgrade-regexps
     (filter-map (match-lambda
-                 (('do-not-upgrade . regexp)
-                  (make-regexp regexp))
-                 (_ #f))
+                  (('do-not-upgrade . regexp)
+                   (make-regexp* regexp))
+                  (_ #f))
                 opts))
 
-  (define packages-to-upgrade
-    (match upgrade-regexps
-      (()
-       '())
-      ((_ ...)
-       (filter-map (match-lambda
-                    (($ <manifest-entry> name version output path _)
-                     (and (any (cut regexp-exec <> name)
-                               upgrade-regexps)
-                          (not (any (cut regexp-exec <> name)
-                                    do-not-upgrade-regexps))
-                          (upgradeable? name version path)
-                          (let ((output (or output "out")))
-                            (call-with-values
-                                (lambda ()
-                                  (specification->package+output name output))
-                              list))))
-                    (_ #f))
-                   (manifest-entries manifest)))))
+  (lambda (name)
+    (and (any (cut regexp-exec <> name) upgrade-regexps)
+         (not (any (cut regexp-exec <> name) do-not-upgrade-regexps)))))
+
+(define (store-item->manifest-entry item)
+  "Return a manifest entry for ITEM, a \"/gnu/store/...\" file name."
+  (let-values (((name version)
+                (package-name->name+version (store-path-package-name item))))
+    (manifest-entry
+      (name name)
+      (version version)
+      (output #f)
+      (item item))))
+
+(define (options->installable opts manifest)
+  "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
+return the new list of manifest entries."
+  (define (package->manifest-entry* package output)
+    (check-package-freshness package)
+    (package->manifest-entry package output))
+
+  (define upgrade?
+    (options->upgrade-predicate opts))
 
   (define to-upgrade
-    (map (match-lambda
-          ((package output)
-           (package->manifest-entry* package output)))
-         packages-to-upgrade))
+    (filter-map (match-lambda
+                  (($ <manifest-entry> name version output path _)
+                   (and (upgrade? name)
+                        (upgradeable? name version path)
+                        (let ((output (or output "out")))
+                          (call-with-values
+                              (lambda ()
+                                (specification->package+output name output))
+                            package->manifest-entry*))))
+                  (_ #f))
+                (manifest-entries manifest)))
 
-  (define packages-to-install
+  (define to-install
     (filter-map (match-lambda
-                 (('install . (? package? p))
-                  (list p "out"))
-                 (('install . (? string? spec))
-                  (and (not (store-path? spec))
+                  (('install . (? package? p))
+                   ;; When given a package via `-e', install the first of its
+                   ;; outputs (XXX).
+                   (package->manifest-entry* p "out"))
+                  (('install . (? string? spec))
+                   (if (store-path? spec)
+                       (store-item->manifest-entry spec)
                        (let-values (((package output)
                                      (specification->package+output spec)))
-                         (and package (list package output)))))
-                 (_ #f))
+                         (package->manifest-entry* package output))))
+                  (_ #f))
                 opts))
 
-  (define to-install
-    (append (map (match-lambda
-                  ((package output)
-                   (package->manifest-entry* package output)))
-                 packages-to-install)
-            (filter-map (match-lambda
-                         (('install . (? package?))
-                          #f)
-                         (('install . (? store-path? path))
-                          (let-values (((name version)
-                                        (package-name->name+version
-                                         (store-path-package-name path))))
-                            (manifest-entry
-                             (name name)
-                             (version version)
-                             (output #f)
-                             (item path))))
-                         (_ #f))
-                        opts)))
-
   (append to-upgrade to-install))
 
 (define (options->removable options manifest)
@@ -678,33 +613,200 @@ doesn't need it."
 
   (add-indirect-root store absolute))
 
-(define (readlink* file)
-  "Call 'readlink' until the result is not a symlink."
-  (define %max-symlink-depth 50)
-
-  (let loop ((file  file)
-             (depth 0))
-    (define (absolute target)
-      (if (absolute-file-name? target)
-          target
-          (string-append (dirname file) "/" target)))
-
-    (if (>= depth %max-symlink-depth)
-        file
-        (call-with-values
-            (lambda ()
-              (catch 'system-error
-                (lambda ()
-                  (values #t (readlink file)))
-                (lambda args
-                  (let ((errno (system-error-errno args)))
-                    (if (or (= errno EINVAL))
-                        (values #f file)
-                        (apply throw args))))))
-          (lambda (success? target)
-            (if success?
-                (loop (absolute target) (+ depth 1))
-                file))))))
+
+;;;
+;;; Queries and actions.
+;;;
+
+(define (process-query opts)
+  "Process any query specified by OPTS.  Return #t when a query was actually
+processed, #f otherwise."
+  (let* ((profiles (match (filter-map (match-lambda
+                                        (('profile . p) p)
+                                        (_              #f))
+                                      opts)
+                     (() (list %current-profile))
+                     (lst lst)))
+         (profile  (match profiles
+                     ((head tail ...) head))))
+    (match (assoc-ref opts 'query)
+      (('list-generations pattern)
+       (define (list-generation number)
+         (unless (zero? number)
+           (display-generation profile number)
+           (display-profile-content profile number)
+           (newline)))
+
+       (cond ((not (file-exists? profile))      ; XXX: race condition
+              (raise (condition (&profile-not-found-error
+                                 (profile profile)))))
+             ((string-null? pattern)
+              (for-each list-generation (profile-generations profile)))
+             ((matching-generations pattern profile)
+              =>
+              (lambda (numbers)
+                (if (null-list? numbers)
+                    (exit 1)
+                    (leave-on-EPIPE
+                     (for-each list-generation numbers)))))
+             (else
+              (leave (_ "invalid syntax: ~a~%")
+                     pattern)))
+       #t)
+
+      (('list-installed regexp)
+       (let* ((regexp    (and regexp (make-regexp* regexp)))
+              (manifest  (profile-manifest profile))
+              (installed (manifest-entries manifest)))
+         (leave-on-EPIPE
+          (for-each (match-lambda
+                      (($ <manifest-entry> name version output path _)
+                       (when (or (not regexp)
+                                 (regexp-exec regexp name))
+                         (format #t "~a\t~a\t~a\t~a~%"
+                                 name (or version "?") output path))))
+
+                    ;; Show most recently installed packages last.
+                    (reverse installed)))
+         #t))
+
+      (('list-available regexp)
+       (let* ((regexp    (and regexp (make-regexp* regexp)))
+              (available (fold-packages
+                          (lambda (p r)
+                            (let ((n (package-name p)))
+                              (if (supported-package? p)
+                                  (if regexp
+                                      (if (regexp-exec regexp n)
+                                          (cons p r)
+                                          r)
+                                      (cons p r))
+                                  r)))
+                          '())))
+         (leave-on-EPIPE
+          (for-each (lambda (p)
+                      (format #t "~a\t~a\t~a\t~a~%"
+                              (package-name p)
+                              (package-version p)
+                              (string-join (package-outputs p) ",")
+                              (location->string (package-location p))))
+                    (sort available
+                          (lambda (p1 p2)
+                            (string<? (package-name p1)
+                                      (package-name p2))))))
+         #t))
+
+      (('search regexp)
+       (let ((regexp (make-regexp* regexp regexp/icase)))
+         (leave-on-EPIPE
+          (for-each (cute package->recutils <> (current-output-port))
+                    (find-packages-by-description regexp)))
+         #t))
+
+      (('show requested-name)
+       (let-values (((name version)
+                     (package-name->name+version requested-name)))
+         (leave-on-EPIPE
+          (for-each (cute package->recutils <> (current-output-port))
+                    (find-packages-by-name name version)))
+         #t))
+
+      (('search-paths kind)
+       (let* ((manifests (map profile-manifest profiles))
+              (entries   (append-map manifest-entries manifests))
+              (profiles  (map user-friendly-profile profiles))
+              (settings  (search-path-environment-variables entries profiles
+                                                            (const #f)
+                                                            #:kind kind)))
+         (format #t "~{~a~%~}" settings)
+         #t))
+
+      (_ #f))))
+
+
+(define* (roll-back-action store profile arg opts
+                           #:key dry-run?)
+  "Roll back PROFILE to its previous generation."
+  (unless dry-run?
+    (roll-back* store profile)))
+
+(define* (switch-generation-action store profile spec opts
+                                   #:key dry-run?)
+  "Switch PROFILE to the generation specified by SPEC."
+  (unless dry-run?
+    (let* ((number (string->number spec))
+           (number (and number
+                        (case (string-ref spec 0)
+                          ((#\+ #\-)
+                           (relative-generation profile number))
+                          (else number)))))
+      (if number
+          (switch-to-generation* profile number)
+          (leave (_ "cannot switch to generation '~a'~%") spec)))))
+
+(define* (delete-generations-action store profile pattern opts
+                                    #:key dry-run?)
+  "Delete PROFILE's generations that match PATTERN."
+  (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?)))
+    (if dry-run?
+        (format #t (_ "would install new manifest from '~a' with ~d entries~%")
+                file (length (manifest-entries manifest)))
+        (format #t (_ "installing new manifest from '~a' with ~d entries~%")
+                file (length (manifest-entries manifest))))
+    (build-and-use-profile store profile manifest
+                           #:bootstrap? bootstrap?
+                           #:use-substitutes? substitutes?
+                           #:dry-run? dry-run?)))
+
+(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)))
+
+(define (process-actions store opts)
+  "Process any install/remove/upgrade action from OPTS."
+
+  (define dry-run? (assoc-ref opts 'dry-run?))
+  (define bootstrap? (assoc-ref opts 'bootstrap?))
+  (define substitutes? (assoc-ref opts 'substitutes?))
+  (define profile  (or (assoc-ref opts 'profile) %current-profile))
+
+  ;; First, process roll-backs, generation removals, etc.
+  (for-each (match-lambda
+              ((key . arg)
+               (and=> (assoc-ref %actions key)
+                      (lambda (proc)
+                        (proc store profile arg opts
+                              #:dry-run? dry-run?)))))
+            opts)
+
+  ;; Then, process normal package installation/removal/upgrade.
+  (let* ((manifest    (profile-manifest profile))
+         (install     (options->installable opts manifest))
+         (remove      (options->removable opts manifest))
+         (transaction (manifest-transaction (install install)
+                                            (remove remove)))
+         (new         (manifest-perform-transaction manifest transaction)))
+
+    (unless (and (null? install) (null? remove))
+      (show-manifest-transaction store manifest transaction
+                                 #:dry-run? dry-run?)
+      (build-and-use-profile store profile new
+                             #:bootstrap? bootstrap?
+                             #:use-substitutes? substitutes?
+                             #:dry-run? dry-run?))))
 
 
 ;;;
@@ -718,278 +820,6 @@ doesn't need it."
         (arg-handler arg result)
         (leave (_ "~A: extraneous argument~%") arg)))
 
-  (define (ensure-default-profile)
-    ;; Ensure the default profile symlink and directory exist and are
-    ;; writable.
-
-    (define (rtfm)
-      (format (current-error-port)
-              (_ "Try \"info '(guix) Invoking guix package'\" for \
-more information.~%"))
-      (exit 1))
-
-    ;; Create ~/.guix-profile if it doesn't exist yet.
-    (when (and %user-profile-directory
-               %current-profile
-               (not (false-if-exception
-                     (lstat %user-profile-directory))))
-      (symlink %current-profile %user-profile-directory))
-
-    (let ((s (stat %profile-directory #f)))
-      ;; Attempt to create /…/profiles/per-user/$USER if needed.
-      (unless (and s (eq? 'directory (stat:type s)))
-        (catch 'system-error
-          (lambda ()
-            (mkdir-p %profile-directory))
-          (lambda args
-            ;; Often, we cannot create %PROFILE-DIRECTORY because its
-            ;; parent directory is root-owned and we're running
-            ;; unprivileged.
-            (format (current-error-port)
-                    (_ "error: while creating directory `~a': ~a~%")
-                    %profile-directory
-                    (strerror (system-error-errno args)))
-            (format (current-error-port)
-                    (_ "Please create the `~a' directory, with you as the owner.~%")
-                    %profile-directory)
-            (rtfm))))
-
-      ;; Bail out if it's not owned by the user.
-      (unless (or (not s) (= (stat:uid s) (getuid)))
-        (format (current-error-port)
-                (_ "error: directory `~a' is not owned by you~%")
-                %profile-directory)
-        (format (current-error-port)
-                (_ "Please change the owner of `~a' to user ~s.~%")
-                %profile-directory (or (getenv "USER")
-                                       (getenv "LOGNAME")
-                                       (getuid)))
-        (rtfm))))
-
-  (define (process-actions opts)
-    ;; Process any install/remove/upgrade action from OPTS.
-
-    (define dry-run? (assoc-ref opts 'dry-run?))
-    (define profile  (assoc-ref opts 'profile))
-
-    (define (build-and-use-profile manifest)
-      (let* ((bootstrap?  (assoc-ref opts 'bootstrap?)))
-
-        (when (equal? profile %current-profile)
-          (ensure-default-profile))
-
-        (let* ((prof-drv (run-with-store (%store)
-                           (profile-derivation
-                            manifest
-                            #:hooks (if bootstrap?
-                                        '()
-                                        %default-profile-hooks))))
-               (prof     (derivation->output-path prof-drv)))
-          (show-what-to-build (%store) (list prof-drv)
-                              #:use-substitutes?
-                              (assoc-ref opts 'substitutes?)
-                              #:dry-run? dry-run?)
-
-          (cond
-           (dry-run? #t)
-           ((and (file-exists? profile)
-                 (and=> (readlink* profile) (cut string=? prof <>)))
-            (format (current-error-port) (_ "nothing to be done~%")))
-           (else
-            (let* ((number (generation-number profile))
-
-                   ;; Always use NUMBER + 1 for the new profile,
-                   ;; possibly overwriting a "previous future
-                   ;; generation".
-                   (name   (generation-file-name profile
-                                                 (+ 1 number))))
-              (and (build-derivations (%store) (list prof-drv))
-                   (let* ((entries (manifest-entries manifest))
-                          (count   (length entries)))
-                     (switch-symlinks name prof)
-                     (switch-symlinks profile name)
-                     (unless (string=? profile %current-profile)
-                       (register-gc-root (%store) name))
-                     (format #t (N_ "~a package in profile~%"
-                                    "~a packages in profile~%"
-                                    count)
-                             count)
-                     (display-search-paths entries profile)))))))))
-
-    ;; First roll back if asked to.
-    (cond ((and (assoc-ref opts 'roll-back?)
-                (not dry-run?))
-           (roll-back (%store) profile)
-           (process-actions (alist-delete 'roll-back? opts)))
-          ((and (assoc-ref opts 'switch-generation)
-                (not dry-run?))
-           (for-each
-            (match-lambda
-              (('switch-generation . pattern)
-               (let* ((number (string->number pattern))
-                      (number (and number
-                                   (case (string-ref pattern 0)
-                                     ((#\+ #\-)
-                                      (relative-generation profile number))
-                                     (else number)))))
-                 (if number
-                     (switch-to-generation profile number)
-                     (leave (_ "cannot switch to generation '~a'~%")
-                            pattern)))
-               (process-actions (alist-delete 'switch-generation opts)))
-              (_ #f))
-            opts))
-          ((and (assoc-ref opts 'delete-generations)
-                (not dry-run?))
-           (for-each
-            (match-lambda
-             (('delete-generations . pattern)
-              (delete-matching-generations (%store) profile pattern)
-
-              (process-actions
-               (alist-delete 'delete-generations opts)))
-             (_ #f))
-            opts))
-          ((assoc-ref opts 'manifest)
-           (let* ((file-name   (assoc-ref opts 'manifest))
-                  (user-module (make-user-module '((guix profiles)
-                                                   (gnu))))
-                  (manifest    (load* file-name user-module)))
-             (if (assoc-ref opts 'dry-run?)
-                 (format #t (_ "would install new manifest from '~a' with ~d entries~%")
-                         file-name (length (manifest-entries manifest)))
-                 (format #t (_ "installing new manifest from '~a' with ~d entries~%")
-                         file-name (length (manifest-entries manifest))))
-             (build-and-use-profile manifest)))
-          (else
-           (let* ((manifest    (profile-manifest profile))
-                  (install     (options->installable opts manifest))
-                  (remove      (options->removable opts manifest))
-                  (transaction (manifest-transaction (install install)
-                                                     (remove remove)))
-                  (new         (manifest-perform-transaction
-                                manifest transaction)))
-
-             (unless (and (null? install) (null? remove))
-               (show-manifest-transaction (%store) manifest transaction
-                                          #:dry-run? dry-run?)
-               (build-and-use-profile new))))))
-
-  (define (process-query opts)
-    ;; Process any query specified by OPTS.  Return #t when a query was
-    ;; actually processed, #f otherwise.
-    (let ((profile  (assoc-ref opts 'profile)))
-      (match (assoc-ref opts 'query)
-        (('list-generations pattern)
-         (define (list-generation number)
-           (unless (zero? number)
-             (let ((header (format #f (_ "Generation ~a\t~a") number
-                                   (date->string
-                                    (time-utc->date
-                                     (generation-time profile number))
-                                    "~b ~d ~Y ~T")))
-                   (current (generation-number profile)))
-               (if (= number current)
-                   (format #t (_ "~a\t(current)~%") header)
-                   (format #t "~a~%" header)))
-             (for-each (match-lambda
-                        (($ <manifest-entry> name version output location _)
-                         (format #t "  ~a\t~a\t~a\t~a~%"
-                                 name version output location)))
-
-                       ;; Show most recently installed packages last.
-                       (reverse
-                        (manifest-entries
-                         (profile-manifest
-                          (generation-file-name profile number)))))
-             (newline)))
-
-         (cond ((not (file-exists? profile)) ; XXX: race condition
-                (raise (condition (&profile-not-found-error
-                                   (profile profile)))))
-               ((string-null? pattern)
-                (for-each list-generation (profile-generations profile)))
-               ((matching-generations pattern profile)
-                =>
-                (lambda (numbers)
-                  (if (null-list? numbers)
-                      (exit 1)
-                      (leave-on-EPIPE
-                       (for-each list-generation numbers)))))
-               (else
-                (leave (_ "invalid syntax: ~a~%")
-                       pattern)))
-         #t)
-
-        (('list-installed regexp)
-         (let* ((regexp    (and regexp (make-regexp regexp)))
-                (manifest  (profile-manifest profile))
-                (installed (manifest-entries manifest)))
-           (leave-on-EPIPE
-            (for-each (match-lambda
-                       (($ <manifest-entry> name version output path _)
-                        (when (or (not regexp)
-                                  (regexp-exec regexp name))
-                          (format #t "~a\t~a\t~a\t~a~%"
-                                  name (or version "?") output path))))
-
-                      ;; Show most recently installed packages last.
-                      (reverse installed)))
-           #t))
-
-        (('list-available regexp)
-         (let* ((regexp    (and regexp (make-regexp regexp)))
-                (available (fold-packages
-                            (lambda (p r)
-                              (let ((n (package-name p)))
-                                (if (supported-package? p)
-                                    (if regexp
-                                        (if (regexp-exec regexp n)
-                                            (cons p r)
-                                            r)
-                                        (cons p r))
-                                    r)))
-                            '())))
-           (leave-on-EPIPE
-            (for-each (lambda (p)
-                        (format #t "~a\t~a\t~a\t~a~%"
-                                (package-name p)
-                                (package-version p)
-                                (string-join (package-outputs p) ",")
-                                (location->string (package-location p))))
-                      (sort available
-                            (lambda (p1 p2)
-                              (string<? (package-name p1)
-                                        (package-name p2))))))
-           #t))
-
-        (('search regexp)
-         (let ((regexp (make-regexp regexp regexp/icase)))
-           (leave-on-EPIPE
-            (for-each (cute package->recutils <> (current-output-port))
-                      (find-packages-by-description regexp)))
-           #t))
-
-        (('show requested-name)
-         (let-values (((name version)
-                       (package-name->name+version requested-name)))
-           (leave-on-EPIPE
-            (for-each (cute package->recutils <> (current-output-port))
-                      (find-packages-by-name name version)))
-           #t))
-
-        (('search-paths kind)
-         (let* ((manifest (profile-manifest profile))
-                (entries  (manifest-entries manifest))
-                (profile  (user-friendly-profile profile))
-                (settings (search-path-environment-variables entries profile
-                                                             (const #f)
-                                                             #:kind kind)))
-           (format #t "~{~a~%~}" settings)
-           #t))
-
-        (_ #f))))
-
   (let ((opts (parse-command-line args %options (list %default-options #f)
                                   #:argument-handler handle-argument)))
     (with-error-handling
@@ -1003,4 +833,4 @@ more information.~%"))
                              (if (assoc-ref opts 'bootstrap?)
                                  %bootstrap-guile
                                  (canonical-package guile-2.0)))))
-              (process-actions opts)))))))
+              (process-actions (%store) opts)))))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 56ee9acb18..a4824e4fd7 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts pull)
   #:use-module (guix ui)
+  #:use-module (guix utils)
   #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix config)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 6f7ca4a41b..a5834d12cc 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,7 +27,11 @@
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix upstream)
-  #:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
+  #:use-module (guix graph)
+  #:use-module (guix scripts graph)
+  #:use-module (guix monads)
+  #:use-module ((guix gnu-maintenance)
+                #:select (%gnu-updater %gnome-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
   #:use-module (guix gnupg)
@@ -41,7 +46,8 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs io ports)
-  #:export (guix-refresh))
+  #:export (guix-refresh
+            %updaters))
 
 
 ;;;
@@ -68,7 +74,16 @@
                             arg)))))
         (option '(#\t "type") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'updater (string->symbol arg) result)))
+                  (let* ((not-comma (char-set-complement (char-set #\,)))
+                         (names (map string->symbol
+                                     (string-tokenize arg not-comma))))
+                    (alist-cons 'updaters names result))))
+        (option '(#\L "list-updaters") #f #f
+                (lambda args
+                  (list-updaters-and-exit)))
+        (option '(#\e "expression") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'expression arg result)))
         (option '(#\l "list-dependent") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'list-dependent? #t result)))
@@ -105,12 +120,17 @@ When PACKAGE... is given, update only the specified packages.  Otherwise
 update all the packages of the distribution, or the subset thereof
 specified with `--select'.\n"))
   (display (_ "
+  -e, --expression=EXPR  consider the package EXPR evaluates to"))
+  (display (_ "
   -u, --update           update source files in place"))
   (display (_ "
   -s, --select=SUBSET    select all the packages in SUBSET, one of
                          `core' or `non-core'"))
   (display (_ "
-  -t, --type=UPDATER     restrict to updates from UPDATER--e.g., 'gnu'"))
+  -t, --type=UPDATER,... restrict to updates from the specified updaters
+                         (e.g., 'gnu')"))
+  (display (_ "
+  -L, --list-updaters    list available updaters and exit"))
   (display (_ "
   -l, --list-dependent   list top-level dependent packages that would need to
                          be rebuilt as a result of upgrading PACKAGE..."))
@@ -137,17 +157,62 @@ specified with `--select'.\n"))
 ;;; Updates.
 ;;;
 
+(define-syntax maybe-updater
+  ;; Helper macro for 'list-updaters'.
+  (syntax-rules (=>)
+    ((_ ((module => updater) rest ...) result)
+     (maybe-updater (rest ...)
+                    (let ((iface (false-if-exception
+                                  (resolve-interface 'module)))
+                          (tail  result))
+                      (if iface
+                          (cons (module-ref iface 'updater) tail)
+                          tail))))
+    ((_ (updater rest ...) result)
+     (maybe-updater (rest ...)
+                    (cons updater result)))
+    ((_ () result)
+     (reverse result))))
+
+(define-syntax-rule (list-updaters updaters ...)
+  "Expand to '(list UPDATERS ...)' but only the subset of UPDATERS that are
+either unconditional, or have their requirement met.
+
+A conditional updater has this form:
+
+  ((SOME MODULE) => UPDATER)
+
+meaning that UPDATER is added to the list if and only if (SOME MODULE) could
+be resolved at run time.
+
+This is a way to discard at macro expansion time updaters that depend on
+unavailable optional dependencies such as Guile-JSON."
+  (maybe-updater (updaters ...) '()))
+
 (define %updaters
   ;; List of "updaters" used by default.  They are consulted in this order.
-  (list %gnu-updater
-        %elpa-updater
-        %cran-updater))
+  (list-updaters %gnu-updater
+                 %gnome-updater
+                 %elpa-updater
+                 %cran-updater
+                 ((guix import pypi) => %pypi-updater)))
 
 (define (lookup-updater name)
   "Return the updater called NAME."
-  (find (lambda (updater)
-          (eq? name (upstream-updater-name updater)))
-        %updaters))
+  (or (find (lambda (updater)
+              (eq? name (upstream-updater-name updater)))
+            %updaters)
+      (leave (_ "~a: no such updater~%") name)))
+
+(define (list-updaters-and-exit)
+  "Display available updaters and exit."
+  (format #t (_ "Available updaters:~%"))
+  (for-each (lambda (updater)
+              (format #t "- ~a: ~a~%"
+                      (upstream-updater-name updater)
+                      (_ (upstream-updater-description updater))))
+            %updaters)
+  (exit 0))
 
 (define* (update-package store package updaters
                          #:key (key-download 'interactive))
@@ -177,6 +242,50 @@ downloaded and authenticated; not updating~%")
 
 
 ;;;
+;;; Dependents.
+;;;
+
+(define (all-packages)
+  "Return the list of all the distro's packages."
+  (fold-packages cons '()))
+
+(define (list-dependents packages)
+  "List all the things that would need to be rebuilt if PACKAGES are changed."
+  (with-store store
+    (run-with-store store
+      ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+      ;; because it includes implicit dependencies.
+      (mlet %store-monad ((edges (node-back-edges %bag-node-type
+                                                  (all-packages))))
+        (let* ((dependents (node-transitive-edges packages edges))
+               (covering   (filter (lambda (node)
+                                     (null? (edges node)))
+                                   dependents)))
+          (match dependents
+            (()
+             (format (current-output-port)
+                     (N_ "No dependents other than itself: ~{~a~}~%"
+                         "No dependents other than themselves: ~{~a~^ ~}~%"
+                         (length packages))
+                     (map package-full-name packages)))
+
+            ((x)
+             (format (current-output-port)
+                     (_ "A single dependent package: ~a~%")
+                     (package-full-name x)))
+            (lst
+             (format (current-output-port)
+                     (N_ "Building the following package would ensure ~d \
+dependent packages are rebuilt: ~*~{~a~^ ~}~%"
+                         "Building the following ~d packages would ensure ~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+                         (length covering))
+                     (length covering) (length dependents)
+                     (map package-full-name covering))))
+          (return #t))))))
+
+
+;;;
 ;;; Entry point.
 ;;;
 
@@ -193,15 +302,15 @@ downloaded and authenticated; not updating~%")
   (define (options->updaters opts)
     ;; Return the list of updaters to use.
     (match (filter-map (match-lambda
-                         (('updater . name)
-                          (lookup-updater name))
+                         (('updaters . names)
+                          (map lookup-updater names))
                          (_ #f))
                        opts)
       (()
        ;; Use the default updaters.
        %updaters)
-      (lst
-       lst)))
+      (lists
+       (concatenate lists))))
 
   (define (keep-newest package lst)
     ;; If a newer version of PACKAGE is already in LST, return LST; otherwise
@@ -248,6 +357,8 @@ update would trigger a complete rebuild."
                                 ;; Take either the specified version or the
                                 ;; latest one.
                                 (specification->package spec))
+                               (('expression . exp)
+                                (read/eval-package-expression exp))
                                (_ #f))
                              opts)
             (()                                   ; default to all packages
@@ -265,25 +376,7 @@ update would trigger a complete rebuild."
     (with-error-handling
       (cond
        (list-dependent?
-        (let* ((rebuilds (map package-full-name
-                              (package-covering-dependents packages)))
-               (total-dependents
-                (length (package-transitive-dependents packages))))
-          (if (= total-dependents 0)
-              (format (current-output-port)
-                      (N_ "No dependents other than itself: ~{~a~}~%"
-                          "No dependents other than themselves: ~{~a~^ ~}~%"
-                          (length packages))
-                      (map package-full-name packages))
-              (format (current-output-port)
-                      (N_ (N_ "A single dependent package: ~2*~{~a~}~%"
-                              "Building the following package would ensure ~d \
-dependent packages are rebuilt; ~*~{~a~^ ~}~%"
-                              total-dependents)
-                          "Building the following ~d packages would ensure ~d \
-dependent packages are rebuilt: ~{~a~^ ~}~%"
-                          (length rebuilds))
-                      (length rebuilds) total-dependents rebuilds))))
+        (list-dependents packages))
        (update?
         (let ((store (open-connection)))
           (parameterize ((%openpgp-key-server
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index 44ff92655b..e999cce1fd 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -252,8 +252,7 @@ Report the size of PACKAGE and its dependencies.\n"))
                   (show-version-and-exit "guix size")))))
 
 (define %default-options
-  `((system . ,(%current-system))
-    (substitute-urls . ,%default-substitute-urls)))
+  `((system . ,(%current-system))))
 
 
 ;;;
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 8967fa062e..01cc3f129e 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -72,6 +72,7 @@
             assert-valid-narinfo
 
             lookup-narinfos
+            lookup-narinfos/diverse
             read-narinfo
             write-narinfo
             guix-substitute))
@@ -474,12 +475,13 @@ may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
                             ".narinfo")))
     (build-request (string->uri url) #:method 'GET)))
 
-(define (http-multiple-get base-url requests proc)
+(define (http-multiple-get base-url proc seed requests)
   "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."
+response, passing it the request object, the response, a port from which to
+read the response body, and the previous result, starting with SEED, à la
+'fold'.  Return the final result."
   (let connect ((requests requests)
-                (result   '()))
+                (result   seed))
     ;; (format (current-error-port) "connecting (~a requests left)..."
     ;;         (length requests))
     (let ((p (open-socket-for-uri base-url)))
@@ -497,7 +499,7 @@ to read the response body.  Return the list of results."
           ((head tail ...)
            (let* ((resp   (read-response p))
                   (body   (response-body-port resp))
-                  (result (cons (proc head resp body) result)))
+                  (result (proc head resp body result)))
              ;; The server can choose to stop responding at any time, in which
              ;; case we have to try again.  Check whether that is the case.
              ;; Note that even upon "Connection: close", we can read from BODY.
@@ -536,7 +538,7 @@ if file doesn't exist, and the narinfo otherwise."
                 url (* 100. (/ done (length paths))))
         (set! done (+ 1 done)))))
 
-  (define (handle-narinfo-response request response port)
+  (define (handle-narinfo-response request response port result)
     (let ((len (response-content-length response)))
       ;; Make sure to read no more than LEN bytes since subsequent bytes may
       ;; belong to the next response.
@@ -545,7 +547,7 @@ if file doesn't exist, and the narinfo otherwise."
          (let ((narinfo (read-narinfo port url #:size len)))
            (cache-narinfo! url (narinfo-path narinfo) narinfo)
            (update-progress!)
-           narinfo))
+           (cons narinfo result)))
         ((404)                                     ; failure
          (let* ((path      (uri-path (request-uri request)))
                 (hash-part (string-drop-right path 8))) ; drop ".narinfo"
@@ -555,38 +557,45 @@ if file doesn't exist, and the narinfo otherwise."
            (cache-narinfo! url
                            (find (cut string-contains <> hash-part) paths)
                            #f)
-           (update-progress!))
-         #f)
+           (update-progress!)
+           result))
         (else                                      ; transient failure
          (if len
              (get-bytevector-n port len)
              (read-to-eof port))
-         #f))))
+         result))))
+
+  (define (do-fetch uri)
+    (case (and=> uri uri-scheme)
+      ((http)
+       (let ((requests (map (cut narinfo-request url <>) paths)))
+         (update-progress!)
+         (let ((result (http-multiple-get url
+                                          handle-narinfo-response '()
+                                          requests)))
+           (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 cache-info
     (download-cache-info url))
 
   (and cache-info
-       (string=? (cache-info-store-directory cache-info)
-                 (%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)))))))
+       (if (string=? (cache-info-store-directory cache-info)
+                     (%store-prefix))
+           (do-fetch (string->uri url))
+           (begin
+             (warning (_ "'~a' uses different store '~a'; ignoring it~%")
+                      url (cache-info-store-directory cache-info))
+             #f))))
 
 (define (lookup-narinfos cache paths)
   "Return the narinfos for PATHS, invoking the server at CACHE when no
@@ -596,7 +605,9 @@ information is available locally."
                          (let-values (((valid? value)
                                        (cached-narinfo cache path)))
                            (if valid?
-                               (values (cons value cached) missing)
+                               (if value
+                                   (values (cons value cached) missing)
+                                   (values cached missing))
                                (values cached (cons path missing)))))
                        '()
                        '()
@@ -606,11 +617,32 @@ information is available locally."
         (let ((missing (fetch-narinfos cache missing)))
           (append cached (or 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 (lookup-narinfos/diverse caches paths)
+  "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order.
+That is, when a cache lacks a narinfo, look it up in the next cache, and so
+on.  Return a list of narinfos for PATHS or a subset thereof."
+  (let loop ((caches caches)
+             (paths  paths)
+             (result '()))
+    (match paths
+      (()                                         ;we're done
+       result)
+      (_
+       (match caches
+         ((cache rest ...)
+          (let* ((narinfos (lookup-narinfos cache paths))
+                 (hits     (map narinfo-path narinfos))
+                 (missing  (lset-difference string=? paths hits))) ;XXX: perf
+            (loop rest missing (append narinfos result))))
+         (()                                      ;that's it
+          result))))))
+
+(define (lookup-narinfo caches path)
+  "Return the narinfo for PATH in CACHES, or #f when no substitute for PATH
+was found."
+  (match (lookup-narinfos/diverse caches (list path))
+    ((answer) answer)
+    (_        #f)))
 
 (define (remove-expired-cached-narinfos directory)
   "Remove expired narinfo entries from DIRECTORY.  The sole purpose of this
@@ -752,34 +784,34 @@ expected by the daemon."
           (or (narinfo-size narinfo) 0)))
 
 (define* (process-query command
-                        #:key cache-url acl)
+                        #:key cache-urls acl)
   "Reply to COMMAND, a query as written by the daemon to this process's
 standard input.  Use ACL as the access-control list against which to check
 authorized substitutes."
   (define (valid? obj)
-    (and (narinfo? obj) (valid-narinfo? obj acl)))
+    (valid-narinfo? obj acl))
 
   (match (string-tokenize command)
     (("have" paths ..1)
-     ;; Return the subset of PATHS available in CACHE-URL.
-     (let ((substitutable (lookup-narinfos cache-url paths)))
+     ;; Return the subset of PATHS available in CACHE-URLS.
+     (let ((substitutable (lookup-narinfos/diverse cache-urls paths)))
        (for-each (lambda (narinfo)
                    (format #t "~a~%" (narinfo-path narinfo)))
                  (filter valid? substitutable))
        (newline)))
     (("info" paths ..1)
-     ;; Reply info about PATHS if it's in CACHE-URL.
-     (let ((substitutable (lookup-narinfos cache-url paths)))
+     ;; Reply info about PATHS if it's in CACHE-URLS.
+     (let ((substitutable (lookup-narinfos/diverse cache-urls paths)))
        (for-each display-narinfo-data (filter valid? substitutable))
        (newline)))
     (wtf
      (error "unknown `--query' command" wtf))))
 
 (define* (process-substitution store-item destination
-                               #:key cache-url acl)
-  "Substitute STORE-ITEM (a store file name) from CACHE-URL, and write it to
+                               #:key cache-urls acl)
+  "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
 DESTINATION as a nar file.  Verify the substitute against ACL."
-  (let* ((narinfo (lookup-narinfo cache-url store-item))
+  (let* ((narinfo (lookup-narinfo cache-urls store-item))
          (uri     (narinfo-uri narinfo)))
     ;; Make sure it is signed and everything.
     (assert-valid-narinfo narinfo acl)
@@ -876,21 +908,16 @@ found."
         b
         first)))
 
-(define %cache-url
+(define %cache-urls
   (match (and=> (or* (find-daemon-option "untrusted-substitute-urls") ;client
                      (find-daemon-option "substitute-urls"))          ;admin
                 string-tokenize)
-    ((url)
-     url)
-    ((head tail ..1)
-     ;; Currently we don't handle multiple substitute URLs.
-     (warning (_ "these substitute URLs will not be used:~{ ~a~}~%")
-              tail)
-     head)
+    ((urls ...)
+     urls)
     (#f
      ;; This can only happen when this script is not invoked by the
      ;; daemon.
-     "http://hydra.gnu.org")))
+     '("http://hydra.gnu.org"))))
 
 (define (guix-substitute . args)
   "Implement the build daemon's substituter protocol."
@@ -901,20 +928,8 @@ found."
   ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
   ;; when we know we cannot substitute, but we must emit a newline on stdout
   ;; when everything is alright.
-  (let ((uri (string->uri %cache-url)))
-    (case (uri-scheme uri)
-      ((http)
-       ;; Exit gracefully if there's no network access.
-       (let ((host (uri-host uri)))
-         (catch 'getaddrinfo-error
-           (lambda ()
-             (getaddrinfo host))
-           (lambda (key error)
-             (warning (_ "failed to look up host '~a' (~a), \
-substituter disabled~%")
-                      host (gai-strerror error))
-             (exit 0)))))
-      (else #t)))
+  (when (null? %cache-urls)
+    (exit 0))
 
   ;; Say hello (see above.)
   (newline)
@@ -929,13 +944,13 @@ substituter disabled~%")
             (or (eof-object? command)
                 (begin
                   (process-query command
-                                 #:cache-url %cache-url
+                                 #:cache-urls %cache-urls
                                  #:acl acl)
                   (loop (read-line)))))))
        (("--substitute" store-path destination)
         ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
         (process-substitution store-path destination
-                              #:cache-url %cache-url
+                              #:cache-urls %cache-urls
                               #:acl (current-acl)))
        (("--version")
         (show-version-and-exit "guix substitute"))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b5da57a9ce..1407dc73fa 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -25,14 +25,17 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (guix monads)
+  #:use-module (guix records)
   #:use-module (guix profiles)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix build utils)
   #:use-module (gnu build install)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu system linux-container)
   #:use-module (gnu system vm)
   #:use-module (gnu system grub)
   #:use-module (gnu services)
@@ -41,6 +44,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:export (guix-system
@@ -186,6 +191,39 @@ the ownership of '~a' may be incorrect!~%")
 
 
 ;;;
+;;; Boot parameters
+;;;
+
+(define-record-type* <boot-parameters>
+  boot-parameters make-boot-parameters boot-parameters?
+  (label            boot-parameters-label)
+  (root-device      boot-parameters-root-device)
+  (kernel           boot-parameters-kernel)
+  (kernel-arguments boot-parameters-kernel-arguments))
+
+(define (read-boot-parameters port)
+  "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object or #f if the format is unrecognized."
+  (match (read port)
+    (('boot-parameters ('version 0)
+                       ('label label) ('root-device root)
+                       ('kernel linux)
+                       rest ...)
+     (boot-parameters
+      (label label)
+      (root-device root)
+      (kernel linux)
+      (kernel-arguments
+       (match (assq 'kernel-arguments rest)
+         ((_ args) args)
+         (#f       '())))))                       ;the old format
+    (x                                            ;unsupported format
+     (warning (_ "unrecognized boot parameters for '~a'~%")
+              system)
+     #f)))
+
+
+;;;
 ;;; Reconfiguration.
 ;;;
 
@@ -247,30 +285,22 @@ it atomically, and then run OS's activation script."
   "Return a list of 'menu-entry' for the generations of PROFILE."
   (define (system->grub-entry system number time)
     (unless-file-not-found
-     (call-with-input-file (string-append system "/parameters")
-       (lambda (port)
-         (match (read port)
-           (('boot-parameters ('version 0)
-                              ('label label) ('root-device root)
-                              ('kernel linux)
-                              rest ...)
-            (menu-entry
-             (label (string-append label " (#"
-                                   (number->string number) ", "
-                                   (seconds->string time) ")"))
-             (linux linux)
-             (linux-arguments
-              (cons* (string-append "--root=" root)
-                     #~(string-append "--system=" #$system)
-                     #~(string-append "--load=" #$system "/boot")
-                     (match (assq 'kernel-arguments rest)
-                       ((_ args) args)
-                       (#f       '()))))          ;old format
-             (initrd #~(string-append #$system "/initrd"))))
-           (_                                     ;unsupported format
-            (warning (_ "unrecognized boot parameters for '~a'~%")
-                     system)
-            #f))))))
+     (let ((file (string-append system "/parameters")))
+       (match (call-with-input-file file read-boot-parameters)
+         (($ <boot-parameters> label root kernel kernel-arguments)
+          (menu-entry
+           (label (string-append label " (#"
+                                 (number->string number) ", "
+                                 (seconds->string time) ")"))
+           (linux kernel)
+           (linux-arguments
+            (cons* (string-append "--root=" root)
+                   #~(string-append "--system=" #$system)
+                   #~(string-append "--load=" #$system "/boot")
+                   kernel-arguments))
+           (initrd #~(string-append #$system "/initrd"))))
+         (#f                                      ;invalid format
+          #f)))))
 
   (let* ((numbers (generation-numbers profile))
          (systems (map (cut generation-file-name profile <>)
@@ -327,6 +357,48 @@ list of services."
 
 
 ;;;
+;;; Generations.
+;;;
+
+(define* (display-system-generation number
+                                    #:optional (profile %system-profile))
+  "Display a summary of system generation NUMBER in a human-readable format."
+  (unless (zero? number)
+    (let* ((generation (generation-file-name profile number))
+           (param-file (string-append generation "/parameters"))
+           (params     (call-with-input-file param-file read-boot-parameters)))
+      (display-generation profile number)
+      (format #t (_ "  file name: ~a~%") generation)
+      (format #t (_ "  canonical file name: ~a~%") (readlink* generation))
+      (match params
+        (($ <boot-parameters> label root kernel)
+         ;; TRANSLATORS: Please preserve the two-space indentation.
+         (format #t (_ "  label: ~a~%") label)
+         (format #t (_ "  root device: ~a~%") root)
+         (format #t (_ "  kernel: ~a~%") kernel))
+        (_
+         #f)))))
+
+(define* (list-generations pattern #:optional (profile %system-profile))
+  "Display in a human-readable format all the system generations matching
+PATTERN, a string.  When PATTERN is #f, display all the system generations."
+  (cond ((not (file-exists? profile))             ; XXX: race condition
+         (raise (condition (&profile-not-found-error
+                            (profile profile)))))
+        ((string-null? pattern)
+         (for-each display-system-generation (profile-generations profile)))
+        ((matching-generations pattern profile)
+         =>
+         (lambda (numbers)
+           (if (null-list? numbers)
+               (exit 1)
+               (leave-on-EPIPE
+                (for-each display-system-generation numbers)))))
+        (else
+         (leave (_ "invalid syntax: ~a~%") pattern))))
+
+
+;;;
 ;;; Action.
 ;;;
 
@@ -336,6 +408,8 @@ list of services."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
+    ((container)
+     (container-script os #:mappings mappings))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -368,12 +442,20 @@ building anything."
                                                 #:full-boot? full-boot?
                                                 #:mappings mappings))
        (grub      (package->derivation grub))
-       (grub.cfg  (operating-system-grub.cfg os
-                                             (if (eq? 'init action)
-                                                 '()
-                                                 (previous-grub-entries))))
-       (drvs   -> (if (and grub? (memq action '(init reconfigure)))
-                      (list sys grub grub.cfg)
+       (grub.cfg  (if (eq? 'container action)
+                      (return #f)
+                      (operating-system-grub.cfg os
+                                                 (if (eq? 'init action)
+                                                     '()
+                                                     (previous-grub-entries)))))
+
+       ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
+       ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
+       ;; root.  See <http://bugs.gnu.org/21068>.
+       (drvs   -> (if (memq action '(init reconfigure))
+                      (if grub?
+                          (list sys grub.cfg grub)
+                          (list sys grub.cfg))
                       (list sys)))
        (%         (if derivations-only?
                       (return (for-each (compose println derivation-file-name)
@@ -416,10 +498,10 @@ building anything."
 (define (export-extension-graph os port)
   "Export the service extension graph of OS to PORT."
   (let* ((services (operating-system-services os))
-         (boot     (find (lambda (service)
-                           (eq? (service-kind service) boot-service-type))
+         (system   (find (lambda (service)
+                           (eq? (service-kind service) system-service-type))
                          services)))
-    (export-graph (list boot) (current-output-port)
+    (export-graph (list system) (current-output-port)
                   #:node-type (service-node-type services)
                   #:reverse-edges? #t)))
 
@@ -442,7 +524,7 @@ building anything."
 ;;;
 
 (define (show-help)
-  (display (_ "Usage: guix system [OPTION] ACTION FILE
+  (display (_ "Usage: guix system [OPTION] ACTION [FILE]
 Build the operating system declared in FILE according to ACTION.\n"))
   (newline)
   (display (_ "The valid values for ACTION are:\n"))
@@ -450,8 +532,12 @@ Build the operating system declared in FILE according to ACTION.\n"))
   (display (_ "\
    reconfigure      switch to a new operating system configuration\n"))
   (display (_ "\
+   list-generations list the system generations\n"))
+  (display (_ "\
    build            build the operating system without installing anything\n"))
   (display (_ "\
+   container        build a container that shares the host's store\n"))
+  (display (_ "\
    vm               build a virtual machine image that shares the host's store\n"))
   (display (_ "\
    vm-image         build a freestanding virtual machine image\n"))
@@ -488,19 +574,6 @@ Build the operating system declared in FILE according to ACTION.\n"))
   (newline)
   (show-bug-report-information))
 
-(define (specification->file-system-mapping spec writable?)
-  "Read the SPEC and return the corresponding <file-system-mapping>."
-  (let ((index (string-index spec #\=)))
-    (if index
-        (file-system-mapping
-         (source (substring spec 0 index))
-         (target (substring spec (+ 1 index)))
-         (writable? writable?))
-        (file-system-mapping
-         (source spec)
-         (target spec)
-         (writable? writable?)))))
-
 (define %options
   ;; Specifications of the command-line options.
   (cons* (option '(#\h "help") #f #f
@@ -563,6 +636,71 @@ Build the operating system declared in FILE according to ACTION.\n"))
 ;;; Entry point.
 ;;;
 
+(define (process-action action args opts)
+  "Process ACTION, a sub-command, with the arguments are listed in ARGS.
+ACTION must be one of the sub-commands that takes an operating system
+declaration as an argument (a file name.)  OPTS is the raw alist of options
+resulting from command-line parsing."
+  (let* ((file     (match args
+                     (() #f)
+                     ((x . _) x)))
+         (system   (assoc-ref opts 'system))
+         (os       (if file
+                       (load* file %user-module
+                              #:on-error (assoc-ref opts 'on-error))
+                       (leave (_ "no configuration file specified~%"))))
+
+         (dry?     (assoc-ref opts 'dry-run?))
+         (grub?    (assoc-ref opts 'install-grub?))
+         (target   (match args
+                     ((first second) second)
+                     (_ #f)))
+         (device   (and grub?
+                        (grub-configuration-device
+                         (operating-system-bootloader os)))))
+
+    (with-store store
+      (set-build-options-from-command-line store opts)
+
+      (run-with-store store
+        (mbegin %store-monad
+          (set-guile-for-build (default-guile))
+          (case action
+            ((extension-graph)
+             (export-extension-graph os (current-output-port)))
+            ((dmd-graph)
+             (export-dmd-graph os (current-output-port)))
+            (else
+             (perform-action action os
+                             #:dry-run? dry?
+                             #:derivations-only? (assoc-ref opts
+                                                            'derivations-only?)
+                             #:use-substitutes? (assoc-ref opts 'substitutes?)
+                             #:image-size (assoc-ref opts 'image-size)
+                             #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:mappings (filter-map (match-lambda
+                                                      (('file-system-mapping . m)
+                                                       m)
+                                                      (_ #f))
+                                                    opts)
+                             #:grub? grub?
+                             #:target target #:device device))))
+        #:system system))))
+
+(define (process-command command args opts)
+  "Process COMMAND, one of the 'guix system' sub-commands.  ARGS is its
+argument list and OPTS is the option alist."
+  (case command
+    ((list-generations)
+     ;; List generations.  No need to connect to the daemon, etc.
+     (let ((pattern (match args
+                      (() "")
+                      ((pattern) pattern)
+                      (x (leave (_ "wrong number of arguments~%"))))))
+       (list-generations pattern)))
+    (else
+     (process-action command args opts))))
+
 (define (guix-system . args)
   (define (parse-sub-command arg result)
     ;; Parse sub-command ARG and augment RESULT accordingly.
@@ -570,8 +708,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
         (alist-cons 'argument arg result)
         (let ((action (string->symbol arg)))
           (case action
-            ((build vm vm-image disk-image reconfigure init
-              extension-graph dmd-graph)
+            ((build container vm vm-image disk-image reconfigure init
+              extension-graph dmd-graph list-generations)
              (alist-cons 'action action result))
             (else (leave (_ "~a: unknown action~%") action))))))
 
@@ -599,7 +737,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
         (exit 1))
 
       (case action
-        ((build vm vm-image disk-image reconfigure)
+        ((build container vm vm-image disk-image reconfigure)
          (unless (= count 1)
            (fail)))
         ((init)
@@ -613,49 +751,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
                                          #:argument-handler
                                          parse-sub-command))
            (args     (option-arguments opts))
-           (file     (first args))
-           (action   (assoc-ref opts 'action))
-           (system   (assoc-ref opts 'system))
-           (os       (if file
-                         (load* file %user-module
-                                #:on-error (assoc-ref opts 'on-error))
-                         (leave (_ "no configuration file specified~%"))))
-
-           (dry?     (assoc-ref opts 'dry-run?))
-           (grub?    (assoc-ref opts 'install-grub?))
-           (target   (match args
-                       ((first second) second)
-                       (_ #f)))
-           (device   (and grub?
-                          (grub-configuration-device
-                           (operating-system-bootloader os))))
-
-           (store    (open-connection)))
-      (set-build-options-from-command-line store opts)
-
-      (run-with-store store
-        (mbegin %store-monad
-          (set-guile-for-build (default-guile))
-          (case action
-            ((extension-graph)
-             (export-extension-graph os (current-output-port)))
-            ((dmd-graph)
-             (export-dmd-graph os (current-output-port)))
-            (else
-             (perform-action action os
-                             #:dry-run? dry?
-                             #:derivations-only? (assoc-ref opts
-                                                            'derivations-only?)
-                             #:use-substitutes? (assoc-ref opts 'substitutes?)
-                             #:image-size (assoc-ref opts 'image-size)
-                             #:full-boot? (assoc-ref opts 'full-boot?)
-                             #:mappings (filter-map (match-lambda
-                                                      (('file-system-mapping . m)
-                                                       m)
-                                                      (_ #f))
-                                                    opts)
-                             #:grub? grub?
-                             #:target target #:device device))))
-        #:system system))))
+           (command  (assoc-ref opts 'action)))
+      (process-command command args opts))))
 
 ;;; system.scm ends here
diff --git a/guix/store.scm b/guix/store.scm
index c4e3573711..3c4d1c0058 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -53,6 +53,7 @@
             nix-protocol-error-status
 
             hash-algo
+            build-mode
 
             open-connection
             close-connection
@@ -129,7 +130,7 @@
             direct-store-path
             log-file))
 
-(define %protocol-version #x10c)
+(define %protocol-version #x10f)
 
 (define %worker-magic-1 #x6e697863)               ; "nixc"
 (define %worker-magic-2 #x6478696f)               ; "dxio"
@@ -188,6 +189,12 @@
   (sha1 2)
   (sha256 3))
 
+(define-enumerate-type build-mode
+  ;; store-api.hh
+  (normal 0)
+  (repair 1)
+  (check 2))
+
 (define-enumerate-type gc-action
   ;; store-api.hh
   (return-live 0)
@@ -328,11 +335,13 @@
   (status  nix-protocol-error-status))
 
 (define* (open-connection #:optional (file (%daemon-socket-file))
-                          #:key (reserve-space? #t))
+                          #:key (reserve-space? #t) cpu-affinity)
   "Connect to the daemon over the Unix-domain socket at FILE.  When
-RESERVE-SPACE? is true, instruct it to reserve a little bit of extra
-space on the file system so that the garbage collector can still
-operate, should the disk become full.  Return a server object."
+RESERVE-SPACE? is true, instruct it to reserve a little bit of extra space on
+the file system so that the garbage collector can still operate, should the
+disk become full.  When CPU-AFFINITY is true, it must be an integer
+corresponding to an OS-level CPU number to which the daemon's worker process
+for this connection will be pinned.  Return a server object."
   (let ((s (with-fluids ((%default-port-encoding #f))
              ;; This trick allows use of the `scm_c_read' optimization.
              (socket PF_UNIX SOCK_STREAM 0)))
@@ -355,8 +364,12 @@ operate, should the disk become full.  Return a server object."
                         (protocol-major v))
                   (begin
                     (write-int %protocol-version s)
-                    (if (>= (protocol-minor v) 11)
-                        (write-int (if reserve-space? 1 0) s))
+                    (when (>= (protocol-minor v) 14)
+                      (write-int (if cpu-affinity 1 0) s)
+                      (when cpu-affinity
+                        (write-int cpu-affinity s)))
+                    (when (>= (protocol-minor v) 11)
+                      (write-int (if reserve-space? 1 0) s))
                     (let ((s (%make-nix-server s
                                                (protocol-major v)
                                                (protocol-minor v)
@@ -491,6 +504,7 @@ encoding conversion errors."
 (define* (set-build-options server
                             #:key keep-failed? keep-going? fallback?
                             (verbosity 0)
+                            rounds                ;number of build rounds
                             (max-build-jobs 1)
                             timeout
                             (max-silent-time 3600)
@@ -501,11 +515,11 @@ encoding conversion errors."
                             (build-cores (current-processor-count))
                             (use-substitutes? #t)
 
-                            ;; Client-provided substitute URLs.  For
-                            ;; unprivileged clients, these are considered
-                            ;; "untrusted"; for "trusted" users, they override
-                            ;; the daemon's settings.
-                            (substitute-urls %default-substitute-urls))
+                            ;; Client-provided substitute URLs.  If it is #f,
+                            ;; the daemon's settings are used.  Otherwise, it
+                            ;; overrides the daemons settings; see 'guix
+                            ;; substitute'.
+                            (substitute-urls #f))
   ;; Must be called after `open-connection'.
 
   (define socket
@@ -533,7 +547,14 @@ encoding conversion errors."
       (let ((pairs `(,@(if timeout
                            `(("build-timeout" . ,(number->string timeout)))
                            '())
-                     ("substitute-urls" . ,(string-join substitute-urls)))))
+                     ,@(if substitute-urls
+                           `(("substitute-urls"
+                              . ,(string-join substitute-urls)))
+                           '())
+                     ,@(if rounds
+                           `(("build-repeat"
+                              . ,(number->string (max 0 (1- rounds)))))
+                           '()))))
         (send (string-pairs pairs))))
     (let loop ((done? (process-stderr server)))
       (or done? (process-stderr server)))))
@@ -628,12 +649,26 @@ bits are kept.  HASH-ALGO must be a string such as \"sha256\"."
               (hash-set! cache args path)
               path))))))
 
-(define-operation (build-things (string-list things))
-  "Build THINGS, a list of store items which may be either '.drv' files or
+(define build-things
+  (let ((build (operation (build-things (string-list things)
+                                        (integer mode))
+                          "Do it!"
+                          boolean))
+        (build/old (operation (build-things (string-list things))
+                              "Do it!"
+                              boolean)))
+    (lambda* (store things #:optional (mode (build-mode normal)))
+      "Build THINGS, a list of store items which may be either '.drv' files or
 outputs, and return when the worker is done building them.  Elements of THINGS
 that are not derivations can only be substituted and not built locally.
 Return #t on success."
-  boolean)
+      (if (>= (nix-server-minor-version store) 15)
+          (build store things mode)
+          (if (= mode (build-mode normal))
+              (build/old store things)
+              (raise (condition (&nix-protocol-error
+                                 (message "unsupported build mode")
+                                 (status  1)))))))))
 
 (define-operation (add-temp-root (store-path path))
   "Make PATH a temporary root for the duration of the current session.
diff --git a/guix/ui.scm b/guix/ui.scm
index fb8121c213..35a6671a07 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -34,6 +34,7 @@
   #:use-module (guix serialization)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix licenses) #:select (license? license-name))
+  #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -60,6 +61,7 @@
             warn-about-load-error
             show-version-and-exit
             show-bug-report-information
+            make-regexp*
             string->number*
             size->number
             show-derivation-outputs
@@ -72,7 +74,6 @@
             read/eval
             read/eval-package-expression
             location->string
-            switch-symlinks
             config-directory
             fill-paragraph
             texi->plain-text
@@ -80,8 +81,15 @@
             string->recutils
             package->recutils
             package-specification->name+version+output
+            specification->file-system-mapping
             string->generations
             string->duration
+            matching-generations
+            display-generation
+            display-profile-content
+            roll-back*
+            switch-to-generation*
+            delete-generation*
             run-guix-command
             run-guix
             program-name
@@ -343,6 +351,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
                  (list (strerror (car errno)) target)
                  (list errno)))))))
 
+(define (make-regexp* regexp . flags)
+  "Like 'make-regexp' but error out if REGEXP is invalid, reporting the error
+nicely."
+  (catch 'regular-expression-syntax
+    (lambda ()
+      (apply make-regexp regexp flags))
+    (lambda (key proc message . rest)
+      (leave (_ "'~a' is not a valid regular expression: ~a~%")
+             regexp message))))
+
 (define (string->number* str)
   "Like `string->number', but error out with an error message on failure."
   (or (string->number str)
@@ -513,17 +531,18 @@ error."
                (derivation-outputs derivation))))
 
 (define* (show-what-to-build store drv
-                             #:key dry-run? (use-substitutes? #t))
+                             #:key dry-run? (use-substitutes? #t)
+                             (mode (build-mode normal)))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
-derivations listed in DRV.  Return #t if there's something to build, #f
-otherwise.  When USE-SUBSTITUTES?, check and report what is prerequisites are
-available for download."
+derivations listed in DRV using MODE, a 'build-mode' value.  Return #t if
+there's something to build, #f otherwise.  When USE-SUBSTITUTES?, check and
+report what is prerequisites are available for download."
   (define substitutable?
     ;; Call 'substitutation-oracle' upfront so we don't end up launching the
     ;; substituter many times.  This makes a big difference, especially when
     ;; DRV is a long list as is the case with 'guix environment'.
     (if use-substitutes?
-        (substitution-oracle store drv)
+        (substitution-oracle store drv #:mode mode)
         (const #f)))
 
   (define (built-or-substitutable? drv)
@@ -537,6 +556,7 @@ available for download."
                           (let-values (((b d)
                                         (derivation-prerequisites-to-build
                                          store drv
+                                         #:mode mode
                                          #:substitutable? substitutable?)))
                             (values (append b build)
                                     (append d download))))
@@ -710,13 +730,6 @@ replacement if PORT is not Unicode-capable."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define (switch-symlinks link target)
-  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
-both when LINK already exists and when it does not."
-  (let ((pivot (string-append link ".new")))
-    (symlink target pivot)
-    (rename-file pivot link)))
-
 (define (config-directory)
   "Return the name of the configuration directory, after making sure that it
 exists.  Honor the XDG specs,
@@ -946,6 +959,119 @@ following patterns: \"1d\", \"1w\", \"1m\"."
            (hours->duration (* 24 30) match)))
         (else #f)))
 
+(define* (matching-generations str profile
+                               #:key (duration-relation <=))
+  "Return the list of available generations matching a pattern in STR.  See
+'string->generations' and 'string->duration' for the list of valid patterns.
+When STR is a duration pattern, return all the generations whose ctime has
+DURATION-RELATION with the current time."
+  (define (valid-generations lst)
+    (define (valid-generation? n)
+      (any (cut = n <>) (generation-numbers profile)))
+
+    (fold-right (lambda (x acc)
+                  (if (valid-generation? x)
+                      (cons x acc)
+                      acc))
+                '()
+                lst))
+
+  (define (filter-generations generations)
+    (match generations
+      (() '())
+      (('>= n)
+       (drop-while (cut > n <>)
+                   (generation-numbers profile)))
+      (('<= n)
+       (valid-generations (iota n 1)))
+      ((lst ..1)
+       (valid-generations lst))
+      (_ #f)))
+
+  (define (filter-by-duration duration)
+    (define (time-at-midnight time)
+      ;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and
+      ;; hours to zeros.
+      (let ((d (time-utc->date time)))
+         (date->time-utc
+          (make-date 0 0 0 0
+                     (date-day d) (date-month d)
+                     (date-year d) (date-zone-offset d)))))
+
+    (define generation-ctime-alist
+      (map (lambda (number)
+             (cons number
+                   (time-second
+                    (time-at-midnight
+                     (generation-time profile number)))))
+           (generation-numbers profile)))
+
+    (match duration
+      (#f #f)
+      (res
+       (let ((s (time-second
+                 (subtract-duration (time-at-midnight (current-time))
+                                    duration))))
+         (delete #f (map (lambda (x)
+                           (and (duration-relation s (cdr x))
+                                (first x)))
+                         generation-ctime-alist))))))
+
+  (cond ((string->generations str)
+         =>
+         filter-generations)
+        ((string->duration str)
+         =>
+         filter-by-duration)
+        (else #f)))
+
+(define (display-generation profile number)
+  "Display a one-line summary of generation NUMBER of PROFILE."
+  (unless (zero? number)
+    (let ((header (format #f (_ "Generation ~a\t~a") number
+                          (date->string
+                           (time-utc->date
+                            (generation-time profile number))
+                           "~b ~d ~Y ~T")))
+          (current (generation-number profile)))
+      (if (= number current)
+          (format #t (_ "~a\t(current)~%") header)
+          (format #t "~a~%" header)))))
+
+(define (display-profile-content profile number)
+  "Display the packages in PROFILE, generation NUMBER, in a human-readable
+way."
+  (for-each (match-lambda
+              (($ <manifest-entry> name version output location _)
+               (format #t "  ~a\t~a\t~a\t~a~%"
+                       name version output location)))
+
+            ;; Show most recently installed packages last.
+            (reverse
+             (manifest-entries
+              (profile-manifest (generation-file-name profile number))))))
+
+(define (display-generation-change previous current)
+  (format #t (_ "switched from generation ~a to ~a~%") previous current))
+
+(define (roll-back* store profile)
+  "Like 'roll-back', but display what is happening."
+  (call-with-values
+      (lambda ()
+        (roll-back store profile))
+    display-generation-change))
+
+(define (switch-to-generation* profile number)
+  "Like 'switch-generation', but display what is happening."
+  (let ((previous (switch-to-generation profile number)))
+    (display-generation-change previous number)))
+
+(define (delete-generation* store profile generation)
+  "Like 'delete-generation', but display what is going on."
+  (format #t (_ "deleting ~a~%")
+          (generation-file-name profile generation))
+  (delete-generation store profile generation))
+
 (define* (package-specification->name+version+output spec
                                                      #:optional (output "out"))
   "Parse package specification SPEC and return three value: the specified
@@ -966,6 +1092,23 @@ optionally contain a version number and an output name, as in these examples:
                  (package-name->name+version name)))
     (values name version sub-drv)))
 
+(define (specification->file-system-mapping spec writable?)
+  "Read the SPEC and return the corresponding <file-system-mapping>.  SPEC is
+a string of the form \"SOURCE\" or \"SOURCE=TARGET\".  The former specifies
+that SOURCE from the host should be mounted at SOURCE in the other system.
+The latter format specifies that SOURCE from the host should be mounted at
+TARGET in the other system."
+  (let ((index (string-index spec #\=)))
+    (if index
+        (file-system-mapping
+         (source (substring spec 0 index))
+         (target (substring spec (+ 1 index)))
+         (writable? writable?))
+        (file-system-mapping
+         (source spec)
+         (target spec)
+         (writable? writable?)))))
+
 
 ;;;
 ;;; Command-line option processing.
@@ -1050,6 +1193,9 @@ and signal handling has already been set up."
      (format (current-error-port)
              (_ "guix: unrecognized option '~a'~%") o)
      (show-guix-usage))
+    (("help" command)
+     (apply run-guix-command (string->symbol command)
+            '("--help")))
     (("help" args ...)
      (show-guix-help))
     ((command args ...)
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 9300113ac6..c62667dd01 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,12 +40,14 @@
             upstream-source-version
             upstream-source-urls
             upstream-source-signature-urls
+            upstream-source-archive-types
 
             coalesce-sources
 
             upstream-updater
             upstream-updater?
             upstream-updater-name
+            upstream-updater-description
             upstream-updater-predicate
             upstream-updater-latest
 
@@ -95,8 +98,9 @@ correspond to the same version."
                         (urls (append (upstream-source-urls release)
                                       (upstream-source-urls head)))
                         (signature-urls
-                         (append (upstream-source-signature-urls release)
-                                 (upstream-source-signature-urls head))))
+                         (let ((one (upstream-source-signature-urls release))
+                               (two (upstream-source-signature-urls release)))
+                           (and one two (append one two)))))
                        tail)
                  (cons release result)))
             (()
@@ -109,18 +113,19 @@ correspond to the same version."
 ;;; Auto-update.
 ;;;
 
-(define-record-type <upstream-updater>
-  (upstream-updater name pred latest)
+(define-record-type* <upstream-updater>
+  upstream-updater make-upstream-updater
   upstream-updater?
-  (name      upstream-updater-name)
-  (pred      upstream-updater-predicate)
-  (latest    upstream-updater-latest))
+  (name        upstream-updater-name)
+  (description upstream-updater-description)
+  (pred        upstream-updater-predicate)
+  (latest      upstream-updater-latest))
 
 (define (lookup-updater package updaters)
   "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
 them matches."
   (any (match-lambda
-         (($ <upstream-updater> _ pred latest)
+         (($ <upstream-updater> _ _ pred latest)
           (and (pred package) latest)))
        updaters))
 
diff --git a/guix/utils.scm b/guix/utils.scm
index 190b787185..7b589e68a8 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -29,7 +29,8 @@
   #:use-module (srfi srfi-39)
   #:use-module (srfi srfi-60)
   #:use-module (rnrs bytevectors)
-  #:use-module ((rnrs io ports) #:select (put-bytevector))
+  #:use-module (rnrs io ports)
+  #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module ((guix build utils)
                 #:select (dump-port package-name->name+version))
   #:use-module ((guix build syscalls) #:select (errno mkdtemp!))
@@ -74,6 +75,7 @@
             arguments-from-environment-variable
             file-extension
             file-sans-extension
+            switch-symlinks
             call-with-temporary-output-file
             call-with-temporary-directory
             with-atomic-file-output
@@ -82,13 +84,15 @@
             fold-tree-leaves
             split
             cache-directory
+            readlink*
 
             filtered-port
             compressed-port
             decompressed-port
             call-with-decompressed-port
             compressed-output-port
-            call-with-compressed-output-port))
+            call-with-compressed-output-port
+            canonical-newline-port))
 
 
 ;;;
@@ -556,6 +560,13 @@ minor version numbers from version-string."
         (substring file 0 dot)
         file)))
 
+(define (switch-symlinks link target)
+  "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
+both when LINK already exists and when it does not."
+  (let ((pivot (string-append link ".new")))
+    (symlink target pivot)
+    (rename-file pivot link)))
+
 (define* (string-replace-substring str substr replacement
                                    #:optional
                                    (start 0)
@@ -710,6 +721,61 @@ elements after E."
       (and=> (getenv "HOME")
              (cut string-append <> "/.cache/guix"))))
 
+(define (readlink* file)
+  "Call 'readlink' until the result is not a symlink."
+  (define %max-symlink-depth 50)
+
+  (let loop ((file  file)
+             (depth 0))
+    (define (absolute target)
+      (if (absolute-file-name? target)
+          target
+          (string-append (dirname file) "/" target)))
+
+    (if (>= depth %max-symlink-depth)
+        file
+        (call-with-values
+            (lambda ()
+              (catch 'system-error
+                (lambda ()
+                  (values #t (readlink file)))
+                (lambda args
+                  (let ((errno (system-error-errno args)))
+                    (if (or (= errno EINVAL))
+                        (values #f file)
+                        (apply throw args))))))
+          (lambda (success? target)
+            (if success?
+                (loop (absolute target) (+ depth 1))
+                file))))))
+
+(define (canonical-newline-port port)
+  "Return an input port that wraps PORT such that all newlines consist
+  of a single carriage return."
+  (define (get-position)
+    (if (port-has-port-position? port) (port-position port) #f))
+  (define (set-position! position)
+    (if (port-has-set-port-position!? port)
+        (set-port-position! position port)
+        #f))
+  (define (close) (close-port port))
+  (define (read! bv start n)
+    (let loop ((count 0)
+               (byte (get-u8 port)))
+      (cond ((eof-object? byte) count)
+            ((= count (- n 1))
+             (bytevector-u8-set! bv (+ start count) byte)
+             n)
+            ;; XXX: consume all LFs even if not followed by CR.
+            ((eqv? byte (char->integer #\return)) (loop count (get-u8 port)))
+            (else
+             (bytevector-u8-set! bv (+ start count) byte)
+             (loop (+ count 1) (get-u8 port))))))
+  (make-custom-binary-input-port "canonical-newline-port"
+                                 read!
+                                 get-position
+                                 set-position!
+                                 close))
 
 ;;;
 ;;; Source location.