From 264fdbcaff9c078642355bace0c61c094b3581fc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 26 Jan 2024 17:27:11 +0100 Subject: git-download: Download from SWH by nar hash when possible. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- guix/build/git.scm | 20 ++++++++++++++++---- guix/git-download.scm | 4 +++- guix/scripts/perform-download.scm | 4 +++- 3 files changed, 22 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/build/git.scm b/guix/build/git.scm index 867cade2c4..4c69365a7b 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès +;;; Copyright © 2014, 2016, 2019, 2023-2024 Ludovic Courtès ;;; Copyright © 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. @@ -20,7 +20,9 @@ (define-module (guix build git) #:use-module (guix build utils) #: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 (ice-9 format) #:export (git-fetch @@ -91,10 +93,13 @@ (define* (git-fetch url commit directory (define* (git-fetch-with-fallback url commit directory #:key (git-command "git") + hash hash-algorithm lfs? recursive?) "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, -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 #:lfs? lfs? #:recursive? recursive? @@ -110,7 +115,14 @@ (define* (git-fetch-with-fallback url commit directory (format (current-error-port) "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? (string-append directory "/.gitattributes")) ;; Perform CR/LF conversion and other changes diff --git a/guix/git-download.scm b/guix/git-download.scm index 3de6ae970d..aadcbd234c 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2021, 2023 Ludovic Courtès +;;; Copyright © 2014-2021, 2023-2024 Ludovic Courtès ;;; Copyright © 2017 Mathieu Lirzin ;;; Copyright © 2017 Christopher Baines ;;; Copyright © 2020 Jakub Kądziołka @@ -165,6 +165,8 @@ (define recursive? (git-fetch-with-fallback (getenv "git url") (getenv "git commit") #$output + #:hash #$hash + #:hash-algorithm '#$hash-algo #:lfs? lfs? #:recursive? recursive? #:git-command "git"))))) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index 9aa0e61e9d..e7eb3b2a1f 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès +;;; Copyright © 2016-2018, 2020, 2023-2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -115,6 +115,8 @@ (define* (perform-git-download drv output (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") (git-fetch-with-fallback url commit output + #:hash hash + #:hash-algorithm algo #:recursive? recursive? #:git-command %git)))) -- cgit v1.2.3