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

34 files changed, 1301 insertions, 201 deletions

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index ed69746a3b..0c76ba9355 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -77,8 +78,10 @@ to NAME and VERSION."
                       (vendor-dir "guix-vendor")
                       (cargo-build-flags ''("--release"))
                       (cargo-test-flags ''("--release"))
+                      (cargo-package-flags ''("--no-metadata" "--no-verify"))
                       (features ''())
                       (skip-build? #f)
+                      (install-source? #t)
                       (phases '(@ (guix build cargo-build-system)
                                   %standard-phases))
                       (outputs '("out"))
@@ -106,8 +109,10 @@ to NAME and VERSION."
                     #:vendor-dir ,vendor-dir
                     #:cargo-build-flags ,cargo-build-flags
                     #:cargo-test-flags ,cargo-test-flags
+                    #:cargo-package-flags ,cargo-package-flags
                     #:features ,features
                     #:skip-build? ,skip-build?
+                    #:install-source? ,install-source?
                     #:tests? ,(and tests? (not skip-build?))
                     #:phases ,phases
                     #:outputs %outputs
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index f8ebaefb27..0e2c1cd2ee 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -26,9 +26,12 @@
   #:use-module (guix build-system gnu)
   #:use-module (guix packages)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:export (%go-build-system-modules
             go-build
-            go-build-system))
+            go-build-system
+
+            go-version->git-ref))
 
 ;; Commentary:
 ;;
@@ -37,6 +40,36 @@
 ;;
 ;; Code:
 
