Merge branch 'master' into emacs-team

20 files changed, 642 insertions, 173 deletions

diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index 0d5493ab90..3f7a2dea27 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -197,7 +197,9 @@ XS or similar."
                                native-search-paths))
                       #:make-maker? #$make-maker?
                       #:make-maker-flags #$make-maker-flags
-                      #:module-build-flags #$(sexp->gexp module-build-flags)
+                      #:module-build-flags #$(if (pair? module-build-flags)
+                                                 (sexp->gexp module-build-flags)
+                                                 module-build-flags)
                       #:phases #$phases
                       #:build #$build
                       #:system #$system
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index ffb2ec898e..70ddf063d2 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
-;;; Copyright © 2019-2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019-2024 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
 ;;;
@@ -162,6 +162,7 @@ libraries or executables."
                    ("powerpc64le-linux-gnu" "powerpc64le-unknown-linux-gnu")
                    ("riscv64-linux-gnu" "riscv64gc-unknown-linux-gnu")
                    ("x86_64-linux-gnu" "x86_64-unknown-linux-gnu")
+                   ("x86_64-linux-gnux32" "x86_64-unknown-linux-gnux32")
                    ("i586-pc-gnu" "i686-unknown-hurd-gnu")
                    ("i686-w64-mingw32" "i686-pc-windows-gnu")
                    ("x86_64-w64-mingw32" "x86_64-pc-windows-gnu")
diff --git a/guix/build/git.scm b/guix/build/git.scm
index 867cade2c4..4c69365a7b 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2019, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,7 +20,9 @@
 (define-module (guix build git)
   #:use-module (guix build utils)
   #:autoload   (guix build download-nar) (download-nar)
-  #:autoload   (guix swh) (%verify-swh-certificate? swh-download)
+  #:autoload   (guix swh) (%verify-swh-certificate?
+                           swh-download
+                           swh-download-directory-by-nar-hash)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 format)
   #:export (git-fetch
@@ -91,10 +93,13 @@ fetched, recursively.  Return #t on success, #f otherwise."
 
 (define* (git-fetch-with-fallback url commit directory
                                   #:key (git-command "git")
+                                  hash hash-algorithm
                                   lfs? recursive?)
   "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to
 alternative methods when fetching from URL fails: attempt to download a nar,
-and if that also fails, download from the Software Heritage archive."
+and if that also fails, download from the Software Heritage archive.  When
+HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of
+the directory of interested and are used as its content address at SWH."
   (or (git-fetch url commit directory
                  #:lfs? lfs?
                  #:recursive? recursive?
@@ -110,7 +115,14 @@ and if that also fails, download from the Software Heritage archive."
              (format (current-error-port)
                      "Trying to download from Software Heritage...~%")
 
-             (swh-download url commit directory)
+             ;; First try to look up and download the directory corresponding
+             ;; to HASH: this is fundamentally more reliable than looking up
+             ;; COMMIT, especially when COMMIT denotes a tag.
+             (or (and hash hash-algorithm
+                      (swh-download-directory-by-nar-hash hash hash-algorithm
+                                                          directory))
+                 (swh-download url commit directory))
+
              (when (file-exists?
                     (string-append directory "/.gitattributes"))
                ;; Perform CR/LF conversion and other changes
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index b2871c3c10..39bcffd516 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -765,27 +765,50 @@ current process."
                  (list (strerror err))
                  (list err)))))))
 
