diff options
author | Christopher Baines <mail@cbaines.net> | 2024-04-21 10:42:38 +0100 |
---|---|---|
committer | Guix Patches Tester <> | 2024-04-21 11:53:24 +0200 |
commit | 13abc599f747eb68e628f9f4355e230ee43e6ec2 (patch) | |
tree | 7483d2f4065982a4d3b08d27f89e641040b7e665 | |
parent | 263aec1d57e31fc7b36ae5168c8e832731099cbb (diff) | |
download | guix-patches-13abc599f747eb68e628f9f4355e230ee43e6ec2.tar guix-patches-13abc599f747eb68e628f9f4355e230ee43e6ec2.tar.gz |
scripts: substitute: Simplify with-timeout usage.
To reduce the codepaths in download-nar.
* guix/scripts/substitute.scm (with-timeout): Accept a #f duration and don't
set a timeout.
(download-nar): Remove the if for fetch-timeout.
Change-Id: I4e944a425a8612e96659dd84dd0e315012f080ab
-rwxr-xr-x | guix/scripts/substitute.scm | 93 |
1 files changed, 45 insertions, 48 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 362d9fbe7a..b4bb9d51ff 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -101,34 +101,37 @@ disabled!~%")) (define-syntax-rule (with-timeout duration handler body ...) "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY again." - (begin - (sigaction SIGALRM - (lambda (signum) - (sigaction SIGALRM SIG_DFL) - handler)) - (alarm duration) - (call-with-values - (lambda () - (let try () - (catch 'system-error - (lambda () - body ...) - (lambda args - ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR - ;; because of the bug at - ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. - ;; When that happens, try again. Note: SA_RESTART cannot be - ;; used because of <http://bugs.gnu.org/14640>. - (if (= EINTR (system-error-errno args)) - (begin - ;; Wait a little to avoid bursts. - (usleep (random 3000000 %random-state)) - (try)) - (apply throw args)))))) - (lambda result - (alarm 0) - (sigaction SIGALRM SIG_DFL) - (apply values result))))) + (if duration + (begin + (sigaction SIGALRM + (lambda (signum) + (sigaction SIGALRM SIG_DFL) + handler)) + (alarm duration) + (call-with-values + (lambda () + (let try () + (catch 'system-error + (lambda () + body ...) + (lambda args + ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR + ;; because of the bug at + ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. + ;; When that happens, try again. Note: SA_RESTART cannot be + ;; used because of <http://bugs.gnu.org/14640>. + (if (= EINTR (system-error-errno args)) + (begin + ;; Wait a little to avoid bursts. + (usleep (random 3000000 %random-state)) + (try)) + (apply throw args)))))) + (lambda result + (alarm 0) + (sigaction SIGALRM SIG_DFL) + (apply values result)))) + (begin + body ...))) (define (at-most max-length lst) "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise @@ -475,26 +478,20 @@ if DESTINATION is in the store, deduplicate its files." (let ((port (open-file (uri-path uri) "r0b"))) (values port (stat:size (stat port))))) ((http https) - (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)))) + ;; 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)))) (else (raise (formatted-message |