Merge remote-tracking branch 'origin/master' into core-updates

18 files changed, 345 insertions, 621 deletions

diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 02557ce454..c04baf9784 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -310,6 +311,16 @@ the input port."
         (leave (G_ "failed to read public key: ~a: ~a~%")
                (error-source err) (error-string err)))))
 
+  ;; Warn about potentially volatile ACLs, but continue: system reconfiguration
+  ;; might not be possible without (newly-authorized) substitutes.
+  (let ((stat (false-if-exception (lstat %acl-file))))
+    (when (and stat (eq? 'symlink (stat:type (lstat %acl-file))))
+      (warning (G_ "replacing symbolic link ~a with a regular file~%")
+               %acl-file)
+      (when (string-prefix? (%store-prefix) (readlink %acl-file))
+        (display-hint (G_ "On Guix System, add public keys to the
+@code{authorized-keys} field of your @code{operating-system} instead.")))))
+
   (let ((key (read-key))
         (acl (current-acl)))
     (unless (eq? 'public-key (canonical-sexp-nth-data key 0))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index e59e0ee67f..a959cb827d 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -31,11 +31,6 @@
 
   #:use-module (guix utils)
 
-  ;; Use the procedure that destructures "NAME-VERSION" forms.
-  #:use-module ((guix build utils)
-                #:select ((package-name->name+version
-                           . hyphen-package-name->name+version)))
-
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix profiles)
@@ -45,28 +40,24 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #: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)
-  #:autoload   (guix git-download) (git-reference? git-reference-url)
-  #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module ((guix progress) #:select (current-terminal-columns))
   #:use-module ((guix build syscalls) #:select (terminal-columns))
-  #:export (%standard-build-options
+  #:use-module (guix transformations)
+  #:export (log-url
+
+            %standard-build-options
             set-build-options-from-command-line
             set-build-options-from-command-line*
             show-build-options-help
 
-            %transformation-options
-            options->transformation
-            manifest-entry-with-transformations
-            show-transformation-options-help
-
             guix-build
             register-root
             register-root*))
@@ -151,493 +142,6 @@ found.  Return #f if no build log was found."
 (define register-root*
   (store-lift register-root))
 
-(define (numeric-extension? file-name)
-  "Return true if FILE-NAME ends with digits."
-  (string-every char-set:hex-digit (file-extension file-name)))
-
-(define (tarball-base-name file-name)
-  "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar
-extensions."
-  ;; TODO: Factorize.
-  (cond ((not (file-extension file-name))
-         file-name)
-        ((numeric-extension? file-name)
-         file-name)
-        ((string=? (file-extension file-name) "tar")
-         (file-sans-extension file-name))
-        ((file-extension file-name)
-         =>
-         (match-lambda
-           ("scm" file-name)
-           (else  (tarball-base-name (file-sans-extension file-name)))))
-        (else
-         file-name)))
-
-(define* (package-with-source store p uri #:optional version)
-  "Return a package based on P but with its source taken from URI.  Extract
-the new package's version number from URI."
-  (let ((base (tarball-base-name (basename uri))))
-    (let-values (((_ version*)
-                  (hyphen-package-name->name+version base)))
-      (package (inherit p)
-               (version (or version version*
-                            (package-version p)))
-
-               ;; Use #:recursive? #t to allow for directories.
-               (source (download-to-store store uri
-                                          #:recursive? #t))
-
-               ;; Override the replacement, otherwise '--with-source' would
-               ;; have no effect.
-               (replacement #f)))))
-
-
-;;;
-;;; Transformations.
-;;;
-
-(define (transform-package-source sources)
-  "Return a transformation procedure that replaces package sources with the
-matching URIs given in SOURCES."
-  (define new-sources
-    (map (lambda (uri)
-           (match (string-index uri #\=)
-             (#f
-              ;; Determine the package name and version from URI.
-              (call-with-values
-                  (lambda ()
-                    (hyphen-package-name->name+version
-                     (tarball-base-name (basename uri))))
-                (lambda (name version)
-                  (list name version uri))))
-             (index
-              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
-              (call-with-values
-                  (lambda ()
-                    (package-name->name+version (string-take uri index)))
-                (lambda (name version)
-                  (list name version
-                        (string-drop uri (+ 1 index))))))))
-         sources))
-
-  (lambda (store obj)
-    (let loop ((sources  new-sources)
-               (result   '()))
-      (match obj
-        ((? package? p)
-         (match (assoc-ref sources (package-name p))
-           ((version source)
-            (package-with-source store p source version))
-           (#f
-            p)))
-        (_
-         obj)))))
-
-(define (evaluate-replacement-specs specs proc)
-  "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
-of package spec/procedure pairs as expected by 'package-input-rewriting/spec'.
-PROC is called with the package to be replaced and its replacement according
-to SPECS.  Raise an error if an element of SPECS uses invalid syntax, or if a
-package it refers to could not be found."
-  (define not-equal
-    (char-set-complement (char-set #\=)))
-
-  (map (lambda (spec)
-         (match (string-tokenize spec not-equal)
-           ((spec new)
-            (cons spec
-                  (let ((new (specification->package new)))
-                    (lambda (old)
-                      (proc old new)))))
-           (x
-            (leave (G_ "invalid replacement specification: ~s~%") spec))))
-       specs))
-
-(define (transform-package-inputs replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile=guile@2.1\" meaning that, any dependency on a package
-called \"guile\" must be replaced with a dependency on a version 2.1 of
-\"guile\"."
-  (let* ((replacements (evaluate-replacement-specs replacement-specs
-                                                   (lambda (old new)
-                                                     new)))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (store obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-inputs/graft replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
-current 'gnutls' package, after which version 3.5.4 is grafted onto them."
-  (define (set-replacement old new)
-    (package (inherit old) (replacement new)))
-
-  (let* ((replacements (evaluate-replacement-specs replacement-specs
-                                                   set-replacement))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (store obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define %not-equal
-  (char-set-complement (char-set #\=)))
-
-(define (package-git-url package)
-  "Return the URL of the Git repository for package, or raise an error if
-the source of PACKAGE is not fetched from a Git repository."
-  (let ((source (package-source package)))
-    (cond ((and (origin? source)
-                (git-reference? (origin-uri source)))
-           (git-reference-url (origin-uri source)))
-          ((git-checkout? source)
-           (git-checkout-url source))
-          (else
-           (leave (G_ "the source of ~a is not a Git reference~%")
-                  (package-full-name package))))))
-
-(define (evaluate-git-replacement-specs specs proc)
-  "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
-of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
-replacement package.  Raise an error if an element of SPECS uses invalid
-syntax, or if a package it refers to could not be found."
-  (map (lambda (spec)
-         (match (string-tokenize spec %not-equal)
-           ((spec branch-or-commit)
-            (define (replace old)
-              (let* ((source (package-source old))
-                     (url    (package-git-url old)))
-                (proc old url branch-or-commit)))
-
-            (cons spec replace))
-           (x
-            (leave (G_ "invalid replacement specification: ~s~%") spec))))
-       specs))
-
-(define (transform-package-source-branch replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile-next=stable-3.0\" meaning that packages are built using
-'guile-next' from the latest commit on its 'stable-3.0' branch."
-  (define (replace old url branch)
-    (package
-      (inherit old)
-      (version (string-append "git." (string-map (match-lambda
-                                                   (#\/ #\-)
-                                                   (chr chr))
-                                                 branch)))
-      (source (git-checkout (url url) (branch branch)
-                            (recursive? #t)))))
-
-  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
-                                                       replace))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (store obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-source-commit replacement-specs)
-  "Return a procedure that, when passed a package, replaces its direct
-dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
-strings like \"guile-next=cabba9e\" meaning that packages are built using
-'guile-next' from commit 'cabba9e'."
-  (define (replace old url commit)
-    (package
-      (inherit old)
-      (version (if (and (> (string-length commit) 1)
-                        (string-prefix? "v" commit)
-                        (char-set-contains? char-set:digit
-                                            (string-ref commit 1)))
-                   (string-drop commit 1)        ;looks like a tag like "v1.0"
-                   (string-append "git."
-                                  (if (< (string-length commit) 7)
-                                      commit
-                                      (string-take commit 7)))))
-      (source (git-checkout (url url) (commit commit)
-                            (recursive? #t)))))
-
-  (let* ((replacements (evaluate-git-replacement-specs replacement-specs
-                                                       replace))
-         (rewrite      (package-input-rewriting/spec replacements)))
-    (lambda (store obj)
-      (if (package? obj)
-          (rewrite obj)
-          obj))))
-
-(define (transform-package-source-git-url replacement-specs)
-  "Return a procedure that, when passed a package, replaces its dependencies
-according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of strings like
-\"guile-json=https://gitthing.com/…\" meaning that packages are built using
-a checkout of the Git repository at the given URL."
-  (define replacements
-    (map (lambda (spec)
-           (match (string-tokenize spec %not-equal)
-             ((spec url)
-              (cons spec
-                    (lambda (old)
-                      (package
-                        (inherit old)
-                        (source (git-checkout (url url)
-                                              (recursive? #t)))))))
-             (_
-              (leave (G_ "~a: invalid Git URL replacement specification~%")
-                     spec))))
-         replacement-specs))
-
-  (define rewrite
-    (package-input-rewriting/spec replacements))
-
-  (lambda (store obj)
-    (if (package? obj)
-        (rewrite obj)
-        obj)))
-
-(define (package-dependents/spec top bottom)
-  "Return the list of dependents of BOTTOM, a spec string, that are also
-dependencies of TOP, a package."
-  (define-values (name version)
-    (package-name->name+version bottom))
-
-  (define dependent?
-    (mlambda (p)
-      (and (package? p)
-           (or (and (string=? name (package-name p))
-                    (or (not version)
-                        (version-prefix? version (package-version p))))
-               (match (bag-direct-inputs (package->bag p))
-                 (((labels dependencies . _) ...)
-                  (any dependent? dependencies)))))))
-
-  (filter dependent? (package-closure (list top))))
-
-(define (package-toolchain-rewriting p bottom toolchain)
-  "Return a procedure that, when passed a package that's either BOTTOM or one
-of its dependents up to P so, changes it so it is built with TOOLCHAIN.
-TOOLCHAIN must be an input list."
-  (define rewriting-property
-    (gensym " package-toolchain-rewriting"))
-
-  (match (package-dependents/spec p bottom)
-    (()                                           ;P does not depend on BOTTOM
-     identity)
-    (set
-     ;; SET is the list of packages "between" P and BOTTOM (included) whose
-     ;; toolchain needs to be changed.
-     (package-mapping (lambda (p)
-                        (if (or (assq rewriting-property
-                                      (package-properties p))
-                                (not (memq p set)))
-                            p
-                            (let ((p (package-with-c-toolchain p toolchain)))
-                              (package/inherit p
-                                (properties `((,rewriting-property . #t)
-                                              ,@(package-properties p)))))))
-                      (lambda (p)
-                        (or (assq rewriting-property (package-properties p))
-                            (not (memq p set))))
-                      #:deep? #t))))
-
-(define (transform-package-toolchain replacement-specs)
-  "Return a procedure that, when passed a package, changes its toolchain or
-that of its dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is
-a list of strings like \"fftw=gcc-toolchain@10\" meaning that the package to
-the left of the equal sign must be built with the toolchain to the right of
-the equal sign."
-  (define split-on-commas
-    (cute string-tokenize <> (char-set-complement (char-set #\,))))
-
-  (define (specification->input spec)
-    (let ((package (specification->package spec)))
-      (list (package-name package) package)))
-
-  (define replacements
-    (map (lambda (spec)
-           (match (string-tokenize spec %not-equal)
-             ((spec (= split-on-commas toolchain))
-              (cons spec (map specification->input toolchain)))
-             (_
-              (leave (G_ "~a: invalid toolchain replacement specification~%")
-                     spec))))
-         replacement-specs))
-
-  (lambda (store obj)
-    (if (package? obj)
-        (or (any (match-lambda
-                   ((bottom . toolchain)
-                    ((package-toolchain-rewriting obj bottom toolchain) obj)))
-                 replacements)
-            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
-  ;; procedure; it is called with two arguments: the store, and a list of
-  ;; things to build.
-  `((with-source . ,transform-package-source)
-    (with-input  . ,transform-package-inputs)
-    (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-c-toolchain . ,transform-package-toolchain)
-    (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.
-  (let ((parser (lambda (symbol)
-                  (lambda (opt name arg result . rest)
-                    (apply values
-                           (alist-cons symbol arg result)
-                           rest)))))
-    (list (option '("with-source") #t #f
-                  (parser 'with-source))
-          (option '("with-input") #t #f
-                  (parser 'with-input))
-          (option '("with-graft") #t #f
-                  (parser 'with-graft))
-          (option '("with-branch") #t #f
-                  (parser 'with-branch))
-          (option '("with-commit") #t #f
-                  (parser 'with-commit))
-          (option '("with-git-url") #t #f
-                  (parser 'with-git-url))
-          (option '("with-c-toolchain") #t #f
-                  (parser 'with-c-toolchain))
-          (option '("without-tests") #t #f
-                  (parser 'without-tests)))))
-
-(define (show-transformation-options-help)
-  (display (G_ "
-      --with-source=[PACKAGE=]SOURCE
-                         use SOURCE when building the corresponding package"))
-  (display (G_ "
-      --with-input=PACKAGE=REPLACEMENT
-                         replace dependency PACKAGE by REPLACEMENT"))
-  (display (G_ "
-      --with-graft=PACKAGE=REPLACEMENT
-                         graft REPLACEMENT on packages that refer to PACKAGE"))
-  (display (G_ "
-      --with-branch=PACKAGE=BRANCH
-                         build PACKAGE from the latest commit of BRANCH"))
-  (display (G_ "
-      --with-commit=PACKAGE=COMMIT
-                         build PACKAGE from COMMIT"))
-  (display (G_ "
-      --with-git-url=PACKAGE=URL
-                         build PACKAGE from the repository at URL"))
-  (display (G_ "
-      --with-c-toolchain=PACKAGE=TOOLCHAIN
-                         build PACKAGE and its dependents with TOOLCHAIN"))
-  (display (G_ "
-      --without-tests=PACKAGE
-                         build PACKAGE without running its tests")))
-
-
-(define (options->transformation opts)
-  "Return a procedure that, when passed an object to build (package,
-derivation, etc.), applies the transformations specified by OPTS."
-  (define applicable
-    ;; List of applicable transformations as symbol/procedure pairs in the
-    ;; order in which they appear on the command line.
-    (filter-map (match-lambda
-                  ((key . value)
-                   (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.
-                      (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)
-    (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)))))))))
-
 
 ;;;
 ;;; Standard command-line build options.
@@ -1053,8 +557,7 @@ build."
       (systems systems)))
 
   (define things-to-build
-    (map (cut transform store <>)
-         (options->things-to-build opts)))
+    (map transform (options->things-to-build opts)))
 
   (define (compute-derivation obj system)
     ;; Compute the derivation of OBJ for SYSTEM.
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 1b5be307be..0725fba54b 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -120,17 +120,28 @@ Perform the deployment specified by FILE.\n"))
   (info (G_ "deploying to ~a...~%")
         (machine-display-name machine))
 
-  (guard (c ((message-condition? c)
-             (report-error (G_ "failed to deploy ~a: ~a~%")
-                           (machine-display-name machine)
-                           (condition-message c)))
-            ((deploy-error? c)
-             (when (deploy-error-should-roll-back c)
-               (info (G_ "rolling back ~a...~%")
-                     (machine-display-name machine))
-               (run-with-store store (roll-back-machine machine)))
-             (apply throw (deploy-error-captured-args c))))
-    (run-with-store store (deploy-machine machine))
+  (guard* (c
+           ;; On Guile 3.0, exceptions such as 'unbound-variable' are compound
+           ;; and include a '&message'.  However, that message only contains
+           ;; the format string.  Thus, special-case it here to avoid
+           ;; displaying a bare format string.
+           ((cond-expand
+              (guile-3
+               ((exception-predicate &exception-with-kind-and-args) c))
+              (else #f))
+            (raise c))
+
+           ((message-condition? c)
+            (report-error (G_ "failed to deploy ~a: ~a~%")
+                          (machine-display-name machine)
+                          (condition-message c)))
+           ((deploy-error? c)
+            (when (deploy-error-should-roll-back c)
+              (info (G_ "rolling back ~a...~%")
+                    (machine-display-name machine))
+              (run-with-store store (roll-back-machine machine)))
+            (apply throw (deploy-error-captured-args c))))
+      (run-with-store store (deploy-machine machine))
 
     (info (G_ "successfully deployed ~a~%")
           (machine-display-name machine))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 085f11a9d4..e435bf0ce4 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -32,6 +32,7 @@
   #:use-module ((guix gexp) #:select (lower-object))
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (gnu build linux-container)
   #:use-module (gnu build accounts)
   #:use-module ((guix build syscalls) #:select (set-network-interface-up))
@@ -322,7 +323,7 @@ for the corresponding packages."
                    (manifest-entry-output e2))))
 
   (define transform
-    (cut (options->transformation opts) store <>))
+    (options->transformation opts))
 
   (define* (package->manifest-entry* package #:optional (output "out"))
     (package->manifest-entry (transform package) output))
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index d7a08a4fe1..ddfc6ba497 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -34,11 +34,12 @@
   #:use-module (guix sets)
   #:use-module ((guix diagnostics)
                 #:select (location-file formatted-message))
-  #:use-module ((guix scripts build)
+  #:use-module ((guix transformations)
                 #:select (show-transformation-options-help
                           options->transformation
-                          %standard-build-options
                           %transformation-options))
+  #:use-module ((guix scripts build)
+                #:select (%standard-build-options))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -585,11 +586,11 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
                                       (('argument . (? store-path? item))
                                        item)
                                       (('argument . spec)
-                                       (transform store
-                                                  (specification->package spec)))
+                                       (transform
+                                        (specification->package spec)))
                                       (('expression . exp)
-                                       (transform store
-                                                  (read/eval-package-expression exp)))
+                                       (transform
+                                        (read/eval-package-expression exp)))
                                       (_ #f))
                                     opts)))
         (run-with-store store
diff --git a/guix/scripts/install.scm b/guix/scripts/install.scm
index 894e60f9da..63e625f266 100644
--- a/guix/scripts/install.scm
+++ b/guix/scripts/install.scm
@@ -20,6 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts package)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix scripts)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 979d4f8363..c72dc3caad 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -9,7 +9,8 @@
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
-;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2019, 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,11 +48,15 @@
   ;; provided MESSAGE.
   (for-each
    (lambda (lint-warning)
-     (let ((package (lint-warning-package lint-warning))
-           (loc     (lint-warning-location lint-warning)))
-       (info loc (G_ "~a@~a: ~a~%")
-             (package-name package) (package-version package)
-             (lint-warning-message lint-warning))))
+     (let* ((package (lint-warning-package lint-warning))
+            (name    (package-name package))
+            (version (package-version package))
+            (loc     (lint-warning-location lint-warning))
+            (message (lint-warning-message lint-warning)))
+       (parameterize
+           ((guix-warning-port (current-output-port)))
+         (info loc (G_ "~a@~a: ~a~%")
+               name version message))))
    warnings))
 
 (define* (run-checkers package checkers #:key store)
@@ -98,6 +103,12 @@ run the checkers on all packages.\n"))
   (display (G_ "
   -c, --checkers=CHECKER1,CHECKER2...
                          only run the specified checkers"))
+   (display (G_ "
+  -x, --exclude=CHECKER1,CHECKER2...
+                         exclude the specified checkers"))
+  (display (G_ "
+  -n, --no-network       only run checkers that do not access the network"))
+
   (display (G_ "
   -L, --load-path=DIR    prepend DIR to the package module search path"))
   (newline)
@@ -110,32 +121,37 @@ run the checkers on all packages.\n"))
   (newline)
   (show-bug-report-information))
 
+(define (option-checker short-long)
+  ;; Factorize the creation of the two options -c/--checkers and -x/--exclude,
+  ;; see %options.  The parameter SHORT-LONG is the list containing the short
+  ;; and long name.  The alist uses the long name as symbol.
+  (option short-long #t #f
+          (lambda (opt name arg result)
+            (let ((names (map string->symbol (string-split arg #\,)))
+                  (checker-names (map lint-checker-name %all-checkers))
+                  (option-name (string->symbol (match short-long
+                                                 ((short long) long)))))
+              (for-each (lambda (c)
+                          (unless (memq c checker-names)
+                            (leave (G_ "~a: invalid checker~%") c)))
+                        names)
+              (alist-cons option-name
+                          (filter (lambda (checker)
+                                    (member (lint-checker-name checker)
+                                            names))
+                                  %all-checkers)
+                          result)))))
 
 (define %options
   ;; Specification of the command-line options.
   ;; TODO: add some options:
   ;; * --certainty=[low,medium,high]: only run checkers that have at least this
   ;;                                  'certainty'.
-  (list (option '(#\c "checkers") #t #f
-                (lambda (opt name arg result)
-                  (let ((names (map string->symbol (string-split arg #\,)))
-                        (checker-names (map lint-checker-name %all-checkers)))
-                    (for-each (lambda (c)
-                                (unless (memq c checker-names)
-                                  (leave (G_ "~a: invalid checker~%") c)))
-                              names)
-                    (alist-cons 'checkers
-                                (filter (lambda (checker)
-                                          (member (lint-checker-name checker)
-                                                  names))
-                                        %all-checkers)
-                                result))))
+  (list (option-checker '(#\c "checkers"))
+        (option-checker '(#\x "exclude"))
         (option '(#\n "no-network") #f #f
                 (lambda (opt name arg result)
-                  (alist-cons 'checkers
-                              %local-checkers
-                              (alist-delete 'checkers
-                                            result))))
+                  (alist-cons 'no-network? #t result)))
         (find (lambda (option)
                 (member "load-path" (option-names option)))
               %standard-build-options)
@@ -172,7 +188,16 @@ run the checkers on all packages.\n"))
                               value)
                              (_ #f))
                            (reverse opts)))
-         (checkers (or (assoc-ref opts 'checkers) %all-checkers)))
+         (no-checkers (or (assoc-ref opts 'exclude) '()))
+         (the-checkers (filter (lambda (checker)
+                                 (not (member checker no-checkers)))
+                               (or (assoc-ref opts 'checkers) %all-checkers)))
+         (checkers
+          (if (assoc-ref opts 'no-network?)
+              (filter (lambda (checker)
+                        (member checker %local-checkers))
+                      the-checkers)
+              the-checkers)))
 
     (when (assoc-ref opts 'list?)
       (list-checkers-and-exit checkers))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index a5fe98b675..6366556647 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -53,7 +53,22 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 binary-ports)
   #:export (build-machine
+            build-machine?
+            build-machine-name
+            build-machine-port
+            build-machine-systems
+            build-machine-user
+            build-machine-private-key
+            build-machine-host-key
+            build-machine-compression
+            build-machine-daemon-socket
+            build-machine-overload-threshold
+            build-machine-systems
+            build-machine-features
+
             build-requirements
+            build-requirements?
+
             guix-offload))
 
 ;;; Commentary:
@@ -182,8 +197,10 @@ can interpret meaningfully."
 private key from '~a': ~a")
                                 file str)))))
 
-(define* (open-ssh-session machine #:optional (max-silent-time -1))
-  "Open an SSH session for MACHINE and return it.  Throw an error on failure."
+(define* (open-ssh-session machine #:optional max-silent-time)
+  "Open an SSH session for MACHINE and return it.  Throw an error on failure.
+When MAX-SILENT-TIME is true, it must be a positive integer denoting the
+number of seconds after which the connection times out."
   (let ((private (private-key-from-file* (build-machine-private-key machine)))
         (public  (public-key-from-file
                   (string-append (build-machine-private-key machine)
@@ -220,9 +237,10 @@ private key from '~a': ~a")
            (leave (G_ "SSH public key authentication failed for '~a': ~a~%")
                   (build-machine-name machine) (get-error session))))
 
-       ;; From then on use MAX-SILENT-TIME as the absolute timeout when
-       ;; reading from or write to a channel for this session.
-       (session-set! session 'timeout max-silent-time)
+       (when max-silent-time
+         ;; From then on use MAX-SILENT-TIME as the absolute timeout when
+         ;; reading from or write to a channel for this session.
+         (session-set! session 'timeout max-silent-time))
 
        session)
       (x
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ea2a96d5a1..6e0a16f033 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,6 +45,7 @@
   #:use-module (guix search-paths)
   #:use-module (guix build-system gnu)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
@@ -59,11 +61,16 @@
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:export (compressor?
+            compressor-name
+            compressor-extenstion
+            compressor-command
+            %compressors
             lookup-compressor
             self-contained-tarball
             docker-image
             squashfs-image
 
+            %formats
             guix-pack))
 
 ;; Type of a compression tool.
@@ -142,9 +149,11 @@ dependencies are registered."
 
   (define build
     (with-extensions gcrypt-sqlite3&co
-      (with-imported-modules (source-module-closure
-                              '((guix build store-copy)
-                                (guix store database)))
+      (with-imported-modules `(((guix config) => ,(make-config.scm))
+                               ,@(source-module-closure
+                                  '((guix build store-copy)
+                                    (guix store database))
+                                  #:select? not-config?))
         #~(begin
             (use-modules (guix store database)
                          (guix build store-copy)
@@ -757,12 +766,13 @@ last resort for relocation."
                               (guix elf)))
       #~(begin
           (use-modules (guix build utils)
-                       ((guix build union) #:select (relative-file-name))
+                       ((guix build union) #:select (symlink-relative))
                        (guix elf)
                        (guix build gremlin)
                        (ice-9 binary-ports)
                        (ice-9 ftw)
                        (ice-9 match)
+                       (ice-9 receive)
                        (srfi srfi-1)
                        (rnrs bytevectors))
 
@@ -856,7 +866,7 @@ last resort for relocation."
               (("@STORE_DIRECTORY@") (%store-directory)))
 
             (let* ((base   (strip-store-prefix program))
-                   (result (string-append target "/" base))
+                   (result (string-append target base))
                    (proot  #$(and proot?
                                   #~(string-drop
                                      #$(file-append (proot) "/bin/proot")
@@ -865,6 +875,9 @@ last resort for relocation."
               (mkdir-p (dirname result))
               (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
                      "run.c" "-o" result
+                     (string-append "-DWRAPPER_PROGRAM=\""
+                                    (canonicalize-path (dirname result)) "/"
+                                    (basename result) "\"")
                      (append (if proot
                                  (list (string-append "-DPROOT_PROGRAM=\""
                                                       proot "\""))
@@ -879,16 +892,27 @@ last resort for relocation."
           (mkdir target)
           (for-each (lambda (file)
                       (unless (member file '("." ".." "bin" "sbin" "libexec"))
-                        (let ((file* (string-append input "/" file)))
-                          (symlink (relative-file-name target file*)
-                                   (string-append target "/" file)))))
+                        (symlink-relative (string-append input  "/" file)
+                                          (string-append target "/" file))))
                     (scandir input))
 
-          (for-each build-wrapper
-                    ;; Note: Trailing slash in case these are symlinks.
-                    (append (find-files (string-append input "/bin/"))
-                            (find-files (string-append input "/sbin/"))
-                            (find-files (string-append input "/libexec/")))))))
+          (receive (executables others)
+              (partition executable-file?
+			 ;; Note: Trailing slash in case these are symlinks.
+                         (append (find-files (string-append input "/bin/"))
+                                 (find-files (string-append input "/sbin/"))
+                                 (find-files (string-append input "/libexec/"))))
+            ;; Wrap only executables, since the wrapper will eventually need
+            ;; to execve them.  E.g. git's "libexec" directory contains many
+            ;; shell scripts that are source'd from elsewhere, which fails if
+            ;; they are wrapped.
+            (for-each build-wrapper executables)
+            ;; Link any other non-executable files
+            (for-each (lambda (old)
+                        (let ((new (string-append target (strip-store-prefix old))))
+                          (mkdir-p (dirname new))
+                          (symlink-relative old new)))
+                      others)))))
 
   (computed-file (string-append
                   (cond ((package? package)
@@ -1127,9 +1151,9 @@ Create a bundle of PACKAGE.\n"))
     (let* ((transform     (options->transformation opts))
            (packages      (map (match-lambda
                                  (((? package? package) output)
-                                  (list (transform store package) output))
+                                  (list (transform package) output))
                                  ((? package? package)
-                                  (list (transform store package) "out")))
+                                  (list (transform package) "out")))
                                (reverse
                                 (filter-map maybe-package-argument opts))))
            (manifests     (filter-map (match-lambda
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 2f04652634..6faf2adb7a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -41,6 +41,7 @@
   #:use-module (guix config)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix describe)
   #:autoload   (guix store roots) (gc-roots user-owned?)
   #:use-module ((guix build utils)
@@ -223,7 +224,7 @@ non-zero relevance score."
       (($ <manifest-entry> name version output (? string? path))
        (match (find-best-packages-by-name name #f)
          ((pkg . rest)
-          (let* ((pkg               (transform store pkg))
+          (let* ((pkg               (transform pkg))
                  (candidate-version (package-version pkg)))
             (match (package-superseded pkg)
               ((? package? new)
@@ -873,7 +874,7 @@ processed, #f otherwise."
   (define transform (options->transformation opts))
 
   (define (transform-entry entry)
-    (let ((item (transform store (manifest-entry-item entry))))
+    (let ((item (transform (manifest-entry-item entry))))
       (manifest-entry-with-transformations
        (manifest-entry
          (inherit entry)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 4eaf961ab2..2a2185e2b9 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -1,6 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
 ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,10 +63,14 @@
   #:use-module ((guix build utils)
                 #:select (dump-port mkdir-p find-files))
   #:use-module ((guix build syscalls) #:select (set-thread-name))
-  #:export (%public-key
+  #:export (%default-gzip-compression
+
+            %public-key
             %private-key
             signed-string
 
+            open-server-socket
+            run-publish-server
             guix-publish))
 
 (define (show-help)
@@ -82,6 +88,9 @@ Publish ~a over HTTP.\n") %store-directory)
   (display (G_ "
   -c, --cache=DIRECTORY  cache published items to DIRECTORY"))
   (display (G_ "
+      --cache-bypass-threshold=SIZE
+                         serve store items below SIZE even when not cached"))
+  (display (G_ "
       --workers=N        use N workers to bake items"))
   (display (G_ "
       --ttl=TTL          announce narinfos can be cached for TTL seconds"))
@@ -134,6 +143,12 @@ if ITEM is already compressed."
       (list %no-compression)
       requested))
 
+(define (low-compression c)
+  "Return <compression> of the same type as C, but optimized for low CPU
+usage."
+  (compression (compression-type c)
+               (min (compression-level c) 2)))
+
 (define %options
   (list (option '(#\h "help") #f #f
                 (lambda _
@@ -184,6 +199,10 @@ if ITEM is already compressed."
         (option '(#\c "cache") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'cache arg result)))
+        (option '("cache-bypass-threshold") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'cache-bypass-threshold (size->number arg)
+                              result)))
         (option '("workers") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'workers (string->number* arg)
@@ -236,6 +255,21 @@ if ITEM is already compressed."
     ("WantMassQuery" . 0)
     ("Priority" . 100)))
 
+;;; A common buffer size value used for the TCP socket SO_SNDBUF option and
+;;; the gzip compressor buffer size.
+(define %default-buffer-size
+  (* 208 1024))
+
+(define %default-socket-options
+  ;; List of options passed to 'setsockopt' when transmitting files.
+  (list (list SO_SNDBUF %default-buffer-size)))
+
+(define* (configure-socket socket #:key (level SOL_SOCKET)
+                           (options %default-socket-options))
+  "Apply multiple option tuples in OPTIONS to SOCKET, using LEVEL."
+  (for-each (cut apply setsockopt socket level <>)
+            options))
+
 (define (signed-string s)
   "Sign the hash of the string S with the daemon's key.  Return a canonical
 sexp for the signature."
@@ -434,7 +468,7 @@ items.  Failing that, we could eventually have to recompute them and return
             (expiration-time file))))))
 
 (define (hash-part->path* store hash cache)
-  "Like 'hash-part->path' but cached results under CACHE.  This ensures we can
+  "Like 'hash-part->path' but cache results under CACHE.  This ensures we can
 still map HASH to the corresponding store file name, even if said store item
 vanished from the store in the meantime."
   (let ((cached (hash-part-mapping-cache-file cache hash)))
@@ -454,6 +488,18 @@ vanished from the store in the meantime."
                result))
             (apply throw args))))))
 
+(define cache-bypass-threshold
+  ;; Maximum size of a store item that may be served by the '/cached' handlers
+  ;; below even when not in cache.
+  (make-parameter (* 10 (expt 2 20))))
+
+(define (bypass-cache? store item)
+  "Return true if we allow ITEM to be downloaded before it is cached.  ITEM is
+interpreted as the basename of a store item."
+  (guard (c ((store-error? c) #f))
+    (< (path-info-nar-size (query-path-info store item))
+       (cache-bypass-threshold))))
+
 (define* (render-narinfo/cached store request hash
                                 #:key ttl (compressions (list %no-compression))
                                 (nar-path "nar")
@@ -513,9 +559,20 @@ requested using POOL."
                                                      (nar-expiration-time ttl)
                                                      #:delete-entry delete-entry
                                                      #:cleanup-period ttl))))
-           (not-found request
-                      #:phrase "We're baking it"
-                      #:ttl 300))              ;should be available within 5m
+
+           ;; If ITEM passes 'bypass-cache?', render a temporary narinfo right
+           ;; away, with a short TTL.  The narinfo is temporary because it
+           ;; lacks 'FileSize', for instance, which the cached narinfo will
+           ;; have.  Chances are that the nar will be baked by the time the
+           ;; client asks for it.
+           (if (bypass-cache? store item)
+               (render-narinfo store request hash
+                               #:ttl 300          ;temporary
+                               #:nar-path nar-path
+                               #:compressions compressions)
+               (not-found request
+                          #:phrase "We're baking it"
+                          #:ttl 300)))          ;should be available within 5m
           (else
            (not-found request #:phrase "")))))
 
@@ -532,7 +589,7 @@ requested using POOL."
        (lambda (port)
          (write-file item port))
        #:level (compression-level compression)
-       #:buffer-size (* 128 1024))
+       #:buffer-size %default-buffer-size)
      (rename-file (string-append nar ".tmp") nar))
     ('lzip
      ;; Note: the file port gets closed along with the lzip port.
@@ -546,7 +603,10 @@ requested using POOL."
      ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
      (with-atomic-file-output nar
        (lambda (port)
-         (write-file item port))))))
+         (write-file item port)
+         ;; Make the file world-readable, contrary to what
+         ;; 'with-atomic-file-output' does.
+         (chmod port (logand #o644 (lognot (umask)))))))))
 
 (define* (bake-narinfo+nar cache item
                            #:key ttl (compressions (list %no-compression))
@@ -578,7 +638,12 @@ requested using POOL."
                                           #:nar-path nar-path
                                           #:compressions compressions
                                           #:file-sizes sizes)
-                          port)))))
+                          port)))
+
+             ;; Make the cached narinfo world-readable, contrary to what
+             ;; 'with-atomic-file-output' does, so that other users can rsync
+             ;; the whole cache.
+             (chmod port (logand #o644 (lognot (umask))))))
 
          ;; Make narinfo files for OTHERS hard links to NARINFO such that the
          ;; atime-based cache eviction considers either all the nars or none
@@ -627,19 +692,32 @@ return it; otherwise, return 404.  When TTL is true, use it as the
 'Cache-Control' expiration time."
   (let ((cached (nar-cache-file cache store-item
                                 #:compression compression)))
-    (if (file-exists? cached)
-        (values `((content-type . (application/octet-stream
-                                   (charset . "ISO-8859-1")))
-                  ,@(if ttl
-                        `((cache-control (max-age . ,ttl)))
-                        '())
-
-                  ;; XXX: We're not returning the actual contents, deferring
-                  ;; instead to 'http-write'.  This is a hack to work around
-                  ;; <http://bugs.gnu.org/21093>.
-                  (x-raw-file . ,cached))
-                #f)
-        (not-found request))))
+    (cond ((file-exists? cached)
+           (values `((content-type . (application/octet-stream
+                                      (charset . "ISO-8859-1")))
+                     ,@(if ttl
+                           `((cache-control (max-age . ,ttl)))
+                           '())
+
+                     ;; XXX: We're not returning the actual contents, deferring
+                     ;; instead to 'http-write'.  This is a hack to work around
+                     ;; <http://bugs.gnu.org/21093>.
+                     (x-raw-file . ,cached))
+                   #f))
+          ((let* ((hash (and=> (string-index store-item #\-)
+                               (cut string-take store-item <>)))
+                  (item (and hash
+                             (guard (c ((store-error? c) #f))
+                               (hash-part->path store hash)))))
+             (and item (not (string-null? item))
+                  (bypass-cache? store item)))
+           ;; Render STORE-ITEM live.  We reach this because STORE-ITEM is
+           ;; being baked but clients are already asking for it.  Thus, we're
+           ;; duplicating work, but doing so allows us to reduce delays.
+           (render-nar store request store-item
+                       #:compression (low-compression compression)))
+          (else
+           (not-found request)))))
 
 (define (render-content-addressed-file store request
                                        name algo hash)
@@ -686,6 +764,13 @@ to compress or decompress the log file; just return it as-is."
         (values (response-headers log) log)
         (not-found request))))
 
+(define (render-signing-key)
+  "Render signing key."
+  (let ((file %public-key-file))
+    (values `((content-type . (text/plain (charset . "UTF-8")))
+              (x-raw-file . ,file))
+            file)))
+
 (define (render-home-page request)
   "Render the home page."
   (values `((content-type . (text/html (charset . "UTF-8"))))
@@ -699,7 +784,12 @@ to compress or decompress the log file; just return it as-is."
                                (a (@ (href
                                       "https://guix.gnu.org/manual/en/html_node/Invoking-guix-publish.html"))
                                   (tt "guix publish"))
-                               " speaking.  Welcome!")))
+                               " speaking.  Welcome!")
+                            (p "Here is the "
+                               (a (@ (href
+                                      "signing-key.pub"))
+                                  (tt "signing key"))
+                               " for this server. Knock yourselves out!")))
                          port)))))
 
 (define (extract-narinfo-hash str)
@@ -796,7 +886,7 @@ or if EOF is reached."
      ;; 'make-gzip-output-port' wants a file port.
      (make-gzip-output-port (response-port response)
                             #:level level
-                            #:buffer-size (* 64 1024)))
+                            #:buffer-size %default-buffer-size))
     (($ <compression> 'lzip level)
      (make-lzip-output-port (response-port response)
                             #:level level))
@@ -821,6 +911,7 @@ blocking."
                                             client))
                (port        (begin
                               (force-output client)
+                              (configure-socket client)
                               (nar-response-port response compression))))
           ;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in
           ;; 'render-nar', BODY here is just the file name of the store item.
@@ -850,7 +941,7 @@ blocking."
                                                                          size)
                                                     client))
                           (output   (response-port response)))
-                     (setsockopt client SOL_SOCKET SO_SNDBUF (* 128 1024))
+                     (configure-socket client)
                      (if (file-port? output)
                          (sendfile output input size)
                          (dump-port input output))
@@ -918,6 +1009,9 @@ methods, return the applicable compression."
           ;; /
           ((or () ("index.html"))
            (render-home-page request))
+          ;; guix signing-key
+          (("signing-key.pub")
+           (render-signing-key))
           ;; /<hash>.narinfo
           (((= extract-narinfo-hash (? string? hash)))
            (if cache
@@ -992,7 +1086,8 @@ methods, return the applicable compression."
 (define (open-server-socket address)
   "Return a TCP socket bound to ADDRESS, a socket address."
   (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
-    (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+    (configure-socket sock #:options (cons (list SO_REUSEADDR 1)
+                                           %default-socket-options))
     (bind sock address)
     sock))
 
@@ -1061,7 +1156,10 @@ methods, return the applicable compression."
 consider using the '--user' option!~%")))
 
       (parameterize ((%public-key public-key)
-                     (%private-key private-key))
+                     (%private-key private-key)
+                     (cache-bypass-threshold
+                      (or (assoc-ref opts 'cache-bypass-threshold)
+                          (cache-bypass-threshold))))
         (info (G_ "publishing ~a on ~a, port ~d~%")
               %store-directory
               (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index bb1b560a22..7fd8b3f1a4 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -385,7 +385,7 @@ previous generation.  Return true if there are news to display."
     (and=> (relative-generation profile -1)
            (cut generation-file-name profile <>)))
 
-  (when previous
+  (and previous
     (let ((old-channels (profile-channels previous))
           (new-channels (profile-channels profile)))
       ;; Find the channels present in both PROFILE and PREVIOUS, and print
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 4a71df28d1..fb6c52a567 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -440,7 +440,7 @@ releases for ~a~%")
                  (full-name x)))
         (lst
          (format (current-output-port)
-                 (N_ "Building the following ~*package would ensure ~d \
+                 (N_ "Building the following ~d package would ensure ~d \
 dependent packages are rebuilt: ~{~a~^ ~}~%"
                      "Building the following ~d packages would ensure ~d \
 dependent packages are rebuilt: ~{~a~^ ~}~%"
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 7ec170b08a..ddb885d344 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -656,7 +656,7 @@ print a warning and return #f."
                 (get-bytevector-n port len)
                 (read-to-eof port))
             (cache-narinfo! url (hash-part->path hash-part) #f
-                            (if (= 404 code)
+                            (if (or (= 404 code) (= 202 code))
                                 ttl
                                 %narinfo-transient-error-ttl))
             result))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 9ed5c26483..db80e0be8f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -385,6 +385,8 @@ STORE is an open connection to the store."
          (params (first (profile-boot-parameters %system-profile
                                                  (list number))))
          (locale (boot-parameters-locale params))
+         (store-directory-prefix
+          (boot-parameters-store-directory-prefix params))
          (old-generations
           (delv number (reverse (generation-numbers %system-profile))))
          (old-params (profile-boot-parameters
@@ -398,6 +400,7 @@ STORE is an open connection to the store."
                      ((bootloader-configuration-file-generator bootloader)
                       bootloader-config entries
                       #:locale locale
+                      #:store-directory-prefix store-directory-prefix
                       #:old-entries old-entries)))
            (drvs -> (list bootcfg)))
         (mbegin %store-monad
@@ -671,7 +674,8 @@ checking this by themselves in their 'check' procedure."
 (define* (system-derivation-for-action os action
                                        #:key image-size image-type
                                        full-boot? container-shared-network?
-                                       mappings label)
+                                       mappings label
+                                       volatile-root?)
   "Return as a monadic value the derivation for OS according to ACTION."
   (mlet %store-monad ((target (current-target-system)))
     (case action
@@ -703,7 +707,8 @@ checking this by themselves in their 'check' procedure."
                          base-image))
             (target (or base-target target))
             (size image-size)
-            (operating-system os))))))
+            (operating-system os)
+            (volatile-root? volatile-root?))))))
       ((docker-image)
        (system-docker-image os
                             #:shared-network? container-shared-network?)))))
@@ -758,6 +763,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size image-type
+                         volatile-root?
                          full-boot? label container-shared-network?
                          (mappings '())
                          (gc-root #f))
@@ -765,7 +771,8 @@ and TARGET arguments."
 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.  IMAGE-TYPE is the type of image to
-be built.
+be built.  When VOLATILE-ROOT? is #t, the root file system is mounted
+volatile.
 
 FULL-BOOT? is used for the 'vm' action; it determines whether to
 boot directly to the kernel or to the bootloader.  CONTAINER-SHARED-NETWORK?
@@ -813,6 +820,7 @@ static checks."
                                                 #:label label
                                                 #:image-type image-type
                                                 #:image-size image-size
+                                                #:volatile-root? volatile-root?
                                                 #:full-boot? full-boot?
                                                 #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
@@ -972,6 +980,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --no-bootloader    for 'init', do not install a bootloader"))
   (display (G_ "
+      --volatile         for 'disk-image', make the root file system volatile"))
+  (display (G_ "
       --label=LABEL      for 'disk-image', label disk image with LABEL"))
   (display (G_ "
       --save-provenance  save provenance information"))
@@ -1045,6 +1055,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
+         (option '("volatile") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'volatile-root? #t result)))
          (option '("label") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'label arg result)))
@@ -1106,7 +1119,8 @@ Some ACTIONS support additional ARGS.\n"))
     (image-type . raw)
     (image-size . guess)
     (install-bootloader? . #t)
-    (label . #f)))
+    (label . #f)
+    (volatile-root? . #f)))
 
 (define (verbosity-level opts)
   "Return the verbosity level based on OPTS, the alist of parsed options."
@@ -1203,6 +1217,8 @@ resulting from command-line parsing."
                                #:image-type (lookup-image-type-by-name
                                              (assoc-ref opts 'image-type))
                                #:image-size (assoc-ref opts 'image-size)
+                               #:volatile-root?
+                               (assoc-ref opts 'volatile-root?)
                                #:full-boot? (assoc-ref opts 'full-boot?)
                                #:container-shared-network?
                                (assoc-ref opts 'container-shared-network?)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index d89caf80fc..5581e12892 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -204,7 +204,8 @@ services as defined by OS."
 ;;; Bootloader configuration.
 ;;;
 
-(define (install-bootloader-program installer bootloader-package bootcfg
+(define (install-bootloader-program installer disk-installer
+                                    bootloader-package bootcfg
                                     bootcfg-file device target)
   "Return an executable store item that, upon being evaluated, will install
 BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device,
@@ -246,10 +247,17 @@ BOOTLOADER-PACKAGE."
              ;; a broken installation.
              (switch-symlinks new-gc-root #$bootcfg)
              (install-boot-config #$bootcfg #$bootcfg-file #$target)
-             (when #$installer
+             (when (or #$installer #$disk-installer)
                (catch #t
                  (lambda ()
-                   (#$installer #$bootloader-package #$device #$target))
+                   ;; The bootloader might not support installation on a
+                   ;; mounted directory using the BOOTLOADER-INSTALLER
+                   ;; procedure. In that case, fallback to installing the
+                   ;; bootloader directly on DEVICE using the
+                   ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
+                   (if #$installer
+                       (#$installer #$bootloader-package #$device #$target)
+                       (#$disk-installer #$bootloader-package 0 #$device)))
                  (lambda args
                    (delete-file new-gc-root)
                    (match args
@@ -272,11 +280,14 @@ additional configurations specified by MENU-ENTRIES can be selected."
   (let* ((bootloader (bootloader-configuration-bootloader configuration))
          (installer (and run-installer?
                          (bootloader-installer bootloader)))
+         (disk-installer (and run-installer?
+                              (bootloader-disk-image-installer bootloader)))
          (package (bootloader-package bootloader))
          (device (bootloader-configuration-target configuration))
          (bootcfg-file (bootloader-configuration-file bootloader)))
     (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
               (primitive-load #$(install-bootloader-program installer
+                                                            disk-installer
                                                             package
                                                             bootcfg
                                                             bootcfg-file
diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm
index 5ec844328e..dcbcb2ab09 100644
--- a/guix/scripts/upgrade.scm
+++ b/guix/scripts/upgrade.scm
@@ -21,6 +21,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts package)
   #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix scripts)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 6a2582c997..f28070ddc4 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   #:use-module (guix grafts)
   #:use-module (guix gexp)
   #:use-module ((guix build syscalls) #:select (terminal-columns))
+  #:use-module ((guix build utils) #:select (every*))
   #:use-module (guix scripts substitute)
   #:use-module (guix http-client)
   #:use-module (guix ci)
@@ -540,23 +542,23 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                                     (package-outputs packages system))
                                   systems))))))
         (exit
-         (every (lambda (server)
-                  (define coverage
-                    (report-server-coverage server items
-                                            #:display-missing?
-                                            (assoc-ref opts 'display-missing?)))
-                  (match (assoc-ref opts 'coverage)
-                    (#f #f)
-                    (threshold
-                     ;; PACKAGES may include non-package objects coming from a
-                     ;; manifest.  Filter them out.
-                     (report-package-coverage server
-                                              (filter package? packages)
-                                              systems
-                                              #:threshold threshold)))
-
-                  (= 1 coverage))
-                urls))))))
+         (every* (lambda (server)
+                   (define coverage
+                     (report-server-coverage server items
+                                             #:display-missing?
+                                             (assoc-ref opts 'display-missing?)))
+                   (match (assoc-ref opts 'coverage)
+                     (#f #f)
+                     (threshold
+                      ;; PACKAGES may include non-package objects coming from a
+                      ;; manifest.  Filter them out.
+                      (report-package-coverage server
+                                               (filter package? packages)
+                                               systems
+                                               #:threshold threshold)))
+
+                   (= 1 coverage))
+                 urls))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'let/time 'scheme-indent-function 1)