Merge branch master into core-updates

21 files changed, 961 insertions, 240 deletions

diff --git a/guix/build-system/rebar.scm b/guix/build-system/rebar.scm
new file mode 100644
index 0000000000..6ca5abe4d6
--- /dev/null
+++ b/guix/build-system/rebar.scm
@@ -0,0 +1,158 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system rebar)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix monads)
+  #:use-module (guix search-paths)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:export (hexpm-uri
+            hexpm-package-url
+            %rebar-build-system-modules
+            rebar-build
+            rebar-build-system))
+
+;;;
+;;; Definitions for the hex.pm repository,
+;;;
+
+;; URL and paths from
+;; https://github.com/hexpm/specifications/blob/master/endpoints.md
+(define %hexpm-repo-url
+  (make-parameter "https://repo.hex.pm"))
+
+(define hexpm-package-url
+  (string-append (%hexpm-repo-url) "/tarballs/"))
+
+(define (hexpm-uri name version)
+  "Return a URI string for the package hosted at hex.pm corresponding to NAME
+and VERSION."
+  (string-append hexpm-package-url name "-" version ".tar"))
+
+;;
+;; Standard build procedure for Erlang packages using Rebar.
+;;
+
+(define %rebar-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build rebar-build-system)
+    ,@%gnu-build-system-modules))
+
+(define (default-rebar3)
+  "Return the default Rebar3 package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
+    (module-ref erlang-mod 'rebar3)))
+
+(define (default-erlang)
+  "Return the default Erlang package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((erlang-mod (resolve-interface '(gnu packages erlang))))
+    (module-ref erlang-mod 'erlang)))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (rebar (default-rebar3))
+                (erlang (default-erlang))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME from the given arguments."
+  (define private-keywords
+    '(#:target #:rebar #:erlang #:inputs #:native-inputs))
+
+  (and (not target)                               ;XXX: no cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs))
+         (build-inputs `(("rebar" ,rebar)
+                         ("erlang" ,erlang) ;; for escriptize
+                         ,@native-inputs
+                         ;; Keep the standard inputs of 'gnu-build-system'.
+                         ,@(standard-packages)))
+         (outputs outputs)
+         (build rebar-build)
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (rebar-build name inputs
+                       #:key
+                       guile source
+                       (rebar-flags ''("skip_deps=true" "-vv"))
+                       (tests? #t)
+                       (test-target "eunit")
+                       ;; TODO: install-name  ; default: based on guix package name
+                       (install-profile "default")
+                       (phases '(@ (guix build rebar-build-system)
+                                   %standard-phases))
+                       (outputs '("out"))
+                       (search-paths '())
+                       (native-search-paths '())
+                       (system (%current-system))
+                       (imported-modules %rebar-build-system-modules)
+                       (modules '((guix build rebar-build-system)
+                                  (guix build utils))))
+  "Build SOURCE with INPUTS."
+
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+
+          #$(with-build-variables inputs outputs
+              #~(rebar-build #:source #+source
+                      #:system #$system
+                      #:name #$name
+                      #:rebar-flags #$rebar-flags
+                      #:tests? #$tests?
+                      #:test-target #$test-target
+                      ;; TODO: #:install-name #$install-name
+                      #:install-profile #$install-profile
+                      #:phases #$(if (pair? phases)
+                                     (sexp->gexp phases)
+                                     phases)
+                      #:outputs %outputs
+                      #:search-paths '#$(sexp->gexp
+                                         (map search-path-specification->sexp
+                                              search-paths))
+                      #:inputs %build-inputs)))))
+
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    ;; Note: Always pass #:graft? #f.  Without it, ALLOWED-REFERENCES &
+    ;; co. would be interpreted as referring to grafted packages.
+    (gexp->derivation name builder
+                      #:system system
+                      #:target #f
+                      #:graft? #f
+                      #:guile-for-build guile)))
+
+(define rebar-build-system
+  (build-system
+    (name 'rebar)
+    (description "The standard Rebar build system")
+    (lower lower)))
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 60a754b9e9..8ee547f2b3 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2018, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;; Copyright © 2022 Fredrik Salomonsson <plattfot@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,12 +23,22 @@
 (define-module (guix build emacs-utils)
   #:use-module (guix build utils)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:export (%emacs
             emacs-batch-eval
             emacs-batch-edit-file
             emacs-batch-disable-compilation
+            emacs-batch-script
+
+            emacs-batch-error?
+            emacs-batch-error-message
+
             emacs-generate-autoloads
             emacs-byte-compile-directory
+            emacs-header-parse
 
             as-display
             emacs-substitute-sexps
@@ -69,6 +80,26 @@ true, evaluate using dynamic scoping."
       (add-file-local-variable 'no-byte-compile t)
       (basic-save-buffer))))
 
+(define-condition-type &emacs-batch-error &error
+  emacs-batch-error?
+  (message emacs-batch-error-message))
+
+(define (emacs-batch-script expr)
+  "Execute the Elisp code EXPR in Emacs batch mode and return output."
+  (let* ((error-pipe (pipe))
+         (port (parameterize ((current-error-port (cdr error-pipe)))
+                 (open-pipe*
+                  OPEN_READ
+                  (%emacs) "--quick" "--batch"
+                  (string-append "--eval=" (expr->string expr)))))
+         (output (read-string port))
+         (status (close-pipe port)))
+    (close-port (cdr error-pipe))
+    (unless (zero? status)
+      (raise (condition (&emacs-batch-error
+                         (message (read-string (car error-pipe)))))))
+    output))
+
 (define (emacs-generate-autoloads name directory)
   "Generate autoloads for Emacs package NAME placed in DIRECTORY."
   (let* ((file (string-append directory "/" name "-autoloads.el"))
@@ -84,6 +115,14 @@ true, evaluate using dynamic scoping."
                 (byte-recompile-directory (file-name-as-directory ,dir) 0 1))))
     (emacs-batch-eval expr)))
 
+(define (emacs-header-parse section file)
+  "Parse the header SECTION in FILE and return it as a string."
+  (emacs-batch-script
+   `(progn
+     (require 'lisp-mnt)
+     (find-file ,file)
+     (princ (lm-header ,section)))))
+
 (define as-display         ;syntactic keyword for 'emacs-substitute-sexps'
   '(as display))
 
diff --git a/guix/build/rebar-build-system.scm b/guix/build/rebar-build-system.scm
new file mode 100644
index 0000000000..fb66422877
--- /dev/null
+++ b/guix/build/rebar-build-system.scm
@@ -0,0 +1,147 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
+;;; Copyright © 2020, 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build rebar-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module ((guix build utils) #:hide (delete))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (rebar-build
+            %standard-phases))
+
+;;
+;; Builder-side code of the standard build procedure for Erlang packages using
+;; rebar3.
+;;
+;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir
+;; "(include") need to be configurable
+
+(define %erlang-libdir "/lib/erlang/lib")
+
+(define* (erlang-depends #:key inputs #:allow-other-keys)
+  (define input-directories
+    (match inputs
+      (((_ . dir) ...)
+       dir)))
+  (mkdir-p "_checkouts")
+
+  (for-each
+   (lambda (input-dir)
+     (let ((elibdir (string-append input-dir %erlang-libdir)))
+       (when (directory-exists? elibdir)
+         (for-each
+          (lambda (dirname)
+            (let ((dest (string-append elibdir "/" dirname))
+                  (link (string-append "_checkouts/" dirname)))
+              (when (not (file-exists? link))
+                ;; RETHINK: Maybe better copy and make writable to avoid some
+                ;; error messages e.g. when using with rebar3-git-vsn.
+                (symlink dest link))))
+          (list-directories elibdir)))))
+   input-directories))
+
+(define* (unpack #:key source #:allow-other-keys)
+  "Unpack SOURCE in the working directory, and change directory within the
+source.  When SOURCE is a directory, copy it in a sub-directory of the current
+working directory."
+  (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack)))
+    (gnu-unpack #:source source)
+    ;; Packages from hex.pm typically have a contents.tar.gz containing the
+    ;; actual source. If this tar file exists, extract it.
+    (when (file-exists? "contents.tar.gz")
+      (invoke "tar" "xvf" "contents.tar.gz"))))
+
+(define* (build #:key (rebar-flags '()) #:allow-other-keys)
+  (apply invoke `("rebar3" "compile" ,@rebar-flags)))
+
+(define* (check #:key target (rebar-flags '()) (tests? (not target))
+                (test-target "eunit")
+                #:allow-other-keys)
+  (if tests?
+      (apply invoke `("rebar3" ,test-target ,@rebar-flags))
+      (format #t "test suite not run~%")))
+
+(define (erlang-package? name)
+  "Check if NAME correspond to the name of an Erlang package."
+  (string-prefix? "erlang-" name))
+
+(define (package-name-version->erlang-name name+ver)
+  "Convert the Guix package NAME-VER to the corresponding Erlang name-version
+format.  Essentially drop the prefix used in Guix and replace dashes by
+underscores."
+  (let* ((name- (package-name->name+version name+ver)))
+    (string-join
+     (string-split
+      (if (erlang-package? name-)  ; checks for "erlang-" prefix
+          (string-drop name- (string-length "erlang-"))
+          name-)
+      #\-)
+     "_")))
+
+(define (list-directories directory)
+  "Return file names of the sub-directory of DIRECTORY."
+  (scandir directory
+           (lambda (file)
+             (and (not (member file '("." "..")))
+                  (file-is-directory? (string-append directory "/" file))))))
+
+(define* (install #:key name outputs
+                  (install-name (package-name-version->erlang-name name))
+                  (install-profile "default") ; build profile outputs to install
+                  #:allow-other-keys)
+  (let* ((out (assoc-ref outputs "out"))
+         (pkg-dir (string-append out %erlang-libdir "/" install-name)))
+    (let ((bin-dir (string-append "_build/" install-profile "/bin"))
+          (lib-dir (string-append "_build/" install-profile "/lib")))
+      ;; install _build/PROFILE/bin
+      (when (file-exists? bin-dir)
+        (copy-recursively bin-dir out #:follow-symlinks? #t))
+      ;; install _build/PROFILE/lib/*/{ebin,include,priv}
+      (for-each
+       (lambda (*)
+         (for-each
+          (lambda (dirname)
+            (let ((src-dir (string-append lib-dir "/" * "/" dirname))
+                  (dst-dir (string-append pkg-dir "/" dirname)))
+              (when (file-exists? src-dir)
+                (copy-recursively src-dir dst-dir #:follow-symlinks? #t))
+              (false-if-exception
+               (delete-file (string-append dst-dir "/.gitignore")))))
+          '("ebin" "include" "priv")))
+       (list-directories lib-dir))
+      (false-if-exception
+       (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect"))))))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (replace 'unpack unpack)
+    (delete 'bootstrap)
+    (delete 'configure)
+    (add-before 'build 'erlang-depends erlang-depends)
+    (replace 'build build)
+    (replace 'check check)
+    (replace 'install install)))
+
+(define* (rebar-build #:key inputs (phases %standard-phases)
+                      #:allow-other-keys #:rest args)
+  "Build the given Erlang package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
diff --git a/guix/build/renpy-build-system.scm b/guix/build/renpy-build-system.scm
index e4a88456be..7c15d52f19 100644
--- a/guix/build/renpy-build-system.scm
+++ b/guix/build/renpy-build-system.scm
@@ -37,10 +37,9 @@
           game
           ;; should be "compile", but renpy wants to compile itself really
           ;; badly if we do
-          "quit")
-  #t)
+          "quit"))
 
-(define* (install #:key outputs game (output "out") #:allow-other-keys)
+(define* (install #:key inputs outputs game (output "out") #:allow-other-keys)
   (let* ((out (assoc-ref outputs output))
          (json-dump (call-with-input-file (string-append game
                                                          "/renpy-build.json")
@@ -58,13 +57,12 @@
       (call-with-output-file launcher
         (lambda (port)
           (format port "#!~a~%~a ~s \"$@\""
-                  (which "bash")
-                  (which "renpy")
+                  (search-input-file inputs "/bin/sh")
+                  (search-input-file inputs "/bin/renpy")
                   data)))
-      (chmod launcher #o755)))
-  #t)
+      (chmod launcher #o755))))
 
-(define* (install-desktop-file #:key outputs game (output "out")
+(define* (install-desktop-file #:key inputs outputs game (output "out")
                                #:allow-other-keys)
   (let* ((out (assoc-ref outputs output))
          (json-dump (call-with-input-file (string-append game
@@ -78,10 +76,9 @@
      #:name (assoc-ref json-dump "name")
      #:generic-name (assoc-ref build "display_name")
      #:exec (format #f "~a ~s"
-                    (which "renpy")
+                    (search-input-file inputs "/bin/renpy")
                     (string-append out "/share/renpy/" directory-name))
-     #:categories '("Game" "Visual Novel")))
-  #t)
+     #:categories '("Game" "Visual Novel"))))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
diff --git a/guix/channels.scm b/guix/channels.scm
index 5f47834c10..ce1a60436f 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -907,7 +907,14 @@ be used as a profile hook."
                 (format (current-error-port)
                         "Generating package cache for '~a'...~%"
                         #$profile)
-                (generate-package-cache #$output))
+                ;; This script runs through (primitive-load), which by default
+                ;; doesn't print backtraces when it encounters an exception,
+                ;; so manually do it.  Use with-throw-handler because it is
+                ;; supported by all Guile versions.
+                (with-throw-handler #t
+                  (lambda () (generate-package-cache #$output))
+                  (lambda (key . args)
+                      (backtrace))))
               (mkdir #$output))))
 
     (gexp->derivation-in-inferior "guix-package-cache" build
diff --git a/guix/extracting-download.scm b/guix/extracting-download.scm
deleted file mode 100644
index 4b7dcc7e83..0000000000
--- a/guix/extracting-download.scm
+++ /dev/null
@@ -1,179 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
-;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
-;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix extracting-download)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 popen)
-  #:use-module ((guix build download) #:prefix build:)
-  #:use-module ((guix build utils) #:hide (delete))
-  #:use-module (guix gexp)
-  #:use-module (guix modules)
-  #:use-module (guix monads)
-  #:use-module (guix packages) ;; for %current-system
-  #:use-module (guix store)
-  #:use-module (guix utils)
-  #:use-module (srfi srfi-26)
-  #:export (http-fetch/extract
-            download-to-store/extract))
-
-;;;
-;;; Produce fixed-output derivations with data extracted from n archive
-;;; fetched over HTTP or FTP.
-;;;
-;;; This is meant to be used for package repositories where the actual source
-;;; archive is packed into another archive, eventually carrying meta-data.
-;;; Using this derivation saves both storing the outer archive and extracting
-;;; the actual one at build time.  The hash is calculated on the actual
-;;; archive to ease validating the stored file.
-;;;
-
-(define* (http-fetch/extract url filename-to-extract hash-algo hash
-                    #:optional name
-                    #:key (system (%current-system)) (guile (default-guile)))
-  "Return a fixed-output derivation that fetches an archive at URL, and
-extracts FILE_TO_EXTRACT from the archive.  The FILE_TO_EXTRACT is expected to
-have hash HASH of type HASH-ALGO (a symbol).  By default, the file name is the
-base name of URL; optionally, NAME can specify a different file name."
-  (define file-name
-    (match url
-      ((head _ ...)
-       (basename head))
-      (_
-       (basename url))))
-
-  (define guile-zlib
-    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
-
-  (define guile-json
-    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
-
-  (define gnutls
-    (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
-
-  (define inputs
-    `(("tar" ,(module-ref (resolve-interface '(gnu packages base))
-                          'tar))))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%system))
-
-                     (define %system
-                       #$(%current-system)))))
-
-  (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build download)
-                                           (guix build utils)
-                                           (guix utils)
-                                           (web uri))))))
-
-  (define build
-    (with-imported-modules modules
-      (with-extensions (list guile-json gnutls ;for (guix swh)
-                             guile-zlib)
-        #~(begin
-            (use-modules (guix build download)
-                         (guix build utils)
-                         (guix utils)
-                         (web uri)
-                         (ice-9 match)
-                         (ice-9 popen))
-            ;; The code below expects tar to be in $PATH.
-            (set-path-environment-variable "PATH" '("bin")
-                                           (match '#+inputs
-                                             (((names dirs outputs ...) ...)
-                                              dirs)))
-
-            (setvbuf (current-output-port) 'line)
-            (setvbuf (current-error-port) 'line)
-
-            (call-with-temporary-directory
-             (lambda (directory)
-               ;; TODO: Support different archive types, based on content-type
-               ;; or archive name extention.
-               (let* ((file-to-extract (getenv "extract filename"))
-                      (port (http-fetch (string->uri (getenv "download url"))
-                                        #:verify-certificate? #f))
-                      (tar (open-pipe* OPEN_WRITE "tar" "-C" directory
-                                       "-xf" "-" file-to-extract)))
-                 (dump-port port tar)
-                 (close-port port)
-                 (let ((status (close-pipe tar)))
-                   (unless (zero? status)
-                     (error "tar extraction failure" status)))
-                 (copy-file (string-append directory "/"
-                                           (getenv "extract filename"))
-                            #$output))))))))
-
-  (mlet %store-monad ((guile (package->derivation guile system)))
-    (gexp->derivation (or name file-name) build
-
-                      ;; Use environment variables and a fixed script name so
-                      ;; there's only one script in store for all the
-                      ;; downloads.
-                      #:script-name "extract-download"
-                      #:env-vars
-                      `(("download url" . ,url)
-                        ("extract filename" . ,filename-to-extract))
-                      #:leaked-env-vars '("http_proxy" "https_proxy"
-                                          "LC_ALL" "LC_MESSAGES" "LANG"
-                                          "COLUMNS")
-                      #:system system
-                      #:local-build? #t           ; don't offload download
-                      #:hash-algo hash-algo
-                      #:hash hash
-                      #:guile-for-build guile)))
-
-
-(define* (download-to-store/extract store url filename-to-extract
-                                    #:optional (name (basename url))
-                                    #:key (log (current-error-port))
-                                    (verify-certificate? #t))
-  "Download an archive from URL, and extracts FILE_TO_EXTRACT from the archive
-to STORE, either under NAME or URL's basename if omitted.  Write progress
-reports to LOG.  VERIFY-CERTIFICATE? determines whether or not to validate
-HTTPS server certificates."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (let ((result
-            (parameterize ((current-output-port log))
-              (build:url-fetch url temp
-                               ;;#:mirrors %mirrors
-                               #:verify-certificate?
-                               verify-certificate?))))
-       (close port)
-       (and result
-            (call-with-temporary-output-file
-             (lambda (contents port)
-               (let ((tar (open-pipe* OPEN_READ
-                                      "tar"  ;"--auto-compress"
-                                      "-xf" temp "--to-stdout" filename-to-extract)))
-                 (dump-port tar port)
-                 (close-port port)
-                 (let ((status (close-pipe tar)))
-                   (unless (zero? status)
-                     (error "tar extraction failure" status)))
-                 (add-to-store store name #f "sha256" contents)))))))))
diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm
new file mode 100644
index 0000000000..2a7a9f3d82
--- /dev/null
+++ b/guix/import/hexpm.scm
@@ -0,0 +1,347 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2017, 2019-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020-2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import hexpm)
+  #:use-module (guix base32)
+  #:use-module ((guix download) #:prefix download:)
+  #:use-module (gcrypt hash)
+  #:use-module (guix http-client)
+  #:use-module (json)
+  #:use-module (guix import utils)
+  #:use-module ((guix import json) #:select (json-fetch))
+  #:use-module ((guix build utils)
+                #:select ((package-name->name+version
+                           . hyphen-package-name->name+version)
+                          dump-port))
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 popen)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-26)
+  #:use-module (guix build-system rebar)
+  #:export (hexpm->guix-package
+            guix-package->hexpm-name
+            strings->licenses   ;;  why used here?
+            hexpm-recursive-import
+            %hexpm-updater))
+
+;;;
+;;; Interface to https://hex.pm/api, version 2.
+;;; REST-API end-points:
+;;;   https://github.com/hexpm/specifications/blob/master/apiary.apib
+;;; Repository end-points:
+;;;   https://github.com/hexpm/specifications/blob/master/endpoints.md
+;;;
+
+(define %hexpm-api-url
+  (make-parameter "https://hex.pm/api"))
+
+(define (package-url name)
+  (string-append (%hexpm-api-url) "/packages/" name))
+
+;;
+;; Hexpm Package. /packages/${name}
+;; https://github.com/hexpm/specifications/blob/master/apiary.apib#Package
+;;
+;; Each package can have several "releases", each of which has its own set of
+;; requirements, build-tool, etc. - see <hexpm-release> below.
+(define-json-mapping <hexpm-pkgdef> make-hexpm-pkgdef hexpm-pkgdef?
+  json->hexpm
+  (name          hexpm-name)                          ; string
+  (html-url      hexpm-html-url      "html_url")      ; string
+  (docs-html-url hexpm-docs-html-url "docs_html_url") ; string | 'null
+  (meta          hexpm-meta "meta" json->hexpm-meta)
+  (versions      hexpm-versions "releases" ; list of <hexpm-version>
+                 (lambda (vector)
+                   (map json->hexpm-version
+                        (vector->list vector))))
+  ;; "latest_version" and "latest_stable_version" are not named in the
+  ;; specification, butt seen in practice.
+  (latest-version hexpm-latest-version "latest_version") ; string
+  (latest-stable  hexpm-latest-stable "latest_stable_version")) ; string
+
+;; Hexpm package metadata.
+(define-json-mapping <hexpm-meta> make-hexpm-meta hexpm-meta?
+  json->hexpm-meta
+  (description hexpm-meta-description)        ;string
+  (licenses    hexpm-meta-licenses "licenses" ;list of strings
+               (lambda (vector)
+                 (or (and vector (vector->list vector))
+                     #f))))
+
+;; Hexpm package versions.
+(define-json-mapping <hexpm-version> make-hexpm-version hexpm-version?
+  json->hexpm-version
+  (number  hexpm-version-number "version")   ;string
+  (url     hexpm-version-url))               ;string
+
+
+(define (lookup-hexpm name)
+  "Look up NAME on hex.pm and return the corresopnding <hexpm> record
+or #f if it was not found."
+  (and=> (json-fetch (package-url name))
+         json->hexpm))
+
+;;
+;; Hexpm release. /packages/${name}/releases/${version}
+;; https://github.com/hexpm/specifications/blob/master/apiary.apib#Release
+;;
+(define-json-mapping <hexpm-release> make-hexpm-release hexpm-release?
+  json->hexpm-release
+  (version hexpm-release-version)  ; string
+  (url     hexpm-release-url)      ; string
+  (meta    hexpm-release-meta "meta" json->hexpm-release-meta)
+  ;; Specification names the next fields "dependencies", but in practice it is
+  ;; "requirements".
+  (dependencies hexpm-requirements "requirements")) ; list of <hexpm-dependency>
+
+;; Hexpm release meta.
+;; https://github.com/hexpm/specifications/blob/main/package_metadata.md
+(define-json-mapping <hexpm-release-meta>
+  make-hexpm-release-meta hexpm-release-meta?
+  json->hexpm-release-meta
+  (app         hexpm-release-meta-app)        ; string
+  (elixir      hexpm-release-meta-elixir)     ; string
+  (build-tools hexpm-release-meta-build-tools "build_tools" ; list of strings
+               (lambda (vector)
+                 (or (and vector (vector->list vector))
+                     (list)))))
+
+;; Hexpm dependency.  Each requirement has information about the required
+;; version, such as "~> 2.1.2" or ">= 2.1.2 and < 2.2.0", see
+;; <https://hexdocs.pm/elixir/Version.html#module-requirements>, and whether
+;; the dependency is optional.
+(define-json-mapping <hexpm-dependency> make-hexpm-dependency
+  hexpm-dependency?
+  json->hexpm-dependency
+  (name        hexpm-dependency-name "app")   ; string
+  (requirement hexpm-dependency-requirement)  ; string
+  (optional    hexpm-dependency-optional))    ; bool
+
+(define (hexpm-release-dependencies release)
+  "Return the list of dependency names of RELEASE, a <hexpm-release>."
+  (let ((reqs (or (hexpm-requirements release) '#())))
+    (map first reqs)))  ;; TODO: also return required version
+
+
+(define (lookup-hexpm-release version*)
+  "Look up RELEASE on hexpm-version-url and return the corresopnding
+<hexpm-release> record or #f if it was not found."
+  (and=> (json-fetch (hexpm-version-url version*))
+         json->hexpm-release))
+
+
+;;;
+;;; Converting hex.pm packages to Guix packages.
+;;;
+
+(define (maybe-inputs package-inputs input-type)
+  "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
+package definition.  INPUT-TYPE, a symbol, is used to populate the name of
+the input field."
+  (match package-inputs
+    (()
+     '())
+    ((package-inputs ...)
+     `((,input-type (list ,@package-inputs))))))
+
+(define (dependencies->package-names names)
+  "Given a list of hexpm package NAMES, returns a list of guix package names
+as symbols."
+  ;; TODO: Base name on language of dependency.
+  ;; The language used for implementing the dependency is not know without
+  ;; recursing the dependencies.  So for now assume more packages are based on
+  ;; Erlang and prefix all dependencies with "erlang-" (the default).
+  (map string->symbol
+       (map hexpm-name->package-name
+            (sort names string-ci<?))))
+
+(define* (make-hexpm-sexp #:key name version tarball-url
+                          home-page synopsis description license
+                          language build-system dependencies
+                          #:allow-other-keys)
+  "Return the `package' s-expression for a hexpm package with the given NAME,
+VERSION, TARBALL-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE. The
+created package's name will stem from LANGUAGE. BUILD-SYSTEM defined the
+build-system, and DEPENDENCIES the inputs for the package."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (and (url-fetch tarball-url temp)
+          (values
+       `(package
+         (name ,(hexpm-name->package-name name language))
+         (version ,version)
+         (source (origin
+                   (method url-fetch)
+                   (uri (hexpm-uri ,name version))
+                   (sha256 (base32 ,(guix-hash-url temp)))))
+         (build-system ,build-system)
+         ,@(maybe-inputs (dependencies->package-names dependencies) 'inputs)
+         (synopsis ,synopsis)
+         (description ,(beautify-description description))
+         (home-page ,(match home-page
+                            (() "")
+                            (_ home-page)))
+         (license ,(match license
+                          (() #f)
+                          ((license) license)
+                          (_ `(list ,@license))))))))))
+
+(define (strings->licenses strings)
+  "Convert the list of STRINGS into a list of license objects."
+  (filter-map (lambda (license)
+                (and (not (string-null? license))
+                     (not (any (lambda (elem) (string=? elem license))
+                               '("AND" "OR" "WITH")))
+                     (or (spdx-string->license license)
+                         license)))
+              strings))
+
+(define (hexpm-latest-release package)
+  "Return the version string for the latest stable release of PACKAGE."
+  ;; Use latest-stable if specified (see comment in hexpm-pkgdef above),
+  ;; otherwise compare the lists of release versions.
+  (let ((latest-stable (hexpm-latest-stable package)))
+    (if (not (unspecified? latest-stable))
+        latest-stable
+        (let ((versions (map hexpm-version-number (hexpm-versions package))))
+          (fold (lambda (a b)
+                  (if (version>? a b) a b)) (car versions) versions)))))
+
+(define* (hexpm->guix-package package-name #:key repo version)
+  "Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the
+`package' s-expression corresponding to that package, or #f on failure.
+When VERSION is specified, attempt to fetch that version; otherwise fetch the
+latest version of PACKAGE-NAME."
+
+  (define package
+    (lookup-hexpm package-name))
+
+  (define version-number
+    (and package
+         (or version
+             (hexpm-latest-release package))))
+
+  (define version*
+    (and package
+         (find (lambda (version)
+                 (string=? (hexpm-version-number version)
+                           version-number))
+               (hexpm-versions package))))
+
+  (define release
+    (and package version*
+         (lookup-hexpm-release version*)))
+
+  (define release-meta
+    (and package version*
+         (hexpm-release-meta release)))
+
+  (define build-system
+    (and package version*
+         (let ((build-tools (hexpm-release-meta-build-tools release-meta)))
+           (cond
+            ((member "rebar3" build-tools) 'rebar-build-system)
+            ((member "mix" build-tools) 'mix-build-system)
+            ((member "make" build-tools) 'gnu-build-system)
+            (else #f)))))
+
+  (define language
+    (and package version*
+         (let ((elixir (hexpm-release-meta-elixir release-meta)))
+           (cond
+            ((and (string? elixir) (not (string-null? elixir))) "elixir")
+            (else "erlang")))))
+
+  (and package version*
+       (let ((dependencies  (hexpm-release-dependencies release))
+             (pkg-meta      (hexpm-meta package))
+             (docs-html-url (hexpm-docs-html-url package)))
+         (values
+          (make-hexpm-sexp
+           #:language language
+           #:build-system build-system
+           #:name package-name
+           #:version version-number
+           #:dependencies dependencies
+           #:home-page (or (and (not (eq? docs-html-url 'null))
+                                docs-html-url)
+                           ;; TODO: Homepage?
+                           (hexpm-html-url package))
+           #:synopsis (hexpm-meta-description pkg-meta)
+           #:description (hexpm-meta-description pkg-meta)
+           #:license (or (and=> (hexpm-meta-licenses pkg-meta)
+                                strings->licenses))
+           #:tarball-url (hexpm-uri package-name version-number))
+          dependencies))))
+
+(define* (hexpm-recursive-import pkg-name #:optional version)
+  (recursive-import pkg-name
+                    #:version version
+                    #:repo->guix-package hexpm->guix-package
+                    #:guix-name hexpm-name->package-name))
+
+(define (guix-package->hexpm-name package)
+  "Return the hex.pm name of PACKAGE."
+  (define (url->hexpm-name url)
+    (hyphen-package-name->name+version
+     (basename (file-sans-extension url))))
+
+  (match (and=> (package-source package) origin-uri)
+    ((? string? url)
+     (url->hexpm-name url))
+    ((lst ...)
+     (any url->hexpm-name lst))
+    (#f #f)))
+
+(define* (hexpm-name->package-name name #:optional (language "erlang"))
+  (string-append language "-" (string-join (string-split name #\_) "-")))
+
+
+;;;
+;;; Updater
+;;;
+
+(define (latest-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((hexpm-name (guix-package->hexpm-name package))
+         (hexpm      (lookup-hexpm hexpm-name))
+         (version    (hexpm-latest-release hexpm))
+         (url        (hexpm-uri hexpm-name version)))
+    (upstream-source
+     (package (package-name package))
+     (version version)
+     (urls (list url)))))
+
+(define %hexpm-updater
+  (upstream-updater
+   (name 'hexpm)
+   (description "Updater for hex.pm packages")
+   (pred (url-prefix-predicate hexpm-package-url))
+   (latest latest-release)))
diff --git a/guix/least-authority.scm b/guix/least-authority.scm
index d871816fca..bfd7275e7c 100644
--- a/guix/least-authority.scm
+++ b/guix/least-authority.scm
@@ -51,7 +51,7 @@
   "Return a wrapper of PROGRAM that executes it with the least authority.
 
 PROGRAM is executed in separate namespaces according to NAMESPACES, a list of
-symbols; it turns with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
+symbols; it runs with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
 <file-system-mapping> records indicating directories mirrored inside the
 execution environment of PROGRAM.  DIRECTORY is the working directory of the
 wrapped process.  Each environment listed in PRESERVED-ENVIRONMENT-VARIABLES
diff --git a/guix/packages.scm b/guix/packages.scm
index 7425389618..94e464cd01 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
@@ -149,6 +149,8 @@
 
             transitive-input-references
 
+            %32bit-supported-systems
+            %64bit-supported-systems
             %supported-systems
             %hurd-systems
             %cuirass-supported-systems
@@ -400,11 +402,19 @@ from forcing GEXP-PROMISE."
                       #:guile-for-build guile)))
 
 
+(define %32bit-supported-systems
+  ;; This is the list of 32-bit system types that are supported.
+  '("i686-linux" "armhf-linux" "i586-gnu" "powerpc-linux"))
+
+(define %64bit-supported-systems
+  ;; This is the list of 64-bit system types that are supported.
+  '("x86_64-linux" "mips64el-linux" "aarch64-linux" "powerpc64le-linux"
+    "riscv64-linux"))
+
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
   ;; expect all packages to build successfully here.
-  '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"
-    "powerpc64le-linux" "powerpc-linux" "riscv64-linux"))
+  (append %64bit-supported-systems %32bit-supported-systems))
 
 (define %hurd-systems
   ;; The GNU/Hurd systems for which support is being developed.
diff --git a/guix/platform.scm b/guix/platform.scm
index 361241cb2e..19d4527e29 100644
--- a/guix/platform.scm
+++ b/guix/platform.scm
@@ -121,7 +121,7 @@ otherwise."
 (define (platform-target->system target)
   "Return the system matching the given TARGET if it exists or false
 otherwise."
-  (let ((platform (lookup-platform-by-target system)))
+  (let ((platform (lookup-platform-by-target target)))
     (and=> platform platform-system)))
 
 
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index c29d5105ae..5c0f837d13 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,7 @@
 
 (define-module (guix scripts challenge)
   #:use-module (guix ui)
+  #:use-module (guix colors)
   #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix utils)
@@ -32,6 +33,7 @@
   #:use-module (rnrs bytevectors)
   #:autoload   (guix http-client) (http-fetch)
   #:use-module ((guix build syscalls) #:select (terminal-columns))
+  #:autoload   (guix build utils) (make-file-writable)
   #:use-module (gcrypt hash)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -310,6 +312,23 @@ specified in COMPARISON-REPORT."
                     (length files)))
      (format #t     "~{    ~a~%~}" files))))
 
+(define (make-directory-writable directory)
+  "Recurse into DIRECTORY and make each entry writable, similar to
+'chmod -R +w DIRECTORY'."
+  (file-system-fold (const #t)
+                    (lambda (file stat _)         ;leaf
+                      (unless (eq? 'symlink (stat:type stat))
+                        (make-file-writable file)))
+                    (lambda (directory stat _)    ;down
+                      (make-file-writable directory))
+                    (const #t)                    ;up
+                    (const #f)                    ;skip
+                    (lambda (file stat errno _)   ;error
+                      (leave (G_ "failed to delete '~a': ~a~%")
+                             file (strerror errno)))
+                    #t
+                    directory))
+
 (define (call-with-mismatches comparison-report proc)
   "Call PROC with two directories containing the mismatching store items."
   (define local-hash
@@ -318,6 +337,13 @@ specified in COMPARISON-REPORT."
   (define narinfos
     (comparison-report-narinfos comparison-report))
 
+  (define (restore-file* port directory)
+    ;; Since 'restore-file' sets "canonical" file permissions (read-only),
+    ;; make an extra traversal to make DIRECTORY writable so it can be deleted
+    ;; when the dynamic extent of 'call-with-temporary-directory' is left.
+    (restore-file port directory)
+    (make-directory-writable directory))
+
   (call-with-temporary-directory
    (lambda (directory1)
      (call-with-temporary-directory
@@ -338,10 +364,10 @@ specified in COMPARISON-REPORT."
                      narinfos)))
 
         (rmdir directory1)
-        (call-with-nar narinfo1 (cut restore-file <> directory1))
+        (call-with-nar narinfo1 (cut restore-file* <> directory1))
         (when narinfo2
           (rmdir directory2)
-          (call-with-nar narinfo2 (cut restore-file <> directory2)))
+          (call-with-nar narinfo2 (cut restore-file* <> directory2)))
         (proc directory1
               (if local-hash
                   (comparison-report-item comparison-report)
@@ -363,6 +389,11 @@ COMPARISON-REPORT."
                                  (append command
                                          (list directory1 directory2))))))
 
+(define good-news
+  (coloring-procedure (color BOLD GREEN)))
+(define bad-news
+  (coloring-procedure (color BOLD RED)))
+
 (define* (summarize-report comparison-report
                            #:key
                            (report-differences (const #f))
@@ -385,7 +416,7 @@ with COMPARISON-REPORT."
 
   (match comparison-report
     (($ <comparison-report> item 'mismatch local (narinfos ...))
-     (report (G_ "~a contents differ:~%") item)
+     (report (bad-news (G_ "~a contents differ:~%")) item)
      (report-hashes item local narinfos)
      (report-differences comparison-report))
     (($ <comparison-report> item 'inconclusive #f narinfos)
@@ -394,7 +425,7 @@ with COMPARISON-REPORT."
      (warning (G_ "could not challenge '~a': no substitutes~%") item))
     (($ <comparison-report> item 'match local (narinfos ...))
      (when verbose?
-       (report (G_ "~a contents match:~%") item)
+       (report (good-news (G_ "~a contents match:~%")) item)
        (report-hashes item local narinfos)))))
 
 (define (summarize-report-list reports)
@@ -403,10 +434,11 @@ with COMPARISON-REPORT."
         (inconclusive  (count comparison-report-inconclusive? reports))
         (matches       (count comparison-report-match? reports))
         (discrepancies (count comparison-report-mismatch? reports)))
-    (report (G_ "~h store items were analyzed:~%") total)
-    (report (G_ "  - ~h (~,1f%) were identical~%")
+    (report (highlight (G_ "~h store items were analyzed:~%")) total)
+    (report (highlight (G_ "  - ~h (~,1f%) were identical~%"))
             matches (* 100. (/ matches total)))
-    (report (G_ "  - ~h (~,1f%) differed~%")
+    (report ((if (zero? discrepancies) good-news bad-news)
+             (G_ "  - ~h (~,1f%) differed~%"))
             discrepancies (* 100. (/ discrepancies total)))
     (report (G_ "  - ~h (~,1f%) were inconclusive~%")
             inconclusive (* 100. (/ inconclusive total)))))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 62aa7bdbc5..71ab4b4fed 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -50,7 +50,7 @@
 
 (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
                     "gem" "go" "cran" "crate" "texlive" "json" "opam"
-                    "minetest" "elm"))
+                    "minetest" "elm" "hexpm"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm
new file mode 100644
index 0000000000..eb9a1b0af5
--- /dev/null
+++ b/guix/scripts/import/hexpm.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020, 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import hexpm)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import hexpm)
+  #:use-module (guix scripts import)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (guix-import-hexpm))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import hexpm PACKAGE-NAME
+Import and convert the hex.pm package for PACKAGE-NAME.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (display (G_ "
+  -r, --recursive        import packages recursively"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix import hexpm")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
+         %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-hexpm . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                            (('argument . value)
+                             value)
+                            (_ #f))
+                           (reverse opts))))
+    (match args
+      ((spec)
+       (with-error-handling
+         (let ((name version (package-name->name+version spec)))
+           (if (assoc-ref opts 'recursive)
+               ;; Recursive import
+               (map (match-lambda
+                     ((and ('package ('name name) . rest) pkg)
+                      `(define-public ,(string->symbol name)
+                         ,pkg))
+                     (_ #f))
+                    (hexpm-recursive-import name version))
+               ;; Single import
+               (let ((sexp (hexpm->guix-package name #:version version)))
+                 (unless sexp
+                   (leave (G_ "failed to download meta-data for package '~a'~%")
+                          spec))
+                 sexp)))))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index f01764637b..b0cc459d63 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -20,6 +20,7 @@
 
 (define-module (guix scripts pull)
   #:use-module ((guix ui) #:hide (display-profile-content))
+  #:use-module (guix diagnostics)
   #:use-module (guix colors)
   #:use-module (guix utils)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -786,6 +787,35 @@ Use '~/.config/guix/channels.scm' instead."))
            channels))
         channels)))
 
+(define (validate-cache-directory-ownership)
+  "Bail out if the cache directory is not owned by the current user."
+  (let ((stats dir
+               (let loop ((dir (cache-directory)))
+                 (let ((stats (stat dir #f)))
+                   (if stats
+                       (values stats dir)
+                       (loop (dirname dir)))))))
+    (let ((dir:uid (stat:uid stats))
+          (our:uid (getuid)))
+      (unless (= dir:uid our:uid)
+        (let* ((user (lambda (uid)         ;handle the unthinkable invalid UID
+                       (or (false-if-exception (passwd:name
+                                                (getpwuid uid)))
+                           uid)))
+               (our:user (user our:uid))
+               (dir:user (user dir:uid)))
+          (raise
+           (make-compound-condition
+            (formatted-message
+             (G_ "directory '~a' is not owned by user ~a")
+             dir our:user)
+            (condition
+             (&fix-hint
+              (hint
+               (format #f (G_ "You should run this command as ~a; use \
+@command{sudo -i} or equivalent if you really want to pull as ~a.")
+                       dir:user our:user)))))))))))
+
 
 (define-command (guix-pull . args)
   (synopsis "pull the latest revision of Guix")
@@ -810,6 +840,10 @@ Use '~/.config/guix/channels.scm' instead."))
         ((assoc-ref opts 'generation)
          (process-generation-change opts profile))
         (else
+         ;; Bail out early when users accidentally run, e.g., ’sudo guix pull’.
+         ;; If CACHE-DIRECTORY doesn't yet exist, test where it would end up.
+         (validate-cache-directory-ownership)
+
          (with-store store
            (with-status-verbosity (assoc-ref opts 'verbosity)
              (parameterize ((%current-system (assoc-ref opts 'system))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 68bb9040d8..4d52200b84 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
@@ -46,9 +46,9 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 binary-ports)
   #:export (guix-refresh))
 
@@ -315,12 +315,11 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
 values: 'interactive' (default), 'always', and 'never'.  When WARN? is true,
 warn about packages that have no matching updater."
   (if (lookup-updater package updaters)
-      (let-values (((version output source)
-                    (package-update store package updaters
-                                    #:key-download key-download))
-                   ((loc)
-                    (or (package-field-location package 'version)
-                        (package-location package))))
+      (let ((version output source
+                     (package-update store package updaters
+                                     #:key-download key-download))
+            (loc (or (package-field-location package 'version)
+                     (package-location package))))
         (when version
           (if (and=> output file-exists?)
               (begin
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 1a6df98829..004ed7af2e 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -256,6 +256,7 @@ Return the modified OPTS."
       ((('package . _) . _) #t)
       ((('load . _) . _) #t)
       ((('manifest . _) . _) #t)
+      ((('profile . _) . _) #t)
       ((('expression . _) . _) #t)
       ((_ . rest) (options-contain-payload? rest))))
 
@@ -465,6 +466,8 @@ concatenates MANIFESTS, a list of expressions."
                            (filter-map (match-lambda
                                          (('manifest . file)
                                           (load-manifest file))
+                                         (('profile . file)
+                                          (profile-manifest file))
                                          (_ #f))
                                        opts)))))
     (display (G_ "\
diff --git a/guix/self.scm b/guix/self.scm
index 9a64051c32..36ada4d171 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -569,10 +569,12 @@ instead of 'C'."
                               (filter package? packages))))
                    ":"))
           (setenv "LIBRARY_PATH" #$(file-append gcc "/lib"))
+          (setenv "GUIX_LD_WRAPPER_DISABLE_RPATH" "1")
 
           (invoke "gcc" #$(local-file source) "-Wall" "-g0" "-O2"
                   "-I" #$(file-append guile "/include/guile/" effective)
                   "-L" #$(file-append guile "/lib")
+                  "-Wl,-rpath" #$(file-append guile "/lib")
                   #$(string-append "-lguile-" effective)
                   "-o" (string-append #$output "/bin/guile")))))
 
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 232b6bfe94..a6f0f2eb96 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -102,7 +102,8 @@ actual key does not match."
 (define* (open-ssh-session host #:key user port identity
                            host-key
                            (compression %compression)
-                           (timeout 3600))
+                           (timeout 3600)
+                           (connection-timeout 10))
   "Open an SSH session for HOST and return it.  IDENTITY specifies the file
 name of a private key to use for authenticating with the host.  When USER,
 PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
@@ -112,15 +113,16 @@ When HOST-KEY is true, it must be a string like \"ssh-ed25519 AAAAC3Nz…
 root@example.org\"; the server is authenticated and an error is raised if its
 host key is different from HOST-KEY.
 
-Install TIMEOUT as the maximum time in seconds after which a read or write
-operation on a channel of the returned session is considered as failing.
+Error out if connection establishment takes more than CONNECTION-TIMEOUT
+seconds.  Install TIMEOUT as the maximum time in seconds after which a read or
+write operation on a channel of the returned session is considered as failing.
 
 Throw an error on failure."
   (let ((session (make-session #:user user
                                #:identity identity
                                #:host host
                                #:port port
-                               #:timeout 10       ;seconds
+                               #:timeout connection-timeout
                                ;; #:log-verbosity 'protocol
 
                                ;; Prevent libssh from reading
diff --git a/guix/ui.scm b/guix/ui.scm
index cb68a07c6c..a7acd41440 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -17,6 +17,7 @@
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1672,11 +1673,18 @@ return the underlying port.  Otherwise return #f."
     (_
      #f)))
 
+(define (find-available-pager)
+  "Return the program name of an available pager or the empty string if none is
+available."
+  (or (getenv "GUIX_PAGER")
+      (getenv "PAGER")
+      (which "less")
+      (which "more")
+      ""))
+
 (define* (call-with-paginated-output-port proc
                                           #:key (less-options "FrX"))
-  (let ((pager-command-line (or (getenv "GUIX_PAGER")
-                                (getenv "PAGER")
-                                "less")))
+  (let ((pager-command-line (find-available-pager)))
     ;; Setting PAGER to the empty string conventionally disables paging.
     (if (and (not (string-null? pager-command-line))
              (isatty?* (current-output-port)))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 6666803a92..dac8153905 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
@@ -464,6 +464,7 @@ SOURCE, an <upstream-source>."
                                         #:key-download key-download)))
          (values version tarball source))))))
 
+
 (define* (package-update/git-fetch store package source #:key key-download)
   "Return the version, checkout, and SOURCE, to update PACKAGE to
 SOURCE, an <upstream-source>."
@@ -487,30 +488,36 @@ SOURCE, an <upstream-source>."
                          #:optional (updaters (force %updaters))
                          #:key (key-download 'interactive))
   "Return the new version, the file name of the new version tarball, and input
-changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date.
+changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date;
+raise an error when the updater could not determine available releases.
 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
 values: 'always', 'never', and 'interactive' (default)."
-  (match (package-latest-release* package updaters)
+  (match (package-latest-release package updaters)
     ((? upstream-source? source)
-     (let ((method (match (package-source package)
-                     ((? origin? origin)
-                      (origin-method origin))
-                     (_
-                      #f))))
-       (match (assq method %method-updates)
-         (#f
-          (raise (make-compound-condition
-                  (formatted-message (G_ "cannot download for \
+     (if (version>? (upstream-source-version source)
+                    (package-version package))
+         (let ((method (match (package-source package)
+                         ((? origin? origin)
+                          (origin-method origin))
+                         (_
+                          #f))))
+           (match (assq method %method-updates)
+             (#f
+              (raise (make-compound-condition
+                      (formatted-message (G_ "cannot download for \
 this method: ~s")
-                                     method)
-                  (condition
-                   (&error-location
-                    (location (package-location package)))))))
-         ((_ . update)
-          (update store package source
-                  #:key-download key-download)))))
+                                         method)
+                      (condition
+                       (&error-location
+                        (location (package-location package)))))))
+             ((_ . update)
+              (update store package source
+                      #:key-download key-download))))
+         (values #f #f #f)))
     (#f
-     (values #f #f #f))))
+     (raise (formatted-message
+             (G_ "updater failed to determine available releases for ~a~%")
+             (package-name package))))))
 
 (define* (update-package-source package source hash)
   "Modify the source file that defines PACKAGE to refer to SOURCE, an
diff --git a/guix/utils.scm b/guix/utils.scm
index 37b2e29800..5c36b15cfe 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -158,6 +159,8 @@
     (dynamic-wind
       (lambda ()
         (for-each (match-lambda
+                    ((variable #false)
+                     (unsetenv variable))
                     ((variable value)
                      (setenv variable value)))
                   variables))