Merge branch 'master' into gnome-team

18 files changed, 493 insertions, 302 deletions

diff --git a/guix/build/bzr.scm b/guix/build/bzr.scm
index a0f5e15880..dede5e031a 100644
--- a/guix/build/bzr.scm
+++ b/guix/build/bzr.scm
@@ -37,6 +37,7 @@ revision identifier.  Return #t on success, else throw an exception."
   (invoke bzr-command "-Ossl.cert_reqs=none" "checkout"
           "--lightweight" "-r" revision url directory)
   (with-directory-excursion directory
-    (delete-file-recursively ".bzr")))
+    (delete-file-recursively ".bzr"))
+  #t)
 
 ;;; bzr.scm ends here
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 3ba121b7fb..f26ad28cd0 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2019, 2020, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,9 +57,9 @@ ITEM."
       (restore-file decompressed-port
                     item))))
 
-(define (download-nar item)
-  "Download and extract the normalized archive for ITEM.  Return #t on
-success, #f otherwise."
+(define* (download-nar item #:optional (output item))
+  "Download and extract to OUTPUT the normalized archive for ITEM, a store
+item.  Return #t on success, #f otherwise."
   ;; Let progress reports go through.
   (setvbuf (current-error-port) 'none)
   (setvbuf (current-output-port) 'none)
@@ -96,10 +96,10 @@ success, #f otherwise."
                                              #:download-size size)))
                  (if (string-contains url "/lzip")
                      (restore-lzipped-nar port-with-progress
-                                          item
+                                          output
                                           size)
                      (restore-file port-with-progress
-                                   item)))
+                                   output)))
                (newline)
                #t))))
       (()
diff --git a/guix/build/download.scm b/guix/build/download.scm
index db0a39084b..74b7486b7b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com>
@@ -40,7 +40,10 @@
   #:autoload   (guix swh) (swh-download-directory %verify-swh-certificate?)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
-  #:export (open-socket-for-uri
+  #:export (%download-methods
+            download-method-enabled?
+
+            open-socket-for-uri
             open-connection-for-uri
             http-fetch
             %x509-certificate-directory
@@ -622,6 +625,20 @@ true, verify HTTPS certificates; otherwise simply ignore them."
     (lambda (key . args)
       (print-exception (current-error-port) #f key args))))
 
+(define %download-methods
+  ;; Either #f (the default) or a list of symbols denoting the sequence of
+  ;; download methods to be used--e.g., '(swh nar upstream).
+  (make-parameter
+   (and=> (getenv "GUIX_DOWNLOAD_METHODS")
+          (lambda (str)
+            (map string->symbol (string-tokenize str))))))
+
+(define (download-method-enabled? method)
+  "Return true if METHOD (a symbol such as 'swh) is enabled as part of the
+download fallback sequence."
+  (or (not (%download-methods))
+      (memq method (%download-methods))))
+
 (define (uri-vicinity dir file)
   "Concatenate DIR, slash, and FILE, keeping only one slash in between.
 This is required by some HTTP servers."
@@ -788,18 +805,28 @@ otherwise simply ignore them."
                          hashes)))
                 disarchive-mirrors))
 
