From 2f441fc738976175d438f7942211b1894e2eb416 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 23 Feb 2024 14:42:43 +0100
Subject: =?UTF-8?q?download:=20Honor=20=E2=80=98GUIX=5FDOWNLOAD=5FMETHODS?=
 =?UTF-8?q?=E2=80=99=20environment=20variable.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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
---
 guix/hg-download.scm | 36 +++++++++++++++++++++++-------------
 1 file changed, 23 insertions(+), 13 deletions(-)

(limited to 'guix/hg-download.scm')

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
-- 
cgit v1.2.3