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.
This commit is contained in:
Ludovic Courtès 2018-09-12 15:08:38 +02:00
parent dc0f74e5fc
commit 240a9c69a6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 38 additions and 16 deletions

View file

@ -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