mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
git-download: Support recursive clones.
* guix/git-download.scm (<git-reference>)[recursive?]: New field. (git-fetch): Add 'inputs' variable. Add it to the #:inputs argument of 'build-expression->derivation'. Augment builder with call to 'set-path-environment-variable', and pass #:recursive? to 'git-fetch'. * guix/build/git.scm (git-fetch): Add #:recursive? parameter. Pass --recursive when RECURSIVE? is true, and delete all the '.git' files.
This commit is contained in:
parent
20b1d19e10
commit
6750877f46
2 changed files with 48 additions and 16 deletions
|
@ -28,23 +28,32 @@ (define-module (guix build git)
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define* (git-fetch url commit directory
|
(define* (git-fetch url commit directory
|
||||||
#:key (git-command "git"))
|
#:key (git-command "git") recursive?)
|
||||||
"Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit
|
"Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit
|
||||||
identifier. Return #t on success, #f otherwise."
|
identifier. 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
|
;; Disable TLS certificate verification. The hash of the checkout is known
|
||||||
;; in advance anyway.
|
;; in advance anyway.
|
||||||
(setenv "GIT_SSL_NO_VERIFY" "true")
|
(setenv "GIT_SSL_NO_VERIFY" "true")
|
||||||
|
|
||||||
(and (zero? (system* git-command "clone" url directory))
|
(let ((args `("clone" ,@(if recursive? '("--recursive") '())
|
||||||
(with-directory-excursion directory
|
,url ,directory)))
|
||||||
(system* git-command "tag" "-l")
|
(and (zero? (apply system* git-command args))
|
||||||
(and (zero? (system* git-command "checkout" commit))
|
(with-directory-excursion directory
|
||||||
(begin
|
(system* git-command "tag" "-l")
|
||||||
;; The contents of '.git' vary as a function of the current
|
(and (zero? (system* git-command "checkout" commit))
|
||||||
;; status of the Git repo. Since we want a fixed output, this
|
(begin
|
||||||
;; directory needs to be taken out.
|
;; The contents of '.git' vary as a function of the current
|
||||||
(delete-file-recursively ".git")
|
;; status of the Git repo. Since we want a fixed output, this
|
||||||
#t)))))
|
;; directory needs to be taken out.
|
||||||
|
(delete-file-recursively ".git")
|
||||||
|
|
||||||
|
(when recursive?
|
||||||
|
;; In sub-modules, '.git' is a flat file, not a directory,
|
||||||
|
;; so we can use 'find-files' here.
|
||||||
|
(for-each delete-file-recursively
|
||||||
|
(find-files directory "^\\.git$")))
|
||||||
|
#t))))))
|
||||||
|
|
||||||
;;; git.scm ends here
|
;;; git.scm ends here
|
||||||
|
|
|
@ -20,11 +20,13 @@ (define-module (guix git-download)
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
|
#:autoload (guix build-system gnu) (standard-inputs)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (git-reference
|
#:export (git-reference
|
||||||
git-reference?
|
git-reference?
|
||||||
git-reference-url
|
git-reference-url
|
||||||
git-reference-commit
|
git-reference-commit
|
||||||
|
git-reference-recursive?
|
||||||
|
|
||||||
git-fetch))
|
git-fetch))
|
||||||
|
|
||||||
|
@ -39,8 +41,10 @@ (define-module (guix git-download)
|
||||||
(define-record-type* <git-reference>
|
(define-record-type* <git-reference>
|
||||||
git-reference make-git-reference
|
git-reference make-git-reference
|
||||||
git-reference?
|
git-reference?
|
||||||
(url git-reference-url)
|
(url git-reference-url)
|
||||||
(commit git-reference-commit))
|
(commit git-reference-commit)
|
||||||
|
(recursive? git-reference-recursive? ; whether to recurse into sub-modules
|
||||||
|
(default #f)))
|
||||||
|
|
||||||
(define* (git-fetch store ref hash-algo hash
|
(define* (git-fetch store ref hash-algo hash
|
||||||
#:optional name
|
#:optional name
|
||||||
|
@ -67,18 +71,37 @@ (define git-for-build
|
||||||
(git (module-ref distro 'git)))
|
(git (module-ref distro 'git)))
|
||||||
(package-derivation store git system)))))
|
(package-derivation store git system)))))
|
||||||
|
|
||||||
|
(define inputs
|
||||||
|
;; When doing 'git clone --recursive', we need sed, grep, etc. to be
|
||||||
|
;; available so that 'git submodule' works.
|
||||||
|
(if (git-reference-recursive? ref)
|
||||||
|
(standard-inputs (%current-system))
|
||||||
|
'()))
|
||||||
|
|
||||||
(let* ((command (string-append (derivation->output-path git-for-build)
|
(let* ((command (string-append (derivation->output-path git-for-build)
|
||||||
"/bin/git"))
|
"/bin/git"))
|
||||||
(builder `(begin
|
(builder `(begin
|
||||||
(use-modules (guix build git))
|
(use-modules (guix build git)
|
||||||
|
(guix build utils)
|
||||||
|
(ice-9 match))
|
||||||
|
|
||||||
|
;; The 'git submodule' commands expects Coreutils, sed,
|
||||||
|
;; grep, etc. to be in $PATH.
|
||||||
|
(set-path-environment-variable "PATH" '("bin")
|
||||||
|
(match %build-inputs
|
||||||
|
(((names . dirs) ...)
|
||||||
|
dirs)))
|
||||||
|
|
||||||
(git-fetch ',(git-reference-url ref)
|
(git-fetch ',(git-reference-url ref)
|
||||||
',(git-reference-commit ref)
|
',(git-reference-commit ref)
|
||||||
%output
|
%output
|
||||||
|
#:recursive? ',(git-reference-recursive? ref)
|
||||||
#:git-command ',command))))
|
#:git-command ',command))))
|
||||||
(build-expression->derivation store (or name "git-checkout") builder
|
(build-expression->derivation store (or name "git-checkout") builder
|
||||||
#:system system
|
#:system system
|
||||||
#:local-build? #t
|
#:local-build? #t
|
||||||
#:inputs `(("git" ,git-for-build))
|
#:inputs `(("git" ,git-for-build)
|
||||||
|
,@inputs)
|
||||||
#:hash-algo hash-algo
|
#:hash-algo hash-algo
|
||||||
#:hash hash
|
#:hash hash
|
||||||
#:recursive? #t
|
#:recursive? #t
|
||||||
|
|
Loading…
Reference in a new issue