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

30 files changed, 1750 insertions, 192 deletions

diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 7bafee5a7a..0eab919deb 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -158,6 +159,7 @@
                              (phases '%standard-phases)
                              (outputs '("out"))
                              (make-flags ''())
+                             (parallel-build? #t)
                              (system (%current-system))
                              (source-directory ".")
                              (guile #f)
@@ -184,6 +186,7 @@
                               #:tests? #$tests?
                               #:outputs #$(outputs->gexp outputs)
                               #:make-flags #$make-flags
+                              #:parallel-build? #$parallel-build?
                               #:inputs #$(input-tuples->gexp inputs)))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
@@ -201,6 +204,7 @@
           (guile #f)
           (outputs '("out"))
           (make-flags ''())
+          (parallel-build? #t)
           (search-paths '())
           (native-search-paths '())
           (tests? #f)
diff --git a/guix/build-system/renpy.scm b/guix/build-system/renpy.scm
index 0ee73ec969..f1070951ee 100644
--- a/guix/build-system/renpy.scm
+++ b/guix/build-system/renpy.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/guix/build/download.scm b/guix/build/download.scm
index c8ddadfdd4..fd8fe69901 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -674,10 +674,23 @@ and write the output to FILE."
      (match (fetch-specification uris)
        (#f (format #t "could not find its Disarchive specification~%")
            #f)
-       (spec (parameterize ((%disarchive-log-port (current-output-port)))
+       (spec (parameterize ((%disarchive-log-port (current-output-port))
+                            (%verify-swh-certificate? verify-certificate?))
                (false-if-exception*
                 (disarchive-assemble spec file #:resolver resolve))))))))
 
+(define (internet-archive-uri uri)
+  "Return a URI corresponding to an Internet Archive backup of URI, or #f if
+URI does not denote a Web URI."
+  (and (memq (uri-scheme uri) '(http https))
+       (let* ((now  (time-utc->date (current-time time-utc)))
+              (date (date->string now "~Y~m~d~H~M~S")))
+         ;; Note: the date in the URL can be anything and web.archive.org
+         ;; automatically redirects to the closest date.
+         (build-uri 'https #:host "web.archive.org"
+                    #:path (string-append "/web/" date "/"
+                                          (uri->string uri))))))
+
 (define* (url-fetch url file
                     #:key
                     (timeout 10) (verify-certificate? #t)
@@ -769,7 +782,12 @@ otherwise simply ignore them."
 
   (setvbuf (current-error-port) 'line)
 
-  (let try ((uri (append uri content-addressed-uris)))
+  (let try ((uri (append uri content-addressed-uris
+                   (match uri
+                     ((first . _)
+                      (or (and=> (internet-archive-uri first) list)
+                          '()))
+                     (() '())))))
     (match uri
       ((uri tail ...)
        (or (fetch uri file)
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 5f7ba71244..64ef40e25a 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2014, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2018, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2019 Leo Prikler <leo.prikler@student.tugraz.at>
+;;; Copyright © 2019 Liliana Marie Prikler <liliana.prikler@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm
index 28253ce2f0..ef6cb316ee 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
 ;;; Copyright © 2018, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
+;;; Copyright © 2021 John Kehayias <john.kehayias@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -63,13 +64,14 @@
                      ((file-exists? "Setup.lhs")
                       "Setup.lhs")
                      (else
-                      #f))))
+                      #f)))
+        (pkgdb (string-append "-package-db=" %tmp-db-dir)))
     (if setup-file
         (begin
           (format #t "running \"runhaskell Setup.hs\" with command ~s \
 and parameters ~s~%"
                   command params)
-          (apply invoke "runhaskell" setup-file command params))
+          (apply invoke "runhaskell" pkgdb setup-file command params))
         (error "no Setup.hs nor Setup.lhs found"))))
 
 (define* (configure #:key outputs inputs tests? (configure-flags '())
@@ -141,17 +143,6 @@ and parameters ~s~%"
                 (find-files lib "\\.a$"))))
   #t)
 
-(define (grep rx port)
-  "Given a regular-expression RX including a group, read from PORT until the
-first match and return the content of the group."
-  (let ((line (read-line port)))
-    (if (eof-object? line)
-        #f
-        (let ((rx-result (regexp-exec rx line)))
-          (if rx-result
-              (match:substring rx-result 1)
-              (grep rx port))))))
-
 (define* (setup-compiler #:key system inputs outputs #:allow-other-keys)
   "Setup the compiler environment."
   (let* ((haskell (assoc-ref inputs "haskell"))
@@ -173,15 +164,8 @@ first match and return the content of the group."
   "Generate the GHC package database."
   (let* ((haskell  (assoc-ref inputs "haskell"))
          (name-version (strip-store-file-name haskell))
-         (input-dirs (match inputs
-                       (((_ . dir) ...)
-                        dir)
-                       (_ '())))
          ;; Silence 'find-files' (see 'evaluate-search-paths')
-         (conf-dirs (with-null-error-port
-                     (search-path-as-list
-                      `(,(string-append "lib/" name-version))
-                      input-dirs #:pattern ".*\\.conf.d$")))
+         (conf-dirs (search-path-as-string->list (getenv "GHC_PACKAGE_PATH")))
          (conf-files (append-map (cut find-files <> "\\.conf$") conf-dirs)))
     (mkdir-p %tmp-db-dir)
     (for-each (lambda (file)
@@ -233,6 +217,8 @@ given Haskell package."
          (if (not (vhash-assoc id seen))
              (let ((dep-conf  (string-append src  "/" id ".conf"))
                    (dep-conf* (string-append dest "/" id ".conf")))
+               (when (not (file-exists? dep-conf))
+                   (error (format #f "File ~a does not exist. This usually means the dependency ~a is missing. Was checking conf-file ~a." dep-conf id conf-file)))
                (copy-file dep-conf dep-conf*) ;XXX: maybe symlink instead?
                (loop (vhash-cons id #t seen)
                      (append lst (conf-depends dep-conf))))
@@ -241,12 +227,13 @@ given Haskell package."
   (let* ((out (assoc-ref outputs "out"))
          (doc (assoc-ref outputs "doc"))
          (haskell  (assoc-ref inputs "haskell"))
-         (name-verion (strip-store-file-name haskell))
+         (name-version (strip-store-file-name haskell))
+         (version (last (string-split name-version #\-)))
          (lib (string-append (or (assoc-ref outputs "lib") out) "/lib"))
          (config-dir (string-append lib
-                                    "/" name-verion
+                                    "/ghc-" version
                                     "/" name ".conf.d"))
-         (id-rx (make-regexp "^id: *(.*)$"))
+         (id-rx (make-regexp "^id:[ \n\t]+([^ \t\n]+)$" regexp/newline))
          (config-file (string-append out "/" name ".conf"))
          (params
           (list (string-append "--gen-pkg-config=" config-file))))
@@ -254,8 +241,15 @@ given Haskell package."
     ;; The conf file is created only when there is a library to register.
     (when (file-exists? config-file)
       (mkdir-p config-dir)
-      (let ((config-file-name+id
-             (call-with-ascii-input-file config-file (cut grep id-rx <>))))
+      (let* ((contents (call-with-input-file config-file read-string))
+             (config-file-name+id (match:substring (first (list-matches id-rx contents)) 1)))
+
+        (when (or
+                (and
+                  (string? config-file-name+id)
+                  (string-null? config-file-name+id))
+                (not config-file-name+id))
+          (error (format #f "The package id for ~a is empty. This is a bug." config-file)))
 
         ;; Remove reference to "doc" output from "lib" (or "out") by rewriting the
         ;; "haddock-interfaces" field and removing the optional "haddock-html"
diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm
index 729ab6154f..18ccf7cd8b 100644
--- a/guix/build/linux-module-build-system.scm
+++ b/guix/build/linux-module-build-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +34,7 @@
 ;;
 ;; Code:
 
-;; Copied from make-linux-libre's "configure" phase.
+;; Similar to make-linux-libre's "configure" phase.
 (define* (configure #:key inputs target arch #:allow-other-keys)
   (setenv "KCONFIG_NOTIMESTAMP" "1")
   (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
@@ -42,23 +43,28 @@
   (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
 
   (when target
+    ;; TODO? (setenv "EXTRA_VERSION" ,extra-version)
+    ;; TODO? kernel ".config".
     (setenv "CROSS_COMPILE" (string-append target "-"))
     (format #t "`CROSS_COMPILE' set to `~a'~%"
-               (getenv "CROSS_COMPILE")))
-  ; TODO: (setenv "EXTRA_VERSION" ,extra-version)
-  ; TODO: kernel ".config".
-  #t)
+            (getenv "CROSS_COMPILE"))))
 
-(define* (build #:key inputs make-flags (source-directory ".") #:allow-other-keys)
+(define* (build #:key (make-flags '()) (parallel-build? #t)
+                (source-directory ".")
+                inputs
+                #:allow-other-keys)
   (apply invoke "make" "-C"
          (string-append (assoc-ref inputs "linux-module-builder")
                         "/lib/modules/build")
-         (string-append "M=" (getcwd) "/" source-directory)
-         (or make-flags '())))
+         (string-append "M=" (canonicalize-path source-directory))
+         `(,@(if parallel-build?
+                 `("-j" ,(number->string (parallel-job-count)))
+                 '())
+           ,@make-flags)))
 
-;; This block was copied from make-linux-libre--only took the "modules_install"
-;; part.
-(define* (install #:key make-flags (source-directory ".")
+;; Similar to the "modules_install" part of make-linux-libre.
+(define* (install #:key (make-flags '()) (parallel-build? #t)
+                  (source-directory ".")
                   inputs native-inputs outputs
                   #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
@@ -68,7 +74,7 @@
     (apply invoke "make" "-C"
             (string-append (assoc-ref inputs "linux-module-builder")
                            "/lib/modules/build")
-            (string-append "M=" (getcwd) "/" source-directory)
+            (string-append "M=" (canonicalize-path source-directory))
             ;; Disable depmod because the Guix system's module directory
             ;; is an union of potentially multiple packages.  It is not
             ;; possible to use depmod to usefully calculate a dependency
@@ -79,7 +85,10 @@
             (string-append "INSTALL_MOD_PATH=" out)
             "INSTALL_MOD_STRIP=1"
             "modules_install"
-            (or make-flags '()))))
+         `(,@(if parallel-build?
+                 `("-j" ,(number->string (parallel-job-count)))
+                 '())
+           ,@make-flags))))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
diff --git a/guix/build/renpy-build-system.scm b/guix/build/renpy-build-system.scm
index 66683971c5..e4a88456be 100644
--- a/guix/build/renpy-build-system.scm
+++ b/guix/build/renpy-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at>
+;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index ac1b0c2eea..99a3b45004 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,6 +57,9 @@
 
             restart-on-EINTR
 
+            device-number
+            device-number->major+minor
+
             mount?
             mount-device-number
             mount-source
@@ -450,6 +454,29 @@ the returned procedure is called."
 
 
 ;;;
+;;; Block devices.
+;;;
+
+;; Convert between major:minor pairs and packed ‘device number’ representation.
+;; XXX These aren't syscalls, but if you squint very hard they are part of the
+;; FFI or however you want to justify me not finding a better fit… :-)
+(define (device-number major minor)     ; see glibc's <sys/sysmacros.h>
+  "Return the device number for the device with MAJOR and MINOR, for use as
+the last argument of `mknod'."
+  (logior (ash (logand #x00000fff major) 8)
+          (ash (logand #xfffff000 major) 32)
+               (logand #x000000ff minor)
+          (ash (logand #xffffff00 minor) 12)))
+
+(define (device-number->major+minor device)     ; see glibc's <sys/sysmacros.h>
+  "Return two values: the major and minor device numbers that make up DEVICE."
+  (values (logior (ash (logand #x00000000000fff00 device) -8)
+                  (ash (logand #xfffff00000000000 device) -32))
+          (logior      (logand #x00000000000000ff device)
+                  (ash (logand #x00000ffffff00000 device) -12))))
+
+
+;;;
 ;;; File systems.
 ;;;
 
@@ -628,7 +655,7 @@ current process."
   (define (string->device-number str)
     (match (string-split str #\:)
       (((= string->number major) (= string->number minor))
-       (+ (* major 256) minor))))
+       (device-number major minor))))
 
   (call-with-input-file "/proc/self/mountinfo"
     (lambda (port)
diff --git a/guix/channels.scm b/guix/channels.scm
index 476d62e1f4..e4e0428eb5 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1089,8 +1089,13 @@ cannot be found."
   (if (channel-news-entry-commit entry)
       entry
       (let* ((tag       (channel-news-entry-tag entry))
-             (reference (string-append "refs/tags/" tag))
-             (oid       (reference-name->oid repository reference)))
+             (reference (reference-lookup repository
+                                          (string-append "refs/tags/" tag)))
+             (target    (reference-target reference))
+             (oid       (let ((obj (object-lookup repository target)))
+                          (if (= OBJ-TAG (object-type obj)) ;annotated tag?
+                              (tag-target-id (tag-lookup repository target))
+                              target))))
         (channel-news-entry (oid->string oid) tag
                             (channel-news-entry-title entry)
                             (channel-news-entry-body entry)))))
diff --git a/guix/cpio.scm b/guix/cpio.scm
index 8038a11f3c..d4a7d5f1e0 100644
--- a/guix/cpio.scm
+++ b/guix/cpio.scm
@@ -18,6 +18,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix cpio)
+  #:use-module ((guix build syscalls) #:select (device-number
+                                                device-number->major+minor))
   #:use-module ((guix build utils) #:select (dump-port))
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
@@ -129,8 +131,8 @@
                            (nlink 1) (mtime 0) (size 0)
                            (dev 0) (rdev 0) (name-size 0))
   "Return a new cpio file header."
-  (let-values (((major minor)   (device->major+minor dev))
-               ((rmajor rminor) (device->major+minor rdev)))
+  (let-values (((major minor)   (device-number->major+minor dev))
+               ((rmajor rminor) (device-number->major+minor rdev)))
     (%make-cpio-header MAGIC
                        inode mode uid gid
                        nlink mtime
@@ -154,21 +156,6 @@ denotes, similar to 'stat:type'."
           (else
            (error "unsupported file type" mode)))))
 
-(define (device-number major minor)     ; see glibc's <sys/sysmacros.h>
-  "Return the device number for the device with MAJOR and MINOR, for use as
-the last argument of `mknod'."
-  (logior (ash (logand #x00000fff major) 8)
-          (ash (logand #xfffff000 major) 32)
-               (logand #x000000ff minor)
-          (ash (logand #xffffff00 minor) 12)))
-
-(define (device->major+minor device)     ; see glibc's <sys/sysmacros.h>
-  "Return two values: the major and minor device numbers that make up DEVICE."
-  (values (logior (ash (logand #x00000000000fff00 device) -8)
-                  (ash (logand #xfffff00000000000 device) -32))
-          (logior      (logand #x00000000000000ff device)
-                  (ash (logand #x00000ffffff00000 device) -12))))
-
 (define* (file->cpio-header file #:optional (file-name file)
                             #:key (stat lstat))
   "Return a cpio header corresponding to the info returned by STAT for FILE,
diff --git a/guix/discovery.scm b/guix/discovery.scm
index b84b9ff370..81d4ca600f 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -107,19 +107,25 @@ name and the exception key and arguments."
   (define prefix-len
     (string-length directory))
 
-  (filter-map (lambda (file)
-                (let* ((relative (string-drop file prefix-len))
-                       (module   (file-name->module-name relative)))
-                  (catch #t
-                    (lambda ()
-                      (resolve-interface module))
-                    (lambda args
-                      ;; Report the error, but keep going.
-                      (warn file module args)
-                      #f))))
-              (scheme-files (if sub-directory
-                                (string-append directory "/" sub-directory)
-                                directory))))
+  ;; Hide Guile warnings such as "source file [...] newer than compiled" when
+  ;; loading user code, unless we're hacking on Guix proper.  See
+  ;; <https://issues.guix.gnu.org/43747>.
+  (parameterize ((current-warning-port (if (getenv "GUIX_UNINSTALLED")
+                                           (current-warning-port)
+                                           (%make-void-port "w"))))
+    (filter-map (lambda (file)
+                  (let* ((relative (string-drop file prefix-len))
+                         (module   (file-name->module-name relative)))
+                    (catch #t
+                      (lambda ()
+                        (resolve-interface module))
+                      (lambda args
+                        ;; Report the error, but keep going.
+                        (warn file module args)
+                        #f))))
+                (scheme-files (if sub-directory
+                                  (string-append directory "/" sub-directory)
+                                  directory)))))
 
 (define* (scheme-modules* directory #:optional sub-directory)
   "Return the list of module names found under SUB-DIRECTORY in DIRECTORY.
diff --git a/guix/extracting-download.scm b/guix/extracting-download.scm
new file mode 100644
index 0000000000..4b7dcc7e83
--- /dev/null
+++ b/guix/extracting-download.scm
@@ -0,0 +1,179 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.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 extracting-download)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module ((guix build download) #:prefix build:)
+  #:use-module ((guix build utils) #:hide (delete))
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix packages) ;; for %current-system
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-26)
+  #:export (http-fetch/extract
+            download-to-store/extract))
+
+;;;
+;;; Produce fixed-output derivations with data extracted from n archive
+;;; fetched over HTTP or FTP.
+;;;
+;;; This is meant to be used for package repositories where the actual source
+;;; archive is packed into another archive, eventually carrying meta-data.
+;;; Using this derivation saves both storing the outer archive and extracting
+;;; the actual one at build time.  The hash is calculated on the actual
+;;; archive to ease validating the stored file.
+;;;
+
+(define* (http-fetch/extract url filename-to-extract hash-algo hash
+                    #:optional name
+                    #:key (system (%current-system)) (guile (default-guile)))
+  "Return a fixed-output derivation that fetches an archive at URL, and
+extracts FILE_TO_EXTRACT from the archive.  The FILE_TO_EXTRACT is expected to
+have hash HASH of type HASH-ALGO (a symbol).  By default, the file name is the
+base name of URL; optionally, NAME can specify a different file name."
+  (define file-name
+    (match url
+      ((head _ ...)
+       (basename head))
+      (_
+       (basename url))))
+
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+
+  (define guile-json
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
+
+  (define gnutls
+    (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
+
+  (define inputs
+    `(("tar" ,(module-ref (resolve-interface '(gnu packages base))
+                          'tar))))
+
+  (define config.scm
+    (scheme-file "config.scm"
+                 #~(begin
+                     (define-module (guix config)
+                       #:export (%system))
+
+                     (define %system
+                       #$(%current-system)))))
+
+  (define modules
+    (cons `((guix config) => ,config.scm)
+          (delete '(guix config)
+                  (source-module-closure '((guix build download)
+                                           (guix build utils)
+                                           (guix utils)
+                                           (web uri))))))
+
+  (define build
+    (with-imported-modules modules
+      (with-extensions (list guile-json gnutls ;for (guix swh)
+                             guile-zlib)
+        #~(begin
+            (use-modules (guix build download)
+                         (guix build utils)
+                         (guix utils)
+                         (web uri)
+                         (ice-9 match)
+                         (ice-9 popen))
+            ;; The code below expects tar to be in $PATH.
+            (set-path-environment-variable "PATH" '("bin")
+                                           (match '#+inputs
+                                             (((names dirs outputs ...) ...)
+                                              dirs)))
+
+            (setvbuf (current-output-port) 'line)
+            (setvbuf (current-error-port) 'line)
+
+            (call-with-temporary-directory
+             (lambda (directory)
+               ;; TODO: Support different archive types, based on content-type
+               ;; or archive name extention.
+               (let* ((file-to-extract (getenv "extract filename"))
+                      (port (http-fetch (string->uri (getenv "download url"))
+                                        #:verify-certificate? #f))
+                      (tar (open-pipe* OPEN_WRITE "tar" "-C" directory
+                                       "-xf" "-" file-to-extract)))
+                 (dump-port port tar)
+                 (close-port port)
+                 (let ((status (close-pipe tar)))
+                   (unless (zero? status)
+                     (error "tar extraction failure" status)))
+                 (copy-file (string-append directory "/"
+                                           (getenv "extract filename"))
+                            #$output))))))))
+
+  (mlet %store-monad ((guile (package->derivation guile system)))
+    (gexp->derivation (or name file-name) build
+
+                      ;; Use environment variables and a fixed script name so
+                      ;; there's only one script in store for all the
+                      ;; downloads.
+                      #:script-name "extract-download"
+                      #:env-vars
+                      `(("download url" . ,url)
+                        ("extract filename" . ,filename-to-extract))
+                      #:leaked-env-vars '("http_proxy" "https_proxy"
+                                          "LC_ALL" "LC_MESSAGES" "LANG"
+                                          "COLUMNS")
+                      #:system system
+                      #:local-build? #t           ; don't offload download
+                      #:hash-algo hash-algo
+                      #:hash hash
+                      #:guile-for-build guile)))
+
+
+(define* (download-to-store/extract store url filename-to-extract
+                                    #:optional (name (basename url))
+                                    #:key (log (current-error-port))
+                                    (verify-certificate? #t))
+  "Download an archive from URL, and extracts FILE_TO_EXTRACT from the archive
+to STORE, either under NAME or URL's basename if omitted.  Write progress
+reports to LOG.  VERIFY-CERTIFICATE? determines whether or not to validate
+HTTPS server certificates."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((result
+            (parameterize ((current-output-port log))
+              (build:url-fetch url temp
+                               ;;#:mirrors %mirrors
+                               #:verify-certificate?
+                               verify-certificate?))))
+       (close port)
+       (and result
+            (call-with-temporary-output-file
+             (lambda (contents port)
+               (let ((tar (open-pipe* OPEN_READ
+                                      "tar"  ;"--auto-compress"
+                                      "-xf" temp "--to-stdout" filename-to-extract)))
+                 (dump-port tar port)
+                 (close-port port)
+                 (let ((status (close-pipe tar)))
+                   (unless (zero? status)
+                     (error "tar extraction failure" status)))
+                 (add-to-store store name #f "sha256" contents)))))))))
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..dc2ca1be84 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -34,8 +34,9 @@
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix sets)
-  #:use-module ((guix diagnostics) #:select (leave))
+  #:use-module ((guix diagnostics) #:select (leave warning))
   #:use-module (guix progress)
+  #:autoload   (guix swh) (swh-download commit-id?)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -57,6 +58,8 @@
             commit-difference
             commit-relation
 
+            remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -180,6 +183,13 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
       (lambda args
         (make-fetch-options auth-method)))))
 
+(define GITERR_HTTP
+  ;; Guile-Git <= 0.5.2 lacks this constant.
+  (let ((errors (resolve-interface '(git errors))))
+    (if (module-defined? errors 'GITERR_HTTP)
+        (module-ref errors 'GITERR_HTTP)
+        34)))
+
 (define (clone* url directory)
   "Clone git repository at URL into DIRECTORY.  Upon failure,
 make sure no empty directory is left behind."
@@ -332,7 +342,8 @@ dynamic extent of EXP."
   "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
 definitely available in REPOSITORY, false otherwise."
   (match ref
-    (('commit . commit)
+    ((or ('commit . commit)
+         ('tag-or-commit . (? commit-id? commit)))
      (let ((len (string-length commit))
            (oid (string->oid commit)))
        (false-if-git-not-found
@@ -342,6 +353,42 @@ definitely available in REPOSITORY, false otherwise."
     (_
      #f)))
 
+(define (clone-from-swh url tag-or-commit output)
+  "Attempt to clone TAG-OR-COMMIT (a string), which originates from URL, using
+a copy archived at Software Heritage."
+  (call-with-temporary-directory
+   (lambda (bare)
+     (and (swh-download url tag-or-commit bare
+                        #:archive-type 'git-bare)
+          (let ((repository (clone* bare output)))
+            (remote-set-url! repository "origin" url)
+            repository)))))
+
+(define (clone/swh-fallback url ref cache-directory)
+  "Like 'clone', but fallback to Software Heritage if the repository cannot be
+found at URL."
+  (define (inaccessible-url-error? err)
+    (let ((class (git-error-class err))
+          (code  (git-error-code err)))
+      (or (= class GITERR_HTTP)                   ;404 or similar
+          (= class GITERR_NET))))                 ;unknown host, etc.
+
+  (catch 'git-error
+    (lambda ()
+      (clone* url cache-directory))
+    (lambda (key err)
+      (match ref
+        (((or 'commit 'tag-or-commit) . commit)
+         (if (inaccessible-url-error? err)
+             (or (clone-from-swh url commit cache-directory)
+                 (begin
+                   (warning (G_ "revision ~a of ~a \
+could not be fetched from Software Heritage~%")
+                            commit url)
+                   (throw key err)))
+             (throw key err)))
+        (_ (throw key err))))))
+
 (define cached-checkout-expiration
   ;; Return the expiration time procedure for a cached checkout.
   ;; TODO: Honor $GUIX_GIT_CACHE_EXPIRATION.
@@ -408,7 +455,7 @@ it unchanged."
    (let* ((cache-exists? (openable-repository? cache-directory))
           (repository    (if cache-exists?
                              (repository-open cache-directory)
-                             (clone* url cache-directory))))
+                             (clone/swh-fallback url ref cache-directory))))
      ;; Only fetch remote if it has not been cloned just before.
      (when (and cache-exists?
                 (not (reference-available? repository ref)))
@@ -571,6 +618,45 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+
+;;
+;;; Remote operations.
+;;;
+
+(define* (remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (define (remote-head->ref remote)
+    (let ((name (remote-head-name remote)))
+      (and (include? name)
+           name)))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+
+        (let* ((remote-heads (remote-ls remote))
+               (refs (filter-map remote-head->ref remote-heads)))
+          ;; Wait until we're finished with the repository before closing it.
+          (remote-disconnect remote)
+          (repository-close! repository)
+          refs))))))
 
 
 ;;;
diff --git a/guix/graph.scm b/guix/graph.scm
index 0d4cd83667..3a1cab244b 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -337,11 +337,12 @@ nodeArray.push(nodes[\"~a\"]);~%"
 
 (define* (export-graph sinks port
                        #:key
-                       reverse-edges? node-type
+                       reverse-edges? node-type (max-depth +inf.0)
                        (backend %graphviz-backend))
   "Write to PORT the representation of the DAG with the given SINKS, using the
 given BACKEND.  Use NODE-TYPE to traverse the DAG.  When REVERSE-EDGES? is
-true, draw reverse arrows."
+true, draw reverse arrows.  Do not represent nodes whose distance to one of
+the SINKS is greater than MAX-DEPTH."
   (match backend
     (($ <graph-backend> _ _ emit-prologue emit-epilogue emit-node emit-edge)
      (emit-prologue (node-type-name node-type) port)
@@ -349,6 +350,7 @@ true, draw reverse arrows."
      (match node-type
        (($ <node-type> node-identifier node-label node-edges)
         (let loop ((nodes   sinks)
+                   (depths  (make-list (length sinks) 0))
                    (visited (set)))
           (match nodes
             (()
@@ -356,20 +358,29 @@ true, draw reverse arrows."
                (emit-epilogue port)
                (store-return #t)))
             ((head . tail)
-             (mlet %store-monad ((id (node-identifier head)))
-               (if (set-contains? visited id)
-                   (loop tail visited)
-                   (mlet* %store-monad ((dependencies (node-edges head))
-                                        (ids          (mapm %store-monad
-                                                            node-identifier
-                                                            dependencies)))
-                     (emit-node id (node-label head) port)
-                     (for-each (lambda (dependency dependency-id)
-                                 (if reverse-edges?
-                                     (emit-edge dependency-id id port)
-                                     (emit-edge id dependency-id port)))
-                               dependencies ids)
-                     (loop (append dependencies tail)
-                           (set-insert id visited)))))))))))))
+             (match depths
+               ((depth . depths)
+                (mlet %store-monad ((id (node-identifier head)))
+                  (if (set-contains? visited id)
+                      (loop tail depths visited)
+                      (mlet* %store-monad ((dependencies
+                                            (if (= depth max-depth)
+                                                (return '())
+                                                (node-edges head)))
+                                           (ids
+                                            (mapm %store-monad
+                                                  node-identifier
+                                                  dependencies)))
+                        (emit-node id (node-label head) port)
+                        (for-each (lambda (dependency dependency-id)
+                                    (if reverse-edges?
+                                        (emit-edge dependency-id id port)
+                                        (emit-edge id dependency-id port)))
+                                  dependencies ids)
+                        (loop (append dependencies tail)
+                              (append (make-list (length dependencies)
+                                                 (+ 1 depth))
+                                  depths)
+                              (set-insert id visited)))))))))))))))
 
 ;;; graph.scm ends here
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 287ffd2536..c76d7e9c1a 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;;;
@@ -79,7 +79,10 @@
   (number        crate-version-number "num")      ;string
   (download-path crate-version-download-path "dl_path") ;string
   (readme-path   crate-version-readme-path "readme_path") ;string
-  (license       crate-version-license "license") ;string
+  (license       crate-version-license "license"  ;string | #f
+                 (match-lambda
+                   ('null #f)
+                   ((? string? str) str)))
   (links         crate-version-links))            ;alist
 
 ;; Crate dependency.  Each dependency (each edge in the graph) is annotated as
@@ -198,6 +201,7 @@ and LICENSE."
                    (description ,(beautify-description description))
                    (license ,(match license
                                (() #f)
+                               (#f #f)
                                ((license) license)
                                (_ `(list ,@license)))))))
          (close-port port)
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..1eb219f3fe
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,225 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; 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 import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater
+
+            ;; For tests.
+            latest-git-tag-version))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `release-tag-prefix',
+;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
+;;; package to make the updater parse the Git tag name correctly.
+;;;
+;;; Possible improvements:
+;;;
+;;; * More robust method for trying to guess the delimiter.  Maybe look at the
+;;;   previous version/tag combo to determine the delimiter.
+;;;
+;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g.,
+;;;   2021.12.31.  Honor a `release-tag-date-scheme?' property?
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test" "pre"))
+
+(define %pre-release-rx
+  (map (lambda (word)
+         (make-regexp (string-append ".+" word) regexp/icase))
+       %pre-release-words))
+
+(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
+  "Given a list of Git TAGS, return an association list where the car is the
+version corresponding to the tag, and the cdr is the name of the tag."
+  (define (guess-delimiter)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
+  (define suffix-rx  (string-append (or suffix "") "$"))
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (define pre-release-rx
+    (if pre-releases?
+        (string-append "(.*(" (string-join %pre-release-words "|") ").*)")
+        ""))
+
+  (define tag-rx
+    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
+                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                   ;; If there are no delimiters, it could mean that the
+                   ;; version just contains one number (e.g., "2"), thus, use
+                   ;; "*" instead of "+" to match zero or more numbers.
+                   (if (string=? delim-rx "") "*" "+") ")"
+                   ;; We don't want the pre-release stuff (e.g., "-alpha") be
+                   ;; part of the first group; otherwise, the "-" in "-alpha"
+                   ;; might be interpreted as a delimiter, and thus replaced
+                   ;; with "."
+                   pre-release-rx suffix-rx))
+
+
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (and=> (and tag-match
+                  (regexp-substitute/global
+                   #f delim-rx (match:substring tag-match 1)
+                   ;; If there were no delimiters, don't insert ".".
+                   'pre (if (string=? delim-rx "") "" ".") 'post))
+             (lambda (version)
+               (if pre-releases?
+                   (string-append version (match:substring tag-match 3))
+                   version)))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (stable-sort (filter-map (lambda (tag)
+                             (let ((version (get-version tag)))
+                               (and version (cons version tag))))
+                           tags)
+               entry<?))
+
+(define* (latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest version and corresponding tag available from the Git
+repository at URL."
+  (define (pre-release? tag)
+    (any (cut regexp-exec <> tag)
+         %pre-release-rx))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (remote-refs url #:tags? #t)))
+         (versions->tags
+          (version-mapping (if pre-releases?
+                               tags
+                               (filter (negate pre-release?) tags))
+                           #:prefix prefix
+                           #:suffix suffix
+                           #:delim delim
+                           #:pre-releases? pre-releases?)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package)
+  "Given a PACKAGE, return the latest version of it, or #f if the latest version
+could not be determined."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source)))
+           (property (cute assq-ref (package-properties package) <>)))
+      (latest-tag url
+                  #:prefix (property 'release-tag-prefix)
+                  #:suffix (property 'release-tag-suffix)
+                  #:delim (property 'release-tag-version-delimiter)
+                  #:pre-releases? (property 'accept-pre-releases?)))))
+
+(define (git-package? package)
+  "Return true if PACKAGE is hosted on a Git repository."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package)))
+
+    (and new-version
+         (upstream-source
+          (package name)
+          (version new-version)
+          (urls (list url))))))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
diff --git a/guix/import/go.scm b/guix/import/go.scm
index c6ecdbaffd..26dbc34b63 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -474,13 +474,13 @@ Optionally include a VERSION string to append to the name."
 because goproxy servers don't currently provide all the information needed to
 build a package."
   (define (go-import->module-meta content-text)
-    (match (string-split content-text #\space)
+    (match (string-tokenize content-text char-set:graphic)
       ((root-path vcs repo-url)
        (make-module-meta root-path (string->symbol vcs)
                          (strip-.git-suffix/maybe repo-url)))))
   ;; <meta name="go-import" content="import-prefix vcs repo-root">
   (let* ((meta-data (http-fetch* (format #f "https://~a?go-get=1" module-path)))
-         (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
+         (select (sxpath `(// (meta (@ (equal? (name "go-import"))))
                               // content))))
     (match (select (html->sxml meta-data #:strict? #t))
       (() #f)                           ;nothing selected
@@ -612,6 +612,8 @@ hint: use one of the following available versions ~a\n"
          (dependencies (if pin-versions?
                            dependencies+versions
                            (map car dependencies+versions)))
+         (module-path-sans-suffix
+          (match:prefix (string-match "([\\./]v[0-9]+)?$" module-path)))
          (guix-name (go-module->guix-package-name module-path))
          (root-module-path (module-path->repository-root module-path))
          ;; The VCS type and URL are not included in goproxy information. For
@@ -619,7 +621,7 @@ hint: use one of the following available versions ~a\n"
          (meta-data (fetch-module-meta-data root-module-path))
          (vcs-type (module-meta-vcs meta-data))
          (vcs-repo-url (module-meta-data-repo-url meta-data goproxy))
-         (synopsis (go-package-synopsis root-module-path))
+         (synopsis (go-package-synopsis module-path))
          (description (go-package-description module-path))
          (licenses (go-package-licenses module-path)))
     (values
@@ -630,7 +632,10 @@ hint: use one of the following available versions ~a\n"
          ,(vcs->origin vcs-type vcs-repo-url version*))
         (build-system go-build-system)
         (arguments
-         '(#:import-path ,root-module-path))
+         '(#:import-path ,module-path
+           ,@(if (string=? module-path-sans-suffix root-module-path)
+                 '()
+                 `(#:unpack-path ,root-module-path))))
         ,@(maybe-propagated-inputs
            (map (match-lambda
                   ((name version)
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 7c6d9d0a22..d73fbe6a81 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -55,8 +55,8 @@
             hackage-package?))
 
 (define ghc-standard-libraries
-  ;; List of libraries distributed with ghc (8.6.5).
-  ;; Contents of ...-ghc-8.6.5/lib/ghc-8.6.5.
+  ;; List of libraries distributed with ghc (as of 8.10.7).
+  ;; Contents of …-ghc-8.10.7/lib/ghc-8.10.7
   '("ghc"
     "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
             ;; hackage-name->package-name takes this into account.
@@ -68,6 +68,7 @@
     "containers"
     "deepseq"
     "directory"
+    "exceptions"
     "filepath"
     "ghc"
     "ghc-boot"
@@ -121,12 +122,12 @@ version is returned."
       (string-append package-name-prefix (string-downcase name))))
 
 (define guix-package->hackage-name
-  (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*"))
+  (let ((uri-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage)/package/([^/]+)/.*"))
         (name-rx (make-regexp "(.*)-[0-9\\.]+")))
     (lambda (package)
       "Given a Guix package name, return the corresponding Hackage name."
       (let* ((source-url (and=> (package-source package) origin-uri))
-             (name (match:substring (regexp-exec uri-rx source-url) 1)))
+             (name (match:substring (regexp-exec uri-rx source-url) 2)))
         (match (regexp-exec name-rx name)
           (#f name)
           (m (match:substring m 1)))))))
@@ -351,7 +352,7 @@ respectively."
                     #:guix-name hackage-name->package-name))
 
 (define hackage-package?
-  (let ((hackage-rx (make-regexp "https?://hackage.haskell.org")))
+  (let ((hackage-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage/)")))
     (url-predicate (cut regexp-exec hackage-rx <>))))
 
 (define (latest-release package)
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index e1f8487b75..0f3ab473ca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -25,6 +25,8 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module ((guix packages) #:prefix package:)
+  #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (guix ui)
   #:use-module (guix i18n)
@@ -36,15 +38,19 @@
   #:use-module (json)
   #:use-module (guix base32)
   #:use-module (guix git)
+  #:use-module ((guix git-download) #:prefix download:)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
             json->package
             contentdb-fetch
             elaborate-contentdb-name
+            minetest-package?
+            latest-minetest-release
             minetest->guix-package
             minetest-recursive-import
-            sort-packages))
+            sort-packages
+            %minetest-updater))
 
 ;; The ContentDB API is documented at
 ;; <https://content.minetest.net>.
@@ -203,7 +209,7 @@ raise an exception."
         (match correctly-named
           ((one) (package-keys-full-name one))
           ((too . many)
-           (warning (G_ "~a is ambigious, presuming ~a (other options include: ~a)~%")
+           (warning (G_ "~a is ambiguous, presuming ~a (other options include: ~a)~%")
                     name (package-keys-full-name too)
                     (map package-keys-full-name many))
            (package-keys-full-name too))
@@ -256,7 +262,7 @@ and possibly some other packages as well, or #f on failure."
                                    (order "desc"))
   "Search ContentDB for Q (a string).  Sort by SORT, in ascending order
 if ORDER is \"asc\" or descending order if ORDER is \"desc\".  TYPE must
-be \"mod\", \"game\" or \"txp\", restricting thes search results to
+be \"mod\", \"game\" or \"txp\", restricting the search results to
 respectively mods, games and texture packs.  Limit to at most LIMIT
 results.  The return value is a list of <package-keys> records."
   ;; XXX does Guile have something for constructing (and, when necessary,
@@ -337,6 +343,25 @@ official Minetest forum and the Git repository (if any)."
       (and=> (package-forums package) topic->url-sexp)
       (package-repository package)))
 
+(define (release-version release)
+  "Guess the version of RELEASE from the release title."
+  (define title (release-title release))
+  (if (string-prefix? "v" title)
+      ;; Remove "v" prefix from release titles like ‘v1.0.1’.
+      (substring title 1)
+      title))
+
+(define (version-style version)
+  "Determine the kind of version number VERSION is -- a date, or a conventional
+conventional version number."
+  (define dots? (->bool (string-index version #\.)))
+  (define hyphens? (->bool (string-index version #\-)))
+  (match (cons dots? hyphens?)
+    ((#true . #false) 'regular) ; something like "0.1"
+    ((#false . #false) 'regular) ; single component version number
+    ((#true . #true) 'regular) ; result of 'git-version'
+    ((#false . #true) 'date))) ; something like "2021-01-25"
+
 ;; If the default sort key is changed, make sure to modify 'show-help'
 ;; in (guix scripts import minetest) appropriately as well.
 (define %default-sort-key "score")
@@ -371,7 +396,11 @@ official Minetest forum and the Git repository (if any)."
 DEPENDENCIES as a list of AUTHOR/NAME strings."
   (define dependency-list
     (assoc-ref dependencies author/name))
-  (filter-map
+  ;; A mod can have multiple dependencies implemented by the same mod,
+  ;; so remove duplicate mod names.
+  (define (filter-deduplicate-map f list)
+    (delete-duplicates (filter-map f list)))
+  (filter-deduplicate-map
    (lambda (dependency)
      (and (not (dependency-optional? dependency))
           (not (builtin-mod? (dependency-name dependency)))
@@ -432,7 +461,7 @@ list of AUTHOR/NAME strings."
   (define important-upstream-dependencies
     (important-dependencies dependencies author/name #:sort sort))
   (values (make-minetest-sexp author/name
-                              (release-title release) ; version
+                              (release-version release)
                               (package-repository package)
                               (release-commit release)
                               important-upstream-dependencies
@@ -454,3 +483,37 @@ list of AUTHOR/NAME strings."
   (recursive-import author/name
                     #:repo->guix-package minetest->guix-package*
                     #:guix-name contentdb->package-name))
+
+(define (minetest-package? pkg)
+  "Is PKG a Minetest mod on ContentDB?"
+  (and (string-prefix? "minetest-" (package:package-name pkg))
+       (assq-ref (package:package-properties pkg) 'upstream-name)))
+
+(define (latest-minetest-release pkg)
+  "Return an <upstream-source> for the latest release of the package PKG,
+or #false if the latest release couldn't be determined."
+  (define author/name
+    (assq-ref (package:package-properties pkg) 'upstream-name))
+  (define contentdb-package (contentdb-fetch author/name)) ; TODO warn if #f?
+  (define release (latest-release author/name))
+  (define source (package:package-source pkg))
+  (and contentdb-package release
+       (release-commit release) ; not always set
+       ;; Only continue if both the old and new version number are both
+       ;; dates or regular version numbers, as two different styles confuses
+       ;; the logic for determining which version is newer.
+       (eq? (version-style (release-version release))
+            (version-style (package:package-version pkg)))
+       (upstream-source
+        (package (package:package-name pkg))
+        (version (release-version release))
+        (urls (list (download:git-reference
+                     (url (package-repository contentdb-package))
+                     (commit (release-commit release))))))))
+
+(define %minetest-updater
+  (upstream-updater
+    (name 'minetest)
+    (description "Updater for Minetest packages on ContentDB")
+    (pred minetest-package?)
+    (latest latest-minetest-release)))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index f3619dcd9e..e2314820d0 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -163,12 +164,13 @@ package on PyPI."
     (hyphen-package-name->name+version
      (basename (file-sans-extension url))))
 
-  (match (and=> (package-source package) origin-uri)
-    ((? string? url)
-     (url->pypi-name url))
-    ((lst ...)
-     (any url->pypi-name lst))
-    (#f #f)))
+  (or (assoc-ref (package-properties package) 'upstream-name)
+      (match (and=> (package-source package) origin-uri)
+        ((? string? url)
+         (url->pypi-name url))
+        ((lst ...)
+         (any url->pypi-name lst))
+        (#f #f))))
 
 (define (wheel-url->extracted-directory wheel-url)
   (match (string-split (basename wheel-url) #\-)
@@ -416,6 +418,11 @@ return the unaltered list of upstream dependency names."
                         description license)
   "Return the `package' s-expression for a python package with the given NAME,
 VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
+  (define (maybe-upstream-name name)
+    (if (string-match ".*\\-[0-9]+" (pk name))
+        `((properties ,`'(("upstream-name" . ,name))))
+        '()))
+  
   (call-with-temporary-output-file
    (lambda (temp port)
      (and (url-fetch source-url temp)
@@ -454,6 +461,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
                       (sha256
                        (base32
                         ,(guix-hash-url temp)))))
+                   ,@(maybe-upstream-name name)
                    (build-system python-build-system)
                    ,@(maybe-inputs required-inputs 'propagated-inputs)
                    ,@(maybe-inputs native-inputs 'native-inputs)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index bbd903a2cd..f58c6b163d 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Xinglu Chem <public@yoctocell.xyz>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,9 +22,8 @@
 
 (define-module (guix import stackage)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (guix import json)
@@ -31,6 +32,8 @@
   #:use-module (guix memoization)
   #:use-module (guix packages)
   #:use-module (guix upstream)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:export (%stackage-url
             stackage->guix-package
             stackage-recursive-import
@@ -44,15 +47,31 @@
 (define %stackage-url
   (make-parameter "https://www.stackage.org"))
 
-;; Latest LTS version compatible with GHC 8.6.5.
-(define %default-lts-version "14.27")
-
-(define (lts-info-packages lts-info)
-  "Returns the alist of packages contained in LTS-INFO."
-  (or (assoc-ref lts-info "packages") '()))
-
-(define (leave-with-message fmt . args)
-  (raise (condition (&message (message (apply format #f fmt args))))))
+;; Latest LTS version compatible with current GHC.
+(define %default-lts-version "18.10")
+
+(define-json-mapping <stackage-lts> make-stackage-lts
+  stackage-lts?
+  json->stackage-lts
+  (snapshot    stackage-lts-snapshot "snapshot" json->snapshot)
+  (packages    stackage-lts-packages "packages"
+               (lambda (vector)
+                 (map json->stackage-package (vector->list vector)))))
+
+(define-json-mapping <snapshot> make-snapshot
+  stackage-snapshot?
+  json->snapshot
+  (name        snapshot-name)
+  (ghc-version snapshot-ghc-version)
+  (compiler    snapshot-compiler))
+
+(define-json-mapping <stackage-package> make-stackage-package
+  stackage-package?
+  json->stackage-package
+  (origin      stackage-package-origin)
+  (name        stackage-package-name)
+  (version     stackage-package-version)
+  (synopsis    stackage-package-synopsis))
 
 (define stackage-lts-info-fetch
   ;; "Retrieve the information about the LTS Stackage release VERSION."
@@ -62,21 +81,15 @@
                                 "/lts-" (if (string-null? version)
                                             %default-lts-version
                                             version)))
-            (lts-info (json-fetch url)))
-       (if lts-info
-           (reverse lts-info)
-           (leave-with-message "LTS release version not found: ~a" version))))))
-
-(define (stackage-package-name pkg-info)
-  (assoc-ref pkg-info "name"))
-
-(define (stackage-package-version pkg-info)
-  (assoc-ref pkg-info "version"))
+            (lts-info (and=> (json-fetch url) json->stackage-lts)))
+       (or lts-info
+           (raise (formatted-message (G_ "LTS release version not found: ~a")
+                                     version)))))))
 
-(define (lts-package-version pkgs-info name)
-  "Return the version of the package with upstream NAME included in PKGS-INFO."
+(define (lts-package-version packages name)
+  "Return the version of the package with upstream NAME included in PACKAGES."
   (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
-                   (vector->list pkgs-info))))
+                   packages)))
     (stackage-package-version pkg)))
 
 
@@ -93,21 +106,22 @@
              #:key
              (include-test-dependencies? #t)
              (lts-version %default-lts-version)
-             (packages-info
-              (lts-info-packages
+             (packages
+              (stackage-lts-packages
                (stackage-lts-info-fetch lts-version))))
      "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org.  The retrieved
 version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION
 release at stackage.org.  Return the `package' S-expression corresponding to
 that package, or #f on failure.  PACKAGES-INFO is the alist with the packages
 included in the Stackage LTS release."
-     (let* ((version (lts-package-version packages-info package-name))
+     (let* ((version (lts-package-version packages package-name))
             (name-version (hackage-name-version package-name version)))
        (if name-version
            (hackage->guix-package name-version
                                   #:include-test-dependencies?
                                   include-test-dependencies?)
-           (leave-with-message "~a: Stackage package not found" package-name))))))
+           (raise (formatted-message (G_ "~a: Stackage package not found")
+                                     package-name)))))))
 
 (define (stackage-recursive-import package-name . args)
   (recursive-import package-name
@@ -121,31 +135,46 @@ included in the Stackage LTS release."
 ;;;
 
 (define latest-lts-release
-  (let ((pkgs-info
-        (mlambda () (lts-info-packages
-                     (stackage-lts-info-fetch %default-lts-version)))))
-    (lambda* (package)
+  (let ((packages
+         (mlambda ()
+           (stackage-lts-packages
+            (stackage-lts-info-fetch %default-lts-version)))))
+    (lambda* (pkg)
       "Return an <upstream-source> for the latest Stackage LTS release of
 PACKAGE or #f if the package is not included in the Stackage LTS release."
-      (let* ((hackage-name (guix-package->hackage-name package))
-             (version (lts-package-version (pkgs-info) hackage-name))
+      (let* ((hackage-name (guix-package->hackage-name pkg))
+             (version (lts-package-version (packages) hackage-name))
              (name-version (hackage-name-version hackage-name version)))
         (match (and=> name-version hackage-fetch)
-          (#f (format (current-error-port)
-                      "warning: failed to parse ~a~%"
-                      (hackage-cabal-url hackage-name))
-              #f)
+          (#f
+           (warning (G_ "failed to parse ~a~%")
+                    (hackage-cabal-url hackage-name))
+           #f)
           (_ (let ((url (hackage-source-url hackage-name version)))
                (upstream-source
-                (package (package-name package))
+                (package (package-name pkg))
                 (version version)
-                (urls (list url))))))))))
+                (urls (list url))
+                (input-changes
+                 (changed-inputs
+                  pkg
+                  (stackage->guix-package hackage-name #:packages (packages))))))))))))
+
+(define (stackage-lts-package? package)
+  "Return whether PACKAGE is available on the default Stackage LTS release."
+  (and (hackage-package? package)
+       (let ((packages (stackage-lts-packages
+                        (stackage-lts-info-fetch %default-lts-version)))
+             (hackage-name (guix-package->hackage-name package)))
+         (find (lambda (package)
+                 (string=? (stackage-package-name package) hackage-name))
+               packages))))
 
 (define %stackage-updater
   (upstream-updater
    (name 'stackage)
    (description "Updater for Stackage LTS packages")
-   (pred hackage-package?)
+   (pred stackage-lts-package?)
    (latest latest-lts-release)))
 
 ;;; stackage.scm ends here
diff --git a/guix/packages.scm b/guix/packages.scm
index 3953b7f79b..fa23cc39b3 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
@@ -363,6 +363,27 @@ name of its URI."
          ;; git, svn, cvs, etc. reference
          #f))))
 
+;; Work around limitations in the 'snippet' mechanism.  It is not possible for
+;; a 'snippet' to produce a tarball with a different base name than the
+;; original downloaded source.  Moreover, cherry picking dozens of upsteam
+;; patches and applying them suddenly is often impractical; especially when a
+;; comprehensive code reformatting is done upstream.  Mainly designed for
+;; Linux and IceCat packages.
+;; XXXX: do not make part of public API (export) such radical capability
+;; before a detailed review process.
+(define* (computed-origin-method gexp-promise hash-algo hash
+                                 #:optional (name "source")
+                                 #:key (system (%current-system))
+                                 (guile (default-guile)))
+  "Return a derivation that executes the G-expression that results
+from forcing GEXP-PROMISE."
+  (mlet %store-monad ((guile (package->derivation guile system)))
+    (gexp->derivation (or name "computed-origin")
+                      (force gexp-promise)
+                      #:graft? #f       ;nothing to graft
+                      #:system system
+                      #:guile-for-build guile)))
+
 
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 66de824ef4..439fae0b52 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -500,6 +500,10 @@ package modules, while attempting to retain user package modules."
                  (lambda (opt name arg result)
                    (alist-cons 'backend (lookup-backend arg)
                                result)))
+         (option '(#\M "max-depth") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'max-depth (string->number* arg)
+                               result)))
          (option '("list-backends") #f #f
                  (lambda (opt name arg result)
                    (list-backends)
@@ -538,6 +542,8 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
   (display (G_ "
       --list-types       list the available graph types"))
   (display (G_ "
+      --max-depth=DEPTH  limit to nodes within distance DEPTH"))
+  (display (G_ "
       --path             display the shortest path between the given nodes"))
   (display (G_ "
   -e, --expression=EXPR  consider the package EXPR evaluates to"))
@@ -559,6 +565,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
 (define %default-options
   `((node-type . ,%package-node-type)
     (backend   . ,%graphviz-backend)
+    (max-depth . +inf.0)
     (system    . ,(%current-system))))
 
 
@@ -582,6 +589,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
 
     (with-store store
       (let* ((transform (options->transformation opts))
+             (max-depth (assoc-ref opts 'max-depth))
              (items     (filter-map (match-lambda
                                       (('argument . (? store-path? item))
                                        item)
@@ -613,7 +621,8 @@ nodes (given ~a)~%")
                 (export-graph (concatenate nodes)
                               (current-output-port)
                               #:node-type type
-                              #:backend backend)))
+                              #:backend backend
+                              #:max-depth max-depth)))
           #:system (assq-ref opts 'system)))))
   #t)
 
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
new file mode 100644
index 0000000000..55e7b436c1
--- /dev/null
+++ b/guix/scripts/home.scm
@@ -0,0 +1,524 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.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 scripts home)
+  #:use-module (gnu packages admin)
+  #:use-module ((gnu services) #:hide (delete))
+  #:use-module (gnu packages)
+  #:use-module (gnu home)
+  #:use-module (gnu home services)
+  #:use-module (guix channels)
+  #:use-module (guix derivations)
+  #:use-module (guix ui)
+  #:use-module (guix grafts)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix scripts package)
+  #:use-module (guix scripts build)
+  #:use-module (guix scripts system search)
+  #:autoload   (guix scripts pull) (channel-commit-hyperlink)
+  #:use-module (guix scripts home import)
+  #:use-module ((guix status) #:select (with-status-verbosity))
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (guix-home))
+
+
+;;;
+;;; Options.
+;;;
+
+(define %user-module
+  (make-user-module '((gnu home))))
+
+(define %guix-home
+  (string-append %profile-directory "/guix-home"))
+
+(define (show-help)
+  (display (G_ "Usage: guix home [OPTION ...] ACTION [ARG ...] [FILE]
+Build the home environment declared in FILE according to ACTION.
+Some ACTIONS support additional ARGS.\n"))
+    (newline)
+  (display (G_ "The valid values for ACTION are:\n"))
+  (newline)
+  (display (G_ "\
+   search             search for existing service types\n"))
+  (display (G_ "\
+   reconfigure        switch to a new home environment configuration\n"))
+  (display (G_ "\
+   roll-back          switch to the previous home environment configuration\n"))
+  (display (G_ "\
+   describe           describe the current home environment\n"))
+  (display (G_ "\
+   list-generations   list the home environment generations\n"))
+  (display (G_ "\
+   switch-generation  switch to an existing home environment configuration\n"))
+  (display (G_ "\
+   delete-generations delete old home environment generations\n"))
+  (display (G_ "\
+   build              build the home environment without installing anything\n"))
+  (display (G_ "\
+   import             generates a home environment definition from dotfiles\n"))
+
+  (show-build-options-help)
+  (display (G_ "
+  -e, --expression=EXPR  consider the home-environment EXPR evaluates to
+                         instead of reading FILE, when applicable"))
+  (display (G_ "
+  -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define (verbosity-level opts)
+  "Return the verbosity level based on OPTS, the alist of parsed options."
+  (or (assoc-ref opts 'verbosity)
+      (if (eq? (assoc-ref opts 'action) 'build)
+          2 1)))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t result)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix show")))
+         (option '(#\v "verbosity") #t #f
+                 (lambda (opt name arg result)
+                   (let ((level (string->number* arg)))
+                     (alist-cons 'verbosity level
+                                 (alist-delete 'verbosity result)))))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
+         %standard-build-options))
+
+(define %default-options
+  `((build-mode . ,(build-mode normal))
+    (graft? . #t)
+    (substitutes? . #t)
+    (offload? . #t)
+    (print-build-trace? . #t)
+    (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
+    (verbosity . 3)
+    (debug . 0)))
+
+
+;;;
+;;; Actions.
+;;;
+
+(define* (perform-action action he
+                         #:key
+                         dry-run?
+                         derivations-only?
+                         use-substitutes?)
+  "Perform ACTION for home environment. "
+
+  (define println
+    (cut format #t "~a~%" <>))
+
+  (mlet* %store-monad
+      ((he-drv   (home-environment-derivation he))
+       (drvs     (mapm/accumulate-builds lower-object (list he-drv)))
+       (%        (if derivations-only?
+                     (return
+                      (for-each (compose println derivation-file-name) drvs))
+                     (built-derivations drvs)))
+
+       (he-out-path -> (derivation->output-path he-drv)))
+    (if (or dry-run? derivations-only?)
+        (return #f)
+        (begin
+          (for-each (compose println derivation->output-path) drvs)
+
+          (case action
+            ((reconfigure)
+             (let* ((number (generation-number %guix-home))
+                    (generation (generation-file-name
+                                 %guix-home (+ 1 number))))
+
+               (switch-symlinks generation he-out-path)
+               (switch-symlinks %guix-home generation)
+               (setenv "GUIX_NEW_HOME" he-out-path)
+               (primitive-load (string-append he-out-path "/activate"))
+               (setenv "GUIX_NEW_HOME" #f)
+               (return he-out-path)))
+            (else
+             (newline)
+             (return he-out-path)))))))
+
+(define (process-action action args opts)
+  "Process ACTION, a sub-command, with the arguments are listed in ARGS.
+ACTION must be one of the sub-commands that takes a home environment
+declaration as an argument (a file name.)  OPTS is the raw alist of options
+resulting from command-line parsing."
+  (define (ensure-home-environment file-or-exp obj)
+    (ensure-profile-directory)
+    (unless (home-environment? obj)
+      (leave (G_ "'~a' does not return a home environment ~%")
+             file-or-exp))
+    obj)
+
+  (let* ((file   (match args
+                   (() #f)
+                   ((x . _) x)))
+         (expr   (assoc-ref opts 'expression))
+         (system (assoc-ref opts 'system))
+
+         (transform   (lambda (obj)
+                        (home-environment-with-provenance obj file)))
+
+         (home-environment
+          (transform
+           (ensure-home-environment
+            (or file expr)
+            (cond
+             ((and expr file)
+              (leave
+               (G_ "both file and expression cannot be specified~%")))
+             (expr
+              (read/eval expr))
+             (file
+              (load* file %user-module
+                     #:on-error (assoc-ref opts 'on-error)))
+             (else
+              (leave (G_ "no configuration specified~%")))))))
+
+         (dry?        (assoc-ref opts 'dry-run?)))
+
+    (with-store store
+      (set-build-options-from-command-line store opts)
+      (with-build-handler (build-notifier #:use-substitutes?
+                                          (assoc-ref opts 'substitutes?)
+                                          #:verbosity
+                                          (verbosity-level opts)
+                                          #:dry-run?
+                                          (assoc-ref opts 'dry-run?))
+
+        (run-with-store store
+          (mbegin %store-monad
+            (set-guile-for-build (default-guile))
+
+            (case action
+              (else
+               (perform-action action home-environment
+                               #:dry-run? dry?
+                               #:derivations-only? (assoc-ref opts 'derivations-only?)
+                               #:use-substitutes? (assoc-ref opts 'substitutes?))
+               ))))))
+    (warn-about-disk-space)))
+
+
+(define (process-command command args opts)
+  "Process COMMAND, one of the 'guix home' sub-commands.  ARGS is its
+argument list and OPTS is the option alist."
+  (define-syntax-rule (with-store* store exp ...)
+    (with-store store
+      (set-build-options-from-command-line store opts)
+      exp ...))
+  (case command
+    ;; The following commands do not need to use the store, and they do not need
+    ;; an home environment file.
+    ((search)
+     (apply search args))
+    ((import)
+     (let* ((profiles (delete-duplicates
+                      (match (filter-map (match-lambda
+                                           (('profile . p) p)
+                                           (_              #f))
+                                         opts)
+                        (() (list %current-profile))
+                        (lst (reverse lst)))))
+           (manifest (concatenate-manifests
+                      (map profile-manifest profiles))))
+       (import-manifest manifest (current-output-port))))
+    ((describe)
+     (match (generation-number %guix-home)
+       (0
+        (error (G_ "no home environment generation, nothing to describe~%")))
+       (generation
+        (display-home-environment-generation generation))))
+    ((list-generations)
+     (let ((pattern (match args
+                      (() #f)
+                      ((pattern) pattern)
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (list-generations pattern)))
+    ((switch-generation)
+     (let ((pattern (match args
+                      ((pattern) pattern)
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (with-store* store
+                    (switch-to-home-environment-generation store pattern))))
+    ((roll-back)
+     (let ((pattern (match args
+                      (() "")
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (with-store* store
+                    (roll-back-home-environment store))))
+    ((delete-generations)
+     (let ((pattern (match args
+                      (() #f)
+                      ((pattern) pattern)
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (with-store*
+        store
+        (delete-matching-generations store %guix-home pattern))))
+    (else (process-action command args opts))))
+
+(define-command (guix-home . args)
+  (synopsis "build and deploy home environments")
+
+  (define (parse-sub-command arg result)
+    ;; Parse sub-command ARG and augment RESULT accordingly.
+    (if (assoc-ref result 'action)
+        (alist-cons 'argument arg result)
+        (let ((action (string->symbol arg)))
+          (case action
+            ((build
+              reconfigure
+              extension-graph shepherd-graph
+              list-generations describe
+              delete-generations roll-back
+              switch-generation search
+              import)
+             (alist-cons 'action action result))
+            (else (leave (G_ "~a: unknown action~%") action))))))
+
+  (define (match-pair car)
+    ;; Return a procedure that matches a pair with CAR.
+    (match-lambda
+      ((head . tail)
+       (and (eq? car head) tail))
+      (_ #f)))
+
+  (define (option-arguments opts)
+    ;; Extract the plain arguments from OPTS.
+    (let* ((args   (reverse (filter-map (match-pair 'argument) opts)))
+           (count  (length args))
+           (action (assoc-ref opts 'action))
+           (expr   (assoc-ref opts 'expression)))
+      (define (fail)
+        (leave (G_ "wrong number of arguments for action '~a'~%")
+               action))
+
+      (unless action
+        (format (current-error-port)
+                (G_ "guix home: missing command name~%"))
+        (format (current-error-port)
+                (G_ "Try 'guix home --help' for more information.~%"))
+        (exit 1))
+
+      (case action
+        ((build reconfigure)
+         (unless (or (= count 1)
+                     (and expr (= count 0)))
+           (fail)))
+        ((init)
+         (unless (= count 2)
+           (fail))))
+      args))
+
+  (with-error-handling
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:argument-handler
+                                         parse-sub-command))
+           (args     (option-arguments opts))
+           (command  (assoc-ref opts 'action)))
+      (parameterize ((%graft? (assoc-ref opts 'graft?)))
+        (with-status-verbosity (verbosity-level opts)
+          (process-command command args opts))))))
+
+
+;;;
+;;; Searching.
+;;;
+
+(define service-type-name*
+  (compose symbol->string service-type-name))
+
+(define (service-type-description-string type)
+  "Return the rendered and localised description of TYPE, a service type."
+  (and=> (service-type-description type)
+         (compose texi->plain-text P_)))
+
+(define %service-type-metrics
+  ;; Metrics used to estimate the relevance of a search result.
+  `((,service-type-name* . 3)
+    (,service-type-description-string . 2)
+    (,(lambda (type)
+        (match (and=> (service-type-location type) location-file)
+          ((? string? file)
+           (basename file ".scm"))
+          (#f
+           "")))
+     . 1)))
+
+(define (find-service-types regexps)
+  "Return a list of service type/score pairs: service types whose name or
+description matches REGEXPS sorted by relevance, and their score."
+  (let ((matches (fold-home-service-types
+                  (lambda (type result)
+                    (match (relevance type regexps
+                                      %service-type-metrics)
+                      ((? zero?)
+                       result)
+                      (score
+                       (cons (cons type score) result))))
+                  '())))
+    (sort matches
+          (lambda (m1 m2)
+            (match m1
+              ((type1 . score1)
+               (match m2
+                 ((type2 . score2)
+                  (if (= score1 score2)
+                      (string>? (service-type-name* type1)
+                                (service-type-name* type2))
+                      (> score1 score2))))))))))
+
+(define (search . args)
+  (with-error-handling
+    (let* ((regexps (map (cut make-regexp* <> regexp/icase) args))
+           (matches (find-service-types regexps)))
+      (leave-on-EPIPE
+       (display-search-results matches (current-output-port)
+                               #:print service-type->recutils
+                               #:command "guix home search")))))
+
+
+;;;
+;;; Generations.
+;;;
+
+(define* (display-home-environment-generation
+          number
+          #:optional (profile %guix-home))
+  "Display a summary of home-environment generation NUMBER in a
+human-readable format."
+  (define (display-channel channel)
+    (format #t     "    ~a:~%" (channel-name 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))))
+
+  (unless (zero? number)
+    (let* ((generation  (generation-file-name profile number)))
+      (define-values (channels config-file)
+        ;; The function will work for home environments too, we just
+        ;; need to keep provenance file.
+        (system-provenance generation))
+
+      (display-generation profile number)
+      (format #t (G_ "  file name: ~a~%") generation)
+      (format #t (G_ "  canonical file name: ~a~%") (readlink* generation))
+      ;; TRANSLATORS: Please preserve the two-space indentation.
+
+      (unless (null? channels)
+        ;; TRANSLATORS: Here "channel" is the same terminology as used in
+        ;; "guix describe" and "guix pull --channels".
+        (format #t (G_ "  channels:~%"))
+        (for-each display-channel channels))
+      (when config-file
+        (format #t (G_ "  configuration file: ~a~%")
+                (if (supports-hyperlinks?)
+                    (file-hyperlink config-file)
+                    config-file))))))
+
+(define* (list-generations pattern #:optional (profile %guix-home))
+  "Display in a human-readable format all the home environment
+generations matching PATTERN, a string.  When PATTERN is #f, display
+all the home environment generations."
+  (cond ((not (file-exists? profile))             ; XXX: race condition
+         (raise (condition (&profile-not-found-error
+                            (profile profile)))))
+        ((not pattern)
+         (for-each display-home-environment-generation (profile-generations profile)))
+        ((matching-generations pattern profile)
+         =>
+         (lambda (numbers)
+           (if (null-list? numbers)
+               (exit 1)
+               (leave-on-EPIPE
+                (for-each display-home-environment-generation numbers)))))))
+
+
+;;;
+;;; Switch generations.
+;;;
+
+;; TODO: Make it public in (guix scripts system)
+(define-syntax-rule (unless-file-not-found exp)
+  (catch 'system-error
+    (lambda ()
+      exp)
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          #f
+          (apply throw args)))))
+
+(define (switch-to-home-environment-generation store spec)
+  "Switch the home-environment profile to the generation specified by
+SPEC.  STORE is an open connection to the store."
+  (let* ((number (relative-generation-spec->number %guix-home spec))
+         (generation (generation-file-name %guix-home number))
+         (activate (string-append generation "/activate")))
+    (if number
+        (begin
+          (setenv "GUIX_NEW_HOME" (readlink generation))
+          (switch-to-generation* %guix-home number)
+          (unless-file-not-found (primitive-load activate))
+          (setenv "GUIX_NEW_HOME" #f))
+        (leave (G_ "cannot switch to home environment generation '~a'~%") spec))))
+
+
+;;;
+;;; Roll-back.
+;;;
+
+(define (roll-back-home-environment store)
+  "Roll back the home-environment profile to its previous generation.
+STORE is an open connection to the store."
+  (switch-to-home-environment-generation store "-1"))
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
new file mode 100644
index 0000000000..611f580e85
--- /dev/null
+++ b/guix/scripts/home/import.scm
@@ -0,0 +1,243 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;;
+;;; 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 scripts home import)
+  #:use-module (guix profiles)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (gnu packages)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (import-manifest))
+
+;;; Commentary:
+;;;
+;;; This module provides utilities for generating home service
+;;; configurations from existing "dotfiles".
+;;;
+;;; Code:
+
+
+(define (generate-bash-module+configuration)
+  (let ((rc (string-append (getenv "HOME") "/.bashrc"))
+        (profile (string-append (getenv "HOME") "/.bash_profile"))
+        (logout (string-append (getenv "HOME") "/.bash_logout")))
+    `((gnu home services bash)
+      (service home-bash-service-type
+                 (home-bash-configuration
+                  ,@(if (file-exists? rc)
+                        `((bashrc
+                           (list (local-file ,rc))))
+                        '())
+                  ,@(if (file-exists? profile)
+                        `((bash-profile
+                           (list (local-file ,profile))))
+                        '())
+                  ,@(if (file-exists? logout)
+                        `((bash-logout
+                           (list (local-file ,logout))))
+                        '()))))))
+
+
+(define %files-configurations-alist
+  `((".bashrc" . ,generate-bash-module+configuration)
+    (".bash_profile" . ,generate-bash-module+configuration)
+    (".bash_logout" . ,generate-bash-module+configuration)))
+
+(define (modules+configurations)
+  (let ((configurations (delete-duplicates
+                         (filter-map (match-lambda
+                                ((file . proc)
+                                 (if (file-exists?
+                                      (string-append (getenv "HOME") "/" file))
+                                     proc
+                                     #f)))
+                                     %files-configurations-alist)
+                         (lambda (x y)
+                           (equal? (procedure-name x) (procedure-name y))))))
+    (map (lambda (proc) (proc)) configurations)))
+
+;; Based on `manifest->code' from (guix profiles)
+;; MAYBE: Upstream it?
+(define* (manifest->code manifest
+                         #:key
+                         (entry-package-version (const ""))
+                         (home-environment? #f))
+  "Return an sexp representing code to build an approximate version of
+MANIFEST; the code is wrapped in a top-level 'begin' form.  If
+HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
+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)
+      (let ((specs (map (lambda (entry)
+                          (match (manifest-entry-output entry)
+                            ("out"  (qualified-name entry))
+                            (output (string-append (qualified-name entry)
+                                                   ":" output))))
+                        (manifest-entries manifest))))
+        (if home-environment?
+            (let ((modules+configurations (modules+configurations)))
+              `(begin
+               (use-modules (gnu home)
+                            (gnu packages)
+                            ,@(map first modules+configurations))
+               ,(home-environment-template
+                 #:specs specs
+                 #:services (map second modules+configurations))))
+            `(begin
+               (use-modules (gnu packages))
+
+               (specifications->manifest
+                (list ,@specs)))))
+      (let* ((transform (lambda (options exp)
+                         (if (not options)
+                             exp
+                             (let ((proc (assoc-ref transformation-procedures
+                                                    options)))
+                               `(,proc ,exp)))))
+            (packages (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)))
+            (transformations (map (match-lambda
+                         ((options . name)
+                          `(define ,name
+                             (options->transformation ',options))))
+                       transformation-procedures)))
+        (if home-environment?
+            (let ((modules+configurations (modules+configurations)))
+              `(begin
+                 (use-modules (guix transformations)
+                              (gnu home)
+                              (gnu packages)
+                              ,@(map first modules+configurations))
+
+                 ,@transformations
+
+                 ,(home-environment-template
+                   #:packages packages
+                   #:services (map second modules+configurations))))
+            `(begin
+               (use-modules (guix transformations)
+                            (gnu packages))
+
+                ,@transformations
+
+                (packages->manifest
+                 (list ,@packages)))))))
+
+(define* (home-environment-template #:key (packages #f) (specs #f) services)
+  "Return an S-exp containing a <home-environment> declaration
+containing PACKAGES, or SPECS (package specifications), and SERVICES."
+  `(home-environment
+     (packages
+      ,@(if packages
+            `((list ,@packages))
+            `((map specification->package
+                   (list ,@specs)))))
+     (services (list ,@services))))
+
+(define* (import-manifest
+          manifest
+          #:optional (port (current-output-port)))
+  "Write to PORT a <home-environment> 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
+                         #:home-environment? #t)
+    (('begin exp ...)
+     (format port (G_ "\
+;; This \"home-environment\" file can be passed to 'guix home reconfigure'
+;; 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))))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 25846b7dc2..6e2b4368da 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -25,6 +25,7 @@
   #:use-module ((system repl server) #:prefix repl:)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 match)
   #:use-module (ice-9 poll)
   #:use-module (ice-9 regex)
@@ -400,15 +401,18 @@ appropriate duration.  NAR-PATH specifies the prefix for nar URLs."
   (let ((store-path (hash-part->path store hash)))
     (if (string-null? store-path)
         (not-found request #:phrase "" #:ttl negative-ttl)
-        (values `((content-type . (application/x-nix-narinfo))
+        (values `((content-type . (application/x-nix-narinfo
+                                   (charset . "UTF-8")))
+                  (x-nar-path . ,nar-path)
+                  (x-narinfo-compressions . ,compressions)
                   ,@(if ttl
                         `((cache-control (max-age . ,ttl)))
                         '()))
-                (cut display
-                  (narinfo-string store store-path
-                                  #:nar-path nar-path
-                                  #:compressions compressions)
-                  <>)))))
+                ;; Do not call narinfo-string directly here as it is an
+                ;; expensive call that could potentially block the main
+                ;; thread.  Instead, create the narinfo string in the
+                ;; http-write procedure.
+                store-path))))
 
 (define* (nar-cache-file directory item
                              #:key (compression %no-compression))
@@ -663,19 +667,38 @@ requested using POOL."
                        (link narinfo other)))
                    others))))))
 
+(define (compression->sexp compression)
+  "Return the SEXP representation of COMPRESSION."
+  (match compression
+    (($ <compression> type level)
+     `(compression ,type ,level))))
+
+(define (sexp->compression sexp)
+  "Turn the given SEXP into a <compression> record and return it."
+  (match sexp
+    (('compression type level)
+     (compression type level))))
+
 ;; XXX: Declare the 'X-Nar-Compression' HTTP header, which is in fact for
 ;; internal consumption: it allows us to pass the compression info to
 ;; 'http-write', as part of the workaround to <http://bugs.gnu.org/21093>.
 (declare-header! "X-Nar-Compression"
                  (lambda (str)
-                   (match (call-with-input-string str read)
-                     (('compression type level)
-                      (compression type level))))
+                   (sexp->compression
+                    (call-with-input-string str read)))
                  compression?
                  (lambda (compression port)
-                   (match compression
-                     (($ <compression> type level)
-                      (write `(compression ,type ,level) port)))))
+                   (write (compression->sexp compression) port)))
+
+;; This header is used to pass the supported compressions to http-write in
+;; order to format on-the-fly narinfo responses.
+(declare-header! "X-Narinfo-Compressions"
+                 (lambda (str)
+                   (map sexp->compression
+                        (call-with-input-string str read)))
+                 (cut every compression? <>)
+                 (lambda (compressions port)
+                   (write (map compression->sexp compressions) port)))
 
 (define* (render-nar store request store-item
                      #:key (compression %no-compression))
@@ -830,7 +853,8 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
   "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
   (fold alist-delete
         (response-headers response)
-        '(content-length x-raw-file x-nar-compression)))
+        '(content-length x-raw-file x-nar-compression
+                         x-narinfo-compressions x-nar-path)))
 
 (define (sans-content-length response)
   "Return RESPONSE without its 'content-length' header."
@@ -964,6 +988,38 @@ blocking."
              (unless keep-alive?
                (close-port client)))
             (values))))))
+    (('application/x-nix-narinfo . _)
+     (let ((compressions (assoc-ref (response-headers response)
+                                    'x-narinfo-compressions))
+           (nar-path (assoc-ref (response-headers response)
+                                'x-nar-path)))
+       (if nar-path
+           (begin
+             (when (keep-alive? response)
+               (keep-alive client))
+             (call-with-new-thread
+              (lambda ()
+                (set-thread-name "publish narinfo")
+                (let* ((narinfo
+                        (with-store store
+                          (narinfo-string store (utf8->string body)
+                                          #:nar-path nar-path
+                                          #:compressions compressions)))
+                       (narinfo-bv (string->bytevector narinfo "UTF-8"))
+                       (narinfo-length
+                        (bytevector-length narinfo-bv))
+                       (response (write-response
+                                  (with-content-length response
+                                                       narinfo-length)
+                                  client))
+                       (output (response-port response)))
+                  (configure-socket client)
+                  (put-bytevector output narinfo-bv)
+                  (force-output output)
+                  (unless (keep-alive? response)
+                    (close-port output))
+                  (values)))))
+           (%http-write server client response body))))
     (_
      (match (assoc-ref (response-headers response) 'x-raw-file)
        ((? string? file)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 65eb98e4b2..7faa92fd7d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -64,6 +64,7 @@
                  (device-module-aliases matching-modules)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu image)
+  #:use-module (gnu platform)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
@@ -253,7 +254,7 @@ the ownership of '~a' may be incorrect!~%")
           (install-bootloader local-eval bootloader bootcfg
                               #:target target)
           (return
-           (info (G_ "bootloader successfully installed on '~a'~%")
+           (info (G_ "bootloader successfully installed on~{ ~a~}~%")
                  (bootloader-configuration-targets bootloader))))))))
 
 
@@ -1212,13 +1213,11 @@ resulting from command-line parsing."
                             (base-image (if (operating-system? obj)
                                             (os->image obj
                                                        #:type image-type)
-                                            obj))
-                            (base-target (image-target base-image)))
+                                            obj)))
                         (image
                          (inherit (if label
                                       (image-with-label base-image label)
                                       base-image))
-                         (target (or base-target target))
                          (size image-size)
                          (volatile-root? volatile?))))
          (os          (image-operating-system image))
diff --git a/guix/self.scm b/guix/self.scm
index 79d93357a2..61ff423086 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -958,13 +958,23 @@ itself."
                  #:guile-for-build
                  guile-for-build))
 
+  (define *home-modules*
+    (scheme-node "guix-home"
+                 `((gnu home)
+                   (gnu home services)
+                   ,@(scheme-modules* source "gnu/home/services"))
+                 (list *core-package-modules* *package-modules*
+                       *extra-modules* *core-modules* *system-modules*)
+                 #:extensions dependencies
+                 #:guile-for-build guile-for-build))
+
   (define *cli-modules*
     (scheme-node "guix-cli"
                  (append (scheme-modules* source "/guix/scripts")
                          `((gnu ci)))
                  (list *core-modules* *extra-modules*
                        *core-package-modules* *package-modules*
-                       *system-modules*)
+                       *system-modules* *home-modules*)
                  #:extensions dependencies
                  #:guile-for-build guile-for-build))
 
@@ -1012,6 +1022,7 @@ itself."
                                        *cli-modules*
                                        *system-test-modules*
                                        *system-modules*
+                                       *home-modules*
                                        *package-modules*
                                        *core-package-modules*
                                        *extra-modules*
diff --git a/guix/swh.scm b/guix/swh.scm
index a62567dd58..5c41685a24 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -645,20 +645,29 @@ delete it when leaving the dynamic extent of this call."
       (lambda ()
         (false-if-exception (delete-file-recursively tmp-dir))))))
 
-(define* (swh-download-directory id output
-                                 #:key (log-port (current-error-port)))
-  "Download from Software Heritage the directory with the given ID, and
-unpack it to OUTPUT.  Return #t on success and #f on failure"
+(define* (swh-download-archive swhid output
+                               #:key
+                               (archive-type 'flat)
+                               (log-port (current-error-port)))
+  "Download from Software Heritage the directory or revision with the given
+SWID, in the ARCHIVE-TYPE format (one of 'flat or 'git-bare), and unpack it to
+OUTPUT.  Return #t on success and #f on failure."
   (call-with-temporary-directory
    (lambda (directory)
-     (match (vault-fetch id 'directory #:log-port log-port)
+     (match (vault-fetch swhid
+                         #:archive-type archive-type
+                         #:log-port log-port)
        (#f
         (format log-port
-                "SWH: directory ~a could not be fetched from the vault~%"
-                id)
+                "SWH: object ~a could not be fetched from the vault~%"
+                swhid)
         #f)
        ((? port? input)
-        (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
+        (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory
+                               (match archive-type
+                                 ('flat "-xzvf")     ;gzipped
+                                 ('git-bare "-xvf")) ;uncompressed
+                               "-")))
           (dump-port input tar)
           (close-port input)
           (let ((status (close-pipe tar)))
@@ -672,6 +681,14 @@ unpack it to OUTPUT.  Return #t on success and #f on failure"
                                #:log (%make-void-port "w"))
              #t))))))))
 
+(define* (swh-download-directory id output
+                                 #:key (log-port (current-error-port)))
+  "Download from Software Heritage the directory with the given ID, and
+unpack it to OUTPUT.  Return #t on success and #f on failure."
+  (swh-download-archive (string-append "swh:1:dir:" id) output
+                        #:archive-type 'flat
+                        #:log-port log-port))
+
 (define (commit-id? reference)
   "Return true if REFERENCE is likely a commit ID, false otherwise---e.g., if
 it is a tag name.  This is based on a simple heuristic so use with care!"
@@ -679,8 +696,11 @@ it is a tag name.  This is based on a simple heuristic so use with care!"
        (string-every char-set:hex-digit reference)))
 
 (define* (swh-download url reference output
-                       #:key (log-port (current-error-port)))
-  "Download from Software Heritage a checkout of the Git tag or commit
+                       #:key
+                       (archive-type 'flat)
+                       (log-port (current-error-port)))
+  "Download from Software Heritage a checkout (if ARCHIVE-TYPE is 'flat) or a
+full Git repository (if ARCHIVE-TYPE is 'git-bare) of the Git tag or commit
 REFERENCE originating from URL, and unpack it in OUTPUT.  Return #t on success
 and #f on failure.
 
@@ -694,8 +714,16 @@ wait until it becomes available, which could take several minutes."
      (format log-port "SWH: found revision ~a with directory at '~a'~%"
              (revision-id revision)
              (swh-url (revision-directory-url revision)))
-     (swh-download-directory (revision-directory revision) output
-                             #:log-port log-port))
+     (swh-download-archive (match archive-type
+                             ('flat
+                              (string-append
+                               "swh:1:dir:" (revision-directory revision)))
+                             ('git-bare
+                              (string-append
+                               "swh:1:rev:" (revision-id revision))))
+                           output
+                           #:archive-type archive-type
+                           #:log-port log-port))
     (#f
      (format log-port
              "SWH: revision ~s originating from ~a could not be found~%"
diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index b8e5f7e643..69960284d9 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,6 +54,7 @@ Return DIRECTORY on success."
        (with-environment-variables
         `(("GIT_CONFIG_NOSYSTEM" "1")
           ("GIT_ATTR_NOSYSTEM" "1")
+          ("GIT_CONFIG_GLOBAL" ,(string-append home "/.gitconfig"))
           ("HOME" ,home))
         (apply invoke (git-command) "-C" directory
                command args)))))
@@ -88,6 +90,9 @@ Return DIRECTORY on success."
       ((('tag name) rest ...)
        (git "tag" name)
        (loop rest))
+      ((('tag name text) rest ...)
+       (git "tag" "-m" text name)
+       (loop rest))
       ((('branch name) rest ...)
        (git "branch" name)
        (loop rest))