download: Honor ‘GUIX_DOWNLOAD_METHODS’ environment variable.

This replaces ‘GUIX_DOWNLOAD_FALLBACK_TEST’ and allows you to test
various download methods, like so:

  GUIX_DOWNLOAD_METHODS=nar guix build guile-gcrypt -S --check
  GUIX_DOWNLOAD_METHODS=disarchive guix build hello -S --check

* guix/build/download.scm (%download-methods): New variable.
(download-method-enabled?): New procedure.
(url-fetch): Define ‘initial-uris’; honor ‘download-method-enabled?’.
Call ‘disarchive-fetch/any’ only when the 'disarchive method is enabled.
* guix/build/git.scm (git-fetch-with-fallback): Honor
‘download-method-enabled?’.
* guix/download.scm (%download-methods): New variable.
(%download-fallback-test): Remove.
(built-in-download): Add #:download-methods parameter and honor it.
(url-fetch*): Pass #:content-addressed-mirrors and #:disarchive-mirrors
unconditionally.
* guix/git-download.scm (git-fetch/in-band*): Pass “git url”
unconditionally.
(git-fetch/built-in): Likewise.  Pass “download-methods”.
* guix/bzr-download.scm (bzr-fetch)[build]: Honor ‘download-method-enabled?’.
Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars.
* guix/cvs-download.scm (cvs-fetch)[build]: Honor ‘download-method-enabled?’.
Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars.
* guix/hg-download.scm (hg-fetch): Honor ‘download-method-enabled?’.
Pass #:env-vars to ‘gexp->derivation’.
* guix/scripts/perform-download.scm (perform-download): Honor
“download-methods” from DRV.  Parameterize ‘%download-methods’ before
calling ‘url-fetch’.
(perform-git-download): Likewise.
* guix/svn-download.scm (svn-fetch): Honor ‘download-method-enabled?’.
Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars.
(svn-multi-fetch): Likewise.

Change-Id: Ia3402e17f0303dfa964bdc761265efe8a1dd69ab

9 files changed, 231 insertions, 155 deletions

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 a135026fae..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
@@ -102,17 +104,20 @@ 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 (git-fetch url commit directory
-                 #:lfs? lfs?
-                 #:recursive? recursive?
-                 #:git-command git-command)
-      (download-nar item directory)
+  (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/bzr-download.scm b/guix/bzr-download.scm
index 01c12fd54d..a22c9bee99 100644
--- a/guix/bzr-download.scm
+++ b/guix/bzr-download.scm
@@ -24,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
@@ -72,20 +72,26 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
       (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 (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")))
-                (download-nar #$output))))))
+            (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
@@ -95,7 +101,11 @@ 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")
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 dd28d9c244..55d908817f 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
@@ -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,28 +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...~%")
-                  (or (swh-download-directory-by-nar-hash #$hash '#$hash-algo
-                                                          #$output)
-                      (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/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index b96959a09e..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,14 +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")
 
-      ;; 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))))
+      (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 64af996a06..17a7f4f957 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -93,6 +93,7 @@ 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 swh)))
@@ -100,23 +101,28 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                              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)
-                (parameterize ((%verify-swh-certificate? #f))
-                  (swh-download-directory-by-nar-hash #$hash '#$hash-algo
-                                                      #$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
@@ -139,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
@@ -178,6 +188,7 @@ 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 swh)))
@@ -186,6 +197,8 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
         #~(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)
@@ -197,30 +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))
-                  (or (download-nar #$output)
-                      (parameterize ((%verify-swh-certificate? #f))
-                        ;; 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>.
-                        (swh-download-directory-by-nar-hash
-                         #$hash '#$hash-algo #$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
@@ -245,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"