mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-04 09:16:31 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

scripts: substitute: Allow not using with-timeout in download-nar.

Browse source 
I don't think the approach of using SIGALARM here for the timeout will work
well in all cases (e.g. when using Guile Fibers), so make it possible to avoid
this.

* guix/scripts/substitute.scm (download-nar): Pass the fetch timeout in as an
option.

Change-Id: I8cbe6cdfa10cdaa7d41974cbea56a95f5efecfe6
This commit is contained in:
Christopher Baines 2024-02-10 17:09:25 +00:00
parent d9276a46bf
commit dcf0cca8d7
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
1 changed files with 22 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
guix/scripts/substitute.scm
View file

@ -452,7 +452,8 @@ (define-syntax-rule (catch-system-error exp)
(define* (download-nar narinfo destination (define* (download-nar narinfo destination
#:key status-port #:key status-port
deduplicate? print-build-trace?) deduplicate? print-build-trace?
(fetch-timeout %fetch-timeout))
"Download the nar prescribed in NARINFO, which is assumed to be authentic "Download the nar prescribed in NARINFO, which is assumed to be authentic
and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and
if DESTINATION is in the store, deduplicate its files. Print a status line to if DESTINATION is in the store, deduplicate its files. Print a status line to
@ -473,6 +474,7 @@ (define (fetch uri)
(let ((port (open-file (uri-path uri) "r0b"))) (let ((port (open-file (uri-path uri) "r0b")))
(values port (stat:size (stat port))))) (values port (stat:size (stat port)))))
((http https) ((http https)
(if fetch-timeout
;; Test this with: ;; Test this with:
;; sudo tc qdisc add dev eth0 root netem delay 1500ms ;; sudo tc qdisc add dev eth0 root netem delay 1500ms
;; and then cancel with: ;; and then cancel with:
@ -482,6 +484,11 @@ (define (fetch uri)
(warning (G_ "while fetching ~a: server is somewhat slow~%") (warning (G_ "while fetching ~a: server is somewhat slow~%")
(uri->string uri)) (uri->string uri))
(warning (G_ "try `--no-substitutes' if the problem persists~%"))) (warning (G_ "try `--no-substitutes' if the problem persists~%")))
(with-cached-connection uri port
(http-fetch uri #:text? #f
#:port port
#:keep-alive? #t
#:buffered? #f)))
(with-cached-connection uri port (with-cached-connection uri port
(http-fetch uri #:text? #f (http-fetch uri #:text? #f
#:port port #:port port