From 2e3b5863e14fcdba394540690ec8b606c2c466dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 30 Sep 2025 10:47:20 +0200
Subject: [PATCH] cvs-download: Implement SWH fallback.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/cvs-download.scm (cvs-fetch)[modules]: Add (guix swh).
[build]: Add ‘swh’ method and call to ‘swh-download-directory-by-nar-hash’.
Add “hash” variable to #:env-vars.

Reported-by: Nguyễn Gia Phong <mcsinyx@disroot.org>
Change-Id: I5d44b5855f3a042f9869f858b79fc0aed511ad4a
---
 guix/cvs-download.scm | 37 +++++++++++++++++++++++++++++--------
 1 file changed, 29 insertions(+), 8 deletions(-)

diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index 023054941b9..068f284a457 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2017, 2019, 2024-2025 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
@@ -26,6 +26,7 @@
   #:use-module (guix modules)
   #:use-module (guix packages)
   #:use-module (ice-9 match)
+  #:autoload   (rnrs bytevectors) (bytevector->u8-list)
   #:export (cvs-reference
             cvs-reference?
             cvs-reference-root-directory
@@ -72,7 +73,8 @@ 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)
+            (source-module-closure '((guix swh)
+                                     (guix build cvs)
                                      (guix build download)
                                      (guix build download-nar)))))
   (define build
@@ -83,7 +85,10 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
             (use-modules (guix build cvs)
                          ((guix build download)
                           #:select (download-method-enabled?))
-                         (guix build download-nar))
+                         (guix build download-nar)
+                         (guix swh)
+                         ((rnrs bytevectors)
+                          #:select (u8-list->bytevector)))
 
             (or (and (download-method-enabled? 'upstream)
                      (cvs-fetch '#$(cvs-reference-root-directory ref)
@@ -93,17 +98,33 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                                 #:cvs-command
                                 #+(file-append cvs "/bin/cvs")))
                 (and (download-method-enabled? 'nar)
-                     (download-nar #$output)))))))
+                     (download-nar #$output))
+                (and (download-method-enabled? 'swh)
+                     (parameterize ((%verify-swh-certificate? #f))
+                       (swh-download-directory-by-nar-hash
+                        (u8-list->bytevector
+                         (map string->number
+                              (string-split (getenv "hash") #\,)))
+                        '#$hash-algo
+                        #$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))))
+                      #:env-vars
+                      `(,@(match (getenv "GUIX_DOWNLOAD_METHODS")
+                            (#f '())
+                            (value
+                             `(("GUIX_DOWNLOAD_METHODS" . ,value))))
+                        ;; To avoid pulling in (guix base32) in the builder
+                        ;; script, use bytevector->u8-list from (rnrs
+                        ;; bytevectors)
+                        ("hash" . ,(string-join
+                                    (map number->string
+                                         (bytevector->u8-list hash))
+                                    ",")))
                       #:system system
                       #:hash-algo hash-algo
                       #:hash hash