amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

cvs-download: Implement SWH fallback.

Browse source 
* 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
This commit is contained in:
Ludovic Courtès 2025-09-30 10:47:20 +02:00
parent 1bb323866b
commit 2e3b5863e1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

37
guix/cvs-download.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; ;;;
@ -26,6 +26,7 @@
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:autoload (rnrs bytevectors) (bytevector->u8-list)
#:export (cvs-reference #:export (cvs-reference
cvs-reference? cvs-reference?
cvs-reference-root-directory 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 (define modules
(delete '(guix config) (delete '(guix config)
(source-module-closure '((guix build cvs) (source-module-closure '((guix swh)
(guix build cvs)
(guix build download) (guix build download)
(guix build download-nar))))) (guix build download-nar)))))
(define build (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) (use-modules (guix build cvs)
((guix build download) ((guix build download)
#:select (download-method-enabled?)) #: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) (or (and (download-method-enabled? 'upstream)
(cvs-fetch '#$(cvs-reference-root-directory ref) (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 #:cvs-command
#+(file-append cvs "/bin/cvs"))) #+(file-append cvs "/bin/cvs")))
(and (download-method-enabled? 'nar) (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))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "cvs-checkout") build (gexp->derivation (or name "cvs-checkout") build
#:leaked-env-vars '("http_proxy" "https_proxy" #:leaked-env-vars '("http_proxy" "https_proxy"
"LC_ALL" "LC_MESSAGES" "LANG" "LC_ALL" "LC_MESSAGES" "LANG"
"COLUMNS") "COLUMNS")
#:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS") #:env-vars
(#f '()) `(,@(match (getenv "GUIX_DOWNLOAD_METHODS")
(value (#f '())
`(("GUIX_DOWNLOAD_METHODS" . ,value)))) (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 #:system system
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash