me
/
guix
Archived
1
0
Fork 0
Code

git-download: Fetch only the required commit, if possible. 

* guix/build/git.scm (git-fetch): Fetch only the required commit, if possible.
master
Danny Milosavljevic 2018-02-14 00:54:01 +01:00
parent 48c8622010
commit 329dabe13b
No known key found for this signature in database
GPG Key ID: E71A35542C30BAA5
1 changed files with 23 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
guix/build/git.scm
View File

@ -37,28 +37,31 @@ recursively. Return #t on success, #f otherwise."
;; in advance anyway. ;; in advance anyway.
(setenv "GIT_SSL_NO_VERIFY" "true") (setenv "GIT_SSL_NO_VERIFY" "true")
;; We cannot use "git clone --recursive" since the following "git checkout" (mkdir-p directory)
;; effectively removes sub-module checkouts as of Git 2.6.3.
(and (zero? (system* git-command "clone" url directory)) (with-directory-excursion directory
(with-directory-excursion directory (invoke git-command "init")
(system* git-command "tag" "-l") (invoke git-command "remote" "add" "origin" url)
(and (zero? (system* git-command "checkout" commit)) (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
(begin (invoke git-command "checkout" "FETCH_HEAD")
(when recursive? (begin
;; Now is the time to fetch sub-modules. (invoke git-command "fetch" "origin")
(unless (zero? (system* git-command "submodule" "update" (invoke git-command "checkout" commit)))
(when recursive?
;; Now is the time to fetch sub-modules.
(unless (zero? (system* git-command "submodule" "update"
"--init" "--recursive")) "--init" "--recursive"))
(error "failed to fetch sub-modules" url)) (error "failed to fetch sub-modules" url))
;; In sub-modules, '.git' is a flat file, not a directory, ;; In sub-modules, '.git' is a flat file, not a directory,
;; so we can use 'find-files' here. ;; so we can use 'find-files' here.
(for-each delete-file-recursively (for-each delete-file-recursively
(find-files directory "^\\.git$"))) (find-files directory "^\\.git$")))
;; The contents of '.git' vary as a function of the current ;; The contents of '.git' vary as a function of the current
;; status of the Git repo. Since we want a fixed output, this ;; status of the Git repo. Since we want a fixed output, this
;; directory needs to be taken out. ;; directory needs to be taken out.
(delete-file-recursively ".git") (delete-file-recursively ".git")
#t))))) #t))
;;; git.scm ends here ;;; git.scm ends here