+  (define initial-uris
+    (append (if (download-method-enabled? 'upstream)
+                uri
+                '())
+            (if (download-method-enabled? 'content-addressed-mirrors)
+                content-addressed-uris
+                '())
+            (if (download-method-enabled? 'internet-archive)
+                (match uri
+                  ((first . _)
+                   (or (and=> (internet-archive-uri first) list)
+                       '()))
+                  (() '()))
+                '())))
+
   ;; Make this unbuffered so 'progress-report/file' works as expected.  'line
   ;; means '\n', not '\r', so it's not appropriate here.
   (setvbuf (current-output-port) 'none)
 
   (setvbuf (current-error-port) 'line)
 
-  (let try ((uri (append uri content-addressed-uris
-                   (match uri
-                     ((first . _)
-                      (or (and=> (internet-archive-uri first) list)
-                          '()))
-                     (() '())))))
+  (let try ((uri initial-uris))
     (match uri
       ((uri tail ...)
        (or (fetch uri file)
@@ -807,9 +834,10 @@ otherwise simply ignore them."
       (()
        ;; If we are looking for a software archive, one last thing we
        ;; can try is to use Disarchive to assemble it.
-       (or (disarchive-fetch/any disarchive-uris file
-                                 #:verify-certificate? verify-certificate?
-                                 #:timeout timeout)
+       (or (and (download-method-enabled? 'disarchive)
+                (disarchive-fetch/any disarchive-uris file
+                                      #:verify-certificate? verify-certificate?
+                                      #:timeout timeout))
            (begin
              (format (current-error-port) "failed to download ~s from ~s~%"
                      file url)
diff --git a/guix/build/git.scm b/guix/build/git.scm
index 4c69365a7b..62877394bb 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -19,6 +19,8 @@
 
 (define-module (guix build git)
   #:use-module (guix build utils)
+  #:use-module ((guix build download)
+                #:select (download-method-enabled?))
   #:autoload   (guix build download-nar) (download-nar)
   #:autoload   (guix swh) (%verify-swh-certificate?
                            swh-download
@@ -92,25 +94,30 @@ fetched, recursively.  Return #t on success, #f otherwise."
 
 
 (define* (git-fetch-with-fallback url commit directory
-                                  #:key (git-command "git")
+                                  #:key (item directory)
+                                  (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.  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?
-                 #:git-command git-command)
-      (download-nar directory)
+alternative methods when fetching from URL fails: attempt to download a nar
+for ITEM, 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 (and (download-method-enabled? 'upstream)
+           (git-fetch url commit directory
+                      #:lfs? lfs?
+                      #:recursive? recursive?
+                      #:git-command git-command))
+      (and (download-method-enabled? 'nar)
+           (download-nar item directory))
 
       ;; As a last resort, attempt to download from Software Heritage.
       ;; Disable X.509 certificate verification to avoid depending
       ;; on nss-certs--we're authenticating the checkout anyway.
       ;; XXX: Currently recursive checkouts are not supported.
       (and (not recursive?)
+           (download-method-enabled? 'swh)
            (parameterize ((%verify-swh-certificate? #f))
              (format (current-error-port)
                      "Trying to download from Software Heritage...~%")
diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
index e7e7f2d0be..8927da224a 100644
--- a/guix/build/guile-build-system.scm
+++ b/guix/build/guile-build-system.scm
@@ -184,39 +184,38 @@ installed; this is useful for files that are meant to be included."
                              (#f "")
                              (path (string-append ":" path)))))
 
-  (let ((source-files
+    (let ((source-files
            (with-directory-excursion source-directory
              (find-files "." scheme-file-regexp))))
-    (invoke-each
-     (filter-map (lambda (file)
-                   (and (or (not not-compiled-file-regexp)
-                            (not (string-match not-compiled-file-regexp
-                                               file)))
-                        (cons* guild
-                               "guild" "compile"
-                               "-L" source-directory
-                               "-o" (string-append go-dir
-                                                   (file-sans-extension file)
-                                                   ".go")
-                               (string-append source-directory "/" file)
-                               flags)))
-                 source-files)
-     #:max-processes (parallel-job-count)
-     #:report-progress report-build-progress)
-
-    (for-each
-     (lambda (file)
+      (for-each
+       (lambda (file)
          (install-file (string-append source-directory "/" file)
                        (string-append module-dir
                                       "/" (dirname file))))
-     source-files))
+       source-files)
+      (invoke-each
+       (filter-map (lambda (file)
+                     (and (or (not not-compiled-file-regexp)
+                              (not (string-match not-compiled-file-regexp
+                                                 file)))
+                          (cons* guild
+                                 "guild" "compile"
+                                 "-L" source-directory
+                                 "-o" (string-append go-dir
+                                                     (file-sans-extension file)
+                                                     ".go")
+                                 (string-append source-directory "/" file)
+                                 flags)))
+                   source-files)
+       #:max-processes (parallel-job-count)
+       #:report-progress report-build-progress))
     #t))
 
 (define* (install-documentation #:key outputs
                                 (documentation-file-regexp
                                  %documentation-file-regexp)
                                 #:allow-other-keys)
-  "Install files that mactch DOCUMENTATION-FILE-REGEXP."
+  "Install files that match DOCUMENTATION-FILE-REGEXP."
   (let* ((out (assoc-ref outputs "out"))
          (doc (string-append out "/share/doc/"
                              (strip-store-file-name out))))
diff --git a/guix/build/rakudo-build-system.scm b/guix/build/rakudo-build-system.scm
index 5cf1cc55bc..8f9a3b11d8 100644
--- a/guix/build/rakudo-build-system.scm
+++ b/guix/build/rakudo-build-system.scm
@@ -36,7 +36,11 @@
 (define* (check #:key tests? inputs with-prove6? #:allow-other-keys)
   (if (and tests? (assoc-ref inputs "perl6-tap-harness"))
   ;(if (and tests? with-prove6?)
-      (invoke "prove6" "-I=lib" "t/")
+      (let ((test-files (find-files "t/" "\\.(rakutest|t|t6)$")))
+        (invoke "raku" "-MTAP" "-e"
+                (string-append
+                 "my @tests = <" (string-join test-files " ") ">; "
+                 "TAP::Harness.new().run(@tests);")))
       (format #t "test suite not run~%"))
   #t)
 
@@ -59,7 +63,7 @@
           #t)
         (begin
           (let ((inst (string-append (assoc-ref inputs "rakudo")
-                                     "/share/perl6/tools/install-dist.p6")))
+                                     "/share/perl6/tools/install-dist.raku")))
             (setenv "RAKUDO_RERESOLVE_DEPENDENCIES" "0")
             (setenv "RAKUDO_MODULE_DEBUG" "1") ; be verbose while building
             (invoke inst (string-append "--to=" perl6) "--for=site"))))))
diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm
index d97f84838e..a22c9bee99 100644
--- a/guix/bzr-download.scm
+++ b/guix/bzr-download.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,7 +24,7 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix store)
-
+  #:use-module (ice-9 match)
   #:export (bzr-reference
             bzr-reference?
             bzr-reference-url
@@ -51,20 +52,46 @@
     (module-ref distro 'breezy)))
 
 (define* (bzr-fetch ref hash-algo hash
-                       #:optional name
-                       #:key (system (%current-system)) (guile (default-guile))
-                       (bzr (bzr-package)))
+                    #:optional name
+                    #:key (system (%current-system)) (guile (default-guile))
+                    (bzr (bzr-package)))
   "Return a fixed-output derivation that fetches REF, a <bzr-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
+  (define guile-json
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
+
+  (define guile-lzlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
+
+  (define guile-gnutls
+    (module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls))
+
   (define build
-    (with-imported-modules (source-module-closure
-                            '((guix build bzr)))
-      #~(begin
-          (use-modules (guix build bzr))
-          (bzr-fetch
-           (getenv "bzr url") (getenv "bzr reference") #$output
-           #:bzr-command (string-append #+bzr "/bin/brz")))))
+    (with-extensions (list guile-gnutls guile-lzlib guile-json)
+      (with-imported-modules (source-module-closure
+                              '((guix build bzr)
+                                (guix build utils)
+                                (guix build download)
+                                (guix build download-nar)))
+        #~(begin
+            (use-modules (guix build bzr)
+                         (guix build download-nar)
+                         ((guix build download)
+                          #:select (download-method-enabled?))
+                         (guix build utils)
+                         (srfi srfi-34))
+
+            (or (and (download-method-enabled? 'upstream)
+                     (guard (c ((invoke-error? c)
+                                (report-invoke-error c)
+                                #f))
+                       (bzr-fetch (getenv "bzr url") (getenv "bzr reference")
+                                  #$output
+                                  #:bzr-command
+                                  (string-append #+bzr "/bin/brz"))))
+                (and (download-method-enabled? 'nar)
+                     (download-nar #$output)))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "bzr-branch") build
@@ -74,12 +101,16 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                       #:script-name "bzr-download"
                       #:env-vars
                       `(("bzr url" . ,(bzr-reference-url ref))
-                        ("bzr reference" . ,(bzr-reference-revision ref)))
+                        ("bzr reference" . ,(bzr-reference-revision ref))
+                        ,@(match (getenv "GUIX_DOWNLOAD_METHODS")
+                            (#f '())
+                            (value
+                             `(("GUIX_DOWNLOAD_METHODS" . ,value)))))
                       #:leaked-env-vars '("http_proxy" "https_proxy"
                                           "LC_ALL" "LC_MESSAGES" "LANG"
                                           "COLUMNS")
                       #:system system
-                      #:local-build? #t  ;don't offload repo branching
+                      #:local-build? #t          ;don't offload repo branching
                       #:hash-algo hash-algo
                       #:hash hash
                       #:recursive? #t
diff --git a/guix/cpu.scm b/guix/cpu.scm
index 29ad883584..840215cff0 100644
--- a/guix/cpu.scm
+++ b/guix/cpu.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2022, 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2022-2024 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -113,7 +113,7 @@
   "Return the architecture name, suitable for GCC's '-march' flag, that
 corresponds to CPU, a record as returned by 'current-cpu'."
   (match (cpu-architecture cpu)
-    ("x86_64"
+    ((or "x86_64" "i686")
      ;; Transcribed from GCC's 'host_detect_local_cpu' in driver-i386.cc.
      (letrec-syntax ((if-flags (syntax-rules (=>)
                                  ((_)
@@ -128,18 +128,21 @@ corresponds to CPU, a record as returned by 'current-cpu'."
 
        (or (and (equal? "GenuineIntel" (cpu-vendor cpu))
                 (= 6 (cpu-family cpu))              ;the "Pentium Pro" family
-                (if-flags ("avx" "raoint" => "grandridge")
-                          ("avx" "amx_fp16" => "graniterapids")
+                (if-flags ("avx512f" "amx_complex" => "graniterapids-d")
+                          ("avx512f" "amx_fp16" => "graniterapids")
+                          ("avx512f" "avx512vp2intersect" => "tigerlake")
+                          ("avx512f" "tsxldtrk" => "sapphirerapids")
+                          ("avx512f" "avx512bf16" => "cooperlake")
+                          ("avx512f" "wbnoinvd" => "icelake-server")
+                          ("avx512f" "avx512bitalg" => "icelake-client")
+                          ("avx512f" "avx512vbmi" => "cannonlake")
+                          ("avx512f" "avx5124vnniw" => "knm")
+                          ("avx512f" "avx512er" => "knl")
+                          ("avx512f" => "skylake-avx512")
+                          ("avx" "prefetchi" => "pantherlake")
+                          ("avx" "user_msr" => "clearwaterforest")
+                          ("avx" "sm3" => "arrowlake-s")
                           ("avx" "avxvnniint8" => "sierraforest")
-                          ("avx" "avx512vp2intersect" => "tigerlake")
-                          ("avx" "tsxldtrk" => "sapphirerapids")
-                          ("avx" "avx512bf16" => "cooperlake")
-                          ("avx" "wbnoinvd" => "icelake-server")
-                          ("avx" "avx512bitalg" => "icelake-client")
-                          ("avx" "avx512vbmi" => "cannonlake")
-                          ("avx" "avx5124vnniw" => "knm")
-                          ("avx" "avx512er" => "knl")
-                          ("avx" "avx512f" => "skylake-avx512")
                           ("avx" "serialize" => "alderlake")
                           ("avx" "clflushopt" => "skylake")
                           ("avx" "adx" => "broadwell")
@@ -190,10 +193,16 @@ corresponds to CPU, a record as returned by 'current-cpu'."
                     (= #x3b (cpu-model cpu)))
              "lujiazui"
              (cpu->micro-architecture-level cpu))
+           (if (and (= 7 (cpu-family cpu))
+                    (>= #x5b (cpu-model cpu)))
+             "yongfeng"
+             (cpu->micro-architecture-level cpu))
 
          ;; TODO: Recognize CENTAUR/CYRIX/NSC?
 
-         "x86_64")))
+         (match (cpu-architecture cpu)
+           ("x86_64" "x86-64")
+           (_ "generic")))))
     ("aarch64"
      ;; Transcribed from GCC's list of aarch64 processors in aarch64-cores.def
      ;; What to do with big.LITTLE cores?
@@ -210,7 +219,9 @@ corresponds to CPU, a record as returned by 'current-cpu'."
           (#xd15
            "armv8-r")
           ((or #xd46 #xd47 #xd4d #xd48 #xd4e #xd49 #xd4f)
-           "armv9-a")))
+           "armv9-a")
+          ((or #xd80 #xd81)
+           "armv9.2-a")))
        ("0x42"
         "armv8.1-a")
        ("0x43"
@@ -241,8 +252,14 @@ corresponds to CPU, a record as returned by 'current-cpu'."
         "armv8-a")
        ("0x68"
         "armv8-a")
+       ("0x6d"
+        "armv9-a")
        ("0xC0"
-        "armv8.6-a")
+        (match (cpu-model cpu)
+          ((or #xac3 #xac4)
+           "armv8.6-a")
+          (#xac5
+           "armv8.7-a")))
        ("0xC00"
         "armv8-a")
        (_
@@ -275,12 +292,12 @@ correspond roughly to CPU, a record as returned by 'current-cpu'."
              ;; v2: CMPXCHG16B, LAHF, SAHF, POPCNT, SSE3, SSE4.1, SSE4.2, SSSE3
              ("avx512f" "avx512bw" "abx512cd" "abx512dq" "avx512vl"
               "avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe"
-              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v4")
+              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86-64-v4")
              ("avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe"
-              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v3")
-             ("popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v2")
-             (_ => "x86_64-v1")))
-         "x86_64-v1"))
+              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86-64-v3")
+             ("popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86-64-v2")
+             (_ => "x86-64")))
+         "x86-64"))
     (architecture
      ;; TODO: More architectures
      architecture)))
@@ -289,19 +306,22 @@ correspond roughly to CPU, a record as returned by 'current-cpu'."
   "Return a matching psABI micro-architecture, allowing optimizations for x86_64
 CPUs for compilers which don't allow for more focused optimizing."
   ;; Matching gcc-architectures isn't an easy task, with the rule-of-thumb being
-  ;; 'Haswell and higher' qualify for x86_64-v3.
+  ;; AVX512F+ for x86-64-v4, AVX+ for x86-64-v3.
   ;; https://gitlab.com/x86-psABIs/x86-64-ABI/-/blob/master/x86-64-ABI/low-level-sys-info.tex
   (match gcc-architecture
-    ((or "grandridge" "graniterapids" "sierraforest" "tigerlake"
-         "sapphirerapids" "cooperlake" "icelake-server" "icelake-client"
-         "cannonlake" "knm" "knl" "skylake-avx512" "alderlake" "skylake"
-         "broadwell" "haswell"
-         "znver4" "znver3" "znver2" "znver1" "bdver4")
-     "x86_64-v3")
+    ((or "graniterapids-d" "graniterapids" "tigerlake" "sapphirerapids"
+         "cooperlake" "icelake-server" "icelake-client" "cannonlake" "knm"
+         "knl" "skylake-avx512"
+         "znver4")
+     "x86-64-v4")
+    ((or "pantherlake" "clearwaterforest" "arrowlake-s" "sierraforest"
+         "alderlake" "skylake" "broadwell" "haswell"
+         "znver3" "znver2" "znver1" "bdver4")
+     "x86-64-v3")
     ((or "sandybridge" "tremont" "goldmont-plus" "goldmont" "silvermont"
          "nehalem" "bonnell" "core2"
          "btver2" "athalon" "k8-sse3" "k8" "bdver3" "bdver2" "bdver1" "btver1"
          "amdfam10"
-         "lujiazui" "x86-64")
-     "x86_64-v1")
+         "lujiazui" "yongfeng" "x86-64")
+     "x86-64")
     (_ gcc-architecture)))
diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index c0c526b9db..023054941b 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
@@ -73,6 +73,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
   (define modules
     (delete '(guix config)
             (source-module-closure '((guix build cvs)
+                                     (guix build download)
                                      (guix build download-nar)))))
   (define build
     (with-imported-modules modules
@@ -80,20 +81,29 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                              guile-lzlib)
         #~(begin
             (use-modules (guix build cvs)
+                         ((guix build download)
+                          #:select (download-method-enabled?))
                          (guix build download-nar))
 
-            (or (cvs-fetch '#$(cvs-reference-root-directory ref)
-                           '#$(cvs-reference-module ref)
-                           '#$(cvs-reference-revision ref)
-                           #$output
-                           #:cvs-command (string-append #+cvs "/bin/cvs"))
-                (download-nar #$output))))))
+            (or (and (download-method-enabled? 'upstream)
+                     (cvs-fetch '#$(cvs-reference-root-directory ref)
+                                '#$(cvs-reference-module ref)
+                                '#$(cvs-reference-revision ref)
+                                #$output
+                                #:cvs-command
+                                #+(file-append cvs "/bin/cvs")))
+                (and (download-method-enabled? 'nar)
+                     (download-nar #$output)))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "cvs-checkout") build
                       #:leaked-env-vars '("http_proxy" "https_proxy"
                                           "LC_ALL" "LC_MESSAGES" "LANG"
                                           "COLUMNS")
+                      #:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS")
+                                   (#f '())
+                                   (value
+                                    `(("GUIX_DOWNLOAD_METHODS" . ,value))))
                       #:system system
                       #:hash-algo hash-algo
                       #:hash hash
diff --git a/guix/download.scm b/guix/download.scm
index 21d02ab203..3dfe143e9f 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
@@ -35,9 +35,9 @@
   #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (%mirrors
+  #:export (%download-methods
+            %mirrors
             %disarchive-mirrors
-            %download-fallback-test
             (url-fetch* . url-fetch)
             url-fetch/executable
             url-fetch/tarbomb
@@ -434,10 +434,19 @@
 (define built-in-builders*
   (store-lift built-in-builders))
 
+(define %download-methods
+  ;; Either #f (the default) or a list of symbols denoting the sequence of
+  ;; download methods to be used--e.g., '(swh nar upstream).
+  (make-parameter
+   (and=> (getenv "GUIX_DOWNLOAD_METHODS")
+          (lambda (str)
+            (map string->symbol (string-tokenize str))))))
+
 (define* (built-in-download file-name url
                             #:key system hash-algo hash
                             mirrors content-addressed-mirrors
                             disarchive-mirrors
+                            (download-methods (%download-methods))
                             executable?
                             (guile 'unused))
   "Download FILE-NAME from URL using the built-in 'download' builder.  When
@@ -471,6 +480,11 @@ download by itself using its own dependencies."
                                  ("disarchive-mirrors" . ,disarchive-mirrors)
                                  ,@(if executable?
                                        '(("executable" . "1"))
+                                       '())
+                                 ,@(if download-methods
+                                       `(("download-methods"
+                                          . ,(object->string
+                                              download-methods)))
                                        '()))
 
                     ;; Do not offload this derivation because we cannot be
@@ -479,24 +493,6 @@ download by itself using its own dependencies."
                     ;; for that built-in is widespread.
                     #:local-build? #t)))
 
-(define %download-fallback-test
-  ;; Define whether to test one of the download fallback mechanism.  Possible
-  ;; values are:
-  ;;
-  ;;   - #f, to use the normal download methods, not trying to exercise the
-  ;;     fallback mechanism;
-  ;;
-  ;;   - 'none, to disable all the fallback mechanisms;
-  ;;
-  ;;   - 'content-addressed-mirrors, to purposefully attempt to download from
-  ;;     a content-addressed mirror;
-  ;;
-  ;;   - 'disarchive-mirrors, to download from Disarchive + Software Heritage.
-  ;;
-  ;; This is meant to be used for testing purposes.
-  (make-parameter (and=> (getenv "GUIX_DOWNLOAD_FALLBACK_TEST")
-                         string->symbol)))
-
 (define* (url-fetch* url hash-algo hash
                      #:optional name
                      #:key (system (%current-system))
@@ -532,10 +528,7 @@ name in the store."
           (unless (member "download" builtins)
             (error "'guix-daemon' is too old, please upgrade" builtins))
 
-          (built-in-download (or name file-name)
-                             (match (%download-fallback-test)
-                               ((or #f 'none) url)
-                               (_ "https://example.org/does-not-exist"))
+          (built-in-download (or name file-name) url
                              #:guile guile
                              #:system system
                              #:hash-algo hash-algo
@@ -543,15 +536,9 @@ name in the store."
                              #:executable? executable?
                              #:mirrors %mirror-file
                              #:content-addressed-mirrors
-                             (match (%download-fallback-test)
-                               ((or #f 'content-addressed-mirrors)
-                                %content-addressed-mirror-file)
-                               (_ %no-mirrors-file))
+                             %content-addressed-mirror-file
                              #:disarchive-mirrors
-                             (match (%download-fallback-test)
-                               ((or #f 'disarchive-mirrors)
-                                %disarchive-mirror-file)
-                               (_ %no-disarchive-mirrors-file)))))))
+                             %disarchive-mirror-file)))))
 
 (define* (url-fetch/executable url hash-algo hash
                                #:optional name
diff --git a/guix/git-download.scm b/guix/git-download.scm
index aadcbd234c..d26a814e07 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -29,8 +29,8 @@
   #:use-module (guix packages)
   #:use-module (guix modules)
   #:use-module ((guix derivations) #:select (raw-derivation))
+  #:autoload   (guix download) (%download-methods)
   #:autoload   (guix build-system gnu) (standard-packages)
-  #:autoload   (guix download) (%download-fallback-test)
   #:autoload   (git bindings)   (libgit2-init!)
   #:autoload   (git repository) (repository-open
                                  repository-close!
@@ -180,11 +180,7 @@ respective documentation."
                       ;; downloads.
                       #:script-name "git-download"
                       #:env-vars
-                      `(("git url" . ,(match (%download-fallback-test)
-                                        ('content-addressed-mirrors
-                                         "https://example.org/does-not-exist")
-                                        (_
-                                         (git-reference-url ref))))
+                      `(("git url" . ,(git-reference-url ref))
                         ("git commit" . ,(git-reference-commit ref))
                         ("git recursive?" . ,(object->string
                                               (git-reference-recursive? ref)))
@@ -246,14 +242,14 @@ download by itself using its own dependencies."
                   #:recursive? #t
                   #:env-vars
                   `(("url" . ,(object->string
-                               (match (%download-fallback-test)
-                                 ('content-addressed-mirrors
-                                  "https://example.org/does-not-exist")
-                                 (_
-                                  (git-reference-url ref)))))
+                               (git-reference-url ref)))
                     ("commit" . ,(git-reference-commit ref))
                     ("recursive?" . ,(object->string
-                                      (git-reference-recursive? ref))))
+                                      (git-reference-recursive? ref)))
+                    ,@(if (%download-methods)
+                          `(("download-methods"
+                             . ,(object->string (%download-methods))))
+                          '()))
                   #:leaked-env-vars '("http_proxy" "https_proxy"
                                       "LC_ALL" "LC_MESSAGES" "LANG"
                                       "COLUMNS")
diff --git a/guix/hg-download.scm b/guix/hg-download.scm
index 6d02de47e4..55d908817f 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
@@ -84,6 +84,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
   (define modules
     (delete '(guix config)
             (source-module-closure '((guix build hg)
+                                     (guix build download)
                                      (guix build download-nar)
                                      (guix swh)))))
 
@@ -94,6 +95,8 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
         #~(begin
             (use-modules (guix build hg)
                          (guix build utils) ;for `set-path-environment-variable'
+                         ((guix build download)
+                          #:select (download-method-enabled?))
                          (guix build download-nar)
                          (guix swh)
                          (ice-9 match))
@@ -106,26 +109,35 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
             (setvbuf (current-output-port) 'line)
             (setvbuf (current-error-port) 'line)
 
-            (or (hg-fetch '#$(hg-reference-url ref)
-                          '#$(hg-reference-changeset ref)
-                          #$output
-                          #:hg-command (string-append #+hg "/bin/hg"))
-                (download-nar #$output)
+            (or (and (download-method-enabled? 'upstream)
+                     (hg-fetch '#$(hg-reference-url ref)
+                               '#$(hg-reference-changeset ref)
+                               #$output
+                               #:hg-command (string-append #+hg "/bin/hg")))
+                (and (download-method-enabled? 'nar)
+                     (download-nar #$output))
                 ;; As a last resort, attempt to download from Software Heritage.
                 ;; Disable X.509 certificate verification to avoid depending
                 ;; on nss-certs--we're authenticating the checkout anyway.
-                (parameterize ((%verify-swh-certificate? #f))
-                  (format (current-error-port)
-                          "Trying to download from Software Heritage...~%")
-                  (swh-download #$(hg-reference-url ref)
-                                #$(hg-reference-changeset ref)
-                                #$output)))))))
+                (and (download-method-enabled? 'swh)
+                     (parameterize ((%verify-swh-certificate? #f))
+                       (format (current-error-port)
+                               "Trying to download from Software Heritage...~%")
+                       (or (swh-download-directory-by-nar-hash
+                            #$hash '#$hash-algo #$output)
+                           (swh-download #$(hg-reference-url ref)
+                                         #$(hg-reference-changeset ref)
+                                         #$output)))))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "hg-checkout") build
                       #:leaked-env-vars '("http_proxy" "https_proxy"
                                           "LC_ALL" "LC_MESSAGES" "LANG"
                                           "COLUMNS")
+                      #:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS")
+                                   (#f '())
+                                   (value
+                                    `(("GUIX_DOWNLOAD_METHODS" . ,value))))
                       #:system system
                       #:local-build? #t           ;don't offload repo cloning
                       #:hash-algo hash-algo
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 9b30dc30e0..c4c42836ee 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -418,6 +418,7 @@ empty list when the FIELD cannot be found."
         "none"
         "rtools"
         "unix"
+        "use_c17"
         "windows"
         "xcode"
         "xquartz"))
diff --git a/guix/lint.scm b/guix/lint.scm
index c95de85e69..68d532968d 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -67,6 +67,10 @@
                                     svn-multi-reference-url
                                     svn-multi-reference-user-name
                                     svn-multi-reference-password)
+  #:autoload   (guix hg-download)  (hg-reference?
+                                    hg-reference-url)
+  #:autoload   (guix bzr-download) (bzr-reference?
+                                    bzr-reference-url)
   #:use-module (guix import stackage)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -84,10 +88,10 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-6)                      ;Unicode string ports
   #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 rdelim)
   #:export (check-description-style
             check-inputs-should-be-native
@@ -823,8 +827,8 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed."
                   ;; Return RESPONSE, unless the final response as we follow
                   ;; redirects is not 200.
                   (if location
-                      (let-values (((status response2)
-                                    (loop location (cons location visited))))
+                      (let ((status response2 (loop location
+                                                    (cons location visited))))
                         (case status
                           ((http-response)
                            (values 'http-response
@@ -926,8 +930,7 @@ display a message including MESSAGE and return ERROR-VALUE."
 (define (validate-uri uri package field)
   "Return #t if the given URI can be reached, otherwise return a warning for
 PACKAGE mentioning the FIELD."
-  (let-values (((status argument)
-                (probe-uri uri #:timeout 3)))     ;wait at most 3 seconds
+  (let ((status argument (probe-uri uri #:timeout 3))) ;wait at most 3 seconds
     (case status
       ((http-response)
        (cond ((= 200 (response-code argument))
@@ -1633,6 +1636,69 @@ directory identifiers the spec refers to.  Otherwise return #f."
               (extract-swh-id spec)))))
        %disarchive-mirrors))
 
+(define (swh-response->warning package url method response)
+  "Given RESPONSE, the response of METHOD on URL, return a suitable warning
+list for PACKAGE."
+  (if (request-rate-limit-reached? url method)
+      (list (make-warning package
+                          (G_ "Software Heritage rate limit reached; \
+try again later")
+                          #:field 'source))
+      (list (make-warning package
+                          (G_ "'~a' returned ~a")
+                          (list url (response-code response))
+                          #:field 'source))))
+
+(define (vcs-origin origin)
+  "Return two values: the URL and type (a string) of the version-control used
+for ORIGIN.  Return #f and #f if ORIGIN is not a version-control checkout."
+  (match (and=> origin origin-uri)
+    ((? git-reference? ref)
+     (values (git-reference-url ref) "git"))
+    ((? svn-reference? ref)
+     (values (svn-reference-url ref) "svn"))
+    ((? svn-multi-reference? ref)
+     (values (svn-multi-reference-url ref) "svn"))
+    ((? hg-reference? ref)
+     (values (hg-reference-url ref) "hg"))
+    ((? bzr-reference? ref)
+     (values (bzr-reference-url ref) "bzr"))
+    ;; XXX: Not sure what to do with the weird CVS URIs (:pserver: etc.).
+    (_
+     (values #f #f))))
+
+(define (save-package-source package)
+  "Attempt to save the source of PACKAGE on SWH.  Return a list of warnings."
+  (let* ((origin (package-source package))
+         (url type (if origin (vcs-origin origin) (values #f #f))))
+    (cond ((and url type)
+           (catch 'swh-error
+             (lambda ()
+               (save-origin url type)
+               (list (make-warning
+                      package
+                      ;; TRANSLATORS: "Software Heritage" is a proper noun that
+                      ;; must remain untranslated.  See
+                      ;; <https://www.softwareheritage.org>.
+                      (G_ "scheduled Software Heritage archival")
+                      #:field 'source)))
+             (lambda (key url method response . _)
+               (cond ((= 429 (response-code response))
+                      (list (make-warning
+                             package
+                             (G_ "archival rate limit exceeded; \
+try again later")
+                             #:field 'source)))
+                     (else
+                      (swh-response->warning package url method response))))))
+          ((not origin)
+           '())
+          (else
+           (list (make-warning
+                  package
+                  (G_ "source code cannot be archived")
+                  #:field 'source))))))
+
 (define (check-archival package)
   "Check whether PACKAGE's source code is archived on Software Heritage.  If
 it's not, and if its source code is a VCS snapshot, then send a \"save\"
@@ -1641,17 +1707,6 @@ request to Software Heritage.
 Software Heritage imposes limits on the request rate per client IP address.
 This checker prints a notice and stops doing anything once that limit has been
 reached."
-  (define (response->warning url method response)
-    (if (request-rate-limit-reached? url method)
-        (list (make-warning package
-                            (G_ "Software Heritage rate limit reached; \
-try again later")
-                            #:field 'source))
-        (list (make-warning package
-                            (G_ "'~a' returned ~a")
-                            (list url (response-code response))
-                            #:field 'source))))
-
   (define skip-key (gensym "skip-archival-check"))
 
   (define (skip-when-limit-reached url method)
@@ -1686,28 +1741,8 @@ try again later")
               '())
              (#f
               ;; Revision is missing from the archive, attempt to save it.
-              (catch 'swh-error
-                (lambda ()
-                  (save-origin (git-reference-url reference) "git")
-                  (list (make-warning
-                         package
-                         ;; TRANSLATORS: "Software Heritage" is a proper noun
-                         ;; that must remain untranslated.  See
-                         ;; <https://www.softwareheritage.org>.
-                         (G_ "scheduled Software Heritage archival")
-                         #:field 'source)))
-                (lambda (key url method response . _)
-                  (cond ((= 429 (response-code response))
-                         (list (make-warning
-                                package
-                                (G_ "archival rate limit exceeded; \
-try again later")
-                                #:field 'source)))
-                        (else
-                         (response->warning url method response))))))))
+              (save-package-source package))))
           ((? origin? origin)
-           ;; Since "save" origins are not supported for non-VCS source, all
-           ;; we can do is tell whether a given tarball is available or not.
            (if (and=> (origin-hash origin)          ;XXX: for ungoogled-chromium
                       content-hash-value)           ;& icecat
                (let ((hash (origin-hash origin)))
@@ -1716,27 +1751,31 @@ try again later")
                                             (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
-                    ;; the Disarchive database has an entry for that tarball.
-                    (match (lookup-disarchive-spec hash)
-                      (#f
-                       (list (make-warning package
-                                           (G_ "source not archived on Software \
+                    ;; If ORIGIN is a version-control checkout, save it now.
+                    ;; If not, check whether HASH is in the Disarchive
+                    ;; database ("Save Code Now" does not accept tarballs).
+                    (if (vcs-origin origin)
+                        (save-package-source package)
+                        (match (lookup-disarchive-spec hash)
+                          (#f
+                           (list (make-warning package
+                                               (G_ "source not archived on Software \
 Heritage and missing from the Disarchive database")
-                                           #:field 'source)))
-                      (directory-ids
-                       (match (find (lambda (id)
-                                      (not (lookup-directory id)))
-                                    directory-ids)
-                         (#f '())
-                         (id
-                          (list (make-warning package
-                                              (G_ "\
+                                               #:field 'source)))
+                          (directory-ids
+                           (match (find (lambda (id)
+                                          (not (lookup-directory id)))
+                                        directory-ids)
+                             (#f '())
+                             (id
+                              (list (make-warning package
+                                                  (G_ "\
 Disarchive entry refers to non-existent SWH directory '~a'")
-                                              (list id)
-                                              #:field 'source)))))))
+                                                  (list id)
+                                                  #:field 'source))))))))
                    ((? content?)
+                    '())
+                   ((? string? swhid)
                     '())))
                '()))
           ((? local-file?)
@@ -1748,7 +1787,7 @@ source is not an origin, it cannot be archived")
                                #:field 'source)))))
       (match-lambda*
         (('swh-error url method response)
-         (response->warning url method response))
+         (swh-response->warning package url method response))
         ((key . args)
          (if (eq? key skip-key)
              '()
diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm
index f587eeb243..7f77beaac0 100644
--- a/guix/scripts/import/elpa.scm
+++ b/guix/scripts/import/elpa.scm
@@ -104,7 +104,7 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
                                       #:repo (assoc-ref opts 'repo)))
          ((or #f '())
           (leave (G_ "failed to download meta-data for package '~a'~%") package-name))
-         (('package etc ...) `(package ,etc))
+         (('package etc ...) `(package ,@etc))
          ((? list? sexps) (map
                            (match-lambda
                              ((and ('package ('name name) . rest) pkg)
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index e7eb3b2a1f..5079d0ea71 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -21,7 +21,7 @@
   #:use-module (guix scripts)
   #:use-module (guix derivations)
   #:use-module ((guix store) #:select (derivation-path? store-path?))
-  #:autoload   (guix build download) (url-fetch)
+  #:autoload   (guix build download) (%download-methods url-fetch)
   #:autoload   (guix build git) (git-fetch-with-fallback)
   #:autoload   (guix config) (%git)
   #:use-module (ice-9 match)
@@ -55,7 +55,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
                        (executable "executable")
                        (mirrors "mirrors")
                        (content-addressed-mirrors "content-addressed-mirrors")
-                       (disarchive-mirrors "disarchive-mirrors"))
+                       (disarchive-mirrors "disarchive-mirrors")
+                       (download-methods "download-methods"))
     (unless url
       (leave (G_ "~a: missing URL~%") (derivation-file-name drv)))
 
@@ -64,26 +65,30 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
            (algo       (derivation-output-hash-algo drv-output))
            (hash       (derivation-output-hash drv-output)))
       ;; We're invoked by the daemon, which gives us write access to OUTPUT.
-      (when (url-fetch url output
-                       #:print-build-trace? print-build-trace?
-                       #:mirrors (if mirrors
-                                     (call-with-input-file mirrors read)
-                                     '())
-                       #:content-addressed-mirrors
-                       (if content-addressed-mirrors
-                           (call-with-input-file content-addressed-mirrors
-                             (lambda (port)
-                               (eval (read port) %user-module)))
-                           '())
-                       #:disarchive-mirrors
-                       (if disarchive-mirrors
-                           (call-with-input-file disarchive-mirrors read)
-                           '())
-                       #:hashes `((,algo . ,hash))
-
-                       ;; Since DRV's output hash is known, X.509 certificate
-                       ;; validation is pointless.
-                       #:verify-certificate? #f)
+      (when (parameterize ((%download-methods
+                            (and download-methods
+                                 (call-with-input-string download-methods
+                                   read))))
+              (url-fetch url output
+                         #:print-build-trace? print-build-trace?
+                         #:mirrors (if mirrors
+                                       (call-with-input-file mirrors read)
+                                       '())
+                         #:content-addressed-mirrors
+                         (if content-addressed-mirrors
+                             (call-with-input-file content-addressed-mirrors
+                               (lambda (port)
+                                 (eval (read port) %user-module)))
+                             '())
+                         #:disarchive-mirrors
+                         (if disarchive-mirrors
+                             (call-with-input-file disarchive-mirrors read)
+                             '())
+                         #:hashes `((,algo . ,hash))
+
+                         ;; Since DRV's output hash is known, X.509 certificate
+                         ;; validation is pointless.
+                         #:verify-certificate? #f))
         (when (and executable (string=? executable "1"))
           (chmod output #o755))))))
 
@@ -96,7 +101,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
 'bmRepair' builds."
   (derivation-let drv ((url "url")
                        (commit "commit")
-                       (recursive? "recursive?"))
+                       (recursive? "recursive?")
+                       (download-methods "download-methods"))
     (unless url
       (leave (G_ "~a: missing Git URL~%") (derivation-file-name drv)))
     (unless commit
@@ -114,11 +120,18 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
       ;; on ambient authority, hence the PATH value below.
       (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))))
+      (parameterize ((%download-methods
+                      (and download-methods
+                           (call-with-input-string download-methods
+                             read))))
+        ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are
+        ;; different, hence the #:item argument below.
+        (git-fetch-with-fallback url commit output
+                                 #:hash hash
+                                 #:hash-algorithm algo
+                                 #:recursive? recursive?
+                                 #:item (derivation-output-path drv-output)
+                                 #:git-command %git)))))
 
 (define (assert-low-privileges)
   (when (zero? (getuid))
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index c6688908de..17a7f4f957 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2016, 2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2016, 2019, 2021-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
 ;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;;
@@ -93,25 +93,36 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
   (define build
     (with-imported-modules
         (source-module-closure '((guix build svn)
+                                 (guix build download)
                                  (guix build download-nar)
-                                 (guix build utils)))
+                                 (guix build utils)
+                                 (guix swh)))
       (with-extensions (list guile-json guile-gnutls   ;for (guix swh)
                              guile-lzlib)
         #~(begin
             (use-modules (guix build svn)
+                         ((guix build download)
+                          #:select (download-method-enabled?))
                          (guix build download-nar)
+                         (guix swh)
                          (ice-9 match))
 
-            (or (svn-fetch (getenv "svn url")
-                           (string->number (getenv "svn revision"))
-                           #$output
-                           #:svn-command #+(file-append svn "/bin/svn")
-                           #:recursive? (match (getenv "svn recursive?")
-                                          ("yes" #t)
-                                          (_ #f))
-                           #:user-name (getenv "svn user name")
-                           #:password (getenv "svn password"))
-                (download-nar #$output))))))
+            (or (and (download-method-enabled? 'upstream)
+                     (svn-fetch (getenv "svn url")
+                                (string->number (getenv "svn revision"))
+                                #$output
+                                #:svn-command #+(file-append svn "/bin/svn")
+                                #:recursive? (match (getenv "svn recursive?")
+                                               ("yes" #t)
+                                               (_ #f))
+                                #:user-name (getenv "svn user name")
+                                #:password (getenv "svn password")))
+                (and (download-method-enabled? 'nar)
+                     (download-nar #$output))
+                (and (download-method-enabled? 'swh)
+                     (parameterize ((%verify-swh-certificate? #f))
+                       (swh-download-directory-by-nar-hash #$hash '#$hash-algo
+                                                           #$output))))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "svn-checkout") build
@@ -134,7 +145,11 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                         ,@(if (svn-reference-password ref)
                               `(("svn password"
                                  . ,(svn-reference-password ref)))
-                              '()))
+                              '())
+                        ,@(match (getenv "GUIX_DOWNLOAD_METHODS")
+                            (#f '())
+                            (value
+                             `(("GUIX_DOWNLOAD_METHODS" . ,value)))))
 
                       #:system system
                       #:hash-algo hash-algo
@@ -173,14 +188,19 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
   (define build
     (with-imported-modules
         (source-module-closure '((guix build svn)
+                                 (guix build download)
                                  (guix build download-nar)
-                                 (guix build utils)))
+                                 (guix build utils)
+                                 (guix swh)))
       (with-extensions (list guile-json guile-gnutls   ;for (guix swh)
                              guile-lzlib)
         #~(begin
             (use-modules (guix build svn)
                          (guix build utils)
+                         ((guix build download)
+                          #:select (download-method-enabled?))
                          (guix build download-nar)
+                         (guix swh)
                          (srfi srfi-1)
                          (ice-9 match))
 
@@ -190,23 +210,33 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                    ;; single file.
                    (unless (string-suffix? "/" location)
                      (mkdir-p (string-append #$output "/" (dirname location))))
-                   (svn-fetch (string-append (getenv "svn url") "/" location)
-                              (string->number (getenv "svn revision"))
-                              (if (string-suffix? "/" location)
-                                  (string-append #$output "/" location)
-                                  (string-append #$output "/" (dirname location)))
-                              #:svn-command #+(file-append svn "/bin/svn")
-                              #:recursive? (match (getenv "svn recursive?")
-                                             ("yes" #t)
-                                             (_ #f))
-                              #:user-name (getenv "svn user name")
-                              #:password (getenv "svn password")))
+                   (and (download-method-enabled? 'upstream)
+                        (svn-fetch (string-append (getenv "svn url") "/" location)
+                                   (string->number (getenv "svn revision"))
+                                   (if (string-suffix? "/" location)
+                                       (string-append #$output "/" location)
+                                       (string-append #$output "/" (dirname location)))
+                                   #:svn-command #+(file-append svn "/bin/svn")
+                                   #:recursive? (match (getenv "svn recursive?")
+                                                  ("yes" #t)
+                                                  (_ #f))
+                                   #:user-name (getenv "svn user name")
+                                   #:password (getenv "svn password"))))
                  (call-with-input-string (getenv "svn locations")
                    read))
                 (begin
                   (when (file-exists? #$output)
                     (delete-file-recursively #$output))
-                  (download-nar #$output)))))))
+                  (or (and (download-method-enabled? 'nar)
+                           (download-nar #$output))
+                      (and (download-method-enabled? 'swh)
+                           ;; SWH keeps HASH as an ExtID for the combination
+                           ;; of files/directories, which allows us to
+                           ;; retrieve the entire combination at once:
+                           ;; <https://gitlab.softwareheritage.org/swh/infra/sysadm-environment/-/issues/5263>.
+                           (parameterize ((%verify-swh-certificate? #f))
+                             (swh-download-directory-by-nar-hash
+                              #$hash '#$hash-algo #$output))))))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "svn-checkout") build
@@ -231,7 +261,11 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                         ,@(if (svn-multi-reference-password ref)
                               `(("svn password"
                                  . ,(svn-multi-reference-password ref)))
-                              '()))
+                              '())
+                        ,@(match (getenv "GUIX_DOWNLOAD_METHODS")
+                            (#f '())
+                            (value
+                             `(("GUIX_DOWNLOAD_METHODS" . ,value)))))
 
                       #:leaked-env-vars '("http_proxy" "https_proxy"
                                           "LC_ALL" "LC_MESSAGES" "LANG"
diff --git a/guix/swh.scm b/guix/swh.scm
index 04cecd854c..f602cd89d1 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -54,6 +54,7 @@
             visit-snapshot-url
             visit-status
             visit-number
+            visit-type
             visit-snapshot
 
             snapshot?
@@ -312,6 +313,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   (url visit-url "origin_visit_url")
   (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f
   (status visit-status "status" string->symbol)   ;'full | 'partial | 'ongoing
+  (type   visit-type "type" string->symbol)       ;'git | 'git-checkout | ...
   (number visit-number "visit"))
 
 ;; <https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
@@ -472,10 +474,11 @@ and use of ALGORITHM."
                              hash)
          external-id-target))
 
-(define (origin-visits origin)
-  "Return the list of visits of ORIGIN, a record as returned by
-'lookup-origin'."
-  (call (swh-url (origin-visits-url origin))
+(define* (origin-visits origin #:optional (max 10))
+  "Return the list of the up to MAX latest visits of ORIGIN, a record as
+returned by 'lookup-origin'."
+  (call (string-append (swh-url (origin-visits-url origin))
+                       "?per_page=" (number->string max))
         (lambda (port)
           (map json->visit (vector->list (json->scm port))))))
 
@@ -513,14 +516,20 @@ could not be found."
           (_ #f)))))
 
 (define (branch-target branch)
-  "Return the target of BRANCH, either a <revision> or a <release>."
+  "Return the target of BRANCH: a <revision>, a <release>, or the SWHID of a
+directory."
   (match (branch-target-type branch)
     ('release
      (call (swh-url (branch-target-url branch))
            json->release))
     ('revision
      (call (swh-url (branch-target-url branch))
-           json->revision))))
+           json->revision))
+    ((or 'directory 'alias)
+     (match (string-tokenize (branch-target-url branch)
+                             (char-set-complement (char-set #\/)))
+       ((_ ... "directory" id)
+        (string-append "swh:1:dir:" id))))))
 
 (define (lookup-origin-revision url tag)
   "Return a <revision> corresponding to the given TAG for the repository
@@ -534,31 +543,31 @@ URL could not be found."
   (match (lookup-origin url)
     (#f #f)
     (origin
-      (match (filter (lambda (visit)
-                       ;; Return #f if (visit-snapshot VISIT) would return #f.
-                       (and (visit-snapshot-url visit)
-                            (eq? 'full (visit-status visit))))
-                     (origin-visits origin))
-        ((visit . _)
-         (let ((snapshot (visit-snapshot visit)))
-           (match (and=> (find (lambda (branch)
-                                 (or
-                                  ;; Git specific.
-                                  (string=? (string-append "refs/tags/" tag)
-                                            (branch-name branch))
-                                  ;; Hg specific.
-                                  (string=? tag
-                                            (branch-name branch))))
-                               (snapshot-branches snapshot))
-                         branch-target)
-             ((? release? release)
-              (release-target release))
-             ((? revision? revision)
-              revision)
-             (#f                                  ;tag not found
-              #f))))
-        (()
-         #f)))))
+      (any (lambda (visit)
+             (and (visit-snapshot-url visit)
+                  (eq? 'full (visit-status visit))
+                  (let ((snapshot (visit-snapshot visit)))
+                    (match (and=> (find (lambda (branch)
+                                          (or
+                                           ;; Git specific.
+                                           (string=? (string-append "refs/tags/" tag)
+                                                     (branch-name branch))
+                                           ;; Hg specific.
+                                           (string=? tag
+                                                     (branch-name branch))))
+                                        (snapshot-branches snapshot))
+                                  branch-target)
+                      ((? release? release)
+                       (release-target release))
+                      ((? revision? revision)
+                       revision)
+                      (_
+                       ;; Either the branch points to a directory rather than
+                       ;; a revision (this is the case for visits of type
+                       ;; 'git-checkout, 'hg-checkout, 'tarball-directory,
+                       ;; etc.), or TAG was not found.
+                       #f)))))
+           (origin-visits origin 30)))))
 
 (define (release-target release)
   "Return the revision that is the target of RELEASE."