Merge branch 'master' into core-updates

12 files changed, 248 insertions, 407 deletions

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)