From: Christopher Baines <mail@cbaines.net>
To: 70494@debbugs.gnu.org
Cc: "Christopher Baines" <guix@cbaines.net>,
"Josselin Poiret" <dev@jpoiret.xyz>,
"Ludovic Courtès" <ludo@gnu.org>,
"Mathieu Othacehe" <othacehe@gnu.org>,
"Ricardo Wurmus" <rekado@elephly.net>,
"Simon Tournier" <zimon.toutoune@gmail.com>,
"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#70494] [PATCH 20/23] scripts: substitute: Simplify with-timeout usage.
Date: Sun, 21 Apr 2024 10:42:38 +0100 [thread overview]
Message-ID: <603b957f193b30f454d27070d1536aa6a7adaca9.1713692561.git.mail@cbaines.net> (raw)
In-Reply-To: <87bk632h36.fsf@cbaines.net>
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
---
guix/scripts/substitute.scm | 93 ++++++++++++++++++-------------------
1 file 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 @@ (define %random-state
(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 @@ (define* (download-nar narinfo destination
(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
--
2.41.0
next prev parent reply other threads:[~2024-04-21 9:44 UTC|newest]
Thread overview: 45+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-04-21 9:35 [bug#70494] [PATCH 00/23] Groundwork for the Guile guix-daemon Christopher Baines
2024-04-21 9:42 ` [bug#70494] [PATCH 01/23] store: database: Register derivation outputs Christopher Baines
2024-05-07 14:30 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 02/23] gnu: linux-container: Make it more suitable for derivation-building Christopher Baines
2024-05-07 14:28 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 03/23] syscalls: Add missing pieces for derivation build environment Christopher Baines
2024-05-07 14:27 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 04/23] guix: store: environment: New module Christopher Baines
2024-05-13 15:10 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 05/23] store: build-derivations: " Christopher Baines
2024-05-13 15:22 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 06/23] store: Export protocol related constants Christopher Baines
2024-05-13 15:58 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 07/23] serialization: Export read-byte-string Christopher Baines
2024-05-13 15:58 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 08/23] store: Add text-output-path and text-output-path-from-hash Christopher Baines
2024-05-13 15:59 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 09/23] store: Add validate-store-name Christopher Baines
2024-05-13 16:04 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 10/23] store: database: Add procedures for querying valid paths Christopher Baines
2024-05-16 16:04 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 11/23] scripts: substitute: Untangle selecting fast vs small compressions Christopher Baines
2024-05-16 16:08 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 12/23] scripts: substitute: Extract script specific output from download-nar Christopher Baines
2024-05-16 16:13 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 13/23] syscalls: Add unshare Christopher Baines
2024-05-16 16:14 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 14/23] scripts: perform-download: Support configuring the %store-prefix Christopher Baines
2024-05-16 16:17 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 15/23] store: Export operation-id Christopher Baines
2024-05-16 16:18 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 16/23] store: database: Log when aborting transactions Christopher Baines
2024-05-16 16:20 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 17/23] store: database: Export transaction helpers Christopher Baines
2024-05-16 16:21 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 18/23] guix: http-client: Add network-error? Christopher Baines
2024-05-16 16:23 ` Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 19/23] http-client: Include EPIPE in network-error? Christopher Baines
2024-05-16 16:23 ` Ludovic Courtès
2024-04-21 9:42 ` Christopher Baines [this message]
2024-05-16 16:27 ` [bug#70494] [PATCH 20/23] scripts: substitute: Simplify with-timeout usage Ludovic Courtès
2024-04-21 9:42 ` [bug#70494] [PATCH 21/23] scripts: substitute: Don't enforce cached connections in download-nar Christopher Baines
2024-04-21 9:42 ` [bug#70494] [PATCH 22/23] substitutes: Move download-nar from substitutes script to here Christopher Baines
2024-04-21 9:42 ` [bug#70494] [PATCH 23/23] substitutes: Add #:keep-alive? keyword argument to download-nar Christopher Baines
2024-05-16 16:29 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=603b957f193b30f454d27070d1536aa6a7adaca9.1713692561.git.mail@cbaines.net \
--to=mail@cbaines.net \
--cc=70494@debbugs.gnu.org \
--cc=dev@jpoiret.xyz \
--cc=guix@cbaines.net \
--cc=ludo@gnu.org \
--cc=me@tobias.gr \
--cc=othacehe@gnu.org \
--cc=rekado@elephly.net \
--cc=zimon.toutoune@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).