summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2018-11-19 15:46:50 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-26 11:10:20 +0100
commit608d3dca89d73fe7260e97a284a8aeea756a3e11 (patch)
treec2e11633c3da2a01f60efb691c2733d61f21af08 /guix
parentde2bfe902936e3f7abfd4b55ad1149f75c5818b3 (diff)
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'.
Diffstat (limited to 'guix')
-rw-r--r--guix/git-download.scm68
1 files changed, 46 insertions, 22 deletions
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 072ab51538..6cf267d6c8 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -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))
-
- ;; 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)))
-
- (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)))))
+ (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))
+
+ (define recursive?
+ (call-with-input-string (getenv "git recursive?") read))
+
+ ;; 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