From a4db19d8e07eeb26931edfde0f0e6bca4e0448d3 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 22 Oct 2023 23:41:22 -0400 Subject: git-download: Add support for Git Large File Storage (LFS). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/git.scm (git-fetch) [lfs?]: New argument, doc and setup code. (git-fetch-with-fallback) [lfs?]: New argument. Pass it to git-fetch. * guix/git-download.scm (git-lfs-package): New procedure. (git-fetch/in-band*): New procedure, made of the logic of git-fetch/in-band, with new git-lfs specifics, with the following changes: New #:git-lfs argument. : Remove labels. Conditionally add git-lfs. : Read "git lfs?" environment variable and pass its value to the #:lfs? argument of git-fetch-with-fallback. Use INPUTS directly; update comment. derivation>: Add "git lfs?" to #:env-vars. (git-fetch/in-band): Express in terms of git-fetch/in-band*. (git-fetch/lfs): New procedure. * doc/guix.texi (origin Reference): Document it. Change-Id: I5b233b8642a7bdb8737b9d9b740e7254a89ccb25 Reviewed-by: Ludovic Courtès --- guix/build/git.scm | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/git.scm b/guix/build/git.scm index 0ff263c81b..867cade2c4 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès +;;; Copyright © 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,10 +34,13 @@ ;;; Code: (define* (git-fetch url commit directory - #:key (git-command "git") recursive?) + #:key (git-command "git") + lfs? recursive?) "Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit -identifier. When RECURSIVE? is true, all the sub-modules of URL are fetched, -recursively. Return #t on success, #f otherwise." +identifier. When LFS? is true, configure Git to also fetch Large File +Storage (LFS) files; it assumes that the @code{git-lfs} extension is available +in the environment. When RECURSIVE? is true, all the sub-modules of URL are +fetched, recursively. Return #t on success, #f otherwise." ;; Disable TLS certificate verification. The hash of the checkout is known ;; in advance anyway. @@ -57,6 +61,11 @@ recursively. Return #t on success, #f otherwise." (with-directory-excursion directory (invoke git-command "init" "--initial-branch=main") (invoke git-command "remote" "add" "origin" url) + + (when lfs? + (setenv "HOME" "/tmp") + (invoke git-command "lfs" "install")) + (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit)) (invoke git-command "checkout" "FETCH_HEAD") (begin @@ -81,11 +90,13 @@ recursively. Return #t on success, #f otherwise." (define* (git-fetch-with-fallback url commit directory - #:key (git-command "git") recursive?) + #:key (git-command "git") + 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." (or (git-fetch url commit directory + #:lfs? lfs? #:recursive? recursive? #:git-command git-command) (download-nar directory) -- cgit v1.2.3