Merge branch 'master' into staging.

36 files changed, 1081 insertions, 398 deletions

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 2f74000eef..651415098e 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -273,9 +273,7 @@ standard packages used as implicit inputs of the GNU build system."
 
   ;; Resolve (gnu packages commencement) lazily to hide circular dependency.
   (let ((distro (resolve-module '(gnu packages commencement))))
-    (if (target-riscv64?)
-      (module-ref distro '%final-inputs-riscv64)
-      (module-ref distro '%final-inputs))))
+    (module-ref distro '%final-inputs)))
 
 (define* (lower name
                 #:key source inputs native-inputs outputs target
diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm
index 6261f8a55a..66e7711bcd 100644
--- a/guix/build-system/julia.scm
+++ b/guix/build-system/julia.scm
@@ -2,7 +2,8 @@
 ;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
-;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021, 2022 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,6 +89,7 @@
                       (guile #f)
                       (julia-package-name #f)
                       (julia-package-uuid #f)
+                      (julia-package-dependencies ''())
                       (imported-modules %julia-build-system-modules)
                       (modules '((guix build julia-build-system)
                                  (guix build utils))))
@@ -108,7 +110,8 @@
                                                search-paths))
                        #:inputs #$(input-tuples->gexp inputs)
                        #:julia-package-name #$julia-package-name
-                       #:julia-package-uuid #$julia-package-uuid))))
+                       #:julia-package-uuid #$julia-package-uuid
+                       #:julia-package-dependencies #$julia-package-dependencies))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index ad604f8871..9fee6c4570 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -58,6 +59,7 @@ for TRIPLET."
                           (if (target-64bit? triplet)
                               "ppc64"
                               "ppc"))
+                         ((target-riscv64? triplet) "riscv64")
                          (#t (error "meson: unknown architecture"))))
     (cpu . ,(cond ((target-x86-32? triplet) ; i386, ..., i686
                    (substring triplet 0 4))
@@ -78,6 +80,8 @@ for TRIPLET."
                      ;; At least in Guix.  Aarch64 and 32-bit arm
                      ;; have a big-endian mode as well.
                      ((target-arm? triplet) "little")
+                     ((target-ppc32? triplet) "big")
+                     ((target-riscv64? triplet) "little")
                      (#t (error "meson: unknown architecture"))))))
 
 (define (make-binaries-alist triplet)
diff --git a/guix/build-system/ocaml.scm b/guix/build-system/ocaml.scm
index e7d6d96f0e..5ced9d243b 100644
--- a/guix/build-system/ocaml.scm
+++ b/guix/build-system/ocaml.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
-;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -216,13 +216,13 @@ pre-defined variants."
          (host-inputs `(,@(if source
                               `(("source" ,source))
                               '())
-                        ,@inputs
-
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
+                        ,@inputs))
          (build-inputs `(("ocaml" ,ocaml)
                          ("findlib" ,findlib)
-                         ,@native-inputs))
+                         ,@native-inputs
+
+                         ;; Keep the standard inputs of 'gnu-build-system'.
+                         ,@(standard-packages)))
          (outputs outputs)
          (build ocaml-build)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 7c310e94f1..41583e8143 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com>
@@ -28,6 +28,7 @@
   #:use-module (guix ftp-client)
   #:use-module (guix build utils)
   #:use-module (guix progress)
+  #:use-module (guix memoization)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
@@ -177,27 +178,30 @@ name decoding bug described at
   (let ((data (call-with-input-file file get-bytevector-all)))
     (set-certificate-credentials-x509-trust-data! cred data format)))
 
-(define (make-credendials-with-ca-trust-files directory)
-  "Return certificate credentials with X.509 authority certificates read from
+(define make-credentials-with-ca-trust-files
+  (mlambda (directory)
+    "Return certificate credentials with X.509 authority certificates read from
 DIRECTORY.  Those authority certificates are checked when
 'peer-certificate-status' is later called."
-  (let ((cred  (make-certificate-credentials))
-        (files (match (scandir directory (cut string-suffix? ".pem" <>))
-                 ((or #f ())
-                  ;; Some distros provide nothing but bundles (*.crt) under
-                  ;; /etc/ssl/certs, so look for them.
-                  (or (scandir directory (cut string-suffix? ".crt" <>))
-                      '()))
-                 (pem pem))))
-    (for-each (lambda (file)
-                (let ((file (string-append directory "/" file)))
-                  ;; Protect against dangling symlinks.
-                  (when (file-exists? file)
-                    (set-certificate-credentials-x509-trust-file!*
-                     cred file
-                     x509-certificate-format/pem))))
-              files)
-    cred))
+    ;; Memoize the result to avoid scanning all the certificates every time a
+    ;; connection is made.
+    (let ((cred  (make-certificate-credentials))
+          (files (match (scandir directory (cut string-suffix? ".pem" <>))
+                   ((or #f ())
+                    ;; Some distros provide nothing but bundles (*.crt) under
+                    ;; /etc/ssl/certs, so look for them.
+                    (or (scandir directory (cut string-suffix? ".crt" <>))
+                        '()))
+                   (pem pem))))
+      (for-each (lambda (file)
+                  (let ((file (string-append directory "/" file)))
+                    ;; Protect against dangling symlinks.
+                    (when (file-exists? file)
+                      (set-certificate-credentials-x509-trust-file!*
+                       cred file
+                       x509-certificate-format/pem))))
+                files)
+      cred)))
 
 (define (peer-certificate session)
   "Return the certificate of the remote peer in SESSION."
@@ -273,7 +277,7 @@ host name without trailing dot."
 
     (set-session-credentials! session
                               (if (and verify-certificate? ca-certs)
-                                  (make-credendials-with-ca-trust-files
+                                  (make-credentials-with-ca-trust-files
                                    ca-certs)
                                   (make-certificate-credentials)))
 
@@ -431,8 +435,7 @@ ETIMEDOUT error is raised."
                                   #:key
                                   timeout
                                   (verify-certificate? #t))
-  "Like 'open-socket-for-uri', but also handle HTTPS connections.  The
-resulting port must be closed with 'close-connection'.  When
+  "Like 'open-socket-for-uri', but also handle HTTPS connections.  When
 VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
   ;; Note: Guile 2.2.0's (web client) has a same-named export that's actually
   ;; undefined.  See Guile commit 011669af3b428e5626f7bbf66b11d57d9768c047.
diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm
index 03d669be64..b0dac154e9 100644
--- a/guix/build/julia-build-system.scm
+++ b/guix/build/julia-build-system.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2019, 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
 ;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
 ;;; Copyright © 2021, 2022 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -111,9 +112,9 @@ Project.toml)."
            (job-count (if parallel-tests?
                           (parallel-job-count)
                           1))
-           ;; The --proc argument of Julia *adds* extra processors rather than
-           ;; specify the exact count to use, so zero must be specified to
-           ;; disable parallel processing...
+           ;; The --procs argument of Julia *adds* extra processors rather
+           ;; than specify the exact count to use, so zero must be specified
+           ;; to disable parallel processing...
            (additional-procs (max 0 (1- job-count))))
       ;; With a patch, SOURCE_DATE_EPOCH is honored
       (setenv "SOURCE_DATE_EPOCH" "1")
@@ -126,7 +127,7 @@ Project.toml)."
       (setenv "HOME" "/tmp")
       (apply invoke "julia"
              `("--depwarn=yes"
-               ,@(if parallel-tests?
+               ,@(if (and parallel-tests? (< 0 additional-procs))
                      ;; XXX: ... but '--procs' doesn't accept 0 as a valid
                      ;; value, so just omit the argument entirely.
                      (list (string-append  "--procs="
@@ -136,7 +137,8 @@ Project.toml)."
                                package "/test/runtests.jl"))))))
 
 (define* (link-depot #:key source inputs outputs
-                     julia-package-name julia-package-uuid  #:allow-other-keys)
+                     julia-package-name julia-package-uuid
+                     julia-package-dependencies #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (name+version (strip-store-file-name out))
          (version (last (string-split name+version #\-)))
@@ -156,6 +158,7 @@ println(Base.version_slug(Base.UUID(\"~a\"),
         (julia-create-package-toml (getcwd)
                                    julia-package-name julia-package-uuid
                                    version
+                                   julia-package-dependencies
                                    #:file "Project.toml"))
 
     ;; When installing a package, julia looks first at in the JULIA_DEPOT_PATH
@@ -186,9 +189,10 @@ version = \"" version "\"
 ") f)
     (when (not (null? deps))
       (display "[deps]\n" f)
-      (for-each (lambda dep
-                  (display (string-append (car (car dep)) " = \"" (cdr (car dep)) "\"\n")
-                           f))
+      (for-each (match-lambda
+                  ((name . uuid)
+                   (display (string-append name " = \"" uuid "\"\n")
+                            f)))
                 deps))
     (close-port f)))
 
@@ -207,6 +211,7 @@ version = \"" version "\"
     (delete 'build)))
 
 (define* (julia-build #:key inputs julia-package-name julia-package-uuid
+                      julia-package-dependencies
                       (phases %standard-phases)
                       #:allow-other-keys #:rest args)
   "Build the given Julia package, applying all of PHASES in order."
@@ -214,4 +219,5 @@ version = \"" version "\"
          #:inputs inputs #:phases phases
          #:julia-package-name julia-package-name
          #:julia-package-uuid julia-package-uuid
+         #:julia-package-dependencies julia-package-dependencies
          args))
diff --git a/guix/colors.scm b/guix/colors.scm
index 3031f54799..ae0a583d94 100644
--- a/guix/colors.scm
+++ b/guix/colors.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2013, 2014 Free Software Foundation, Inc.
 ;;; Copyright © 2018 Sahithi Yarlagadda <sahi@swecha.net>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +31,7 @@
 
             colorize-string
             highlight
+            highlight/warn
             dim
 
             color-rules
@@ -143,6 +144,7 @@ that subsequent output will not have any colors in effect."
         str)))
 
 (define highlight (coloring-procedure (color BOLD)))
+(define highlight/warn (coloring-procedure (color BOLD MAGENTA)))
 (define dim (coloring-procedure (color DARK)))
 
 (define (colorize-matches rules)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index f77ea179f4..354ec20e3f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -245,11 +245,19 @@ Nix itself keeps only one of them."
     (make-hash-table 25))
 
   (for-each (lambda (input)
-              (let* ((drv (derivation-input-path input))
+              ;; If DRV1 and DRV2 are fixed-output derivations with the same
+              ;; output path, they must be coalesced.  Thus, TABLE is keyed by
+              ;; output paths.
+              (let* ((drv (derivation-input-derivation input))
+                     (key (string-join
+                           (map (match-lambda
+                                  ((_ . output)
+                                   (derivation-output-path output)))
+                                (derivation-outputs drv))))
                      (sub-drvs (derivation-input-sub-derivations input)))
-                (match (hash-get-handle table drv)
+                (match (hash-get-handle table key)
                   (#f
-                   (hash-set! table drv input))
+                   (hash-set! table key input))
                   ((and handle (key . ($ <derivation-input> drv sub-drvs2)))
                    ;; Merge DUP with INPUT.
                    (let* ((sub-drvs (delete-duplicates
diff --git a/guix/gexp.scm b/guix/gexp.scm
index dfeadbd15d..9fdb7a30be 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -174,12 +174,15 @@ As a result, the S-expression will be approximate if GEXP has references."
          (map (lambda (reference)
                 (match reference
                   (($ <gexp-input> thing output native)
-                   (if (gexp-like? thing)
-                       (gexp->approximate-sexp thing)
-                       ;; Simply returning 'thing' won't work in some
-                       ;; situations; see 'write-gexp' below.
-                       '(*approximate*)))
-                  (_ '(*approximate*))))
+                   (cond ((gexp-like? thing)
+                          (gexp->approximate-sexp thing))
+                         ((not (record? thing)) ; a S-exp
+                          thing)
+                         (#true
+                          ;; Simply returning 'thing' won't work in some
+                          ;; situations; see 'write-gexp' below.
+                          '(*approximate*))))
+                  (($ <gexp-output>) '(*approximate*))))
               (gexp-references gexp))))
 
 (define (write-gexp gexp port)
@@ -598,7 +601,7 @@ This is the declarative counterpart of 'gexp->derivation'."
   (match file
     (($ <computed-file> name gexp guile options)
      (mlet %store-monad ((guile (lower-object (or guile (default-guile))
-                                              system #:target target)))
+                                              system #:target #f)))
        (apply gexp->derivation name gexp #:guile-for-build guile
               #:system system #:target target options)))))
 
@@ -2176,6 +2179,29 @@ is true, the derivation will not print anything."
 ;;;
 
 (eval-when (expand load eval)
+  (define-once read-syntax-redefined?
+    ;; Have we already redefined 'read-syntax'?  This needs to be done on
+    ;; 3.0.8 only to work around <https://issues.guix.gnu.org/54003>.
+    (or (not (module-variable the-scm-module 'read-syntax))
+        (not (guile-version>? "3.0.7"))))
+
+  (define read-procedure
+    ;; The current read procedure being called: either 'read' or
+    ;; 'read-syntax'.
+    (make-parameter read))
+
+  (define read-syntax*
+    ;; Replacement for 'read-syntax'.
+    (let ((read-syntax (and=> (module-variable the-scm-module 'read-syntax)
+                              variable-ref)))
+      (lambda (port . rest)
+        (parameterize ((read-procedure read-syntax))
+          (apply read-syntax port rest)))))
+
+  (unless read-syntax-redefined?
+    (set! (@ (guile) read-syntax) read-syntax*)
+    (set! read-syntax-redefined? #t))
+
   (define* (read-ungexp chr port #:optional native?)
     "Read an 'ungexp' or 'ungexp-splicing' form from PORT.  When NATIVE? is
 true, use 'ungexp-native' and 'ungexp-native-splicing' instead."
@@ -2191,22 +2217,39 @@ true, use 'ungexp-native' and 'ungexp-native-splicing' instead."
              'ungexp-native
              'ungexp))))
 
-    (match (read port)
-      ((? symbol? symbol)
-       (let ((str (symbol->string symbol)))
+    (define symbolic?
+      ;; Depending on whether (read-procedure) is 'read' or 'read-syntax', we
+      ;; might get either sexps or syntax objects.  Adjust accordingly.
+      (if (eq? (read-procedure) read)
+          symbol?
+          (compose symbol? syntax->datum)))
+
+    (define symbolic->string
+      (if (eq? (read-procedure) read)
+          symbol->string
+          (compose symbol->string syntax->datum)))
+
+    (define wrapped-symbol
+      (if (eq? (read-procedure) read)
+          (lambda (_ symbol) symbol)
+          datum->syntax))
+
+    (match ((read-procedure) port)
+      ((? symbolic? symbol)
+       (let ((str (symbolic->string symbol)))
          (match (string-index-right str #\:)
            (#f
             `(,unquote-symbol ,symbol))
            (colon
             (let ((name   (string->symbol (substring str 0 colon)))
                   (output (substring str (+ colon 1))))
-              `(,unquote-symbol ,name ,output))))))
+              `(,unquote-symbol ,(wrapped-symbol symbol name) ,output))))))
       (x
        `(,unquote-symbol ,x))))
 
   (define (read-gexp chr port)
     "Read a 'gexp' form from PORT."
-    `(gexp ,(read port)))
+    `(gexp ,((read-procedure) port)))
 
   ;; Extend the reader
   (read-hash-extend #\~ read-gexp)
diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
index ab3fcd8b2f..419cb85afc 100644
--- a/guix/git-authenticate.scm
+++ b/guix/git-authenticate.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,7 +22,9 @@
   #:use-module (guix base16)
   #:autoload   (guix base64) (base64-encode)
   #:use-module ((guix git)
-                #:select (commit-difference false-if-git-not-found))
+                #:select (commit-difference
+                          commit-descendant?
+                          false-if-git-not-found))
   #:use-module (guix i18n)
   #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix openpgp)
@@ -426,6 +428,17 @@ denoting the authorized keys for commits whose parent lack the
           (verify-introductory-commit repository keyring
                                       start-commit signer))
 
+        ;; Make sure END-COMMIT is a descendant of START-COMMIT or of one of
+        ;; AUTHENTICATED-COMMITS, which are known to be descendants of
+        ;; START-COMMIT.
+        (unless (commit-descendant? end-commit
+                                    (cons start-commit
+                                          authenticated-commits))
+          (raise (formatted-message
+                  (G_ "commit ~a is not a descendant of introductory commit ~a")
+                  (oid->string (commit-id end-commit))
+                  (oid->string (commit-id start-commit)))))
+
         (let ((stats (call-with-progress-reporter reporter
                        (lambda (report)
                          (authenticate-commits repository commits
diff --git a/guix/git.scm b/guix/git.scm
index 43e85a5026..53e7219c8c 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
@@ -46,6 +46,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (%repository-cache-directory
@@ -60,6 +61,7 @@
             latest-repository-commit
             commit-difference
             commit-relation
+            commit-descendant?
 
             remote-refs
 
@@ -623,6 +625,26 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+
+(define (commit-descendant? new old)
+  "Return true if NEW is the descendant of one of OLD, a list of commits.
+
+When the expected result is likely #t, this is faster than using
+'commit-relation' since fewer commits need to be traversed."
+  (let ((old (list->setq old)))
+    (let loop ((commits (list new))
+               (visited (setq)))
+      (match commits
+        (()
+         #f)
+        (_
+         ;; Perform a breadth-first search as this is likely going to
+         ;; terminate more quickly than a depth-first search.
+         (let ((commits (remove (cut set-contains? visited <>) commits)))
+           (or (any (cut set-contains? old <>) commits)
+               (loop (append-map commit-parents commits)
+                     (fold set-insert visited commits)))))))))
+
 
 ;;
 ;;; Remote operations.
diff --git a/guix/graph.scm b/guix/graph.scm
index 3a1cab244b..41219ab67d 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2016, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -22,10 +22,13 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix sets)
+  #:autoload   (guix diagnostics) (formatted-message)
+  #:autoload   (guix i18n) (G_)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:export (node-type
@@ -47,6 +50,8 @@
             %graph-backends
             %d3js-backend
             %graphviz-backend
+            lookup-backend
+
             graph-backend?
             graph-backend
             graph-backend-name
@@ -335,6 +340,13 @@ nodeArray.push(nodes[\"~a\"]);~%"
         %d3js-backend
         %cypher-backend))
 
+(define (lookup-backend name)
+  "Return the graph backend called NAME.  Raise an error if it is not found."
+  (or (find (lambda (backend)
+              (string=? (graph-backend-name backend) name))
+            %graph-backends)
+      (raise (formatted-message (G_ "~a: unknown graph backend") name))))
+
 (define* (export-graph sinks port
                        #:key
                        reverse-edges? node-type (max-depth +inf.0)
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 10bc278023..143ed6de31 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -52,6 +52,7 @@
             http-get-error-uri
             http-get-error-code
             http-get-error-reason
+            http-get-error-headers
 
             http-fetch
             http-multiple-get
@@ -69,9 +70,10 @@
 ;; HTTP GET error.
 (define-condition-type &http-get-error &error
   http-get-error?
-  (uri    http-get-error-uri)                     ; URI
-  (code   http-get-error-code)                    ; integer
-  (reason http-get-error-reason))                 ; string
+  (uri      http-get-error-uri)                   ;URI
+  (code     http-get-error-code)                  ;integer
+  (reason   http-get-error-reason)                ;string
+  (headers  http-get-error-headers))              ;alist
 
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
@@ -98,14 +100,15 @@ TIMEOUT is #f, connection establishment never times out.
 Write information about redirects to LOG-PORT.
 
 Raise an '&http-get-error' condition if downloading fails."
-  (let loop ((uri (if (string? uri)
-                      (string->uri uri)
-                      uri)))
-    (let ((port (or port (open-connection uri
-                                          #:verify-certificate?
-                                          verify-certificate?
-                                          #:timeout timeout)))
-          (headers (match (uri-userinfo uri)
+  (define uri*
+    (if (string? uri) (string->uri uri) uri))
+
+  (let loop ((uri uri*)
+             (port (or port (open-connection uri*
+                                             #:verify-certificate?
+                                             verify-certificate?
+                                             #:timeout timeout))))
+    (let ((headers (match (uri-userinfo uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -129,16 +132,29 @@ Raise an '&http-get-error' condition if downloading fails."
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((uri (resolve-uri-reference (response-location resp) uri)))
-             (close-port port)
+           (let ((host (uri-host uri))
+                 (uri  (resolve-uri-reference (response-location resp) uri)))
+             (if keep-alive?
+                 (dump-port data (%make-void-port "w0")
+                            (response-content-length resp))
+                 (close-port port))
              (format log-port (G_ "following redirection to `~a'...~%")
                      (uri->string uri))
-             (loop uri)))
+             (loop uri
+                   (or (and keep-alive?
+                            (or (not (uri-host uri))
+                                (string=? host (uri-host uri)))
+                            port)
+                       (open-connection uri*
+                                        #:verify-certificate?
+                                        verify-certificate?
+                                        #:timeout timeout)))))
           (else
            (raise (condition (&http-get-error
                               (uri uri)
                               (code code)
-                              (reason (response-reason-phrase resp)))
+                              (reason (response-reason-phrase resp))
+                              (headers (response-headers resp)))
                              (&message
                               (message
                                (format
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 7a73c11382..e848ebc789 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -606,9 +607,7 @@ s-expression corresponding to that package, or #f on failure."
               ;; Retry import from CRAN
               (cran->guix-package package-name #:repo 'cran))
              (else
-              (raise (condition
-                      (&message
-                       (message "couldn't find meta-data for R package")))))))))))
+              (values #f '()))))))))
 
 (define* (cran-recursive-import package-name #:key (repo 'cran) version)
   (recursive-import package-name
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index ea77a7c244..9399f45ebc 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -379,11 +380,7 @@ type '<elpa-package>'."
   "Fetch the package NAME from REPO and produce a Guix package S-expression."
   (match (fetch-elpa-package name repo)
     (#false
-     (raise (condition
-             (&message
-              (message (format #false
-                               "couldn't find meta-data for ELPA package `~a'."
-                               name))))))
+     (values #f '()))
     (package
       ;; ELPA is known to contain only GPLv3+ code.  Other repos may contain
       ;; code under other license but there's no license metadata.
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 8c1898c0c5..51118d1d39 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
-;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
@@ -30,15 +30,17 @@
   #:use-module (guix utils)
   #:use-module (guix i18n)
   #:use-module (guix diagnostics)
+  #:use-module ((guix ui) #:select (display-hint))
   #:use-module ((guix download) #:prefix download:)
   #:use-module ((guix git-download) #:prefix download:)
+  #:autoload   (guix build download) (open-connection-for-uri)
   #:use-module (guix import utils)
-  #:use-module (guix import json)
   #:use-module (json)
   #:use-module (guix packages)
   #:use-module (guix upstream)
   #:use-module (guix http-client)
   #:use-module (web uri)
+  #:use-module (web response)
   #:export (%github-api %github-updater))
 
 ;; For tests.
@@ -140,6 +142,33 @@ repository separated by a forward slash, from a string URL of the form
   ;; limit, or #f.
   (make-parameter (getenv "GUIX_GITHUB_TOKEN")))
 
+(define %rate-limit-reset-time
+  ;; Time (seconds since the Epoch, UTC) when the rate limit for GitHub
+  ;; requests will be reset, or #f if the rate limit hasn't been reached.
+  #f)
+
+(define (update-rate-limit-reset-time! headers)
+  "Update the rate limit reset time based on HEADERS, the HTTP response
+headers."
+  (match (assq-ref headers 'x-ratelimit-reset)
+    ((= string->number (? number? reset))
+     (set! %rate-limit-reset-time reset)
+     reset)
+    (_
+     ;; This shouldn't happen.
+     (warning
+      (G_ "GitHub HTTP response lacks 'X-RateLimit-Reset' header~%"))
+     0)))
+
+(define (request-rate-limit-reached?)
+  "Return true if the rate limit has been reached."
+  (and %rate-limit-reset-time
+       (match (< (car (gettimeofday)) %rate-limit-reset-time)
+         (#t #t)
+         (#f
+          (set! %rate-limit-reset-time #f)
+          #f))))
+
 (define (fetch-releases-or-tags url)
   "Fetch the list of \"releases\" or, if it's empty, the list of tags for the
 repository at URL.  Return the corresponding JSON dictionaries (alists),
@@ -170,20 +199,54 @@ empty list."
             `((Authorization . ,(string-append "token " (%github-token))))
             '())))
 
-  (guard (c ((and (http-get-error? c)
-                  (= 404 (http-get-error-code c)))
-             (warning (G_ "~a is unreachable (~a)~%")
-                      release-url (http-get-error-code c))
-             '#()))                               ;return an empty release set
-    (let* ((port   (http-fetch release-url #:headers headers))
-           (result (json->scm port)))
-      (close-port port)
-      (match result
-        (#()
-         ;; We got the empty list, presumably because the user didn't use GitHub's
-         ;; "release" mechanism, but hopefully they did use Git tags.
-         (json-fetch tag-url #:headers headers))
-        (x x)))))
+  (and (not (request-rate-limit-reached?))
+       (guard (c ((and (http-get-error? c)
+                       (= 404 (http-get-error-code c)))
+                  (warning (G_ "~a is unreachable (~a)~%")
+                           (uri->string (http-get-error-uri c))
+                           (http-get-error-code c))
+                  '#())                           ;return an empty release set
+                 ((and (http-get-error? c)
+                       (= 403 (http-get-error-code c)))
+                  ;; See
+                  ;; <https://docs.github.com/en/rest/overview/resources-in-the-rest-api#rate-limiting>.
+                  (match (assq-ref (http-get-error-headers c)
+                                   'x-ratelimit-remaining)
+                    (#f
+                     (raise c))
+                    ((? (compose zero? string->number))
+                     (let ((reset (update-rate-limit-reset-time!
+                                   (http-get-error-headers c))))
+                       (warning (G_ "GitHub rate limit exceeded; \
+disallowing requests for ~a seconds~%")
+                                (- reset (car (gettimeofday))))
+                       (display-hint (G_ "You can raise the rate limit by
+setting the @env{GUIX_GITHUB_TOKEN} environment variable to a token obtained
+from @url{https://github.com/settings/tokens} with your GitHub account.
+
+Alternatively, you can wait until your rate limit is reset, or use the
+@code{generic-git} updater instead."))
+                       #f))                       ;bail out
+                    (_
+                     (raise c)))))
+
+         (let ((release-uri (string->uri release-url)))
+           (call-with-port (open-connection-for-uri release-uri)
+             (lambda (connection)
+               (let* ((result (json->scm
+                               (http-fetch release-uri
+                                           #:port connection
+                                           #:keep-alive? #t
+                                           #:headers headers))))
+                 (match result
+                   (#()
+                    ;; We got the empty list, presumably because the user didn't use GitHub's
+                    ;; "release" mechanism, but hopefully they did use Git tags.
+                    (json->scm (http-fetch tag-url
+                                           #:port connection
+                                           #:keep-alive? #t
+                                           #:headers headers)))
+                   (x x)))))))))
 
 (define (latest-released-version url package-name)
   "Return the newest released version and its tag given a string URL like
@@ -223,23 +286,16 @@ releases."
         (cons tag tag))
        (else #f))))
 
-  (let* ((json (and=> (fetch-releases-or-tags url)
-                      vector->list)))
-    (if (eq? json #f)
-        (if (%github-token)
-            (error "Error downloading release information through the GitHub
-API when using a GitHub token")
-            (error "Error downloading release information through the GitHub
-API. This may be fixed by using an access token and setting the environment
-variable GUIX_GITHUB_TOKEN, for instance one procured from
-https://github.com/settings/tokens"))
-        (match (sort (filter-map release->version
-                                 (match (remove pre-release? json)
-                                   (() json) ; keep everything
-                                   (releases releases)))
-                     (lambda (x y) (version>? (car x) (car y))))
-          (((latest-version . tag) . _) (values latest-version tag))
-          (() (values #f #f))))))
+  (match (and=> (fetch-releases-or-tags url) vector->list)
+    (#f (values #f #f))
+    (json
+     (match (sort (filter-map release->version
+                              (match (remove pre-release? json)
+                                (() json)         ; keep everything
+                                (releases releases)))
+                  (lambda (x y) (version>? (car x) (car y))))
+       (((latest-version . tag) . _) (values latest-version tag))
+       (() (values #f #f))))))
 
 (define (latest-release pkg)
   "Return an <upstream-source> for the latest release of PKG."
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index b94f4169d4..0d6c77e399 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,9 +26,9 @@
 (define-module (guix import hackage)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-71)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-1)
   #:use-module ((guix download) #:select (download-to-store url-fetch))
   #:use-module ((guix utils) #:select (package-name->name+version
@@ -136,7 +137,7 @@ version is returned."
 (define (read-cabal-and-hash port)
   "Read a Cabal file from PORT and return it and its hash in nix-base32
 format as two values."
-  (let-values (((port get-hash) (open-sha256-input-port port)))
+  (let ((port get-hash (open-sha256-input-port port)))
     (values (read-cabal (canonical-newline-port port))
             (bytevector->nix-base32-string (get-hash)))))
 
@@ -148,10 +149,10 @@ version.  On failure, both return values will be #f."
   (guard (c ((and (http-get-error? c)
                   (= 404 (http-get-error-code c)))
              (values #f #f)))           ;"expected" if package is unknown
-    (let*-values (((name version) (package-name->name+version name-version))
-                  ((url)          (hackage-cabal-url name version))
-                  ((port _)       (http-fetch url))
-                  ((cabal hash)   (read-cabal-and-hash port)))
+    (let* ((name version (package-name->name+version name-version))
+           (url          (hackage-cabal-url name version))
+           (port _       (http-fetch url))
+           (cabal hash   (read-cabal-and-hash port)))
       (close-port port)
       (values cabal hash))))
 
@@ -159,7 +160,7 @@ version.  On failure, both return values will be #f."
   "Return the Cabal file for the package NAME-VERSION, or #f on failure.  If
 the version part is omitted from the package name, then return the latest
 version."
-  (let-values (((cabal hash) (hackage-fetch-and-hash name-version)))
+  (let ((cabal hash (hackage-fetch-and-hash name-version)))
     cabal))
 
 (define string->license
@@ -248,23 +249,18 @@ the hash of the Cabal file."
     (hackage-source-url name version))
 
   (define hackage-dependencies
-    ((compose (cut filter-dependencies <>
-                   (cabal-package-name cabal))
-              (cut cabal-dependencies->names <>))
-     cabal))
+    (filter-dependencies (cabal-dependencies->names cabal)
+                         (cabal-package-name cabal)))
 
   (define hackage-native-dependencies
     (lset-difference
      equal?
-     ((compose (cut filter-dependencies <>
-                    (cabal-package-name cabal))
-               ;; FIXME: Check include-test-dependencies?
-               (lambda (cabal)
-                 (append (if include-test-dependencies?
-                             (cabal-test-dependencies->names cabal)
-                             '())
-                         (cabal-custom-setup-dependencies->names cabal))))
-      cabal)
+     (filter-dependencies
+      (append (if include-test-dependencies?
+                  (cabal-test-dependencies->names cabal)
+                  '())
+              (cabal-custom-setup-dependencies->names cabal))
+      (cabal-package-name cabal))
      hackage-dependencies))
 
   (define dependencies
@@ -333,14 +329,16 @@ symbol 'true' or 'false'.  The value associated with other keys has to conform
 to the Cabal file format definition.  The default value associated with the
 keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
 respectively."
-  (let-values (((cabal-meta cabal-hash)
-                (if port
-                    (read-cabal-and-hash port)
-                    (hackage-fetch-and-hash package-name))))
-    (and=> cabal-meta (compose (cut hackage-module->sexp <> cabal-hash
-                                    #:include-test-dependencies?
-                                    include-test-dependencies?)
-                               (cut eval-cabal <> cabal-environment)))))
+  (let ((cabal-meta cabal-hash
+                    (if port
+                        (read-cabal-and-hash port)
+                        (hackage-fetch-and-hash package-name))))
+    (if cabal-meta
+        (hackage-module->sexp (eval-cabal cabal-meta cabal-environment)
+                              cabal-hash
+                              #:include-test-dependencies?
+                              include-test-dependencies?)
+        (values #f '()))))
 
 (define hackage->guix-package/m                   ;memoized variant
   (memoize hackage->guix-package))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index e07b792c53..77b5f12f72 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2022 Vivien Kraus <vivien@planete-kraus.eu>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -496,33 +497,37 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
      (let* ((project (pypi-fetch package-name))
             (info    (and=> project pypi-project-info))
             (version (or version (and=> project latest-version))))
-       (and project
-            (guard (c ((missing-source-error? c)
-                       (let ((package (missing-source-error-package c)))
-                         (raise
-                          (make-compound-condition
-                           (formatted-message
-                            (G_ "no source release for pypi package ~a ~a~%")
-                            (project-info-name info) version)
-                           (condition
-                            (&fix-hint
-                             (hint (format #f (G_ "This indicates that the
+       (if project
+           (guard (c ((missing-source-error? c)
+                      (let ((package (missing-source-error-package c)))
+                        (raise
+                         (apply
+                          make-compound-condition
+                          (formatted-message
+                           (G_ "no source release for pypi package ~a ~a~%")
+                           (project-info-name info) version)
+                          (match (project-info-home-page info)
+                            ((or #f "") '())
+                            (url
+                             (list
+                              (condition
+                               (&fix-hint
+                                (hint (format #f (G_ "This indicates that the
 package is available on PyPI, but only as a \"wheel\" containing binaries, not
 source.  To build it from source, refer to the upstream repository at
 @uref{~a}.")
-                                           (or (project-info-home-page info)
-                                               (project-info-url info)
-                                               "?"))))))))))
-              (make-pypi-sexp (project-info-name info) version
-                              (and=> (source-release project version)
-                                     distribution-url)
-                              (and=> (wheel-release project version)
-                                     distribution-url)
-                              (project-info-home-page info)
-                              (project-info-summary info)
-                              (project-info-summary info)
-                              (string->license
-                               (project-info-license info)))))))))
+                                              url))))))))))))
+             (make-pypi-sexp (project-info-name info) version
+                             (and=> (source-release project version)
+                                    distribution-url)
+                             (and=> (wheel-release project version)
+                                    distribution-url)
+                             (project-info-home-page info)
+                             (project-info-summary info)
+                             (project-info-summary info)
+                             (string->license
+                              (project-info-license info))))
+           (values #f '()))))))
 
 (define* (pypi-recursive-import package-name #:optional version)
   (recursive-import package-name
diff --git a/guix/lint.scm b/guix/lint.scm
index 3ca7a0b608..e535eb8158 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -34,6 +34,7 @@
   #:use-module (guix store)
   #:autoload   (guix base16) (bytevector->base16-string)
   #:use-module (guix base32)
+  #:use-module (guix build-system)
   #:use-module (guix diagnostics)
   #:use-module (guix download)
   #:use-module (guix ftp-client)
@@ -279,6 +280,16 @@ superfluous when building natively and incorrect when cross-compiling."
              (eq? tests? #t))
            (package-arguments package)))
   (if (and (tests-explicitly-enabled?)
+           ;; emacs-build-system sets #:tests? #f by default, therefore
+           ;; writing #:tests? #t in package definitions using
+           ;; emacs-build-system is reasonable.  Likewise for
+           ;; texlive-build-system.
+           ;;
+           ;; Compare the name of the build system instead of the build system
+           ;; itself to avoid loading unnecessary modules when only a few
+           ;; modules are linted.
+           (not (memq (build-system-name (package-build-system package))
+                      '(emacs texlive)))
            ;; Some packages, e.g. gnutls, set #:tests?
            ;; differently depending on whether it is being
            ;; cross-compiled.
diff --git a/guix/man-db.scm b/guix/man-db.scm
index a6528e4431..7d9707a592 100644
--- a/guix/man-db.scm
+++ b/guix/man-db.scm
@@ -110,7 +110,12 @@
     ;; Write ENTRIES in sorted order so we get deterministic output.
     (for-each (lambda (entry)
                 (gdbm-set! db
-                           (string-append (mandb-entry-file-name entry)
+                           ;; For the 'whatis' tool to find anything, the key
+                           ;; should match the name of the software,
+                           ;; e.g. 'cat'.  Derive it from the file name, as
+                           ;; the name could technically be #f.
+                           (string-append (abbreviate-file-name
+                                           (mandb-entry-file-name entry))
                                           "\x00")
                            (entry->string entry)))
               (sort entries mandb-entry<?))
diff --git a/guix/packages.scm b/guix/packages.scm
index 9d5b23eb8a..1c63eb2d3e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -7,6 +7,7 @@
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -182,8 +183,16 @@
 
 ;; The 'source-module-closure' procedure ca. 1.2.0 did not recognize
 ;; #:re-export-and-replace: <https://issues.guix.gnu.org/52694>.
-;; Work around it.
-(module-re-export! (current-module) '(delete) #:replace? #t)
+;; Work around it.  The #:replace? argument is only supported by
+;; Guile 2.2.7 and later, work-around it if necessary to allow
+;; time-travel from 1.1.0, see <https://issues.guix.gnu.org/53765>.
+(let ((major (string->number (major-version))))
+  (if (or (>= major 3)
+          (and (= major 2)
+               (= (string->number (minor-version)) 2) ; there is no Guile 2.3.X
+               (>= (string->number (micro-version)) 7)))
+      (module-re-export! (current-module) '(delete) #:replace? #t)
+      (module-re-export! (current-module) '(delete))))
 
 ;;; Commentary:
 ;;;
@@ -1091,11 +1100,11 @@ otherwise."
   "Replace input NAME by REPLACEMENT within INPUTS."
   (map (lambda (input)
          (match input
-           (((? string? label) . _)
+           (((? string? label) _ . outputs)
             (if (string=? label name)
                 (match replacement        ;does REPLACEMENT specify an output?
                   ((_ _) (cons label replacement))
-                  (_     (list label replacement)))
+                  (_     (cons* label replacement outputs)))
                 input))))
        inputs))
 
@@ -1235,7 +1244,7 @@ in INPUTS and their transitive propagated inputs."
                       (_
                        systems)))
                   (package-supported-systems package)
-                  (bag-direct-inputs (package->bag package))))))
+                  (bag-direct-inputs (package->bag package system #f))))))
 
       supported-systems)
 
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 86926d6793..bad9b95519 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2016, 2018, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;; Copyright © 2017, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -33,7 +33,7 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
                 #:select (package-name->name+version mkdir-p))
-  #:use-module ((guix diagnostics) #:select (&fix-hint))
+  #:use-module ((guix diagnostics) #:select (&fix-hint formatted-message))
   #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
@@ -1752,6 +1752,8 @@ MANIFEST."
     (module-ref (resolve-interface '(gnu packages tex)) 'texlive-bin))
   (define coreutils
     (module-ref (resolve-interface '(gnu packages base)) 'coreutils))
+  (define grep
+    (module-ref (resolve-interface '(gnu packages base)) 'grep))
   (define sed
     (module-ref (resolve-interface '(gnu packages base)) 'sed))
   (define updmap.cfg
@@ -1779,6 +1781,8 @@ MANIFEST."
           (setenv "PATH"
                   (string-append #$(file-append coreutils "/bin")
                                  ":"
+                                 #$(file-append grep "/bin")
+                                 ":"
                                  #$(file-append sed "/bin")))
           (setenv "PERL5LIB" #$(file-append texlive-bin "/share/tlpkg"))
           (setenv "GUIX_TEXMF" "/tmp/texlive/share/texmf-dist")
@@ -1808,7 +1812,21 @@ MANIFEST."
                     (string-append "--dvipsoutputdir="
                                    maproot "dvips/updmap")
                     (string-append "--pdftexoutputdir="
-                                   maproot "pdftex/updmap"))))))
+                                   maproot "pdftex/updmap"))
+
+            ;; Create ls-R file.  I know, that's not *just* for font maps, but
+            ;; we've generated new files, so there's no point in running it
+            ;; any earlier.  The ls-R file must act on a full TeX Live tree,
+            ;; but we have two: the one in /tmp containing all packages and
+            ;; the one in #$output containing the generated font maps.  To
+            ;; avoid having to merge ls-R files, we copy the generated stuff
+            ;; to /tmp and run mktexlsr only once.
+            (let ((a (string-append #$output "/share/texmf-dist"))
+                  (b "/tmp/texlive/share/texmf-dist")
+                  (mktexlsr #$(file-append texlive-bin "/bin/mktexlsr")))
+              (copy-recursively a b)
+              (invoke mktexlsr b)
+              (install-file (string-append b "/ls-R") a))))))
 
   (mlet %store-monad ((texlive-base (manifest-lookup-package manifest "texlive-base")))
     (if texlive-base
@@ -1842,6 +1860,7 @@ MANIFEST."
                              (name "profile")
                              (hooks %default-profile-hooks)
                              (locales? #t)
+                             (allow-unsupported-packages? #f)
                              (allow-collisions? #f)
                              (relative-symlinks? #f)
                              system target)
@@ -1850,7 +1869,9 @@ the given MANIFEST.  The profile includes additional derivations returned by
 the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
 Unless ALLOW-COLLISIONS? is true, a '&profile-collision-error' is raised if
 entries in MANIFEST collide (for instance if there are two same-name packages
-with a different version number.)
+with a different version number.)  Unless ALLOW-UNSUPPORTED-PACKAGES? is true
+or TARGET is set, raise an error if MANIFEST contains a package that does not
+support SYSTEM.
 
 When LOCALES? is true, the build is performed under a UTF-8 locale; this adds
 a dependency on the 'glibc-utf8-locales' package.
@@ -1860,12 +1881,27 @@ This is one of the things to do for the result to be relocatable.
 
 When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST
 are cross-built for TARGET."
+  (define (check-supported-packages system)
+    ;; Raise an error if a package in MANIFEST does not support SYSTEM.
+    (map-manifest-entries
+     (lambda (entry)
+
+       (match (manifest-entry-item entry)
+         ((? package? package)
+          (unless (supported-package? package system)
+            (raise (formatted-message (G_ "package ~a does not support ~a")
+                                      (package-full-name package) system))))
+         (_ #t)))
+     manifest))
+
   (mlet* %store-monad ((system (if system
                                    (return system)
                                    (current-system)))
                        (target (if target
                                    (return target)
                                    (current-target-system)))
+                       (ok? -> (or allow-unsupported-packages? target
+                                   (check-supported-packages system)))
                        (ok?    (if allow-collisions?
                                    (return #t)
                                    (check-for-collisions manifest system
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 97e2f5a167..d9cdb6e5e0 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
@@ -559,11 +559,29 @@ build."
   (define things-to-build
     (map transform (options->things-to-build opts)))
 
+  (define warn-if-unsupported
+    (let ((target (assoc-ref opts 'target)))
+      (if target
+          (lambda (package system)
+            ;; We cannot tell whether PACKAGE supports TARGET.
+            package)
+          (lambda (package system)
+            (match package
+              ((? package? package)
+               (unless (supported-package? package system)
+                 (warning (package-location package)
+                          (G_ "package ~a does not support ~a~%")
+                          (package-full-name package) system))
+               package)
+              (x x))))))
+
   (define (compute-derivation obj system)
     ;; Compute the derivation of OBJ for SYSTEM.
     (match obj
       ((? package? p)
-       (let ((p (or (and graft? (package-replacement p)) p)))
+       (let ((p (warn-if-unsupported
+                 (or (and graft? (package-replacement p)) p)
+                 system)))
          (match src
            (#f
             (list (package->derivation store p system)))
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8943e87099..535875c858 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -429,13 +429,6 @@ package modules, while attempting to retain user package modules."
             %node-types)
       (leave (G_ "~a: unknown node type~%") name)))
 
-(define (lookup-backend name)
-  "Return the graph backend called NAME.  Raise an error if it is not found."
-  (or (find (lambda (backend)
-              (string=? (graph-backend-name backend) name))
-            %graph-backends)
-      (leave (G_ "~a: unknown backend~%") name)))
-
 (define (list-node-types)
   "Print the available node types along with their synopsis."
   (display (G_ "The available node types are:\n"))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 837fd96361..af2643014d 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,8 +24,24 @@
   #:use-module (gnu packages admin)
   #:use-module ((gnu services) #:hide (delete))
   #:use-module (gnu packages)
+  #:autoload   (gnu packages base) (coreutils)
+  #:autoload   (gnu packages bash) (bash)
+  #:autoload   (gnu packages gnupg) (guile-gcrypt)
+  #:autoload   (gnu packages shells) (fish gash zsh)
   #:use-module (gnu home)
   #:use-module (gnu home services)
+  #:autoload   (gnu home services shepherd) (home-shepherd-service-type
+                                             home-shepherd-configuration-services
+                                             shepherd-service-requirement)
+  #:autoload   (guix modules) (source-module-closure)
+  #:autoload   (gnu build linux-container) (call-with-container %namespaces)
+  #:autoload   (gnu system linux-container) (eval/container)
+  #:autoload   (gnu system file-systems) (file-system-mapping
+                                          file-system-mapping-source
+                                          file-system-mapping->bind-mount
+                                          specification->file-system-mapping
+                                          %network-file-mappings)
+  #:autoload   (guix self) (make-config.scm)
   #:use-module (guix channels)
   #:use-module (guix derivations)
   #:use-module (guix ui)
@@ -33,13 +50,16 @@
   #:use-module (guix profiles)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:autoload   (guix graph) (lookup-backend export-graph)
   #:use-module (guix scripts)
   #:use-module (guix scripts package)
   #:use-module (guix scripts build)
   #:autoload   (guix scripts system search) (service-type->recutils)
   #:use-module (guix scripts system reconfigure)
   #:autoload   (guix scripts pull) (channel-commit-hyperlink)
-  #:use-module (guix scripts home import)
+  #:autoload   (guix scripts system) (service-node-type
+                                      shepherd-service-node-type)
+  #:autoload   (guix scripts home import) (import-manifest)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (guix gexp)
@@ -48,6 +68,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:export (guix-home))
 
@@ -71,6 +92,8 @@ Some ACTIONS support additional ARGS.\n"))
   (newline)
   (display (G_ "\
    search             search for existing service types\n"))
+  (display (G_ "
+   container          run the home environment configuration in a container\n"))
   (display (G_ "\
    reconfigure        switch to a new home environment configuration\n"))
   (display (G_ "\
@@ -87,6 +110,10 @@ Some ACTIONS support additional ARGS.\n"))
    build              build the home environment without installing anything\n"))
   (display (G_ "\
    import             generates a home environment definition from dotfiles\n"))
+  (display (G_ "\
+   extension-graph    emit the service extension graph\n"))
+  (display (G_ "\
+   shepherd-graph     emit the graph of shepherd services\n"))
 
   (show-build-options-help)
   (display (G_ "
@@ -95,8 +122,21 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --allow-downgrades for 'reconfigure', allow downgrades to earlier
                          channel revisions"))
+  (newline)
+  (display (G_ "
+  -N, --network          allow containers to access the network"))
+  (display (G_ "
+      --share=SPEC       for containers, share writable host file system
+                         according to SPEC"))
+  (display (G_ "
+      --expose=SPEC      for containers, expose read-only host file system
+                         according to SPEC"))
+  (newline)
   (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
+  (display (G_ "
+      --graph-backend=BACKEND
+                         use BACKEND for 'extension-graph' and 'shepherd-graph'"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -136,6 +176,25 @@ Some ACTIONS support additional ARGS.\n"))
                    (alist-cons 'validate-reconfigure
                                warn-about-backward-reconfigure
                                result)))
+         (option '("graph-backend") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'graph-backend arg result)))
+
+         ;; Container options.
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'network? #t result)))
+         (option '("share") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file-system-mapping
+                               (specification->file-system-mapping arg #t)
+                               result)))
+         (option '("expose") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'file-system-mapping
+                               (specification->file-system-mapping arg #f)
+                               result)))
+
          %standard-build-options))
 
 (define %default-options
@@ -147,19 +206,195 @@ Some ACTIONS support additional ARGS.\n"))
     (multiplexed-build-output? . #t)
     (verbosity . #f)                              ;default
     (debug . 0)
-    (validate-reconfigure . ,ensure-forward-reconfigure)))
+    (validate-reconfigure . ,ensure-forward-reconfigure)
+    (graph-backend . "graphviz")))
+
+
+;;;
+;;; Container.
+;;;
+
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix _ ...) #t)
+    (('gnu _ ...) #t)
+    (_ #f)))
+
+(define (user-shell)
+  (match (and=> (or (getenv "SHELL")
+                    (passwd:shell (getpwuid (getuid))))
+                basename)
+    ("zsh"  (file-append zsh "/bin/zsh"))
+    ("fish" (file-append fish "/bin/fish"))
+    ("gash" (file-append gash "/bin/gash"))
+    (_      (file-append bash "/bin/bash"))))
+
+(define %default-system-profile
+  ;; The "system" profile available when running 'guix home container'.  The
+  ;; activation script currently expects to run "env -0" (XXX), so provide
+  ;; Coreutils by default.
+  (delay (profile
+          (name "home-system-profile")
+          (content (packages->manifest (list coreutils))))))
+
+(define* (spawn-home-container home
+                               #:key
+                               network?
+                               (command '())
+                               (mappings '())
+                               (system-profile
+                                (force %default-system-profile)))
+  "Spawn a login shell within a container running HOME, a home environment.
+When COMMAND is a non-empty list, execute it in the container and exit
+immediately.  Return the exit status of the process in the container."
+  (define passwd (getpwuid (getuid)))
+  (define home-directory (or (getenv "HOME") (passwd:dir passwd)))
+  (define host (gethostname))
+  (define uid 1000)
+  (define gid 1000)
+  (define user-name (passwd:name passwd))
+  (define user-real-name (passwd:gecos passwd))
+
+  (define (optional-mapping mapping)
+    (and (file-exists? (file-system-mapping-source mapping))
+         mapping))
+
+  (define network-mappings
+    (if network?
+        (filter-map optional-mapping %network-file-mappings)
+        '()))
+
+  (eval/container
+   (with-extensions (list guile-gcrypt)
+     (with-imported-modules `(((guix config) => ,(make-config.scm))
+                              ,@(source-module-closure
+                                 '((gnu build accounts)
+                                   (guix profiles)
+                                   (guix build utils)
+                                   (guix build syscalls))
+                                 #:select? not-config?))
+       #~(begin
+           (use-modules (guix build utils)
+                        (gnu build accounts)
+                        ((guix build syscalls)
+                         #:select (set-network-interface-up)))
+
+           (define shell
+             #$(user-shell))
+
+           (define term
+             #$(getenv "TERM"))
+
+           (define passwd
+             (password-entry
+              (name #$user-name)
+              (real-name #$user-real-name)
+              (uid #$uid) (gid #$gid) (shell shell)
+              (directory #$home-directory)))
+
+           (define groups
+             (list (group-entry (name "users") (gid #$gid))
+                   (group-entry (gid 65534)       ;the overflow GID
+                                (name "overflow"))))
+
+           ;; (guix profiles) loads (guix utils), which calls 'getpw' from the
+           ;; top level.  Thus, arrange so that it's loaded after /etc/passwd
+           ;; has been created.
+           (module-autoload! (current-module)
+                             '(guix profiles) '(load-profile))
+
+           ;; Create /etc/passwd for applications that need it, such as mcron.
+           (mkdir-p "/etc")
+           (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)
+                 (chmod port #o444))))
+
+           ;; Set PATH for things that the activation script might expect, such
+           ;; as "env".
+           (load-profile #$system-profile)
+
+           (mkdir-p #$home-directory)
+           (setenv "HOME" #$home-directory)
+           (setenv "GUIX_NEW_HOME" #$home)
+           (primitive-load (string-append #$home "/activate"))
+           (setenv "GUIX_NEW_HOME" #f)
+
+           (when term
+             ;; Preserve TERM for proper interactive use.
+             (setenv "TERM" term))
+
+           (chdir #$home-directory)
+
+           ;; Invoke SHELL with argv[0] starting with "-": that's how shells
+           ;; figure out that they are login shells!
+           (execl shell (string-append "-" (basename shell))
+                  #$@(match command
+                       (() #~())
+                       ((_ ...)
+                        #~("-c" #$(string-join command))))))))
+
+   #:namespaces (if network?
+                    (delq 'net %namespaces)       ; share host network
+                    %namespaces)
+   #:mappings (append network-mappings mappings)
+   #:guest-uid uid
+   #:guest-gid gid))
 
 
 ;;;
 ;;; Actions.
 ;;;
 
+(define* (export-extension-graph home port
+                                 #:key (backend (lookup-backend "graphviz")))
+  "Export the service extension graph of HOME to PORT using BACKEND."
+  (let* ((services (home-environment-services home))
+         (home     (find (lambda (service)
+                           (eq? (service-kind service) home-service-type))
+                         services)))
+    (export-graph (list home) port
+                  #:backend backend
+                  #:node-type (service-node-type services)
+                  #:reverse-edges? #t)))
+
+(define* (export-shepherd-graph home port
+                                #:key (backend (lookup-backend "graphviz")))
+  "Export the graph of shepherd services of HOME to PORT using BACKEND."
+  (let* ((services  (home-environment-services home))
+         (root      (fold-services services
+                                   #:target-type home-shepherd-service-type))
+         ;; Get the list of <shepherd-service>.
+         (shepherds (home-shepherd-configuration-services
+                     (service-value root)))
+         (sinks     (filter (lambda (service)
+                              (null? (shepherd-service-requirement service)))
+                            shepherds)))
+    (export-graph sinks port
+                  #:backend backend
+                  #:node-type (shepherd-service-node-type shepherds)
+                  #:reverse-edges? #t)))
+
 (define* (perform-action action he
                          #:key
                          dry-run?
                          derivations-only?
                          use-substitutes?
-                         (validate-reconfigure ensure-forward-reconfigure))
+                         (graph-backend "graphviz")
+                         (validate-reconfigure ensure-forward-reconfigure)
+
+                         ;; Container options.
+                         (file-system-mappings '())
+                         (container-command '())
+                         network?)
   "Perform ACTION for home environment. "
 
   (define println
@@ -169,35 +404,56 @@ Some ACTIONS support additional ARGS.\n"))
     (check-forward-update validate-reconfigure
                           #:current-channels (home-provenance %guix-home)))
 
-  (mlet* %store-monad
-      ((he-drv   (home-environment-derivation he))
-       (drvs     (mapm/accumulate-builds lower-object (list he-drv)))
-       (%        (if derivations-only?
-                     (return
-                      (for-each (compose println derivation-file-name) drvs))
-                     (built-derivations drvs)))
-
-       (he-out-path -> (derivation->output-path he-drv)))
-    (if (or dry-run? derivations-only?)
-        (return #f)
-        (begin
-          (for-each (compose println derivation->output-path) drvs)
-
-          (case action
-            ((reconfigure)
-             (let* ((number (generation-number %guix-home))
-                    (generation (generation-file-name
-                                 %guix-home (+ 1 number))))
-
-               (switch-symlinks generation he-out-path)
-               (switch-symlinks %guix-home generation)
-               (setenv "GUIX_NEW_HOME" he-out-path)
-               (primitive-load (string-append he-out-path "/activate"))
-               (setenv "GUIX_NEW_HOME" #f)
-               (return he-out-path)))
-            (else
-             (newline)
-             (return he-out-path)))))))
+  (case action
+    ((extension-graph)
+     (export-extension-graph he (current-output-port)
+                             #:backend (lookup-backend graph-backend)))
+    ((shepherd-graph)
+     (export-shepherd-graph he (current-output-port)
+                            #:backend (lookup-backend graph-backend)))
+    (else
+     (mlet* %store-monad
+         ((he-drv   (home-environment-derivation he))
+          (drvs     (mapm/accumulate-builds lower-object (list he-drv)))
+          (%        (if derivations-only?
+                        (return
+                         (for-each (compose println derivation-file-name) drvs))
+                        (built-derivations drvs)))
+
+          (he-out-path -> (derivation->output-path he-drv)))
+       (if (or dry-run? derivations-only?)
+           (return #f)
+           (case action
+             ((reconfigure)
+              (let* ((number (generation-number %guix-home))
+                     (generation (generation-file-name
+                                  %guix-home (+ 1 number))))
+
+                (switch-symlinks generation he-out-path)
+                (switch-symlinks %guix-home generation)
+                (setenv "GUIX_NEW_HOME" he-out-path)
+                (primitive-load (string-append he-out-path "/activate"))
+                (setenv "GUIX_NEW_HOME" #f)
+                (return he-out-path)))
+             ((container)
+              (mlet %store-monad ((status (spawn-home-container
+                                           he
+                                           #:network? network?
+                                           #:mappings file-system-mappings
+                                           #:command
+                                           container-command)))
+                (match (status:exit-val status)
+                  (0 (return #t))
+                  ((? integer? n) (return (exit n)))
+                  (#f
+                   (if (status:term-sig status)
+                       (leave (G_ "process terminated with signal ~a~%")
+                              (status:term-sig status))
+                       (leave (G_ "process stopped with signal ~a~%")
+                              (status:stop-sig status)))))))
+             (else
+              (for-each (compose println derivation->output-path) drvs)
+              (return he-out-path))))))))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -236,6 +492,10 @@ resulting from command-line parsing."
              (else
               (leave (G_ "no configuration specified~%")))))))
 
+         (mappings    (filter-map (match-lambda
+                                    (('file-system-mapping . mapping) mapping)
+                                    (_ #f))
+                                  opts))
          (dry?        (assoc-ref opts 'dry-run?)))
 
     (with-store store
@@ -256,7 +516,13 @@ resulting from command-line parsing."
                             #:derivations-only? (assoc-ref opts 'derivations-only?)
                             #:use-substitutes? (assoc-ref opts 'substitutes?)
                             #:validate-reconfigure
-                            (assoc-ref opts 'validate-reconfigure))))))
+                            (assoc-ref opts 'validate-reconfigure)
+                            #:graph-backend
+                            (assoc-ref opts 'graph-backend)
+                            #:network? (assoc-ref opts 'network?)
+                            #:file-system-mappings mappings
+                            #:container-command
+                            (or (assoc-ref opts 'container-command) '()))))))
     (warn-about-disk-space)))
 
 
@@ -345,7 +611,7 @@ deploy the home environment described by these files.\n")
               list-generations describe
               delete-generations roll-back
               switch-generation search
-              import)
+              import container)
              (alist-cons 'action action result))
             (else (leave (G_ "~a: unknown action~%") action))))))
 
@@ -383,11 +649,28 @@ deploy the home environment described by these files.\n")
            (fail))))
       args))
 
+  (define (parse-args args)
+    ;; Parse the list of command line arguments ARGS.
+
+    ;; The '--' token is used to separate the command to run from the rest of
+    ;; the operands.
+    (let* ((args rest (break (cut string=? "--" <>) args))
+           (opts (parse-command-line args %options (list %default-options)
+                                     #:argument-handler
+                                     parse-sub-command)))
+      (match rest
+        (() opts)
+        (("--") opts)
+        (("--" command ...)
+         (match (assoc-ref opts 'action)
+           ('container
+            (alist-cons 'container-command command opts))
+           (_
+            (leave (G_ "~a: extraneous command~%")
+                   (string-join command))))))))
+
   (with-error-handling
-    (let* ((opts     (parse-command-line args %options
-                                         (list %default-options)
-                                         #:argument-handler
-                                         parse-sub-command))
+    (let* ((opts     (parse-args args))
            (args     (option-arguments opts))
            (command  (assoc-ref opts 'action)))
       (parameterize ((%graft? (assoc-ref opts 'graft?)))
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 15bd3140ed..575fe8f688 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
-;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -60,19 +60,24 @@ FILE-NAME with \"-\", and return the basename of it."
   (define (destination-append path)
     (string-append destination-directory "/" path))
 
+  (define alias-rx
+    (make-regexp "^alias ([^=]+)=[\"'](.+)[\"']$"))
+
   (define (bash-alias->pair line)
-    (if (string-prefix? "alias" line)
-        (let ((matched (string-match "alias (.+)=\"?'?([^\"']+)\"?'?" line)))
-          `(,(match:substring matched 1) . ,(match:substring matched 2)))
-        '()))
-  
+    (match (regexp-exec alias-rx line)
+      (#f #f)
+      (matched
+       `(,(match:substring matched 1) . ,(match:substring matched 2)))))
+
   (define (parse-aliases input)
-    (let loop ((line (read-line input))
-               (result '()))
-      (if (eof-object? line)
-          (reverse result)
-          (loop (read-line input)
-                (cons (bash-alias->pair line) result)))))
+    (let loop ((result '()))
+      (match (read-line input)
+        ((? eof-object?)
+         (reverse result))
+        (line
+         (match (bash-alias->pair line)
+           (#f    (loop result))
+           (alias (loop (cons alias result))))))))
 
   (let ((rc (destination-append ".bashrc"))
         (profile (destination-append ".bash_profile"))
@@ -82,9 +87,9 @@ FILE-NAME with \"-\", and return the basename of it."
                 ,@(if (file-exists? rc)
                       `((aliases
                          ',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias"))
-                               (alist (parse-aliases port)))
+                                  (alist (parse-aliases port)))
                            (close-port port)
-                           (filter (negate null?) alist))))
+                           alist)))
                       '())
                 ,@(if (file-exists? rc)
                       `((bashrc
diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm
index 328d20b946..82deac16ad 100644
--- a/guix/scripts/import/gem.scm
+++ b/guix/scripts/import/gem.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,24 +81,26 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n"))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
-                            (('argument . value)
-                             value)
-                            (_ #f))
+                             (('argument . value)
+                              value)
+                             (_ #f))
                            (reverse opts))))
     (match args
       ((package-name)
-       (if (assoc-ref opts 'recursive)
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
-                (gem-recursive-import package-name 'rubygems))
-           (let ((sexp (gem->guix-package package-name)))
-             (unless sexp
-               (leave (G_ "failed to download meta-data for package '~a'~%")
-                      package-name))
-             sexp)))
+       (let ((code (if (assoc-ref opts 'recursive)
+                       (map (match-lambda
+                              ((and ('package ('name name) . rest) pkg)
+                               `(define-public ,(string->symbol name)
+                                  ,pkg))
+                              (_ #f))
+                            (gem-recursive-import package-name 'rubygems))
+                       (let ((sexp (gem->guix-package package-name)))
+                         (if sexp sexp #f)))))
+         (match code
+           ((or #f '(#f))
+            (leave (G_ "failed to download meta-data for package '~a'~%")
+                   package-name))
+           (_ code))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 6e2b4368da..870dfc11e9 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -1,7 +1,7 @@
 ;;; 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, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
@@ -345,20 +345,10 @@ much needs to be downloaded."
          (base-info  (format #f
                              "\
 StorePath: ~a
-~{~a~}\
 NarHash: sha256:~a
 NarSize: ~d
 References: ~a~%"
                              store-path
-                             (map (lambda (compression)
-                                    (let ((size (assoc-ref file-sizes
-                                                           compression)))
-                                      (store-item->recutils store-path
-                                                            #:file-size size
-                                                            #:nar-path nar-path
-                                                            #:compression
-                                                            compression)))
-                                  compressions)
                              hash size references))
          ;; Do not render a "Deriver" line if we are rendering info for a
          ;; derivation.  Also do not render a "System" line that would be
@@ -369,7 +359,22 @@ References: ~a~%"
                                  base-info (basename deriver))))
          (signature  (base64-encode-string
                       (canonical-sexp->string (signed-string info)))))
-    (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
+    (format #f "~aSignature: 1;~a;~a~%~{~a~}"
+            info (gethostname) signature
+
+            ;; Move information about the actual nars
+            ;; (URL/Compression/FileSize) *after* the normative part that is
+            ;; signed.  That makes it possible to alter these bits of the
+            ;; narinfo without having to resign them.
+            (map (lambda (compression)
+                   (let ((size (assoc-ref file-sizes
+                                          compression)))
+                     (store-item->recutils store-path
+                                           #:file-size size
+                                           #:nar-path nar-path
+                                           #:compression
+                                           compression)))
+                 compressions))))
 
 (define* (not-found request
                     #:key (phrase "Resource not found")
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index fb8ce50fa7..7402782ff3 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2015, 2017-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -105,6 +105,8 @@ Download and deploy the latest version of Guix.\n"))
   -l, --list-generations[=PATTERN]
                          list generations matching PATTERN"))
   (display (G_ "
+      --details          show details when listing generations"))
+  (display (G_ "
       --roll-back        roll back to the previous generation"))
   (display (G_ "
   -d, --delete-generations[=PATTERN]
@@ -138,6 +140,13 @@ Download and deploy the latest version of Guix.\n"))
                  (lambda (opt name arg result)
                    (cons `(query list-generations ,arg)
                          result)))
+         (option '("details") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'details? #t
+                               (if (assoc-ref result 'query)
+                                   result
+                                   (cons `(query list-generations #f)
+                                         result)))))
          (option '("roll-back") #f #f
                  (lambda (opt name arg result)
                    (cons '(generation roll-back)
@@ -152,7 +161,8 @@ Download and deploy the latest version of Guix.\n"))
                          result)))
          (option '(#\N "news") #f #f
                  (lambda (opt name arg result)
-                   (cons '(query display-news) result)))
+                   (cons '(query display-news)
+                         (alist-delete 'query result))))
          (option '("url") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'repository-url arg
@@ -274,7 +284,8 @@ purposes."
                   (texi->plain-text title))
 
                 ;; When Texinfo markup is invalid, display it as-is.
-                (const title)))))))
+                (const title)))
+             (or (pager-wrapped-port port) port)))))
 
 (define (display-news-entry entry channel language port)
   "Display ENTRY, a <channel-news-entry> from CHANNEL, in LANGUAGE, a language
@@ -286,7 +297,8 @@ code, to PORT."
     (channel-news-entry-commit entry))
 
   (display-news-entry-title entry language port)
-  (format port (dim (G_ "    commit ~a~%"))
+  (format port (dim (G_ "    commit ~a~%")
+                    (or (pager-wrapped-port port) port))
           (if (supports-hyperlinks?)
               (channel-commit-hyperlink channel commit)
               commit))
@@ -337,45 +349,48 @@ to display."
                                (previous
                                 (and=> (relative-generation profile -1)
                                        (cut generation-file-name profile <>))))
-  "Display news about the channels of PROFILE compared to PREVIOUS."
-  (when previous
-    (let ((old-channels (profile-channels previous))
-          (new-channels (profile-channels profile)))
-      (and (pair? old-channels) (pair? new-channels)
-           (begin
-             (match (lset-difference channel=? new-channels old-channels)
-               (()
-                #t)
-               (new
-                (let ((count (length new)))
-                  (format (current-error-port)
-                          (N_ "  ~a new channel:~%"
-                              "  ~a new channels:~%" count)
-                          count)
-                  (for-each display-channel new))))
-             (match (lset-difference channel=? old-channels new-channels)
-               (()
-                #t)
-               (removed
-                (let ((count (length removed)))
-                  (format (current-error-port)
-                          (N_ "  ~a channel removed:~%"
-                              "  ~a channels removed:~%" count)
-                          count)
-                  (for-each display-channel removed))))
-
-             ;; Display channel-specific news for those channels that were
-             ;; here before and are still around afterwards.
-             (for-each (match-lambda
-                         ((new old)
-                          (display-channel-specific-news new old)))
-                       (filter-map (lambda (new)
-                                     (define old
-                                       (find (cut channel=? new <>)
-                                             old-channels))
-
-                                     (and old (list new old)))
-                                   new-channels)))))))
+  "Display news about the channels of PROFILE compared to PREVIOUS.  Return
+true if news were displayed, false otherwise."
+  (and previous
+       (let ((old-channels (profile-channels previous))
+             (new-channels (profile-channels profile)))
+         (and (pair? old-channels) (pair? new-channels)
+              (begin
+                (match (lset-difference channel=? new-channels old-channels)
+                  (()
+                   #t)
+                  (new
+                   (let ((count (length new)))
+                     (format (current-error-port)
+                             (N_ "  ~a new channel:~%"
+                                 "  ~a new channels:~%" count)
+                             count)
+                     (for-each display-channel new))))
+                (match (lset-difference channel=? old-channels new-channels)
+                  (()
+                   #t)
+                  (removed
+                   (let ((count (length removed)))
+                     (format (current-error-port)
+                             (N_ "  ~a channel removed:~%"
+                                 "  ~a channels removed:~%" count)
+                             count)
+                     (for-each display-channel removed))))
+
+                ;; Display channel-specific news for those channels that were
+                ;; here before and are still around afterwards.
+                (fold (match-lambda*
+                        (((new old) news?)
+                         (or (display-channel-specific-news new old)
+                             news?)))
+                      #f
+                      (filter-map (lambda (new)
+                                    (define old
+                                      (find (cut channel=? new <>)
+                                            old-channels))
+
+                                    (and old (list new old)))
+                                  new-channels)))))))
 
 (define* (display-channel-news-headlines profile)
   "Display the titles of news about the channels of PROFILE compared to its
@@ -406,13 +421,26 @@ previous generation.  Return true if there are news to display."
 
              (any ->bool more?))))))
 
-(define (display-news profile)
-  ;; Display profile news, with the understanding that this process represents
-  ;; the newest generation.
-  (display-profile-news profile
-                        #:current-is-newer? #t)
-
-  (display-channel-news profile))
+(define* (display-news profile #:key (profile-news? #f))
+  "Display channel news for PROFILE compared to its previous generation.  When
+PROFILE-NEWS? is true, display the list of added/upgraded packages since the
+previous generation."
+  (define previous
+    (relative-generation profile -1))
+
+  (if previous
+      (begin
+        (when profile-news?
+          (display-profile-news profile
+                                #:current-is-newer? #t))
+
+        (unless (display-channel-news profile
+                                      (generation-file-name profile previous))
+          (info (G_ "no channel news since generation ~a~%") previous)
+          (display-hint (G_ "Run @command{guix pull -l} to view the
+news for earlier generations."))))
+      (leave (G_ "profile ~a does not have a previous generation~%")
+             profile)))
 
 (define* (build-and-install instances profile)
   "Build the tool from SOURCE, and install it in PROFILE.  When DRY-RUN? is
@@ -430,10 +458,9 @@ true, display what would be built without actually building it."
                       #:hooks %channel-profile-hooks)
 
       (return
-       (let ((more? (list (display-profile-news profile #:concise? #t)
-                          (display-channel-news-headlines profile))))
+       (let ((more? (display-channel-news-headlines profile)))
          (newline)
-         (when (any ->bool more?)
+         (when more?
            (display-hint
             (G_ "Run @command{guix pull --news} to read all the news.")))))
       (if guix-command
@@ -640,17 +667,23 @@ Return true when there is more package info to display."
 
 (define (process-query opts profile)
   "Process any query on PROFILE specified by OPTS."
+  (define details?
+    (assoc-ref opts 'details?))
+
   (match (assoc-ref opts 'query)
     (('list-generations pattern)
      (define (list-generations profile numbers)
        (match numbers
          ((first rest ...)
           (display-profile-content profile first)
+
           (let loop ((numbers numbers))
             (match numbers
               ((first second rest ...)
-               (display-profile-content-diff profile
-                                             first second)
+               (if details?
+                   (display-profile-content-diff profile
+                                                 first second)
+                   (display-profile-content profile second))
                (display-channel-news (generation-file-name profile second)
                                      (generation-file-name profile first))
                (loop (cons second rest)))
@@ -662,16 +695,23 @@ Return true when there is more package info to display."
              (raise (condition (&profile-not-found-error
                                 (profile profile)))))
             ((not pattern)
-             (list-generations profile (profile-generations profile)))
+             (with-paginated-output-port port
+               (with-output-to-port port
+                 (lambda ()
+                   (list-generations profile (profile-generations profile))))))
             ((matching-generations pattern profile)
              =>
              (match-lambda
                (()
                 (exit 1))
                ((numbers ...)
-                (list-generations profile numbers)))))))
+                (with-paginated-output-port port
+                  (with-output-to-port port
+                    (lambda ()
+                      (list-generations profile numbers))))))))))
     (('display-news)
-     (display-news profile))))
+     (display-news profile
+                   #:profile-news? (assoc-ref opts 'details?)))))
 
 (define (process-generation-change opts profile)
   "Process a request to change the current generation (roll-back, switch, delete)."
@@ -754,7 +794,7 @@ Use '~/.config/guix/channels.scm' instead."))
 (define-command (guix-pull . args)
   (synopsis "pull the latest revision of Guix")
 
-  (define (no-arguments arg _‌)
+  (define (no-arguments arg _)
     (leave (G_ "~A: extraneous argument~%") arg))
 
   (with-error-handling
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index a92932cbc9..1eab05d737 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -372,6 +372,10 @@ return #f and #f."
        ;; least depending on external state (with-source, with-commit, etc.),
        ;; so do not cache anything when they're used.
        (values #f #f))
+      ((('profile . _) . _)
+       ;; If the user already specified a profile, there's nothing more to
+       ;; cache.
+       (values #f #f))
       ((('system . system) . rest)
        (loop rest system file specs))
       ((_ . rest) (loop rest system file specs)))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 430815902d..067bf999f1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -51,7 +51,7 @@
                                        delete-matching-generations)
   #:autoload   (guix scripts pull) (channel-commit-hyperlink)
   #:autoload   (guix graph) (export-graph node-type
-                             graph-backend-name %graph-backends)
+                             graph-backend-name lookup-backend)
   #:use-module (guix scripts graph)
   #:use-module (guix scripts system reconfigure)
   #:use-module (guix build utils)
@@ -88,7 +88,10 @@
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:export (guix-system
-            read-operating-system))
+            read-operating-system
+
+            service-node-type
+            shepherd-service-node-type))
 
 
 ;;;
@@ -887,13 +890,6 @@ Run 'herd status' to view the list of services on your system.\n"))))))
                    (register-root* (list output) gc-root))
                  (return output)))))))))
 
-(define (lookup-backend name)                     ;TODO: factorize
-  "Return the graph backend called NAME.  Raise an error if it is not found."
-  (or (find (lambda (backend)
-              (string=? (graph-backend-name backend) name))
-            %graph-backends)
-      (leave (G_ "~a: unknown backend~%") name)))
-
 (define* (export-extension-graph os port
                                  #:key (backend (lookup-backend "graphviz")))
   "Export the service extension graph of OS to PORT using BACKEND."
@@ -901,7 +897,7 @@ Run 'herd status' to view the list of services on your system.\n"))))))
          (system   (find (lambda (service)
                            (eq? (service-kind service) system-service-type))
                          services)))
-    (export-graph (list system) (current-output-port)
+    (export-graph (list system) port
                   #:backend backend
                   #:node-type (service-node-type services)
                   #:reverse-edges? #t)))
@@ -917,7 +913,7 @@ Run 'herd status' to view the list of services on your system.\n"))))))
          (sinks     (filter (lambda (service)
                               (null? (shepherd-service-requirement service)))
                             shepherds)))
-    (export-graph sinks (current-output-port)
+    (export-graph sinks port
                   #:backend backend
                   #:node-type (shepherd-service-node-type shepherds)
                   #:reverse-edges? #t)))
@@ -1328,9 +1324,17 @@ argument list and OPTS is the option alist."
                       (x (leave (G_ "wrong number of arguments~%"))))))
        (list-generations pattern)))
     ((describe)
+     ;; Describe the running system, which is not necessarily the current
+     ;; generation.  /run/current-system might point to
+     ;; /var/guix/profiles/system-N-link, or it might point directly to
+     ;; /gnu/store/…-system.  Try both.
      (match (generation-number "/run/current-system" %system-profile)
        (0
-        (leave (G_ "no system generation, nothing to describe~%")))
+        (match (generation-number %system-profile)
+          (0
+           (leave (G_ "no system generation, nothing to describe~%")))
+          (generation
+           (display-system-generation generation))))
        (generation
         (display-system-generation generation))))
     ((search)
diff --git a/guix/status.scm b/guix/status.scm
index fba28765df..b8905c9542 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -414,6 +414,11 @@ produce colorful output.  When PRINT-LOG? is true, display the build log in
 addition to build events.  When PRINT-URLS? is true, display the URL of
 substitutes being downloaded."
   (define info
+    (if (and colorize? (or print-urls? print-log?))
+        (cute colorize-string <> (color BOLD))
+        identity))
+
+  (define emph
     (if colorize?
         (cute colorize-string <> (color BOLD))
         identity))
@@ -483,7 +488,9 @@ substitutes being downloaded."
              (format port (info (N_ "applying ~a graft for ~a ..."
                                     "applying ~a grafts for ~a ..."
                                     count))
-                     count drv)))
+                     count
+                     (string-drop-right (store-path-package-name drv)
+                                        (string-length ".drv")))))
          ('profile
           (let ((count (match (assq-ref properties 'profile)
                          (#f  0)
@@ -496,7 +503,7 @@ substitutes being downloaded."
           (let ((hook-type (assq-ref properties 'hook)))
             (or (and=> (hook-message hook-type)
                        (lambda (msg)
-                         (format port (info msg))))
+                         (display (info msg) port)))
                 (format port (info (G_ "running profile hook of type '~a'..."))
                         hook-type))))
          (_
@@ -524,7 +531,7 @@ substitutes being downloaded."
         (format port (failure (G_ "Could not find build log for '~a'."))
                 drv))
        (log
-        (format port (info (G_ "View build log at '~a'.")) log)))
+        (format port (emph (G_ "View build log at '~a'.")) log)))
      (newline port))
     (('substituter-started item _ ...)
      (erase-current-line*)
@@ -575,12 +582,12 @@ substitutes being downloaded."
      ;; /gnu/store/…-sth:", where "sha256" is the hash algorithm.
      (format port (failure (G_ "~a hash mismatch for ~a:")) algo item)
      (newline port)
-     (format port (info (G_ "\
+     (format port (emph (G_ "\
   expected hash: ~a
   actual hash:   ~a~%"))
              expected actual))
     (('build-remote drv host _ ...)
-     (format port (info (G_ "offloading build of ~a to '~a'")) drv host)
+     (format port (emph (G_ "offloading build of ~a to '~a'")) drv host)
      (newline port))
     (('build-log pid line)
      (if (multiplexed-output-supported?)
diff --git a/guix/tests.scm b/guix/tests.scm
index 06ef3cf76d..8f6d040f1f 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -85,10 +85,12 @@
                      "warning: build daemon error: ~s~%" c)
              #f))
     (let ((store (open-connection uri)))
-      ;; Make sure we build everything by ourselves.
+      ;; Make sure we build everything by ourselves.  When we build something,
+      ;; it should take at most 5 minutes.
       (set-build-options store
                          #:use-substitutes? #f
-                         #:substitute-urls (%test-substitute-urls))
+                         #:substitute-urls (%test-substitute-urls)
+                         #:timeout (* 5 60))
 
       ;; Use the bootstrap Guile when running tests, so we don't end up
       ;; building everything in the temporary test store.
@@ -147,6 +149,9 @@ no external store to talk to."
           ;; further.
           (unsetenv "NIX_STORE_DIR"))
         (lambda ()
+          (when store
+            ;; Make sure we don't end up rebuilding the world for those tests.
+            (set-build-options store #:timeout (* 10 60)))
           (proc store))
         (lambda ()
           (when store-variable
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 0976f0d824..a0045e5b27 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -46,6 +46,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 (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -526,10 +527,29 @@ system that builds code for MICRO-ARCHITECTURE; otherwise raise an error."
                   micro-architecture)))
         (unless (member micro-architecture
                         (or (assoc-ref lst architecture) '()))
-          (raise (formatted-message
-                  (G_ "compiler ~a does not support micro-architecture ~a")
-                  (package-full-name compiler)
-                  micro-architecture))))
+          (raise
+           (make-compound-condition
+            (formatted-message
+             (G_ "compiler ~a does not support micro-architecture ~a")
+             (package-full-name compiler)
+             micro-architecture)
+            (condition
+             (&fix-hint
+              (hint (match (assoc-ref lst architecture)
+                      (#f (format #f (G_ "Compiler ~a does not support
+micro-architectures of ~a.")
+                                  (package-full-name compiler "@@")
+                                  architecture))
+                      (lst
+                       (format #f (G_ "Compiler ~a supports the following ~a
+micro-architectures:
+
+@quotation
+~a
+@end quotation")
+                               (package-full-name compiler "@@")
+                               architecture
+                               (string-join lst ", ")))))))))))
 
       (bag
         (inherit lowered)
diff --git a/guix/ui.scm b/guix/ui.scm
index 093de1b4ab..6c194eb3c9 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -124,6 +124,7 @@
             file-hyperlink
             location->hyperlink
 
+            pager-wrapped-port
             with-paginated-output-port
             relevance
             package-relevance
@@ -1030,29 +1031,38 @@ summary, and level 0 shows nothing."
     ;; Unfortunately, this is hardly avoidable for proper i18n.
     (if dry-run?
         (begin
-          (unless (zero? verbosity)
+          (unless (or (zero? verbosity) (null? build))
             (format (current-error-port)
-                    (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
-                        "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
-                        (length build))
-                    (null? build) (map colorized-store-item build)))
+                    (highlight/warn
+                     (N_ "The following derivation would be built:~%"
+                         "The following derivations would be built:~%"
+                         (length build))))
+            (format (current-error-port) "~{  ~a~%~}"
+                    (map colorized-store-item build)))
           (cond ((>= verbosity 2)
                  (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:~%~{   ~a~%~}~;~]")
-                             (null? download)
-                             download-size
-                             (map (compose colorized-store-item substitutable-path)
-                                  download))
-                     (format (current-error-port)
-                             (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
-                                 "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
-                                 (length download))
-                             (null? download)
-                             (map (compose colorized-store-item substitutable-path)
-                                  download)))
+                     (begin
+                       (format (current-error-port)
+                               (highlight
+                                ;; TRANSLATORS: "MB" is for "megabyte"; it
+                                ;; should be translated to the corresponding
+                                ;; abbreviation.
+                                (G_ "~:[~,1h MB would be downloaded:~%~;~]"))
+                               (null? download)
+                               download-size)
+                       (format (current-error-port) "~{  ~a~%~}"
+                               (map (compose colorized-store-item substitutable-path)
+                                    download)))
+                     (begin
+                       (format (current-error-port)
+                               (highlight
+                                (N_ "~:[The following file would be downloaded:~%~;~]"
+                                    "~:[The following files would be downloaded:~%~;~]"
+                                    (length download)))
+                               (null? download))
+                       (format (current-error-port) "~{  ~a~%~}"
+                               (map (compose colorized-store-item substitutable-path)
+                                    download))))
                  (format (current-error-port)
                          (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
                              "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
@@ -1081,29 +1091,38 @@ summary, and level 0 shows nothing."
                              (null? download) (length download))))))
 
         (begin
-          (unless (zero? verbosity)
+          (unless (or (zero? verbosity) (null? build))
             (format (current-error-port)
-                    (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
-                        "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
-                        (length build))
-                    (null? build) (map colorized-store-item build)))
+                    (highlight/warn
+                     (N_ "The following derivation will be built:~%"
+                         "The following derivations will be built:~%"
+                         (length build))))
+            (format (current-error-port) "~{  ~a~%~}"
+                    (map colorized-store-item build)))
           (cond ((>= verbosity 2)
                  (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:~%~{   ~a~%~}~;~]")
-                             (null? download)
-                             download-size
-                             (map (compose colorized-store-item substitutable-path)
-                                  download))
-                     (format (current-error-port)
-                             (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
-                                 "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
-                                 (length download))
-                             (null? download)
-                             (map (compose colorized-store-item substitutable-path)
-                                  download)))
+                     (begin
+                       (format (current-error-port)
+                               (highlight
+                                ;; TRANSLATORS: "MB" is for "megabyte"; it
+                                ;; should be translated to the corresponding
+                                ;; abbreviation.
+                                (G_ "~:[~,1h MB will be downloaded:~%~;~]"))
+                               (null? download)
+                               download-size)
+                       (format (current-error-port) "~{  ~a~%~}"
+                               (map (compose colorized-store-item substitutable-path)
+                                    download)))
+                     (begin
+                       (format (current-error-port)
+                               (highlight
+                                (N_ "~:[The following file will be downloaded:~%~;~]"
+                                    "~:[The following files will be downloaded:~%~;~]"
+                                    (length download)))
+                               (null? download))
+                       (format (current-error-port) "~{  ~a~%~}"
+                               (map (compose colorized-store-item substitutable-path)
+                                    download))))
                  (format (current-error-port)
                          (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
                              "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
@@ -1665,6 +1684,20 @@ score, the more relevant OBJ is to REGEXPS."
 zero means that PACKAGE does not match any of REGEXPS."
   (relevance package regexps %package-metrics))
 
+(define pager-port-mapping
+  ;; If a pager is being used, via 'with-paginated-output-port', this maps the
+  ;; pager port (pipe) to the underlying output port.
+  (make-parameter #f))
+
+(define* (pager-wrapped-port #:optional (port (current-output-port)))
+  "If PORT is a pipe to a pager created by 'with-paginated-output-port',
+return the underlying port.  Otherwise return #f."
+  (match (pager-port-mapping)
+    ((pager . wrapped)
+     (and (eq? pager port) wrapped))
+    (_
+     #f)))
+
 (define* (call-with-paginated-output-port proc
                                           #:key (less-options "FrX"))
   (let ((pager-command-line (or (getenv "GUIX_PAGER")
@@ -1691,7 +1724,10 @@ zero means that PACKAGE does not match any of REGEXPS."
                                                      char-set:whitespace))))))
           (dynamic-wind
             (const #t)
-            (lambda () (proc pager))
+            (lambda ()
+              (parameterize ((pager-port-mapping
+                              (cons pager (current-output-port))))
+                (proc pager)))
             (lambda () (close-pipe pager))))
         (proc (current-output-port)))))
 
@@ -1882,7 +1918,9 @@ DURATION-RELATION with the current time."
            (link   (if (supports-hyperlinks?)
                        (cut file-hyperlink file <>)
                        identity))
-           (header (format #f (link (highlight (G_ "Generation ~a\t~a")))
+           (header (format #f (link (highlight (G_ "Generation ~a\t~a")
+                                               (or (pager-wrapped-port)
+                                                   (current-output-port))))
                            number
                            (date->string
                             (time-utc->date
diff --git a/guix/utils.scm b/guix/utils.scm
index a0ca9b9070..44c46cb4a9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -99,8 +99,10 @@
             target-powerpc?
             target-riscv64?
             target-64bit?
+            ar-for-target
             cc-for-target
             cxx-for-target
+            ld-for-target
             pkg-config-for-target
 
             version-compare
@@ -715,6 +717,11 @@ architecture (x86_64)?"
   (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64"
                                         "powerpc64" "riscv64")))
 
+(define* (ar-for-target #:optional (target (%current-target-system)))
+  (if target
+      (string-append target "-ar")
+      "ar"))
+
 (define* (cc-for-target #:optional (target (%current-target-system)))
   (if target
       (string-append target "-gcc")
@@ -725,6 +732,11 @@ architecture (x86_64)?"
       (string-append target "-g++")
       "g++"))
 
+(define* (ld-for-target #:optional (target (%current-target-system)))
+  (if target
+      (string-append target "-ld")
+      "ld"))
+
 (define* (pkg-config-for-target #:optional (target (%current-target-system)))
   (if target
       (string-append target "-pkg-config")