me
/
guix
Archived
1
0
Fork 0
Code

git-download: Download from SWH by nar hash when possible. 

* guix/build/git.scm (git-fetch-with-fallback): Add #:hash
and #:hash-algorithm.  Try ‘swh-download-directory-by-nar-hash’ before
‘swh-download’ when #:hash is provided.
* guix/git-download.scm (git-fetch/in-band*): Pass #:hash
and #:hash-algorithm to ‘git-fetch-with-fallback’.
* guix/scripts/perform-download.scm (perform-git-download): Likewise.

Change-Id: Ic875a7022fd78c9fac32e92ad4f8ce4d81646ec5
master
Ludovic Courtès 2024-01-26 17:27:11 +01:00 committed by Ludovic Courtès
parent 29f3089c84
commit 264fdbcaff
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/build/git.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2016, 2019, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -20,7 +20,9 @@
(define-module (guix build git) (define-module (guix build git)
#:use-module (guix build utils) #:use-module (guix build utils)
#:autoload (guix build download-nar) (download-nar) #:autoload (guix build download-nar) (download-nar)
#:autoload (guix swh) (%verify-swh-certificate? swh-download) #:autoload (guix swh) (%verify-swh-certificate?
swh-download
swh-download-directory-by-nar-hash)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (git-fetch #:export (git-fetch
@ -91,10 +93,13 @@ fetched, recursively. Return #t on success, #f otherwise."
(define* (git-fetch-with-fallback url commit directory (define* (git-fetch-with-fallback url commit directory
#:key (git-command "git") #:key (git-command "git")
hash hash-algorithm
lfs? recursive?) lfs? recursive?)
"Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to "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, alternative methods when fetching from URL fails: attempt to download a nar,
and if that also fails, download from the Software Heritage archive." 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 (or (git-fetch url commit directory
#:lfs? lfs? #:lfs? lfs?
#:recursive? recursive? #:recursive? recursive?
@ -110,7 +115,14 @@ and if that also fails, download from the Software Heritage archive."
(format (current-error-port) (format (current-error-port)
"Trying to download from Software Heritage...~%") "Trying to download from Software Heritage...~%")
(swh-download url commit directory) ;; First try to look up and download the directory corresponding
;; to HASH: this is fundamentally more reliable than looking up
;; COMMIT, especially when COMMIT denotes a tag.
(or (and hash hash-algorithm
(swh-download-directory-by-nar-hash hash hash-algorithm
directory))
(swh-download url commit directory))
(when (file-exists? (when (file-exists?
(string-append directory "/.gitattributes")) (string-append directory "/.gitattributes"))
;; Perform CR/LF conversion and other changes ;; Perform CR/LF conversion and other changes

4
guix/git-download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@ -165,6 +165,8 @@ respective documentation."
(git-fetch-with-fallback (getenv "git url") (getenv "git commit") (git-fetch-with-fallback (getenv "git url") (getenv "git commit")
#$output #$output
#:hash #$hash
#:hash-algorithm '#$hash-algo
#:lfs? lfs? #:lfs? lfs?
#:recursive? recursive? #:recursive? recursive?
#:git-command "git"))))) #:git-command "git")))))

4
guix/scripts/perform-download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2018, 2020, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -115,6 +115,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin")
(git-fetch-with-fallback url commit output (git-fetch-with-fallback url commit output
#:hash hash
#:hash-algorithm algo
#:recursive? recursive? #:recursive? recursive?
#:git-command %git)))) #:git-command %git))))