Merge branch 'master' into core-updates

41 files changed, 1245 insertions, 614 deletions

diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm
index 488fe9bb1d..63cb7cd864 100644
--- a/guix/build-system/julia.scm
+++ b/guix/build-system/julia.scm
@@ -75,13 +75,14 @@
 
 (define* (julia-build store name inputs
                       #:key source
-                      (tests? #f)
+                      (tests? #t)
                       (phases '(@ (guix build julia-build-system)
                                   %standard-phases))
                       (outputs '("out"))
                       (search-paths '())
                       (system (%current-system))
                       (guile #f)
+                      (julia-package-name #f)
                       (imported-modules %julia-build-system-modules)
                       (modules '((guix build julia-build-system)
                                  (guix build utils))))
@@ -103,7 +104,8 @@
                     #:outputs %outputs
                     #:search-paths ',(map search-path-specification->sexp
                                           search-paths)
-                    #:inputs %build-inputs)))
+                    #:inputs %build-inputs
+                    #:julia-package-name ,julia-package-name)))
 
   (define guile-for-build
     (match guile
diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm
index e8ebcf8ba0..8f57045a8c 100644
--- a/guix/build/julia-build-system.scm
+++ b/guix/build/julia-build-system.scm
@@ -21,6 +21,8 @@
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
   #:export (%standard-phases
             julia-create-package-toml
             julia-build))
@@ -37,18 +39,34 @@
 ;; subpath where we store the package content
 (define %package-path "/share/julia/packages/")
 
-(define* (install #:key source inputs outputs #:allow-other-keys)
+(define (project.toml->name file)
+  "Look for Julia package name in the TOML file FILE (usually named
+Project.toml)."
+  (call-with-input-file file
+    (lambda (in)
+      (let loop ((line (read-line in 'concat)))
+        (if (eof-object? line)
+            #f
+            (let ((m (string-match "name\\s*=\\s*\"(.*)\"" line)))
+              (if m (match:substring m 1)
+                  (loop (read-line in 'concat)))))))))
+
+(define* (install #:key source inputs outputs julia-package-name
+                  #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (package-dir (string-append out %package-path
-                                     (strip-store-file-name source))))
+                                     (or
+                                      julia-package-name
+                                      (project.toml->name "Project.toml")))))
     (mkdir-p package-dir)
     (copy-recursively (getcwd) package-dir))
   #t)
 
-(define* (precompile #:key source inputs outputs #:allow-other-keys)
+(define* (precompile #:key source inputs outputs julia-package-name
+                     #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (builddir (string-append out "/share/julia/"))
-         (package (strip-store-file-name source)))
+         (package (or julia-package-name (project.toml->name "Project.toml"))))
     (mkdir-p builddir)
     ;; With a patch, SOURCE_DATE_EPOCH is honored
     (setenv "SOURCE_DATE_EPOCH" "1")
@@ -69,15 +87,23 @@
      (string-append "pushfirst!(DEPOT_PATH, pop!(DEPOT_PATH)); using " package)))
   #t)
 
-(define* (check #:key source inputs outputs #:allow-other-keys)
-  (let* ((out (assoc-ref outputs "out"))
-         (package (strip-store-file-name source))
-         (builddir (string-append out "/share/julia/")))
-    ;; With a patch, SOURCE_DATE_EPOCH is honored
-    (setenv "SOURCE_DATE_EPOCH" "1")
-    (setenv "JULIA_DEPOT_PATH" builddir)
-    (setenv "JULIA_LOAD_PATH" (string-append builddir "packages/"))
-    (invoke-julia (string-append "using Pkg;Pkg.test(\"" package "\")")))
+(define* (check #:key tests? source inputs outputs julia-package-name
+                #:allow-other-keys)
+  (when tests?
+    (let* ((out (assoc-ref outputs "out"))
+           (package (or julia-package-name (project.toml->name "Project.toml")))
+           (builddir (string-append out "/share/julia/")))
+      ;; With a patch, SOURCE_DATE_EPOCH is honored
+      (setenv "SOURCE_DATE_EPOCH" "1")
+      (setenv "JULIA_DEPOT_PATH" builddir)
+      (setenv "JULIA_LOAD_PATH"
+              (string-append builddir "packages/" ":"
+                             (or (getenv "JULIA_LOAD_PATH")
+                                 "")))
+      (setenv "HOME" "/tmp")
+      (invoke "julia"
+              (string-append builddir "packages/"
+                             package "/test/runtests.jl"))))
   #t)
 
 (define (julia-create-package-toml outputs source
@@ -112,7 +138,7 @@ version = \"" version "\"
     (delete 'check) ; tests must be run after installation
     (replace 'install install)
     (add-after 'install 'precompile precompile)
-    ;; (add-after 'install 'check check)
+    (add-after 'install 'check check)
     ;; TODO: In the future we could add a "system-image-generation" phase
     ;; where we use PackageCompiler.jl to speed up package loading times
     (delete 'configure)
@@ -120,9 +146,11 @@ version = \"" version "\"
     (delete 'patch-usr-bin-file)
     (delete 'build)))
 
-(define* (julia-build #:key inputs (phases %standard-phases)
+(define* (julia-build #:key inputs julia-package-name
+                      (phases %standard-phases)
                       #:allow-other-keys #:rest args)
   "Build the given Julia package, applying all of PHASES in order."
   (apply gnu:gnu-build
          #:inputs inputs #:phases phases
+         #:julia-package-name julia-package-name
          args))
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 67ee9b665a..b42f498a80 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -169,7 +169,9 @@ SEARCH-PATHS."
     (lambda (p)
       (display "\
 ;; This file was automatically generated and is for internal use only.
-;; It cannot be passed to the '--manifest' option.\n\n"
+;; It cannot be passed to the '--manifest' option.
+;; Run 'guix package --export-manifest' if to export a file suitable
+;; for '--manifest'.\n\n"
                p)
       (pretty-print manifest p)))
 
diff --git a/guix/cache.scm b/guix/cache.scm
index feff131068..0401a9d428 100644
--- a/guix/cache.scm
+++ b/guix/cache.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,13 +47,14 @@
       (unless (= ENOENT (system-error-errno args))
         (apply throw args)))))
 
-(define (file-expiration-time ttl)
+(define* (file-expiration-time ttl #:optional (timestamp stat:atime))
   "Return a procedure that, when passed a file, returns its \"expiration
-time\" computed as its last-access time + TTL seconds."
+time\" computed as its timestamp + TTL seconds.  Call TIMESTAMP to obtain the
+relevant timestamp from the result of 'stat'."
   (lambda (file)
     (match (stat file #f)
       (#f 0)                       ;FILE may have been deleted in the meantime
-      (st (+ (stat:atime st) ttl)))))
+      (st (+ (timestamp st) ttl)))))
 
 (define* (remove-expired-cache-entries entries
                                        #:key
diff --git a/guix/channels.scm b/guix/channels.scm
index 0c84eed477..e7e1eb6fd0 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
@@ -91,6 +91,9 @@
             ensure-forward-channel-update
 
             profile-channels
+            manifest-entry-channel
+            sexp->channel
+            channel->code
 
             channel-news-entry?
             channel-news-entry-commit
@@ -802,13 +805,36 @@ derivation."
                           (derivation-input-derivation input))))
              (derivation-inputs drv))))
 
+(define (channel-instance->sexp instance)
+  "Return an sexp representation of INSTANCE, a channel instance."
+  (let* ((commit  (channel-instance-commit instance))
+         (channel (channel-instance-channel instance))
+         (intro   (channel-introduction channel)))
+    `(repository
+      (version 0)
+      (url ,(channel-url channel))
+      (branch ,(channel-branch channel))
+      (commit ,commit)
+      (name ,(channel-name channel))
+      ,@(if intro
+            `((introduction
+               (channel-introduction
+                (version 0)
+                (commit
+                 ,(channel-introduction-first-signed-commit
+                   intro))
+                (signer
+                 ,(openpgp-format-fingerprint
+                   (channel-introduction-first-commit-signer
+                    intro))))))
+            '()))))
+
 (define (channel-instances->manifest instances)
   "Return a profile manifest with entries for all of INSTANCES, a list of
 channel instances."
   (define (instance->entry instance drv)
-    (let* ((commit  (channel-instance-commit instance))
-           (channel (channel-instance-channel instance))
-           (intro   (channel-introduction channel)))
+    (let ((commit  (channel-instance-commit instance))
+          (channel (channel-instance-channel instance)))
       (manifest-entry
         (name (symbol->string (channel-name channel)))
         (version (string-take commit 7))
@@ -819,23 +845,7 @@ channel instances."
                       drv)
                   drv))
         (properties
-         `((source (repository
-                    (version 0)
-                    (url ,(channel-url channel))
-                    (branch ,(channel-branch channel))
-                    (commit ,commit)
-                    ,@(if intro
-                          `((introduction
-                             (channel-introduction
-                              (version 0)
-                              (commit
-                               ,(channel-introduction-first-signed-commit
-                                 intro))
-                              (signer
-                               ,(openpgp-format-fingerprint
-                                 (channel-introduction-first-commit-signer
-                                  intro))))))
-                          '()))))))))
+         `((source ,(channel-instance->sexp instance)))))))
 
   (mlet* %store-monad ((derivations (channel-instance-derivations instances))
                        (entries ->  (map instance->entry instances derivations)))
@@ -900,35 +910,73 @@ to 'latest-channel-instances'."
                                                   validate-pull)))
     (channel-instances->derivation instances)))
 
+(define* (sexp->channel sexp #:optional (name 'channel))
+  "Read SEXP, a provenance sexp as created by 'channel-instance->sexp'; use
+NAME as the channel name if SEXP does not specify it.  Return #f if the sexp
+does not have the expected structure."
+  (match sexp
+    (('repository ('version 0)
+                  ('url url)
+                  ('branch branch)
+                  ('commit commit)
+                  rest ...)
+     ;; Historically channel sexps did not include the channel name.  It's OK
+     ;; for channels created by 'channel-instances->manifest' because the
+     ;; entry name is the channel name, but it was missing for entries created
+     ;; by 'manifest-entry-with-provenance'.
+     (channel (name (match (assq 'name rest)
+                      (#f name)
+                      (('name name) name)))
+              (url url)
+              (commit commit)
+              (introduction
+               (match (assq 'introduction rest)
+                 (#f #f)
+                 (('introduction intro)
+                  (sexp->channel-introduction intro))))))
+
+    (_ #f)))
+
+(define (manifest-entry-channel entry)
+  "Return the channel ENTRY corresponds to, or #f if that information is
+missing or unreadable.  ENTRY must be an entry created by
+'channel-instances->manifest', with the 'source' property."
+  (let ((name (string->symbol (manifest-entry-name entry))))
+    (match (assq-ref (manifest-entry-properties entry) 'source)
+      ((sexp)
+       (sexp->channel sexp name))
+      (_
+       ;; No channel information for this manifest entry.
+       ;; XXX: Pre-0.15.0 Guix did not provide that information,
+       ;; but there's not much we can do in that case.
+       #f))))
+
 (define (profile-channels profile)
   "Return the list of channels corresponding to entries in PROFILE.  If
 PROFILE is not a profile created by 'guix pull', return the empty list."
-  (filter-map (lambda (entry)
-                (match (assq 'source (manifest-entry-properties entry))
-                  (('source ('repository ('version 0)
-                                         ('url url)
-                                         ('branch branch)
-                                         ('commit commit)
-                                         rest ...))
-                   (channel (name (string->symbol
-                                   (manifest-entry-name entry)))
-                            (url url)
-                            (commit commit)
-                            (introduction
-                             (match (assq 'introduction rest)
-                               (#f #f)
-                               (('introduction intro)
-                                (sexp->channel-introduction intro))))))
-
-                  ;; No channel information for this manifest entry.
-                  ;; XXX: Pre-0.15.0 Guix did not provide that information,
-                  ;; but there's not much we can do in that case.
-                  (_ #f)))
-
+  (filter-map manifest-entry-channel
               ;; Show most recently installed packages last.
               (reverse
                (manifest-entries (profile-manifest profile)))))
 
+(define* (channel->code channel #:key (include-introduction? #t))
+  "Return code (an sexp) to build CHANNEL.  When INCLUDE-INTRODUCTION? is
+true, include its introduction, if any."
+  (let ((intro (and include-introduction?
+                    (channel-introduction channel))))
+    `(channel
+      (name ',(channel-name channel))
+      (url ,(channel-url channel))
+      (commit ,(channel-commit channel))
+      ,@(if intro
+            `((introduction (make-channel-introduction
+                             ,(channel-introduction-first-signed-commit intro)
+                             (openpgp-fingerprint
+                              ,(openpgp-format-fingerprint
+                                (channel-introduction-first-commit-signer
+                                 intro))))))
+            '()))))
+
 
 ;;;
 ;;; News.
diff --git a/guix/ci.scm b/guix/ci.scm
index f429bf198f..f04109112c 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -19,9 +19,13 @@
 
 (define-module (guix ci)
   #:use-module (guix http-client)
+  #:use-module (guix utils)
   #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (guix i18n)
+  #:use-module (guix diagnostics)
+  #:autoload   (guix channels) (channel)
   #:export (build-product?
             build-product-id
             build-product-type
@@ -52,7 +56,9 @@
             latest-builds
             evaluation
             latest-evaluations
-            evaluations-for-commit))
+            evaluations-for-commit
+
+            channel-with-substitutes-available))
 
 ;;; Commentary:
 ;;;
@@ -165,3 +171,35 @@ as one of their inputs."
                     (string=? (checkout-commit checkout) commit))
                   (evaluation-checkouts evaluation)))
           (latest-evaluations url limit)))
+
+(define (find-latest-commit-with-substitutes url)
+  "Return the latest commit with available substitutes for the Guix package
+definitions at URL.  Return false if no commit were found."
+  (let* ((job-name (string-append "guix." (%current-system)))
+         (build (match (latest-builds url 1
+                                      #:job job-name
+                                      #:status 0) ;success
+                  ((build) build)
+                  (_ #f)))
+         (evaluation (and build
+                          (evaluation url (build-evaluation build))))
+         (commit (and evaluation
+                      (match (evaluation-checkouts evaluation)
+                        ((checkout)
+                         (checkout-commit checkout))))))
+    commit))
+
+(define (channel-with-substitutes-available chan url)
+  "Return a channel inheriting from CHAN but which commit field is set to the
+latest commit with available substitutes for the Guix package definitions at
+URL.  The current system is taken into account.
+
+If no commit with available substitutes were found, the commit field is set to
+false and a warning message is printed."
+  (let ((commit (find-latest-commit-with-substitutes url)))
+    (unless commit
+      (warning (G_ "could not find available substitutes at ~a~%")
+               url))
+    (channel
+     (inherit chan)
+     (commit commit))))
diff --git a/guix/describe.scm b/guix/describe.scm
index 05bf99eb58..ac89fc0d7c 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module ((guix utils) #:select (location-file))
   #:use-module ((guix store) #:select (%store-prefix store-path?))
   #:use-module ((guix config) #:select (%state-directory))
+  #:autoload   (guix channels) (sexp->channel)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (current-profile
@@ -31,7 +32,8 @@
             package-path-entries
 
             package-provenance
-            manifest-entry-with-provenance))
+            manifest-entry-with-provenance
+            manifest-entry-provenance))
 
 ;;; Commentary:
 ;;;
@@ -166,3 +168,31 @@ there."
                (#f   properties)
                (sexp `((provenance ,@sexp)
                        ,@properties)))))))))
+
+(define (manifest-entry-provenance entry)
+  "Return the list of channels ENTRY comes from.  Return the empty list if
+that information is missing."
+  (match (assq-ref (manifest-entry-properties entry) 'provenance)
+    ((main extras ...)
+     ;; XXX: Until recently, channel sexps lacked the channel name.  For
+     ;; entries created by 'manifest-entry-with-provenance', the first sexp
+     ;; is known to be the 'guix channel, and for the other ones, invent a
+     ;; fallback name (it's OK as the name is just a "pet name").
+     (match (sexp->channel main 'guix)
+       (#f '())
+       (channel
+        (let loop ((extras   extras)
+                   (counter  1)
+                   (channels (list channel)))
+          (match extras
+            (()
+             (reverse channels))
+            ((head . tail)
+             (let* ((name  (string->symbol
+                            (format #f "channel~a" counter)))
+                    (extra (sexp->channel head name)))
+               (if extra
+                   (loop tail (+ 1 counter) (cons extra channels))
+                   (loop tail counter channels)))))))))
+    (_
+     '())))
diff --git a/guix/git.scm b/guix/git.scm
index ca77b9f54b..a5103547d3 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,8 +23,10 @@
   #:use-module (git submodule)
   #:use-module (guix i18n)
   #:use-module (guix base32)
+  #:use-module (guix cache)
   #:use-module (gcrypt hash)
-  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module ((guix build utils)
+                #:select (mkdir-p delete-file-recursively))
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix records)
@@ -35,6 +37,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
@@ -318,6 +321,24 @@ definitely available in REPOSITORY, false otherwise."
     (_
      #f)))
 
+(define cached-checkout-expiration
+  ;; Return the expiration time procedure for a cached checkout.
+  ;; TODO: Honor $GUIX_GIT_CACHE_EXPIRATION.
+
+  ;; Use the mtime rather than the atime to cope with file systems mounted
+  ;; with 'noatime'.
+  (file-expiration-time (* 90 24 3600) stat:mtime))
+
+(define %checkout-cache-cleanup-period
+  ;; Period for the removal of expired cached checkouts.
+  (* 5 24 3600))
+
+(define (delete-checkout directory)
+  "Delete DIRECTORY recursively, in an atomic fashion."
+  (let ((trashed (string-append directory ".trashed")))
+    (rename-file directory trashed)
+    (delete-file-recursively trashed)))
+
 (define* (update-cached-checkout url
                                  #:key
                                  (ref '(branch . "master"))
@@ -341,6 +362,14 @@ When RECURSIVE? is true, check out submodules as well, if any.
 
 When CHECK-OUT? is true, reset the cached working tree to REF; otherwise leave
 it unchanged."
+  (define (cache-entries directory)
+    (filter-map (match-lambda
+                  ((or "." "..")
+                   #f)
+                  (file
+                   (string-append directory "/" file)))
+                (or (scandir directory) '())))
+
   (define canonical-ref
     ;; We used to require callers to specify "origin/" for each branch, which
     ;; made little sense since the cache should be transparent to them.  So
@@ -387,6 +416,17 @@ it unchanged."
        ;; REPOSITORY as soon as possible.
        (repository-close! repository)
 
+       ;; When CACHE-DIRECTORY is a sub-directory of the default cache
+       ;; directory, remove expired checkouts that are next to it.
+       (let ((parent (dirname cache-directory)))
+         (when (string=? parent (%repository-cache-directory))
+           (maybe-remove-expired-cache-entries parent cache-entries
+                                               #:entry-expiration
+                                               cached-checkout-expiration
+                                               #:delete-entry delete-checkout
+                                               #:cleanup-period
+                                               %checkout-cache-cleanup-period)))
+
        (values cache-directory (oid->string oid) relation)))))
 
 (define* (latest-repository-commit store url
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 08b2bcf758..0da6fc19b6 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -361,7 +362,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
 
   (let loop ((directory directory)
              (result    #f))
-    (let* ((entries (ftp-list conn directory))
+    (let* ((entries (catch 'ftp-error
+                      (lambda _ (ftp-list conn directory))
+                      (const '())))
 
            ;; Filter out things like /gnupg/patches.  Filter out "w32"
            ;; directories as found on ftp.gnutls.org.
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 514417f781..87abe9c2f1 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
 ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -109,6 +109,7 @@
   (home-page    cpan-release-home-page "resources"
                 (match-lambda
                   (#f #f)
+                  ((? unspecified?) #f)
                   ((lst ...) (assoc-ref lst "homepage"))))
   (dependencies cpan-release-dependencies "dependency"
                 (lambda (vector)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index fd44d80915..e8caf080fd 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
@@ -341,7 +341,11 @@ empty list when the FIELD cannot be found."
 ;; The field for system dependencies is often abused to specify non-package
 ;; dependencies (such as c++11).  This list is used to ignore them.
 (define invalid-packages
-  (list "c++11"))
+  (list "c++11"
+        "c++14"
+        "linux"
+        "getopt::long"
+        "xquartz"))
 
 (define cran-guix-name (cut guix-name "r-" <>))
 
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 1f6f94532e..418d716be6 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -49,6 +49,7 @@
                    ;; This is sometimes #nil (the JSON 'null' value).  Arrange
                    ;; to always return a list.
                    (cond ((not licenses) '())
+                         ((unspecified? licenses) '())
                          ((vector? licenses) (vector->list licenses))
                          (else '()))))
   (info          gem-info)
@@ -69,7 +70,7 @@
                  json->gem-dependency-list))
 
 (define (json->gem-dependency-list vector)
-  (if vector
+  (if (and vector (not (unspecified? vector)))
       (map json->gem-dependency (vector->list vector))
       '()))
 
diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm
index 29324d7554..51d5b77d34 100644
--- a/guix/import/gnu.scm
+++ b/guix/import/gnu.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,8 +19,10 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix import gnu)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix gnu-maintenance)
   #:use-module (guix import utils)
+  #:use-module (guix i18n)
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module (gcrypt hash)
@@ -108,20 +112,17 @@ download policy (see 'download-tarball' for details.)"
   "Return the package declaration for NAME as an s-expression.  Use
 KEY-DOWNLOAD as the OpenPGP key download policy (see 'download-tarball' for
 details.)"
-  (match (latest-release name)
-    ((? upstream-source? release)
-     (let ((version (upstream-source-version release)))
-       (match (find-package name)
-         (#f
-          (raise (condition
-                  (&message
-                   (message "couldn't find meta-data for GNU package")))))
-         (info
-          (gnu-package->sexp info release #:key-download key-download)))))
-    (_
-     (raise (condition
-             (&message
-              (message
-               "failed to determine latest release of GNU package")))))))
+  (let ((package (find-package name)))
+    (unless package
+      (raise (formatted-message (G_ "no GNU package found for ~a") name)))
+
+    (match (latest-release name)
+      ((? upstream-source? release)
+       (let ((version (upstream-source-version release)))
+         (gnu-package->sexp package release #:key-download key-download)))
+      (_
+       (raise (formatted-message
+               (G_ "failed to determine latest release of GNU ~a")
+               name))))))
 
 ;;; gnu.scm ends here
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index a84683ef6f..18d8b95ee0 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,8 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (web uri)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (guix http-client)
   #:use-module (gcrypt hash)
   #:use-module (guix memoization)
@@ -149,19 +152,24 @@ expression describing it."
            (home-page  (string-append "http://www.ctan.org/pkg/" id))
            (ref        (texlive-ref component id))
            (checkout   (download-svn-to-store store ref)))
+      (unless checkout
+        (warning (G_ "Could not determine source location.  \
+Please manually specify the source field.~%")))
       `(package
          (name ,(guix-name component id))
          (version ,version)
-         (source (origin
-                   (method svn-fetch)
-                   (uri (texlive-ref ,component ,id))
-                   (sha256
-                    (base32
-                     ,(bytevector->nix-base32-string
-                       (let-values (((port get-hash) (open-sha256-port)))
-                         (write-file checkout port)
-                         (force-output port)
-                         (get-hash)))))))
+         (source ,(if checkout
+                      `(origin
+                         (method svn-fetch)
+                         (uri (texlive-ref ,component ,id))
+                         (sha256
+                          (base32
+                           ,(bytevector->nix-base32-string
+                             (let-values (((port get-hash) (open-sha256-port)))
+                               (write-file checkout port)
+                               (force-output port)
+                               (get-hash))))))
+                      #f))
          (build-system texlive-build-system)
          (arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/"))))
          (home-page ,home-page)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 2fe91beaab..0990696e6c 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +40,7 @@
   #:use-module (guix search-paths)
   #:use-module (guix profiles)
   #:use-module (guix channels)
+  #:use-module ((guix git) #:select (update-cached-checkout))
   #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (guix derivations)
@@ -51,6 +52,7 @@
   #:autoload   (guix build utils) (mkdir-p)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:autoload   (ice-9 ftw) (scandir)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
@@ -311,8 +313,7 @@ Raise '&inferior-exception' when an exception is read from PORT."
   "Return the list of name/version pairs corresponding to the set of packages
 available in INFERIOR.
 
-This is faster and requires less resource-intensive than calling
-'inferior-packages'."
+This is faster and less resource-intensive than calling 'inferior-packages'."
   (if (inferior-eval '(defined? 'fold-available-packages)
                      inferior)
       (inferior-eval '(fold-available-packages
@@ -642,29 +643,45 @@ failing when GUIX is too old and lacks the 'guix repl' command."
 
 (define* (inferior-package->manifest-entry package
                                            #:optional (output "out")
-                                           #:key (parent (delay #f))
-                                           (properties '()))
+                                           #:key (properties '()))
   "Return a manifest entry for the OUTPUT of package PACKAGE."
-  ;; For each dependency, keep a promise pointing to its "parent" entry.
-  (letrec* ((deps  (map (match-lambda
-                          ((label package)
-                           (inferior-package->manifest-entry package
-                                                             #:parent (delay entry)))
-                          ((label package output)
-                           (inferior-package->manifest-entry package output
-                                                             #:parent (delay entry))))
-                        (inferior-package-propagated-inputs package)))
-            (entry (manifest-entry
-                     (name (inferior-package-name package))
-                     (version (inferior-package-version package))
-                     (output output)
-                     (item package)
-                     (dependencies (delete-duplicates deps))
-                     (search-paths
-                      (inferior-package-transitive-native-search-paths package))
-                     (parent parent)
-                     (properties properties))))
-    entry))
+  (define cache
+    (make-hash-table))
+
+  (define-syntax-rule (memoized package output exp)
+    ;; Memoize the entry returned by EXP for PACKAGE/OUTPUT.  This is
+    ;; important as the same package may be traversed many times through
+    ;; propagated inputs, and querying the inferior is costly.  Use
+    ;; 'hash'/'equal?', which is okay since <inferior-package> is simple.
+    (let ((compute (lambda () exp))
+          (key     (cons package output)))
+      (or (hash-ref cache key)
+          (let ((result (compute)))
+            (hash-set! cache key result)
+            result))))
+
+  (let loop ((package package)
+             (output  output)
+             (parent  (delay #f)))
+    (memoized package output
+      ;; For each dependency, keep a promise pointing to its "parent" entry.
+      (letrec* ((deps  (map (match-lambda
+                              ((label package)
+                               (loop package "out" (delay entry)))
+                              ((label package output)
+                               (loop package output (delay entry))))
+                            (inferior-package-propagated-inputs package)))
+                (entry (manifest-entry
+                         (name (inferior-package-name package))
+                         (version (inferior-package-version package))
+                         (output output)
+                         (item package)
+                         (dependencies (delete-duplicates deps))
+                         (search-paths
+                          (inferior-package-transitive-native-search-paths package))
+                         (parent parent)
+                         (properties properties))))
+        entry))))
 
 
 ;;;
@@ -676,6 +693,21 @@ failing when GUIX is too old and lacks the 'guix repl' command."
   (make-parameter (string-append (cache-directory #:ensure? #f)
                                  "/inferiors")))
 
+(define (channel-full-commit channel)
+  "Return the commit designated by CHANNEL as quickly as possible.  If
+CHANNEL's 'commit' field is a full SHA1, return it as-is; if it's a SHA1
+prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
+  (let ((commit (channel-commit channel))
+        (branch (channel-branch channel)))
+    (if (and commit (= (string-length commit) 40))
+        commit
+        (let* ((ref (if commit `(commit . ,commit) `(branch . ,branch)))
+               (cache commit relation
+                     (update-cached-checkout (channel-url channel)
+                                             #:ref ref
+                                             #:check-out? #f)))
+          commit))))
+
 (define* (cached-channel-instance store
                                   channels
                                   #:key
@@ -686,15 +718,16 @@ failing when GUIX is too old and lacks the 'guix repl' command."
 The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
 This procedure opens a new connection to the build daemon.  AUTHENTICATE?
 determines whether CHANNELS are authenticated."
-  (define instances
-    (latest-channel-instances store channels
-                              #:authenticate? authenticate?))
+  (define commits
+    ;; Since computing the instances of CHANNELS is I/O-intensive, use a
+    ;; cheaper way to get the commit list of CHANNELS.  This limits overhead
+    ;; to the minimum in case of a cache hit.
+    (map channel-full-commit channels))
 
   (define key
     (bytevector->base32-string
      (sha256
-      (string->utf8
-       (string-concatenate (map channel-instance-commit instances))))))
+      (string->utf8 (string-concatenate commits)))))
 
   (define cached
     (string-append cache-directory "/" key))
@@ -722,8 +755,12 @@ determines whether CHANNELS are authenticated."
   (if (file-exists? cached)
       cached
       (run-with-store store
-        (mlet %store-monad ((profile
-                             (channel-instances->derivation instances)))
+        (mlet* %store-monad ((instances
+                              -> (latest-channel-instances store channels
+                                                           #:authenticate?
+                                                           authenticate?))
+                             (profile
+                              (channel-instances->derivation instances)))
           (mbegin %store-monad
             (show-what-to-build* (list profile))
             (built-derivations (list profile))
@@ -750,3 +787,7 @@ This is a convenience procedure that people may use in manifests passed to
                                #:cache-directory cache-directory
                                #:ttl ttl)))
   (open-inferior cached))
+
+;;; Local Variables:
+;;; eval: (put 'memoized 'scheme-indent-function 1)
+;;; End:
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 255b755e6c..1091eee67c 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -61,7 +61,7 @@
             gpl1 gpl1+ gpl2 gpl2+ gpl3 gpl3+
             gfl1.0
             fdl1.1+ fdl1.2+ fdl1.3+
-            opl1.0+
+            opl1.0+ osl2.1
             isc
             ijg
             ibmpl1.0
@@ -78,7 +78,7 @@
             mpl1.0 mpl1.1 mpl2.0
             ms-pl
             ncsa
-            npsl
+            nmap
             ogl-psi1.0
             openldap2.8 openssl
             perl-license
@@ -371,6 +371,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://opencontent.org/openpub/"
            "https://www.gnu.org/licenses/license-list#OpenPublicationL"))
 
+(define osl2.1
+  (license "The Open Software License 2.1"
+           "https://opensource.org/licenses/osl-2.1.php"
+           "https://www.gnu.org/licenses/license-list#OSL"))
+
 (define isc
   (license "ISC"
            "http://directory.fsf.org/wiki/License:ISC"
@@ -531,10 +536,10 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://directory.fsf.org/wiki/License:IllinoisNCSA"
            "https://www.gnu.org/licenses/license-list#NCSA"))
 
-(define npsl
-  (license "Nmap Public Source License"
-           "https://svn.nmap.org/nmap/LICENSE"
-           "https://nmap.org/npsl/"))
+(define nmap
+  (license "Nmap license"
+           "https://svn.nmap.org/nmap/COPYING"
+           "https://fedoraproject.org/wiki/Licensing/Nmap"))
 
 (define ogl-psi1.0
   (license "Open Government Licence for Public Sector Information"
diff --git a/guix/modules.scm b/guix/modules.scm
index 1a6fafe35b..61bc8e1978 100644
--- a/guix/modules.scm
+++ b/guix/modules.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -77,7 +77,7 @@ CLAUSES."
       ((#:autoload module _ rest ...)
        (loop rest (cons module result)))
       (((or #:export #:re-export #:export-syntax #:re-export-syntax
-            #:replace #:version)
+            #:re-export-and-replace #:replace #:version)
         _ rest ...)
        (loop rest result))
       (((or #:pure #:no-backtrace) rest ...)
diff --git a/guix/narinfo.scm b/guix/narinfo.scm
new file mode 100644
index 0000000000..d3deba28bd
--- /dev/null
+++ b/guix/narinfo.scm
@@ -0,0 +1,327 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix narinfo)
+  #:use-module (guix pki)
+  #:use-module (guix i18n)
+  #:use-module (guix base32)
+  #:use-module (guix base64)
+  #:use-module (guix records)
+  #:use-module (guix diagnostics)
+  #:use-module (guix scripts substitute)
+  #:use-module (gcrypt hash)
+  #:use-module (gcrypt pk-crypto)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (web uri)
+  #:export (narinfo-signature->canonical-sexp
+
+            narinfo?
+            narinfo-path
+            narinfo-uris
+            narinfo-uri-base
+            narinfo-compressions
+            narinfo-file-hashes
+            narinfo-file-sizes
+            narinfo-hash
+            narinfo-size
+            narinfo-references
+            narinfo-deriver
+            narinfo-system
+            narinfo-signature
+            narinfo-contents
+
+            narinfo-hash-algorithm+value
+
+            narinfo-hash->sha256
+            narinfo-best-uri
+
+            valid-narinfo?
+
+            read-narinfo
+            write-narinfo
+
+            string->narinfo
+            narinfo->string
+
+            equivalent-narinfo?))
+
+(define-record-type <narinfo>
+  (%make-narinfo path uri-base uris compressions file-sizes file-hashes
+                 nar-hash nar-size references deriver system
+                 signature contents)
+  narinfo?
+  (path         narinfo-path)
+  (uri-base     narinfo-uri-base)        ;URI of the cache it originates from
+  (uris         narinfo-uris)            ;list of strings
+  (compressions narinfo-compressions)    ;list of strings
+  (file-sizes   narinfo-file-sizes)      ;list of (integers | #f)
+  (file-hashes  narinfo-file-hashes)
+  (nar-hash     narinfo-hash)
+  (nar-size     narinfo-size)
+  (references   narinfo-references)
+  (deriver      narinfo-deriver)
+  (system       narinfo-system)
+  (signature    narinfo-signature)      ; canonical sexp
+  ;; The original contents of a narinfo file.  This field is needed because we
+  ;; want to preserve the exact textual representation for verification purposes.
+  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
+  ;; for more information.
+  (contents     narinfo-contents))
+
+(define (narinfo-hash-algorithm+value narinfo)
+  "Return two values: the hash algorithm used by NARINFO and its value as a
+bytevector."
+  (match (string-tokenize (narinfo-hash narinfo)
+                          (char-set-complement (char-set #\:)))
+    ((algorithm base32)
+     (values (lookup-hash-algorithm (string->symbol algorithm))
+             (nix-base32-string->bytevector base32)))
+    (_
+     (raise (formatted-message
+             (G_ "invalid narinfo hash: ~s") (narinfo-hash narinfo))))))
+
+(define (narinfo-hash->sha256 hash)
+  "If the string HASH denotes a sha256 hash, return it as a bytevector.
+Otherwise return #f."
+  (and (string-prefix? "sha256:" hash)
+       (nix-base32-string->bytevector (string-drop hash 7))))
+
+(define (narinfo-signature->canonical-sexp str)
+  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
+  (match (string-split str #\;)
+    ((version host-name sig)
+     (let ((maybe-number (string->number version)))
+       (cond ((not (number? maybe-number))
+              (leave (G_ "signature version must be a number: ~s~%")
+                     version))
+             ;; Currently, there are no other versions.
+             ((not (= 1 maybe-number))
+              (leave (G_ "unsupported signature version: ~a~%")
+                     maybe-number))
+             (else
+              (let ((signature (utf8->string (base64-decode sig))))
+                (catch 'gcry-error
+                  (lambda ()
+                    (string->canonical-sexp signature))
+                  (lambda (key proc err)
+                    (leave (G_ "signature is not a valid \
+s-expression: ~s~%")
+                           signature))))))))
+    (x
+     (leave (G_ "invalid format of the signature field: ~a~%") x))))
+
+(define (narinfo-maker str cache-url)
+  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
+must contain the original contents of a narinfo file."
+  (lambda (path urls compressions file-hashes file-sizes
+                nar-hash nar-size references deriver system
+                signature)
+    "Return a new <narinfo> object."
+    (define len (length urls))
+    (%make-narinfo path cache-url
+                   ;; Handle the case where URL is a relative URL.
+                   (map (lambda (url)
+                          (or (string->uri url)
+                              (string->uri
+                               (string-append cache-url "/" url))))
+                        urls)
+                   compressions
+                   (match file-sizes
+                     (()        (make-list len #f))
+                     ((lst ...) (map string->number lst)))
+                   (match file-hashes
+                     (()        (make-list len #f))
+                     ((lst ...) (map string->number lst)))
+                   nar-hash
+                   (and=> nar-size string->number)
+                   (string-tokenize references)
+                   (match deriver
+                     ((or #f "") #f)
+                     (_ deriver))
+                   system
+                   (false-if-exception
+                    (and=> signature narinfo-signature->canonical-sexp))
+                   str)))
+
+(define fields->alist
+  ;; The narinfo format is really just like recutils.
+  recutils->alist)
+
+(define* (read-narinfo port #:optional url
+                       #:key size)
+  "Read a narinfo from PORT.  If URL is true, it must be a string used to
+build full URIs from relative URIs found while reading PORT.  When SIZE is
+true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
+
+No authentication and authorization checks are performed here!"
+  (let ((str (utf8->string (if size
+                               (get-bytevector-n port size)
+                               (get-bytevector-all port)))))
+    (alist->record (call-with-input-string str fields->alist)
+                   (narinfo-maker str url)
+                   '("StorePath" "URL" "Compression"
+                     "FileHash" "FileSize" "NarHash" "NarSize"
+                     "References" "Deriver" "System"
+                     "Signature")
+                   '("URL" "Compression" "FileSize" "FileHash"))))
+
+(define (narinfo-sha256 narinfo)
+  "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
+'Signature' field."
+  (define %mandatory-fields
+    ;; List of fields that must be signed.  If they are not signed, the
+    ;; narinfo is considered unsigned.
+    '("StorePath" "NarHash" "References"))
+
+  (let ((contents (narinfo-contents narinfo)))
+    (match (string-contains contents "Signature:")
+      (#f #f)
+      (index
+       (let* ((above-signature (string-take contents index))
+              (signed-fields (match (call-with-input-string above-signature
+                                      fields->alist)
+                               (((fields . values) ...) fields))))
+         (and (every (cut member <> signed-fields) %mandatory-fields)
+              (sha256 (string->utf8 above-signature))))))))
+
+(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
+                         #:key verbose?)
+  "Return #t if NARINFO's signature is not valid."
+  (let ((hash      (narinfo-sha256 narinfo))
+        (signature (narinfo-signature narinfo))
+        (uri       (uri->string (first (narinfo-uris narinfo)))))
+    (and hash signature
+         (signature-case (signature hash acl)
+           (valid-signature #t)
+           (invalid-signature
+            (when verbose?
+              (format (current-error-port)
+                      "invalid signature for substitute at '~a'~%"
+                      uri))
+            #f)
+           (hash-mismatch
+            (when verbose?
+              (format (current-error-port)
+                      "hash mismatch for substitute at '~a'~%"
+                      uri))
+            #f)
+           (unauthorized-key
+            (when verbose?
+              (format (current-error-port)
+                      "substitute at '~a' is signed by an \
+unauthorized party~%"
+                      uri))
+            #f)
+           (corrupt-signature
+            (when verbose?
+              (format (current-error-port)
+                      "corrupt signature for substitute at '~a'~%"
+                      uri))
+            #f)))))
+
+(define (write-narinfo narinfo port)
+  "Write NARINFO to PORT."
+  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
+
+(define (narinfo->string narinfo)
+  "Return the external representation of NARINFO."
+  (call-with-output-string (cut write-narinfo narinfo <>)))
+
+(define (string->narinfo str cache-uri)
+  "Return the narinfo represented by STR.  Assume CACHE-URI as the base URI of
+the cache STR originates form."
+  (call-with-input-string str (cut read-narinfo <> cache-uri)))
+
+(define (equivalent-narinfo? narinfo1 narinfo2)
+  "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe
+the same store item.  This ignores unnecessary metadata such as the Nar URL."
+  (and (string=? (narinfo-hash narinfo1)
+                 (narinfo-hash narinfo2))
+
+       ;; The following is not needed if all we want is to download a valid
+       ;; nar, but it's necessary if we want valid narinfo.
+       (string=? (narinfo-path narinfo1)
+                 (narinfo-path narinfo2))
+       (equal? (narinfo-references narinfo1)
+               (narinfo-references narinfo2))
+
+       (= (narinfo-size narinfo1)
+          (narinfo-size narinfo2))))
+
+(define %compression-methods
+  ;; Known compression methods and a thunk to determine whether they're
+  ;; supported.  See 'decompressed-port' in (guix utils).
+  `(("gzip"  . ,(const #t))
+    ("lzip"  . ,(const #t))
+    ("zstd"  . ,(lambda ()
+                  (resolve-module '(zstd) #t #f #:ensure #f)))
+    ("xz"    . ,(const #t))
+    ("bzip2" . ,(const #t))
+    ("none"  . ,(const #t))))
+
+(define (supported-compression? compression)
+  "Return true if COMPRESSION, a string, denotes a supported compression
+method."
+  (match (assoc-ref %compression-methods compression)
+    (#f         #f)
+    (supported? (supported?))))
+
+(define (compresses-better? compression1 compression2)
+  "Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
+this is a rough approximation."
+  (match compression1
+    ("none" #f)
+    ("gzip" (string=? compression2 "none"))
+    ("lzip" #t)
+    (_      (or (string=? compression2 "none")
+                (string=? compression2 "gzip")))))
+
+(define (narinfo-best-uri narinfo)
+  "Select the \"best\" URI to download NARINFO's nar, and return three values:
+the URI, its compression method (a string), and the compressed file size."
+  (define choices
+    (filter (match-lambda
+              ((uri compression file-size)
+               (supported-compression? compression)))
+            (zip (narinfo-uris narinfo)
+                 (narinfo-compressions narinfo)
+                 (narinfo-file-sizes narinfo))))
+
+  (define (file-size<? c1 c2)
+    (match c1
+      ((uri1 compression1 (? integer? file-size1))
+       (match c2
+         ((uri2 compression2 (? integer? file-size2))
+          (< file-size1 file-size2))
+         (_ #t)))
+      ((uri compression1 #f)
+       (match c2
+         ((uri2 compression2 _)
+          (compresses-better? compression1 compression2))))
+      (_ #f)))                                    ;we can't tell
+
+  (match (sort choices file-size<?)
+    (((uri compression file-size) _ ...)
+     (values uri compression file-size))))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index deefce2e26..36cb30c191 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -107,6 +107,8 @@
             manifest-search-paths
             check-for-collisions
 
+            manifest->code
+
             manifest-transaction
             manifest-transaction?
             manifest-transaction-install
@@ -667,6 +669,88 @@ including the search path specification for $PATH."
          (append-map manifest-entry-search-paths
                      (manifest-entries manifest)))))
 
+(define* (manifest->code manifest
+                         #:key (entry-package-version (const "")))
+  "Return an sexp representing code to build an approximate version of
+MANIFEST; the code is wrapped in a top-level 'begin' form.  Call
+ENTRY-PACKAGE-VERSION to determine the version number to use in the spec for a
+given entry; it can be set to 'manifest-entry-version' for fully-specified
+version numbers, or to some other procedure to disambiguate versions for
+packages for which several versions are available."
+  (define (entry-transformations entry)
+    ;; Return the transformations that apply to ENTRY.
+    (assoc-ref (manifest-entry-properties entry) 'transformations))
+
+  (define transformation-procedures
+    ;; List of transformation options/procedure name pairs.
+    (let loop ((entries (manifest-entries manifest))
+               (counter 1)
+               (result  '()))
+      (match entries
+        (() result)
+        ((entry . tail)
+         (match (entry-transformations entry)
+           (#f
+            (loop tail counter result))
+           (options
+            (if (assoc-ref result options)
+                (loop tail counter result)
+                (loop tail (+ 1 counter)
+                      (alist-cons options
+                                  (string->symbol
+                                   (format #f "transform~a" counter))
+                                  result)))))))))
+
+  (define (qualified-name entry)
+    ;; Return the name of ENTRY possibly with "@" followed by a version.
+    (match (entry-package-version entry)
+      (""      (manifest-entry-name entry))
+      (version (string-append (manifest-entry-name entry)
+                              "@" version))))
+
+  (if (null? transformation-procedures)
+      `(begin                                     ;simplest case
+         (specifications->manifest
+          (list ,@(map (lambda (entry)
+                         (match (manifest-entry-output entry)
+                           ("out"  (qualified-name entry))
+                           (output (string-append (qualified-name entry)
+                                                  ":" output))))
+                       (manifest-entries manifest)))))
+      (let* ((transform (lambda (options exp)
+                          (if (not options)
+                              exp
+                              (let ((proc (assoc-ref transformation-procedures
+                                                     options)))
+                                `(,proc ,exp))))))
+        `(begin                                   ;transformations apply
+           (use-modules (guix transformations))
+
+           ,@(map (match-lambda
+                    ((options . name)
+                     `(define ,name
+                        (options->transformation ',options))))
+                  transformation-procedures)
+
+           (packages->manifest
+            (list ,@(map (lambda (entry)
+                           (define options
+                             (entry-transformations entry))
+
+                           (define name
+                             (qualified-name entry))
+
+                           (match (manifest-entry-output entry)
+                             ("out"
+                              (transform options
+                                         `(specification->package ,name)))
+                             (output
+                              `(list ,(transform
+                                       options
+                                       `(specification->package ,name))
+                                     ,output))))
+                         (manifest-entries manifest))))))))
+
 
 ;;;
 ;;; Manifest transactions.
diff --git a/guix/repl.scm b/guix/repl.scm
index 0ace5976cf..94d85815ef 100644
--- a/guix/repl.scm
+++ b/guix/repl.scm
@@ -78,8 +78,14 @@ output port.  VERSION is the client's protocol version we are targeting."
          (let ((stack (if (repl-prompt)
                           (make-stack #t handle-exception (repl-prompt))
                           (make-stack #t))))
+           ;; Note: 'make-stack' returns #f if there's no 'handle-exception'
+           ;; stack frame, which is the case when this file is being
+           ;; interpreted as with 'primitive-load'.
            `(exception (arguments ,key ,@(map value->sexp args))
-                       (stack ,@(map frame->sexp (stack->frames stack))))))
+                       (stack ,@(map frame->sexp
+                                     (if stack
+                                         (stack->frames stack)
+                                         '()))))))
         (_
          ;; Protocol (0 0).
          `(exception ,key ,@(map value->sexp args)))))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 1f73fff711..91be1b02e1 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -318,8 +318,8 @@ the input port."
       (warning (G_ "replacing symbolic link ~a with a regular file~%")
                %acl-file)
       (when (string-prefix? (%store-prefix) (readlink %acl-file))
-        (display-hint (G_ "On Guix System, add public keys to the
-@code{authorized-keys} field of your @code{operating-system} instead.")))))
+        (display-hint (G_ "On Guix System, add all @code{authorized-keys} to the
+@code{guix-service-type} service of your @code{operating-system} instead.")))))
 
   (let ((key (read-key))
         (acl (current-acl)))
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index d0a456ac1d..cc9cbe6f27 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -28,6 +28,7 @@
   #:use-module ((guix progress) #:hide (dump-port*))
   #:use-module (guix serialization)
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (rnrs bytevectors)
   #:autoload   (guix http-client) (http-fetch)
   #:use-module ((guix build syscalls) #:select (terminal-columns))
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index c3667516eb..e47d207ee0 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Ekaitz Zarraga <ekaitz@elenq.tech>
 ;;;
@@ -113,22 +113,6 @@ Display information about the channels currently in use.\n"))
        (_
         (warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not captured~%")))))))
 
-(define* (channel->sexp channel #:key (include-introduction? #t))
-  (let ((intro (and include-introduction?
-                    (channel-introduction channel))))
-    `(channel
-      (name ',(channel-name channel))
-      (url ,(channel-url channel))
-      (commit ,(channel-commit channel))
-      ,@(if intro
-            `((introduction (make-channel-introduction
-                             ,(channel-introduction-first-signed-commit intro)
-                             (openpgp-fingerprint
-                              ,(openpgp-format-fingerprint
-                                (channel-introduction-first-commit-signer
-                                 intro))))))
-            '()))))
-
 (define (channel->json channel)
   (scm->json-string
    (let ((intro (channel-introduction channel)))
@@ -183,7 +167,7 @@ string is ~a.~%")
        (format #t (G_ "  branch: ~a~%") (reference-shorthand head))
        (format #t (G_ "  commit: ~a~%") commit))
       ('channels
-       (pretty-print `(list ,(channel->sexp (channel (name 'guix)
+       (pretty-print `(list ,(channel->code (channel (name 'guix)
                                                      (url (dirname directory))
                                                      (commit commit))))))
       ('json
@@ -213,9 +197,9 @@ in the format specified by FMT."
     ('human
      (display-profile-content profile number))
     ('channels
-     (pretty-print `(list ,@(map channel->sexp channels))))
+     (pretty-print `(list ,@(map channel->code channels))))
     ('channels-sans-intro
-     (pretty-print `(list ,@(map (cut channel->sexp <>
+     (pretty-print `(list ,@(map (cut channel->code <>
                                       #:include-introduction? #f)
                                  channels))))
     ('json
@@ -237,23 +221,17 @@ way and displaying details about the channel's source code."
               (format #t "  ~a ~a~%"
                       (manifest-entry-name entry)
                       (manifest-entry-version entry))
-              (match (assq 'source (manifest-entry-properties entry))
-                (('source ('repository ('version 0)
-                                       ('url url)
-                                       ('branch branch)
-                                       ('commit commit)
-                                       _ ...))
-                 (let ((channel (channel (name 'nameless)
-                                         (url url)
-                                         (branch branch)
-                                         (commit commit))))
-                   (format #t (G_ "    repository URL: ~a~%") url)
-                   (when branch
-                     (format #t (G_ "    branch: ~a~%") branch))
-                   (format #t (G_ "    commit: ~a~%")
-                           (if (supports-hyperlinks?)
-                               (channel-commit-hyperlink channel commit)
-                               commit))))
+              (match (manifest-entry-channel entry)
+                ((? channel? channel)
+                 (format #t (G_ "    repository URL: ~a~%")
+                         (channel-url channel))
+                 (when (channel-branch channel)
+                   (format #t (G_ "    branch: ~a~%")
+                           (channel-branch channel)))
+                 (format #t (G_ "    commit: ~a~%")
+                         (if (supports-hyperlinks?)
+                             (channel-commit-hyperlink channel)
+                             (channel-commit channel))))
                 (_ #f)))
 
             ;; Show most recently installed packages last.
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index fbc202c658..f4d12f89bf 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -675,7 +675,7 @@ message if any test fails."
   (let* ((root (if (string-prefix? "/" root)
                    root
                    (string-append (canonicalize-path (dirname root))
-                                  "/" root))))
+                                  "/" (basename root)))))
     (catch 'system-error
       (lambda ()
         (symlink target root)
diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm
index 778e5f4bc5..d8d5c3a4af 100644
--- a/guix/scripts/import/json.scm
+++ b/guix/scripts/import/json.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,8 +89,13 @@ Import and convert the JSON package definition in PACKAGE-FILE.\n"))
                            (reverse opts))))
     (match args
       ((file-name)
-       (or (json->code file-name)
-           (leave (G_ "invalid JSON in file '~a'~%") file-name)))
+       (catch 'system-error
+         (lambda ()
+           (or (json->code file-name)
+               (leave (G_ "invalid JSON in file '~a'~%") file-name)))
+         (lambda args
+           (leave (G_ "failed to access '~a': ~a~%")
+                  file-name (strerror (system-error-errno args))))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 6faf2adb7a..8234a1703d 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
@@ -43,11 +43,13 @@
   #:use-module (guix scripts build)
   #:use-module (guix transformations)
   #:use-module (guix describe)
+  #:autoload   (guix channels) (channel-name channel-commit channel->code)
   #:autoload   (guix store roots) (gc-roots user-owned?)
   #:use-module ((guix build utils)
                 #:select (directory-exists? mkdir-p))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:autoload   (ice-9 pretty-print) (pretty-print)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
@@ -322,6 +324,96 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
 
 
 ;;;
+;;; Export a manifest.
+;;;
+
+(define* (export-manifest manifest
+                          #:optional (port (current-output-port)))
+  "Write to PORT a manifest corresponding to MANIFEST."
+  (define (version-spec entry)
+    (let ((name (manifest-entry-name entry)))
+      (match (map package-version (find-packages-by-name name))
+        ((_)
+         ;; A single version of NAME is available, so do not specify the
+         ;; version number, even if the available version doesn't match ENTRY.
+         "")
+        (versions
+         ;; If ENTRY uses the latest version, don't specify any version.
+         ;; Otherwise return the shortest unique version prefix.  Note that
+         ;; this is based on the currently available packages, which could
+         ;; differ from the packages available in the revision that was used
+         ;; to build MANIFEST.
+         (let ((current (manifest-entry-version entry)))
+           (if (every (cut version>? current <>)
+                      (delete current versions))
+               ""
+               (version-unique-prefix (manifest-entry-version entry)
+                                      versions)))))))
+
+  (match (manifest->code manifest
+                         #:entry-package-version version-spec)
+    (('begin exp ...)
+     (format port (G_ "\
+;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
+;; the content of your profile.  This is \"symbolic\": it only specifies
+;; package names.  To reproduce the exact same profile, you also need to
+;; capture the channels being used, as returned by \"guix describe\".
+;; See the \"Replicating Guix\" section in the manual.\n"))
+     (for-each (lambda (exp)
+                 (newline port)
+                 (pretty-print exp port))
+               exp))))
+
+(define (channel=? a b)
+  (and (channel-commit a) (channel-commit b)
+       (string=? (channel-commit a) (channel-commit b))))
+
+(define* (export-channels manifest
+                          #:optional (port (current-output-port)))
+  (define channels
+    (delete-duplicates
+     (append-map manifest-entry-provenance (manifest-entries manifest))
+     channel=?))
+
+  (define channel-names
+    (delete-duplicates (map channel-name channels)))
+
+  (define table
+    (fold (lambda (channel table)
+            (vhash-consq (channel-name channel) channel table))
+          vlist-null
+          channels))
+
+  (when (null? channels)
+    (leave (G_ "no provenance information for this profile~%")))
+
+  (format port (G_ "\
+;; This channel file can be passed to 'guix pull -C' or to
+;; 'guix time-machine -C' to obtain the Guix revision that was
+;; used to populate this profile.\n"))
+  (newline port)
+  (display "(list\n" port)
+  (for-each (lambda (name)
+              (define indent "     ")
+              (match (vhash-foldq* cons '() name table)
+                ((channel extra ...)
+                 (unless (null? extra)
+                   (display indent port)
+                   (format port (G_ "\
+;; Note: these other commits were also used to install \
+some of the packages in this profile:~%"))
+                   (for-each (lambda (channel)
+                               (format port "~a;;   ~s~%"
+                                       indent (channel-commit channel)))
+                             extra))
+                 (pretty-print (channel->code channel) port
+                               #:per-line-prefix indent))))
+            channel-names)
+  (display ")\n" port)
+  #t)
+
+
+;;;
 ;;; Command-line options.
 ;;;
 
@@ -374,6 +466,10 @@ Install, remove, or upgrade packages in a single transaction.\n"))
   -S, --switch-generation=PATTERN
                          switch to a generation matching PATTERN"))
   (display (G_ "
+      --export-manifest  print a manifest for the chosen profile"))
+  (display (G_ "
+      --export-channels  print channels for the chosen profile"))
+  (display (G_ "
   -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
   (display (G_ "
       --list-profiles    list the user's profiles"))
@@ -507,6 +603,14 @@ kind of search path~%")
                      (values (cons `(query search-paths ,kind)
                                    result)
                              #f))))
+         (option '("export-manifest") #f #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (cons `(query export-manifest) result)
+                           #f)))
+         (option '("export-channels") #f #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (cons `(query export-channels) result)
+                           #f)))
          (option '(#\p "profile") #t #f
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'profile (canonicalize-profile arg)
@@ -827,6 +931,18 @@ processed, #f otherwise."
          (format #t "~{~a~%~}" settings)
          #t))
 
+      (('export-manifest)
+       (let* ((manifest (concatenate-manifests
+                         (map profile-manifest profiles))))
+         (export-manifest manifest (current-output-port))
+         #t))
+
+      (('export-channels)
+       (let ((manifest (concatenate-manifests
+                        (map profile-manifest profiles))))
+         (export-channels manifest (current-output-port))
+         #t))
+
       (_ #f))))
 
 
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 5a865c838d..fa85088ed0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -56,6 +56,8 @@
   #:use-module (zlib)
   #:autoload   (lzlib) (call-with-lzip-output-port
                         make-lzip-output-port)
+  #:autoload   (zstd)  (call-with-zstd-output-port
+                        make-zstd-output-port)
   #:use-module (guix cache)
   #:use-module (guix ui)
   #:use-module (guix scripts)
@@ -588,23 +590,22 @@ requested using POOL."
   (define nar
     (nar-cache-file cache item #:compression compression))
 
+  (define (write-compressed-file call-with-compressed-output-port)
+    ;; Note: the file port gets closed along with the compressed port.
+    (call-with-compressed-output-port (open-output-file (string-append nar ".tmp"))
+      (lambda (port)
+        (write-file item port))
+      #:level (compression-level compression))
+    (rename-file (string-append nar ".tmp") nar))
+
   (mkdir-p (dirname nar))
   (match (compression-type compression)
     ('gzip
-     ;; Note: the file port gets closed along with the gzip port.
-     (call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
-       (lambda (port)
-         (write-file item port))
-       #:level (compression-level compression)
-       #:buffer-size %default-buffer-size)
-     (rename-file (string-append nar ".tmp") nar))
+     (write-compressed-file call-with-gzip-output-port))
     ('lzip
-     ;; Note: the file port gets closed along with the lzip port.
-     (call-with-lzip-output-port (open-output-file (string-append nar ".tmp"))
-       (lambda (port)
-         (write-file item port))
-       #:level (compression-level compression))
-     (rename-file (string-append nar ".tmp") nar))
+     (write-compressed-file call-with-lzip-output-port))
+    ('zstd
+     (write-compressed-file call-with-zstd-output-port))
     ('none
      ;; Cache nars even when compression is disabled so that we can
      ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
@@ -871,6 +872,9 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
     (($ <compression> 'lzip level)
      (make-lzip-output-port (response-port response)
                             #:level level))
+    (($ <compression> 'zstd level)
+     (make-zstd-output-port (response-port response)
+                            #:level level))
     (($ <compression> 'none)
      (response-port response))
     (#f
@@ -953,6 +957,7 @@ blocking."
   (match string
     ("gzip" 'gzip)
     ("lzip" 'lzip)
+    ("zstd" 'zstd)
     (_      #f)))
 
 (define (effective-compression requested-type compressions)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 83cdc1d1eb..4e0ab5d341 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -765,60 +765,61 @@ Use '~/.config/guix/channels.scm' instead."))
                                               #:argument-handler no-arguments))
             (substitutes? (assoc-ref opts 'substitutes?))
             (dry-run?     (assoc-ref opts 'dry-run?))
-            (channels     (channel-list opts))
             (profile      (or (assoc-ref opts 'profile) %current-profile))
             (current-channels (profile-channels profile))
             (validate-pull    (assoc-ref opts 'validate-pull))
             (authenticate?    (assoc-ref opts 'authenticate-channels?)))
-       (cond ((assoc-ref opts 'query)
-              (process-query opts profile))
-             ((assoc-ref opts 'generation)
-              (process-generation-change opts profile))
-             (else
-              (with-store store
-                (with-status-verbosity (assoc-ref opts 'verbosity)
-                  (parameterize ((%current-system (assoc-ref opts 'system))
-                                 (%graft? (assoc-ref opts 'graft?)))
-                    (with-build-handler (build-notifier #:use-substitutes?
-                                                        substitutes?
-                                                        #:verbosity
-                                                        (assoc-ref opts 'verbosity)
-                                                        #:dry-run? dry-run?)
-                      (set-build-options-from-command-line store opts)
-                      (ensure-default-profile)
-                      (honor-x509-certificates store)
-
-                      (let ((instances
-                             (latest-channel-instances store channels
-                                                       #:current-channels
-                                                       current-channels
-                                                       #:validate-pull
-                                                       validate-pull
-                                                       #:authenticate?
-                                                       authenticate?)))
-                        (format (current-error-port)
-                                (N_ "Building from this channel:~%"
-                                    "Building from these channels:~%"
-                                    (length instances)))
-                        (for-each (lambda (instance)
-                                    (let ((channel
-                                           (channel-instance-channel instance)))
-                                      (format (current-error-port)
-                                              "  ~10a~a\t~a~%"
-                                              (channel-name channel)
-                                              (channel-url channel)
-                                              (string-take
-                                               (channel-instance-commit instance)
-                                               7))))
-                                  instances)
-                        (parameterize ((%guile-for-build
-                                        (package-derivation
-                                         store
-                                         (if (assoc-ref opts 'bootstrap?)
-                                             %bootstrap-guile
-                                             (default-guile)))))
-                          (with-profile-lock profile
-                            (run-with-store store
-                              (build-and-install instances profile)))))))))))))))
+       (cond
+        ((assoc-ref opts 'query)
+         (process-query opts profile))
+        ((assoc-ref opts 'generation)
+         (process-generation-change opts profile))
+        (else
+         (with-store store
+           (with-status-verbosity (assoc-ref opts 'verbosity)
+             (parameterize ((%current-system (assoc-ref opts 'system))
+                            (%graft? (assoc-ref opts 'graft?)))
+               (with-build-handler (build-notifier #:use-substitutes?
+                                                   substitutes?
+                                                   #:verbosity
+                                                   (assoc-ref opts 'verbosity)
+                                                   #:dry-run? dry-run?)
+                 (set-build-options-from-command-line store opts)
+                 (ensure-default-profile)
+                 (honor-x509-certificates store)
+
+                 (let* ((channels (channel-list opts))
+                        (instances
+                         (latest-channel-instances store channels
+                                                   #:current-channels
+                                                   current-channels
+                                                   #:validate-pull
+                                                   validate-pull
+                                                   #:authenticate?
+                                                   authenticate?)))
+                   (format (current-error-port)
+                           (N_ "Building from this channel:~%"
+                               "Building from these channels:~%"
+                               (length instances)))
+                   (for-each (lambda (instance)
+                               (let ((channel
+                                      (channel-instance-channel instance)))
+                                 (format (current-error-port)
+                                         "  ~10a~a\t~a~%"
+                                         (channel-name channel)
+                                         (channel-url channel)
+                                         (string-take
+                                          (channel-instance-commit instance)
+                                          7))))
+                             instances)
+                   (parameterize ((%guile-for-build
+                                   (package-derivation
+                                    store
+                                    (if (assoc-ref opts 'bootstrap?)
+                                        %bootstrap-guile
+                                        (default-guile)))))
+                     (with-profile-lock profile
+                       (run-with-store store
+                         (build-and-install instances profile)))))))))))))))
 
 ;;; pull.scm ends here
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index e53de8c304..f9bcead045 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 (define-module (guix scripts substitute)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module (guix narinfo)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix combinators)
@@ -67,29 +69,8 @@
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (guix http-client)
-  #:export (narinfo-signature->canonical-sexp
-
-            narinfo?
-            narinfo-path
-            narinfo-uris
-            narinfo-uri-base
-            narinfo-compressions
-            narinfo-file-hashes
-            narinfo-file-sizes
-            narinfo-hash
-            narinfo-size
-            narinfo-references
-            narinfo-deriver
-            narinfo-system
-            narinfo-signature
-
-            narinfo-hash->sha256
-            narinfo-best-uri
-
-            lookup-narinfos
+  #:export (lookup-narinfos
             lookup-narinfos/diverse
-            read-narinfo
-            write-narinfo
 
             %allow-unauthenticated-substitutes?
             %error-to-file-descriptor-4?
@@ -149,10 +130,6 @@ disabled!~%"))
   ;; How often we want to remove files corresponding to expired cache entries.
   (* 7 24 3600))
 
-(define fields->alist
-  ;; The narinfo format is really just like recutils.
-  recutils->alist)
-
 (define %fetch-timeout
   ;; Number of seconds after which networking is considered "slow".
   5)
@@ -236,191 +213,6 @@ connection (typically PORT) is kept open once data has been fetched from URI."
      (leave (G_ "unsupported substitute URI scheme: ~a~%")
             (uri->string uri)))))
 
-
-(define-record-type <narinfo>
-  (%make-narinfo path uri-base uris compressions file-sizes file-hashes
-                 nar-hash nar-size references deriver system
-                 signature contents)
-  narinfo?
-  (path         narinfo-path)
-  (uri-base     narinfo-uri-base)        ;URI of the cache it originates from
-  (uris         narinfo-uris)            ;list of strings
-  (compressions narinfo-compressions)    ;list of strings
-  (file-sizes   narinfo-file-sizes)      ;list of (integers | #f)
-  (file-hashes  narinfo-file-hashes)
-  (nar-hash     narinfo-hash)
-  (nar-size     narinfo-size)
-  (references   narinfo-references)
-  (deriver      narinfo-deriver)
-  (system       narinfo-system)
-  (signature    narinfo-signature)      ; canonical sexp
-  ;; The original contents of a narinfo file.  This field is needed because we
-  ;; want to preserve the exact textual representation for verification purposes.
-  ;; See <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00340.html>
-  ;; for more information.
-  (contents     narinfo-contents))
-
-(define (narinfo-hash-algorithm+value narinfo)
-  "Return two values: the hash algorithm used by NARINFO and its value as a
-bytevector."
-  (match (string-tokenize (narinfo-hash narinfo)
-                          (char-set-complement (char-set #\:)))
-    ((algorithm base32)
-     (values (lookup-hash-algorithm (string->symbol algorithm))
-             (nix-base32-string->bytevector base32)))
-    (_
-     (raise (formatted-message
-             (G_ "invalid narinfo hash: ~s") (narinfo-hash narinfo))))))
-
-(define (narinfo-hash->sha256 hash)
-  "If the string HASH denotes a sha256 hash, return it as a bytevector.
-Otherwise return #f."
-  (and (string-prefix? "sha256:" hash)
-       (nix-base32-string->bytevector (string-drop hash 7))))
-
-(define (narinfo-signature->canonical-sexp str)
-  "Return the value of a narinfo's 'Signature' field as a canonical sexp."
-  (match (string-split str #\;)
-    ((version host-name sig)
-     (let ((maybe-number (string->number version)))
-       (cond ((not (number? maybe-number))
-              (leave (G_ "signature version must be a number: ~s~%")
-                     version))
-             ;; Currently, there are no other versions.
-             ((not (= 1 maybe-number))
-              (leave (G_ "unsupported signature version: ~a~%")
-                     maybe-number))
-             (else
-              (let ((signature (utf8->string (base64-decode sig))))
-                (catch 'gcry-error
-                  (lambda ()
-                    (string->canonical-sexp signature))
-                  (lambda (key proc err)
-                    (leave (G_ "signature is not a valid \
-s-expression: ~s~%")
-                           signature))))))))
-    (x
-     (leave (G_ "invalid format of the signature field: ~a~%") x))))
-
-(define (narinfo-maker str cache-url)
-  "Return a narinfo constructor for narinfos originating from CACHE-URL.  STR
-must contain the original contents of a narinfo file."
-  (lambda (path urls compressions file-hashes file-sizes
-                nar-hash nar-size references deriver system
-                signature)
-    "Return a new <narinfo> object."
-    (define len (length urls))
-    (%make-narinfo path cache-url
-                   ;; Handle the case where URL is a relative URL.
-                   (map (lambda (url)
-                          (or (string->uri url)
-                              (string->uri
-                               (string-append cache-url "/" url))))
-                        urls)
-                   compressions
-                   (match file-sizes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   (match file-hashes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   nar-hash
-                   (and=> nar-size string->number)
-                   (string-tokenize references)
-                   (match deriver
-                     ((or #f "") #f)
-                     (_ deriver))
-                   system
-                   (false-if-exception
-                    (and=> signature narinfo-signature->canonical-sexp))
-                   str)))
-
-(define* (read-narinfo port #:optional url
-                       #:key size)
-  "Read a narinfo from PORT.  If URL is true, it must be a string used to
-build full URIs from relative URIs found while reading PORT.  When SIZE is
-true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
-
-No authentication and authorization checks are performed here!"
-  (let ((str (utf8->string (if size
-                               (get-bytevector-n port size)
-                               (get-bytevector-all port)))))
-    (alist->record (call-with-input-string str fields->alist)
-                   (narinfo-maker str url)
-                   '("StorePath" "URL" "Compression"
-                     "FileHash" "FileSize" "NarHash" "NarSize"
-                     "References" "Deriver" "System"
-                     "Signature")
-                   '("URL" "Compression" "FileSize" "FileHash"))))
-
-(define (narinfo-sha256 narinfo)
-  "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
-'Signature' field."
-  (define %mandatory-fields
-    ;; List of fields that must be signed.  If they are not signed, the
-    ;; narinfo is considered unsigned.
-    '("StorePath" "NarHash" "References"))
-
-  (let ((contents (narinfo-contents narinfo)))
-    (match (string-contains contents "Signature:")
-      (#f #f)
-      (index
-       (let* ((above-signature (string-take contents index))
-              (signed-fields (match (call-with-input-string above-signature
-                                      fields->alist)
-                               (((fields . values) ...) fields))))
-         (and (every (cut member <> signed-fields) %mandatory-fields)
-              (sha256 (string->utf8 above-signature))))))))
-
-(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
-                         #:key verbose?)
-  "Return #t if NARINFO's signature is not valid."
-  (or (%allow-unauthenticated-substitutes?)
-      (let ((hash      (narinfo-sha256 narinfo))
-            (signature (narinfo-signature narinfo))
-            (uri       (uri->string (first (narinfo-uris narinfo)))))
-        (and hash signature
-             (signature-case (signature hash acl)
-               (valid-signature #t)
-               (invalid-signature
-                (when verbose?
-                  (format (current-error-port)
-                          "invalid signature for substitute at '~a'~%"
-                          uri))
-                #f)
-               (hash-mismatch
-                (when verbose?
-                  (format (current-error-port)
-                          "hash mismatch for substitute at '~a'~%"
-                          uri))
-                #f)
-               (unauthorized-key
-                (when verbose?
-                  (format (current-error-port)
-                          "substitute at '~a' is signed by an \
-unauthorized party~%"
-                          uri))
-                #f)
-               (corrupt-signature
-                (when verbose?
-                  (format (current-error-port)
-                          "corrupt signature for substitute at '~a'~%"
-                          uri))
-                #f))))))
-
-(define (write-narinfo narinfo port)
-  "Write NARINFO to PORT."
-  (put-bytevector port (string->utf8 (narinfo-contents narinfo))))
-
-(define (narinfo->string narinfo)
-  "Return the external representation of NARINFO."
-  (call-with-output-string (cut write-narinfo narinfo <>)))
-
-(define (string->narinfo str cache-uri)
-  "Return the narinfo represented by STR.  Assume CACHE-URI as the base URI of
-the cache STR originates form."
-  (call-with-input-string str (cut read-narinfo <> cache-uri)))
-
 (define (narinfo-cache-file cache-url path)
   "Return the name of the local file that contains an entry for PATH.  The
 entry is stored in a sub-directory specific to CACHE-URL."
@@ -742,22 +534,6 @@ information is available locally."
         (let ((missing (fetch-narinfos cache missing)))
           (append cached (or missing '()))))))
 
-(define (equivalent-narinfo? narinfo1 narinfo2)
-  "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe
-the same store item.  This ignores unnecessary metadata such as the Nar URL."
-  (and (string=? (narinfo-hash narinfo1)
-                 (narinfo-hash narinfo2))
-
-       ;; The following is not needed if all we want is to download a valid
-       ;; nar, but it's necessary if we want valid narinfo.
-       (string=? (narinfo-path narinfo1)
-                 (narinfo-path narinfo2))
-       (equal? (narinfo-references narinfo1)
-               (narinfo-references narinfo2))
-
-       (= (narinfo-size narinfo1)
-          (narinfo-size narinfo2))))
-
 (define (lookup-narinfos/diverse caches paths authorized?)
   "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order.
 That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next
@@ -918,11 +694,14 @@ expected by the daemon."
   "Reply to COMMAND, a query as written by the daemon to this process's
 standard input.  Use ACL as the access-control list against which to check
 authorized substitutes."
-  (define (valid? obj)
-    (valid-narinfo? obj acl))
+  (define valid?
+    (if (%allow-unauthenticated-substitutes?)
+        (begin
+          (warn-about-missing-authentication)
 
-  (when (%allow-unauthenticated-substitutes?)
-    (warn-about-missing-authentication))
+          (const #t))
+        (lambda (obj)
+          (valid-narinfo? obj acl))))
 
   (match (string-tokenize command)
     (("have" paths ..1)
@@ -940,59 +719,6 @@ authorized substitutes."
     (wtf
      (error "unknown `--query' command" wtf))))
 
-(define %compression-methods
-  ;; Known compression methods and a thunk to determine whether they're
-  ;; supported.  See 'decompressed-port' in (guix utils).
-  `(("gzip"  . ,(const #t))
-    ("lzip"  . ,(const #t))
-    ("xz"    . ,(const #t))
-    ("bzip2" . ,(const #t))
-    ("none"  . ,(const #t))))
-
-(define (supported-compression? compression)
-  "Return true if COMPRESSION, a string, denotes a supported compression
-method."
-  (match (assoc-ref %compression-methods compression)
-    (#f         #f)
-    (supported? (supported?))))
-
-(define (compresses-better? compression1 compression2)
-  "Return true if COMPRESSION1 generally compresses better than COMPRESSION2;
-this is a rough approximation."
-  (match compression1
-    ("none" #f)
-    ("gzip" (string=? compression2 "none"))
-    (_      (or (string=? compression2 "none")
-                (string=? compression2 "gzip")))))
-
-(define (narinfo-best-uri narinfo)
-  "Select the \"best\" URI to download NARINFO's nar, and return three values:
-the URI, its compression method (a string), and the compressed file size."
-  (define choices
-    (filter (match-lambda
-              ((uri compression file-size)
-               (supported-compression? compression)))
-            (zip (narinfo-uris narinfo)
-                 (narinfo-compressions narinfo)
-                 (narinfo-file-sizes narinfo))))
-
-  (define (file-size<? c1 c2)
-    (match c1
-      ((uri1 compression1 (? integer? file-size1))
-       (match c2
-         ((uri2 compression2 (? integer? file-size2))
-          (< file-size1 file-size2))
-         (_ #t)))
-      ((uri compression1 #f)
-       (match c2
-         ((uri2 compression2 _)
-          (compresses-better? compression1 compression2))))
-      (_ #f)))                                    ;we can't tell
-
-  (match (sort choices file-size<?)
-    (((uri compression file-size) _ ...)
-     (values uri compression file-size))))
-
 (define %max-cached-connections
   ;; Maximum number of connections kept in cache by
   ;; 'open-connection-for-uri/cached'.
@@ -1079,7 +805,9 @@ DESTINATION is in the store, deduplicate its files.  Print a status line on
 the current output port."
   (define narinfo
     (lookup-narinfo cache-urls store-item
-                    (cut valid-narinfo? <> acl)))
+                    (if (%allow-unauthenticated-substitutes?)
+                        (const #t)
+                        (cut valid-narinfo? <> acl))))
 
   (define destination-in-store?
     (string-prefix? (string-append (%store-prefix) "/")
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 51c8cf2f76..19b8c5163c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -705,9 +705,11 @@ checking this by themselves in their 'check' procedure."
                                                   image-size
                                                   (* 70 (expt 2 20)))
                                               #:mappings mappings))
-      ((disk-image)
+      ((image disk-image)
        (let* ((base-image (os->image os #:type image-type))
               (base-target (image-target base-image)))
+         (when (eq? action 'disk-image)
+           (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
          (lower-object
           (system-image
            (image
@@ -779,7 +781,7 @@ and TARGET arguments."
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
 bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
 target root directory; IMAGE-SIZE is the size of the image to be built, for
-the 'vm-image' and 'disk-image' actions.  IMAGE-TYPE is the type of image to
+the 'vm-image' and 'image' actions.  IMAGE-TYPE is the type of image to
 be built.  When VOLATILE-ROOT? is #t, the root file system is mounted
 volatile.
 
@@ -913,7 +915,8 @@ Run 'herd status' to view the list of services on your system.\n"))))))
   (let* ((services  (operating-system-services os))
          (pid1      (fold-services services
                                    #:target-type shepherd-root-service-type))
-         (shepherds (service-value pid1))         ;list of <shepherd-service>
+         ;; Get the list of <shepherd-service>.
+         (shepherds (shepherd-configuration-services (service-value pid1)))
          (sinks     (filter (lambda (service)
                               (null? (shepherd-service-requirement service)))
                             shepherds)))
@@ -968,7 +971,7 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "\
    vm-image         build a freestanding virtual machine image\n"))
   (display (G_ "\
-   disk-image       build a disk image, suitable for a USB stick\n"))
+   image            build a Guix System image\n"))
   (display (G_ "\
    docker-image     build a Docker image\n"))
   (display (G_ "\
@@ -994,15 +997,15 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --list-image-types list available image types"))
   (display (G_ "
-  -t, --image-type=TYPE  for 'disk-image', produce an image of TYPE"))
+  -t, --image-type=TYPE  for 'image', produce an image of TYPE"))
   (display (G_ "
       --image-size=SIZE  for 'vm-image', produce an image of SIZE"))
   (display (G_ "
       --no-bootloader    for 'init', do not install a bootloader"))
   (display (G_ "
-      --volatile         for 'disk-image', make the root file system volatile"))
+      --volatile         for 'image', make the root file system volatile"))
   (display (G_ "
-      --label=LABEL      for 'disk-image', label disk image with LABEL"))
+      --label=LABEL      for 'image', label disk image with LABEL"))
   (display (G_ "
       --save-provenance  save provenance information"))
   (display (G_ "
@@ -1014,7 +1017,7 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
   -N, --network          for 'container', allow containers to access the network"))
   (display (G_ "
-  -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
+  -r, --root=FILE        for 'vm', 'vm-image', 'image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
   (display (G_ "
@@ -1143,7 +1146,7 @@ Some ACTIONS support additional ARGS.\n"))
     (debug . 0)
     (verbosity . #f)                              ;default
     (validate-reconfigure . ,ensure-forward-reconfigure)
-    (image-type . raw)
+    (image-type . efi-raw)
     (image-size . guess)
     (install-bootloader? . #t)
     (label . #f)
@@ -1335,7 +1338,7 @@ argument list and OPTS is the option alist."
         (alist-cons 'argument arg result)
         (let ((action (string->symbol arg)))
           (case action
-            ((build container vm vm-image disk-image reconfigure init
+            ((build container vm vm-image image disk-image reconfigure init
               extension-graph shepherd-graph
               list-generations describe
               delete-generations roll-back
@@ -1368,7 +1371,8 @@ argument list and OPTS is the option alist."
         (exit 1))
 
       (case action
-        ((build container vm vm-image disk-image docker-image reconfigure)
+        ((build container vm vm-image image disk-image docker-image
+                reconfigure)
          (unless (or (= count 1)
                      (and expr (= count 0)))
            (fail)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 5581e12892..39a818dd0b 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -177,9 +177,10 @@ canonical names (symbols)."
 upgrade the Shepherd (PID 1) by unloading obsolete services and loading new
 services as defined by OS."
   (define target-services
-    (service-value
-     (fold-services (operating-system-services os)
-                    #:target-type shepherd-root-service-type)))
+    (shepherd-configuration-services
+     (service-value
+      (fold-services (operating-system-services os)
+                     #:target-type shepherd-root-service-type))))
 
   (mlet* %store-monad ((live-services (running-services eval)))
     (let*-values (((to-unload to-restart)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index f28070ddc4..97e4a73802 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -33,6 +33,7 @@
   #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module ((guix build utils) #:select (every*))
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (guix http-client)
   #:use-module (guix ci)
   #:use-module (guix sets)
diff --git a/guix/self.scm b/guix/self.scm
index e2e3198057..15c8ad4eb9 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -59,6 +59,7 @@
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
       ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
       ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
+      ("guile-zstd" (ref '(gnu packages guile) 'guile-zstd))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'gnutls))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
@@ -823,6 +824,9 @@ itself."
   (define guile-lzlib
     (specification->package "guile-lzlib"))
 
+  (define guile-zstd
+    (specification->package "guile-zstd"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
@@ -836,7 +840,7 @@ itself."
     (append-map transitive-package-dependencies
                 (list guile-gcrypt gnutls guile-git guile-avahi
                       guile-json guile-semver guile-ssh guile-sqlite3
-                      guile-zlib guile-lzlib)))
+                      guile-zlib guile-lzlib guile-zstd)))
 
   (define *core-modules*
     (scheme-node "guix-core"
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 59cd93fb18..9d0739f6c5 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,7 +34,7 @@
             write-bytevector write-string
             read-string read-latin1-string read-maybe-utf8-string
             write-string-list read-string-list
-            write-string-pairs
+            write-string-pairs read-string-pairs
             write-store-path read-store-path
             write-store-path-list read-store-path-list
             (dump . dump-port*)
@@ -166,6 +166,14 @@ substitute invalid byte sequences with question marks.  This is a
   (write-int (length l) p)
   (for-each (cut write-string <> p) l))
 
+(define (read-string-list p)
+  (let ((len (read-int p)))
+    (unfold (cut >= <> len)
+            (lambda (i)
+              (read-string p))
+            1+
+            0)))
+
 (define (write-string-pairs l p)
   (write-int (length l) p)
   (for-each (match-lambda
@@ -174,11 +182,11 @@ substitute invalid byte sequences with question marks.  This is a
               (write-string second p)))
             l))
 
-(define (read-string-list p)
+(define (read-string-pairs p)
   (let ((len (read-int p)))
     (unfold (cut >= <> len)
             (lambda (i)
-              (read-string p))
+              (cons (read-string p) (read-string p)))
             1+
             0)))
 
diff --git a/guix/store.scm b/guix/store.scm
index 4da39971b5..e0b15abce3 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
@@ -114,6 +114,7 @@
             query-failed-paths
             clear-failed-paths
             ensure-path
+            find-roots
             add-temp-root
             add-indirect-root
             add-permanent-root
@@ -340,7 +341,8 @@
      (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path store-path-list string-list
+  (syntax-rules (integer boolean string store-path
+                 store-path-list string-list string-pairs
                  substitutable-path-list path-info base16)
     ((_ integer p)
      (read-int p))
@@ -354,6 +356,8 @@
      (read-store-path-list p))
     ((_ string-list p)
      (read-string-list p))
+    ((_ string-pairs p)
+     (read-string-pairs p))
     ((_ substitutable-path-list p)
      (read-substitutable-path-list p))
     ((_ path-info p)
@@ -1404,6 +1408,15 @@ running a substitute.  As a GC root is not created by the daemon, you may want
 to call ADD-TEMP-ROOT on that store path."
   boolean)
 
+(define-operation (find-roots)
+  "Return a list of root/target pairs: for each pair, the first element is the
+GC root file name and the second element is its target in the store.
+
+When talking to a local daemon, this operation is equivalent to the 'gc-roots'
+procedure in (guix store roots), except that the 'find-roots' excludes
+potential roots that do not point to store items."
+  string-pairs)
+
 (define-operation (add-temp-root (store-path path))
   "Make PATH a temporary root for the duration of the current session.
 Return #t."
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 0a84bbddb9..8d08def833 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
-;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -53,20 +53,6 @@
   ;; Name of the file containing the SQL scheme or #f.
   (make-parameter #f))
 
-(define sqlite-exec
-  ;; XXX: This is was missing from guile-sqlite3 until
-  ;; <https://notabug.org/guile-sqlite3/guile-sqlite3/commit/b87302f9bcd18a286fed57b2ea521845eb1131d7>.
-  (let ((exec (pointer->procedure
-               int
-               (dynamic-func "sqlite3_exec" (@@ (sqlite3) libsqlite3))
-               '(* * * * *))))
-    (lambda (db text)
-      (let ((ret (exec ((@@ (sqlite3) db-pointer) db)
-                       (string->pointer text)
-                       %null-pointer %null-pointer %null-pointer)))
-        (unless (zero? ret)
-          ((@@ (sqlite3) sqlite-error) db "sqlite-exec" ret))))))
-
 (define* (store-database-directory #:key prefix state-directory)
   "Return the store database directory, taking PREFIX and STATE-DIRECTORY into
 account when provided."
@@ -126,7 +112,7 @@ set journal_mode=WAL."
                   (lambda ()
                     (sqlite-close db)))))
 
-;; XXX: missing in guile-sqlite3@0.1.0
+;; XXX: missing in guile-sqlite3@0.1.2
 (define SQLITE_BUSY 5)
 
 (define (call-with-SQLITE_BUSY-retrying thunk)
@@ -139,8 +125,6 @@ errors."
           (call-with-SQLITE_BUSY-retrying thunk)
           (throw key who code errmsg)))))
 
-
-
 (define* (call-with-transaction db proc #:key restartable?)
   "Start a transaction with DB and run PROC.  If PROC exits abnormally, abort
 the transaction, otherwise commit the transaction after it finishes.
@@ -214,17 +198,6 @@ If FILE doesn't exist, create it and initialize it as a new database.  Pass
     ((_ file db exp ...)
      (call-with-database file (lambda (db) exp ...)))))
 
-(define (sqlite-finalize stmt)
-  ;; As of guile-sqlite3 0.1.0, cached statements aren't reset when
-  ;; sqlite-finalize is invoked on them (see
-  ;; https://notabug.org/guile-sqlite3/guile-sqlite3/issues/12).  This can
-  ;; cause problems with automatically-started transactions, so we work around
-  ;; it by wrapping sqlite-finalize so that sqlite-reset is always called.
-  ;; This always works, because resetting a statement twice has no adverse
-  ;; effects.  We can remove this once the fixed guile-sqlite3 is widespread.
-  (sqlite-reset stmt)
-  ((@ (sqlite3) sqlite-finalize) stmt))
-
 (define (call-with-statement db sql proc)
   (let ((stmt (sqlite-prepare db sql #:cache? #t)))
     (dynamic-wind
@@ -268,12 +241,26 @@ identifier.  Otherwise, return #f."
   "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize)
 VALUES (:path, :hash, :time, :deriver, :size)")
 
+(define-inlinable (assert-integer proc in-range? key number)
+  (unless (integer? number)
+    (throw 'wrong-type-arg proc
+           "Wrong type argument ~A: ~S" (list key number)
+           (list number)))
+  (unless (in-range? number)
+    (throw 'out-of-range proc
+           "Integer ~A out of range: ~S" (list key number)
+           (list number))))
+
 (define* (update-or-insert db #:key path deriver hash nar-size time)
   "The classic update-if-exists and insert-if-doesn't feature that sqlite
 doesn't exactly have... they've got something close, but it involves deleting
 and re-inserting instead of updating, which causes problems with foreign keys,
 of course. Returns the row id of the row that was modified or inserted."
 
+  ;; Make sure NAR-SIZE is valid.
+  (assert-integer "update-or-insert" positive? #:nar-size nar-size)
+  (assert-integer "update-or-insert" (cut >= <> 0) #:time time)
+
   ;; It's important that querying the path-id and the insert/update operation
   ;; take place in the same transaction, as otherwise some other
   ;; process/thread/fiber could register the same path between when we check
diff --git a/guix/swh.scm b/guix/swh.scm
index 0b765cc743..f11b7ea2d5 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -348,6 +348,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   (checksums     directory-entry-checksums "checksums"
                  (match-lambda
                    (#f  #f)
+                   ((? unspecified?) #f)
                    (lst (json->checksums lst))))
   (id            directory-entry-id "dir_id")
   (length        directory-entry-length)
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 2385d3231e..4e9260350c 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,9 @@
   #:autoload   (guix download) (download-to-store)
   #:autoload   (guix git-download) (git-reference? git-reference-url)
   #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
+  #:autoload   (guix upstream) (package-latest-release*
+                                upstream-source-version
+                                upstream-source-signature-urls)
   #:use-module (guix utils)
   #:use-module (guix memoization)
   #:use-module (guix gexp)
@@ -511,6 +514,42 @@ additional patches."
         (rewrite obj)
         obj)))
 
+(define (transform-package-latest specs)
+  "Return a procedure that rewrites package graphs such that those in SPECS
+are replaced by their latest upstream version."
+  (define (package-with-latest-upstream p)
+    (let ((source (package-latest-release* p)))
+      (cond ((not source)
+             (warning
+              (G_ "could not determine latest upstream release of '~a'~%")
+              (package-name p))
+             p)
+            ((string=? (upstream-source-version source)
+                       (package-version p))
+             p)
+            (else
+             (unless (pair? (upstream-source-signature-urls source))
+               (warning (G_ "cannot authenticate source of '~a', version ~a~%")
+                        (package-name p)
+                        (upstream-source-version source)))
+
+             ;; TODO: Take 'upstream-source-input-changes' into account.
+             (package
+               (inherit p)
+               (version (upstream-source-version source))
+               (source source))))))
+
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (lambda (spec)
+            (cons spec package-with-latest-upstream))
+          specs)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
@@ -525,7 +564,8 @@ additional patches."
     (with-c-toolchain . ,transform-package-toolchain)
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
-    (with-patch  . ,transform-package-patches)))
+    (with-patch  . ,transform-package-patches)
+    (with-latest . ,transform-package-latest)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -567,6 +607,8 @@ additional patches."
                   (parser 'without-tests))
           (option '("with-patch") #t #f
                   (parser 'with-patch))
+          (option '("with-latest") #t #f
+                  (parser 'with-latest))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -599,6 +641,9 @@ additional patches."
       --with-patch=PACKAGE=FILE
                          add FILE to the list of patches of PACKAGE"))
   (display (G_ "
+      --with-latest=PACKAGE
+                         use the latest upstream release of PACKAGE"))
+  (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
   (display (G_ "
diff --git a/guix/ui.scm b/guix/ui.scm
index bd504c68da..45ae14f83c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2124,24 +2124,20 @@ Run COMMAND with ARGS.\n"))
   "Run COMMAND with the given ARGS.  Report an error when COMMAND is not
 found."
   (define module
-    (catch 'misc-error
-      (lambda ()
-        (resolve-interface `(guix scripts ,command)))
-      (lambda _
-        ;; Check if there is a matching extension.
-        (catch 'misc-error
-          (lambda ()
-            (match (search-path (extension-directories)
-                                (format #f "~a.scm" command))
-              (#f
-               (throw 'misc-error))
-              (file
-                (load file)
-                (resolve-interface `(guix extensions ,command)))))
-          (lambda _
-            (format (current-error-port)
-                    (G_ "guix: ~a: command not found~%") command)
-            (show-guix-usage))))))
+    ;; Check if there is a matching extension.
+    (match (search-path (extension-directories)
+                        (format #f "~a.scm" command))
+      (#f
+       (catch 'misc-error
+         (lambda ()
+           (resolve-interface `(guix scripts ,command)))
+         (lambda _
+           (format (current-error-port)
+                   (G_ "guix: ~a: command not found~%") command)
+           (show-guix-usage))))
+      (file
+       (load file)
+       (resolve-interface `(guix extensions ,command)))))
 
   (let ((command-main (module-ref module
                                   (symbol-append 'guix- command))))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index a8ed1d81cd..accd8967d8 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -31,8 +31,8 @@
   #:use-module (guix base32)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module ((guix derivations)
-                #:select (built-derivations derivation->output-path))
+  #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
+  #:autoload   (gcrypt hash) (port-sha256)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -248,6 +248,9 @@ correspond to the same version."
                                        '()
                                        (importer-modules))))
 
+;; Tests need to mock this variable so mark it as "non-declarative".
+(set! %updaters %updaters)
+
 (define* (lookup-updater package
                          #:optional (updaters (force %updaters)))
   "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
@@ -351,6 +354,27 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE from its first URL and lower it as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
+                       (signature
+                        -> (and=> (upstream-source-signature-urls source)
+                                  first))
+                       (tarball ((store-lift download-tarball) url signature)))
+    (unless tarball
+      (raise (formatted-message (G_ "failed to fetch source from '~a'")
+                                url)))
+
+    ;; Instead of returning TARBALL, return a fixed-output derivation that
+    ;; would be able to re-download it.  In practice, since TARBALL is already
+    ;; in the store, no extra download will happen, but having the derivation
+    ;; in store improves provenance tracking.
+    (let ((hash (call-with-input-file tarball port-sha256)))
+      (url-fetch url 'sha256 hash (store-path-package-name tarball)
+                 #:system system))))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
diff --git a/guix/utils.scm b/guix/utils.scm
index 678954dbfa..edc3503c10 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@@ -93,6 +93,7 @@
             version-major+minor+point
             version-major+minor
             version-major
+            version-unique-prefix
             guile-version>?
             version-prefix?
             string-replace-substring
@@ -114,7 +115,6 @@
             edit-expression
 
             filtered-port
-            compressed-port
             decompressed-port
             call-with-decompressed-port
             compressed-output-port
@@ -215,7 +215,13 @@ buffered data is lost."
   "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
 Raise an error if lzlib support is missing."
   (let ((make-port (module-ref (resolve-interface '(lzlib)) proc)))
-    (values (make-port port) '())))
+    (make-port port)))
+
+(define (zstd-port proc port . args)
+  "Return the zstd port produced by calling PROC (a symbol) on PORT and ARGS.
+Raise an error if zstd support is missing."
+  (let ((make-port (module-ref (resolve-interface '(zstd)) proc)))
+    (make-port port)))
 
 (define (decompressed-port compression input)
   "Return an input port where INPUT is decompressed according to COMPRESSION,
@@ -227,6 +233,8 @@ a symbol such as 'xz."
     ('gzip         (filtered-port `(,%gzip "-dc") input))
     ('lzip         (values (lzip-port 'make-lzip-input-port input)
                            '()))
+    ('zstd         (values (zstd-port 'make-zstd-input-port input)
+                           '()))
     (_             (error "unsupported compression scheme" compression))))
 
 (define (compressed-port compression input)
@@ -299,6 +307,8 @@ program--e.g., '(\"--fast\")."
     ('gzip         (filtered-output-port `(,%gzip "-c" ,@options) output))
     ('lzip         (values (lzip-port 'make-lzip-output-port output)
                            '()))
+    ('zstd         (values (zstd-port 'make-zstd-output-port output)
+                           '()))
     (_             (error "unsupported compression scheme" compression))))
 
 (define* (call-with-compressed-output-port compression port proc
@@ -597,6 +607,38 @@ minor version numbers from version-string."
   "Return the major version number as string from the version-string."
   (version-prefix version-string 1))
 
+(define (version-unique-prefix version versions)
+  "Return the shortest version prefix to unambiguously identify VERSION among
+VERSIONS.  For example:
+
+  (version-unique-prefix \"2.0\" '(\"3.0\" \"2.0\"))
+  => \"2\"
+
+  (version-unique-prefix \"2.2\" '(\"3.0.5\" \"2.0.9\" \"2.2.7\"))
+  => \"2.2\"
+
+  (version-unique-prefix \"27.1\" '(\"27.1\"))
+  => \"\"
+"
+  (define not-dot
+    (char-set-complement (char-set #\.)))
+
+  (define other-versions
+    (delete version versions))
+
+  (let loop ((prefix     '())
+             (components (string-tokenize version not-dot)))
+    (define prefix-str
+      (string-join prefix "."))
+
+    (if (any (cut string-prefix? prefix-str <>) other-versions)
+        (match components
+          ((head . tail)
+           (loop `(,@prefix ,head) tail))
+          (()
+           version))
+        prefix-str)))
+
 (define (version>? a b)
   "Return #t when A denotes a version strictly newer than B."
   (eq? '> (version-compare a b)))