Merge remote-tracking branch 'origin/master' into staging

51 files changed, 1342 insertions, 1639 deletions

diff --git a/guix/android-repo-download.scm b/guix/android-repo-download.scm
new file mode 100644
index 0000000000..9d8937ddc0
--- /dev/null
+++ b/guix/android-repo-download.scm
@@ -0,0 +1,159 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.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 android-repo-download)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix records)
+  #:use-module (guix packages)
+  #:use-module (guix modules)
+  #:autoload   (guix build-system gnu) (standard-packages)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (android-repo-reference
+            android-repo-reference?
+            android-repo-reference-manifest-url
+            android-repo-reference-revision
+
+            android-repo-fetch
+            android-repo-version
+            android-repo-file-name))
+
+;;; Commentary:
+;;;
+;;; An <origin> method that fetches a specific commit from an Android repo
+;;; repository.
+;;; The repository's manifest (URL and revision) can be specified with a
+;;; <android-repo-reference> object.
+;;;
+;;; Code:
+
+(define-record-type* <android-repo-reference>
+  android-repo-reference make-android-repo-reference
+  android-repo-reference?
+  (manifest-url        android-repo-reference-manifest-url)
+  (manifest-revision   android-repo-reference-manifest-revision))
+
+(define (git-repo-package)
+  "Return the default git-repo package."
+  (let ((distro (resolve-interface '(gnu packages android))))
+    (module-ref distro 'git-repo)))
+
+(define* (android-repo-fetch ref hash-algo hash
+                             #:optional name
+                             #:key (system (%current-system))
+                             (guile (default-guile))
+                             (git-repo (git-repo-package)))
+  "Return a fixed-output derivation that fetches REF, an
+<android-repo-reference> object.  The output is expected to have recursive
+hash HASH of type HASH-ALGO (a symbol).  Use NAME as the file name, or a
+generic name if unset."
+  ;; TODO: Remove.
+  (define inputs
+    (standard-packages))
+
+  (define zlib
+    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
+
+  (define guile-json
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
+
+  (define gnutls
+    (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
+
+  (define config.scm
+    (scheme-file "config.scm"
+                 #~(begin
+                     (define-module (guix config)
+                       #:export (%libz))
+
+                     (define %libz
+                       #+(file-append zlib "/lib/libz")))))
+
+  (define modules
+    (cons `((guix config) => ,config.scm)
+          (delete '(guix config)
+                  (source-module-closure '((guix build android-repo)
+                                           (guix build utils)
+                                           (guix build download-nar))))))
+
+  (define build
+    (with-imported-modules modules
+      (with-extensions (list guile-json gnutls)   ;for (guix swh)
+        #~(begin
+            (use-modules (guix build android-repo)
+                         (guix build utils)
+                         (guix build download-nar)
+                         (ice-9 match))
+
+            ;; The 'git submodule' commands expects Coreutils, sed,
+            ;; grep, etc. to be in $PATH.
+            (set-path-environment-variable "PATH" '("bin")
+                                           (match '#+inputs
+                                             (((names dirs outputs ...) ...)
+                                              dirs)))
+
+            (setvbuf (current-output-port) 'line)
+            (setvbuf (current-error-port) 'line)
+
+            (or (android-repo-fetch (getenv "android-repo manifest-url")
+                                    (getenv "android-repo manifest-revision")
+                                    #$output
+                                    #:git-repo-command
+                                    (string-append #+git-repo "/bin/repo"))
+                (download-nar #$output))))))
+
+  (mlet %store-monad ((guile (package->derivation guile system)))
+    (gexp->derivation (or name "android-repo-checkout") build
+
+                      ;; Use environment variables and a fixed script name so
+                      ;; there's only one script in store for all the
+                      ;; downloads.
+                      #:script-name "android-repo-download"
+                      #:env-vars
+                      `(("android-repo manifest-url" .
+                         ,(android-repo-reference-manifest-url ref))
+                        ("android-repo manifest-revision" .
+                         ,(android-repo-reference-manifest-revision ref)))
+                      #:leaked-env-vars '("http_proxy" "https_proxy"
+                                          "LC_ALL" "LC_MESSAGES" "LANG"
+                                          "COLUMNS")
+                      #:system system
+                      #:local-build? #t           ;don't offload repo cloning
+                      #:hash-algo hash-algo
+                      #:hash hash
+                      #:recursive? #t
+                      #:guile-for-build guile)))
+
+(define (android-repo-version version revision)
+  "Return the version string for packages using android-repo-download."
+  (string-append version "-" (string-join (string-split revision #\/) "_")))
+
+(define (android-repo-file-name name version)
+  "Return the file-name for packages using android-repo-download."
+  (string-append name "-" version "-checkout"))
+
+
diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm
index ef6d1b3397..ac05ff420e 100644
--- a/guix/build-system/emacs.scm
+++ b/guix/build-system/emacs.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2020 Morgan Smith <Morgan.J.Smith@outlook.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -112,6 +113,7 @@
                     #:system ,system
                     #:test-command ,test-command
                     #:tests? ,tests?
+                    #:parallel-tests? ,parallel-tests?
                     #:phases ,phases
                     #:outputs %outputs
                     #:include ,include
diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index 1ec11c71d8..8304e3b222 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%haskell-build-system-modules
             haskell-build
@@ -67,7 +69,7 @@ version REVISION."
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:haskell #:cabal-revision #:inputs #:native-inputs))
+    '(#:target #:haskell #:cabal-revision #:inputs #:native-inputs #:outputs))
 
   (define (cabal-revision->origin cabal-revision)
     (match cabal-revision
@@ -95,9 +97,23 @@ version REVISION."
                         ,@(standard-packages)))
          (build-inputs `(("haskell" ,haskell)
                          ,@native-inputs))
-         (outputs outputs)
+         ;; XXX: this is a hack to get around issue #41569.
+         (outputs (match outputs
+                    (("out") (cons "static" outputs))
+                    (_ outputs)))
          (build haskell-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+         (arguments
+          (substitute-keyword-arguments
+              (strip-keyword-arguments private-keywords arguments)
+            ((#:extra-directories extra-directories)
+             `(list ,@(append-map
+                       (lambda (name)
+                         (match (assoc name inputs)
+                           ((_ pkg)
+                            (match (package-transitive-propagated-inputs pkg)
+                              (((propagated-names . _) ...)
+                               (cons name propagated-names))))))
+                       extra-directories))))))))
 
 (define* (haskell-build store name inputs
                         #:key source
@@ -105,10 +121,12 @@ version REVISION."
                         (haddock-flags ''())
                         (tests? #t)
                         (test-target "test")
+                        (parallel-build? #t)
                         (configure-flags ''())
+                        (extra-directories ''())
                         (phases '(@ (guix build haskell-build-system)
                                     %standard-phases))
-                        (outputs '("out"))
+                        (outputs '("out" "static"))
                         (search-paths '())
                         (system (%current-system))
                         (guile #f)
@@ -134,10 +152,12 @@ provides a 'Setup.hs' file as its build system."
                                            (derivation->output-path revision))
                                           (revision revision))
                       #:configure-flags ,configure-flags
+                      #:extra-directories ,extra-directories
                       #:haddock-flags ,haddock-flags
                       #:system ,system
                       #:test-target ,test-target
                       #:tests? ,tests?
+                      #:parallel-build? ,parallel-build?
                       #:haddock? ,haddock?
                       #:phases ,phases
                       #:outputs %outputs
diff --git a/guix/build/android-repo.scm b/guix/build/android-repo.scm
new file mode 100644
index 0000000000..db8c4d127b
--- /dev/null
+++ b/guix/build/android-repo.scm
@@ -0,0 +1,75 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.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 build android-repo)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-34)
+  #:use-module (ice-9 format)
+  #:export (android-repo-fetch))
+
+;;; Commentary:
+;;;
+;;; This is the build-side support code of (guix android-repo-download).
+;;; It allows a multirepository managed by the git-repo tool to be cloned and
+;;; checked out at a specific revision.
+;;;
+;;; Code:
+
+(define* (android-repo-fetch manifest-url manifest-revision directory
+                             #:key (git-repo-command "git-repo"))
+  "Fetch packages according to the manifest at MANIFEST-URL with
+MANIFEST-REVISION.  MANIFEST-REVISION must be either a revision
+or a branch.  Return #t on success, #f otherwise."
+
+  ;; Disable TLS certificate verification.  The hash of the checkout is known
+  ;; in advance anyway.
+  (setenv "GIT_SSL_NO_VERIFY" "true")
+
+  (mkdir-p directory)
+
+  (guard (c ((invoke-error? c)
+             (format (current-error-port)
+                     "android-repo-fetch: '~a~{ ~a~}' failed with exit code ~a~%"
+                     (invoke-error-program c)
+                     (invoke-error-arguments c)
+                     (or (invoke-error-exit-status c) ;XXX: not quite accurate
+                         (invoke-error-stop-signal c)
+                         (invoke-error-term-signal c)))
+             (delete-file-recursively directory)
+             #f))
+    (with-directory-excursion directory
+      (invoke git-repo-command "init" "-u" manifest-url "-b" manifest-revision
+              "--depth=1")
+      (invoke git-repo-command "sync" "-c" "--fail-fast" "-v" "-j"
+              (number->string (parallel-job-count)))
+
+      ;; Delete vendor/**/.git, system/**/.git, toolchain/**/.git,
+      ;; .repo/**/.git etc since they contain timestamps.
+      (for-each delete-file-recursively
+       (find-files "." "^\\.git$" #:directories? #t))
+
+      ;; Delete git state directories since they contain timestamps.
+      (for-each delete-file-recursively
+       (find-files ".repo" "^.*\\.git$" #:directories? #t))
+
+      ;; This file contains timestamps.
+      (delete-file ".repo/.repo_fetchtimes.json")
+      #t)))
+
+;;; android-repo.scm ends here
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 377e428341..867f3c10bb 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -20,7 +20,7 @@
   #:use-module (guix build download)
   #:use-module (guix build utils)
   #:use-module ((guix serialization) #:hide (dump-port*))
-  #:use-module (guix zlib)
+  #:autoload   (zlib) (call-with-gzip-input-port)
   #:use-module (guix progress)
   #:use-module (web uri)
   #:use-module (srfi srfi-11)
diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm
index 91f62138d0..28253ce2f0 100644
--- a/guix/build/haskell-build-system.scm
+++ b/guix/build/haskell-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
-;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -73,37 +73,35 @@ and parameters ~s~%"
         (error "no Setup.hs nor Setup.lhs found"))))
 
 (define* (configure #:key outputs inputs tests? (configure-flags '())
-                    #:allow-other-keys)
+                    (extra-directories '()) #:allow-other-keys)
   "Configure a given Haskell package."
   (let* ((out (assoc-ref outputs "out"))
          (doc (assoc-ref outputs "doc"))
          (lib (assoc-ref outputs "lib"))
-         (bin (assoc-ref outputs "bin"))
          (name-version (strip-store-file-name out))
-         (input-dirs (match inputs
-                       (((_ . dir) ...)
-                        dir)
-                       (_ '())))
+         (extra-dirs (filter-map (cut assoc-ref inputs <>) extra-directories))
          (ghc-path (getenv "GHC_PACKAGE_PATH"))
-         (params (append `(,(string-append "--prefix=" out))
-                         `(,(string-append "--libdir=" (or lib out) "/lib"))
-                         `(,(string-append "--bindir=" (or bin out) "/bin"))
-                         `(,(string-append
-                             "--docdir=" (or doc out)
-                             "/share/doc/" name-version))
-                         '("--libsubdir=$compiler/$pkg-$version")
-                         `(,(string-append "--package-db=" %tmp-db-dir))
-                         '("--global")
-                         `(,@(map
-                              (cut string-append "--extra-include-dirs=" <>)
-                              (search-path-as-list '("include") input-dirs)))
-                         `(,@(map
-                              (cut string-append "--extra-lib-dirs=" <>)
-                              (search-path-as-list '("lib") input-dirs)))
-                         (if tests?
-                             '("--enable-tests")
-                             '())
-                         configure-flags)))
+         (params `(,(string-append "--prefix=" out)
+                   ,(string-append "--libdir=" (or lib out) "/lib")
+                   ,(string-append "--docdir=" (or doc out)
+                                   "/share/doc/" name-version)
+                   "--libsubdir=$compiler/$pkg-$version"
+                   ,(string-append "--package-db=" %tmp-db-dir)
+                   "--global"
+                   ,@(map (cut string-append "--extra-include-dirs=" <>)
+                          (search-path-as-list '("include") extra-dirs))
+                   ,@(map (cut string-append "--extra-lib-dirs=" <>)
+                          (search-path-as-list '("lib") extra-dirs))
+                   ,@(if tests?
+                         '("--enable-tests")
+                         '())
+                   ;; Build and link with shared libraries
+                   "--enable-shared"
+                   "--enable-executable-dynamic"
+                   "--ghc-option=-fPIC"
+                   ,(string-append "--ghc-option=-optl=-Wl,-rpath=" (or lib out)
+                                   "/lib/$compiler/$pkg-$version")
+                   ,@configure-flags)))
     ;; Cabal errors if GHC_PACKAGE_PATH is set during 'configure', so unset
     ;; and restore it.
     (unsetenv "GHC_PACKAGE_PATH")
@@ -121,13 +119,27 @@ and parameters ~s~%"
     (setenv "GHC_PACKAGE_PATH" ghc-path)
     #t))
 
-(define* (build #:rest empty)
+(define* (build #:key parallel-build? #:allow-other-keys)
   "Build a given Haskell package."
-  (run-setuphs "build" '()))
+  (run-setuphs "build"
+               (if parallel-build?
+                   `(,(string-append "--ghc-option=-j" (number->string (parallel-job-count))))
+                   '())))
 
-(define* (install #:rest empty)
+(define* (install #:key outputs #:allow-other-keys)
   "Install a given Haskell package."
-  (run-setuphs "copy" '()))
+  (run-setuphs "copy" '())
+  (when (assoc-ref outputs "static")
+    (let ((static (assoc-ref outputs "static"))
+          (lib (or (assoc-ref outputs "lib")
+                   (assoc-ref outputs "out"))))
+      (for-each (lambda (static-lib)
+                  (let* ((subdir (string-drop static-lib (string-length lib)))
+                         (new    (string-append static subdir)))
+                    (mkdir-p (dirname new))
+                    (rename-file static-lib new)))
+                (find-files lib "\\.a$"))))
+  #t)
 
 (define (grep rx port)
   "Given a regular-expression RX including a group, read from PORT until the
@@ -227,9 +239,10 @@ given Haskell package."
              (loop seen tail))))))
 
   (let* ((out (assoc-ref outputs "out"))
+         (doc (assoc-ref outputs "doc"))
          (haskell  (assoc-ref inputs "haskell"))
          (name-verion (strip-store-file-name haskell))
-         (lib (string-append out "/lib"))
+         (lib (string-append (or (assoc-ref outputs "lib") out) "/lib"))
          (config-dir (string-append lib
                                     "/" name-verion
                                     "/" name ".conf.d"))
@@ -241,8 +254,25 @@ given Haskell package."
     ;; The conf file is created only when there is a library to register.
     (when (file-exists? config-file)
       (mkdir-p config-dir)
-      (let* ((config-file-name+id
-              (call-with-ascii-input-file config-file (cut grep id-rx <>))))
+      (let ((config-file-name+id
+             (call-with-ascii-input-file config-file (cut grep id-rx <>))))
+
+        ;; Remove reference to "doc" output from "lib" (or "out") by rewriting the
+        ;; "haddock-interfaces" field and removing the optional "haddock-html"
+        ;; field in the generated .conf file.
+        (when doc
+          (substitute* config-file
+            (("^haddock-html: .*") "\n")
+            (((format #f "^haddock-interfaces: ~a" doc))
+             (string-append "haddock-interfaces: " lib)))
+          ;; Move the referenced file to the "lib" (or "out") output.
+          (match (find-files doc "\\.haddock$")
+            ((haddock-file . rest)
+             (let* ((subdir (string-drop haddock-file (string-length doc)))
+                    (new    (string-append lib subdir)))
+               (mkdir-p (dirname new))
+               (rename-file haddock-file new)))
+            (_ #f)))
         (install-transitive-deps config-file %tmp-db-dir config-dir)
         (rename-file config-file
                      (string-append config-dir "/"
diff --git a/guix/channels.scm b/guix/channels.scm
index bbabf654a9..ad2442f50e 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -40,10 +40,6 @@
   #:use-module (guix sets)
   #:use-module (guix store)
   #:use-module (guix i18n)
-  #:use-module ((guix utils)
-                #:select (source-properties->location
-                          &error-location
-                          &fix-hint))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
@@ -382,16 +378,16 @@ their relation.  When AUTHENTICATE? is false, CHANNEL is not authenticated."
             ;; TODO: Warn for all the channels once the authentication interface
             ;; is public.
             (when (guix-channel? channel)
-              (raise (condition
-                      (&message
-                       (message (format #f (G_ "channel '~a' lacks an \
+              (raise (make-compound-condition
+                      (formatted-message (G_ "channel '~a' lacks an \
 introduction and cannot be authenticated~%")
-                                        (channel-name channel))))
-                      (&fix-hint
-                       (hint (G_ "Add the missing introduction to your
+                                         (channel-name channel))
+                      (condition
+                       (&fix-hint
+                        (hint (G_ "Add the missing introduction to your
 channels file to address the issue.  Alternatively, you can pass
 @option{--disable-authentication}, at the risk of running unauthenticated and
-thus potentially malicious code.")))))))
+thus potentially malicious code."))))))))
         (warning (G_ "channel authentication disabled~%")))
 
     (when (guix-channel? channel)
diff --git a/guix/config.scm.in b/guix/config.scm.in
index 0ada0f3c38..b2901735d8 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -33,8 +33,6 @@
             %config-directory
 
             %system
-            %libz
-            %liblz
             %gzip
             %bzip2
             %xz))
@@ -88,12 +86,6 @@
 (define %system
   "@guix_system@")
 
-(define %libz
-  "@LIBZ@")
-
-(define %liblz
-  "@LIBLZ@")
-
 (define %gzip
   "@GZIP@")
 
diff --git a/guix/cve.scm b/guix/cve.scm
index 7dd9005f09..ae9cca2341 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
   #:use-module (guix http-client)
   #:use-module (guix json)
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (json)
   #:use-module (web uri)
   #:use-module (srfi srfi-1)
@@ -194,15 +195,11 @@ records."
       (raise (condition (&message
                          (message "invalid CVE feed")))))
     (unless (equal? format "MITRE")
-      (raise (condition
-              (&message
-               (message (format #f (G_ "unsupported CVE format: '~a'")
-                                format))))))
+      (raise (formatted-message (G_ "unsupported CVE format: '~a'")
+                                format)))
     (unless (equal? version "4.0")
-      (raise (condition
-              (&message
-               (message (format #f (G_ "unsupported CVE data version: '~a'")
-                                version))))))
+      (raise (formatted-message (G_ "unsupported CVE data version: '~a'")
+                                version)))
 
     (map json->cve-item
          (vector->list (assoc-ref alist "CVE_Items")))))
diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index cb42103aae..76b3eac739 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <cvs-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build cvs)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build cvs)
+                                     (guix build download-nar)))))
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build cvs)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build cvs)
+                         (guix build download-nar))
 
-          (or (cvs-fetch '#$(cvs-reference-root-directory ref)
-                         '#$(cvs-reference-module ref)
-                         '#$(cvs-reference-revision ref)
-                         #$output
-                         #:cvs-command (string-append #+cvs "/bin/cvs"))
-              (download-nar #$output)))))
+            (or (cvs-fetch '#$(cvs-reference-root-directory ref)
+                           '#$(cvs-reference-module ref)
+                           '#$(cvs-reference-revision ref)
+                           #$output
+                           #:cvs-command (string-append #+cvs "/bin/cvs"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "cvs-checkout") build
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 7db61d272f..2fe684cc18 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -26,6 +26,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 binary-ports)
+  #:use-module ((ice-9 textual-ports) #:select (put-char put-string))
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -561,33 +562,65 @@ things as appropriate and is thus more efficient."
     ((prefix (... ...) last)
      (for-each (lambda (item)
                  (write-item item port)
-                 (display "," port))
+                 (put-char port #\,))
                prefix)
      (write-item last port))))
 
 (define-inlinable (write-list lst write-item port)
   ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
   ;; element.
-  (display "[" port)
+  (put-char port #\[)
   (write-sequence lst write-item port)
-  (display "]" port))
+  (put-char port #\]))
 
 (define-inlinable (write-tuple lst write-item port)
   ;; Same, but write LST as a tuple.
-  (display "(" port)
+  (put-char port #\()
   (write-sequence lst write-item port)
-  (display ")" port))
+  (put-char port #\)))
+
+(define %escape-char-set
+  ;; Characters that need to be escaped.
+  (char-set #\" #\\ #\newline #\return #\tab))
+
+(define (escaped-string str)
+  "Escape double quote characters found in STR, if any."
+  (define escape
+    (match-lambda
+      (#\"       "\\\"")
+      (#\\       "\\\\")
+      (#\newline "\\n")
+      (#\return  "\\r")
+      (#\tab     "\\t")))
+
+  (let loop ((str   str)
+             (result '()))
+    (let ((index (string-index str %escape-char-set)))
+      (if index
+          (let ((rest (string-drop str (+ 1 index))))
+            (loop rest
+                  (cons* (escape (string-ref str index))
+                         (string-take str index)
+                         result)))
+          (if (null? result)
+              str
+              (string-concatenate-reverse (cons str result)))))))
 
 (define (write-derivation drv port)
   "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
 Eelco Dolstra's PhD dissertation for an overview of a previous version of
 that form."
 
-  ;; Make sure we're using the faster implementation.
-  (define format simple-format)
+  ;; Use 'put-string', which does less work and is faster than 'display'.
+  ;; Likewise, 'write-escaped-string' is faster than 'write'.
+
+  (define (write-escaped-string str port)
+    (put-char port #\")
+    (put-string port (escaped-string str))
+    (put-char port #\"))
 
   (define (write-string-list lst)
-    (write-list lst write port))
+    (write-list lst write-escaped-string port))
 
   (define (write-output output port)
     (match output
@@ -599,48 +632,47 @@ that form."
                              "")
                          (or (and=> hash bytevector->base16-string)
                              ""))
-                   write
+                   write-escaped-string
                    port))))
 
   (define (write-input input port)
     (match input
       (($ <derivation-input> obj sub-drvs)
-       (display "(\"" port)
+       (put-string port "(\"")
 
        ;; 'derivation/masked-inputs' produces objects that contain a string
        ;; instead of a <derivation>, so we need to account for that.
-       (display (if (derivation? obj)
-                    (derivation-file-name obj)
-                    obj)
-                port)
-       (display "\"," port)
+       (put-string port (if (derivation? obj)
+                            (derivation-file-name obj)
+                            obj))
+       (put-string port "\",")
        (write-string-list sub-drvs)
-       (display ")" port))))
+       (put-char port #\)))))
 
   (define (write-env-var env-var port)
     (match env-var
       ((name . value)
-       (display "(" port)
-       (write name port)
-       (display "," port)
-       (write value port)
-       (display ")" port))))
+       (put-char port #\()
+       (write-escaped-string name port)
+       (put-char port #\,)
+       (write-escaped-string value port)
+       (put-char port #\)))))
 
   ;; Assume all the lists we are writing are already sorted.
   (match drv
     (($ <derivation> outputs inputs sources
         system builder args env-vars)
-     (display "Derive(" port)
+     (put-string port "Derive(")
      (write-list outputs write-output port)
-     (display "," port)
+     (put-char port #\,)
      (write-list inputs write-input port)
-     (display "," port)
+     (put-char port #\,)
      (write-string-list sources)
      (simple-format port ",\"~a\",\"~a\"," system builder)
      (write-string-list args)
-     (display "," port)
+     (put-char port #\,)
      (write-list env-vars write-env-var port)
-     (display ")" port))))
+     (put-char port #\)))))
 
 (define derivation->bytevector
   (lambda (drv)
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 6c0753aef4..7b9ffc61b5 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,8 +19,10 @@
 (define-module (guix diagnostics)
   #:use-module (guix colors)
   #:use-module (guix i18n)
-  #:autoload   (guix utils) (<location>)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (warning
@@ -28,8 +30,29 @@
             report-error
             leave
 
+            <location>
+            location
+            location?
+            location-file
+            location-line
+            location-column
+            source-properties->location
+            location->source-properties
             location->string
 
+            &error-location
+            error-location?
+            error-location
+
+            formatted-message
+            formatted-message?
+            formatted-message-string
+            formatted-message-arguments
+
+            &fix-hint
+            fix-hint?
+            condition-fix-hint
+
             guix-warning-port
             program-name))
 
@@ -40,22 +63,22 @@
 ;;;
 ;;; Code:
 
+(define (trivial-format-string? fmt)
+  (define len
+    (string-length fmt))
+
+  (let loop ((start 0))
+    (or (>= (+ 1 start) len)
+        (let ((tilde (string-index fmt #\~ start)))
+          (or (not tilde)
+              (case (string-ref fmt (+ tilde 1))
+                ((#\a #\A #\%) (loop (+ tilde 2)))
+                (else          #f)))))))
+
 (define-syntax highlight-argument
   (lambda (s)
     "Given FMT and ARG, expand ARG to a call that highlights it, provided FMT
 is a trivial format string."
-    (define (trivial-format-string? fmt)
-      (define len
-        (string-length fmt))
-
-      (let loop ((start 0))
-        (or (>= (+ 1 start) len)
-            (let ((tilde (string-index fmt #\~ start)))
-              (or (not tilde)
-                  (case (string-ref fmt (+ tilde 1))
-                    ((#\a #\A #\%) (loop (+ tilde 2)))
-                    (else          #f)))))))
-
     ;; Be conservative: limit format argument highlighting to cases where the
     ;; format string contains nothing but ~a escapes.  If it contained ~s
     ;; escapes, this strategy wouldn't work.
@@ -115,7 +138,15 @@ messages."
                   args (... ...))
             (free-identifier=? #'N-underscore #'N_)
             #'(name #f (N-underscore singular plural n)
-                    args (... ...)))))))))
+                    args (... ...)))
+           (id
+            (identifier? #'id)
+            ;; Run-time variant.
+            #'(lambda (location fmt . args)
+                (emit-diagnostic fmt args
+                                 #:location location
+                                 #:prefix prefix
+                                 #:colors colors)))))))))
 
 ;; XXX: This doesn't work well for right-to-left languages.
 ;; TRANSLATORS: The goal is to emit "warning:" followed by a short phrase;
@@ -130,6 +161,20 @@ messages."
     (report-error args ...)
     (exit 1)))
 
+(define* (emit-diagnostic fmt args
+                          #:key location (colors (color)) (prefix ""))
+  "Report diagnostic message FMT with the given ARGS and the specified
+LOCATION, COLORS, and PREFIX.
+
+This procedure is used as a last resort when the format string is not known at
+macro-expansion time."
+  (print-diagnostic-prefix (gettext prefix %gettext-domain)
+                           location #:colors colors)
+  (apply format (guix-warning-port) fmt
+         (if (trivial-format-string? fmt)
+             (map %highlight-argument args)
+             args)))
+
 (define %warning-color (color BOLD MAGENTA))
 (define %info-color (color BOLD))
 (define %error-color (color BOLD RED))
@@ -162,6 +207,45 @@ messages."
                 (program-name) (program-name)
                 (prefix-color prefix)))))
 
+
+;; A source location.
+(define-record-type <location>
+  (make-location file line column)
+  location?
+  (file          location-file)                   ; file name
+  (line          location-line)                   ; 1-indexed line
+  (column        location-column))                ; 0-indexed column
+
+(define (location file line column)
+  "Return the <location> object for the given FILE, LINE, and COLUMN."
+  (and line column file
+       (make-location file line column)))
+
+(define (source-properties->location loc)
+  "Return a location object based on the info in LOC, an alist as returned
+by Guile's `source-properties', `frame-source', `current-source-location',
+etc."
+  ;; In accordance with the GCS, start line and column numbers at 1.  Note
+  ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
+  (match loc
+    ((('line . line) ('column . col) ('filename . file)) ;common case
+     (and file line col
+          (make-location file (+ line 1) col)))
+    (#f
+     #f)
+    (_
+     (let ((file (assq-ref loc 'filename))
+           (line (assq-ref loc 'line))
+           (col  (assq-ref loc 'column)))
+       (location file (and line (+ line 1)) col)))))
+
+(define (location->source-properties loc)
+  "Return the source property association list based on the info in LOC,
+a location object."
+  `((line     . ,(and=> (location-line loc) 1-))
+    (column   . ,(location-column loc))
+    (filename . ,(location-file loc))))
+
 (define (location->string loc)
   "Return a human-friendly, GNU-standard representation of LOC."
   (match loc
@@ -169,6 +253,73 @@ messages."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
+(define-condition-type &error-location &error
+  error-location?
+  (location  error-location))                     ;<location>
+
+(define-condition-type &fix-hint &condition
+  fix-hint?
+  (hint condition-fix-hint))                      ;string
+
+(define-condition-type &formatted-message &error
+  formatted-message?
+  (format    formatted-message-string)
+  (arguments formatted-message-arguments))
+
+(define (check-format-string location format args)
+  "Check that FORMAT, a format string, contains valid escapes, and that the
+number of arguments in ARGS matches the escapes in FORMAT."
+  (define actual-count
+    (length args))
+
+  (define allowed-chars                           ;for 'simple-format'
+    '(#\A #\S #\a #\s #\~ #\%))
+
+  (define (format-chars fmt)
+    (let loop ((chars  (string->list fmt))
+               (result '()))
+      (match chars
+        (()
+         (reverse result))
+        ((#\~ opt rest ...)
+         (loop rest (cons opt result)))
+        ((chr rest ...)
+         (and (memv chr allowed-chars)
+              (loop rest result))))))
+
+  (match (format-chars format)
+    (#f
+     ;; XXX: In this case it could be that FMT contains invalid escapes, or it
+     ;; could be that it contains escapes beyond ALLOWED-CHARS, for (ice-9
+     ;; format).  Instead of implementing '-Wformat', do nothing.
+     #f)
+    (chars
+     (let ((count (fold (lambda (chr count)
+                          (case chr
+                            ((#\~ #\%) count)
+                            (else (+ count 1))))
+                        0
+                        chars)))
+       (unless (= count actual-count)
+         (warning location (G_ "format string got ~a arguments, expected ~a~%")
+                  actual-count count))))))
+
+(define-syntax formatted-message
+  (lambda (s)
+    "Return a '&formatted-message' error condition."
+    (syntax-case s (G_)
+      ((_ (G_ str) args ...)
+       (string? (syntax->datum #'str))
+       (let ((str (syntax->datum #'str)))
+         ;; Implement a subset of '-Wformat'.
+         (check-format-string (source-properties->location
+                               (syntax-source s))
+                              str #'(args ...))
+         (with-syntax ((str (string-append str "\n")))
+           #'(condition
+              (&formatted-message (format str)
+                                  (arguments (list args ...))))))))))
+
 
 (define guix-warning-port
   (make-parameter (current-warning-port)))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 67b6121313..9d3c52e783 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -504,13 +505,15 @@ This is the declarative counterpart of 'text-file'."
   (options    computed-file-options))             ;list of arguments
 
 (define* (computed-file name gexp
-                        #:key guile (options '(#:local-build? #t)))
+                        #:key guile (local-build? #t) (options '()))
   "Return an object representing the store item NAME, a file or directory
-computed by GEXP.  OPTIONS is a list of additional arguments to pass
-to 'gexp->derivation'.
+computed by GEXP.  When LOCAL-BUILD? is #t (the default), it ensures the
+corresponding derivation is built locally.  OPTIONS may be used to pass
+additional arguments to 'gexp->derivation'.
 
 This is the declarative counterpart of 'gexp->derivation'."
-  (%computed-file name gexp guile options))
+  (let ((options* `(#:local-build? ,local-build? ,@options)))
+    (%computed-file name gexp guile options*)))
 
 (define-gexp-compiler (computed-file-compiler (file <computed-file>)
                                               system target)
diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
index 6cfc7fabe1..4ab5419bd6 100644
--- a/guix/git-authenticate.scm
+++ b/guix/git-authenticate.scm
@@ -24,6 +24,7 @@
   #:use-module ((guix git)
                 #:select (commit-difference false-if-git-not-found))
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix openpgp)
   #:use-module ((guix utils)
                 #:select (cache-directory with-atomic-file-output))
@@ -105,23 +106,21 @@ not in KEYRING."
                   (lambda _
                     (values #f #f)))))
     (unless signature
-      (raise (condition
-              (&unsigned-commit-error (commit commit-id))
-              (&message
-               (message (format #f (G_ "commit ~a lacks a signature")
-                                (oid->string commit-id)))))))
+      (raise (make-compound-condition
+              (condition (&unsigned-commit-error (commit commit-id)))
+              (formatted-message (G_ "commit ~a lacks a signature")
+                                 (oid->string commit-id)))))
 
     (let ((signature (string->openpgp-packet signature)))
       (when (memq (openpgp-signature-hash-algorithm signature)
                   `(,@disallowed-hash-algorithms md5))
-        (raise (condition
-                (&unsigned-commit-error (commit commit-id))
-                (&message
-                 (message (format #f (G_ "commit ~a has a ~a signature, \
+        (raise (make-compound-condition
+                (condition (&unsigned-commit-error (commit commit-id)))
+                (formatted-message (G_ "commit ~a has a ~a signature, \
 which is not permitted")
-                                  (oid->string commit-id)
-                                  (openpgp-signature-hash-algorithm
-                                   signature)))))))
+                                   (oid->string commit-id)
+                                   (openpgp-signature-hash-algorithm
+                                    signature)))))
 
       (with-fluids ((%default-port-encoding "UTF-8"))
         (let-values (((status data)
@@ -130,23 +129,22 @@ which is not permitted")
           (match status
             ('bad-signature
              ;; There's a signature but it's invalid.
-             (raise (condition
-                     (&signature-verification-error (commit commit-id)
-                                                    (signature signature)
-                                                    (keyring keyring))
-                     (&message
-                      (message (format #f (G_ "signature verification failed \
+             (raise (make-compound-condition
+                     (condition
+                      (&signature-verification-error (commit commit-id)
+                                                     (signature signature)
+                                                     (keyring keyring)))
+                     (formatted-message (G_ "signature verification failed \
 for commit ~a")
-                                       (oid->string commit-id)))))))
+                                        (oid->string commit-id)))))
             ('missing-key
-             (raise (condition
-                     (&missing-key-error (commit commit-id)
-                                         (signature signature))
-                     (&message
-                      (message (format #f (G_ "could not authenticate \
+             (raise (make-compound-condition
+                     (condition (&missing-key-error (commit commit-id)
+                                                    (signature signature)))
+                     (formatted-message (G_ "could not authenticate \
 commit ~a: key ~a is missing")
-                                       (oid->string commit-id)
-                                       (openpgp-format-fingerprint data)))))))
+                                        (oid->string commit-id)
+                                        (openpgp-format-fingerprint data)))))
             ('good-signature data)))))))
 
 (define (read-authorizations port)
@@ -179,13 +177,13 @@ does not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
     ;; If COMMIT removes the '.guix-authorizations' file found in one of its
     ;; parents, raise an error.
     (when (parents-have-authorizations-file? commit)
-      (raise (condition
-              (&unauthorized-commit-error (commit (commit-id commit))
-                                          (signing-key #f))
-              (&message
-               (message (format #f (G_ "commit ~a attempts \
+      (raise (make-compound-condition
+              (condition
+               (&unauthorized-commit-error (commit (commit-id commit))
+                                           (signing-key #f)))
+              (formatted-message (G_ "commit ~a attempts \
 to remove '.guix-authorizations' file")
-                                (oid->string (commit-id commit)))))))))
+                                 (oid->string (commit-id commit)))))))
 
   (define (commit-authorizations commit)
     (catch 'git-error
@@ -234,16 +232,16 @@ not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
   (unless (member (openpgp-public-key-fingerprint signing-key)
                   (commit-authorized-keys repository commit
                                           default-authorizations))
-    (raise (condition
-            (&unauthorized-commit-error (commit id)
-                                        (signing-key signing-key))
-            (&message
-             (message (format #f (G_ "commit ~a not signed by an authorized \
+    (raise (make-compound-condition
+            (condition
+             (&unauthorized-commit-error (commit id)
+                                         (signing-key signing-key)))
+            (formatted-message (G_ "commit ~a not signed by an authorized \
 key: ~a")
-                              (oid->string id)
-                              (openpgp-format-fingerprint
-                               (openpgp-public-key-fingerprint
-                                signing-key))))))))
+                               (oid->string id)
+                               (openpgp-format-fingerprint
+                                (openpgp-public-key-fingerprint
+                                 signing-key))))))
 
   signing-key)
 
@@ -366,13 +364,11 @@ EXPECTED-SIGNER."
      (commit-signing-key repository (commit-id commit) keyring)))
 
   (unless (bytevector=? expected-signer actual-signer)
-    (raise (condition
-            (&message
-             (message (format #f (G_ "initial commit ~a is signed by '~a' \
+    (raise (formatted-message (G_ "initial commit ~a is signed by '~a' \
 instead of '~a'")
                               (oid->string (commit-id commit))
                               (openpgp-format-fingerprint actual-signer)
-                              (openpgp-format-fingerprint expected-signer))))))))
+                              (openpgp-format-fingerprint expected-signer)))))
 
 (define* (authenticate-repository repository start signer
                                   #:key
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 71ea1031c5..90634a8c4c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -84,35 +84,26 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
           ("tar" ,(module-ref (resolve-interface '(gnu packages base))
                               'tar)))))
 
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
   (define guile-json
     (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
 
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+
   (define gnutls
     (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
 
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
-
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build git)
-                                           (guix build utils)
-                                           (guix build download-nar)
-                                           (guix swh))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build git)
+                                     (guix build utils)
+                                     (guix build download-nar)
+                                     (guix swh)))))
 
   (define build
     (with-imported-modules modules
-      (with-extensions (list guile-json gnutls)   ;for (guix swh)
+      (with-extensions (list guile-json gnutls   ;for (guix swh)
+                             guile-zlib)
         #~(begin
             (use-modules (guix build git)
                          (guix build utils)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index cd7109002b..08b2bcf758 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -36,7 +36,7 @@
   #:use-module (guix records)
   #:use-module (guix upstream)
   #:use-module (guix packages)
-  #:use-module (guix zlib)
+  #:use-module (zlib)
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
diff --git a/guix/hg-download.scm b/guix/hg-download.scm
index 4cdc1a780a..694105ceba 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <hg-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build hg)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build hg)
+                                     (guix build download-nar)))))
 
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build hg)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build hg)
+                         (guix build download-nar))
 
-          (or (hg-fetch '#$(hg-reference-url ref)
-                        '#$(hg-reference-changeset ref)
-                        #$output
-                        #:hg-command (string-append #+hg "/bin/hg"))
-              (download-nar #$output)))))
+            (or (hg-fetch '#$(hg-reference-url ref)
+                          '#$(hg-reference-changeset ref)
+                          #$output
+                          #:hg-command (string-append #+hg "/bin/hg"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "hg-checkout") build
diff --git a/guix/import/launchpad.scm b/guix/import/launchpad.scm
index c7375837c7..fd3cfa8444 100644
--- a/guix/import/launchpad.scm
+++ b/guix/import/launchpad.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2019, 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +32,7 @@
   "Return the extension of the archive e.g. '.tar.gz' given a URL, or
 false if none is recognized"
   (find (lambda (x) (string-suffix? x url))
-        (list ".tar.gz" ".tar.bz2" ".tar.xz"
+        (list ".orig.tar.gz" ".tar.gz" ".tar.bz2" ".tar.xz"
               ".zip" ".tar" ".tgz" ".tbz" ".love")))
 
 (define (updated-launchpad-url old-package new-version)
@@ -46,15 +46,35 @@ false if none is recognized"
                (version (package-version old-package))
                (repo (launchpad-repository url)))
            (cond
-            ((and
-              (>= (length (string-split version #\.)) 2)
-              (string=? (string-append "https://launchpad.net/"
-                                       repo "/" (version-major+minor version)
-                                       "/" version "/+download/" repo "-" version ext)
-                        url))
+            ((< (length (string-split version #\.)) 2) #f)
+            ((string=? (string-append "https://launchpad.net/"
+                                      repo "/" (version-major+minor version)
+                                      "/" version "/+download/" repo "-" version ext)
+                       url)
              (string-append "https://launchpad.net/"
                             repo "/" (version-major+minor new-version)
                             "/" new-version "/+download/" repo "-" new-version ext))
+            ((string=? (string-append "https://launchpad.net/"
+                                      repo "/" (version-major+minor version)
+                                      "/" version "/+download/" repo "_" version ext)
+                       url)
+             (string-append "https://launchpad.net/"
+                            repo "/" (version-major+minor new-version)
+                            "/" new-version "/+download/" repo "-" new-version ext))
+            ((string=? (string-append "https://launchpad.net/"
+                                      repo "/trunk/" version "/+download/"
+                                      repo "-" version ext)
+                       url)
+             (string-append "https://launchpad.net/"
+                            repo "/trunk/" new-version
+                            "/+download/" repo "-" new-version ext))
+            ((string=? (string-append "https://launchpad.net/"
+                                      repo "/trunk/" version "/+download/"
+                                      repo "_" version ext)
+                       url)
+             (string-append "https://launchpad.net/"
+                            repo "/trunk/" new-version
+                            "/+download/" repo "_" new-version ext))
             (#t #f))))) ; Some URLs are not recognised.
 
   (match (package-source old-package)
@@ -66,7 +86,7 @@ false if none is recognized"
               ((? string?)
                (updated-url source-uri))
               ((source-uri ...)
-               (find updated-url source-uri))))))
+               (any updated-url source-uri))))))
     (_ #f)))
 
 (define (launchpad-package? package)
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index a2b5d995ef..a4a2489688 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -34,8 +34,10 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
-  #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix memoization)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
                            . hyphen-package-name->name+version)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index d347754bbc..77820872b3 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -21,9 +21,10 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module ((guix diagnostics)
+                #:select (source-properties->location))
   #:use-module ((guix utils)
                 #:select (%current-system
-                          source-properties->location
                           call-with-temporary-directory
                           version>? version-prefix?
                           cache-directory))
diff --git a/guix/lint.scm b/guix/lint.scm
index e7855678ca..ec43a4dcad 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -139,7 +139,7 @@
    message-text
    message-data
    (or location
-       (package-field-location package field)
+       (and field (package-field-location package field))
        (package-location package))))
 
 (define-syntax make-warning
@@ -668,7 +668,12 @@ patch could not be found."
               ;; Use %make-warning, as condition-mesasge is already
               ;; translated.
               (%make-warning package (condition-message c)
-                             #:field 'patch-file-names))))
+                             #:field 'patch-file-names)))
+            ((formatted-message? c)
+             (list (%make-warning package
+                                  (apply format #f
+                                         (G_ (formatted-message-string c))
+                                         (formatted-message-arguments c))))))
     (define patches
       (match (package-source package)
         ((? origin? origin) (origin-patches origin))
@@ -789,6 +794,9 @@ descriptions maintained upstream."
            (#t
             ;; We found a working URL, so stop right away.
             '())
+           (#f
+            ;; Unsupported URL or other error, skip.
+            (loop rest warnings))
            ((? lint-warning? warning)
             (loop rest (cons warning warnings))))))))
 
@@ -955,7 +963,14 @@ descriptions maintained upstream."
                    (make-warning package
                                  (G_ "failed to create ~a derivation: ~a")
                                  (list system
-                                       (condition-message c)))))
+                                       (condition-message c))))
+                  ((formatted-message? c)
+                   (let ((str (apply format #f
+                                     (formatted-message-string c)
+                                     (formatted-message-arguments c))))
+                     (make-warning package
+                                   (G_ "failed to create ~a derivation: ~a")
+                                   (list system str)))))
           (parameterize ((%graft? #f))
             (package-derivation store package system #:graft? #f)
 
@@ -1340,12 +1355,20 @@ them for PACKAGE."
   "Check the formatting of the source code of PACKAGE."
   (let ((location (package-location package)))
     (if location
-        (and=> (search-path %load-path (location-file location))
-               (lambda (file)
-                 ;; Report issues starting from the line before the 'package'
-                 ;; form, which usually contains the 'define' form.
-                 (report-formatting-issues package file
-                                           (- (location-line location) 1))))
+        ;; Report issues starting from the line before the 'package'
+        ;; form, which usually contains the 'define' form.
+        (let ((line (- (location-line location) 1)))
+          (match (search-path %load-path (location-file location))
+            ((? string? file)
+             (report-formatting-issues package file line))
+            (#f
+             ;; It could be that LOCATION lists a "true" relative file
+             ;; name--i.e., not relative to an element of %LOAD-PATH.
+             (let ((file (location-file location)))
+               (if (file-exists? file)
+                   (report-formatting-issues package file line)
+                   (list (make-warning package
+                                       (G_ "source file not found"))))))))
         '())))
 
 
diff --git a/guix/lzlib.scm b/guix/lzlib.scm
deleted file mode 100644
index 2fc326ba34..0000000000
--- a/guix/lzlib.scm
+++ /dev/null
@@ -1,709 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
-;;; Copyright © 2019, 2020 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 lzlib)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs arithmetic bitwise)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 match)
-  #:use-module (system foreign)
-  #:use-module (guix config)
-  #:use-module (srfi srfi-11)
-  #:export (lzlib-available?
-            make-lzip-input-port
-            make-lzip-output-port
-            make-lzip-input-port/compressed
-            call-with-lzip-input-port
-            call-with-lzip-output-port
-            %default-member-length-limit
-            %default-compression-level
-            dictionary-size+match-length-limit))
-
-;;; Commentary:
-;;;
-;;; Bindings to the lzlib / liblz API.  Some convenience functions are also
-;;; provided (see the export).
-;;;
-;;; While the bindings are complete, the convenience functions only support
-;;; single member archives.  To decompress single member archives, we loop
-;;; until lz-decompress-read returns 0.  This is simpler.  To support multiple
-;;; members properly, we need (among others) to call lz-decompress-finish and
-;;; loop over lz-decompress-read until lz-decompress-finished? returns #t.
-;;; Otherwise a multi-member archive starting with an empty member would only
-;;; decompress the empty member and stop there, resulting in truncated output.
-
-;;; Code:
-
-(define %lzlib
-  ;; File name of lzlib's shared library.  When updating via 'guix pull',
-  ;; '%liblz' might be undefined so protect against it.
-  (delay (dynamic-link (if (defined? '%liblz)
-                           %liblz
-                           "liblz"))))
-
-(define (lzlib-available?)
-  "Return true if lzlib is available, #f otherwise."
-  (false-if-exception (force %lzlib)))
-
-(define (lzlib-procedure ret name parameters)
-  "Return a procedure corresponding to C function NAME in liblz, or #f if
-either lzlib or the function could not be found."
-  (match (false-if-exception (dynamic-func name (force %lzlib)))
-    ((? pointer? ptr)
-     (pointer->procedure ret ptr parameters))
-    (#f
-     #f)))
-
-(define-wrapped-pointer-type <lz-decoder>
-  ;; Scheme counterpart of the 'LZ_Decoder' opaque type.
-  lz-decoder?
-  pointer->lz-decoder
-  lz-decoder->pointer
-  (lambda (obj port)
-    (format port "#<lz-decoder ~a>"
-            (number->string (object-address obj) 16))))
-
-(define-wrapped-pointer-type <lz-encoder>
-  ;; Scheme counterpart of the 'LZ_Encoder' opaque type.
-  lz-encoder?
-  pointer->lz-encoder
-  lz-encoder->pointer
-  (lambda (obj port)
-    (format port "#<lz-encoder ~a>"
-            (number->string (object-address obj) 16))))
-
-;; From lzlib.h
-(define %error-number-ok 0)
-(define %error-number-bad-argument 1)
-(define %error-number-mem-error 2)
-(define %error-number-sequence-error 3)
-(define %error-number-header-error 4)
-(define %error-number-unexpected-eof 5)
-(define %error-number-data-error 6)
-(define %error-number-library-error 7)
-
-
-;; Compression bindings.
-
-(define lz-compress-open
-  (let ((proc (lzlib-procedure '* "LZ_compress_open" (list int int uint64)))
-        ;; member-size is an "unsigned long long", and the C standard guarantees
-        ;; a minimum range of 0..2^64-1.
-        (unlimited-size (- (expt 2 64) 1)))
-    (lambda* (dictionary-size match-length-limit #:optional (member-size unlimited-size))
-      "Initialize the internal stream state for compression and returns a
-pointer that can only be used as the encoder argument for the other
-lz-compress functions, or a null pointer if the encoder could not be
-allocated.
-
-See the manual: (lzlib) Compression functions."
-      (let ((encoder-ptr (proc dictionary-size match-length-limit member-size)))
-        (if (not (= (lz-compress-error encoder-ptr) -1))
-            (pointer->lz-encoder encoder-ptr)
-            (throw 'lzlib-error 'lz-compress-open))))))
-
-(define lz-compress-close
-  (let ((proc (lzlib-procedure int "LZ_compress_close" '(*))))
-    (lambda (encoder)
-      "Close encoder.  ENCODER can no longer be used as an argument to any
-lz-compress function. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-close ret)
-            ret)))))
-
-(define lz-compress-finish
-  (let ((proc (lzlib-procedure int "LZ_compress_finish" '(*))))
-    (lambda (encoder)
-      "Tell that all the data for this member have already been written (with
-the `lz-compress-write' function).  It is safe to call `lz-compress-finish' as
-many times as needed.  After all the produced compressed data have been read
-with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a new
-member can be started with 'lz-compress-restart-member'."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-finish (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-restart-member
-  (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* uint64))))
-    (lambda (encoder member-size)
-      "Start a new member in a multimember data stream.
-Call this function only after `lz-compress-member-finished?' indicates that the
-current member has been fully read (with the `lz-compress-read' function)."
-      (let ((ret (proc (lz-encoder->pointer encoder) member-size)))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-restart-member
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-sync-flush
-  (let ((proc (lzlib-procedure int "LZ_compress_sync_flush" (list '*))))
-    (lambda (encoder)
-      "Make available to `lz-compress-read' all the data already written with
-the `LZ-compress-write' function.  First call `lz-compress-sync-flush'.  Then
-call 'lz-compress-read' until it returns 0.
-
-Repeated use of `LZ-compress-sync-flush' may degrade compression ratio,
-so use it only when needed. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-sync-flush
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-read
-  (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int))))
-    (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv)))
-      "Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV.
-Return the number of uncompressed bytes written, a positive integer."
-      (let ((ret (proc (lz-encoder->pointer encoder)
-                       (bytevector->pointer lzfile-bv start)
-                       count)))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-read (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-write
-  (let ((proc (lzlib-procedure int "LZ_compress_write" (list '* '* int))))
-    (lambda* (encoder bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV to the encoder stream.  Return the
-number of uncompressed bytes written, a strictly positive integer."
-      (let ((ret (proc (lz-encoder->pointer encoder)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-compress-write (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-write-size
-  (let ((proc (lzlib-procedure int "LZ_compress_write_size" '(*))))
-    (lambda (encoder)
-      "The maximum number of bytes that can be immediately written through the
-`lz-compress-write' function.
-
-It is guaranteed that an immediate call to `lz-compress-write' will accept a
-SIZE up to the returned number of bytes. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-write-size (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-error
-  (let ((proc (lzlib-procedure int "LZ_compress_errno" '(*))))
-    (lambda (encoder)
-      "ENCODER can be a Scheme object or a pointer."
-      (let* ((error-number (proc (if (lz-encoder? encoder)
-                                     (lz-encoder->pointer encoder)
-                                     encoder))))
-        error-number))))
-
-(define lz-compress-finished?
-  (let ((proc (lzlib-procedure int "LZ_compress_finished" '(*))))
-    (lambda (encoder)
-      "Return #t if all the data have been read and `lz-compress-close' can
-be safely called. Otherwise return #f."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-compress-finished? (lz-compress-error encoder))))))))
-
-(define lz-compress-member-finished?
-  (let ((proc (lzlib-procedure int "LZ_compress_member_finished" '(*))))
-    (lambda (encoder)
-      "Return #t if the current member, in a multimember data stream, has
-been fully read and 'lz-compress-restart-member' can be safely called.
-Otherwise return #f."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-compress-member-finished? (lz-compress-error encoder))))))))
-
-(define lz-compress-data-position
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_data_position" '(*))))
-    (lambda (encoder)
-      "Return the number of input bytes already compressed in the current
-member."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-data-position
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-member-position
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_member_position" '(*))))
-    (lambda (encoder)
-      "Return the number of compressed bytes already produced, but perhaps
-not yet read, in the current member."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-member-position
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-total-in-size
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_total_in_size" '(*))))
-    (lambda (encoder)
-      "Return the total number of input bytes already compressed."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-total-in-size
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-total-out-size
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_total_out_size" '(*))))
-    (lambda (encoder)
-      "Return the total number of compressed bytes already produced, but
-perhaps not yet read."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-total-out-size
-                   (lz-compress-error encoder))
-            ret)))))
-
-
-;; Decompression bindings.
-
-(define lz-decompress-open
-  (let ((proc (lzlib-procedure '* "LZ_decompress_open" '())))
-    (lambda ()
-      "Initializes the internal stream state for decompression and returns a
-pointer that can only be used as the decoder argument for the other
-lz-decompress functions, or a null pointer if the decoder could not be
-allocated.
-
-See the manual: (lzlib) Decompression functions."
-      (let ((decoder-ptr (proc)))
-        (if (not (= (lz-decompress-error decoder-ptr) -1))
-            (pointer->lz-decoder decoder-ptr)
-            (throw 'lzlib-error 'lz-decompress-open))))))
-
-(define lz-decompress-close
-  (let ((proc (lzlib-procedure int "LZ_decompress_close" '(*))))
-    (lambda (decoder)
-      "Close decoder.  DECODER can no longer be used as an argument to any
-lz-decompress function. "
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-close ret)
-            ret)))))
-
-(define lz-decompress-finish
-  (let ((proc (lzlib-procedure int "LZ_decompress_finish" '(*))))
-    (lambda (decoder)
-      "Tell that all the data for this stream have already been written (with
-the `lz-decompress-write' function).  It is safe to call
-`lz-decompress-finish' as many times as needed."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-finish (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-reset
-  (let ((proc (lzlib-procedure int "LZ_decompress_reset" '(*))))
-    (lambda (decoder)
-      "Reset the internal state of DECODER as it was just after opening it
-with the `lz-decompress-open' function.  Data stored in the internal buffers
-is discarded.  Position counters are set to 0."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-reset
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-sync-to-member
-  (let ((proc (lzlib-procedure int "LZ_decompress_sync_to_member" '(*))))
-    (lambda (decoder)
-      "Reset the error state of DECODER and enters a search state that lasts
-until a new member header (or the end of the stream) is found.  After a
-successful call to `lz-decompress-sync-to-member', data written with
-`lz-decompress-write' will be consumed and 'lz-decompress-read' will return 0
-until a header is found.
-
-This function is useful to discard any data preceding the first member, or to
-discard the rest of the current member, for example in case of a data
-error.  If the decoder is already at the beginning of a member, this function
-does nothing."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-sync-to-member
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-read
-  (let ((proc (lzlib-procedure int "LZ_decompress_read" (list '* '* int))))
-    (lambda* (decoder file-bv #:optional (start 0) (count (bytevector-length file-bv)))
-      "Read up to COUNT bytes from the decoder stream, storing the results in FILE-BV.
-Return the number of uncompressed bytes written, a non-negative positive integer."
-      (let ((ret (proc (lz-decoder->pointer decoder)
-                       (bytevector->pointer file-bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-decompress-read (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-write
-  (let ((proc (lzlib-procedure int "LZ_decompress_write" (list '* '* int))))
-    (lambda* (decoder bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV to the decoder stream.  Return the
-number of uncompressed bytes written, a non-negative integer."
-      (let ((ret (proc (lz-decoder->pointer decoder)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-decompress-write (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-write-size
-  (let ((proc (lzlib-procedure int "LZ_decompress_write_size" '(*))))
-    (lambda (decoder)
-      "Return the maximum number of bytes that can be immediately written
-through the `lz-decompress-write' function.
-
-It is guaranteed that an immediate call to `lz-decompress-write' will accept a
-SIZE up to the returned number of bytes. "
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-error
-  (let ((proc (lzlib-procedure int "LZ_decompress_errno" '(*))))
-    (lambda (decoder)
-      "DECODER can be a Scheme object or a pointer."
-      (let* ((error-number (proc (if (lz-decoder? decoder)
-                                     (lz-decoder->pointer decoder)
-                                     decoder))))
-        error-number))))
-
-(define lz-decompress-finished?
-  (let ((proc (lzlib-procedure int "LZ_decompress_finished" '(*))))
-    (lambda (decoder)
-      "Return #t if all the data have been read and `lz-decompress-close' can
-be safely called.  Otherwise return #f."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-decompress-finished? (lz-decompress-error decoder))))))))
-
-(define lz-decompress-member-finished?
-  (let ((proc (lzlib-procedure int "LZ_decompress_member_finished" '(*))))
-    (lambda (decoder)
-      "Return #t if the current member, in a multimember data stream, has
-been fully read and `lz-decompress-restart-member' can be safely called.
-Otherwise return #f."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-decompress-member-finished? (lz-decompress-error decoder))))))))
-
-(define lz-decompress-member-version
-  (let ((proc (lzlib-procedure int "LZ_decompress_member_version" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the version of current member from member header."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-data-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-dictionary-size
-  (let ((proc (lzlib-procedure int "LZ_decompress_dictionary_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the dictionary size of current member from member header."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-data-crc
-  (let ((proc (lzlib-procedure unsigned-int "LZ_decompress_data_crc" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the 32 bit Cyclic Redundancy Check of the data decompressed
-from the current member.  The returned value is valid only when
-`lz-decompress-member-finished' returns #t. "
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-data-position
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_data_position" '(*))))
-    (lambda (decoder)
-      "Return the number of decompressed bytes already produced, but perhaps
-not yet read, in the current member."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-data-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-member-position
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_member_position" '(*))))
-    (lambda (decoder)
-      "Return the number of input bytes already decompressed in the current
-member."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-total-in-size
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_in_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the total number of input bytes already compressed."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-total-in-size
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-total-out-size
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_out_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the total number of compressed bytes already produced, but
-perhaps not yet read."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-total-out-size
-                   (lz-decompress-error decoder))
-            ret)))))
-
-
-;; High level functions.
-
-(define* (lzread! decoder port bv
-                  #:optional (start 0) (count (bytevector-length bv)))
-  "Read up to COUNT bytes from PORT into BV at offset START.  Return the
-number of uncompressed bytes actually read; it is zero if COUNT is zero or if
-the end-of-stream has been reached."
-  (define (feed-decoder! decoder)
-    ;; Feed DECODER with data read from PORT.
-    (match (get-bytevector-n port (lz-decompress-write-size decoder))
-      ((? eof-object? eof) eof)
-      (bv (lz-decompress-write decoder bv))))
-
-  (let loop ((read 0)
-             (start start))
-    (cond ((< read count)
-           (match (lz-decompress-read decoder bv start (- count read))
-             (0 (cond ((lz-decompress-finished? decoder)
-                       read)
-                      ((eof-object? (feed-decoder! decoder))
-                       (lz-decompress-finish decoder)
-                       (loop read start))
-                      (else                       ;read again
-                       (loop read start))))
-             (n (loop (+ read n) (+ start n)))))
-          (else
-           read))))
-
-(define (lzwrite! encoder source source-offset source-count
-                  target target-offset target-count)
-  "Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to
-TARGET-COUNT bytes into TARGET at TARGET-OFFSET.  Return two values: the
-number of bytes read from SOURCE, and the number of bytes written to TARGET,
-possibly zero."
-  (define read
-    (if (> (lz-compress-write-size encoder) 0)
-        (match (lz-compress-write encoder source source-offset source-count)
-          (0 (lz-compress-finish encoder) 0)
-          (n n))
-        0))
-
-  (define written
-    (lz-compress-read encoder target target-offset target-count))
-
-  (values read written))
-
-(define* (lzwrite encoder bv lz-port
-                  #:optional (start 0) (count (bytevector-length bv)))
-  "Write up to COUNT bytes from BV at offset START into LZ-PORT.  Return
-the number of uncompressed bytes written, a non-negative integer."
-  (let ((written 0)
-        (read 0))
-    (while (and (< 0 (lz-compress-write-size encoder))
-                (< written count))
-      (set! written (+ written
-                       (lz-compress-write encoder bv (+ start written) (- count written)))))
-    (when (= written 0)
-      (lz-compress-finish encoder))
-    (let ((lz-bv (make-bytevector written)))
-      (let loop ((rd 0))
-        (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv)))
-        (put-bytevector lz-port lz-bv 0 rd)
-        (set! read (+ read rd))
-        (unless (= rd 0)
-          (loop rd))))
-    ;; `written' is the total byte count of uncompressed data.
-    written))
-
-
-;;;
-;;; Port interface.
-;;;
-
-;; Alist of (levels (dictionary-size match-length-limit)).  0 is the fastest.
-;; See bbexample.c in lzlib's source.
-(define %compression-levels
-  `((0 65535 16)
-    (1 ,(bitwise-arithmetic-shift-left 1 20) 5)
-    (2 ,(bitwise-arithmetic-shift-left 3 19) 6)
-    (3 ,(bitwise-arithmetic-shift-left 1 21) 8)
-    (4 ,(bitwise-arithmetic-shift-left 3 20) 12)
-    (5 ,(bitwise-arithmetic-shift-left 1 22) 20)
-    (6 ,(bitwise-arithmetic-shift-left 1 23) 36)
-    (7 ,(bitwise-arithmetic-shift-left 1 24) 68)
-    (8 ,(bitwise-arithmetic-shift-left 3 23) 132)
-    (9 ,(bitwise-arithmetic-shift-left 1 25) 273)))
-
-(define %default-compression-level
-  6)
-
-(define (dictionary-size+match-length-limit level)
-  "Return two values: the dictionary size for LEVEL, and its match-length
-limit.  LEVEL must be a compression level, an integer between 0 and 9."
-  (match (assv-ref %compression-levels level)
-    ((dictionary-size match-length-limit)
-     (values dictionary-size match-length-limit))))
-
-(define* (make-lzip-input-port port)
-  "Return an input port that decompresses data read from PORT, a file port.
-PORT is automatically closed when the resulting port is closed."
-  (define decoder (lz-decompress-open))
-
-  (define (read! bv start count)
-    (lzread! decoder port bv start count))
-
-  (make-custom-binary-input-port "lzip-input" read! #f #f
-                                 (lambda ()
-                                   (lz-decompress-close decoder)
-                                   (close-port port))))
-
-(define* (make-lzip-output-port port
-                                #:key
-                                (level %default-compression-level))
-  "Return an output port that compresses data at the given LEVEL, using PORT,
-a file port, as its sink.  PORT is automatically closed when the resulting
-port is closed."
-  (define encoder
-    (call-with-values (lambda () (dictionary-size+match-length-limit level))
-      lz-compress-open))
-
-  (define (write! bv start count)
-    (lzwrite encoder bv port start count))
-
-  (make-custom-binary-output-port "lzip-output" write! #f #f
-                                  (lambda ()
-                                    (lz-compress-finish encoder)
-                                    ;; "lz-read" the trailing metadata added by `lz-compress-finish'.
-                                    (let ((lz-bv (make-bytevector (* 64 1024))))
-                                      (let loop ((rd 0))
-                                        (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv)))
-                                        (put-bytevector port lz-bv 0 rd)
-                                        (unless (= rd 0)
-                                          (loop rd))))
-                                    (lz-compress-close encoder)
-                                    (close-port port))))
-
-(define* (make-lzip-input-port/compressed port
-                                          #:key
-                                          (level %default-compression-level))
-  "Return an input port that compresses data read from PORT, with the given LEVEL.
-PORT is automatically closed when the resulting port is closed."
-  (define encoder
-    (call-with-values (lambda () (dictionary-size+match-length-limit level))
-      lz-compress-open))
-
-  (define input-buffer (make-bytevector 8192))
-  (define input-len 0)
-  (define input-offset 0)
-
-  (define input-eof? #f)
-
-  (define (read! bv start count)
-    (cond
-     (input-eof?
-      (match (lz-compress-read encoder bv start count)
-        (0 (if (lz-compress-finished? encoder)
-               0
-               (read! bv start count)))
-        (n n)))
-     ((= input-offset input-len)
-      (match (get-bytevector-n! port input-buffer 0
-                                (bytevector-length input-buffer))
-        ((? eof-object?)
-         (set! input-eof? #t)
-         (lz-compress-finish encoder))
-        (count
-         (set! input-offset 0)
-         (set! input-len count)))
-      (read! bv start count))
-     (else
-      (let-values (((read written)
-                    (lzwrite! encoder
-                              input-buffer input-offset
-                              (- input-len input-offset)
-                              bv start count)))
-        (set! input-offset (+ input-offset read))
-
-        ;; Make sure we don't return zero except on EOF.
-        (if (= 0 written)
-            (read! bv start count)
-            written)))))
-
-  (make-custom-binary-input-port "lzip-input/compressed"
-                                 read! #f #f
-                                 (lambda ()
-                                   (close-port port))))
-
-(define* (call-with-lzip-input-port port proc)
-  "Call PROC with a port that wraps PORT and decompresses data read from it.
-PORT is closed upon completion."
-  (let ((lzip (make-lzip-input-port port)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc lzip))
-      (lambda ()
-        (close-port lzip)))))
-
-(define* (call-with-lzip-output-port port proc
-                                     #:key
-                                     (level %default-compression-level))
-  "Call PROC with an output port that wraps PORT and compresses data.  PORT is
-close upon completion."
-  (let ((lzip (make-lzip-output-port port
-                                     #:level level)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc lzip))
-      (lambda ()
-        (close-port lzip)))))
-
-;;; lzlib.scm ends here
diff --git a/guix/man-db.scm b/guix/man-db.scm
index 4cef874f8b..a6528e4431 100644
--- a/guix/man-db.scm
+++ b/guix/man-db.scm
@@ -17,7 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix man-db)
-  #:use-module (guix zlib)
+  #:use-module (zlib)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (gdbm)                             ;gdbm-ffi
   #:use-module (srfi srfi-9)
diff --git a/guix/packages.scm b/guix/packages.scm
index 95d7c2cc0d..6598bd3149 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -228,7 +228,8 @@ as base32.  Otherwise, it must be a bytevector."
 (define (print-content-hash hash port)
   (format port "#<content-hash ~a:~a>"
           (content-hash-algorithm hash)
-          (bytevector->nix-base32-string (content-hash-value hash))))
+          (and=> (content-hash-value hash)
+                 bytevector->nix-base32-string)))
 
 (set-record-type-printer! <content-hash> print-content-hash)
 
diff --git a/guix/profiles.scm b/guix/profiles.scm
index f34f73e17e..856a05eed1 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -32,6 +32,7 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
                 #:select (package-name->name+version mkdir-p))
+  #:use-module ((guix diagnostics) #:select (&fix-hint))
   #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
@@ -1204,43 +1205,48 @@ and creates the dependency graph of all these kernel modules.
 This is meant to be used as a profile hook."
   (define kmod                                    ; lazy reference
     (module-ref (resolve-interface '(gnu packages linux)) 'kmod))
+
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+
   (define build
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (gnu build linux-modules)))
-      #~(begin
-          (use-modules (ice-9 ftw)
-                       (ice-9 match)
-                       (srfi srfi-1)              ; append-map
-                       (gnu build linux-modules))
-
-          (let* ((inputs '#$(manifest-inputs manifest))
-                 (module-directories
-                  (map (lambda (directory)
-                         (string-append directory "/lib/modules"))
-                       inputs))
-                 (directory-entries
-                  (lambda (directory)
-                    (or (scandir directory
-                                 (lambda (basename)
-                                   (not (string-prefix? "." basename))))
-                        '())))
-                 ;; Note: Should usually result in one entry.
-                 (versions (delete-duplicates
-                            (append-map directory-entries
-                                        module-directories))))
-            (match versions
-              ((version)
-               (let ((old-path (getenv "PATH")))
-                 (setenv "PATH" #+(file-append kmod "/bin"))
-                 (make-linux-module-directory inputs version #$output)
-                 (setenv "PATH" old-path)))
-              (()
-               ;; Nothing here, maybe because this is a kernel with
-               ;; CONFIG_MODULES=n.
-               (mkdir #$output))
-              (_ (error "Specified Linux kernel and Linux kernel modules
-are not all of the same version")))))))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (ice-9 ftw)
+                         (ice-9 match)
+                         (srfi srfi-1)              ; append-map
+                         (gnu build linux-modules))
+
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories
+                    (map (lambda (directory)
+                           (string-append directory "/lib/modules"))
+                         inputs))
+                   (directory-entries
+                    (lambda (directory)
+                      (or (scandir directory
+                                   (lambda (basename)
+                                     (not (string-prefix? "." basename))))
+                          '())))
+                   ;; Note: Should usually result in one entry.
+                   (versions (delete-duplicates
+                              (append-map directory-entries
+                                          module-directories))))
+              (match versions
+                ((version)
+                 (let ((old-path (getenv "PATH")))
+                   (setenv "PATH" #+(file-append kmod "/bin"))
+                   (make-linux-module-directory inputs version #$output)
+                   (setenv "PATH" old-path)))
+                (()
+                 ;; Nothing here, maybe because this is a kernel with
+                 ;; CONFIG_MODULES=n.
+                 (mkdir #$output))
+                (_ (error "Specified Linux kernel and Linux kernel modules
+are not all of the same version"))))))))
   (gexp->derivation "linux-module-database" build
                     #:local-build? #t
                     #:substitutable? #f
@@ -1411,27 +1417,18 @@ the entries in MANIFEST."
     (module-ref (resolve-interface '(gnu packages guile))
                 'guile-gdbm-ffi))
 
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module #$'(guix config) ;placate Geiser
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure `((guix build utils)
-                                           (guix man-db))))))
+    (delete '(guix config)
+            (source-module-closure `((guix build utils)
+                                     (guix man-db)))))
 
   (define build
     (with-imported-modules modules
-      (with-extensions (list gdbm-ffi)            ;for (guix man-db)
+      (with-extensions (list gdbm-ffi           ;for (guix man-db)
+                             guile-zlib)
         #~(begin
             (use-modules (guix man-db)
                          (guix build utils)
diff --git a/guix/remote.scm b/guix/remote.scm
index a227540728..f6adb22846 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +20,7 @@
   #:use-module (guix ssh)
   #:use-module (guix gexp)
   #:use-module (guix i18n)
+  #:use-module ((guix diagnostics) #:select (formatted-message))
   #:use-module (guix inferior)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -72,11 +73,9 @@ BECOME-COMMAND is given, use that to invoke the remote Guile REPL."
     (when (eof-object? (peek-char pipe))
       (let ((status (channel-get-exit-status pipe)))
         (close-port pipe)
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+        (raise (formatted-message (G_ "remote command '~{~a~^ ~}' failed \
 with status ~a")
-                                  repl-command status)))))))
+                                  repl-command status))))
     pipe))
 
 (define* (%remote-eval lowered session #:optional become-command)
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 41a2a42c21..f3b86fba14 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -380,6 +380,8 @@ output port."
                    (with-build-handler
                        (build-notifier #:use-substitutes?
                                        (assoc-ref opts 'substitutes?)
+                                       #:verbosity
+                                       (assoc-ref opts 'verbosity)
                                        #:dry-run?
                                        (assoc-ref opts 'dry-run?))
                      (cond ((assoc-ref opts 'export)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 8ff2fd1910..6286a43c02 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -961,6 +961,8 @@ needed."
 
         (with-build-handler (build-notifier #:use-substitutes?
                                             (assoc-ref opts 'substitutes?)
+                                            #:verbosity
+                                            (assoc-ref opts 'verbosity)
                                             #:dry-run?
                                             (assoc-ref opts 'dry-run?))
           (parameterize ((current-terminal-columns (terminal-columns))
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index f6f64d0a11..274620fc1e 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -20,6 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix ssh)
+  #:use-module ((ssh session) #:select (disconnect!))
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix utils)
@@ -71,9 +72,10 @@ package names, build the underlying packages before sending them."
     (and (build-derivations local drv)
          (let* ((session (open-ssh-session host #:user user
                                            #:port (or port 22)))
-                (sent    (send-files local items
-                                     (connect-to-remote-daemon session)
+                (remote  (connect-to-remote-daemon session))
+                (sent    (send-files local items remote
                                      #:recursive? #t)))
+           (close-connection remote)
            (format #t "~{~a~%~}" sent)
            sent))))
 
@@ -93,6 +95,8 @@ package names, build the underlying packages before sending them."
                    (options->derivations+files local opts))
                   ((retrieved)
                    (retrieve-files local items remote #:recursive? #t)))
+      (close-connection remote)
+      (disconnect! session)
       (format #t "~{~a~%~}" retrieved)
       retrieved)))
 
@@ -175,6 +179,8 @@ Copy ITEMS to or from the specified host over SSH.\n"))
         (set-build-options-from-command-line store opts)
         (with-build-handler (build-notifier #:use-substitutes?
                                             (assoc-ref opts 'substitutes?)
+                                            #:verbosity
+                                            (assoc-ref opts 'verbosity)
                                             #:dry-run?
                                             (assoc-ref opts 'dry-run?))
           (with-status-verbosity (assoc-ref opts 'verbosity)
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 4466a0c632..4a68197620 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -140,18 +140,21 @@ Perform the deployment specified by FILE.\n"))
   (define (handle-argument arg result)
     (alist-cons 'file arg result))
 
-  (let* ((opts (parse-command-line args %options (list %default-options)
-                                   #:argument-handler handle-argument))
-         (file (assq-ref opts 'file))
-         (machines (or (and file (load-source-file file)) '())))
-    (show-what-to-deploy machines)
-
-    (with-status-verbosity (assoc-ref opts 'verbosity)
-      (with-store store
-        (set-build-options-from-command-line store opts)
-        (with-build-handler (build-notifier #:use-substitutes?
-                                            (assoc-ref opts 'substitutes?))
-          (parameterize ((%graft? (assq-ref opts 'graft?)))
-            (map/accumulate-builds store
-                                   (cut deploy-machine* store <>)
-                                   machines)))))))
+  (with-error-handling
+    (let* ((opts (parse-command-line args %options (list %default-options)
+                                     #:argument-handler handle-argument))
+           (file (assq-ref opts 'file))
+           (machines (or (and file (load-source-file file)) '())))
+      (show-what-to-deploy machines)
+
+      (with-status-verbosity (assoc-ref opts 'verbosity)
+        (with-store store
+          (set-build-options-from-command-line store opts)
+          (with-build-handler (build-notifier #:use-substitutes?
+                                              (assoc-ref opts 'substitutes?)
+                                              #:verbosity
+                                              (assoc-ref opts 'verbosity))
+            (parameterize ((%graft? (assq-ref opts 'graft?)))
+              (map/accumulate-builds store
+                                     (cut deploy-machine* store <>)
+                                     machines))))))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index d3b8b57ccc..1fb3505307 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -477,6 +477,7 @@ WHILE-LIST."
                             (group-entry (gid 65534) ;the overflow GID
                                          (name "overflow"))))
             (home-dir (password-entry-directory passwd))
+            (logname  (password-entry-name passwd))
             (environ  (filter (match-lambda
                                 ((variable . value)
                                  (find (cut regexp-exec <> variable)
@@ -528,6 +529,10 @@ WHILE-LIST."
                       ;; The same variables as in Nix's 'build.cc'.
                       '("TMPDIR" "TEMPDIR" "TMP" "TEMP"))
 
+            ;; Some programs expect USER and/or LOGNAME to be set.
+            (setenv "LOGNAME" logname)
+            (setenv "USER" logname)
+
             ;; Create a dummy home directory.
             (mkdir-p home-dir)
             (setenv "HOME" home-dir)
@@ -708,6 +713,8 @@ message if any test fails."
       (with-store store
         (with-build-handler (build-notifier #:use-substitutes?
                                             (assoc-ref opts 'substitutes?)
+                                            #:verbosity
+                                            (assoc-ref opts 'verbosity)
                                             #:dry-run?
                                             (assoc-ref opts 'dry-run?))
           (with-status-verbosity (assoc-ref opts 'verbosity)
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 489931d5bb..73d9269de2 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -32,7 +32,8 @@
   #:use-module ((guix build-system gnu) #:select (standard-packages))
   #:use-module (gnu packages)
   #:use-module (guix sets)
-  #:use-module ((guix utils) #:select (location-file))
+  #:use-module ((guix diagnostics)
+                #:select (location-file formatted-message))
   #:use-module ((guix scripts build)
                 #:select (show-transformation-options-help
                           options->transformation
@@ -90,10 +91,8 @@ name."
      package)
     (x
      (raise
-      (condition
-       (&message
-        (message (format #f (G_ "~a: invalid argument (package name expected)")
-                         x))))))))
+      (formatted-message (G_ "~a: invalid argument (package name expected)")
+                         x)))))
 
 (define nodes-from-package
   ;; The default conversion method.
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 97ffd57301..5168a1ca17 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
@@ -174,23 +174,24 @@ run the checkers on all packages.\n"))
     (when (assoc-ref opts 'list?)
       (list-checkers-and-exit checkers))
 
-    (let ((any-lint-checker-requires-store?
-           (any lint-checker-requires-store? checkers)))
-
-      (define (call-maybe-with-store proc)
-        (if any-lint-checker-requires-store?
-            (with-store store
-              (proc store))
-            (proc #f)))
-
-      (call-maybe-with-store
-       (lambda (store)
-         (cond
-          ((null? args)
-           (fold-packages (lambda (p r) (run-checkers p checkers
-                                                      #:store store)) '()))
-          (else
-           (for-each (lambda (spec)
-                       (run-checkers (specification->package spec) checkers
-                                     #:store store))
-                     args))))))))
+    (with-error-handling
+      (let ((any-lint-checker-requires-store?
+             (any lint-checker-requires-store? checkers)))
+
+        (define (call-maybe-with-store proc)
+          (if any-lint-checker-requires-store?
+              (with-store store
+                (proc store))
+              (proc #f)))
+
+        (call-maybe-with-store
+         (lambda (store)
+           (cond
+            ((null? args)
+             (fold-packages (lambda (p r) (run-checkers p checkers
+                                                        #:store store)) '()))
+            (else
+             (for-each (lambda (spec)
+                         (run-checkers (specification->package spec) checkers
+                                       #:store store))
+                       args)))))))))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e81b6c25f2..1e0e9d7905 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,11 +34,12 @@
   #:use-module ((guix serialization)
                 #:select (nar-error? nar-error-file))
   #:use-module (guix nar)
-  #:use-module (guix utils)
+  #:use-module ((guix utils) #:select (%current-system))
   #:use-module ((guix build syscalls)
                 #:select (fcntl-flock set-thread-name))
   #:use-module ((guix build utils) #:select (which mkdir-p))
   #:use-module (guix ui)
+  #:use-module (guix diagnostics)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -65,14 +67,16 @@
 ;;;
 ;;; Code:
 
-
 (define-record-type* <build-machine>
   build-machine make-build-machine
   build-machine?
   (name            build-machine-name)            ; string
   (port            build-machine-port             ; number
                    (default 22))
-  (system          build-machine-system)          ; string
+  (systems         %build-machine-systems         ; list of strings
+                   (default #f))                  ; drop default after system is removed
+  (system          %build-machine-system          ; deprecated
+                   (default #f))
   (user            build-machine-user)            ; string
   (private-key     build-machine-private-key      ; file name
                    (default (user-openssh-private-key)))
@@ -90,6 +94,19 @@
   (features        build-machine-features         ; list of strings
                    (default '())))
 
+;;; Deprecated.
+(define (build-machine-system machine)
+  (warning (G_ "The 'system' field is deprecated, \
+please use 'systems' instead.~%"))
+  (%build-machine-system machine))
+
+;;; TODO: Remove after the deprecated 'system' field is removed.
+(define (build-machine-systems machine)
+  (or (%build-machine-systems machine)
+      (list (build-machine-system machine))
+      (leave (G_ "The build-machine object lacks a value for its 'systems'
+field."))))
+
 (define-record-type* <build-requirements>
   build-requirements make-build-requirements
   build-requirements?
@@ -156,10 +173,9 @@ can interpret meaningfully."
     (lambda ()
       (private-key-from-file file))
     (lambda (key proc str . rest)
-      (raise (condition
-              (&message (message (format #f (G_ "failed to load SSH \
+      (raise (formatted-message (G_ "failed to load SSH \
 private key from '~a': ~a")
-                                         file str))))))))
+                                file str)))))
 
 (define* (open-ssh-session machine #:optional (max-silent-time -1))
   "Open an SSH session for MACHINE and return it.  Throw an error on failure."
@@ -349,6 +365,8 @@ of free disk space on '~a'~%")
                                        #:log-port (current-error-port)
                                        #:lock? #f)))
 
+  (close-connection store)
+  (disconnect! session)
   (format (current-error-port) "done with offloaded '~a'~%"
           (derivation-file-name drv)))
 
@@ -359,8 +377,8 @@ of free disk space on '~a'~%")
 
 (define (machine-matches? machine requirements)
   "Return #t if MACHINE matches REQUIREMENTS."
-  (and (string=? (build-requirements-system requirements)
-                 (build-machine-system machine))
+  (and (member (build-requirements-system requirements)
+               (build-machine-systems machine))
        (lset<= string=?
                (build-requirements-features requirements)
                (build-machine-features machine))))
@@ -779,7 +797,8 @@ machine."
     (("--version")
      (show-version-and-exit "guix offload"))
     (("--help")
-     (format #t (G_ "Usage: guix offload SYSTEM PRINT-BUILD-TRACE
+     (format #t (G_ "Usage: guix offload SYSTEM MAX-SILENT-TIME \
+PRINT-BUILD-TRACE? BUILD-TIMEOUT
 Process build offload requests written on the standard input, possibly
 offloading builds to the machines listed in '~a'.~%")
              %machine-file)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 5fb6aaae0c..9d6881fdaf 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -744,11 +744,13 @@ last resort for relocation."
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (guix build union)
+                              (guix build gremlin)
                               (guix elf)))
       #~(begin
           (use-modules (guix build utils)
                        ((guix build union) #:select (relative-file-name))
                        (guix elf)
+                       (guix build gremlin)
                        (ice-9 binary-ports)
                        (ice-9 ftw)
                        (ice-9 match)
@@ -786,6 +788,14 @@ last resort for relocation."
                                    bv 0 (bytevector-length bv))
                  (utf8->string bv)))))
 
+          (define (runpath file)
+            ;; Return the RUNPATH of FILE as a list of directories.
+            (let* ((bv      (call-with-input-file file get-bytevector-all))
+                   (elf     (parse-elf bv))
+                   (dyninfo (elf-dynamic-info elf)))
+              (or (and=> dyninfo elf-dynamic-info-runpath)
+                  '())))
+
           (define (elf-loader-compile-flags program)
             ;; Return the cpp flags defining macros for the ld.so/fakechroot
             ;; wrapper of PROGRAM.
@@ -807,6 +817,13 @@ last resort for relocation."
 
                             (string-append "-DLOADER_AUDIT_MODULE=\""
                                            #$(audit-module) "\"")
+                            (string-append "-DLOADER_AUDIT_RUNPATH={ "
+                                           (string-join
+                                            (map object->string
+                                                 (runpath
+                                                  #$(audit-module)))
+                                            ", " 'suffix)
+                                           "NULL }")
                             (if gconv
                                 (string-append "-DGCONV_DIRECTORY=\""
                                                gconv "\"")
@@ -1136,6 +1153,8 @@ Create a bundle of PACKAGE.\n"))
 
         (with-build-handler (build-notifier #:dry-run?
                                             (assoc-ref opts 'dry-run?)
+                                            #:verbosity
+                                            (assoc-ref opts 'verbosity)
                                             #:use-substitutes?
                                             (assoc-ref opts 'substitutes?))
           (parameterize ((%graft? (assoc-ref opts 'graft?))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1246147798..ac8dedb5f3 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -965,6 +965,8 @@ option processing with 'parse-command-line'."
             (set-build-options-from-command-line (%store) opts)
             (with-build-handler (build-notifier #:use-substitutes?
                                                 (assoc-ref opts 'substitutes?)
+                                                #:verbosity
+                                                (assoc-ref opts 'verbosity)
                                                 #:dry-run?
                                                 (assoc-ref opts 'dry-run?))
               (parameterize ((%guile-for-build
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index 01f7213e8c..35698a0216 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -235,4 +235,7 @@ List the current Guix sessions and their processes."))
     (for-each (lambda (session)
                 (daemon-session->recutils session port)
                 (newline port))
-              (daemon-sessions))))
+              (daemon-sessions))
+
+    ;; Pass 'R' (instead of 'r') so 'less' correctly estimates line length.
+    #:less-options "FRX"))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a00f08f9d9..61542f83a0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -50,10 +50,9 @@
   #:use-module (guix workers)
   #:use-module (guix store)
   #:use-module ((guix serialization) #:select (write-file))
-  #:use-module (guix zlib)
-  #:autoload   (guix lzlib) (lzlib-available?
-                             call-with-lzip-output-port
-                             make-lzip-output-port)
+  #:use-module (zlib)
+  #:autoload   (lzlib) (call-with-lzip-output-port
+                        make-lzip-output-port)
   #:use-module (guix cache)
   #:use-module (guix ui)
   #:use-module (guix scripts)
@@ -880,8 +879,8 @@ blocking."
   "Return a symbol denoting the compression method expressed by STRING; return
 #f if STRING doesn't match any supported method."
   (match string
-    ("gzip" (and (zlib-available?) 'gzip))
-    ("lzip" (and (lzlib-available?) 'lzip))
+    ("gzip" 'gzip)
+    ("lzip" 'lzip)
     (_      #f)))
 
 (define (effective-compression requested-type compressions)
@@ -1032,9 +1031,7 @@ methods, return the applicable compression."
                                             opts)
                            (()
                             ;; Default to fast & low compression.
-                            (list (if (zlib-available?)
-                                      %default-gzip-compression
-                                      %no-compression)))
+                            (list %default-gzip-compression))
                            (lst (reverse lst))))
            (address (let ((addr (assoc-ref opts 'address)))
                       (make-socket-address (sockaddr:fam addr)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 807daec593..3b980b8f3f 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -507,6 +507,7 @@ true, display what would be built without actually building it."
   ;; workaround, skip this code when $SUDO_USER is set.  See
   ;; <https://bugs.gnu.org/36785>.
   (unless (or (getenv "SUDO_USER")
+              (not (file-exists? %user-profile-directory))
               (string=? %profile-directory
                         (dirname
                          (canonicalize-profile %user-profile-directory))))
@@ -773,6 +774,8 @@ Use '~/.config/guix/channels.scm' instead."))
                                  (%graft? (assoc-ref opts 'graft?)))
                     (with-build-handler (build-notifier #:use-substitutes?
                                                         substitutes?
+                                                        #:verbosity
+                                                        (assoc-ref opts 'verbosity)
                                                         #:dry-run? dry-run?)
                       (set-build-options-from-command-line store opts)
                       (ensure-default-profile)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index ba2b2d2d4e..117d824449 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -41,7 +41,6 @@
   #:use-module (guix progress)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
-  #:autoload   (guix lzlib) (lzlib-available?)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -912,7 +911,7 @@ authorized substitutes."
   ;; Known compression methods and a thunk to determine whether they're
   ;; supported.  See 'decompressed-port' in (guix utils).
   `(("gzip"  . ,(const #t))
-    ("lzip"  . ,lzlib-available?)
+    ("lzip"  . ,(const #t))
     ("xz"    . ,(const #t))
     ("bzip2" . ,(const #t))
     ("none"  . ,(const #t))))
@@ -1127,12 +1126,13 @@ default value."
   ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
   (for-each validate-uri (substitute-urls))
 
-  ;; Attempt to install the client's locale, mostly so that messages are
-  ;; suitably translated.
+  ;; Attempt to install the client's locale so that messages are suitably
+  ;; translated.  LC_CTYPE must be a UTF-8 locale; it's the case by default so
+  ;; don't change it.
   (match (or (find-daemon-option "untrusted-locale")
              (find-daemon-option "locale"))
     (#f     #f)
-    (locale (false-if-exception (setlocale LC_ALL locale))))
+    (locale (false-if-exception (setlocale LC_MESSAGES locale))))
 
   (catch 'system-error
     (lambda ()
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 79bfcd7db2..b75b0e5b60 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -271,28 +272,33 @@ expression in %STORE-MONAD."
 
 (define (report-shepherd-error error)
   "Report ERROR, a '&shepherd-error' error condition object."
-  (cond ((service-not-found-error? error)
-         (report-error (G_ "service '~a' could not be found~%")
-                       (service-not-found-error-service error)))
-        ((action-not-found-error? error)
-         (report-error (G_ "service '~a' does not have an action '~a'~%")
-                       (action-not-found-error-service error)
-                       (action-not-found-error-action error)))
-        ((action-exception-error? error)
-         (report-error (G_ "exception caught while executing '~a' \
+  (when error
+    (cond ((service-not-found-error? error)
+           (warning (G_ "service '~a' could not be found~%")
+                    (service-not-found-error-service error)))
+          ((action-not-found-error? error)
+           (warning (G_ "service '~a' does not have an action '~a'~%")
+                    (action-not-found-error-service error)
+                    (action-not-found-error-action error)))
+          ((action-exception-error? error)
+           (warning (G_ "exception caught while executing '~a' \
 on service '~a':~%")
-                       (action-exception-error-action error)
-                       (action-exception-error-service error))
-         (print-exception (current-error-port) #f
-                          (action-exception-error-key error)
-                          (action-exception-error-arguments error)))
-        ((unknown-shepherd-error? error)
-         (report-error (G_ "something went wrong: ~s~%")
-                       (unknown-shepherd-error-sexp error)))
-        ((shepherd-error? error)
-         (report-error (G_ "shepherd error~%")))
-        ((not error)                              ;not an error
-         #t)))
+                    (action-exception-error-action error)
+                    (action-exception-error-service error))
+           (print-exception (current-error-port) #f
+                            (action-exception-error-key error)
+                            (action-exception-error-arguments error)))
+          ((unknown-shepherd-error? error)
+           (warning (G_ "something went wrong: ~s~%")
+                    (unknown-shepherd-error-sexp error)))
+          ((shepherd-error? error)
+           (warning (G_ "shepherd error~%"))))
+
+    ;; Don't leave users out in the cold and explain what that means and what
+    ;; they can do.
+    (warning (G_ "some services could not be upgraded~%"))
+    (display-hint (G_ "To allow changes to all the system services to take
+effect, you will need to reboot."))))
 
 (define-syntax-rule (unless-file-not-found exp)
   (catch 'system-error
@@ -565,16 +571,14 @@ any, are available.  Raise an error if they're not."
   (define fail? #f)
 
   (define (file-system-location* fs)
-    (location->string
-     (source-properties->location
-      (file-system-location fs))))
+    (and=> (file-system-location fs)
+           source-properties->location))
 
   (let-syntax ((error (syntax-rules ()
                         ((_ args ...)
                          (begin
                            (set! fail? #t)
-                           (format (current-error-port)
-                                   args ...))))))
+                           (report-error args ...))))))
     (for-each (lambda (fs)
                 (catch 'system-error
                   (lambda ()
@@ -582,9 +586,9 @@ any, are available.  Raise an error if they're not."
                   (lambda args
                     (let ((errno  (system-error-errno args))
                           (device (file-system-device fs)))
-                      (error (G_ "~a: error: device '~a' not found: ~a~%")
-                             (file-system-location* fs) device
-                             (strerror errno))
+                      (error (file-system-location* fs)
+                             (G_ "device '~a' not found: ~a~%")
+                             device (strerror errno))
                       (unless (string-prefix? "/" device)
                         (display-hint (format #f (G_ "If '~a' is a file system
 label, write @code{(file-system-label ~s)} in your @code{device} field.")
@@ -594,13 +598,14 @@ label, write @code{(file-system-label ~s)} in your @code{device} field.")
                 (let ((label (file-system-label->string
                               (file-system-device fs))))
                   (unless (find-partition-by-label label)
-                    (error (G_ "~a: error: file system with label '~a' not found~%")
-                           (file-system-location* fs) label))))
+                    (error (file-system-location* fs)
+                           (G_ "file system with label '~a' not found~%")
+                           label))))
               labeled)
     (for-each (lambda (fs)
                 (unless (find-partition-by-uuid (file-system-device fs))
-                  (error (G_ "~a: error: file system with UUID '~a' not found~%")
-                         (file-system-location* fs)
+                  (error (file-system-location* fs)
+                         (G_ "file system with UUID '~a' not found~%")
                          (uuid->string (file-system-device fs)))))
               uuid)
 
@@ -663,7 +668,7 @@ checking this by themselves in their 'check' procedure."
 (define* (system-derivation-for-action os base-image action
                                        #:key image-size file-system-type
                                        full-boot? container-shared-network?
-                                       mappings)
+                                       mappings label)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
@@ -687,7 +692,7 @@ checking this by themselves in their 'check' procedure."
      (lower-object
       (system-image
        (image
-        (inherit base-image)
+        (inherit (if label (image-with-label base-image label) base-image))
         (size image-size)
         (operating-system os)))))
     ((docker-image)
@@ -742,7 +747,7 @@ and TARGET arguments."
                          install-bootloader?
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
-                         image-size file-system-type full-boot?
+                         image-size file-system-type full-boot? label
                          container-shared-network?
                          (mappings '())
                          (gc-root #f))
@@ -796,6 +801,7 @@ static checks."
       ((target*   (current-target-system))
        (image ->  (find-image file-system-type target*))
        (sys       (system-derivation-for-action os image action
+                                                #:label label
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
@@ -836,7 +842,9 @@ static checks."
                  (upgrade-shepherd-services local-eval os)
                  (return (format #t (G_ "\
 To complete the upgrade, run 'herd restart SERVICE' to stop,
-upgrade, and restart each service that was not automatically restarted.\n"))))))
+upgrade, and restart each service that was not automatically restarted.\n")))
+                 (return (format #t (G_ "\
+Run 'herd status' to view the list of services on your system.\n"))))))
             ((init)
              (newline)
              (format #t (G_ "initializing operating system under '~a'...~%")
@@ -944,6 +952,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --no-bootloader    for 'init', do not install a bootloader"))
   (display (G_ "
+      --label=LABEL      for 'disk-image', label disk image with LABEL"))
+  (display (G_ "
       --save-provenance  save provenance information"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
@@ -1009,6 +1019,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
+         (option '("label") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'label arg result)))
          (option '("full-boot") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'full-boot? #t result)))
@@ -1066,7 +1079,14 @@ Some ACTIONS support additional ARGS.\n"))
     (validate-reconfigure . ,ensure-forward-reconfigure)
     (file-system-type . "ext4")
     (image-size . guess)
-    (install-bootloader? . #t)))
+    (install-bootloader? . #t)
+    (label . #f)))
+
+(define (verbosity-level opts)
+  "Return the verbosity level based on OPTS, the alist of parsed options."
+  (or (assoc-ref opts 'verbosity)
+      (if (eq? (assoc-ref opts 'action) 'build)
+          2 1)))
 
 
 ;;;
@@ -1114,6 +1134,7 @@ resulting from command-line parsing."
 
          (dry?        (assoc-ref opts 'dry-run?))
          (bootloader? (assoc-ref opts 'install-bootloader?))
+         (label       (assoc-ref opts 'label))
          (target-file (match args
                         ((first second) second)
                         (_ #f)))
@@ -1127,6 +1148,8 @@ resulting from command-line parsing."
 
       (with-build-handler (build-notifier #:use-substitutes?
                                           (assoc-ref opts 'substitutes?)
+                                          #:verbosity
+                                          (verbosity-level opts)
                                           #:dry-run?
                                           (assoc-ref opts 'dry-run?))
         (run-with-store store
@@ -1162,6 +1185,7 @@ resulting from command-line parsing."
                                                         (_ #f))
                                                       opts)
                                #:install-bootloader? bootloader?
+                               #:label label
                                #:target target-file
                                #:bootloader-target bootloader-target
                                #:gc-root (assoc-ref opts 'gc-root)))))
@@ -1283,8 +1307,7 @@ argument list and OPTS is the option alist."
            (args     (option-arguments opts))
            (command  (assoc-ref opts 'action)))
       (parameterize ((%graft? (assoc-ref opts 'graft?)))
-        (with-status-verbosity (or (assoc-ref opts 'verbosity)
-                                   (if (eq? command 'build) 2 1))
+        (with-status-verbosity (verbosity-level opts)
           (process-command command args opts))))))
 
 ;;; Local Variables:
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 9013e035f7..45bb1d5d3b 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -39,7 +39,6 @@
   #:autoload   (guix git) (update-cached-checkout)
   #:use-module (guix i18n)
   #:use-module (guix diagnostics)
-  #:use-module ((guix utils) #:select (&fix-hint))
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -340,24 +339,25 @@ to commits of channels in NEW."
               old))
 
 (define* (check-forward-update #:optional
-                               (validate-reconfigure ensure-forward-reconfigure))
+                               (validate-reconfigure
+                                ensure-forward-reconfigure)
+                               #:key
+                               (current-channels
+                                (system-provenance "/run/current-system")))
   "Call VALIDATE-RECONFIGURE passing it, for each channel, the channel, the
-currently-deployed commit (as returned by 'guix system describe') and the
-target commit (as returned by 'guix describe')."
-  ;; TODO: Make that functionality available to 'guix deploy'.
+currently-deployed commit (from CURRENT-CHANNELS, which is as returned by
+'guix system describe' by default) and the target commit (as returned by 'guix
+describe')."
   (define new
     (or (and=> (current-profile) profile-channels)
         '()))
 
-  (define old
-    (system-provenance "/run/current-system"))
-
-  (when (null? old)
-    (warning (G_ "cannot determine provenance for /run/current-system~%")))
+  (when (null? current-channels)
+    (warning (G_ "cannot determine provenance for current system~%")))
   (when (and (null? new) (not (getenv "GUIX_UNINSTALLED")))
     (warning (G_ "cannot determine provenance of ~a~%") %guix-package-name))
 
   (for-each (match-lambda
               ((channel old new relation)
                (validate-reconfigure channel old new relation)))
-            (channel-relations old new)))
+            (channel-relations current-channels new)))
diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm
index 7f14a2fdbe..d2784669be 100644
--- a/guix/scripts/upgrade.scm
+++ b/guix/scripts/upgrade.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -60,7 +61,7 @@ This is an alias for 'guix package -u'.\n"))
          ;; Preserve some of the 'guix package' options.
          (append (filter (lambda (option)
                            (any (cut member <> (option-names option))
-                                '("profile" "dry-run" "verbosity")))
+                                '("profile" "dry-run" "verbosity" "do-not-upgrade")))
                          %package-options)
 
                  %transformation-options
diff --git a/guix/self.scm b/guix/self.scm
index f70b1ecdd8..6a1640acdf 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -53,10 +53,10 @@
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+      ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
+      ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'guile3.0-gnutls))
-      ("zlib"       (ref '(gnu packages compression) 'zlib))
-      ("lzlib"      (ref '(gnu packages compression) 'lzlib))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
@@ -727,8 +727,6 @@ Info manual."
                         (name (string-append "guix-" version))
                         (guile-version (effective-version))
                         (guile-for-build (default-guile))
-                        (zlib (specification->package "zlib"))
-                        (lzlib (specification->package "lzlib"))
                         (gzip (specification->package "gzip"))
                         (bzip2 (specification->package "bzip2"))
                         (xz (specification->package "xz"))
@@ -746,6 +744,12 @@ Info manual."
   (define guile-sqlite3
     (specification->package "guile-sqlite3"))
 
+  (define guile-zlib
+    (specification->package "guile-zlib"))
+
+  (define guile-lzlib
+    (specification->package "guile-lzlib"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
@@ -757,7 +761,7 @@ Info manual."
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
                        (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3))
+                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
@@ -884,9 +888,7 @@ Info manual."
                  '()
                  #:extra-modules
                  `(((guix config)
-                    => ,(make-config.scm #:zlib zlib
-                                         #:lzlib lzlib
-                                         #:gzip gzip
+                    => ,(make-config.scm #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
                                          #:package-name
@@ -983,7 +985,7 @@ Info manual."
                                       (variables rest ...))))))
     (variables %localstatedir %storedir %sysconfdir)))
 
-(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
@@ -1004,8 +1006,6 @@ Info manual."
                                %state-directory
                                %store-database-directory
                                %config-directory
-                               %libz
-                               %liblz
                                %gzip
                                %bzip2
                                %xz))
@@ -1048,15 +1048,7 @@ Info manual."
                    (define %bzip2
                      #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                    (define %xz
-                     #+(and xz (file-append xz "/bin/xz")))
-
-                   (define %libz
-                     #+(and zlib
-                            (file-append zlib "/lib/libz")))
-
-                   (define %liblz
-                     #+(and lzlib
-                            (file-append lzlib "/lib/liblz"))))
+                     #+(and xz (file-append xz "/bin/xz"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are
diff --git a/guix/ssh.scm b/guix/ssh.scm
index b9e6ff8564..e41bffca65 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -20,7 +20,11 @@
   #:use-module (guix store)
   #:use-module (guix inferior)
   #:use-module (guix i18n)
-  #:use-module ((guix utils) #:select (&fix-hint))
+  #:use-module ((guix diagnostics)
+                #:select (info &fix-hint formatted-message))
+  #:use-module ((guix progress)
+                #:select (progress-bar
+                          erase-current-line current-terminal-columns))
   #:use-module (gcrypt pk-crypto)
   #:use-module (ssh session)
   #:use-module (ssh auth)
@@ -36,6 +40,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 vlist)
   #:export (open-ssh-session
             authenticate-server*
 
@@ -88,14 +93,12 @@ actual key does not match."
       ;; provided its Ed25519 key when we where expecting its RSA key.  XXX:
       ;; Guile-SSH 0.10.1 doesn't know about ed25519 keys and 'get-key-type'
       ;; returns #f in that case.
-      (raise (condition
-              (&message
-               (message (format #f (G_ "server at '~a' returned host key \
+      (raise (formatted-message (G_ "server at '~a' returned host key \
 '~a' of type '~a' instead of '~a' of type '~a'~%")
                                 (session-get session 'host)
                                 (public-key->string server)
                                 (get-key-type server)
-                                key type))))))))
+                                key type)))))
 
 (define* (open-ssh-session host #:key user port identity
                            host-key
@@ -148,12 +151,10 @@ Throw an error on failure."
            (match (authenticate-server session)
              ('ok #f)
              (reason
-              (raise (condition
-                      (&message
-                       (message (format #f (G_ "failed to authenticate \
+              (raise (formatted-message (G_ "failed to authenticate \
 server at '~a': ~a")
                                         (session-get session 'host)
-                                        reason))))))))
+                                        reason)))))
 
        ;; Use public key authentication, via the SSH agent if it's available.
        (match (userauth-public-key/auto! session)
@@ -173,10 +174,8 @@ server at '~a': ~a")
                                        host (get-error session)))))))))))
       (x
        ;; Connection failed or timeout expired.
-       (raise (condition
-               (&message
-                (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
-                                 host (get-error session))))))))))
+       (raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%")
+                                 host (get-error session)))))))
 
 (define* (remote-inferior session #:optional become-command)
   "Return a remote inferior for the given SESSION.  If BECOME-COMMAND is
@@ -187,11 +186,9 @@ given, use that to invoke the remote Guile REPL."
     (when (eof-object? (peek-char pipe))
       (let ((status (channel-get-exit-status pipe)))
         (close-port pipe)
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+        (raise (formatted-message (G_ "remote command '~{~a~^ ~}' failed \
 with status ~a")
-                                  repl-command status)))))))
+                                  repl-command status))))
     (port->inferior pipe)))
 
 (define* (inferior-remote-eval exp session #:optional become-command)
@@ -291,6 +288,11 @@ can be written."
   ;; consumed.
   (define import
     `(begin
+       (eval-when (load expand eval)
+         (unless (resolve-module '(guix) #:ensure #f)
+           (write `(module-error))
+           (exit 7)))
+
        (use-modules (guix) (srfi srfi-34)
                     (rnrs io ports) (rnrs bytevectors))
 
@@ -313,6 +315,9 @@ can be written."
                        (consume-input (current-input-port))
                        (list 'protocol-error (nix-protocol-error-message c))))
               (with-store store
+                (write '(importing))              ;we're ready
+                (force-output)
+
                 (setvbuf (current-input-port) 'none)
                 (import-paths store (current-input-port))
                 '(success))))
@@ -402,6 +407,56 @@ to the system ACL file if it has not yet been authorized."
    session
    become-command))
 
+(define (prepare-to-send store host log-port items)
+  "Notify the user that we're about to send ITEMS to HOST.  Return three
+values allowing 'notify-send-progress' to track the state of this transfer."
+  (let* ((count (length items))
+         (sizes (fold (lambda (item result)
+                        (vhash-cons item
+                                    (path-info-nar-size
+                                     (query-path-info store item))
+                                    result))
+                      vlist-null
+                      items))
+         (total  (vlist-fold (lambda (pair result)
+                               (match pair
+                                 ((_ . size) (+ size result))))
+                             0
+                             sizes)))
+    (info (N_ "sending ~a store item (~h MiB) to '~a'...~%"
+              "sending ~a store items (~h MiB) to '~a'...~%" count)
+          count
+          (inexact->exact (round (/ total (expt 2. 20))))
+          host)
+
+    (values log-port sizes total 0)))
+
+(define (notify-transfer-progress item port sizes total sent)
+  "Notify the user that we've already transferred SENT bytes out of TOTAL.
+Use SIZES to determine the size of ITEM, which is about to be sent."
+  (define (display-bar %)
+    (erase-current-line port)
+    (format port "~3@a% ~a"
+            (inexact->exact (round (* 100. (/ sent total))))
+            (progress-bar % (- (max (current-terminal-columns) 5) 5)))
+    (force-output port))
+
+  (unless (zero? total)
+    (let ((% (* 100. (/ sent total))))
+      (match (vhash-assoc item sizes)
+        (#f
+         (display-bar %)
+         (values port sizes total sent))
+        ((_ . size)
+         (display-bar %)
+         (values port sizes total (+ sent size)))))))
+
+(define (notify-transfer-completion port . args)
+  "Notify the user that the transfer has completed."
+  (apply notify-transfer-progress "" port args) ;display the 100% progress bar
+  (erase-current-line port)
+  (force-output port))
+
 (define* (send-files local files remote
                      #:key
                      recursive?
@@ -409,24 +464,11 @@ to the system ACL file if it has not yet been authorized."
   "Send the subset of FILES from LOCAL (a local store) that's missing to
 REMOTE, a remote store.  When RECURSIVE? is true, send the closure of FILES.
 Return the list of store items actually sent."
-  (define (inferior-remote-eval* exp session)
-    (guard (c ((inferior-exception? c)
-               (match (inferior-exception-arguments c)
-                 (('quit 7)
-                  (report-module-error (remote-store-host remote)))
-                 (_
-                  (report-inferior-exception c (remote-store-host remote))))))
-      (inferior-remote-eval exp session)))
-
   ;; Compute the subset of FILES missing on SESSION and send them.
   (let* ((files   (if recursive? (requisites local files) files))
          (session (channel-get-session (store-connection-socket remote)))
-         (missing (inferior-remote-eval*
+         (missing (inferior-remote-eval
                    `(begin
-                      (eval-when (load expand eval)
-                        (unless (resolve-module '(guix) #:ensure #f)
-                          (exit 7)))
-
                       (use-modules (guix)
                                    (srfi srfi-1) (srfi srfi-26))
 
@@ -434,19 +476,21 @@ Return the list of store items actually sent."
                         (remove (cut valid-path? store <>)
                                 ',files)))
                    session))
-         (count   (length missing))
-         (sizes   (map (lambda (item)
-                         (path-info-nar-size (query-path-info local item)))
-                       missing))
-         (port    (store-import-channel session)))
-    (format log-port (N_ "sending ~a store item (~h MiB) to '~a'...~%"
-                         "sending ~a store items (~h MiB) to '~a'...~%" count)
-            count
-            (inexact->exact (round (/ (reduce + 0 sizes) (expt 2. 20))))
-            (session-get session 'host))
+         (port    (store-import-channel session))
+         (host    (session-get session 'host)))
+    ;; Make sure everything alright on the remote side.
+    (match (read port)
+      (('importing)
+       #t)
+      (sexp
+       (handle-import/export-channel-error sexp remote)))
 
     ;; Send MISSING in topological order.
-    (export-paths local missing port)
+    (let ((tty? (isatty? log-port)))
+      (export-paths local missing port
+                    #:start (cut prepare-to-send local host log-port <>)
+                    #:progress (if tty? notify-transfer-progress (const #f))
+                    #:finish (if tty? notify-transfer-completion (const #f))))
 
     ;; Tell the remote process that we're done.  (In theory the end-of-archive
     ;; mark of 'export-paths' would be enough, but in practice it's not.)
@@ -513,6 +557,29 @@ to the length of FILES.)"
              (&message
               (message (format #f fmt args ...))))))))
 
+(define (handle-import/export-channel-error sexp remote)
+  "Report an error corresponding to SEXP, the EOF object or an sexp read from
+REMOTE."
+  (match sexp
+    ((? eof-object?)
+     (report-guile-error (remote-store-host remote)))
+    (('module-error . _)
+     (report-module-error (remote-store-host remote)))
+    (('connection-error file code . _)
+     (raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
+                  file (remote-store-host remote) (strerror code)))
+    (('invalid-items items . _)
+     (raise-error (N_ "no such item on remote host '~A':~{ ~a~}"
+                      "no such items on remote host '~A':~{ ~a~}"
+                      (length items))
+                  (remote-store-host remote) items))
+    (('protocol-error status message . _)
+     (raise-error (G_ "protocol error on remote host '~A': ~a")
+                  (remote-store-host remote) message))
+    (_
+     (raise-error (G_ "failed to retrieve store items from '~a'")
+                  (remote-store-host remote)))))
+
 (define* (retrieve-files* files remote
                           #:key recursive? (log-port (current-error-port))
                           (import (const #f)))
@@ -533,24 +600,8 @@ from REMOTE.  When RECURSIVE? is true, retrieve the closure of FILES."
            (import port))
          (lambda ()
            (close-port port))))
-      ((? eof-object?)
-       (report-guile-error (remote-store-host remote)))
-      (('module-error . _)
-       (report-module-error (remote-store-host remote)))
-      (('connection-error file code . _)
-       (raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
-                    file (remote-store-host remote) (strerror code)))
-      (('invalid-items items . _)
-       (raise-error (N_ "no such item on remote host '~A':~{ ~a~}"
-                        "no such items on remote host '~A':~{ ~a~}"
-                        (length items))
-                    (remote-store-host remote) items))
-      (('protocol-error status message . _)
-       (raise-error (G_ "protocol error on remote host '~A': ~a")
-                    (remote-store-host remote) message))
-      (_
-       (raise-error (G_ "failed to retrieve store items from '~a'")
-                    (remote-store-host remote))))))
+      (sexp
+       (handle-import/export-channel-error sexp remote)))))
 
 (define* (retrieve-files local files remote
                          #:key recursive? (log-port (current-error-port)))
diff --git a/guix/store.scm b/guix/store.scm
index 683e125b20..d859ea33ed 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -628,9 +628,10 @@ connection.  Use with care."
     (define (thunk)
       (parameterize ((current-store-protocol-version
                       (store-connection-version store)))
-        (let ((result (proc store)))
-          (close-connection store)
-          result)))
+        (call-with-values (lambda () (proc store))
+          (lambda results
+            (close-connection store)
+            (apply values results)))))
 
     (cond-expand
       (guile-3
@@ -819,7 +820,7 @@ encoding conversion errors."
                             (terminal-columns (terminal-columns))
 
                             ;; Locale of the client.
-                            (locale (false-if-exception (setlocale LC_ALL))))
+                            (locale (false-if-exception (setlocale LC_MESSAGES))))
   ;; Must be called after `open-connection'.
 
   (define buffered
@@ -1727,10 +1728,20 @@ is raised if the set of paths read from PORT is not signed (as per
       (or done? (loop (process-stderr server port))))
     (= 1 (read-int s))))
 
-(define* (export-paths server paths port #:key (sign? #t) recursive?)
+(define* (export-paths server paths port #:key (sign? #t) recursive?
+                       (start (const #f))
+                       (progress (const #f))
+                       (finish (const #f)))
   "Export the store paths listed in PATHS to PORT, in topological order,
 signing them if SIGN? is true.  When RECURSIVE? is true, export the closure of
-PATHS---i.e., PATHS and all their dependencies."
+PATHS---i.e., PATHS and all their dependencies.
+
+START, PROGRESS, and FINISH are used to track progress of the data transfer.
+START is a one-argument that is passed the list of store items that will be
+transferred; it returns values that are then used as the initial state
+threaded through PROGRESS calls.  PROGRESS is passed the store item about to
+be sent, along with the values previously return by START or by PROGRESS
+itself.  FINISH is called when the last store item has been called."
   (define ordered
     (let ((sorted (topologically-sorted server paths)))
       ;; When RECURSIVE? is #f, filter out the references of PATHS.
@@ -1738,14 +1749,20 @@ PATHS---i.e., PATHS and all their dependencies."
           sorted
           (filter (cut member <> paths) sorted))))
 
-  (let loop ((paths ordered))
+  (let loop ((paths ordered)
+             (state (call-with-values (lambda () (start ordered))
+                      list)))
     (match paths
       (()
+       (apply finish state)
        (write-int 0 port))
       ((head tail ...)
        (write-int 1 port)
        (and (export-path server head port #:sign? sign?)
-            (loop tail))))))
+            (loop tail
+                  (call-with-values
+                      (lambda () (apply progress head state))
+                    list)))))))
 
 (define-operation (query-failed-paths)
   "Return the list of store items for which a build failure is cached.
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index a742a142ee..df959bdd06 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -164,8 +164,10 @@ under STORE."
                     ((file . properties)
                      (unless (member file '("." ".."))
                        (let* ((file (string-append path "/" file))
-                              (type (or (assq-ref properties 'type)
-                                        (stat:type (lstat file)))))
+                              (type (match (assoc-ref properties 'type)
+                                      ((or 'unknown #f)
+                                       (stat:type (lstat file)))
+                                      (type type))))
                          (loop file type
                                (and (not (eq? 'directory type))
                                     (nar-sha256 file)))))))
diff --git a/guix/ui.scm b/guix/ui.scm
index 27bcade9dd..9513f42b93 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -388,12 +388,18 @@ ARGS is the list of arguments received by the 'throw' handler."
     (('unbound-variable _ ...)
      (report-unbound-variable-error args #:frame frame))
     (((or 'srfi-34 '%exception) obj)
-     (if (message-condition? obj)
-         (report-error (and (error-location? obj)
-                            (error-location obj))
-                       (G_ "~a~%")
-                       (gettext (condition-message obj) %gettext-domain))
-         (report-error (G_ "exception thrown: ~s~%") obj))
+     (cond ((message-condition? obj)
+            (report-error (and (error-location? obj)
+                               (error-location obj))
+                          (G_ "~a~%")
+                          (gettext (condition-message obj) %gettext-domain)))
+           ((formatted-message? obj)
+            (apply report-error
+                   (and (error-location? obj) (error-location obj))
+                   (gettext (formatted-message-string obj) %gettext-domain)
+                   (formatted-message-arguments obj)))
+           (else
+            (report-error (G_ "exception thrown: ~s~%") obj)))
      (when (fix-hint? obj)
        (display-hint (condition-fix-hint obj))))
     ((key args ...)
@@ -420,12 +426,19 @@ exiting.  ARGS is the list of arguments received by the 'throw' handler."
     (('unbound-variable _ ...)
      (report-unbound-variable-error args))
     (((or 'srfi-34 '%exception) obj)
-     (if (message-condition? obj)
-         (warning (G_ "failed to load '~a': ~a~%")
-                  file
-                  (gettext (condition-message obj) %gettext-domain))
-         (warning (G_ "failed to load '~a': exception thrown: ~s~%")
-                  file obj)))
+     (cond ((message-condition? obj)
+            (warning (G_ "failed to load '~a': ~a~%")
+                     file
+                     (gettext (condition-message obj) %gettext-domain)))
+           ((formatted-message? obj)
+            (warning (G_ "failed to load '~a': ~a~%")
+                     (apply format #f
+                            (gettext (formatted-message-string obj)
+                                     %gettext-domain)
+                            (formatted-message-arguments obj))))
+           (else
+            (warning (G_ "failed to load '~a': exception thrown: ~s~%")
+                     file obj))))
     ((error args ...)
      (warning (G_ "failed to load '~a':~%") module)
      (apply display-error #f (current-error-port) args)
@@ -481,7 +494,11 @@ guix package -i glibc-utf8-locales
 export GUIX_LOCPATH=\"$HOME/.guix-profile/lib/locale\"
 @end example
 
-See the \"Application Setup\" section in the manual, for more info.\n")))))
+See the \"Application Setup\" section in the manual, for more info.\n"))
+      ;; We're now running in the "C" locale.  Try to install a UTF-8 locale
+      ;; instead.  This one is guaranteed to be available in 'guix' from 'guix
+      ;; pull'.
+      (false-if-exception (setlocale LC_ALL "en_US.utf8")))))
 
 (define (initialize-guix)
   "Perform the usual initialization for stand-alone Guix commands."
@@ -782,17 +799,15 @@ directories:~{ ~a~}~%")
                      (invoke-error-stop-signal c)
                      (cons (invoke-error-program c)
                            (invoke-error-arguments c))))
-             ((and (error-location? c) (message-condition? c))
-              (report-error (error-location c) (G_ "~a~%")
-                            (gettext (condition-message c) %gettext-domain))
+
+             ((formatted-message? c)
+              (apply report-error
+                     (and (error-location? c) (error-location c))
+                     (gettext (formatted-message-string c) %gettext-domain)
+                     (formatted-message-arguments c))
               (when (fix-hint? c)
                 (display-hint (condition-fix-hint c)))
               (exit 1))
-             ((and (message-condition? c) (fix-hint? c))
-              (report-error (G_ "~a~%")
-                            (gettext (condition-message c) %gettext-domain))
-              (display-hint (condition-fix-hint c))
-              (exit 1))
 
              ;; On Guile 3.0.0, exceptions such as 'unbound-variable' are
              ;; compound and include a '&message'.  However, that message only
@@ -810,8 +825,12 @@ directories:~{ ~a~}~%")
 
              ((message-condition? c)
               ;; Normally '&message' error conditions have an i18n'd message.
-              (leave (G_ "~a~%")
-                     (gettext (condition-message c) %gettext-domain))))
+              (report-error (and (error-location? c) (error-location c))
+                            (G_ "~a~%")
+                            (gettext (condition-message c) %gettext-domain))
+              (when (fix-hint? c)
+                (display-hint (condition-fix-hint c)))
+              (exit 1)))
       ;; Catch EPIPE and the likes.
       (catch 'system-error
         thunk
@@ -862,11 +881,17 @@ similar."
           (('syntax-error proc message properties form . rest)
            (report-error (G_ "syntax error: ~a~%") message))
           (((or 'srfi-34 '%exception) obj)
-           (if (message-condition? obj)
-               (report-error (G_ "~a~%")
-                             (gettext (condition-message obj)
-                                      %gettext-domain))
-               (report-error (G_ "exception thrown: ~s~%") obj)))
+           (cond ((message-condition? obj)
+                  (report-error (G_ "~a~%")
+                                (gettext (condition-message obj)
+                                         %gettext-domain)))
+                 ((formatted-message? obj)
+                  (apply report-error #f
+                         (gettext (formatted-message-string obj)
+                                  %gettext-domain)
+                         (formatted-message-arguments obj)))
+                 (else
+                  (report-error (G_ "exception thrown: ~s~%") obj))))
           ((error args ...)
            (apply display-error #f (current-error-port) args))
           (what? #f))
@@ -931,17 +956,25 @@ that the rest."
                                         (color DARK))
                        (string-drop file prefix)))))
 
+(define %default-verbosity
+  ;; Default verbosity level for 'show-what-to-build'.
+  2)
+
 (define* (show-what-to-build store drv
                              #:key dry-run? (use-substitutes? #t)
+                             (verbosity %default-verbosity)
                              (mode (build-mode normal)))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
 derivations listed in DRV using MODE, a 'build-mode' value.  The elements of
 DRV can be either derivations or derivation inputs.
 
 Return two values: a Boolean indicating whether there's something to build,
-and a Boolean indicating whether there's something to download.  When
-USE-SUBSTITUTES?, check and report what is prerequisites are available for
-download."
+and a Boolean indicating whether there's something to download.
+
+When USE-SUBSTITUTES?, check and report what is prerequisites are available
+for download.  VERBOSITY is an integer indicating the level of details to be
+shown: level 2 and higher provide all the details, level 1 shows a high-level
+summary, and level 0 shows nothing."
   (define inputs
     (map (match-lambda
            ((? derivation? drv) (derivation-input drv))
@@ -1000,71 +1033,104 @@ download."
       ;; display when we have information for all of DOWNLOAD.
       (not (any (compose zero? substitutable-download-size) download)))
 
+    ;; Combinatorial explosion ahead along two axes: DRY-RUN? and VERBOSITY.
+    ;; Unfortunately, this is hardly avoidable for proper i18n.
     (if dry-run?
         (begin
-          (format (current-error-port)
-                  (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
-                      "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
-                      (length build))
-                  (null? build) (map colorized-store-item build))
-          (if display-download-size?
-              (format (current-error-port)
-                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
-                      ;; translated to the corresponding abbreviation.
-                      (G_ "~:[~,1h MB would be downloaded:~%~{   ~a~%~}~;~]")
-                      (null? download)
-                      download-size
-                      (map (compose colorized-store-item substitutable-path)
-                           download))
-              (format (current-error-port)
-                      (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
-                          "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
-                          (length download))
-                      (null? download)
-                      (map (compose colorized-store-item substitutable-path)
-                           download)))
-          (format (current-error-port)
-                  (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
-                      "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
-                      (length graft))
-                  (null? graft) (map colorized-store-item graft))
-          (format (current-error-port)
-                  (N_ "~:[The following profile hook would be built:~%~{   ~a~%~}~;~]"
-                      "~:[The following profile hooks would be built:~%~{   ~a~%~}~;~]"
-                      (length hook))
-                  (null? hook) (map colorized-store-item hook)))
+          (unless (zero? verbosity)
+            (format (current-error-port)
+                    (N_ "~:[The following derivation would be built:~%~{   ~a~%~}~;~]"
+                        "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
+                        (length build))
+                    (null? build) (map colorized-store-item build)))
+          (cond ((>= verbosity 2)
+                 (if display-download-size?
+                     (format (current-error-port)
+                             ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                             ;; translated to the corresponding abbreviation.
+                             (G_ "~:[~,1h MB would be downloaded:~%~{   ~a~%~}~;~]")
+                             (null? download)
+                             download-size
+                             (map (compose colorized-store-item substitutable-path)
+                                  download))
+                     (format (current-error-port)
+                             (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
+                                 "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
+                                 (length download))
+                             (null? download)
+                             (map (compose colorized-store-item substitutable-path)
+                                  download)))
+                 (format (current-error-port)
+                         (N_ "~:[The following graft would be made:~%~{   ~a~%~}~;~]"
+                             "~:[The following grafts would be made:~%~{   ~a~%~}~;~]"
+                             (length graft))
+                         (null? graft) (map colorized-store-item graft))
+                 (format (current-error-port)
+                         (N_ "~:[The following profile hook would be built:~%~{   ~a~%~}~;~]"
+                             "~:[The following profile hooks would be built:~%~{   ~a~%~}~;~]"
+                             (length hook))
+                         (null? hook) (map colorized-store-item hook)))
+                ((= verbosity 1)
+                 ;; Display the bare minimum; don't mention grafts and hooks.
+                 (if display-download-size?
+                     (format (current-error-port)
+                             ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                             ;; translated to the corresponding abbreviation.
+                             (G_ "~:[~,1h MB would be downloaded~%~;~]")
+                             (null? download) download-size)
+                     (format (current-error-port)
+                             (N_ "~:[~h item would be downloaded~%~;~]"
+                                 "~:[~h items would be downloaded~%~;~]"
+                                 (length download))
+                             (null? download) (length download))))))
+
         (begin
-          (format (current-error-port)
-                  (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
-                      "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
-                      (length build))
-                  (null? build) (map colorized-store-item build))
-          (if display-download-size?
-              (format (current-error-port)
-                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
-                      ;; translated to the corresponding abbreviation.
-                      (G_ "~:[~,1h MB will be downloaded:~%~{   ~a~%~}~;~]")
-                      (null? download)
-                      download-size
-                      (map (compose colorized-store-item substitutable-path)
-                           download))
-              (format (current-error-port)
-                      (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
-                          "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
-                          (length download))
-                      (null? download)
-                      (map (compose colorized-store-item substitutable-path)
-                           download)))
-          (format (current-error-port)
-                  (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
-                      "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
-                      (length graft))
-                  (null? graft) (map colorized-store-item graft))
-          (format (current-error-port)
-                  (N_ "~:[The following profile hook will be built:~%~{   ~a~%~}~;~]"
-                      "~:[The following profile hooks will be built:~%~{   ~a~%~}~;~]"
-                      (length hook))
-                  (null? hook) (map colorized-store-item hook))))
+          (unless (zero? verbosity)
+            (format (current-error-port)
+                    (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
+                        "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
+                        (length build))
+                    (null? build) (map colorized-store-item build)))
+          (cond ((>= verbosity 2)
+                 (if display-download-size?
+                     (format (current-error-port)
+                             ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                             ;; translated to the corresponding abbreviation.
+                             (G_ "~:[~,1h MB will be downloaded:~%~{   ~a~%~}~;~]")
+                             (null? download)
+                             download-size
+                             (map (compose colorized-store-item substitutable-path)
+                                  download))
+                     (format (current-error-port)
+                             (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
+                                 "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
+                                 (length download))
+                             (null? download)
+                             (map (compose colorized-store-item substitutable-path)
+                                  download)))
+                 (format (current-error-port)
+                         (N_ "~:[The following graft will be made:~%~{   ~a~%~}~;~]"
+                             "~:[The following grafts will be made:~%~{   ~a~%~}~;~]"
+                             (length graft))
+                         (null? graft) (map colorized-store-item graft))
+                 (format (current-error-port)
+                         (N_ "~:[The following profile hook will be built:~%~{   ~a~%~}~;~]"
+                             "~:[The following profile hooks will be built:~%~{   ~a~%~}~;~]"
+                             (length hook))
+                         (null? hook) (map colorized-store-item hook)))
+                ((= verbosity 1)
+                 ;; Display the bare minimum; don't mention grafts and hooks.
+                 (if display-download-size?
+                     (format (current-error-port)
+                             ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                             ;; translated to the corresponding abbreviation.
+                             (G_ "~:[~,1h MB will be downloaded~%~;~]")
+                             (null? download) download-size)
+                     (format (current-error-port)
+                             (N_ "~:[~h item will be downloaded~%~;~]"
+                                 "~:[~h items will be downloaded~%~;~]"
+                                 (length download))
+                             (null? download) (length download)))))))
 
     (check-available-space installed-size)
 
@@ -1073,7 +1139,8 @@ download."
 (define show-what-to-build*
   (store-lift show-what-to-build))
 
-(define* (build-notifier #:key (dry-run? #f) (use-substitutes? #t))
+(define* (build-notifier #:key (dry-run? #f) (use-substitutes? #t)
+                         (verbosity %default-verbosity))
   "Return a procedure suitable for 'with-build-handler' that, when
 'build-things' is called, invokes 'show-what-to-build' to display the build
 plan.  When DRY-RUN? is true, the 'with-build-handler' form returns without
@@ -1107,6 +1174,7 @@ any build happening."
                   (show-what-to-build store inputs
                                       #:dry-run? dry-run?
                                       #:use-substitutes? use-substitutes?
+                                      #:verbosity verbosity
                                       #:mode mode)))
 
       (unless (and (or build? download?)
@@ -1587,13 +1655,18 @@ score, the more relevant OBJ is to REGEXPS."
 zero means that PACKAGE does not match any of REGEXPS."
   (relevance package regexps %package-metrics))
 
-(define (call-with-paginated-output-port proc)
+(define* (call-with-paginated-output-port proc
+                                          #:key (less-options "FrX"))
   (if (isatty?* (current-output-port))
       ;; Set 'LESS' so that 'less' exits if everything fits on the screen (F),
       ;; lets ANSI escapes through (r), does not send the termcap
       ;; initialization string (X).  Set it unconditionally because some
       ;; distros set it to something that doesn't work here.
-      (let ((pager (with-environment-variables `(("LESS" "FrX"))
+      ;;
+      ;; For things that produce long lines, such as 'guix processes', use 'R'
+      ;; instead of 'r': this strips hyperlinks but allows 'less' to make a
+      ;; good estimate of the line length.
+      (let ((pager (with-environment-variables `(("LESS" ,less-options))
                      (open-pipe* OPEN_WRITE
                                  (or (getenv "GUIX_PAGER") (getenv "PAGER")
                                      "less")))))
@@ -1603,10 +1676,15 @@ zero means that PACKAGE does not match any of REGEXPS."
           (lambda () (close-pipe pager))))
       (proc (current-output-port))))
 
-(define-syntax-rule (with-paginated-output-port port exp ...)
-  "Evaluate EXP... with PORT bound to a port that talks to the pager if
+(define-syntax with-paginated-output-port
+  (syntax-rules ()
+    "Evaluate EXP... with PORT bound to a port that talks to the pager if
 standard output is a tty, or with PORT set to the current output port."
-  (call-with-paginated-output-port (lambda (port) exp ...)))
+    ((_ port exp ... #:less-options opts)
+     (call-with-paginated-output-port (lambda (port) exp ...)
+                                      #:less-options opts))
+    ((_ port exp ...)
+     (call-with-paginated-output-port (lambda (port) exp ...)))))
 
 (define* (display-search-results matches port
                                  #:key
@@ -1776,9 +1854,7 @@ DURATION-RELATION with the current time."
          filter-by-duration)
         (else
          (raise
-          (condition (&message
-                      (message (format #f (G_ "invalid syntax: ~a~%")
-                                       str))))))))
+          (formatted-message (G_ "invalid syntax: ~a~%") str)))))
 
 (define (display-generation profile number)
   "Display a one-line summary of generation NUMBER of PROFILE."
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 70cbfb45e8..6584d5e4c4 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -369,7 +369,7 @@ SOURCE, an <upstream-source>."
      (let*-values (((archive-type)
                     (match (and=> (package-source package) origin-uri)
                       ((? string? uri)
-                       (let ((type (file-extension (basename uri))))
+                       (let ((type (or (file-extension (basename uri)) "")))
                          ;; Sometimes we have URLs such as
                          ;; "https://github.com/…/tarball/v0.1", in which case
                          ;; we must not consider "1" as the extension.
@@ -417,12 +417,13 @@ values: 'always', 'never', and 'interactive' (default)."
                       #f))))
        (match (assq method %method-updates)
          (#f
-          (raise (condition (&message
-                             (message (format #f (G_ "cannot download for \
+          (raise (make-compound-condition
+                  (formatted-message (G_ "cannot download for \
 this method: ~s")
-                                              method)))
-                            (&error-location
-                             (location (package-location package))))))
+                                     method)
+                  (condition
+                   (&error-location
+                    (location (package-location package)))))))
          ((_ . update)
           (update store package source
                   #:key-download key-download)))))
diff --git a/guix/utils.scm b/guix/utils.scm
index 17a96370f1..b816c355dc 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,6 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 ftw)
   #:use-module (rnrs io ports)                    ;need 'port-position' etc.
@@ -37,13 +37,29 @@
   #:use-module (guix memoization)
   #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
+  #:use-module (guix diagnostics)           ;<location>, &error-location, etc.
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (system foreign)
-  #:re-export (memoize)         ; for backwards compatibility
+  #:re-export (<location>                         ;for backwards compatibility
+               location
+               location?
+               location-file
+               location-line
+               location-column
+               source-properties->location
+               location->source-properties
+
+               &error-location
+               error-location?
+               error-location
+
+               &fix-hint
+               fix-hint?
+               condition-fix-hint)
   #:export (strip-keyword-arguments
             default-keyword-arguments
             substitute-keyword-arguments
@@ -51,23 +67,6 @@
 
             current-source-directory
 
-            <location>
-            location
-            location?
-            location-file
-            location-line
-            location-column
-            source-properties->location
-            location->source-properties
-
-            &error-location
-            error-location?
-            error-location
-
-            &fix-hint
-            fix-hint?
-            condition-fix-hint
-
             nix-system->gnu-triplet
             gnu-triplet->nix-system
             %current-system
@@ -84,6 +83,7 @@
             version>?
             version>=?
             version-prefix
+            version-major+minor+point
             version-major+minor
             version-major
             guile-version>?
@@ -208,13 +208,8 @@ buffered data is lost."
 (define (lzip-port proc port . args)
   "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
 Raise an error if lzlib support is missing."
-  (let* ((lzlib       (false-if-exception (resolve-interface '(guix lzlib))))
-         (supported?  (and lzlib
-                           ((module-ref lzlib 'lzlib-available?)))))
-    (if supported?
-        (let ((make-port (module-ref lzlib proc)))
-          (values (make-port port) '()))
-        (error "lzip compression not supported" lzlib))))
+  (let ((make-port (module-ref (resolve-interface '(lzlib)) proc)))
+    (values (make-port port) '())))
 
 (define (decompressed-port compression input)
   "Return an input port where INPUT is decompressed according to COMPRESSION,
@@ -566,6 +561,15 @@ or '= when they denote equal versions."
 For example, (version-prefix \"2.1.47.4.23\" 3) returns \"2.1.47\""
   (string-join (take (string-split version-string #\.) num-parts) "."))
 
+(define (version-major+minor+point version-string)
+  "Return \"major>.<minor>.<point>\", where major, minor and point are the
+major, minor and point version numbers from the version-string.  For example,
+(version-major+minor+point \"6.4.5.2\") returns \"6.4.5\" or
+(version-major+minor+point \"1.19.2-2581-324ca14c3003\") returns \"1.19.2\"."
+  (let* ((3-dot (version-prefix version-string 3))
+         (index (string-index 3-dot #\-)))
+    (or (false-if-exception (substring 3-dot 0 index))
+        3-dot)))
 
 (define (version-major+minor version-string)
   "Return \"<major>.<minor>\", where major and minor are the major and
@@ -834,52 +838,6 @@ be determined."
           ;; raising an error would upset Geiser users
           #f))))))
 
-;; A source location.
-(define-record-type <location>
-  (make-location file line column)
-  location?
-  (file          location-file)                   ; file name
-  (line          location-line)                   ; 1-indexed line
-  (column        location-column))                ; 0-indexed column
-
-(define (location file line column)
-  "Return the <location> object for the given FILE, LINE, and COLUMN."
-  (and line column file
-       (make-location file line column)))
-
-(define (source-properties->location loc)
-  "Return a location object based on the info in LOC, an alist as returned
-by Guile's `source-properties', `frame-source', `current-source-location',
-etc."
-  ;; In accordance with the GCS, start line and column numbers at 1.  Note
-  ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
-  (match loc
-    ((('line . line) ('column . col) ('filename . file)) ;common case
-     (and file line col
-          (make-location file (+ line 1) col)))
-    (#f
-     #f)
-    (_
-     (let ((file (assq-ref loc 'filename))
-           (line (assq-ref loc 'line))
-           (col  (assq-ref loc 'column)))
-       (location file (and line (+ line 1)) col)))))
-
-(define (location->source-properties loc)
-  "Return the source property association list based on the info in LOC,
-a location object."
-  `((line     . ,(and=> (location-line loc) 1-))
-    (column   . ,(location-column loc))
-    (filename . ,(location-file loc))))
-
-(define-condition-type &error-location &error
-  error-location?
-  (location  error-location))                     ;<location>
-
-(define-condition-type &fix-hint &condition
-  fix-hint?
-  (hint condition-fix-hint))                      ;string
-
 ;;; Local Variables:
 ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
 ;;; End:
diff --git a/guix/zlib.scm b/guix/zlib.scm
deleted file mode 100644
index 3bd0ad86c9..0000000000
--- a/guix/zlib.scm
+++ /dev/null
@@ -1,241 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 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 zlib)
-  #:use-module (rnrs bytevectors)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 match)
-  #:use-module (system foreign)
-  #:use-module (guix config)
-  #:export (zlib-available?
-            make-gzip-input-port
-            make-gzip-output-port
-            call-with-gzip-input-port
-            call-with-gzip-output-port
-            %default-buffer-size
-            %default-compression-level))
-
-;;; Commentary:
-;;;
-;;; Bindings to the gzip-related part of zlib's API.  The main limitation of
-;;; this API is that it requires a file descriptor as the source or sink.
-;;;
-;;; Code:
-
-(define %zlib
-  ;; File name of zlib's shared library.  When updating via 'guix pull',
-  ;; '%libz' might be undefined so protect against it.
-  (delay (dynamic-link (if (defined? '%libz)
-                           %libz
-                           "libz"))))
-
-(define (zlib-available?)
-  "Return true if zlib is available, #f otherwise."
-  (false-if-exception (force %zlib)))
-
-(define (zlib-procedure ret name parameters)
-  "Return a procedure corresponding to C function NAME in libz, or #f if
-either zlib or the function could not be found."
-  (match (false-if-exception (dynamic-func name (force %zlib)))
-    ((? pointer? ptr)
-     (pointer->procedure ret ptr parameters))
-    (#f
-     #f)))
-
-(define-wrapped-pointer-type <gzip-file>
-  ;; Scheme counterpart of the 'gzFile' opaque type.
-  gzip-file?
-  pointer->gzip-file
-  gzip-file->pointer
-  (lambda (obj port)
-    (format port "#<gzip-file ~a>"
-            (number->string (object-address obj) 16))))
-
-(define gzerror
-  (let ((proc (zlib-procedure '* "gzerror" '(* *))))
-    (lambda (gzfile)
-      (let* ((errnum* (make-bytevector (sizeof int)))
-             (ptr     (proc (gzip-file->pointer gzfile)
-                            (bytevector->pointer errnum*))))
-        (values (bytevector-sint-ref errnum* 0
-                                     (native-endianness) (sizeof int))
-                (pointer->string ptr))))))
-
-(define gzdopen
-  (let ((proc (zlib-procedure '* "gzdopen" (list int '*))))
-    (lambda (fd mode)
-      "Open file descriptor FD as a gzip stream with the given MODE.  MODE must
-be a string denoting the how FD is to be opened, such as \"r\" for reading or
-\"w9\" for writing data compressed at level 9 to FD.  Calling 'gzclose' also
-closes FD."
-      (let ((result (proc fd (string->pointer mode))))
-        (if (null-pointer? result)
-            (throw 'zlib-error 'gzdopen)
-            (pointer->gzip-file result))))))
-
-(define gzread!
-  (let ((proc (zlib-procedure int "gzread" (list '* '* unsigned-int))))
-    (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)))
-      "Read up to COUNT bytes from GZFILE into BV at offset START.  Return the
-number of uncompressed bytes actually read; it is zero if COUNT is zero or if
-the end-of-stream has been reached."
-      (let ((ret (proc (gzip-file->pointer gzfile)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'zlib-error 'gzread! ret)
-            ret)))))
-
-(define gzwrite
-  (let ((proc (zlib-procedure int "gzwrite" (list '* '* unsigned-int))))
-    (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV at offset START into GZFILE.  Return
-the number of uncompressed bytes written, a strictly positive integer."
-      (let ((ret (proc (gzip-file->pointer gzfile)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (<= ret 0)
-            (throw 'zlib-error 'gzwrite ret)
-            ret)))))
-
-(define gzbuffer!
-  (let ((proc (zlib-procedure int "gzbuffer" (list '* unsigned-int))))
-    (lambda (gzfile size)
-      "Change the internal buffer size of GZFILE to SIZE bytes."
-      (let ((ret (proc (gzip-file->pointer gzfile) size)))
-        (unless (zero? ret)
-          (throw 'zlib-error 'gzbuffer! ret))))))
-
-(define gzeof?
-  (let ((proc (zlib-procedure int "gzeof" '(*))))
-    (lambda (gzfile)
-      "Return true if the end-of-file has been reached on GZFILE."
-      (not (zero? (proc (gzip-file->pointer gzfile)))))))
-
-(define gzclose
-  (let ((proc (zlib-procedure int "gzclose" '(*))))
-    (lambda (gzfile)
-      "Close GZFILE."
-      (let ((ret (proc (gzip-file->pointer gzfile))))
-        (unless (zero? ret)
-          (throw 'zlib-error 'gzclose ret (gzerror gzfile)))))))
-
-
-
-;;;
-;;; Port interface.
-;;;
-
-(define %default-buffer-size
-  ;; Default buffer size, as documented in <zlib.h>.
-  8192)
-
-(define %default-compression-level
-  ;; Z_DEFAULT_COMPRESSION.
-  -1)
-
-(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
-  "Return an input port that decompresses data read from PORT, a file port.
-PORT is automatically closed when the resulting port is closed.  BUFFER-SIZE
-is the size in bytes of the internal buffer, 8 KiB by default; using a larger
-buffer increases decompression speed.  An error is thrown if PORT contains
-buffered input, which would be lost (and is lost anyway)."
-  (define gzfile
-    (match (drain-input port)
-      (""                                         ;PORT's buffer is empty
-       ;; 'gzclose' will eventually close the file descriptor beneath PORT.
-       ;; 'close-port' on PORT would get EBADF if 'gzclose' already closed it,
-       ;; so that's no good; revealed ports are no good either because they
-       ;; leak (see <https://bugs.gnu.org/28784>); calling 'close-port' after
-       ;; 'gzclose' doesn't work either because it leads to a race condition
-       ;; (see <https://bugs.gnu.org/29335>).  So we dup and close PORT right
-       ;; away.
-       (gzdopen (dup (fileno port)) "r"))
-      (_
-       ;; This is unrecoverable but it's better than having the buffered input
-       ;; be lost, leading to unclear end-of-file or corrupt-data errors down
-       ;; the path.
-       (throw 'zlib-error 'make-gzip-input-port
-              "port contains buffered input" port))))
-
-  (define (read! bv start count)
-    (gzread! gzfile bv start count))
-
-  (unless (= buffer-size %default-buffer-size)
-    (gzbuffer! gzfile buffer-size))
-
-  (close-port port)                               ;we no longer need it
-  (make-custom-binary-input-port "gzip-input" read! #f #f
-                                 (lambda ()
-                                   (gzclose gzfile))))
-
-(define* (make-gzip-output-port port
-                                #:key
-                                (level %default-compression-level)
-                                (buffer-size %default-buffer-size))
-  "Return an output port that compresses data at the given LEVEL, using PORT,
-a file port, as its sink.  PORT is automatically closed when the resulting
-port is closed."
-  (define gzfile
-    (begin
-      (force-output port)                         ;empty PORT's buffer
-      (gzdopen (dup (fileno port))
-               (string-append "w" (number->string level)))))
-
-  (define (write! bv start count)
-    (gzwrite gzfile bv start count))
-
-  (unless (= buffer-size %default-buffer-size)
-    (gzbuffer! gzfile buffer-size))
-
-  (close-port port)
-  (make-custom-binary-output-port "gzip-output" write! #f #f
-                                  (lambda ()
-                                    (gzclose gzfile))))
-
-(define* (call-with-gzip-input-port port proc
-                                    #:key (buffer-size %default-buffer-size))
-  "Call PROC with a port that wraps PORT and decompresses data read from it.
-PORT is closed upon completion.  The gzip internal buffer size is set to
-BUFFER-SIZE bytes."
-  (let ((gzip (make-gzip-input-port port #:buffer-size buffer-size)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc gzip))
-      (lambda ()
-        (close-port gzip)))))
-
-(define* (call-with-gzip-output-port port proc
-                                     #:key
-                                     (level %default-compression-level)
-                                     (buffer-size %default-buffer-size))
-  "Call PROC with an output port that wraps PORT and compresses data.  PORT is
-close upon completion.  The gzip internal buffer size is set to BUFFER-SIZE
-bytes."
-  (let ((gzip (make-gzip-output-port port
-                                     #:level level
-                                     #:buffer-size buffer-size)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc gzip))
-      (lambda ()
-        (close-port gzip)))))
-
-;;; zlib.scm ends here