| Message ID | 2bcc2278b5aefcd81fbc53b791d08622b6d93c7c.1708458147.git.mail@cbaines.net |
|---|---|
| State | New |
| Headers | show |
| Series | None | expand |
Christopher Baines <mail@cbaines.net> skribis: > 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 The patch LGTM. That said, maybe we should just pass #:timeout to ‘http-fetch’? It’s not strictly equivalent because it only controls the timeout on connection establishment, but in practice it should have the same effect. Ludo’.
Ludovic Courtès <ludo@gnu.org> writes: > Christopher Baines <mail@cbaines.net> skribis: > >> 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 > > The patch LGTM. > > That said, maybe we should just pass #:timeout to ‘http-fetch’? It’s > not strictly equivalent because it only controls the timeout on > connection establishment, but in practice it should have the same > effect. I haven't done that yet, but longer term I do want to make more changes here. In particular, I think the way to go regarding timeouts is to use Guile suspendable ports and have the read/write waiters handle the timeout. The build coordinator does this [1], it's quite similar to what is happening with the http-fetch timeout in connect*, but it's compatible with fibers. 1: https://git.savannah.gnu.org/cgit/guix/build-coordinator.git/tree/guix-build-coordinator/utils/fibers.scm#n473
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index f3eed0eb44..575fa2a0b3 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -452,7 +452,8 @@ (define-syntax-rule (catch-system-error exp) (define* (download-nar narinfo destination #: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 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 @@ -473,20 +474,26 @@ (define* (download-nar narinfo destination (let ((port (open-file (uri-path uri) "r0b"))) (values port (stat:size (stat port))))) ((http https) - ;; Test this with: - ;; sudo tc qdisc add dev eth0 root netem delay 1500ms - ;; and then cancel with: - ;; sudo tc qdisc del dev eth0 root - (with-timeout %fetch-timeout - (begin - (warning (G_ "while fetching ~a: server is somewhat slow~%") - (uri->string uri)) - (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)))) + (if fetch-timeout + ;; Test this with: + ;; sudo tc qdisc add dev eth0 root netem delay 1500ms + ;; and then cancel with: + ;; sudo tc qdisc del dev eth0 root + (with-timeout %fetch-timeout + (begin + (warning (G_ "while fetching ~a: server is somewhat slow~%") + (uri->string uri)) + (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 + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f)))) (else (leave (G_ "unsupported substitute URI scheme: ~a~%") (uri->string uri)))))