perform-download: Optionally report a "download-progress" trace.

* guix/scripts/perform-download.scm (perform-download): Add
 #:print-build-trace? and pass it to 'url-fetch'.
(guix-perform-download): Define 'print-build-trace?' and pass it to
'perform-download'.
* guix/build/download.scm (ftp-fetch): Add #:print-build-trace? and
honor it.
(url-fetch): Likewise.
* nix/libstore/builtins.cc (builtinDownload): Set _NIX_OPTIONS
environment variable.

1 files changed, 13 insertions, 5 deletions

diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
index 9f6ecc00d2..df787a9940 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,14 +41,14 @@
     (module-use! module (resolve-interface '(guix base32)))
     module))
 
-(define* (perform-download drv #:optional output)
+(define* (perform-download drv #:optional output
+                           #:key print-build-trace?)
   "Perform the download described by DRV, a fixed-output derivation, to
 OUTPUT.
 
 Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
 actual output is different from that when we're doing a 'bmCheck' or
 'bmRepair' build."
-  ;; TODO: Use 'trace-progress-proc' when possible.
   (derivation-let drv ((url "url")
                        (output* "out")
                        (executable "executable")
@@ -68,6 +68,7 @@ actual output is different from that when we're doing a 'bmCheck' or
 
       ;; We're invoked by the daemon, which gives us write access to OUTPUT.
       (when (url-fetch url output
+                       #:print-build-trace? print-build-trace?
                        #:mirrors (if mirrors
                                      (call-with-input-file mirrors read)
                                      '())
@@ -99,6 +100,11 @@ allows us to sidestep bootstrapping problems, such downloading the source code
 of GnuTLS over HTTPS, before we have built GnuTLS.  See
 <http://bugs.gnu.org/22774>."
 
+  (define print-build-trace?
+    (match (getenv "_NIX_OPTIONS")
+      (#f #f)
+      (str (string-contains str "print-extended-build-trace=1"))))
+
   ;; This program must be invoked by guix-daemon under an unprivileged UID to
   ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
   ;; execution via the content-addressed mirror procedures.  (That means we
@@ -108,10 +114,12 @@ of GnuTLS over HTTPS, before we have built GnuTLS.  See
       (((? derivation-path? drv) (? store-path? output))
        (assert-low-privileges)
        (perform-download (read-derivation-from-file drv)
-                         output))
+                         output
+                         #:print-build-trace? print-build-trace?))
       (((? derivation-path? drv))                 ;backward compatibility
        (assert-low-privileges)
-       (perform-download (read-derivation-from-file drv)))
+       (perform-download (read-derivation-from-file drv)
+                         #:print-build-trace? print-build-trace?))
       (("--version")
        (show-version-and-exit))
       (x