futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

perform-download: Add backward-compatible case.

Browse Source 
This is meant to ease transition for people running an older guix-daemon
invoking a recent 'guix perform-download' with only one argument.

This is a followup to 9b5364a3af.

* guix/scripts/perform-download.scm (perform-download): Make 'output'
optional.  Bind 'output*' from DRV's "out" and honor it.
(guix-perform-download): Add clause with one argument.
This commit is contained in:
Ludovic Courtès 2017-01-11 22:40:00 +01:00
parent aaa2581b61
commit 26ab00a0a9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
guix/scripts/perform-download.scm
View File

@ -41,20 +41,23 @@
(module-use! module (resolve-interface '(guix base32))) (module-use! module (resolve-interface '(guix base32)))
module)) module))
(define (perform-download drv output) (define* (perform-download drv #:optional output)
"Perform the download described by DRV, a fixed-output derivation, to "Perform the download described by DRV, a fixed-output derivation, to
OUTPUT. OUTPUT.
Note: We don't read the value of 'out' in DRV since the actual output is Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
different from that when we're doing a 'bmCheck' or 'bmRepair' build." actual output is different from that when we're doing a 'bmCheck' or
'bmRepair' build."
(derivation-let drv ((url "url") (derivation-let drv ((url "url")
(output* "out")
(executable "executable") (executable "executable")
(mirrors "mirrors") (mirrors "mirrors")
(content-addressed-mirrors "content-addressed-mirrors")) (content-addressed-mirrors "content-addressed-mirrors"))
(unless url (unless url
(leave (_ "~a: missing URL~%") (derivation-file-name drv))) (leave (_ "~a: missing URL~%") (derivation-file-name drv)))
(let* ((url (call-with-input-string url read)) (let* ((output (or output output*))
(url (call-with-input-string url read))
(drv-output (assoc-ref (derivation-outputs drv) "out")) (drv-output (assoc-ref (derivation-outputs drv) "out"))
(algo (derivation-output-hash-algo drv-output)) (algo (derivation-output-hash-algo drv-output))
(hash (derivation-output-hash drv-output))) (hash (derivation-output-hash drv-output)))
@ -94,17 +97,20 @@ the daemon and not explicitly described as an input of the derivation. This
allows us to sidestep bootstrapping problems, such downloading the source code allows us to sidestep bootstrapping problems, such downloading the source code
of GnuTLS over HTTPS, before we have built GnuTLS. See of GnuTLS over HTTPS, before we have built GnuTLS. See
<http://bugs.gnu.org/22774>." <http://bugs.gnu.org/22774>."
;; 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
;; exclude users who did not pass '--build-users-group'.)
(with-error-handling (with-error-handling
(match args (match args
(((? derivation-path? drv) (? store-path? output)) (((? derivation-path? drv) (? store-path? output))
;; 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 exclude users who did not pass
;; '--build-users-group'.)
(assert-low-privileges) (assert-low-privileges)
(perform-download (call-with-input-file drv read-derivation) (perform-download (call-with-input-file drv read-derivation)
output)) output))
(((? derivation-path? drv)) ;backward compatibility
(assert-low-privileges)
(perform-download (call-with-input-file drv read-derivation)))
(("--version") (("--version")
(show-version-and-exit)) (show-version-and-exit))
(x (x