+(define %go-version-rx
+  (make-regexp (string-append
+                "(v?[0-9]\\.[0-9]\\.[0-9])" ;"v" prefix can be omitted in version prefix
+                "(-|-pre\\.0\\.|-0\\.)"     ;separator
+                "([0-9]{14})-"              ;timestamp
+                "([0-9A-Fa-f]{12})")))      ;commit hash
+
+(define (go-version->git-ref version)
+  "Parse VERSION, a \"pseudo-version\" as defined at
+<https://golang.org/ref/mod#pseudo-versions>, and extract the commit hash from
+it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
+  ;; A module version like v1.2.3 is introduced by tagging a revision in the
+  ;; underlying source repository.  Untagged revisions can be referred to
+  ;; using a "pseudo-version" like v0.0.0-yyyymmddhhmmss-abcdefabcdef, where
+  ;; the time is the commit time in UTC and the final suffix is the prefix of
+  ;; the commit hash (see: https://golang.org/ref/mod#pseudo-versions).
+  (let* ((version
+          ;; If a source code repository has a v2.0.0 or later tag for a file
+          ;; tree with no go.mod, the version is considered to be part of the
+          ;; v1 module's available versions and is given an +incompatible
+          ;; suffix
+          ;; (see:https://golang.org/cmd/go/#hdr-Module_compatibility_and_semantic_versioning).
+          (if (string-suffix? "+incompatible" version)
+              (string-drop-right version 13)
+              version))
+         (match (regexp-exec %go-version-rx version)))
+    (if match
+        (match:substring match 4)
+        version)))
+
 (define %go-build-system-modules
   ;; Build-side modules imported and used by default.
   `((guix build go-build-system)
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 05c24c47d5..a8c5eed09b 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -18,8 +18,6 @@
 
 (define-module (guix build-system node)
   #:use-module (guix store)
-  #:use-module (guix build json)
-  #:use-module (guix build union)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix derivations)
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 2bb6fa87ca..9f3159a960 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -105,8 +105,7 @@ pre-defined variants."
 
      ;; Otherwise build the new package object graph.
      ((eq? (package-build-system p) python-build-system)
-      (package
-        (inherit p)
+      (package/inherit p
         (location (package-location p))
         (name (let ((name (package-name p)))
                 (string-append new-prefix
@@ -138,8 +137,7 @@ pre-defined variants."
 
 (define (strip-python2-variant p)
   "Remove the 'python2-variant' property from P."
-  (package
-    (inherit p)
+  (package/inherit p
     (properties (alist-delete 'python2-variant (package-properties p)))))
 
 (define* (lower name
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index 1d21b33895..0a95672b00 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
-;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
 ;;;
@@ -73,6 +73,44 @@ Cargo.toml file present at its root."
                                             " | cut -d/ -f2"
                                             " | grep -q '^Cargo.toml$'")))))
 
+(define* (unpack-rust-crates #:key inputs vendor-dir #:allow-other-keys)
+  (define (inputs->rust-inputs inputs)
+    "Filter using the label part from INPUTS."
+    (filter (lambda (input)
+              (match input
+                ((name . _) (rust-package? name))))
+            inputs))
+  (define (inputs->directories inputs)
+    "Extract the directory part from INPUTS."
+    (match inputs
+      (((names . directories) ...)
+       directories)))
+
+  (let ((rust-inputs (inputs->directories (inputs->rust-inputs inputs))))
+    (unless (null? rust-inputs)
+      (mkdir-p "target/package")
+      (mkdir-p vendor-dir)
+      ;; TODO: copy only regular inputs to target/package, not native-inputs.
+      (for-each
+        (lambda (input-crate)
+          (for-each
+            (lambda (packaged-crate)
+              (unless
+                (file-exists?
+                  (string-append "target/package/" (basename packaged-crate)))
+                (install-file packaged-crate "target/package/")))
+            (find-files
+              (string-append input-crate "/share/cargo/registry") "\\.crate$")))
+        (delete-duplicates rust-inputs))
+
+      (for-each (lambda (crate)
+                  (invoke "tar" "xzf" crate "-C" vendor-dir))
+                (find-files "target/package" "\\.crate$"))))
+  #t)
+
+(define (rust-package? name)
+  (string-prefix? "rust-" name))
+
 (define* (configure #:key inputs
                     (vendor-dir "guix-vendor")
                     #:allow-other-keys)
@@ -170,9 +208,27 @@ directory = '" port)
       (apply invoke "cargo" "test" cargo-test-flags)
       #t))
 
-(define* (install #:key inputs outputs skip-build? features #:allow-other-keys)
+(define* (package #:key
+                  install-source?
+                  (cargo-package-flags '("--no-metadata" "--no-verify"))
+                  #:allow-other-keys)
+  "Run 'cargo-package' for a given Cargo package."
+  (if install-source?
+    (apply invoke `("cargo" "package" ,@cargo-package-flags))
+    (format #t "Not installing cargo sources, skipping `cargo package`.~%"))
+  #t)
+
+(define* (install #:key
+                  inputs
+                  outputs
+                  skip-build?
+                  install-source?
+                  features
+                  #:allow-other-keys)
   "Install a given Cargo package."
-  (let* ((out (assoc-ref outputs "out")))
+  (let* ((out      (assoc-ref outputs "out"))
+         (registry (string-append out "/share/cargo/registry"))
+         (sources  (string-append out "/share/cargo/src")))
     (mkdir-p out)
 
     ;; Make cargo reuse all the artifacts we just built instead
@@ -186,6 +242,18 @@ directory = '" port)
         (invoke "cargo" "install" "--no-track" "--path" "." "--root" out
                 "--features" (string-join features)))
 
+    (when install-source?
+      ;; Install crate tarballs and unpacked sources for later use.
+      ;; TODO: Is there a better format/directory for these files?
+      (mkdir-p sources)
+      (for-each (lambda (crate)
+                  (install-file crate registry))
+                (find-files "target/package" "\\.crate$"))
+
+      (for-each (lambda (crate)
+                  (invoke "tar" "xzf" crate "-C" sources))
+                (find-files registry "\\.crate$")))
+
     #t))
 
 (define %standard-phases
@@ -195,6 +263,8 @@ directory = '" port)
     (replace 'build build)
     (replace 'check check)
     (replace 'install install)
+    (add-after 'build 'package package)
+    (add-after 'unpack 'unpack-rust-crates unpack-rust-crates)
     (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums)))
 
 (define* (cargo-build #:key inputs (phases %standard-phases)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 46af149b2f..a22d4064ca 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -28,7 +28,6 @@
   #:use-module (guix build utils)
   #:use-module (guix progress)
   #:use-module (rnrs io ports)
-  #:use-module ((ice-9 binary-ports) #:select (unget-bytevector))
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -306,14 +305,22 @@ host name without trailing dot."
 
     (let ((record (session-record-port session)))
       (define (read! bv start count)
-        (define read-bv (get-bytevector-some record))
-        (if (eof-object? read-bv)
-            0  ; read! returns 0 on eof-object
-            (let ((read-bv-len (bytevector-length read-bv)))
-              (bytevector-copy! read-bv 0 bv start (min read-bv-len count))
-              (when (< count read-bv-len)
-                (unget-bytevector record bv count (- read-bv-len count)))
-              read-bv-len)))
+        (define read
+          (catch 'gnutls-error
+            (lambda ()
+              (get-bytevector-n! record bv start count))
+            (lambda (key err proc . rest)
+              ;; When responding to "Connection: close" requests, some
+              ;; servers close the connection abruptly after sending the
+              ;; response body, without doing a proper TLS connection
+              ;; termination.  Treat it as EOF.
+              (if (eq? err error/premature-termination)
+                  the-eof-object
+                  (apply throw key err proc rest)))))
+
+        (if (eof-object? read)
+            0
+            read))
       (define (write! bv start count)
         (put-bytevector record bv start count)
         (force-output record)
@@ -328,17 +335,24 @@ host name without trailing dot."
         (unless (port-closed? record)
           (close-port record)))
 
+      (define (unbuffered port)
+        (setvbuf port 'none)
+        port)
+
       (setvbuf record 'block)
 
       ;; Return a port that wraps RECORD to ensure that closing it also
       ;; closes PORT, the actual socket port, and its file descriptor.
+      ;; Make sure it does not introduce extra buffering (custom ports
+      ;; are buffered by default as of Guile 3.0.5).
       ;; XXX: This wrapper would be unnecessary if GnuTLS could
       ;; automatically close SESSION's file descriptor when RECORD is
       ;; closed, but that doesn't seem to be possible currently (as of
       ;; 3.6.9).
-      (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
-                                            get-position set-position!
-                                            close))))
+      (unbuffered
+       (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
+                                             get-position set-position!
+                                             close)))))
 
 (define (ensure-uri uri-or-string)                ;XXX: copied from (web http)
   (cond
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 552343a481..8886fc0fb9 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -82,6 +83,21 @@
             file-system-fragment-size
             file-system-mount-flags
             statfs
+
+            ST_RDONLY
+            ST_NOSUID
+            ST_NODEV
+            ST_NOEXEC
+            ST_SYNCHRONOUS
+            ST_MANDLOCK
+            ST_WRITE
+            ST_APPEND
+            ST_IMMUTABLE
+            ST_NOATIME
+            ST_NODIRATIME
+            ST_RELATIME
+            statfs-flags->mount-flags
+
             free-disk-space
             device-in-use?
             add-to-entropy-count
@@ -621,8 +637,9 @@ current process."
           (if (eof-object? line)
               (reverse result)
               (match (string-tokenize line)
+                ;; See the proc(5) man page for a description of the columns.
                 ((id parent-id major:minor root mount-point
-                     options _ type source _ ...)
+                     options _ ... "-" type source _)
                  (let ((devno (string->device-number major:minor)))
                    (loop (cons (%mount (octal-decode source)
                                        (octal-decode mount-point)
@@ -754,6 +771,56 @@ fdatasync(2) on the underlying file descriptor."
 (define-syntax fsword                             ;fsword_t
   (identifier-syntax long))
 
+(define linux? (string-contains %host-type "linux-gnu"))
+
+(define-syntax define-statfs-flags
+  (syntax-rules (linux hurd)
+    "Define the statfs mount flags."
+    ((_ (name (linux linux-value) (hurd hurd-value)) rest ...)
+     (begin
+       (define name
+         (if linux? linux-value hurd-value))
+       (define-statfs-flags rest ...)))
+    ((_ (name value) rest ...)
+     (begin
+       (define name value)
+       (define-statfs-flags rest ...)))
+    ((_) #t)))
+
+(define-statfs-flags                              ;<bits/statfs.h>
+  (ST_RDONLY      1)
+  (ST_NOSUID      2)
+  (ST_NODEV       (linux 4) (hurd 0))
+  (ST_NOEXEC      8)
+  (ST_SYNCHRONOUS 16)
+  (ST_MANDLOCK    (linux 64) (hurd 0))
+  (ST_WRITE       (linux 128) (hurd 0))
+  (ST_APPEND      (linux 256) (hurd 0))
+  (ST_IMMUTABLE   (linux 512) (hurd 0))
+  (ST_NOATIME     (linux 1024) (hurd 32))
+  (ST_NODIRATIME  (linux 2048) (hurd 0))
+  (ST_RELATIME    (linux 4096) (hurd 64)))
+
+(define (statfs-flags->mount-flags flags)
+  "Convert FLAGS, a logical or of ST_* constants as returned by
+'file-system-mount-flags', to the corresponding logical or of MS_* constants."
+  (letrec-syntax ((match-flags (syntax-rules (=>)
+                                 ((_ (statfs => mount) rest ...)
+                                  (logior (if (zero? (logand flags statfs))
+                                              0
+                                              mount)
+                                          (match-flags rest ...)))
+                                 ((_)
+                                  0))))
+    (match-flags
+     (ST_RDONLY     => MS_RDONLY)
+     (ST_NOSUID     => MS_NOSUID)
+     (ST_NODEV      => MS_NODEV)
+     (ST_NOEXEC     => MS_NOEXEC)
+     (ST_NOATIME    => MS_NOATIME)
+     (ST_NODIRATIME => 0)                         ;FIXME
+     (ST_RELATIME   => MS_RELATIME))))
+
 (define-c-struct %statfs                          ;<bits/statfs.h>
   sizeof-statfs                                   ;slightly overestimated
   file-system
@@ -769,7 +836,7 @@ fdatasync(2) on the underlying file descriptor."
   (identifier       (array int 2))
   (name-length      fsword)
   (fragment-size    fsword)
-  (mount-flags      fsword)
+  (mount-flags      fsword)                       ;ST_*
   (spare            (array fsword 4)))
 
 (define statfs
@@ -876,7 +943,11 @@ backend device."
 ;;;
 
 ;; From <uapi/linux/random.h>.
-(define RNDADDTOENTCNT #x40045201)
+(define RNDADDTOENTCNT
+  ;; Avoid using %current-system here to avoid depending on host-side code.
+  (if (string-prefix? "powerpc64le" %host-type)
+      #x80045201
+      #x40045201))
 
 (define (add-to-entropy-count port-or-fd n)
   "Add N to the kernel's entropy count (the value that can be read from
@@ -955,6 +1026,7 @@ Turning finalization off shuts down the finalization thread as a side effect."
                        ("mips64" 5055)
                        ("armv7l" 120)
                        ("aarch64" 220)
+                       ("ppc64le" 120)
                        (_ #f))))
     (lambda (flags)
       "Create a new child process by duplicating the current parent process.
diff --git a/guix/channels.scm b/guix/channels.scm
index 05226e766b..b812c1b6e5 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -86,6 +86,7 @@
             latest-channel-instances
             checkout->channel-instance
             latest-channel-derivation
+            channel-instance->sexp
             channel-instances->manifest
             %channel-profile-hooks
             channel-instances->derivation
@@ -948,6 +949,7 @@ does not have the expected structure."
                       (#f name)
                       (('name name) name)))
               (url url)
+              (branch branch)
               (commit commit)
               (introduction
                (match (assq 'introduction rest)
diff --git a/guix/download.scm b/guix/download.scm
index 579996f090..30f69c0325 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -27,7 +27,7 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix store)
-  #:use-module ((guix build download) #:prefix build:)
+  #:autoload   (guix build download) (url-fetch)
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix utils)
@@ -35,7 +35,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%mirrors
-            url-fetch
+            (url-fetch* . url-fetch)
             url-fetch/executable
             url-fetch/tarbomb
             url-fetch/zipbomb
@@ -449,11 +449,11 @@ download by itself using its own dependencies."
                     ;; for that built-in is widespread.
                     #:local-build? #t)))
 
-(define* (url-fetch url hash-algo hash
-                    #:optional name
-                    #:key (system (%current-system))
-                    (guile (default-guile))
-                    executable?)
+(define* (url-fetch* url hash-algo hash
+                     #:optional name
+                     #:key (system (%current-system))
+                     (guile (default-guile))
+                     executable?)
   "Return a fixed-output derivation that fetches data from URL (a string, or a
 list of strings denoting alternate URLs), which is expected to have hash HASH
 of type HASH-ALGO (a symbol).  By default, the file name is the base name of
@@ -499,10 +499,10 @@ name in the store."
                                #:key (system (%current-system))
                                (guile (default-guile)))
   "Like 'url-fetch', but make the downloaded file executable."
-  (url-fetch url hash-algo hash name
-             #:system system
-             #:guile guile
-             #:executable? #t))
+  (url-fetch* url hash-algo hash name
+              #:system system
+              #:guile guile
+              #:executable? #t))
 
 (define* (url-fetch/tarbomb url hash-algo hash
                             #:optional name
@@ -521,11 +521,11 @@ own.  This helper makes it easier to deal with \"tar bombs\"."
   (define tar
     (module-ref (resolve-interface '(gnu packages base)) 'tar))
 
-  (mlet %store-monad ((drv (url-fetch url hash-algo hash
-                                      (string-append "tarbomb-"
-                                                     (or name file-name))
-                                      #:system system
-                                      #:guile guile))
+  (mlet %store-monad ((drv (url-fetch* url hash-algo hash
+                                       (string-append "tarbomb-"
+                                                      (or name file-name))
+                                       #:system system
+                                       #:guile guile))
                       (guile (package->derivation guile system)))
     ;; Take the tar bomb, and simply unpack it as a directory.
     ;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on
@@ -559,11 +559,11 @@ own.  This helper makes it easier to deal with \"zip bombs\"."
   (define unzip
     (module-ref (resolve-interface '(gnu packages compression)) 'unzip))
 
-  (mlet %store-monad ((drv (url-fetch url hash-algo hash
-                                      (string-append "zipbomb-"
-                                                     (or name file-name))
-                                      #:system system
-                                      #:guile guile))
+  (mlet %store-monad ((drv (url-fetch* url hash-algo hash
+                                       (string-append "zipbomb-"
+                                                      (or name file-name))
+                                       #:system system
+                                       #:guile guile))
                       (guile (package->derivation guile system)))
     ;; Take the zip bomb, and simply unpack it as a directory.
     ;; Use ungrafted unzip so that the resulting tarball doesn't depend on
@@ -598,10 +598,9 @@ whether or not to validate HTTPS server certificates."
        (lambda (temp port)
          (let ((result
                 (parameterize ((current-output-port log))
-                  (build:url-fetch url temp
-                                   #:mirrors %mirrors
-                                   #:verify-certificate?
-                                   verify-certificate?))))
+                  (url-fetch url temp
+                             #:mirrors %mirrors
+                             #:verify-certificate? verify-certificate?))))
            (close port)
            (and result
                 (add-to-store store name recursive? "sha256" temp)))))))
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 8e575e3b5f..425184717a 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@@ -27,7 +27,14 @@
   #:use-module (guix packages)
   #:use-module (guix modules)
   #:autoload   (guix build-system gnu) (standard-packages)
-  #:use-module (git)
+  #:autoload   (git repository) (repository-open
+                                 repository-close!
+                                 repository-discover
+                                 repository-head
+                                 repository-working-directory)
+  #:autoload   (git commit)     (commit-lookup commit-tree)
+  #:autoload   (git reference)  (reference-target)
+  #:autoload   (git tree)       (tree-list)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 0da6fc19b6..031a899a6c 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (rnrs io ports)
   #:use-module (system foreign)
   #:use-module (guix http-client)
@@ -37,7 +38,8 @@
   #:use-module (guix records)
   #:use-module (guix upstream)
   #:use-module (guix packages)
-  #:use-module (zlib)
+  #:autoload   (zlib) (call-with-gzip-input-port)
+  #:autoload   (htmlprag) (html->sxml)            ;from Guile-Lib
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
@@ -65,7 +67,8 @@
             %gnu-ftp-updater
             %savannah-updater
             %xorg-updater
-            %kernel.org-updater))
+            %kernel.org-updater
+            %generic-html-updater))
 
 ;;; Commentary:
 ;;;
@@ -238,7 +241,8 @@ network to check in GNU's database."
   ;; The .zip extensions is notably used for freefont-ttf.
   ;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz".
   ;; The "-gnu[0-9]" pattern is for "icecat-38.4.0-gnu1.tar.bz2".
-  (make-regexp "^([^.]+)-([0-9]|[^-])+(-(src|gnu[0-9]))?\\.(tar\\.|zip$)"))
+  ;; Accept underscores as in "PKG_1.2.tar.gz" for some non-GNU packages.
+  (make-regexp "^([^.]+)[-_]([0-9]|[^-])+(-(src|gnu[0-9]))?\\.(tar\\.|zip$)"))
 
 (define %alpha-tarball-rx
   (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|RC|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
@@ -246,7 +250,9 @@ network to check in GNU's database."
 (define (release-file? project file)
   "Return #f if FILE is not a release tarball of PROJECT, otherwise return
 true."
-  (and (not (member (file-extension file) '("sig" "sign" "asc")))
+  (and (not (member (file-extension file)
+                    '("sig" "sign" "asc"
+                      "md5sum" "sha1sum" "sha256sum")))
        (and=> (regexp-exec %tarball-rx file)
               (lambda (match)
                 ;; Filter out unrelated files, like `guile-www-1.1.1'.
@@ -322,16 +328,11 @@ name/directory pairs."
                              #:key
                              (server "ftp.gnu.org")
                              (directory (string-append "/gnu/" project))
-                             (keep-file? (const #t))
-                             (file->signature (cut string-append <> ".sig"))
-                             (ftp-open ftp-open) (ftp-close ftp-close))
+                             (file->signature (cut string-append <> ".sig")))
   "Return an <upstream-source> for the latest release of PROJECT on SERVER
 under DIRECTORY, or #f.  Use FTP-OPEN and FTP-CLOSE to open (resp. close) FTP
 connections; this can be useful to reuse connections.
 
-KEEP-FILE? is a predicate to decide whether to enter a directory and to
-consider a given file (source tarball) as a valid candidate based on its name.
-
 FILE->SIGNATURE must be a procedure; it is passed a source file URL and must
 return the corresponding signature URL, or #f it signatures are unavailable."
   (define (latest a b)
@@ -345,7 +346,7 @@ return the corresponding signature URL, or #f it signatures are unavailable."
     ;; Return #t for patch directory names such as 'bash-4.2-patches'.
     (cut string-suffix? "patches" <>))
 
-  (define conn (ftp-open server))
+  (define conn (ftp-open server #:timeout 5))
 
   (define (file->url directory file)
     (string-append "ftp://" server directory "/" file))
@@ -389,7 +390,6 @@ return the corresponding signature URL, or #f it signatures are unavailable."
            (releases (filter-map (match-lambda
                                    ((file 'file . _)
                                     (and (release-file? project file)
-                                         (keep-file? file)
                                          (file->source directory file)))
                                    (_ #f))
                                  entries)))
@@ -447,18 +447,6 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
 ;;; Latest HTTP release.
 ;;;
 
-(define (html->sxml port)
-  "Read HTML from PORT and return the corresponding SXML tree."
-  (let ((str (get-string-all port)))
-    (catch #t
-      (lambda ()
-        ;; XXX: This is the poor developer's HTML-to-XML converter.  It's good
-        ;; enough for directory listings at <https://kernel.org/pub> but if
-        ;; needed we could resort to (htmlprag) from Guile-Lib.
-        (call-with-input-string (string-replace-substring str "<hr>" "<hr />")
-          xml->sxml))
-      (const '(html)))))                          ;parse error
-
 (define (html-links sxml)
   "Return the list of links found in SXML, the SXML tree of an HTML page."
   (let loop ((sxml sxml)
@@ -479,33 +467,47 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
                               #:key
                               (base-url "https://kernel.org/pub")
                               (directory (string-append "/" package))
-                              (file->signature (cut string-append <> ".sig")))
+                              file->signature)
   "Return an <upstream-source> for the latest release of PACKAGE (a string) on
 SERVER under DIRECTORY, or #f.  BASE-URL should be the URL of an HTML page,
 typically a directory listing as found on 'https://kernel.org/pub'.
 
-FILE->SIGNATURE must be a procedure; it is passed a source file URL and must
-return the corresponding signature URL, or #f it signatures are unavailable."
-  (let* ((uri  (string->uri (string-append base-url directory "/")))
-         (port (http-fetch/cached uri #:ttl 3600))
-         (sxml (html->sxml port)))
+When FILE->SIGNATURE is omitted or #f, guess the detached signature file name,
+if any.  Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
+file URL and must return the corresponding signature URL, or #f it signatures
+are unavailable."
+  (let* ((uri   (string->uri (if (string-null? directory)
+                                 base-url
+                                 (string-append base-url directory "/"))))
+         (port  (http-fetch/cached uri #:ttl 3600))
+         (sxml  (html->sxml port))
+         (links (delete-duplicates (html-links sxml))))
+    (define (file->signature/guess url)
+      (let ((base (basename url)))
+        (any (lambda (link)
+               (any (lambda (extension)
+                      (and (string=? (string-append base extension)
+                                     (basename link))
+                           (string-append url extension)))
+                    '(".asc" ".sig" ".sign")))
+             links)))
+
     (define (url->release url)
-      (and (string=? url (basename url))          ;relative reference?
-           (release-file? package url)
-           (let-values (((name version)
-                         (package-name->name+version
-                          (tarball-sans-extension url)
-                          #\-)))
-             (upstream-source
-              (package name)
-              (version version)
-              (urls (list (string-append base-url directory "/" url)))
-              (signature-urls
-               (list (file->signature
-                      (string-append base-url directory "/" url))))))))
+      (let* ((base (basename url))
+             (url  (if (string=? base url)
+                       (string-append base-url directory "/" url)
+                       url)))
+        (and (release-file? package base)
+             (let ((version (tarball->version base)))
+               (upstream-source
+                (package package)
+                (version version)
+                (urls (list url))
+                (signature-urls
+                 (list ((or file->signature file->signature/guess) url))))))))
 
     (define candidates
-      (filter-map url->release (html-links sxml)))
+      (filter-map url->release links))
 
     (close-port port)
     (match candidates
@@ -593,7 +595,7 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
   ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed.
-  (make-regexp "^(.*)-(([0-9]|\\.)+)(-src)?"))
+  (make-regexp "^(.*)[-_](([0-9]|\\.)+)(-src)?"))
 
 (define (gnu-package-name->name+version name+version)
   "Return the package name and version number extracted from NAME+VERSION."
@@ -608,11 +610,12 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
 (define (pure-gnu-package? package)
   "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package.  This
 excludes AucTeX, for instance, whose releases are now uploaded to
-elpa.gnu.org, and all the GNOME packages; EMMS is included though, because its
-releases are on gnu.org."
+elpa.gnu.org, GNU Radio, which has releases at www.gnuradio.org, and all the
+GNOME packages; EMMS is included though, because its releases are on gnu.org."
   (and (or (not (string-prefix? "emacs-" (package-name package)))
            (gnu-hosted? package))
        (not (gnome-package? package))
+       (not (string-prefix? "gnuradio" (package-name package)))
        (gnu-package? package)))
 
 (define gnu-hosted?
@@ -621,7 +624,7 @@ releases are on gnu.org."
 (define (url-prefix-rewrite old new)
   "Return a one-argument procedure that rewrites URL prefix OLD to NEW."
   (lambda (url)
-    (if (string-prefix? old url)
+    (if (and url (string-prefix? old url))
         (string-append new (string-drop url (string-length old)))
         url)))
 
@@ -653,9 +656,8 @@ releases are on gnu.org."
          (directory (dirname (uri-path uri)))
          (rewrite   (url-prefix-rewrite %savannah-base
                                         "mirror://savannah")))
-    ;; Note: We use the default 'file->signature', which adds ".sig", but not
-    ;; all projects on Savannah follow that convention: some use ".asc" and
-    ;; perhaps some lack signatures altogether.
+    ;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
+    ;; or whichever detached signature naming scheme PACKAGE uses.
     (and=> (latest-html-release package
                                 #:base-url %savannah-base
                                 #:directory directory)
@@ -695,6 +697,55 @@ releases are on gnu.org."
                                 #:file->signature file->signature)
            (cut adjusted-upstream-source <> rewrite))))
 
+(define html-updatable-package?
+  ;; Return true if the given package may be handled by the generic HTML
+  ;; updater.
+  (let ((hosting-sites '("github.com" "github.io" "gitlab.com"
+                         "notabug.org" "sr.ht"
+                         "gforge.inria.fr" "gitlab.inria.fr"
+                         "ftp.gnu.org" "download.savannah.gnu.org"
+                         "pypi.org" "crates.io" "rubygems.org"
+                         "bioconductor.org")))
+    (url-predicate (lambda (url)
+                     (match (string->uri url)
+                       (#f #f)
+                       (uri
+                        (let ((scheme (uri-scheme uri))
+                              (host   (uri-host uri)))
+                          (and (memq scheme '(http https))
+                               (not (member host hosting-sites))))))))))
+
+(define (latest-html-updatable-release package)
+  "Return the latest release of PACKAGE.  Do that by crawling the HTML page of
+the directory containing its source tarball."
+  (let* ((uri       (string->uri
+                     (match (origin-uri (package-source package))
+                       ((? string? url) url)
+                       ((url _ ...) url))))
+         (custom    (assoc-ref (package-properties package)
+                               'release-monitoring-url))
+         (base      (or custom
+                        (string-append (symbol->string (uri-scheme uri))
+                                       "://" (uri-host uri))))
+         (directory (if custom
+                        ""
+                        (dirname (uri-path uri))))
+         (package   (package-upstream-name package)))
+    (catch #t
+      (lambda ()
+        (guard (c ((http-get-error? c) #f))
+          (latest-html-release package
+                               #:base-url base
+                               #:directory directory)))
+      (lambda (key . args)
+        ;; Return false and move on upon connection failures and bogus HTTP
+        ;; servers.
+        (unless (memq key '(gnutls-error tls-certificate-error
+                                         system-error
+                                         bad-header bad-header-component))
+          (apply throw key args))
+        #f))))
+
 (define %gnu-updater
   ;; This is for everything at ftp.gnu.org.
   (upstream-updater
@@ -735,4 +786,11 @@ releases are on gnu.org."
    (pred (url-prefix-predicate "mirror://kernel.org/"))
    (latest latest-kernel.org-release)))
 
+(define %generic-html-updater
+  (upstream-updater
+   (name 'generic-html)
+   (description "Updater that crawls HTML pages.")
+   (pred html-updatable-package?)
+   (latest latest-html-updatable-release)))
+
 ;;; gnu-maintenance.scm ends here
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 2d7458a56e..4b4c14ed0b 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -79,6 +79,7 @@
                      (keep-alive? #f)
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
+                     (log-port (current-error-port))
                      timeout)
   "Return an input port containing the data at URI, and the expected number of
 bytes available or #f.  If TEXT? is true, the data at URI is considered to be
@@ -94,6 +95,8 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
 TIMEOUT specifies the timeout in seconds for connection establishment; when
 TIMEOUT is #f, connection establishment never times out.
 
+Write information about redirects to LOG-PORT.
+
 Raise an '&http-get-error' condition if downloading fails."
   (let loop ((uri (if (string? uri)
                       (string->uri uri)
@@ -128,7 +131,7 @@ Raise an '&http-get-error' condition if downloading fails."
             308)                                  ; permanent redirection
            (let ((uri (resolve-uri-reference (response-location resp) uri)))
              (close-port port)
-             (format (current-error-port) (G_ "following redirection to `~a'...~%")
+             (format log-port (G_ "following redirection to `~a'...~%")
                      (uri->string uri))
              (loop uri)))
           (else
@@ -276,6 +279,7 @@ returning."
 (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
                             (write-cache dump-port)
                             (cache-miss (const #t))
+                            (log-port (current-error-port))
                             (timeout 10))
   "Like 'http-fetch', return an input port, but cache its contents in
 ~/.cache/guix.  The cache remains valid for TTL seconds.
@@ -284,7 +288,9 @@ Call WRITE-CACHE with the HTTP input port and the cache output port to write
 the data to cache.  Call CACHE-MISS with URI just before fetching data from
 URI.
 
-TIMEOUT specifies the timeout in seconds for connection establishment."
+TIMEOUT specifies the timeout in seconds for connection establishment.
+
+Write information about redirects to LOG-PORT."
   (let ((file (cache-file-for-uri uri)))
     (define (update-cache cache-port)
       (define cache-time
@@ -306,6 +312,7 @@ TIMEOUT specifies the timeout in seconds for connection establishment."
                        cache-port)
                      (raise c))))
         (let ((port (http-fetch uri #:text? text?
+                                #:log-port log-port
                                 #:headers headers #:timeout timeout)))
           (cache-miss uri)
           (mkdir-p (dirname file))
diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 436ec88ef9..43966c1028 100644
--- a/guix/import/gnome.scm
+++ b/guix/import/gnome.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,8 +64,9 @@ not be determined."
     (match (string-tokenize version %not-dot)
       (((= string->number major) (= string->number minor) . rest)
        (and minor (even? minor)))
-      (_
-       #t)))                                      ;cross fingers
+      (((= string->number major) . _)
+       ;; It should at last start with a digit.
+       major)))
 
   (define upstream-name
     ;; Some packages like "NetworkManager" have camel-case names.
@@ -82,7 +83,10 @@ not be determined."
 
                   ;; ftp.gnome.org supports 'if-Modified-Since', so the local
                   ;; cache can expire early.
-                  #:ttl (* 60 10)))
+                  #:ttl (* 60 10)
+
+                  ;; Hide messages about URL redirects.
+                  #:log-port (%make-void-port "w")))
            (json (json->scm port)))
       (close-port port)
       (match json
diff --git a/guix/import/go.scm b/guix/import/go.scm
new file mode 100644
index 0000000000..7452b4c903
--- /dev/null
+++ b/guix/import/go.scm
@@ -0,0 +1,547 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
+;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
+;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 go)
+  #:use-module (guix build-system go)
+  #:use-module (guix git)
+  #:use-module (guix i18n)
+  #:use-module (guix diagnostics)
+  #:use-module (guix import utils)
+  #:use-module (guix import json)
+  #:use-module (guix packages)
+  #:use-module ((guix utils) #:select (string-replace-substring))
+  #:use-module (guix http-client)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix memoization)
+  #:autoload   (htmlprag) (html->sxml)            ;from Guile-Lib
+  #:autoload   (guix git) (update-cached-checkout)
+  #:autoload   (gcrypt hash) (open-hash-port hash-algorithm sha256)
+  #:autoload   (guix serialization) (write-file)
+  #:autoload   (guix base32) (bytevector->nix-base32-string)
+  #:autoload   (guix build utils) (mkdir-p)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module ((rnrs io ports) #:select (call-with-port))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (sxml xpath)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:use-module (web uri)
+
+  #:export (go-path-escape
+            go-module->guix-package
+            go-module-recursive-import))
+
+;;; Commentary:
+;;;
+;;; (guix import go) attempts to make it easier to create Guix package
+;;; declarations for Go modules.
+;;;
+;;; Modules in Go are a "collection of related Go packages" which are "the
+;;; unit of source code interchange and versioning".  Modules are generally
+;;; hosted in a repository.
+;;;
+;;; At this point it should handle correctly modules which have only Go
+;;; dependencies and are accessible from proxy.golang.org (or configured via
+;;; GOPROXY).
+;;;
+;;; We want it to work more or less this way:
+;;; - get latest version for the module from GOPROXY
+;;; - infer VCS root repo from which we will check-out source by
+;;;   + recognising known patterns (like github.com)
+;;;   + or recognizing .vcs suffix
+;;;   + or parsing meta tag in HTML served at the URL
+;;;   + or (TODO) if nothing else works by using zip file served by GOPROXY
+;;; - get go.mod from GOPROXY (which is able to synthetize one if needed)
+;;; - extract list of dependencies from this go.mod
+;;;
+;;; The Go module paths are translated to a Guix package name under the
+;;; assumption that there will be no collision.
+
+;;; TODO list
+;;; - get correct hash in vcs->origin
+;;; - print partial result during recursive imports (need to catch
+;;;   exceptions)
+
+;;; Code:
+
+(define (go-path-escape path)
+  "Escape a module path by replacing every uppercase letter with an
+exclamation mark followed with its lowercase equivalent, as per the module
+Escaped Paths specification (see:
+https://godoc.org/golang.org/x/mod/module#hdr-Escaped_Paths)."
+  (define (escape occurrence)
+    (string-append "!" (string-downcase (match:substring occurrence))))
+  (regexp-substitute/global #f "[A-Z]" path 'pre escape 'post))
+
+(define (go-module-latest-version goproxy-url module-path)
+  "Fetch the version number of the latest version for MODULE-PATH from the
+given GOPROXY-URL server."
+  (assoc-ref (json-fetch (format #f "~a/~a/@latest" goproxy-url
+                                 (go-path-escape module-path)))
+             "Version"))
+
+
+(define (go-package-licenses name)
+  "Retrieve the list of licenses that apply to NAME, a Go package or module
+name (e.g. \"github.com/golang/protobuf/proto\").  The data is scraped from
+the https://pkg.go.dev/ web site."
+  (let*-values (((url) (string-append "https://pkg.go.dev/" name
+                                      "?tab=licenses"))
+                ((response body) (http-get url))
+                ;; Extract the text contained in a h2 child node of any
+                ;; element marked with a "License" class attribute.
+                ((select) (sxpath `(// (* (@ (equal? (class "License"))))
+                                       h2 // *text*))))
+    (and (eq? (response-code response) 200)
+         (match (select (html->sxml body))
+           (() #f)                      ;nothing selected
+           (licenses licenses)))))
+
+(define (go.pkg.dev-info name)
+  (http-get (string-append "https://pkg.go.dev/" name)))
+(define go.pkg.dev-info*
+  (memoize go.pkg.dev-info))
+
+(define (go-package-description name)
+  "Retrieve a short description for NAME, a Go package name,
+e.g. \"google.golang.org/protobuf/proto\".  The data is scraped from the
+https://pkg.go.dev/ web site."
+  (let*-values (((response body) (go.pkg.dev-info* name))
+                ;; Extract the text contained in a h2 child node of any
+                ;; element marked with a "License" class attribute.
+                ((select) (sxpath
+                           `(// (section
+                                 (@ (equal? (class "Documentation-overview"))))
+                                (p 1)))))
+    (and (eq? (response-code response) 200)
+         (match (select (html->sxml body))
+           (() #f)                      ;nothing selected
+           (((p . strings))
+            ;; The paragraph text is returned as a list of strings embedding
+            ;; newline characters.  Join them and strip the newline
+            ;; characters.
+            (string-delete #\newline (string-join strings)))))))
+
+(define (go-package-synopsis module-name)
+  "Retrieve a short synopsis for a Go module named MODULE-NAME,
+e.g. \"google.golang.org/protobuf\".  The data is scraped from
+the https://pkg.go.dev/ web site."
+  ;; Note: Only the *module* (rather than package) page has the README title
+  ;; used as a synopsis on the https://pkg.go.dev web site.
+  (let*-values (((response body) (go.pkg.dev-info* module-name))
+                ;; Extract the text contained in a h2 child node of any
+                ;; element marked with a "License" class attribute.
+                ((select) (sxpath
+                           `(// (div (@ (equal? (class "UnitReadme-content"))))
+                                // h3 *text*))))
+    (and (eq? (response-code response) 200)
+         (match (select (html->sxml body))
+           (() #f)                      ;nothing selected
+           ((title more ...)            ;title is the first string of the list
+            (string-trim-both title))))))
+
+(define (list->licenses licenses)
+  "Given a list of LICENSES mostly following the SPDX conventions, return the
+corresponding Guix license or 'unknown-license!"
+  (filter-map (lambda (license)
+                (and (not (string-null? license))
+                     (not (any (cut string=? <> license)
+                               '("AND" "OR" "WITH")))
+                     ;; Adjust the license names scraped from
+                     ;; https://pkg.go.dev to an equivalent SPDX identifier,
+                     ;; if they differ (see: https://github.com/golang/pkgsite
+                     ;; /internal/licenses/licenses.go#L174).
+                     (or (spdx-string->license
+                          (match license
+                            ("BlueOak-1.0" "BlueOak-1.0.0")
+                            ("BSD-0-Clause" "0BSD")
+                            ("BSD-2-Clause" "BSD-2-Clause-FreeBSD")
+                            ("GPL2" "GPL-2.0")
+                            ("GPL3" "GPL-3.0")
+                            ("NIST" "NIST-PD")
+                            (_ license)))
+                         'unknown-license!)))
+              licenses))
+
+(define (fetch-go.mod goproxy-url module-path version)
+  "Fetches go.mod from the given GOPROXY-URL server for the given MODULE-PATH
+and VERSION."
+  (let ((url (format #f "~a/~a/@v/~a.mod" goproxy-url
+                     (go-path-escape module-path)
+                     (go-path-escape version))))
+    (http-fetch url)))
+
+(define %go.mod-require-directive-rx
+  ;; A line in a require directive is composed of a module path and
+  ;; a version separated by whitespace and an optionnal '//' comment at
+  ;; the end.
+  (make-regexp
+   (string-append
+    "^[[:blank:]]*"
+    "([^[:blank:]]+)[[:blank:]]+([^[:blank:]]+)"
+    "([[:blank:]]+//.*)?")))
+
+(define %go.mod-replace-directive-rx
+  ;; ReplaceSpec = ModulePath [ Version ] "=>" FilePath newline
+  ;;             | ModulePath [ Version ] "=>" ModulePath Version newline .
+  (make-regexp
+   (string-append
+    "([^[:blank:]]+)([[:blank:]]+([^[:blank:]]+))?"
+    "[[:blank:]]+" "=>" "[[:blank:]]+"
+    "([^[:blank:]]+)([[:blank:]]+([^[:blank:]]+))?")))
+
+(define (parse-go.mod port)
+  "Parse the go.mod file accessible via the input PORT, returning a list of
+requirements."
+  (define-record-type <results>
+    (make-results requirements replacements)
+    results?
+    (requirements results-requirements)
+    (replacements results-replacements))
+  ;; We parse only a subset of https://golang.org/ref/mod#go-mod-file-grammar
+  ;; which we think necessary for our use case.
+  (define (toplevel results)
+    "Main parser, RESULTS is a pair of alist serving as accumulator for
+     all encountered requirements and replacements."
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)
+        ;; parsing ended, give back the result
+        results)
+       ((string=? line "require (")
+        ;; a require block begins, delegate parsing to IN-REQUIRE
+        (in-require results))
+       ((string=? line "replace (")
+        ;; a replace block begins, delegate parsing to IN-REPLACE
+        (in-replace results))
+       ((string-prefix? "require " line)
+        ;; a standalone require directive
+        (let* ((stripped-line (string-drop line 8))
+               (new-results (require-directive results stripped-line)))
+          (toplevel new-results)))
+       ((string-prefix? "replace " line)
+        ;; a standalone replace directive
+        (let* ((stripped-line (string-drop line 8))
+               (new-results (replace-directive results stripped-line)))
+          (toplevel new-results)))
+       (#t
+        ;; unrecognised line, ignore silently
+        (toplevel results)))))
+
+  (define (in-require results)
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)
+        ;; this should never happen here but we ignore silently
+        results)
+       ((string=? line ")")
+        ;; end of block, coming back to toplevel
+        (toplevel results))
+       (#t
+        (in-require (require-directive results line))))))
+
+  (define (in-replace results)
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)
+        ;; this should never happen here but we ignore silently
+        results)
+       ((string=? line ")")
+        ;; end of block, coming back to toplevel
+        (toplevel results))
+       (#t
+        (in-replace (replace-directive results line))))))
+
+  (define (replace-directive results line)
+    "Extract replaced modules and new requirements from replace directive
+    in LINE and add to RESULTS."
+    (match results
+      (($ <results> requirements replaced)
+       (let* ((rx-match (regexp-exec %go.mod-replace-directive-rx line))
+              (module-path (match:substring rx-match 1))
+              (version (match:substring rx-match 3))
+              (new-module-path (match:substring rx-match 4))
+              (new-version (match:substring rx-match 6))
+              (new-replaced (alist-cons module-path version replaced))
+              (new-requirements
+               (if (string-match "^\\.?\\./" new-module-path)
+                   requirements
+                   (alist-cons new-module-path new-version requirements))))
+         (make-results new-requirements new-replaced)))))
+  (define (require-directive results line)
+    "Extract requirement from LINE and add it to RESULTS."
+    (let* ((rx-match (regexp-exec %go.mod-require-directive-rx line))
+           (module-path (match:substring rx-match 1))
+           ;; we saw double-quoted string in the wild without escape
+           ;; sequences so we just trim the quotes
+           (module-path (string-trim-both module-path #\"))
+           (version (match:substring rx-match 2)))
+      (match results
+        (($ <results> requirements replaced)
+         (make-results (alist-cons module-path version requirements) replaced)))))
+
+  (let ((results (toplevel (make-results '() '()))))
+    (match results
+      (($ <results> requirements replaced)
+       ;; At last we remove replaced modules from the requirements list
+       (fold
+        (lambda (replacedelem requirements)
+          (alist-delete! (car replacedelem) requirements))
+        requirements
+        replaced)))))
+
+;; Prevent inlining of this procedure, which is accessed by unit tests.
+(set! parse-go.mod parse-go.mod)
+
+(define-record-type <vcs>
+  (%make-vcs url-prefix root-regex type)
+  vcs?
+  (url-prefix vcs-url-prefix)
+  (root-regex vcs-root-regex)
+  (type vcs-type))
+(define (make-vcs prefix regexp type)
+    (%make-vcs prefix (make-regexp regexp) type))
+(define known-vcs
+  ;; See the following URL for the official Go equivalent:
+  ;; https://github.com/golang/go/blob/846dce9d05f19a1f53465e62a304dea21b99f910/src/cmd/go/internal/vcs/vcs.go#L1026-L1087
+    (list
+     (make-vcs
+      "github.com"
+      "^(github\\.com/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+      'git)
+     (make-vcs
+      "bitbucket.org"
+      "^(bitbucket\\.org/([A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+))(/[A-Za-z0-9_.\\-]+)*$"
+      'unknown)
+     (make-vcs
+      "hub.jazz.net/git/"
+      "^(hub\\.jazz\\.net/git/[a-z0-9]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+      'git)
+     (make-vcs
+      "git.apache.org"
+      "^(git\\.apache\\.org/[a-z0-9_.\\-]+\\.git)(/[A-Za-z0-9_.\\-]+)*$"
+      'git)
+     (make-vcs
+      "git.openstack.org"
+      "^(git\\.openstack\\.org/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(\\.git)?\
+(/[A-Za-z0-9_.\\-]+)*$"
+      'git)))
+
+(define (module-path->repository-root module-path)
+  "Infer the repository root from a module path.  Go modules can be
+defined at any level of a repository tree, but querying for the meta tag
+usually can only be done from the web page at the root of the repository,
+hence the need to derive this information."
+
+  ;; For reference, see: https://golang.org/ref/mod#vcs-find.
+  (define vcs-qualifiers '(".bzr" ".fossil" ".git" ".hg" ".svn"))
+
+  (define (vcs-qualified-module-path->root-repo-url module-path)
+    (let* ((vcs-qualifiers-group (string-join vcs-qualifiers "|"))
+           (pattern (format #f "^(.*(~a))(/|$)" vcs-qualifiers-group))
+           (m (string-match pattern module-path)))
+      (and=> m (cut match:substring <> 1))))
+
+  (or (and=> (find (lambda (vcs)
+                     (string-prefix? (vcs-url-prefix vcs) module-path))
+                   known-vcs)
+             (lambda (vcs)
+               (match:substring (regexp-exec (vcs-root-regex vcs)
+                                             module-path) 1)))
+      (vcs-qualified-module-path->root-repo-url module-path)
+      module-path))
+
+(define (go-module->guix-package-name module-path)
+  "Converts a module's path to the canonical Guix format for Go packages."
+  (string-downcase (string-append "go-" (string-replace-substring
+                                         (string-replace-substring
+                                          module-path
+                                          "." "-")
+                                         "/" "-"))))
+
+(define-record-type <module-meta>
+  (make-module-meta import-prefix vcs repo-root)
+  module-meta?
+  (import-prefix module-meta-import-prefix)
+  (vcs module-meta-vcs)                 ;a symbol
+  (repo-root module-meta-repo-root))
+
+(define (fetch-module-meta-data module-path)
+  "Retrieve the module meta-data from its landing page.  This is necessary
+because goproxy servers don't currently provide all the information needed to
+build a package."
+  ;; <meta name="go-import" content="import-prefix vcs repo-root">
+  (let* ((port (http-fetch (format #f "https://~a?go-get=1" module-path)))
+         (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
+                              // content))))
+    (match (select (call-with-port port html->sxml))
+      (() #f)                         ;nothing selected
+      (((content content-text))
+       (match (string-split content-text #\space)
+         ((root-path vcs repo-url)
+          (make-module-meta root-path (string->symbol vcs) repo-url)))))))
+
+(define (module-meta-data-repo-url meta-data goproxy-url)
+  "Return the URL where the fetcher which will be used can download the
+source."
+  (if (member (module-meta-vcs meta-data) '(fossil mod))
+      goproxy-url
+      (module-meta-repo-root meta-data)))
+
+;; XXX: Copied from (guix scripts hash).
+(define (vcs-file? file stat)
+  (case (stat:type stat)
+    ((directory)
+     (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+    ((regular)
+     ;; Git sub-modules have a '.git' file that is a regular text file.
+     (string=? (basename file) ".git"))
+    (else
+     #f)))
+
+;; XXX: Adapted from 'file-hash' in (guix scripts hash).
+(define* (file-hash file #:optional (algorithm (hash-algorithm sha256)))
+  ;; Compute the hash of FILE.
+  (let-values (((port get-hash) (open-hash-port algorithm)))
+    (write-file file port #:select? (negate vcs-file?))
+    (force-output port)
+    (get-hash)))
+
+(define* (git-checkout-hash url reference algorithm)
+  "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
+tag."
+  (define cache
+    (string-append (or (getenv "TMPDIR") "/tmp")
+                   "/guix-import-go-"
+                   (passwd:name (getpwuid (getuid)))))
+
+  ;; Use a custom cache to avoid cluttering the default one under
+  ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
+  ;; subsequent "guix import" invocations.
+  (mkdir-p cache)
+  (chmod cache #o700)
+  (let-values (((checkout commit _)
+                (parameterize ((%repository-cache-directory cache))
+                  (update-cached-checkout url
+                                          #:ref
+                                          `(tag-or-commit . ,reference)))))
+    (file-hash checkout algorithm)))
+
+(define (vcs->origin vcs-type vcs-repo-url version)
+  "Generate the `origin' block of a package depending on what type of source
+control system is being used."
+  (case vcs-type
+    ((git)
+     (let ((plain-version? (string=? version (go-version->git-ref version)))
+           (v-prefixed?    (string-prefix? "v" version)))
+       `(origin
+          (method git-fetch)
+          (uri (git-reference
+                (url ,vcs-repo-url)
+                (commit ,(if (and plain-version? v-prefixed?)
+                             '(string-append "v" version)
+                             '(go-version->git-ref version)))))
+          (file-name (git-file-name name version))
+          (sha256
+           (base32
+            ,(bytevector->nix-base32-string
+              (git-checkout-hash vcs-repo-url (go-version->git-ref version)
+                                 (hash-algorithm sha256))))))))
+    ((hg)
+     `(origin
+        (method hg-fetch)
+        (uri (hg-reference
+              (url ,vcs-repo-url)
+              (changeset ,version)))
+        (file-name (string-append name "-" version "-checkout"))
+        (sha256
+         (base32
+          ;; FIXME: populate hash for hg repo checkout
+          "0000000000000000000000000000000000000000000000000000"))))
+    ((svn)
+     `(origin
+        (method svn-fetch)
+        (uri (svn-reference
+              (url ,vcs-repo-url)
+              (revision (string->number version))))
+        (file-name (string-append name "-" version "-checkout"))
+        (sha256
+         (base32
+          ;; FIXME: populate hash for svn repo checkout
+          "0000000000000000000000000000000000000000000000000000"))))
+    (else
+     (raise
+      (formatted-message (G_ "unsupported vcs type '~a' for package '~a'")
+                         vcs-type vcs-repo-url)))))
+
+(define* (go-module->guix-package module-path #:key
+                                  (goproxy-url "https://proxy.golang.org"))
+  (let* ((latest-version (go-module-latest-version goproxy-url module-path))
+         (port (fetch-go.mod goproxy-url module-path latest-version))
+         (dependencies (map car (call-with-port port parse-go.mod)))
+         (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
+         ;; this we need to fetch it from the official module page.
+         (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-url))
+         (synopsis (go-package-synopsis root-module-path))
+         (description (go-package-description module-path))
+         (licenses (go-package-licenses module-path)))
+    (values
+     `(package
+        (name ,guix-name)
+        ;; Elide the "v" prefix Go uses
+        (version ,(string-trim latest-version #\v))
+        (source
+         ,(vcs->origin vcs-type vcs-repo-url latest-version))
+        (build-system go-build-system)
+        (arguments
+         '(#:import-path ,root-module-path))
+        ,@(maybe-inputs (map go-module->guix-package-name dependencies))
+        (home-page ,(format #f "https://~a" root-module-path))
+        (synopsis ,synopsis)
+        (description ,description)
+        (license ,(match (and=> licenses list->licenses)
+                    ((license) license)
+                    ((licenses ...) `(list ,@licenses))
+                    (x x))))
+     dependencies)))
+
+(define go-module->guix-package* (memoize go-module->guix-package))
+
+(define* (go-module-recursive-import package-name
+                                     #:key (goproxy-url "https://proxy.golang.org"))
+  (recursive-import
+   package-name
+   #:repo->guix-package (lambda* (name . _)
+                          (go-module->guix-package*
+                           name
+                           #:goproxy-url goproxy-url))
+   #:guix-name go-module->guix-package-name))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 2f5ccf7cea..64d1385164 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -136,6 +136,7 @@ of the string VERSION is replaced by the symbol 'version."
     ("Apache-1.1"                  'license:asl1.1)
     ("Apache-2.0"                  'license:asl2.0)
     ("BSL-1.0"                     'license:boost1.0)
+    ("0BSD"                        'license:bsd-0)
     ("BSD-2-Clause-FreeBSD"        'license:bsd-2)
     ("BSD-3-Clause"                'license:bsd-3)
     ("BSD-4-Clause"                'license:bsd-4)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 0990696e6c..eb457f81f9 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -120,6 +120,15 @@
   (packages inferior-package-promise)            ;promise of inferior packages
   (table    inferior-package-table))             ;promise of vhash
 
+(define (write-inferior inferior port)
+  (match inferior
+    (($ <inferior> pid _ _ version)
+     (format port "#<inferior ~a ~a ~a>"
+             pid version
+             (number->string (object-address inferior) 16)))))
+
+(set-record-type-printer! <inferior> write-inferior)
+
 (define* (inferior-pipe directory command error-port)
   "Return an input/output pipe on the Guix instance in DIRECTORY.  This runs
 'DIRECTORY/COMMAND repl' if it exists, or falls back to some other method if
@@ -740,8 +749,16 @@ determines whether CHANNELS are authenticated."
            (string-append directory "/" file))
          (scandir directory base32-encoded-sha256?)))
 
+  (define (symlink/safe old new)
+    (catch 'system-error
+      (lambda ()
+        (symlink old new))
+      (lambda args
+        (unless (= EEXIST (system-error-errno args))
+          (apply throw args)))))
+
   (define symlink*
-    (lift2 symlink %store-monad))
+    (lift2 symlink/safe %store-monad))
 
   (define add-indirect-root*
     (store-lift add-indirect-root))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 1091eee67c..0a36067387 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -39,7 +39,7 @@
             apsl2
             asl1.1 asl2.0
             boost1.0
-            bsd-2 bsd-3 bsd-4
+            bsd-0 bsd-2 bsd-3 bsd-4
             non-copyleft
             cc0
             cc-by2.0 cc-by3.0 cc-by4.0
@@ -159,6 +159,11 @@
            "http://directory.fsf.org/wiki/License:Boost1.0"
            "https://www.gnu.org/licenses/license-list#boost"))
 
+(define bsd-0
+  (license "Zero-Clause BSD"
+           "https://spdx.org/licenses/0BSD.html"
+           "https://opensource.org/licenses/0BSD"))
+
 (define bsd-2
   (license "FreeBSD"
            "http://directory.fsf.org/wiki/License:FreeBSD"
diff --git a/guix/narinfo.scm b/guix/narinfo.scm
index 2d06124017..72e0f75fda 100644
--- a/guix/narinfo.scm
+++ b/guix/narinfo.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;;
@@ -297,9 +297,21 @@ this is a rough approximation."
     (_      (or (string=? compression2 "none")
                 (string=? compression2 "gzip")))))
 
-(define (narinfo-best-uri narinfo)
+(define (decompresses-faster? compression1 compression2)
+  "Return true if COMPRESSION1 generally has a higher decompression throughput
+than COMPRESSION2."
+  (match compression1
+    ("none" #t)
+    ("zstd" #t)
+    ("gzip" (string=? compression2 "lzip"))
+    (_      #f)))
+
+(define* (narinfo-best-uri narinfo #:key fast-decompression?)
   "Select the \"best\" URI to download NARINFO's nar, and return three values:
-the URI, its compression method (a string), and the compressed file size."
+the URI, its compression method (a string), and the compressed file size.
+When FAST-DECOMPRESSION? is true, prefer substitutes with faster
+decompression (typically zstd) rather than substitutes with a higher
+compression ratio (typically lzip)."
   (define choices
     (filter (match-lambda
               ((uri compression file-size)
@@ -321,6 +333,13 @@ the URI, its compression method (a string), and the compressed file size."
           (compresses-better? compression1 compression2))))
       (_ #f)))                                    ;we can't tell
 
-  (match (sort choices file-size<?)
+  (define (speed<? c1 c2)
+    (match c1
+      ((uri1 compression1 . _)
+       (match c2
+         ((uri2 compression2 . _)
+          (decompresses-faster? compression2 compression1))))))
+
+  (match (sort choices (if fast-decompression? (negate speed<?) file-size<?))
     (((uri compression file-size) _ ...)
      (values uri compression file-size))))
diff --git a/guix/packages.scm b/guix/packages.scm
index dd1d473fca..56173e1204 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -348,7 +349,8 @@ name of its URI."
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
   ;; expect all packages to build successfully here.
-  '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"))
+  '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"
+    "powerpc64le-linux"))
 
 (define %hurd-systems
   ;; The GNU/Hurd systems for which support is being developed.
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a959cb827d..fa1bbf867d 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
@@ -22,7 +22,7 @@
 (define-module (guix scripts build)
   #:use-module (guix ui)
   #:use-module (guix scripts)
-  #:use-module (guix import json)
+  #:autoload   (guix import json) (json->scheme-file)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 6f8d9aceec..be2279d254 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -28,7 +28,7 @@
   #:use-module (guix profiles)
   #:autoload   (guix openpgp) (openpgp-format-fingerprint)
   #:use-module (git)
-  #:use-module (json)
+  #:autoload   (json builder) (scm->json-string)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0a3863f965..1d2b45d942 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -77,7 +77,7 @@ rather than \\n."
 ;;;
 
 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
-                    "cran" "crate" "texlive" "json" "opam"))
+                    "go" "cran" "crate" "texlive" "json" "opam"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm
new file mode 100644
index 0000000000..afdba4e8f1
--- /dev/null
+++ b/guix/scripts/import/go.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@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 import go)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import go)
+  #:use-module (guix scripts import)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (guix-import-go))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import go PACKAGE-PATH
+Import and convert the Go module for PACKAGE-PATH.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (display (G_ "
+  -r, --recursive        generate package expressions for all Go modules\
+ that are not yet in Guix"))
+  (display (G_ "
+  -p, --goproxy=GOPROXY  specify which goproxy server to use"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix import go")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
+         (option '(#\p "goproxy") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'goproxy
+                               (string->symbol arg)
+                               (alist-delete 'goproxy result))))
+         %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-go . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold* args %options
+                (lambda (opt name arg result)
+                  (leave (G_ "~A: unrecognized option~%") name))
+                (lambda (arg result)
+                  (alist-cons 'argument arg result))
+                %default-options))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                             (('argument . value)
+                              value)
+                             (_ #f))
+                           (reverse opts))))
+    (match args
+      ((module-name)
+       (if (assoc-ref opts 'recursive)
+           (map (match-lambda
+                  ((and ('package ('name name) . rest) pkg)
+                   `(define-public ,(string->symbol name)
+                      ,pkg))
+                  (_ #f))
+                (go-module-recursive-import module-name
+                                            #:goproxy-url
+                                            (or (assoc-ref opts 'goproxy)
+                                                "https://proxy.golang.org")))
+           (let ((sexp (go-module->guix-package module-name
+                                                #:goproxy-url
+                                                (or (assoc-ref opts 'goproxy)
+                                                    "https://proxy.golang.org"))))
+             (unless sexp
+               (leave (G_ "failed to download meta-data for module '~a'~%")
+                      module-name))
+             sexp)))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fc5bf8137b..e3d40d5142 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -35,14 +35,15 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix search-paths)
-  #:use-module (guix import json)
+  #:autoload   (guix import json) (json->scheme-file)
   #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix transformations)
-  #:use-module (guix describe)
+  #:autoload   (guix describe) (manifest-entry-provenance
+                                manifest-entry-with-provenance)
   #:autoload   (guix channels) (channel-name channel-commit channel->code)
   #:autoload   (guix store roots) (gc-roots user-owned?)
   #:use-module ((guix build utils)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 5866b8bb0a..46323c7216 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -45,6 +45,7 @@
                 #:select (uri-abbreviation nar-uri-abbreviation
                           (open-connection-for-uri
                            . guix:open-connection-for-uri)))
+  #:autoload   (gnutls) (error/invalid-session)
   #:use-module (guix progress)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
@@ -257,6 +258,27 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
 ;;; Daemon/substituter protocol.
 ;;;
 
+(define %prefer-fast-decompression?
+  ;; Whether to prefer fast decompression over good compression ratios.  This
+  ;; serves in particular to choose between lzip (high compression ratio but
+  ;; low decompression throughput) and zstd (lower compression ratio but high
+  ;; decompression throughput).
+  #f)
+
+(define (call-with-cpu-usage-monitoring proc)
+  (let ((before (times)))
+    (proc)
+    (let ((after (times)))
+      (if (= (tms:clock after) (tms:clock before))
+          0
+          (/ (- (tms:utime after) (tms:utime before))
+             (- (tms:clock after) (tms:clock before))
+             1.)))))
+
+(define-syntax-rule (with-cpu-usage-monitoring exp ...)
+  "Evaluate EXP...  Return its CPU usage as a fraction between 0 and 1."
+  (call-with-cpu-usage-monitoring (lambda () exp ...)))
+
 (define (display-narinfo-data narinfo)
   "Write to the current output port the contents of NARINFO in the format
 expected by the daemon."
@@ -269,7 +291,10 @@ expected by the daemon."
   (for-each (cute format #t "~a/~a~%" (%store-prefix) <>)
             (narinfo-references narinfo))
 
-  (let-values (((uri compression file-size) (narinfo-best-uri narinfo)))
+  (let-values (((uri compression file-size)
+                (narinfo-best-uri narinfo
+                                  #:fast-decompression?
+                                  %prefer-fast-decompression?)))
     (format #t "~a\n~a\n"
             (or file-size 0)
             (or (narinfo-size narinfo) 0))))
@@ -288,12 +313,30 @@ authorized substitutes."
         (lambda (obj)
           (valid-narinfo? obj acl))))
 
+  (define* (make-progress-reporter total #:key url)
+    (define done 0)
+
+    (define (report-progress)
+      (erase-current-line (current-error-port)) ;erase current line
+      (force-output (current-error-port))
+      (format (current-error-port)
+              (G_ "updating substitutes from '~a'... ~5,1f%")
+              url (* 100. (/ done total)))
+      (set! done (+ 1 done)))
+
+    (progress-reporter
+     (start report-progress)
+     (report report-progress)
+     (stop (lambda ()
+             (newline (current-error-port))))))
+
   (match (string-tokenize command)
     (("have" paths ..1)
      ;; Return the subset of PATHS available in CACHE-URLS.
      (let ((substitutable (lookup-narinfos/diverse
                            cache-urls paths valid?
-                           #:open-connection open-connection-for-uri/cached)))
+                           #:open-connection open-connection-for-uri/cached
+                           #:make-progress-reporter make-progress-reporter)))
        (for-each (lambda (narinfo)
                    (format #t "~a~%" (narinfo-path narinfo)))
                  substitutable)
@@ -302,7 +345,8 @@ authorized substitutes."
      ;; Reply info about PATHS if it's in CACHE-URLS.
      (let ((substitutable (lookup-narinfos/diverse
                            cache-urls paths valid?
-                           #:open-connection open-connection-for-uri/cached)))
+                           #:open-connection open-connection-for-uri/cached
+                           #:make-progress-reporter make-progress-reporter)))
        (for-each display-narinfo-data substitutable)
        (newline)))
     (wtf
@@ -358,6 +402,32 @@ server certificates."
                     (drain-input socket)
                     socket))))))))
 
+(define (call-with-cached-connection uri proc)
+  (let ((port (open-connection-for-uri/cached uri
+                                              #:verify-certificate? #f)))
+    (catch #t
+      (lambda ()
+        (proc port))
+      (lambda (key . args)
+        ;; If PORT was cached and the server closed the connection in the
+        ;; meantime, we get EPIPE.  In that case, open a fresh connection
+        ;; and retry.  We might also get 'bad-response or a similar
+        ;; exception from (web response) later on, once we've sent the
+        ;; request, or a ERROR/INVALID-SESSION from GnuTLS.
+        (if (or (and (eq? key 'system-error)
+                     (= EPIPE (system-error-errno `(,key ,@args))))
+                (and (eq? key 'gnutls-error)
+                     (eq? (first args) error/invalid-session))
+                (memq key '(bad-response bad-header bad-header-component)))
+            (proc (open-connection-for-uri/cached uri
+                                                  #:verify-certificate? #f
+                                                  #:fresh? #t))
+            (apply throw key args))))))
+
+(define-syntax-rule (with-cached-connection uri port exp ...)
+  "Bind PORT with EXP... to a socket connected to URI."
+  (call-with-cached-connection uri (lambda (port) exp ...)))
+
 (define* (process-substitution store-item destination
                                #:key cache-urls acl
                                deduplicate? print-build-trace?)
@@ -402,14 +472,11 @@ the current output port."
              (warning (G_ "while fetching ~a: server is somewhat slow~%")
                       (uri->string uri))
              (warning (G_ "try `--no-substitutes' if the problem persists~%")))
-           (call-with-connection-error-handling
-            uri
-            (lambda ()
-              (http-fetch uri #:text? #f
-                          #:open-connection open-connection-for-uri/cached
-                          #:keep-alive? #t
-                          #:buffered? #f
-                          #:verify-certificate? #f))))))
+           (with-cached-connection uri port
+             (http-fetch uri #:text? #f
+                         #:port port
+                         #:keep-alive? #t
+                         #:buffered? #f)))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
@@ -419,7 +486,9 @@ the current output port."
            store-item))
 
   (let-values (((uri compression file-size)
-                (narinfo-best-uri narinfo)))
+                (narinfo-best-uri narinfo
+                                  #:fast-decompression?
+                                  %prefer-fast-decompression?)))
     (unless print-build-trace?
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
@@ -457,11 +526,28 @@ the current output port."
                   ((hashed get-hash)
                    (open-hash-input-port algorithm input)))
       ;; Unpack the Nar at INPUT into DESTINATION.
-      (restore-file hashed destination
-                    #:dump-file (if (and destination-in-store?
-                                         deduplicate?)
-                                    dump-file/deduplicate*
-                                    dump-file))
+      (define cpu-usage
+        (with-cpu-usage-monitoring
+         (restore-file hashed destination
+                       #:dump-file (if (and destination-in-store?
+                                            deduplicate?)
+                                       dump-file/deduplicate*
+                                       dump-file))))
+
+      ;; Create a hysteresis: depending on CPU usage, favor compression
+      ;; methods with faster decompression (like ztsd) or methods with better
+      ;; compression ratios (like lzip).  This stems from the observation that
+      ;; substitution can be CPU-bound when high-speed networks are used:
+      ;; <https://lists.gnu.org/archive/html/guix-devel/2020-12/msg00177.html>.
+      ;; To simulate "slow" networking or changing conditions, run:
+      ;;   sudo tc qdisc add dev eno1 root tbf rate 512kbit latency 50ms burst 1540
+      ;; and then cancel with:
+      ;;   sudo tc qdisc del dev eno1 root
+      (when (> cpu-usage .8)
+        (set! %prefer-fast-decompression? #t))
+      (when (< cpu-usage .2)
+        (set! %prefer-fast-decompression? #f))
+
       (close-port hashed)
       (close-port input)
 
@@ -696,6 +782,8 @@ if needed, as expected by the daemon's agent."
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
 ;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0)
+;;; eval: (put 'with-cached-connection 'scheme-indent-function 2)
+;;; eval: (put 'call-with-cached-connection 'scheme-indent-function 1)
 ;;; End:
 
 ;;; substitute.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e3cf99acc6..c226f08371 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -363,11 +364,14 @@ connection to the store."
   "Switch the system profile to the generation specified by SPEC, and
 re-install bootloader with a configuration file that uses the specified system
 generation as its default entry.  STORE is an open connection to the store."
-  (let ((number (relative-generation-spec->number %system-profile spec)))
+  (let* ((number (relative-generation-spec->number %system-profile spec))
+         (generation (generation-file-name %system-profile number))
+         (activate (string-append generation "/activate")))
     (if number
         (begin
           (reinstall-bootloader store number)
-          (switch-to-generation* %system-profile number))
+          (switch-to-generation* %system-profile number)
+          (unless-file-not-found (primitive-load activate)))
         (leave (G_ "cannot switch to system generation '~a'~%") spec))))
 
 (define* (system-bootloader-name #:optional (system %system-profile))
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 0d27414702..4aafd432e8 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -118,6 +119,10 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
   (let-values (((args command) (break (cut string=? "--" <>) args)))
     (let ((opts (parse-command-line args %options
                                     (list %default-options))))
+      (when (assoc-ref opts 'argument)
+        (leave (G_ "~A: extraneous argument~%")
+               (assoc-ref opts 'argument)))
+
       (match command
         (() opts)
         (("--") opts)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 9e94bff5a3..5164fe0494 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -117,8 +117,8 @@ values."
          (end    (current-time time-monotonic)))
     (apply kont (time-difference end start) result)))
 
-(define-syntax-rule (let/time ((time result exp)) body ...)
-  (call-with-time (lambda () exp) (lambda (time result) body ...)))
+(define-syntax-rule (let/time ((time result ... exp)) body ...)
+  (call-with-time (lambda () exp) (lambda (time result ...) body ...)))
 
 (define (histogram field proc seed lst)
   "Return an alist giving a histogram of all the values of FIELD for elements
@@ -181,7 +181,12 @@ Return the coverage ratio, an exact number between 0 and 1."
   (format #t (G_ "looking for ~h store items on ~a...~%")
           (length items) server)
 
-  (let/time ((time narinfos (lookup-narinfos server items)))
+  (let/time ((time narinfos requests-made
+                   (lookup-narinfos
+                    server items
+                    #:make-progress-reporter
+                    (lambda* (total #:key url #:allow-other-keys)
+                      (progress-reporter/bar total)))))
     (format #t "~a~%" server)
     (let ((obtained  (length narinfos))
           (requested (length items))
@@ -207,10 +212,11 @@ Return the coverage ratio, an exact number between 0 and 1."
                        total)))))
       (format #t (G_ "  ~,1h MiB on disk (uncompressed)~%")
               (/ (reduce + 0 (map narinfo-size narinfos)) MiB))
-      (format #t (G_ "  ~,3h seconds per request (~,1h seconds in total)~%")
-              (/ time requested 1.) time)
-      (format #t (G_ "  ~,1h requests per second~%")
-              (/ requested time 1.))
+      (when (> requests-made 0)
+        (format #t (G_ "  ~,3h seconds per request (~,1h seconds in total)~%")
+                (/ time requests-made 1.) time)
+        (format #t (G_ "  ~,1h requests per second~%")
+                (/ requests-made time 1.)))
 
       (guard (c ((http-get-error? c)
                  (if (= 404 (http-get-error-code c))
diff --git a/guix/self.scm b/guix/self.scm
index 35fba1152d..3154d180ac 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -56,6 +56,7 @@
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
       ("guile-semver"  (ref '(gnu packages guile-xyz) 'guile-semver))
+      ("guile-lib"  (ref '(gnu packages guile-xyz) 'guile-lib))
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
       ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
       ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
@@ -814,6 +815,9 @@ itself."
   (define guile-ssh
     (specification->package "guile-ssh"))
 
+  (define guile-lib
+    (specification->package "guile-lib"))
+
   (define guile-git
     (specification->package "guile-git"))
 
@@ -842,7 +846,7 @@ itself."
     (append-map transitive-package-dependencies
                 (list guile-gcrypt gnutls guile-git guile-avahi
                       guile-json guile-semver guile-ssh guile-sqlite3
-                      guile-zlib guile-lzlib guile-zstd)))
+                      guile-lib guile-zlib guile-lzlib guile-zstd)))
 
   (define *core-modules*
     (scheme-node "guix-core"
diff --git a/guix/status.scm b/guix/status.scm
index 9ca6d92470..d47bf1700c 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -23,8 +23,7 @@
   #:use-module (guix colors)
   #:use-module (guix progress)
   #:autoload   (guix build syscalls) (terminal-columns)
-  #:use-module ((guix build download)
-                #:select (nar-uri-abbreviation))
+  #:autoload   (guix build download) (nar-uri-abbreviation)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix memoization)
diff --git a/guix/substitutes.scm b/guix/substitutes.scm
index dc94ccc8e4..08f8c24efd 100644
--- a/guix/substitutes.scm
+++ b/guix/substitutes.scm
@@ -173,18 +173,14 @@ if file doesn't exist, and the narinfo otherwise."
           (apply throw args)))))
 
 (define* (fetch-narinfos url paths
-                         #:key (open-connection guix:open-connection-for-uri))
+                         #:key
+                         (open-connection guix:open-connection-for-uri)
+                         (make-progress-reporter
+                          (const progress-reporter/silent)))
   "Retrieve all the narinfos for PATHS from the cache at URL and return them."
-  (define update-progress!
-    (let ((done 0)
-          (total (length paths)))
-      (lambda ()
-        (display "\r\x1b[K" (current-error-port)) ;erase current line
-        (force-output (current-error-port))
-        (format (current-error-port)
-                (G_ "updating substitutes from '~a'... ~5,1f%")
-                url (* 100. (/ done total)))
-        (set! done (+ 1 done)))))
+  (define progress-reporter
+    (make-progress-reporter (length paths)
+                            #:url url))
 
   (define hash-part->path
     (let ((mapping (fold (lambda (path result)
@@ -206,7 +202,7 @@ if file doesn't exist, and the narinfo otherwise."
            (len    (response-content-length response))
            (cache  (response-cache-control response))
            (ttl    (and cache (assoc-ref cache 'max-age))))
-      (update-progress!)
+      (progress-reporter-report! progress-reporter)
 
       ;; Make sure to read no more than LEN bytes since subsequent bytes may
       ;; belong to the next response.
@@ -238,7 +234,7 @@ if file doesn't exist, and the narinfo otherwise."
        ;; narinfos, which provides a much stronger guarantee.
        (let* ((requests (map (cut narinfo-request url <>) paths))
               (result   (begin
-                          (update-progress!)
+                          (start-progress-reporter! progress-reporter)
                           (call-with-connection-error-handling
                            uri
                            (lambda ()
@@ -247,7 +243,7 @@ if file doesn't exist, and the narinfo otherwise."
                                                 requests
                                                 #:open-connection open-connection
                                                 #:verify-certificate? #f))))))
-         (newline (current-error-port))
+         (stop-progress-reporter! progress-reporter)
          result))
       ((file #f)
        (let* ((base  (string-append (uri-path uri) "/"))
@@ -297,7 +293,9 @@ for PATH."
       (values #f #f))))
 
 (define* (lookup-narinfos cache paths
-                          #:key (open-connection guix:open-connection-for-uri))
+                          #:key (open-connection guix:open-connection-for-uri)
+                          (make-progress-reporter
+                           (const progress-reporter/silent)))
   "Return the narinfos for PATHS, invoking the server at CACHE when no
 information is available locally."
   (let-values (((cached missing)
@@ -312,15 +310,20 @@ information is available locally."
                        '()
                        '()
                        paths)))
-    (if (null? missing)
-        cached
-        (let ((missing (fetch-narinfos cache missing
-                                       #:open-connection open-connection)))
-          (append cached (or missing '()))))))
+    (values (if (null? missing)
+                cached
+                (let ((missing (fetch-narinfos cache missing
+                                               #:open-connection open-connection
+                                               #:make-progress-reporter
+                                               make-progress-reporter)))
+                  (append cached (or missing '()))))
+            (length missing))))
 
 (define* (lookup-narinfos/diverse caches paths authorized?
                                   #:key (open-connection
-                                         guix:open-connection-for-uri))
+                                         guix:open-connection-for-uri)
+                                  (make-progress-reporter
+                                   (const progress-reporter/silent)))
   "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order.
 That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next
 cache, and so on.
@@ -353,7 +356,9 @@ AUTHORIZED? narinfo."
        (match caches
          ((cache rest ...)
           (let* ((narinfos (lookup-narinfos cache paths
-                                            #:open-connection open-connection))
+                                            #:open-connection open-connection
+                                            #:make-progress-reporter
+                                            make-progress-reporter))
                  (definite (map narinfo-path (filter authorized? narinfos)))
                  (missing  (lset-difference string=? paths definite))) ;XXX: perf
             (loop rest missing
diff --git a/guix/tests.scm b/guix/tests.scm
index 4c6c7d95db..da75835099 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -143,7 +143,7 @@ no external store to talk to."
       (lambda ()
         ;; Since we're using a different store we must clear the
         ;; package-derivation cache.
-        (hash-clear! (@@ (guix derivations) %derivation-cache))
+        (hash-clear! (@@ (guix packages) %derivation-cache))
 
         (proc store))
       (lambda ()
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
index 4119e9ce01..8f50eaefca 100644
--- a/guix/tests/http.scm
+++ b/guix/tests/http.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,12 +22,12 @@
   #:use-module (web server)
   #:use-module (web server http)
   #:use-module (web response)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 match)
   #:export (with-http-server
             call-with-http-server
             %http-server-port
-            http-server-can-listen?
             %local-url))
 
 ;;; Commentary:
@@ -37,12 +38,13 @@
 
 (define %http-server-port
   ;; TCP port to use for the stub HTTP server.
-  (make-parameter 9999))
+  ;; If 0, the OS will automatically choose
+  ;; a port.
+  (make-parameter 0))
 
 (define (open-http-server-socket)
-  "Return a listening socket for the web server.  It is useful to export it so
-that tests can check whether we succeeded opening the socket and tests skip if
-needed."
+  "Return a listening socket for the web server and the port
+actually listened at (in case %http-server-port was 0)."
   (catch 'system-error
     (lambda ()
       (let ((sock (socket PF_INET SOCK_STREAM 0)))
@@ -50,22 +52,18 @@ needed."
         (bind sock
               (make-socket-address AF_INET INADDR_LOOPBACK
                                    (%http-server-port)))
-        sock))
+        (values sock
+                (sockaddr:port (getsockname sock)))))
     (lambda args
       (let ((err (system-error-errno args)))
         (format (current-error-port)
                 "warning: cannot run Web server for tests: ~a~%"
                 (strerror err))
-        #f))))
-
-(define (http-server-can-listen?)
-  "Return #t if we managed to open a listening socket."
-  (and=> (open-http-server-socket)
-         (lambda (socket)
-           (close-port socket)
-           #t)))
+        (values #f #f)))))
 
 (define* (%local-url #:optional (port (%http-server-port)))
+  (when (= port 0)
+    (error "no web server is running!"))
   ;; URL to use for 'home-page' tests.
   (string-append "http://localhost:" (number->string port)
                  "/foo/bar"))
@@ -73,7 +71,10 @@ needed."
 (define* (call-with-http-server responses+data thunk)
   "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP
 requests.  Each element of RESPONSES+DATA must be a tuple containing a
-response and a string, or an HTTP response code and a string."
+response and a string, or an HTTP response code and a string.
+
+%http-server-port will be set to the port listened at
+The port listened at will be set for the dynamic extent of THUNK."
   (define responses
     (map (match-lambda
            (((? response? response) data)
@@ -100,6 +101,7 @@ response and a string, or an HTTP response code and a string."
   ;; Mutex and condition variable to synchronize with the HTTP server.
   (define %http-server-lock (make-mutex))
   (define %http-server-ready (make-condition-variable))
+  (define %http-real-server-port #f)
 
   (define (http-open . args)
     "Start listening for HTTP requests and signal %HTTP-SERVER-READY."
@@ -122,7 +124,8 @@ response and a string, or an HTTP response code and a string."
          (set! responses rest)
          (values response data))))
 
-    (let ((socket (open-http-server-socket)))
+    (let-values (((socket port) (open-http-server-socket)))
+      (set! %http-real-server-port port)
       (catch 'quit
         (lambda ()
           (run-server handle stub-http-server
@@ -134,7 +137,8 @@ response and a string, or an HTTP response code and a string."
     (let ((server (make-thread server-body)))
       (wait-condition-variable %http-server-ready %http-server-lock)
       ;; Normally SERVER exits automatically once it has received a request.
-      (thunk))))
+      (parameterize ((%http-server-port %http-real-server-port))
+        (thunk)))))
 
 (define-syntax with-http-server
   (syntax-rules ()
diff --git a/guix/utils.scm b/guix/utils.scm
index 96cd8c791e..7db9f52ff6 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -48,6 +49,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
+  #:autoload   (zlib) (make-zlib-input-port make-zlib-output-port)
   #:use-module (system foreign)
   #:re-export (<location>                         ;for backwards compatibility
                location
@@ -83,6 +85,7 @@
             target-arm32?
             target-aarch64?
             target-arm?
+            target-powerpc?
             target-64bit?
             cc-for-target
             cxx-for-target
@@ -234,8 +237,9 @@ a symbol such as 'xz."
   (match compression
     ((or #f 'none) (values input '()))
     ('bzip2        (filtered-port `(,%bzip2 "-dc") input))
-    ('xz           (filtered-port `(,%xz "-dc" ,@(%xz-parallel-args)) input))
-    ('gzip         (filtered-port `(,%gzip "-dc") input))
+    ('xz           (filtered-port `(,%xz "-dc") input))
+    ('gzip         (values (make-zlib-input-port input #:format 'gzip)
+                           '()))
     ('lzip         (values (lzip-port 'make-lzip-input-port input)
                            '()))
     ('zstd         (values (zstd-port 'make-zstd-input-port input)
@@ -307,9 +311,9 @@ program--e.g., '(\"--fast\")."
   (match compression
     ((or #f 'none) (values output '()))
     ('bzip2        (filtered-output-port `(,%bzip2 "-c" ,@options) output))
-    ('xz           (filtered-output-port `(,%xz "-c" ,@(%xz-parallel-args)
-                                                ,@options) output))
-    ('gzip         (filtered-output-port `(,%gzip "-c" ,@options) output))
+    ('xz           (filtered-output-port `(,%xz "-c" ,@options) output))
+    ('gzip         (values (make-zlib-output-port output #:format 'gzip)
+                           '()))
     ('lzip         (values (lzip-port 'make-lzip-output-port output)
                            '()))
     ('zstd         (values (zstd-port 'make-zstd-output-port output)
@@ -555,9 +559,13 @@ a character other than '@'."
                                              (%current-system))))
   (or (target-arm32? target) (target-aarch64? target)))
 
+(define* (target-powerpc? #:optional (target (or (%current-target-system)
+                                                 (%current-system))))
+  (string-prefix? "powerpc" target))
+
 (define* (target-64bit? #:optional (system (or (%current-target-system)
                                                (%current-system))))
-  (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64" "ppc64")))
+  (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64" "powerpc64")))
 
 (define* (cc-for-target #:optional (target (%current-target-system)))
   (if target