diff options
Diffstat (limited to 'guix/build')
| -rw-r--r-- | guix/build/git.scm | 19 |
1 files changed, 15 insertions, 4 deletions
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 <ludo@gnu.org> +;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; 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) |