me
/
guix
Archived
1
0
Fork 0
Code

git-download: Download from Software Heritage as a last resort. 

* guix/git-download.scm (git-fetch)[inputs]: Add gzip and tar when
'git-reference-recursive?' is false.
[guile-json, gnutls]: New variables.
[modules]: Add (guix swh).
[build]: Wrap in 'with-extensions'.  Add call to 'swh-download'.
master
Ludovic Courtès 2018-11-19 15:46:50 +01:00 committed by Ludovic Courtès
parent de2bfe9029
commit 608d3dca89
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 44 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/git-download.scm
View File

@ -74,11 +74,22 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
;; available so that 'git submodule' works.
(if (git-reference-recursive? ref)
(standard-packages)
'()))
;; The 'swh-download' procedure requires tar and gzip.
`(("gzip" ,(module-ref (resolve-interface '(gnu packages compression))
'gzip))
("tar" ,(module-ref (resolve-interface '(gnu packages base))
'tar)))))
(define zlib
(module-ref (resolve-interface '(gnu packages compression)) 'zlib))
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
(define config.scm
(scheme-file "config.scm"
#~(begin
@ -93,30 +104,43 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(delete '(guix config)
(source-module-closure '((guix build git)
(guix build utils)
(guix build download-nar))))))
(guix build download-nar)
(guix swh))))))
(define build
(with-imported-modules modules
#~(begin
(use-modules (guix build git)
(guix build utils)
(guix build download-nar)
(ice-9 match))
(with-extensions (list guile-json gnutls) ;for (guix swh)
#~(begin
(use-modules (guix build git)
(guix build utils)
(guix build download-nar)
(guix swh)
(ice-9 match))
;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin")
(match '#+inputs
(((names dirs outputs ...) ...)
dirs)))
(define recursive?
(call-with-input-string (getenv "git recursive?") read))
(or (git-fetch (getenv "git url") (getenv "git commit")
#$output
#:recursive? (call-with-input-string
(getenv "git recursive?")
read)
#:git-command (string-append #+git "/bin/git"))
(download-nar #$output)))))
;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin")
(match '#+inputs
(((names dirs outputs ...) ...)
dirs)))
(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)
(or (git-fetch (getenv "git url") (getenv "git commit")
#$output
#:recursive? recursive?
#:git-command (string-append #+git "/bin/git"))
(download-nar #$output)
;; As a last resort, attempt to download from Software Heritage.
;; XXX: Currently recursive checkouts are not supported.
(and (not recursive?)
(swh-download (getenv "git url") (getenv "git commit")
#$output)))))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build