inferior: Propagate '&store-protocol-error' error conditions.

[jackhill/guix/guix.git] / guix / git-download.scm

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 6cf267d..1eae035 100644 (file)
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
@@ -85,7 +85,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
     (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
 
   (define guile-json
-    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json))
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
 
   (define gnutls
     (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
@@ -139,8 +139,11 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                 ;; 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)))))))
+                     (begin
+                       (format (current-error-port)
+                               "Trying to download from Software Heritage...~%")
+                       (swh-download (getenv "git url") (getenv "git commit")
+                                     #$output))))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "git-checkout") build
@@ -154,6 +157,9 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                         ("git commit" . ,(git-reference-commit ref))
                         ("git recursive?" . ,(object->string
                                               (git-reference-recursive? ref))))
+                      #:leaked-env-vars '("http_proxy" "https_proxy"
+                                          "LC_ALL" "LC_MESSAGES" "LANG"
+                                          "COLUMNS")
 
                       #:system system
                       #:local-build? #t           ;don't offload repo cloning
@@ -185,9 +191,7 @@ are relative to DIRECTORY, which is not necessarily the root of the checkout."
          (directory  (string-append (canonicalize-path directory) "/"))
          (dot-git    (repository-discover directory))
          (repository (repository-open dot-git))
-         ;; XXX: This procedure is mistakenly private in Guile-Git 0.1.0.
-         (workdir    ((@@ (git repository) repository-working-directory)
-                      repository))
+         (workdir    (repository-working-directory repository))
          (head       (repository-head repository))
          (oid        (reference-target head))
          (commit     (commit-lookup repository oid))