Merge branch 'master' into staging

23 files changed, 707 insertions, 295 deletions

diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 1077215671..fc3d959ce7 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -68,14 +68,41 @@
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
                      (out-lib-build (string-append out "/lib/modules/build")))
+                ;; Delete some huge items that we probably don't need.
                 ;; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig,
                 ;; scripts, include, ".config".
                 (copy-recursively "." out-lib-build)
+                (for-each (lambda (name)
+                            (when (file-exists? name)
+                            (delete-file-recursively name)))
+                 (map (lambda (name)
+                        (string-append out-lib-build "/" name))
+                  '("arch" ; 137 MB
+                    ;"tools" ; 44 MB ; Note: is built by our 'build phase.
+                    "tools/testing" ; 14 MB
+                    "tools/perf" ; 17 MB
+                    "drivers" ; 600 MB
+                    "Documentation" ; 52 MB
+                    "fs" ; 43 MB
+                    "net" ; 33 MB
+                    "samples" ; 2 MB
+                    "sound"))) ; 40 MB
+                ;; Reinstate arch/**/dts since "scripts/dtc" depends on it.
+                ;; Reinstate arch/**/include directories.
+                ;; Reinstate arch/**/Makefile.
+                ;; Reinstate arch/**/module.lds.
+                (for-each
+                 (lambda (name)
+                   (mkdir-p (dirname (string-append out-lib-build "/" name)))
+                   (copy-recursively name
+                                     (string-append out-lib-build "/" name)))
+                 (append (find-files "arch" "^(dts|include)$" #:directories? #t)
+                         (find-files "arch" "^(Makefile|module.lds)$")))
                 (let* ((linux (assoc-ref inputs "linux")))
                   (install-file (string-append linux "/System.map")
                                 out-lib-build)
                   (let ((source (string-append linux "/Module.symvers")))
-                    (if (file-exists? source)
+                    (when (file-exists? source)
                         (install-file source out-lib-build))))
                 #t)))))))))
 
diff --git a/guix/describe.scm b/guix/describe.scm
index 6b9b219113..05bf99eb58 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,11 +43,17 @@
 ;;;
 ;;; Code:
 
+(define initial-program-arguments
+  ;; Save the initial program arguments.  This allows us to see the "real"
+  ;; 'guix' program, even if 'guix repl -s' calls 'set-program-arguments'
+  ;; later on.
+  (program-arguments))
+
 (define current-profile
   (mlambda ()
     "Return the profile (created by 'guix pull') the calling process lives in,
 or #f if this is not applicable."
-    (match (command-line)
+    (match initial-program-arguments
       ((program . _)
        (and (string-suffix? "/bin/guix" program)
             ;; Note: We want to do _lexical dot-dot resolution_.  Using ".."
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 9d3c52e783..25e4881d21 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -26,6 +26,8 @@
   #:use-module (guix derivations)
   #:use-module (guix grafts)
   #:use-module (guix utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -401,9 +403,15 @@ Here TARGET is bound to the cross-compilation triplet or #f."
 (define (true file stat) #t)
 
 (define* (%local-file file promise #:optional (name (basename file))
-                      #:key recursive? (select? true))
+                      #:key
+                      (literal? #t) location
+                      recursive? (select? true))
   ;; This intermediate procedure is part of our ABI, but the underlying
   ;; %%LOCAL-FILE is not.
+  (when (and (not literal?) (not (string-prefix? "/" file)))
+    (warning (and=> location source-properties->location)
+             (G_ "resolving '~a' relative to current directory~%")
+             file))
   (%%local-file file promise name recursive? select?))
 
 (define (absolute-file-name file directory)
@@ -443,9 +451,12 @@ appears."
                       rest ...))
       ((_ file rest ...)
        ;; Resolve FILE relative to the current directory.
-       #'(%local-file file
-                      (delay (absolute-file-name file (getcwd)))
-                      rest ...))
+       (with-syntax ((location (datum->syntax s (syntax-source s))))
+        #`(%local-file file
+                       (delay (absolute-file-name file (getcwd)))
+                       rest ...
+                       #:location 'location
+                       #:literal? #f)))
       ((_)
        #'(syntax-error "missing file name"))
       (id
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 7dfe771e41..da00019297 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -718,7 +718,7 @@ If #f use the function 'port-filename' to obtain it."
   (dependencies cabal-custom-setup-dependencies)) ; list of <cabal-dependency>
 
 (define (cabal-flags->alist flag-list)
-    "Retrun an alist associating the flag name to its default value from a
+    "Return an alist associating the flag name to its default value from a
 list of <cabal-flag> objects."
   (map (lambda (flag) (cons (cabal-flag-name flag) (cabal-flag-default flag)))
        flag-list))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index fd940415a2..514417f781 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -49,7 +49,7 @@
             cpan-release-license
             cpan-release-author
             cpan-release-version
-            cpan-release-modle
+            cpan-release-module
             cpan-release-distribution
             cpan-release-download-url
             cpan-release-abstract
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index 9cda3da006..6d9eb0a092 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -49,16 +49,19 @@
             condition))
 
 ;; Define a PEG parser for the opam format
-(define-peg-pattern comment none (and "#" (* STRCHR) "\n"))
+(define-peg-pattern comment none (and "#" (* COMMCHR) "\n"))
 (define-peg-pattern SP none (or " " "\n" comment))
 (define-peg-pattern SP2 body (or " " "\n"))
 (define-peg-pattern QUOTE none "\"")
 (define-peg-pattern QUOTE2 body "\"")
 (define-peg-pattern COLON none ":")
 ;; A string character is any character that is not a quote, or a quote preceded by a backslash.
+(define-peg-pattern COMMCHR none
+                    (or " " "!" "\\" "\"" (range #\# #\頋)))
 (define-peg-pattern STRCHR body
                     (or " " "!" "\n" (and (ignore "\\") "\"")
-                        (and (ignore "\\") "\\") (range #\# #\頋)))
+                        (ignore "\\\n") (and (ignore "\\") "\\")
+                        (range #\# #\頋)))
 (define-peg-pattern operator all (or "=" "!" "<" ">"))
 
 (define-peg-pattern records body (* (and (or record weird-record) (* SP))))
@@ -69,8 +72,12 @@
 (define-peg-pattern choice-pat all (and (ignore "(") (* SP) choice (* SP)  (ignore ")")))
 (define-peg-pattern choice body
   (or (and (or conditional-value ground-value) (* SP) (ignore "|") (* SP) choice)
+      group-pat
       conditional-value
       ground-value))
+(define-peg-pattern group-pat all
+                    (and (or conditional-value ground-value) (* SP) (ignore "&") (* SP)
+                         (or group-pat conditional-value ground-value)))
 (define-peg-pattern ground-value body (and (or multiline-string string-pat choice-pat list-pat var) (* SP)))
 (define-peg-pattern conditional-value all (and ground-value (* SP) condition))
 (define-peg-pattern string-pat all (and QUOTE (* STRCHR) QUOTE))
@@ -189,6 +196,7 @@ path to the repository."
     (('string-pat str) str)
     ;; Arbitrary select the first dependency
     (('choice-pat choice ...) (dependency->input (car choice)))
+    (('group-pat val ...) (map dependency->input val))
     (('conditional-value val condition)
      (if (native? condition) "" (dependency->input val)))))
 
@@ -196,7 +204,8 @@ path to the repository."
   (match dependency
     (('string-pat str) "")
     ;; Arbitrary select the first dependency
-    (('choice-pat choice ...) (dependency->input (car choice)))
+    (('choice-pat choice ...) (dependency->native-input (car choice)))
+    (('group-pat val ...) (map dependency->native-input val))
     (('conditional-value val condition)
      (if (native? condition) (dependency->input val) ""))))
 
@@ -204,7 +213,8 @@ path to the repository."
   (match dependency
     (('string-pat str) str)
     ;; Arbitrary select the first dependency
-    (('choice-pat choice ...) (dependency->input (car choice)))
+    (('choice-pat choice ...) (dependency->name (car choice)))
+    (('group-pat val ...) (map dependency->name val))
     (('conditional-value val condition)
      (dependency->name val))))
 
@@ -256,9 +266,10 @@ REPOSITORY is #f, from the official OPAM repository.  Return a 'package' sexp
 or #f on failure."
   (and-let* ((opam-file (opam-fetch name repository))
              (version (assoc-ref opam-file "version"))
-             (opam-content (assoc-ref opam-file "metadata"))
+             (opam-content (pk (assoc-ref opam-file "metadata")))
              (url-dict (metadata-ref opam-content "url"))
-             (source-url (metadata-ref url-dict "src"))
+             (source-url (or (metadata-ref url-dict "src")
+                             (metadata-ref url-dict "archive")))
              (requirements (metadata-ref opam-content "depends"))
              (dependencies (dependency-list->names requirements))
              (native-dependencies (depends->native-inputs requirements))
@@ -308,7 +319,7 @@ or #f on failure."
                     (filter
                       (lambda (name)
                         (not (member name '("dune" "jbuilder"))))
-		      dependencies))))))))
+                      dependencies))))))))
 
 (define (opam-recursive-import package-name)
   (recursive-import package-name #f
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index e04073d193..ee12108815 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -42,12 +42,12 @@
 (define %stackage-url "http://www.stackage.org")
 
 (define (lts-info-ghc-version lts-info)
-  "Retruns the version of the GHC compiler contained in LTS-INFO."
+  "Returns the version of the GHC compiler contained in LTS-INFO."
   (and=> (assoc-ref lts-info "snapshot")
          (cut assoc-ref <> "ghc")))
 
 (define (lts-info-packages lts-info)
-  "Retruns the alist of packages contained in LTS-INFO."
+  "Returns the alist of packages contained in LTS-INFO."
   (or (assoc-ref lts-info "packages") '()))
 
 (define (leave-with-message fmt . args)
diff --git a/guix/licenses.scm b/guix/licenses.scm
index bf72a33c92..5038f75638 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -14,6 +14,7 @@
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
+;;; Copyright © 2020 André Batista <nandre@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-9)
   #:export (license? license-name license-uri license-comment
             agpl1 agpl3 agpl3+
+            apsl2
             asl1.1 asl2.0
             boost1.0
             bsd-2 bsd-3 bsd-4
@@ -132,6 +134,11 @@
            "https://gnu.org/licenses/agpl.html"
            "https://gnu.org/licenses/why-affero-gpl.html"))
 
+(define apsl2
+  (license "APSL 2.0"
+           "https://directory.fsf.org/wiki/License:APSL-2.0"
+           "https://www.gnu.org/licenses/license-list.html#apsl2"))
+
 (define asl1.1
   (license "ASL 1.1"
            "http://directory.fsf.org/wiki/License:Apache1.1"
diff --git a/guix/openpgp.scm b/guix/openpgp.scm
index 33c851255b..153752ee73 100644
--- a/guix/openpgp.scm
+++ b/guix/openpgp.scm
@@ -110,7 +110,7 @@
 (define-alias fx/ /)
 (define-alias fxdiv quotient)
 (define-alias fxand logand)
-(define-alias fxbit-set? bit-set?)
+(define-inlinable (fxbit-set? n index) (bit-set? index n))
 (define-alias fxbit-field bit-field)
 (define-alias bitwise-bit-field bit-field)
 (define-alias fxarithmetic-shift-left ash)
diff --git a/guix/packages.scm b/guix/packages.scm
index 6598bd3149..4f2bb432be 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -422,6 +422,16 @@ name of its URI."
                                                        package)
                                                       16)))))
 
+(define-syntax-rule (package/inherit p overrides ...)
+  "Like (package (inherit P) OVERRIDES ...), except that the same
+transformation is done to the package replacement, if any.  P must be a bare
+identifier, and will be bound to either P or its replacement when evaluating
+OVERRIDES."
+  (let loop ((p p))
+    (package (inherit p)
+      overrides ...
+      (replacement (and=> (package-replacement p) loop)))))
+
 (define (package-upstream-name package)
   "Return the upstream name of PACKAGE, which could be different from the name
 it has in Guix."
@@ -968,10 +978,31 @@ packages they depend on, recursively."
                    (vhash-consq package #t visited)
                    (fold set-insert closure dependencies))))))))
 
-(define* (package-mapping proc #:optional (cut? (const #f)))
+(define (build-system-with-package-mapping bs rewrite)
+  "Return a variant of BS, a build system, that rewrites a bag's inputs by
+passing them through REWRITE, a procedure that takes an input tuplet and
+returns a \"rewritten\" input tuplet."
+  (define lower
+    (build-system-lower bs))
+
+  (define (lower* . args)
+    (let ((lowered (apply lower args)))
+      (bag
+        (inherit lowered)
+        (build-inputs (map rewrite (bag-build-inputs lowered)))
+        (host-inputs (map rewrite (bag-host-inputs lowered)))
+        (target-inputs (map rewrite (bag-target-inputs lowered))))))
+
+  (build-system
+    (inherit bs)
+    (lower lower*)))
+
+(define* (package-mapping proc #:optional (cut? (const #f))
+                          #:key deep?)
   "Return a procedure that, given a package, applies PROC to all the packages
 depended on and returns the resulting package.  The procedure stops recursion
-when CUT? returns true for a given package."
+when CUT? returns true for a given package.  When DEEP? is true, PROC is
+applied to implicit inputs as well."
   (define (rewrite input)
     (match input
       ((label (? package? package) outputs ...)
@@ -980,48 +1011,77 @@ when CUT? returns true for a given package."
       (_
        input)))
 
+  (define mapping-property
+    ;; Property indicating whether the package has already been processed.
+    (gensym " package-mapping-done"))
+
   (define replace
     (mlambdaq (p)
-      ;; Return a variant of P with PROC applied to P and its explicit
-      ;; dependencies, recursively.  Memoize the transformations.  Failing to
-      ;; do that, we would build a huge object graph with lots of duplicates,
-      ;; which in turns prevents us from benefiting from memoization in
-      ;; 'package-derivation'.
-      (let ((p (proc p)))
-        (package
-          (inherit p)
-          (location (package-location p))
-          (inputs (map rewrite (package-inputs p)))
-          (native-inputs (map rewrite (package-native-inputs p)))
-          (propagated-inputs (map rewrite (package-propagated-inputs p)))
-          (replacement (and=> (package-replacement p) proc))))))
+      ;; If P is the result of a previous call, return it.
+      (if (assq-ref (package-properties p) mapping-property)
+          p
+
+          ;; Return a variant of P with PROC applied to P and its explicit
+          ;; dependencies, recursively.  Memoize the transformations.  Failing
+          ;; to do that, we would build a huge object graph with lots of
+          ;; duplicates, which in turns prevents us from benefiting from
+          ;; memoization in 'package-derivation'.
+          (let ((p (proc p)))
+            (package
+              (inherit p)
+              (location (package-location p))
+              (build-system (if deep?
+                                (build-system-with-package-mapping
+                                 (package-build-system p) rewrite)
+                                (package-build-system p)))
+              (inputs (map rewrite (package-inputs p)))
+              (native-inputs (map rewrite (package-native-inputs p)))
+              (propagated-inputs (map rewrite (package-propagated-inputs p)))
+              (replacement (and=> (package-replacement p) replace))
+              (properties `((,mapping-property . #t)
+                            ,@(package-properties p))))))))
 
   replace)
 
 (define* (package-input-rewriting replacements
-                                  #:optional (rewrite-name identity))
+                                  #:optional (rewrite-name identity)
+                                  #:key (deep? #t))
   "Return a procedure that, when passed a package, replaces its direct and
-indirect dependencies (but not its implicit inputs) according to REPLACEMENTS.
-REPLACEMENTS is a list of package pairs; the first element of each pair is the
-package to replace, and the second one is the replacement.
+indirect dependencies, including implicit inputs when DEEP? is true, according
+to REPLACEMENTS.  REPLACEMENTS is a list of package pairs; the first element
+of each pair is the package to replace, and the second one is the replacement.
 
 Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
 package and returns its new name after rewrite."
-  (define (rewrite p)
-    (match (assq-ref replacements p)
-      (#f  (package
-             (inherit p)
-             (name (rewrite-name (package-name p)))))
-      (new new)))
-
-  (package-mapping rewrite (cut assq <> replacements)))
+  (define replacement-property
+    ;; Property to tag right-hand sides in REPLACEMENTS.
+    (gensym " package-replacement"))
 
-(define (package-input-rewriting/spec replacements)
+  (define (rewrite p)
+    (if (assq-ref (package-properties p) replacement-property)
+        p
+        (match (assq-ref replacements p)
+          (#f  (package/inherit p
+                 (name (rewrite-name (package-name p)))))
+          (new (if deep?
+                   (package/inherit new
+                     (properties `((,replacement-property . #t)
+                                   ,@(package-properties new))))
+                   new)))))
+
+  (define (cut? p)
+    (or (assq-ref (package-properties p) replacement-property)
+        (assq-ref replacements p)))
+
+  (package-mapping rewrite cut?
+                   #:deep? deep?))
+
+(define* (package-input-rewriting/spec replacements #:key (deep? #t))
   "Return a procedure that, given a package, applies the given REPLACEMENTS to
-all the package graph (excluding implicit inputs).  REPLACEMENTS is a list of
-spec/procedures pair; each spec is a package specification such as \"gcc\" or
-\"guile@2\", and each procedure takes a matching package and returns a
-replacement for that package."
+all the package graph, including implicit inputs unless DEEP? is false.
+REPLACEMENTS is a list of spec/procedures pair; each spec is a package
+specification such as \"gcc\" or \"guile@2\", and each procedure takes a
+matching package and returns a replacement for that package."
   (define table
     (fold (lambda (replacement table)
             (match replacement
@@ -1046,22 +1106,27 @@ replacement for that package."
                  (package-name package)
                  table))
 
-  (define (rewrite package)
-    (match (find-replacement package)
-      (#f package)
-      (proc (proc package))))
-
-  (package-mapping rewrite find-replacement))
+  (define replacement-property
+    (gensym " package-replacement"))
 
-(define-syntax-rule (package/inherit p overrides ...)
-  "Like (package (inherit P) OVERRIDES ...), except that the same
-transformation is done to the package replacement, if any.  P must be a bare
-identifier, and will be bound to either P or its replacement when evaluating
-OVERRIDES."
-  (let loop ((p p))
-    (package (inherit p)
-      overrides ...
-      (replacement (and=> (package-replacement p) loop)))))
+  (define (rewrite p)
+    (if (assq-ref (package-properties p) replacement-property)
+        p
+        (match (find-replacement p)
+          (#f p)
+          (proc
+           (let ((new (proc p)))
+             ;; Mark NEW as already processed.
+             (package/inherit new
+               (properties `((,replacement-property . #t)
+                             ,@(package-properties new)))))))))
+
+  (define (cut? p)
+    (or (assq-ref (package-properties p) replacement-property)
+        (find-replacement p)))
+
+  (package-mapping rewrite cut?
+                   #:deep? deep?))
 
 
 ;;;
diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index 37e6cef53c..45f62f6ebc 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -22,9 +22,16 @@
   #:use-module (gcrypt pk-crypto)
   #:use-module (guix pki)
   #:use-module (guix ui)
+  #:use-module (guix diagnostics)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 iconv)
   #:export (guix-authenticate))
 
 ;;; Commentary:
@@ -39,42 +46,100 @@
   ;; Read a gcrypt sexp from a port and return it.
   (compose string->canonical-sexp read-string))
 
-(define (sign-with-key key-file sha256)
-  "Sign the hash SHA256 (a bytevector) with KEY-FILE, and write an sexp that
-includes both the hash and the actual signature."
-  (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
-         (public-key (if (string-suffix? ".sec" key-file)
-                         (call-with-input-file
+(define (load-key-pair key-file)
+  "Load the key pair whose secret key lives at KEY-FILE.  Return a pair of
+canonical sexps representing those keys."
+  (catch 'system-error
+    (lambda ()
+      (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
+             (public-key (call-with-input-file
                              (string-append (string-drop-right key-file 4)
                                             ".pub")
-                           read-canonical-sexp)
-                         (leave
-                          (G_ "cannot find public key for secret key '~a'~%")
-                          key-file)))
-         (data       (bytevector->hash-data sha256
-                                            #:key-type (key-type public-key)))
-         (signature  (signature-sexp data secret-key public-key)))
-    (display (canonical-sexp->string signature))
-    #t))
-
-(define (validate-signature signature)
+                           read-canonical-sexp)))
+        (cons public-key secret-key)))
+    (lambda args
+      (let ((errno (system-error-errno args)))
+        (raise
+         (formatted-message
+          (G_ "failed to load key pair at '~a': ~a~%")
+          key-file (strerror errno)))))))
+
+(define (sign-with-key public-key secret-key sha256)
+  "Sign the hash SHA256 (a bytevector) with SECRET-KEY (a canonical sexp), and
+return the signature as a canonical sexp that includes SHA256, PUBLIC-KEY, and
+the actual signature."
+  (let ((data (bytevector->hash-data sha256
+                                     #:key-type (key-type public-key))))
+    (signature-sexp data secret-key public-key)))
+
+(define (validate-signature signature acl)
   "Validate SIGNATURE, a canonical sexp.  Check whether its public key is
-authorized, verify the signature, and print the signed data to stdout upon
-success."
+authorized in ACL, verify the signature, and return the signed data (a
+bytevector) upon success."
   (let* ((subject (signature-subject signature))
          (data    (signature-signed-data signature)))
     (if (and data subject)
-        (if (authorized-key? subject)
+        (if (authorized-key? subject acl)
             (if (valid-signature? signature)
-                (let ((hash (hash-data->bytevector data)))
-                  (display (bytevector->base16-string hash))
-                  #t)                              ; success
-                (leave (G_ "error: invalid signature: ~a~%")
-                       (canonical-sexp->string signature)))
-            (leave (G_ "error: unauthorized public key: ~a~%")
-                   (canonical-sexp->string subject)))
-        (leave (G_ "error: corrupt signature data: ~a~%")
-               (canonical-sexp->string signature)))))
+                (hash-data->bytevector data)      ; success
+                (raise
+                 (formatted-message (G_ "invalid signature: ~a")
+                                    (canonical-sexp->string signature))))
+            (raise
+             (formatted-message (G_ "unauthorized public key: ~a")
+                                (canonical-sexp->string subject))))
+        (raise
+         (formatted-message (G_ "corrupt signature data: ~a")
+                            (canonical-sexp->string signature))))))
+
+(define (read-command port)
+  "Read a command from PORT and return the command and arguments as a list of
+strings.  Return the empty list when the end-of-file is reached.
+
+Commands are newline-terminated and must look something like this:
+
+  COMMAND 3:abc 5:abcde 1:x
+
+where COMMAND is an alphanumeric sequence and the remainder is the command
+arguments.  Each argument is written as its length (in characters), followed
+by colon, followed by the given number of characters."
+  (define (consume-whitespace port)
+    (let ((chr (lookahead-u8 port)))
+      (when (eqv? chr (char->integer #\space))
+        (get-u8 port)
+        (consume-whitespace port))))
+
+  (match (read-delimited " \t\n\r" port)
+    ((? eof-object?)
+     '())
+    (command
+     (let loop ((result (list command)))
+       (consume-whitespace port)
+       (let ((next (lookahead-u8 port)))
+         (cond ((eqv? next (char->integer #\newline))
+                (get-u8 port)
+                (reverse result))
+               ((eof-object? next)
+                (reverse result))
+               (else
+                (let* ((len (string->number (read-delimited ":" port)))
+                       (str (bytevector->string
+                             (get-bytevector-n port len)
+                             "ISO-8859-1" 'error)))
+                  (loop (cons str result))))))))))
+
+(define-syntax define-enumerate-type              ;TODO: factorize
+  (syntax-rules ()
+    ((_ name->int (name id) ...)
+     (define-syntax name->int
+       (syntax-rules (name ...)
+         ((_ name) id) ...)))))
+
+;; Codes used when reply to requests.
+(define-enumerate-type reply-code
+  (success 0)
+  (command-not-found 404)
+  (command-failed 500))
 
 
 ;;;
@@ -85,6 +150,26 @@ success."
   (category internal)
   (synopsis "sign or verify signatures on normalized archives (nars)")
 
+  (define (send-reply code str)
+    ;; Send CODE and STR as a reply to our client.
+    (let ((bv (string->bytevector str "ISO-8859-1" 'error)))
+      (format #t "~a ~a:" code (bytevector-length bv))
+      (put-bytevector (current-output-port) bv)
+      (force-output (current-output-port))))
+
+  (define (call-with-reply thunk)
+    ;; Send a reply for the result of THUNK or for any exception raised during
+    ;; its execution.
+    (guard (c ((formatted-message? c)
+               (send-reply (reply-code command-failed)
+                           (apply format #f
+                                  (G_ (formatted-message-string c))
+                                  (formatted-message-arguments c)))))
+      (send-reply (reply-code success) (thunk))))
+
+  (define-syntax-rule (with-reply exp ...)
+    (call-with-reply (lambda () exp ...)))
+
   ;; Signature sexps written to stdout may contain binary data, so force
   ;; ISO-8859-1 encoding so that things are not mangled.  See
   ;; <http://bugs.gnu.org/17312> for details.
@@ -95,21 +180,46 @@ success."
   (with-fluids ((%default-port-encoding "ISO-8859-1")
                 (%default-port-conversion-strategy 'error))
     (match args
-      (("sign" key-file hash)
-       (sign-with-key key-file (base16-string->bytevector hash)))
-      (("verify" signature-file)
-       (call-with-input-file signature-file
-         (lambda (port)
-           (validate-signature (string->canonical-sexp
-                                (read-string port))))))
-
       (("--help")
        (display (G_ "Usage: guix authenticate OPTION...
-Sign or verify the signature on the given file.  This tool is meant to
-be used internally by 'guix-daemon'.\n")))
+Sign data or verify signatures.  This tool is meant to be used internally by
+'guix-daemon'.\n")))
       (("--version")
        (show-version-and-exit "guix authenticate"))
-      (else
-       (leave (G_ "wrong arguments"))))))
+      (()
+       (let ((acl (current-acl)))
+         (let loop ((key-pairs vlist-null))
+           ;; Read a request on standard input and reply.
+           (match (read-command (current-input-port))
+             (("sign" signing-key (= base16-string->bytevector hash))
+              (let* ((key-pairs keys
+                                (match (vhash-assoc signing-key key-pairs)
+                                  ((_ . keys)
+                                   (values key-pairs keys))
+                                  (#f
+                                   (let ((keys (load-key-pair signing-key)))
+                                     (values (vhash-cons signing-key keys
+                                                         key-pairs)
+                                             keys))))))
+                (with-reply (canonical-sexp->string
+                             (match keys
+                               ((public . secret)
+                                (sign-with-key public secret hash)))))
+                (loop key-pairs)))
+             (("verify" signature)
+              (with-reply (bytevector->base16-string
+                           (validate-signature
+                            (string->canonical-sexp signature)
+                            acl)))
+              (loop key-pairs))
+             (()
+              (exit 0))
+             (commands
+              (warning (G_ "~s: invalid command; ignoring~%") commands)
+              (send-reply (reply-code command-not-found)
+                          "invalid command")
+              (loop key-pairs))))))
+      (_
+       (leave (G_ "wrong arguments~%"))))))
 
 ;;; authenticate.scm ends here
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 25418661b9..72a5d46347 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -38,6 +38,7 @@
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix profiles)
+  #:use-module (guix diagnostics)
   #:autoload   (guix http-client) (http-fetch http-get-error?)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -46,6 +47,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
   #:autoload   (guix download) (download-to-store)
@@ -61,6 +63,7 @@
 
             %transformation-options
             options->transformation
+            manifest-entry-with-transformations
             show-transformation-options-help
 
             guix-build
@@ -393,6 +396,25 @@ a checkout of the Git repository at the given URL."
         (rewrite obj)
         obj)))
 
+(define (transform-package-tests specs)
+  "Return a procedure that, when passed a package, sets #:tests? #f in its
+'arguments' field."
+  (define (package-without-tests p)
+    (package/inherit p
+      (arguments
+       (substitute-keyword-arguments (package-arguments p)
+         ((#:tests? _ #f) #f)))))
+
+  (define rewrite
+    (package-input-rewriting/spec (map (lambda (spec)
+                                         (cons spec package-without-tests))
+                                       specs)))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (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
@@ -403,7 +425,16 @@ a checkout of the Git repository at the given URL."
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
     (with-commit . ,transform-package-source-commit)
-    (with-git-url . ,transform-package-source-git-url)))
+    (with-git-url . ,transform-package-source-git-url)
+    (without-tests . ,transform-package-tests)))
+
+(define (transformation-procedure key)
+  "Return the transformation procedure associated with KEY, a symbol such as
+'with-source', or #f if there is none."
+  (any (match-lambda
+         ((k . proc)
+          (and (eq? k key) proc)))
+       %transformations))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -423,11 +454,13 @@ a checkout of the Git repository at the given URL."
           (option '("with-commit") #t #f
                   (parser 'with-commit))
           (option '("with-git-url") #t #f
-                  (parser 'with-git-url)))))
+                  (parser 'with-git-url))
+          (option '("without-tests") #t #f
+                  (parser 'without-tests)))))
 
 (define (show-transformation-options-help)
   (display (G_ "
-      --with-source=SOURCE
+      --with-source=[PACKAGE=]SOURCE
                          use SOURCE when building the corresponding package"))
   (display (G_ "
       --with-input=PACKAGE=REPLACEMENT
@@ -443,7 +476,10 @@ a checkout of the Git repository at the given URL."
                          build PACKAGE from COMMIT"))
   (display (G_ "
       --with-git-url=PACKAGE=URL
-                         build PACKAGE from the repository at URL")))
+                         build PACKAGE from the repository at URL"))
+  (display (G_ "
+      --without-tests=PACKAGE
+                         build PACKAGE without running its tests")))
 
 
 (define (options->transformation opts)
@@ -454,32 +490,69 @@ derivation, etc.), applies the transformations specified by OPTS."
     ;; order in which they appear on the command line.
     (filter-map (match-lambda
                   ((key . value)
-                   (match (any (match-lambda
-                                 ((k . proc)
-                                  (and (eq? k key) proc)))
-                               %transformations)
+                   (match (transformation-procedure key)
                      (#f
                       #f)
                      (transform
                       ;; XXX: We used to pass TRANSFORM a list of several
                       ;; arguments, but we now pass only one, assuming that
                       ;; transform composes well.
-                      (cons key (transform (list value)))))))
+                      (list key value (transform (list value)))))))
                 (reverse opts)))
 
+  (define (package-with-transformation-properties p)
+    (package/inherit p
+      (properties `((transformations
+                     . ,(map (match-lambda
+                               ((key value _)
+                                (cons key value)))
+                             applicable))
+                    ,@(package-properties p)))))
+
   (lambda (store obj)
-    (fold (match-lambda*
-            (((name . transform) obj)
-             (let ((new (transform store obj)))
-               (when (eq? new obj)
-                 (warning (G_ "transformation '~a' had no effect on ~a~%")
-                          name
-                          (if (package? obj)
-                              (package-full-name obj)
-                              obj)))
-               new)))
-          obj
-          applicable)))
+    (define (tagged-object new)
+      (if (and (not (eq? obj new))
+               (package? new) (not (null? applicable)))
+          (package-with-transformation-properties new)
+          new))
+
+    (tagged-object
+     (fold (match-lambda*
+             (((name value transform) obj)
+              (let ((new (transform store obj)))
+                (when (eq? new obj)
+                  (warning (G_ "transformation '~a' had no effect on ~a~%")
+                           name
+                           (if (package? obj)
+                               (package-full-name obj)
+                               obj)))
+                new)))
+           obj
+           applicable))))
+
+(define (package-transformations package)
+  "Return the transformations applied to PACKAGE according to its properties."
+  (match (assq-ref (package-properties package) 'transformations)
+    (#f '())
+    (transformations transformations)))
+
+(define (manifest-entry-with-transformations entry)
+  "Return ENTRY with an additional 'transformations' property if it's not
+already there."
+  (let ((properties (manifest-entry-properties entry)))
+    (if (assq 'transformations properties)
+        entry
+        (let ((item (manifest-entry-item entry)))
+          (manifest-entry
+            (inherit entry)
+            (properties
+             (match (and (package? item)
+                         (package-transformations item))
+               ((or #f '())
+                properties)
+               (transformations
+                `((transformations . ,transformations)
+                  ,@properties)))))))))
 
 
 ;;;
@@ -805,7 +878,28 @@ must be one of 'package', 'all', or 'transitive'~%")
 build---packages, gexps, derivations, and so on."
   (define (validate-type x)
     (unless (or (derivation? x) (file-like? x) (gexp? x) (procedure? x))
-      (leave (G_ "~s: not something we can build~%") x)))
+      (raise (make-compound-condition
+               (formatted-message (G_ "~s: not something we can build~%") x)
+               (condition
+                (&fix-hint
+                 (hint
+                   (if (unspecified? x)
+                       (G_ "If you build from a file, make sure the last Scheme
+expression returns a package value.  @code{define-public} defines a variable,
+but returns @code{#<unspecified>}.  To fix this, add a Scheme expression at
+the end of the file that consists only of the package's variable name you
+defined, as in this example:
+
+@example
+(define-public my-package
+  (package
+    ...))
+
+my-package
+@end example")
+                       (G_ "If you build from a file, make sure the last
+Scheme expression returns a package, gexp, derivation or a list of such
+values.")))))))))
 
   (define (ensure-list x)
     (let ((lst (match x
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ad50281eb2..085f11a9d4 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -34,6 +34,7 @@
   #:use-module (guix scripts build)
   #:use-module (gnu build linux-container)
   #:use-module (gnu build accounts)
+  #:use-module ((guix build syscalls) #:select (set-network-interface-up))
   #:use-module (gnu system linux-container)
   #:use-module (gnu system file-systems)
   #:use-module (gnu packages)
@@ -549,6 +550,16 @@ WHILE-LIST."
             (write-passwd (list passwd))
             (write-group groups)
 
+            (unless network?
+              ;; When isolated from the network, provide a minimal /etc/hosts
+              ;; to resolve "localhost".
+              (call-with-output-file "/etc/hosts"
+                (lambda (port)
+                  (display "127.0.0.1 localhost\n" port)))
+
+              ;; Allow local AF_INET communications.
+              (set-network-interface-up "lo"))
+
             ;; For convenience, start in the user's current working
             ;; directory or, if unmapped, the home directory.
             (chdir (if map-cwd?
@@ -564,7 +575,11 @@ WHILE-LIST."
             (primitive-exit/status
              ;; A container's environment is already purified, so no need to
              ;; request it be purified again.
-             (launch-environment command profile manifest #:pure? #f)))
+             (launch-environment command
+                                 (if link-profile?
+                                     (string-append home-dir "/.guix-profile")
+                                     profile)
+                                 manifest #:pure? #f)))
           #:guest-uid uid
           #:guest-gid gid
           #:namespaces (if network?
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 710e786a79..906dca24b1 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -49,7 +49,7 @@
 Import and convert the Hackage package for PACKAGE-NAME.  If PACKAGE-NAME
 includes a suffix constituted by a at-sign followed by a numerical version (as
 used with Guix packages), then a definition for the specified version of the
-package will be generated.  If no version suffix is pecified, then the
+package will be generated.  If no version suffix is specified, then the
 generated package definition will correspond to the latest available
 version.\n"))
   (display (G_ "
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 379e6a3ac6..0b66da01f9 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -817,11 +817,17 @@ last resort for relocation."
 
                             (string-append "-DLOADER_AUDIT_MODULE=\""
                                            #$(audit-module) "\"")
+
+                            ;; XXX: Normally (runpath #$(audit-module)) is
+                            ;; enough.  However, to work around
+                            ;; <https://sourceware.org/bugzilla/show_bug.cgi?id=26634>
+                            ;; (glibc <= 2.32), pass the whole search path of
+                            ;; PROGRAM, which presumably is a superset of that
+                            ;; of the audit module.
                             (string-append "-DLOADER_AUDIT_RUNPATH={ "
                                            (string-join
                                             (map object->string
-                                                 (runpath
-                                                  #$(audit-module)))
+                                                 (runpath program))
                                             ", " 'suffix)
                                            "NULL }")
                             (if gconv
@@ -1134,19 +1140,24 @@ Create a bundle of PACKAGE.\n"))
                manifest))
             identity))
 
+      (define (with-transformations manifest)
+        (map-manifest-entries manifest-entry-with-transformations
+                              manifest))
+
       (with-provenance
-       (cond
-        ((and (not (null? manifests)) (not (null? packages)))
-         (leave (G_ "both a manifest and a package list were given~%")))
-        ((not (null? manifests))
-         (concatenate-manifests
-          (map (lambda (file)
-                 (let ((user-module (make-user-module
-                                     '((guix profiles) (gnu)))))
-                   (load* file user-module)))
-               manifests)))
-        (else
-         (packages->manifest packages))))))
+       (with-transformations
+        (cond
+         ((and (not (null? manifests)) (not (null? packages)))
+          (leave (G_ "both a manifest and a package list were given~%")))
+         ((not (null? manifests))
+          (concatenate-manifests
+           (map (lambda (file)
+                  (let ((user-module (make-user-module
+                                      '((guix profiles) (gnu)))))
+                    (load* file user-module)))
+                manifests)))
+         (else
+          (packages->manifest packages)))))))
 
   (with-error-handling
     (with-store store
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4eb968a49b..2f04652634 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -218,12 +218,13 @@ non-zero relevance score."
         (output (manifest-entry-output old)))
       transaction)))
 
-  (define (upgrade entry)
+  (define (upgrade entry transform)
     (match entry
       (($ <manifest-entry> name version output (? string? path))
        (match (find-best-packages-by-name name #f)
          ((pkg . rest)
-          (let ((candidate-version (package-version pkg)))
+          (let* ((pkg               (transform store pkg))
+                 (candidate-version (package-version pkg)))
             (match (package-superseded pkg)
               ((? package? new)
                (supersede entry new))
@@ -231,12 +232,14 @@ non-zero relevance score."
                (case (version-compare candidate-version version)
                  ((>)
                   (manifest-transaction-install-entry
-                   (package->manifest-entry* pkg output)
+                   (manifest-entry-with-transformations
+                    (package->manifest-entry* pkg output))
                    transaction))
                  ((<)
                   transaction)
                  ((=)
-                  (let* ((new (package->manifest-entry* pkg output)))
+                  (let* ((new (manifest-entry-with-transformations
+                               (package->manifest-entry* pkg output))))
                     ;; Here we want to determine whether the NEW actually
                     ;; differs from ENTRY, but we need to intercept
                     ;; 'build-things' calls because they would prevent us from
@@ -255,7 +258,14 @@ non-zero relevance score."
 
   (if (manifest-transaction-removal-candidate? entry transaction)
       transaction
-      (upgrade entry)))
+
+      ;; Upgrade ENTRY, preserving transformation options listed in its
+      ;; properties.
+      (let ((transform (options->transformation
+                        (or (assq-ref (manifest-entry-properties entry)
+                                      'transformations)
+                            '()))))
+        (upgrade entry transform))))
 
 
 ;;;
@@ -585,14 +595,8 @@ upgrading, #f otherwise."
 (define (package->manifest-entry* package output)
   "Like 'package->manifest-entry', but attach PACKAGE provenance meta-data to
 the resulting manifest entry."
-  (define (provenance-properties package)
-    (match (package-provenance package)
-      (#f   '())
-      (sexp `((provenance ,@sexp)))))
-
-  (package->manifest-entry package output
-                           #:properties (provenance-properties package)))
-
+  (manifest-entry-with-provenance
+   (package->manifest-entry package output)))
 
 (define (options->installable opts manifest transaction)
   "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
@@ -870,12 +874,13 @@ processed, #f otherwise."
 
   (define (transform-entry entry)
     (let ((item (transform store (manifest-entry-item entry))))
-      (manifest-entry
-        (inherit entry)
-        (item item)
-        (version (if (package? item)
-                     (package-version item)
-                     (manifest-entry-version entry))))))
+      (manifest-entry-with-transformations
+       (manifest-entry
+         (inherit entry)
+         (item item)
+         (version (if (package? item)
+                      (package-version item)
+                      (manifest-entry-version entry)))))))
 
   (when (equal? profile %current-profile)
     ;; Normally the daemon created %CURRENT-PROFILE when we connected, unless
diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm
index 3c79e89f8d..9f20803efc 100644
--- a/guix/scripts/repl.scm
+++ b/guix/scripts/repl.scm
@@ -27,6 +27,7 @@
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
+  #:autoload   (guix describe) (current-profile)
   #:autoload   (system repl repl) (start-repl)
   #:autoload   (system repl server)
                   (make-tcp-server-socket make-unix-domain-server-socket)
@@ -176,9 +177,19 @@ call THUNK."
       ;; Run script
       (save-module-excursion
        (lambda ()
+         ;; Invoke 'current-profile' so that it memoizes the correct value
+         ;; based on (program-arguments), before we call
+         ;; 'set-program-arguments'.  This in turn ensures that
+         ;; (%package-module-path) will contain entries for the channels
+         ;; available in the current profile.
+         (current-profile)
+
          (set-program-arguments script)
          (set-user-module)
-         (load-in-vicinity "." (car script)))))
+
+         ;; When passed a relative file name, 'load-in-vicinity' searches the
+         ;; file in %LOAD-PATH.  Thus, pass (getcwd) instead of ".".
+         (load-in-vicinity (getcwd) (car script)))))
 
     (when (null? script)
       ;; Start REPL
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bd5f84fc5b..939559e719 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -666,38 +666,45 @@ checking this by themselves in their 'check' procedure."
 ;;; Action.
 ;;;
 
-(define* (system-derivation-for-action os base-image action
-                                       #:key image-size file-system-type
+(define* (system-derivation-for-action os action
+                                       #:key image-size image-type
                                        full-boot? container-shared-network?
                                        mappings label)
   "Return as a monadic value the derivation for OS according to ACTION."
-  (case action
-    ((build init reconfigure)
-     (operating-system-derivation os))
-    ((container)
-     (container-script
-      os
-      #:mappings mappings
-      #:shared-network? container-shared-network?))
-    ((vm-image)
-     (system-qemu-image os #:disk-image-size image-size))
-    ((vm)
-     (system-qemu-image/shared-store-script os
-                                            #:full-boot? full-boot?
-                                            #:disk-image-size
-                                            (if full-boot?
-                                                image-size
-                                                (* 70 (expt 2 20)))
-                                            #:mappings mappings))
-    ((disk-image)
-     (lower-object
-      (system-image
-       (image
-        (inherit (if label (image-with-label base-image label) base-image))
-        (size image-size)
-        (operating-system os)))))
-    ((docker-image)
-     (system-docker-image os #:shared-network? container-shared-network?))))
+  (mlet %store-monad ((target (current-target-system)))
+    (case action
+      ((build init reconfigure)
+       (operating-system-derivation os))
+      ((container)
+       (container-script
+        os
+        #:mappings mappings
+        #:shared-network? container-shared-network?))
+      ((vm-image)
+       (system-qemu-image os #:disk-image-size image-size))
+      ((vm)
+       (system-qemu-image/shared-store-script os
+                                              #:full-boot? full-boot?
+                                              #:disk-image-size
+                                              (if full-boot?
+                                                  image-size
+                                                  (* 70 (expt 2 20)))
+                                              #:mappings mappings))
+      ((disk-image)
+       (let* ((base-image (os->image os #:type image-type))
+              (base-target (image-target base-image)))
+         (lower-object
+          (system-image
+           (image
+            (inherit (if label
+                         (image-with-label base-image label)
+                         base-image))
+            (target (or base-target target))
+            (size image-size)
+            (operating-system os))))))
+      ((docker-image)
+       (system-docker-image os
+                            #:shared-network? container-shared-network?)))))
 
 (define (maybe-suggest-running-guix-pull)
   "Suggest running 'guix pull' if this has never been done before."
@@ -748,18 +755,19 @@ and TARGET arguments."
                          install-bootloader?
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
-                         image-size file-system-type full-boot? label
-                         container-shared-network?
+                         image-size image-type
+                         full-boot? label container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
 bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
 target root directory; IMAGE-SIZE is the size of the image to be built, for
-the 'vm-image' and 'disk-image' actions.  The root file system is created as a
-FILE-SYSTEM-TYPE file system.  FULL-BOOT? is used for the 'vm' action; it
-determines whether to boot directly to the kernel or to the bootloader.
-CONTAINER-SHARED-NETWORK? determines if the container will use a separate
-network namespace.
+the 'vm-image' and 'disk-image' actions.  IMAGE-TYPE is the type of image to
+be built.
+
+FULL-BOOT? is used for the 'vm' action; it determines whether to
+boot directly to the kernel or to the bootloader.  CONTAINER-SHARED-NETWORK?
+determines if the container will use a separate network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -799,11 +807,9 @@ static checks."
       (check-initrd-modules os)))
 
   (mlet* %store-monad
-      ((target*   (current-target-system))
-       (image ->  (find-image file-system-type target*))
-       (sys       (system-derivation-for-action os image action
+      ((sys       (system-derivation-for-action os action
                                                 #:label label
-                                                #:file-system-type file-system-type
+                                                #:image-type image-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
                                                 #:container-shared-network? container-shared-network?
@@ -888,6 +894,17 @@ Run 'herd status' to view the list of services on your system.\n"))))))
 
 
 ;;;
+;;; Images.
+;;;
+
+(define (list-image-types)
+  "Print the available image types."
+  (display (G_ "The available image types are:\n"))
+  (newline)
+  (format #t "~{   - ~a ~%~}" (map image-type-name (force %image-types))))
+
+
+;;;
 ;;; Options.
 ;;;
 
@@ -945,9 +962,9 @@ Some ACTIONS support additional ARGS.\n"))
                          apply STRATEGY (one of nothing-special, backtrace,
                          or debug) when an error occurs while reading FILE"))
   (display (G_ "
-      --file-system-type=TYPE
-                         for 'disk-image', produce a root file system of TYPE
-                         (one of 'ext4', 'iso9660')"))
+      --list-image-types list available image types"))
+  (display (G_ "
+  -t, --image-type=TYPE  for 'disk-image', produce an image of TYPE"))
   (display (G_ "
       --image-size=SIZE  for 'vm-image', produce an image of SIZE"))
   (display (G_ "
@@ -1008,10 +1025,14 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'on-error (string->symbol arg)
                                result)))
-         (option '(#\t "file-system-type") #t #f
+         (option '(#\t "image-type") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'file-system-type arg
+                   (alist-cons 'image-type (string->symbol arg)
                                result)))
+         (option '("list-image-types") #f #f
+                 (lambda (opt name arg result)
+                   (list-image-types)
+                   (exit 0)))
          (option '("image-size") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
@@ -1080,7 +1101,7 @@ Some ACTIONS support additional ARGS.\n"))
     (debug . 0)
     (verbosity . #f)                              ;default
     (validate-reconfigure . ,ensure-forward-reconfigure)
-    (file-system-type . "ext4")
+    (image-type . raw)
     (image-size . guess)
     (install-bootloader? . #t)
     (label . #f)))
@@ -1177,7 +1198,8 @@ resulting from command-line parsing."
                                (assoc-ref opts 'skip-safety-checks?)
                                #:validate-reconfigure
                                (assoc-ref opts 'validate-reconfigure)
-                               #:file-system-type (assoc-ref opts 'file-system-type)
+                               #:image-type (lookup-image-type-by-name
+                                             (assoc-ref opts 'image-type))
                                #:image-size (assoc-ref opts 'image-size)
                                #:full-boot? (assoc-ref opts 'full-boot?)
                                #:container-shared-network?
diff --git a/guix/self.scm b/guix/self.scm
index 02ef982c7c..5eb80f42fe 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -56,7 +56,7 @@
       ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
       ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
-      ("gnutls"     (ref '(gnu packages tls) 'guile3.0-gnutls))
+      ("gnutls"     (ref '(gnu packages tls) 'gnutls))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 50b66ce282..2ea63b17aa 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -397,7 +397,10 @@ absolute file name to the state directory of the store being initialized.
 Return #t on success.
 
 Use with care as it directly modifies the store!  This is primarily meant to
-be used internally by the daemon's build hook."
+be used internally by the daemon's build hook.
+
+PATH must be protected from GC and locked during execution of this, typically
+by adding it as a temp-root."
   (define db-file
     (store-database-file #:prefix prefix
                          #:state-directory state-directory))
@@ -423,7 +426,9 @@ be used internally by the daemon's build hook."
   "Register all of ITEMS, a list of <store-info> records as returned by
 'read-reference-graph', in DB.  ITEMS must be in topological order (with
 leaves first.)  REGISTRATION-TIME must be the registration time to be recorded
-in the database; #f means \"now\".  Write a progress report to LOG-PORT."
+in the database; #f means \"now\".  Write a progress report to LOG-PORT.  All
+of ITEMS must be protected from GC and locked during execution of this,
+typically by adding them as temp-roots."
   (define store-dir
     (if prefix
         (string-append prefix %storedir)
@@ -452,24 +457,25 @@ in the database; #f means \"now\".  Write a progress report to LOG-PORT."
       (when reset-timestamps?
         (reset-timestamps real-file-name))
       (let-values (((hash nar-size) (nar-sha256 real-file-name)))
-        (sqlite-register db #:path to-register
-                         #:references (store-info-references item)
-                         #:deriver (store-info-deriver item)
-                         #:hash (string-append "sha256:"
-                                               (bytevector->base16-string hash))
-                         #:nar-size nar-size
-                         #:time registration-time)
+        (call-with-retrying-transaction db
+          (lambda ()
+            (sqlite-register db #:path to-register
+                             #:references (store-info-references item)
+                             #:deriver (store-info-deriver item)
+                             #:hash (string-append
+                                     "sha256:"
+                                     (bytevector->base16-string hash))
+                             #:nar-size nar-size
+                             #:time registration-time)))
         (when deduplicate?
           (deduplicate real-file-name hash #:store store-dir)))))
 
-  (call-with-retrying-transaction db
-      (lambda ()
-        (let* ((prefix   (format #f "registering ~a items" (length items)))
-               (progress (progress-reporter/bar (length items)
-                                                prefix log-port)))
-          (call-with-progress-reporter progress
-            (lambda (report)
-              (for-each (lambda (item)
-                          (register db item)
-                          (report))
-                        items)))))))
+  (let* ((prefix   (format #f "registering ~a items" (length items)))
+         (progress (progress-reporter/bar (length items)
+                                          prefix log-port)))
+    (call-with-progress-reporter progress
+      (lambda (report)
+        (for-each (lambda (item)
+                    (register db item)
+                    (report))
+                  items)))))
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index df959bdd06..0655ceb890 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -94,8 +94,8 @@ LINK-PREFIX."
             (try (tempname-in link-prefix))
             (apply throw args))))))
 
-(define (call-with-writable-file file thunk)
-  (if (string=? file (%store-directory))
+(define (call-with-writable-file file store thunk)
+  (if (string=? file store)
       (thunk)                       ;don't meddle with the store's permissions
       (let ((stat (lstat file)))
         (dynamic-wind
@@ -106,17 +106,18 @@ LINK-PREFIX."
             (set-file-time file stat)
             (chmod file (stat:mode stat)))))))
 
-(define-syntax-rule (with-writable-file file exp ...)
+(define-syntax-rule (with-writable-file file store exp ...)
   "Make FILE writable for the dynamic extent of EXP..., except if FILE is the
 store."
-  (call-with-writable-file file (lambda () exp ...)))
+  (call-with-writable-file file store (lambda () exp ...)))
 
 ;; There are 3 main kinds of errors we can get from hardlinking: "Too many
 ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
 ;; "can't fit more stuff in this directory" (ENOSPC).
 
 (define* (replace-with-link target to-replace
-                            #:key (swap-directory (dirname target)))
+                            #:key (swap-directory (dirname target))
+                            (store (%store-directory)))
   "Atomically replace the file TO-REPLACE with a link to TARGET.  Use
 SWAP-DIRECTORY as the directory to store temporary hard links.  Upon ENOSPC
 and EMLINK, TO-REPLACE is left unchanged.
@@ -137,7 +138,7 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
   ;; If we couldn't create TEMP-LINK, that's OK: just don't do the
   ;; replacement, which means TO-REPLACE won't be deduplicated.
   (when temp-link
-    (with-writable-file (dirname to-replace)
+    (with-writable-file (dirname to-replace) store
       (catch 'system-error
         (lambda ()
           (rename-file temp-link to-replace))
@@ -154,46 +155,49 @@ under STORE."
   (define links-directory
     (string-append store "/.links"))
 
-  (mkdir-p links-directory)
-  (let loop ((path path)
-             (type (stat:type (lstat path)))
-             (hash hash))
-    (if (eq? 'directory type)
-        ;; Can't hardlink directories, so hardlink their atoms.
-        (for-each (match-lambda
-                    ((file . properties)
-                     (unless (member file '("." ".."))
-                       (let* ((file (string-append path "/" file))
-                              (type (match (assoc-ref properties 'type)
-                                      ((or 'unknown #f)
-                                       (stat:type (lstat file)))
-                                      (type type))))
-                         (loop file type
-                               (and (not (eq? 'directory type))
-                                    (nar-sha256 file)))))))
-                  (scandir* path))
-        (let ((link-file (string-append links-directory "/"
-                                        (bytevector->nix-base32-string hash))))
-          (if (file-exists? link-file)
-              (replace-with-link link-file path
-                                 #:swap-directory links-directory)
-              (catch 'system-error
-                (lambda ()
-                  (link path link-file))
-                (lambda args
-                  (let ((errno (system-error-errno args)))
-                    (cond ((= errno EEXIST)
-                           ;; Someone else put an entry for PATH in
-                           ;; LINKS-DIRECTORY before we could.  Let's use it.
-                           (replace-with-link path link-file
-                                              #:swap-directory links-directory))
-                          ((= errno ENOSPC)
-                           ;; There's not enough room in the directory index for
-                           ;; more entries in .links, but that's fine: we can
-                           ;; just stop.
-                           #f)
-                          ((= errno EMLINK)
-                           ;; PATH has reached the maximum number of links, but
-                           ;; that's OK: we just can't deduplicate it more.
-                           #f)
-                          (else (apply throw args)))))))))))
+    (mkdir-p links-directory)
+    (let loop ((path path)
+               (type (stat:type (lstat path)))
+               (hash hash))
+      (if (eq? 'directory type)
+          ;; Can't hardlink directories, so hardlink their atoms.
+          (for-each (match-lambda
+                      ((file . properties)
+                       (unless (member file '("." ".."))
+                         (let* ((file (string-append path "/" file))
+                                (type (match (assoc-ref properties 'type)
+                                        ((or 'unknown #f)
+                                         (stat:type (lstat file)))
+                                        (type type))))
+                           (loop file type
+                                 (and (not (eq? 'directory type))
+                                      (nar-sha256 file)))))))
+                    (scandir* path))
+          (let ((link-file (string-append links-directory "/"
+                                          (bytevector->nix-base32-string hash))))
+            (if (file-exists? link-file)
+                (replace-with-link link-file path
+                                   #:swap-directory links-directory
+                                   #:store store)
+                (catch 'system-error
+                  (lambda ()
+                    (link path link-file))
+                  (lambda args
+                    (let ((errno (system-error-errno args)))
+                      (cond ((= errno EEXIST)
+                             ;; Someone else put an entry for PATH in
+                             ;; LINKS-DIRECTORY before we could.  Let's use it.
+                             (replace-with-link path link-file
+                                                #:swap-directory
+                                                links-directory
+                                                #:store store))
+                            ((= errno ENOSPC)
+                             ;; There's not enough room in the directory index for
+                             ;; more entries in .links, but that's fine: we can
+                             ;; just stop.
+                             #f)
+                            ((= errno EMLINK)
+                             ;; PATH has reached the maximum number of links, but
+                             ;; that's OK: we just can't deduplicate it more.
+                             #f)
+                            (else (apply throw args)))))))))))
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index 59e2eb8d07..b96151234c 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -159,10 +159,11 @@ reports to LOG."
             (parameterize ((current-output-port log))
               (build:svn-fetch (svn-reference-url ref)
                                (svn-reference-revision ref)
-                               temp
+                               (string-append temp "/svn")
                                #:user-name (svn-reference-user-name ref)
                                #:password (svn-reference-password ref)))))
        (and result
-            (add-to-store store name #t "sha256" temp))))))
+            (add-to-store store name #t "sha256"
+                          (string-append temp "/svn")))))))
 
 ;;; svn-download.scm ends here
diff --git a/guix/ui.scm b/guix/ui.scm
index 115d9801b2..8213e8ebab 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -492,7 +492,7 @@ part."
 lines:
 
 @example
-guix package -i glibc-utf8-locales
+guix install glibc-utf8-locales
 export GUIX_LOCPATH=\"$HOME/.guix-profile/lib/locale\"
 @end example
 
@@ -1075,16 +1075,19 @@ summary, and level 0 shows nothing."
                          (null? hook) (map colorized-store-item hook)))
                 ((= verbosity 1)
                  ;; Display the bare minimum; don't mention grafts and hooks.
+                 (unless (null? build)
+                   (newline (current-error-port)))
                  (if display-download-size?
                      (format (current-error-port)
                              ;; TRANSLATORS: "MB" is for "megabyte"; it should be
                              ;; translated to the corresponding abbreviation.
-                             (G_ "~:[~,1h MB would be downloaded~%~;~]")
+                             (highlight (G_ "~:[~,1h MB would be downloaded~%~;~]"))
                              (null? download) download-size)
                      (format (current-error-port)
-                             (N_ "~:[~h item would be downloaded~%~;~]"
-                                 "~:[~h items would be downloaded~%~;~]"
-                                 (length download))
+                             (highlight
+                              (N_ "~:[~h item would be downloaded~%~;~]"
+                                  "~:[~h items would be downloaded~%~;~]"
+                                  (length download)))
                              (null? download) (length download))))))
 
         (begin
@@ -1123,16 +1126,19 @@ summary, and level 0 shows nothing."
                          (null? hook) (map colorized-store-item hook)))
                 ((= verbosity 1)
                  ;; Display the bare minimum; don't mention grafts and hooks.
+                 (unless (null? build)
+                   (newline (current-error-port)))
                  (if display-download-size?
                      (format (current-error-port)
                              ;; TRANSLATORS: "MB" is for "megabyte"; it should be
                              ;; translated to the corresponding abbreviation.
-                             (G_ "~:[~,1h MB will be downloaded~%~;~]")
+                             (highlight (G_ "~:[~,1h MB will be downloaded~%~;~]"))
                              (null? download) download-size)
                      (format (current-error-port)
-                             (N_ "~:[~h item will be downloaded~%~;~]"
-                                 "~:[~h items will be downloaded~%~;~]"
-                                 (length download))
+                             (highlight
+                              (N_ "~:[~h item will be downloaded~%~;~]"
+                                  "~:[~h items will be downloaded~%~;~]"
+                                  (length download)))
                              (null? download) (length download)))))))
 
     (check-available-space installed-size)
@@ -2128,7 +2134,7 @@ and signal handling have already been set up."
              (G_ "guix: missing command name~%"))
      (show-guix-usage))
     ((or ("-h") ("--help"))
-     (show-guix-help))
+     (leave-on-EPIPE (show-guix-help)))
     ((or ("-V") ("--version"))
      (show-version-and-exit "guix"))
     (((? option? o) args ...)
@@ -2139,7 +2145,7 @@ and signal handling have already been set up."
      (apply run-guix-command (string->symbol command)
             '("--help")))
     (("help" args ...)
-     (show-guix-help))
+     (leave-on-EPIPE (show-guix-help)))
     ((command args ...)
      (apply run-guix-command
             (string->symbol command)