-(define (kernel? pid)
-  "Return #t if PID designates a \"kernel thread\" rather than a normal
-user-land process."
-  (let ((stat (call-with-input-file (format #f "/proc/~a/stat" pid)
-                (compose string-tokenize read-string))))
-    ;; See proc.txt in Linux's documentation for the list of fields.
-    (match stat
-      ((pid tcomm state ppid pgrp sid tty_nr tty_pgrp flags min_flt
-            cmin_flt maj_flt cmaj_flt utime stime cutime cstime
-            priority nice num_thread it_real_value start_time
-            vsize rss rsslim
-            (= string->number start_code) (= string->number end_code) _ ...)
-       ;; Got this obscure trick from sysvinit's 'killall5' program.
-       (and (zero? start_code) (zero? end_code))))))
+(define (linux-process-flags pid)                 ;copied from the Shepherd
+  "Return the process flags of @var{pid} (or'd @code{PF_} constants), assuming
+the Linux /proc file system is mounted; raise a @code{system-error} exception
+otherwise."
+  (call-with-input-file (string-append "/proc/" (number->string pid)
+                                       "/stat")
+    (lambda (port)
+      (define line
+        (read-string port))
+
+      ;; Parse like systemd's 'is_kernel_thread' function.
+      (let ((offset (string-index line #\))))     ;offset past 'tcomm' field
+        (match (and offset
+                    (string-tokenize (string-drop line (+ offset 1))))
+          ((state ppid pgrp sid tty-nr tty-pgrp flags . _)
+           (or (string->number flags) 0))
+          (_
+           0))))))
+
+;; Per-process flag defined in <linux/sched.h>.
+(define PF_KTHREAD #x00200000)                    ;I am a kernel thread
+
+(define (linux-kernel-thread? pid)
+  "Return true if @var{pid} is a Linux kernel thread."
+  (= PF_KTHREAD (logand (linux-process-flags pid) PF_KTHREAD)))
+
+(define pseudo-process?
+  (if (string-contains %host-type "linux")
+      (lambda (pid)
+        "Return true if @var{pid} denotes a \"pseudo-process\" such as a Linux
+kernel thread rather than a \"regular\" process.  A pseudo-process is one that
+may never terminate, even after sending it SIGKILL---e.g., kthreadd on Linux."
+        (catch 'system-error
+          (lambda ()
+            (linux-kernel-thread? pid))
+          (const #f)))
+      (const #f)))
 
 (define (processes)
   "Return the list of live processes."
   (sort (filter-map (lambda (file)
                       (let ((pid (string->number file)))
                         (and pid
-                             (not (kernel? pid))
+                             (not (pseudo-process? pid))
                              pid)))
                     (scandir "/proc"))
         <))
diff --git a/guix/channels.scm b/guix/channels.scm
index f01903642d..1b07eb5221 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -34,7 +34,6 @@
   #:use-module (guix packages)
   #:use-module (guix progress)
   #:use-module (guix derivations)
-  #:use-module (guix combinators)
   #:use-module (guix diagnostics)
   #:use-module (guix sets)
   #:use-module (guix store)
@@ -510,16 +509,6 @@ CURRENT-CHANNELS is the list of currently used channels.  It is compared
 against the newly-fetched instances of CHANNELS, and VALIDATE-PULL is called
 for each channel update and can choose to emit warnings or raise an error,
 depending on the policy it implements."
-  ;; Only process channels that are unique, or that are more specific than a
-  ;; previous channel specification.
-  (define (ignore? channel others)
-    (member channel others
-            (lambda (a b)
-              (and (eq? (channel-name a) (channel-name b))
-                   (or (channel-commit b)
-                       (not (or (channel-commit a)
-                                (channel-commit b))))))))
-
   (define (current-commit name)
     ;; Return the current commit for channel NAME.
     (any (lambda (channel)
@@ -527,60 +516,77 @@ depending on the policy it implements."
                 (channel-commit channel)))
          current-channels))
 
+  (define instance-name
+    (compose channel-name channel-instance-channel))
+
+  (define (same-named? channel)
+    (let ((name (channel-name channel)))
+      (lambda (candidate)
+        (eq? (channel-name candidate) name))))
+
+  (define (more-specific? a b)
+    ;; A is more specific than B if it specifies a commit.
+    (and (channel-commit a)
+         (not (channel-commit b))))
+
   (let loop ((channels channels)
-             (previous-channels '()))
-    ;; Accumulate a list of instances.  A list of processed channels is also
-    ;; accumulated to decide on duplicate channel specifications.
-    (define-values (resulting-channels instances)
-      (fold2 (lambda (channel previous-channels instances)
-               (if (ignore? channel previous-channels)
-                   (values previous-channels instances)
-                   (begin
-                     (format (current-error-port)
-                             (G_ "Updating channel '~a' from Git repository at '~a'...~%")
-                             (channel-name channel)
-                             (channel-url channel))
-                     (let* ((current (current-commit (channel-name channel)))
-                            (instance
-                             (latest-channel-instance store channel
-                                                      #:authenticate?
-                                                      authenticate?
-                                                      #:validate-pull
-                                                      validate-pull
-                                                      #:starting-commit
-                                                      current)))
-                       (when authenticate?
-                         ;; CHANNEL is authenticated so we can trust the
-                         ;; primary URL advertised in its metadata and warn
-                         ;; about possibly stale mirrors.
-                         (let ((primary-url (channel-instance-primary-url
-                                             instance)))
-                           (unless (or (not primary-url)
-                                       (channel-commit channel)
-                                       (string=? primary-url (channel-url channel)))
-                             (warning (G_ "pulled channel '~a' from a mirror \
+             (previous-channels '())
+             (instances '()))
+    (match channels
+      (()
+       (reverse instances))
+      ((channel . rest)
+       (let ((previous (find (same-named? channel) previous-channels)))
+         ;; If there's already an instance for CHANNEL, keep the most specific
+         ;; one.
+         (if (and previous
+                  (not (more-specific? channel previous)))
+             (loop rest previous-channels instances)
+             (begin
+               (format (current-error-port)
+                       (G_ "Updating channel '~a' from Git repository at '~a'...~%")
+                       (channel-name channel)
+                       (channel-url channel))
+               (let* ((current (current-commit (channel-name channel)))
+                      (instance
+                       (latest-channel-instance store channel
+                                                #:authenticate?
+                                                authenticate?
+                                                #:validate-pull
+                                                validate-pull
+                                                #:starting-commit
+                                                current)))
+                 (when authenticate?
+                   ;; CHANNEL is authenticated so we can trust the
+                   ;; primary URL advertised in its metadata and warn
+                   ;; about possibly stale mirrors.
+                   (let ((primary-url (channel-instance-primary-url
+                                       instance)))
+                     (unless (or (not primary-url)
+                                 (channel-commit channel)
+                                 (string=? primary-url (channel-url channel)))
+                       (warning (G_ "pulled channel '~a' from a mirror \
 of ~a, which might be stale~%")
-                                      (channel-name channel)
-                                      primary-url))))
-
-                       (let-values (((new-instances new-channels)
-                                     (loop (channel-instance-dependencies instance)
-                                           previous-channels)))
-                         (values (append (cons channel new-channels)
-                                         previous-channels)
-                                 (append (cons instance new-instances)
-                                         instances)))))))
-             previous-channels
-             '()                                  ;instances
-             channels))
-
-    (let ((instance-name (compose channel-name channel-instance-channel)))
-      ;; Remove all earlier channel specifications if they are followed by a
-      ;; more specific one.
-      (values (delete-duplicates instances
-                                 (lambda (a b)
-                                   (eq? (instance-name a) (instance-name b))))
-              resulting-channels))))
+                                (channel-name channel)
+                                primary-url))))
+
+                 ;; Perform a breadth-first traversal with the idea that the
+                 ;; user-provided channels may be more specific than what
+                 ;; '.guix-channel' specifies, and so it is on those instances
+                 ;; that 'channel-instance-dependencies' should be called.
+                 (loop (append rest
+                               (channel-instance-dependencies instance))
+                       (cons channel
+                             (if previous
+                                 (delq previous previous-channels)
+                                 previous-channels))
+                       (cons instance
+                             (if previous
+                                 (remove (lambda (instance)
+                                           (eq? (instance-name instance)
+                                                (channel-name channel)))
+                                         instances)
+                                 instances)))))))))))
 
 (define* (checkout->channel-instance checkout
                                      #:key commit
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 3de6ae970d..aadcbd234c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2021, 2023-2024 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>
@@ -165,6 +165,8 @@ respective documentation."
 
             (git-fetch-with-fallback (getenv "git url") (getenv "git commit")
                                      #$output
+                                     #:hash #$hash
+                                     #:hash-algorithm '#$hash-algo
                                      #:lfs? lfs?
                                      #:recursive? recursive?
                                      #:git-command "git")))))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index d7497e6fb9..9b30dc30e0 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -90,7 +90,7 @@
   (map (lambda (input)
          (case (%input-style)
            ((specification)
-            `(specification->package ,(upstream-input-name input)))
+            `(specification->package ,(upstream-input-downstream-name input)))
            (else
             ((compose string->symbol
                        upstream-input-downstream-name)
@@ -672,6 +672,54 @@ of META, a package in REPOSITORY."
             (string<? (upstream-input-downstream-name input1)
                       (upstream-input-downstream-name input2))))))
 
+(define (phases-for-inputs input-names)
+  "Generate a list of build phases based on the provided INPUT-NAMES, a list
+of package names for all input packages."
+  (let ((rules
+         (list (lambda ()
+                 (and (any (lambda (name)
+                             (member name '("styler" "ExperimentHub")))
+                           input-names)
+                      '(add-after 'unpack 'set-HOME
+                         (lambda _ (setenv "HOME" "/tmp")))))
+               (lambda ()
+                 (and (member "esbuild" input-names)
+                      '(add-after 'unpack 'process-javascript
+                         (lambda* (#:key inputs #:allow-other-keys)
+                           (with-directory-excursion "inst/"
+                             (for-each (match-lambda
+                                         ((source . target)
+                                          (minify source #:target target)))
+                                       '())))))))))
+    (fold (lambda (rule phases)
+            (let ((new-phase (rule)))
+              (if new-phase (cons new-phase phases) phases)))
+          (list)
+          rules)))
+
+(define (maybe-arguments inputs)
+  "Generate a list for the arguments field that can be spliced into a package
+S-expression."
+  (let ((input-names (map upstream-input-name inputs))
+        (esbuild-modules '(#:modules
+                           '((guix build r-build-system)
+                             (guix build minify-build-system)
+                             (guix build utils)
+                             (ice-9 match))
+                           #:imported-modules
+                           `(,@%r-build-system-modules
+                             (guix build minify-build-system)))))
+    (match (phases-for-inputs input-names)
+      (() '())
+      (phases
+       `((arguments
+          (list
+           ,@(if (member "esbuild" input-names)
+                 esbuild-modules '())
+           #:phases
+           '(modify-phases %standard-phases
+              ,@phases))))))))
+
 (define* (description->package repository meta #:key (license-prefix identity)
                                (download-source download))
   "Return the `package' s-expression for an R package published on REPOSITORY
@@ -751,7 +799,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
                     `((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
                     '())
               (build-system r-build-system)
-
+              ,@(maybe-arguments inputs)
               ,@(maybe-inputs (filter (upstream-input-type-predicate 'regular)
                                       inputs)
                               'inputs)
@@ -882,15 +930,25 @@ s-expression corresponding to that package, or #f on failure."
   (define upstream-name
     (package->upstream-name pkg))
 
+  (define type
+    (cond
+     ((bioconductor-data-package? pkg)
+      'annotation)
+     ((bioconductor-experiment-package? pkg)
+      'experiment)
+     ((bioconductor-package? pkg)
+      #true)
+     (else #false)))
+
   (define latest-version
-    (latest-bioconductor-package-version upstream-name))
+    (latest-bioconductor-package-version upstream-name type))
 
   (and latest-version
        ;; Bioconductor does not provide signatures.
        (upstream-source
         (package (package-name pkg))
         (version latest-version)
-        (urls (bioconductor-uri upstream-name latest-version))
+        (urls (bioconductor-uri upstream-name latest-version type))
         (inputs
          (let ((meta (fetch-description 'bioconductor upstream-name)))
            (cran-package-inputs meta 'bioconductor))))))
@@ -944,7 +1002,10 @@ s-expression corresponding to that package, or #f on failure."
   (upstream-updater
    (name 'bioconductor)
    (description "Updater for Bioconductor packages")
-   (pred bioconductor-package?)
+   (pred (lambda (pkg)
+           (or (bioconductor-package? pkg)
+               (bioconductor-data-package? pkg)
+               (bioconductor-experiment-package? pkg))))
    (import latest-bioconductor-release)))
 
 ;;; cran.scm ends here
diff --git a/guix/import/json.scm b/guix/import/json.scm
index b87e9918c5..bf346a1bef 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -78,14 +78,13 @@ a list of S-expressions, or return #F when the JSON is invalid."
                               #:result
                               (append result
                                       (list
-                                       (package->code (alist->package pkg names))
-                                       (string->symbol (assoc-ref pkg "name"))))))))
-                        (list #:names '()
-                              #:result '())
-                        packages))))
+                                       (package->code
+                                         (alist->package pkg names))))))))
+                   (list #:names '()
+                         #:result '())
+                   packages))))
           (package
-            (list (package->code (alist->package json))
-                  (string->symbol (assoc-ref json "name")))))))
+            (list (package->code (alist->package json)))))))
     (const #f)))
 
 (define (json->scheme-file file)
diff --git a/guix/lint.scm b/guix/lint.scm
index 861e352b93..c95de85e69 100644
--- a/guix/lint.scm
+++ b/guix/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-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2024 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>
@@ -1658,24 +1658,31 @@ try again later")
     (or (not (request-rate-limit-reached? url method))
         (throw skip-key #t)))
 
+  (define (lookup-by-nar-hash hash)
+    (lookup-directory-by-nar-hash (content-hash-value hash)
+                                  (content-hash-algorithm hash)))
+
   (parameterize ((%allow-request? skip-when-limit-reached))
     (catch #t
       (lambda ()
         (match (package-source package)
           (#f                                     ;no source
            '())
-          ((and (? origin?)
+          ((and (? origin? origin)
                 (= origin-uri (? git-reference? reference)))
            (define url
              (git-reference-url reference))
            (define commit
              (git-reference-commit reference))
-
-           (match (if (commit-id? commit)
-                      (or (lookup-revision commit)
-                          (lookup-origin-revision url commit))
-                      (lookup-origin-revision url commit))
-             ((? revision? revision)
+           (define hash
+             (origin-hash origin))
+
+           (match (or (lookup-by-nar-hash hash)
+                      (if (commit-id? commit)
+                          (or (lookup-revision commit)
+                              (lookup-origin-revision url commit))
+                          (lookup-origin-revision url commit)))
+             ((or (? string?) (? revision?))
               '())
              (#f
               ;; Revision is missing from the archive, attempt to save it.
@@ -1704,9 +1711,10 @@ try again later")
            (if (and=> (origin-hash origin)          ;XXX: for ungoogled-chromium
                       content-hash-value)           ;& icecat
                (let ((hash (origin-hash origin)))
-                 (match (lookup-content (content-hash-value hash)
-                                        (symbol->string
-                                         (content-hash-algorithm hash)))
+                 (match (or (lookup-by-nar-hash hash)
+                            (lookup-content (content-hash-value hash)
+                                            (symbol->string
+                                             (content-hash-algorithm hash))))
                    (#f
                     ;; If SWH doesn't have HASH as is, it may be because it's
                     ;; a hand-crafted tarball.  In that case, check whether
diff --git a/guix/platforms/or1k.scm b/guix/platforms/or1k.scm
new file mode 100644
index 0000000000..bf983085c5
--- /dev/null
+++ b/guix/platforms/or1k.scm
@@ -0,0 +1,28 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Foundation Devices, Inc. <hello@foundationdevices.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 platforms or1k)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (or1k-elf))
+
+(define or1k-elf
+  (platform
+   (target "or1k-elf")
+   (system #f)
+   (glibc-dynamic-linker #f)))
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 6d451dc902..449ab4b252 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -168,6 +168,8 @@ string is ~a.~%")
        (format #t (G_ "  commit: ~a~%") (channel-commit channel)))
       ('channels
        (pretty-print `(list ,(channel->code channel))))
+      ('channels-sans-intro
+       (pretty-print `(list ,(channel->code channel #:include-introduction? #f))))
       ('json
        (display (channel->json channel))
        (newline))
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 19052d5652..de68e6f328 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -22,17 +22,24 @@
   #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (gcrypt hash)
+  #:use-module (guix hash)
   #:use-module (guix base16)
   #:use-module (guix base32)
   #:autoload   (guix base64) (base64-encode)
   #:use-module ((guix download) #:hide (url-fetch))
+  #:use-module ((guix git)
+                #:select (latest-repository-commit
+                          update-cached-checkout
+                          with-git-error-handling))
   #:use-module ((guix build download)
                 #:select (url-fetch))
+  #:use-module (guix build utils)
   #:use-module ((guix progress)
                 #:select (current-terminal-columns))
   #:use-module ((guix build syscalls)
                 #:select (terminal-columns))
   #:use-module (web uri)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -54,6 +61,57 @@
        (url-fetch url file #:mirrors %mirrors)))
     file))
 
+;; This is a simplified version of 'copy-recursively'.
+;; It allows us to filter out the ".git" subfolder.
+;; TODO: Remove when 'copy-recursively' supports '#:select?'.
+(define (copy-recursively-without-dot-git source destination)
+  (define strip-source
+    (let ((len (string-length source)))
+      (lambda (file)
+        (substring file len))))
+
+  (file-system-fold (lambda (file stat result) ; enter?
+                      (not (string-suffix? "/.git" file)))
+                    (lambda (file stat result) ; leaf
+                      (let ((dest (string-append destination
+                                                 (strip-source file))))
+                        (case (stat:type stat)
+                          ((symlink)
+                           (let ((target (readlink file)))
+                             (symlink target dest)))
+                          (else
+                           (copy-file file dest)))))
+                    (lambda (dir stat result) ; down
+                      (let ((target (string-append destination
+                                                   (strip-source dir))))
+                        (mkdir-p target)))
+                    (const #t)          ; up
+                    (const #t)          ; skip
+                    (lambda (file stat errno result)
+                      (format (current-error-port) "i/o error: ~a: ~a~%"
+                              file (strerror errno))
+                      #f)
+                    #t
+                    source))
+
+(define (git-download-to-file url file reference recursive?)
+  "Download the git repo at URL to file, checked out at REFERENCE.
+REFERENCE must be a pair argument as understood by 'latest-repository-commit'.
+Return FILE."
+  ;; 'libgit2' doesn't support the URL format generated by 'uri->string' so
+  ;; we have to do a little fixup. Dropping completely the 'file:' protocol
+  ;; part gives better performance.
+  (let ((url (cond ((string-prefix? "file://" url)
+                     (string-drop url (string-length "file://")))
+                    ((string-prefix? "file:" url)
+                     (string-drop url (string-length "file:")))
+                    (else url))))
+    (copy-recursively-without-dot-git
+     (with-git-error-handling
+      (update-cached-checkout url #:ref reference #:recursive? recursive?))
+     file))
+  file)
+
 (define (ensure-valid-store-file-name name)
   "Replace any character not allowed in a store name by an underscore."
 
@@ -67,17 +125,46 @@
               name))
 
 
-(define* (download-to-store* url #:key (verify-certificate? #t))
+(define* (download-to-store* url
+                             #:key (verify-certificate? #t)
+                             #:allow-other-keys)
   (with-store store
     (download-to-store store url
                        (ensure-valid-store-file-name (basename url))
                        #:verify-certificate? verify-certificate?)))
 
+(define* (git-download-to-store* url
+                                 reference
+                                 recursive?
+                                 #:key (verify-certificate? #t))
+  "Download the git repository at URL to the store, checked out at REFERENCE.
+URL must specify a protocol (i.e https:// or file://), REFERENCE must be a
+pair argument as understood by 'latest-repository-commit'."
+  ;; Ensure the URL string is properly formatted  when using the 'file'
+  ;; protocol: URL is generated using 'uri->string', which returns
+  ;; "file:/path/to/file" instead of "file:///path/to/file", which in turn
+  ;; makes 'git-download-to-store' fail.
+  (let* ((file? (string-prefix? "file:" url))
+         (url (if (and file?
+                        (not (string-prefix? "file:///" url)))
+                   (string-append "file://"
+                                  (string-drop url (string-length "file:")))
+                   url)))
+    (with-store store
+      ;; TODO: Verify certificate support and deactivation.
+      (with-git-error-handling
+       (latest-repository-commit store
+                                 url
+                                 #:recursive? recursive?
+                                 #:ref reference)))))
+
 (define %default-options
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)
     (hash-algorithm . ,(hash-algorithm sha256))
     (verify-certificate? . #t)
+    (git-reference . #f)
+    (recursive? . #f)
     (download-proc . ,download-to-store*)))
 
 (define (show-help)
@@ -97,6 +184,19 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
                          do not validate the certificate of HTTPS servers "))
   (format #t (G_ "
   -o, --output=FILE      download to FILE"))
+  (format #t (G_ "
+  -g, --git              download the default branch's latest commit of the
+                         Git repository at URL"))
+  (format #t (G_ "
+      --commit=COMMIT-OR-TAG
+                         download the given commit or tag of the Git
+                         repository at URL"))
+  (format #t (G_ "
+      --branch=BRANCH    download the given branch of the Git repository
+                         at URL"))
+  (format #t (G_ "
+  -r, --recursive        download a Git repository recursively"))
+
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -105,6 +205,13 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
   (newline)
   (show-bug-report-information))
 
+(define (add-git-download-option result)
+  (alist-cons 'download-proc
+              ;; XXX: #:verify-certificate? currently ignored.
+              (lambda* (url #:key verify-certificate? ref recursive?)
+                (git-download-to-store* url ref recursive?))
+              (alist-delete 'download result)))
+
 (define %options
   ;; Specifications of the command-line options.
   (list (option '(#\f "format") #t #f
@@ -136,10 +243,46 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
                   (alist-cons 'verify-certificate? #f result)))
         (option '(#\o "output") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'download-proc
-                              (lambda* (url #:key verify-certificate?)
-                                (download-to-file url arg))
-                              (alist-delete 'download result))))
+                  (let* ((git
+                          (assoc-ref result 'git-reference)))
+                    (if git
+                        (alist-cons 'download-proc
+                                    (lambda* (url
+                                              #:key
+                                              verify-certificate?
+                                              ref
+                                              recursive?)
+                                      (git-download-to-file
+                                       url
+                                       arg
+                                       (assoc-ref result 'git-reference)
+                                       recursive?))
+                                    (alist-delete 'download result))
+                        (alist-cons 'download-proc
+                                    (lambda* (url
+                                              #:key verify-certificate?
+                                              #:allow-other-keys)
+                                      (download-to-file url arg))
+                                    (alist-delete 'download result))))))
+        (option '(#\g "git") #f #f
+                (lambda (opt name arg result)
+                  ;; Ignore this option if 'commit' or 'branch' has
+                  ;; already been provided
+                  (if (assoc-ref result 'git-reference)
+                      result
+                      (alist-cons 'git-reference '()
+                                  (add-git-download-option result)))))
+        (option '("commit") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'git-reference `(tag-or-commit . ,arg)
+                              (add-git-download-option result))))
+        (option '("branch") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'git-reference `(branch . ,arg)
+                              (add-git-download-option result))))
+        (option '(#\r "recursive") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'recursive? #t result)))
 
         (option '(#\h "help") #f #f
                 (lambda args
@@ -183,12 +326,14 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
                                   (terminal-columns)))
                     (fetch (uri->string uri)
                            #:verify-certificate?
-                           (assq-ref opts 'verify-certificate?))))
-           (hash  (call-with-input-file
-                      (or path
-                          (leave (G_ "~a: download failed~%")
-                                 arg))
-                    (cute port-hash (assoc-ref opts 'hash-algorithm) <>)))
+                           (assq-ref opts 'verify-certificate?)
+                           #:ref (assq-ref opts 'git-reference)
+                           #:recursive? (assq-ref opts 'recursive?))))
+           (hash  (let* ((path* (or path
+                                  (leave (G_ "~a: download failed~%")
+                                         arg))))
+                   (file-hash* path*
+                               #:algorithm (assoc-ref opts 'hash-algorithm))))
            (fmt   (assq-ref opts 'format)))
       (format #t "~a~%~a~%" path (fmt hash))
       #t)))
diff --git a/guix/scripts/git/authenticate.scm b/guix/scripts/git/authenticate.scm
index 5f5d423f28..6ff5cee682 100644
--- a/guix/scripts/git/authenticate.scm
+++ b/guix/scripts/git/authenticate.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,6 +27,7 @@
   #:use-module ((guix git) #:select (with-git-error-handling))
   #:use-module (guix progress)
   #:use-module (guix base64)
+  #:autoload   (rnrs bytevectors) (bytevector-length)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
@@ -133,6 +134,16 @@ Authenticate the given Git checkout using COMMIT/SIGNER as its introduction.\n")
   (define commit-short-id
     (compose (cut string-take <> 7) oid->string commit-id))
 
+  (define (openpgp-fingerprint* str)
+    (unless (string-every (char-set-union char-set:hex-digit
+                                          char-set:whitespace)
+                          str)
+      (leave (G_ "~a: invalid OpenPGP fingerprint~%") str))
+    (let ((fingerprint (openpgp-fingerprint str)))
+      (unless (= 20 (bytevector-length fingerprint))
+        (leave (G_ "~a: wrong length for OpenPGP fingerprint~%") str))
+      fingerprint))
+
   (define (make-reporter start-commit end-commit commits)
     (format (current-error-port)
             (G_ "Authenticating commits ~a to ~a (~h new \
@@ -165,7 +176,7 @@ commits)...~%")
                                 (repository-cache-key repository))))
           (define stats
             (authenticate-repository repository (string->oid commit)
-                                     (openpgp-fingerprint signer)
+                                     (openpgp-fingerprint* signer)
                                      #:end end
                                      #:keyring-reference keyring
                                      #:historical-authorizations history
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index d2a1cee56e..1f34cab088 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts import)
+  #:use-module (guix import utils)
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix read-print)
@@ -65,10 +67,39 @@ Run IMPORTER with ARGS.\n"))
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
+  -i, --insert           insert packages into file alphabetically"))
+  (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
   (show-bug-report-information))
 
+(define (import-as-definitions importer args proc)
+  "Wrap package expressions from IMPORTER with 'define-public and invoke
+PROC callback."
+  (if (member importer importers)
+      (match (apply (resolve-importer importer) args)
+        ((and expr (or ('package _ ...)
+                       ('let _ ...)))
+         (proc (package->definition expr)))
+        ((and expr ('define-public _ ...))
+         (proc expr))
+        ((expressions ...)
+         (for-each (lambda (expr)
+                     (match expr
+                       ((and expr (or ('package _ ...)
+                                      ('let _ ...)))
+                        (proc (package->definition expr)))
+                       ((and expr ('define-public _ ...))
+                        (proc expr))))
+                   expressions))
+        (x
+         (leave (G_ "'~a' import failed~%") importer)))
+      (let ((hint (string-closest importer importers #:threshold 3)))
+        (report-error (G_ "~a: invalid importer~%") importer)
+        (when hint
+          (display-hint (G_ "Did you mean @code{~a}?~%") hint))
+        (exit 1))))
+
 (define-command (guix-import . args)
   (category packaging)
   (synopsis "import a package definition from an external repository")
@@ -77,32 +108,33 @@ Run IMPORTER with ARGS.\n"))
     (()
      (format (current-error-port)
              (G_ "guix import: missing importer name~%")))
-    ((or ("-h") ("--help"))
+    ((or ("-h" _ ...) ("--help" _ ...))
      (leave-on-EPIPE (show-help))
      (exit 0))
-    ((or ("-V") ("--version"))
+    ((or ("-V" _ ...) ("--version" _ ...))
      (show-version-and-exit "guix import"))
+    ((or ("-i" file importer args ...)
+         ("--insert" file importer args ...))
+     (let ((find-and-insert
+             (lambda (expr)
+               (match expr
+                 (('define-public term _ ...)
+                  (let ((source-properties
+                          (find-definition-insertion-location
+                            file term)))
+                    (if source-properties
+                      (insert-expression source-properties expr)
+                      (let ((port (open-file file "a")))
+                        (pretty-print-with-comments port expr)
+                        (newline port)
+                        (close-port port)))))))))
+       (import-as-definitions importer args find-and-insert)))
     ((importer args ...)
-     (if (member importer importers)
-         (let ((print (lambda (expr)
-                        (leave-on-EPIPE
-                         (pretty-print-with-comments (current-output-port) expr)))))
-           (match (apply (resolve-importer importer) args)
-             ((and expr (or ('package _ ...)
-                            ('let _ ...)
-                            ('define-public _ ...)))
-              (print expr))
-             ((? list? expressions)
-              (for-each (lambda (expr)
-                          (print expr)
-                          ;; Two newlines: one after the closing paren, and
-                          ;; one to leave a blank line.
-                          (newline) (newline))
-                        expressions))
-             (x
-              (leave (G_ "'~a' import failed~%") importer))))
-         (let ((hint (string-closest importer importers #:threshold 3)))
-           (report-error (G_ "~a: invalid importer~%") importer)
-           (when hint
-             (display-hint (G_ "Did you mean @code{~a}?~%") hint))
-           (exit 1))))))
+     (let ((print (lambda (expr)
+                    (leave-on-EPIPE
+                      (pretty-print-with-comments
+                        (current-output-port) expr)
+                      ;; Two newlines: one after the closing paren, and
+                      ;; one to leave a blank line.
+                      (newline) (newline)))))
+       (import-as-definitions importer args print)))))
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index 9aa0e61e9d..e7eb3b2a1f 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2018, 2020, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -115,6 +115,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
       (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin")
 
       (git-fetch-with-fallback url commit output
+                               #:hash hash
+                               #:hash-algorithm algo
                                #:recursive? recursive?
                                #:git-command %git))))
 
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 2f8985593d..08a1b22a74 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
@@ -388,6 +388,8 @@ Report the availability of substitutes.\n"))
   -m, --manifest=MANIFEST
                          look up substitutes for packages specified in MANIFEST"))
   (display (G_ "
+  -e, --expression=EXPR  build the object EXPR evaluates to"))
+  (display (G_ "
   -c, --coverage[=COUNT]
                          show substitute coverage for packages with at least
                          COUNT dependents"))
@@ -426,6 +428,9 @@ Report the availability of substitutes.\n"))
          (option '(#\m "manifest") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'manifest arg result)))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
          (option '(#\c "coverage") #f #t
                  (lambda (opt name arg result)
                    (alist-cons 'coverage
@@ -611,6 +616,8 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
           (base  (filter-map (match-lambda
                                (('argument . spec)
                                 (specification->package spec))
+                               (('expression . str)
+                                (read/eval-package-expression str))
                                (_
                                 #f))
                              opts)))
diff --git a/guix/self.scm b/guix/self.scm
index f378548959..19c6d08e01 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -65,6 +65,7 @@
       ("guile-gnutls"       . ,(ref 'tls 'guile-gnutls))
       ("guix-daemon"        . ,(ref 'package-management 'guix-daemon))
       ("disarchive"         . ,(ref 'backup 'disarchive))
+      ("guile-bzip2"        . ,(ref 'guile 'guile-bzip2))
       ("guile-lzma"         . ,(ref 'guile 'guile-lzma))
       ("gzip"               . ,(ref 'compression 'gzip))
       ("bzip2"              . ,(ref 'compression 'bzip2))
@@ -827,6 +828,9 @@ itself."
   (define disarchive
     (specification->package "disarchive"))
 
+  (define guile-bzip2
+    (specification->package "guile-bzip2"))
+
   (define guile-lzma
     (specification->package "guile-lzma"))
 
@@ -1058,6 +1062,7 @@ itself."
                                         #:source source
                                         #:dependencies
                                         (cons* disarchive
+                                               guile-bzip2
                                                guile-lzma
                                                dependencies)
                                         #:guile guile-for-build
diff --git a/guix/swh.scm b/guix/swh.scm
index c7c1c873a2..04cecd854c 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2021, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
@@ -78,6 +78,14 @@
             lookup-revision
             lookup-origin-revision
 
+            external-id?
+            external-id-value
+            external-id-type
+            external-id-version
+            external-id-target
+            lookup-external-id
+            lookup-directory-by-nar-hash
+
             content?
             content-checksums
             content-data-url
@@ -115,6 +123,7 @@
             commit-id?
 
             swh-download-directory
+            swh-download-directory-by-nar-hash
             swh-download))
 
 ;;; Commentary:
@@ -382,6 +391,15 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   (permissions   directory-entry-permissions "perms")
   (target-url    directory-entry-target-url "target_url"))
 
+;; <https://archive.softwareheritage.org/api/1/extid/doc/>
+(define-json-mapping <external-id> make-external-id external-id?
+  json->external-id
+  (value         external-id-value "extid")
+  (type          external-id-type "extid_type")
+  (version       external-id-version "extid_version")
+  (target        external-id-target)
+  (target-url    external-id-target-url "target_url"))
+
 ;; <https://archive.softwareheritage.org/api/1/origin/save/>
 (define-json-mapping <save-reply> make-save-reply save-reply?
   json->save-reply
@@ -428,7 +446,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   json->revision)
 
 (define-query (lookup-directory id)
-  "Return the directory with the given ID."
+  "Return the list of entries of the directory with the given ID."
   (path "/api/1/directory" id)
   json->directory-entries)
 
@@ -436,6 +454,24 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   (map json->directory-entry
        (vector->list (json->scm port))))
 
+(define (lookup-external-id type id)
+  "Return the external ID record for ID, a bytevector, of the given TYPE
+(currently one of: \"bzr-nodeid\", \"hg-nodeid\", \"nar-sha256\",
+\"checksum-sha512\")."
+  (call (swh-url "/api/1/extid" type
+                 (string-append "hex:" (bytevector->base16-string id)))
+        json->external-id))
+
+(define* (lookup-directory-by-nar-hash hash #:optional (algorithm 'sha256))
+  "Return the SWHID of a directory---i.e., prefixed by \"swh:1:dir\"---for the
+directory that with the given HASH (a bytevector), assuming nar serialization
+and use of ALGORITHM."
+  ;; example:
+  ;; https://archive.softwareheritage.org/api/1/extid/nar-sha256/base64url:0jD6Z4TLMm5g1CviuNNuVNP31KWyoT_oevfr8TQwc3Y/
+  (and=> (lookup-external-id (string-append "nar-" (symbol->string algorithm))
+                             hash)
+         external-id-target))
+
 (define (origin-visits origin)
   "Return the list of visits of ORIGIN, a record as returned by
 'lookup-origin'."
@@ -583,6 +619,41 @@ directory identifier is deprecated."
         json->vault-reply
         http-post*))
 
+(define* (http-get/follow url
+                          #:key
+                          (verify-certificate? (%verify-swh-certificate?)))
+  "Like 'http-get' but follow redirects (HTTP 30x).  On success, return two
+values: an input port to read the response body and its 'Content-Length'.  On
+failure return #f and #f."
+  (define uri
+    (if (string? url) (string->uri url) url))
+
+  (let loop ((uri uri))
+    (define (resolve-uri-reference target)
+      (if (and (uri-scheme target) (uri-host target))
+          target
+          (build-uri (uri-scheme uri) #:host (uri-host uri)
+                     #:port (uri-port uri)
+                     #:path (uri-path target))))
+
+    (let*-values (((response port)
+                   (http-get* uri #:streaming? #t
+                              #:verify-certificate? verify-certificate?))
+                  ((code)
+                   (response-code response)))
+      (case code
+        ((200)
+         (values port (response-content-length response)))
+        ((301                                     ; moved permanently
+          302                                     ; found (redirection)
+          303                                     ; see other
+          307                                     ; temporary redirection
+          308)                                    ; permanent redirection
+         (close-port port)
+         (loop (resolve-uri-reference (response-location response))))
+        (else
+         (values #f #f))))))
+
 (define* (vault-fetch id
                       #:optional kind
                       #:key
@@ -604,16 +675,11 @@ for a tarball containing a bare Git repository corresponding to a revision."
        (match (vault-reply-status reply)
          ('done
           ;; Fetch the bundle.
-          (let-values (((response port)
-                        (http-get* (swh-url (vault-reply-fetch-url reply))
-                                   #:streaming? #t
-                                   #:verify-certificate?
-                                   (%verify-swh-certificate?))))
-            (if (= (response-code response) 200)
-                port
-                (begin                            ;shouldn't happen
-                  (close-port port)
-                  #f))))
+          (let-values (((port length)
+                        (http-get/follow (swh-url (vault-reply-fetch-url reply))
+                                         #:verify-certificate?
+                                         (%verify-swh-certificate?))))
+            port))
          ('failed
           ;; Upon failure, we're supposed to try again.
           (format log-port "SWH vault: failure: ~a~%"
@@ -740,3 +806,26 @@ wait until it becomes available, which could take several minutes."
              "SWH: revision ~s originating from ~a could not be found~%"
              reference url)
      #f)))
+
+(define* (swh-download-directory-by-nar-hash hash algorithm output
+                                             #:key
+                                             (log-port (current-error-port)))
+  "Download from Software Heritage the directory with the given nar HASH for
+ALGORITHM (a symbol such as 'sha256), and unpack it in OUTPUT.  Return #t on
+success and #f on failure.
+
+This procedure uses the \"vault\", which contains \"cooked\" directories in
+the form of tarballs.  If the requested directory is not cooked yet, it will
+wait until it becomes available, which could take several minutes."
+  (match (lookup-directory-by-nar-hash hash algorithm)
+    (#f
+     (format log-port
+             "SWH: directory with nar-~a hash ~a not found~%"
+             algorithm (bytevector->base16-string hash))
+     #f)
+    (swhid
+     (format log-port "SWH: found directory with nar-~a hash ~a at '~a'~%"
+             algorithm (bytevector->base16-string hash) swhid)
+     (swh-download-archive swhid output
+                           #:archive-type 'flat   ;SWHID denotes a directory
+                           #:log-port log-port))))
diff --git a/guix/upstream.scm b/guix/upstream.scm
index e28ae12f3f..180ae21dcf 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2019, 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019, 2022-2024 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
@@ -566,17 +566,21 @@ specified in SOURCE, an <upstream-source>."
              (properties (package-properties package))
              (ignore (or (assoc-ref properties ignore-property) '()))
              (extra (or (assoc-ref properties extra-property) '())))
-        (append (if (null? ignore)
-                    inputs
-                    (remove (lambda (input)
-                              (member (upstream-input-downstream-name input)
-                                      ignore))
-                            inputs))
-                (map (lambda (name)
-                       (upstream-input
-                        (name name)
-                        (downstream-name name)))
-                     extra)))))
+        (sort
+         (append (if (null? ignore)
+                     inputs
+                     (remove (lambda (input)
+                               (member (upstream-input-downstream-name input)
+                                       ignore))
+                             inputs))
+                 (map (lambda (name)
+                        (upstream-input
+                         (name name)
+                         (downstream-name name)))
+                      extra))
+         (lambda (a b)
+           (string-ci<? (upstream-input-downstream-name a)
+                        (upstream-input-downstream-name b)))))))
 
   (define regular-inputs
     (filtered-inputs upstream-source-regular-inputs
diff --git a/guix/utils.scm b/guix/utils.scm
index e4e9d922e7..29ad09d9f7 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -20,6 +20,7 @@
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
 ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,7 @@
 
 (define-module (guix utils)
   #:use-module (guix config)
+  #:autoload   (guix read-print) (object->string*)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -145,6 +147,8 @@
             go-to-location
             edit-expression
             delete-expression
+            insert-expression
+            find-definition-insertion-location
 
             filtered-port
             decompressed-port
@@ -502,6 +506,32 @@ the trailing line is included in the edited expression."
   "Delete the expression specified by SOURCE-PROPERTIES."
   (edit-expression source-properties (const "") #:include-trailing-newline? #t))
 
+(define (insert-expression source-properties expr)
+  "Insert EXPR before the top-level expression specified by
+SOURCE-PROPERTIES."
+  (let* ((expr (object->string* expr 0))
+         (insert (lambda (str)
+                   (string-append expr "\n\n" str))))
+    (edit-expression source-properties insert)))
+
+(define (find-definition-insertion-location file term)
+  "Search in FILE for a top-level public definition whose defined term
+alphabetically succeeds TERM. Return the location if found, or #f
+otherwise."
+  (let ((search-term (symbol->string term)))
+    (call-with-input-file file
+      (lambda (port)
+        (do ((syntax (read-syntax port)
+                     (read-syntax port)))
+          ((match (syntax->datum syntax)
+             (('define-public current-term _ ...)
+              (string> (symbol->string current-term)
+                       search-term))
+             ((? eof-object?) #t)
+             (_ #f))
+           (and (not (eof-object? syntax))
+                (syntax-source syntax))))))))
+
 
 ;;;
 ;;; Keyword arguments.