From: "Ludovic Courtès" <ludo@gnu.org>
To: 68677@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#68677] [PATCH 5/6] marionette: Add #:peek? to ‘wait-for-tcp-port?’.
Date: Tue, 23 Jan 2024 17:48:20 +0100 [thread overview]
Message-ID: <85175dd568a9283816652a6124f14cd65505bb22.1706027375.git.ludo@gnu.org> (raw)
In-Reply-To: <cover.1706027375.git.ludo@gnu.org>
* gnu/build/marionette.scm (wait-for-tcp-port): Add #:peek? parameter
and honor it.
Change-Id: Ie7515a5223299390ab8af6fe5aa3cf63ba5c8078
---
gnu/build/marionette.scm | 32 ++++++++++++++++++++++++++------
1 file changed, 26 insertions(+), 6 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 27c10e3dfe..0b0a8a70d8 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
@@ -223,29 +223,49 @@ (define* (wait-for-file file marionette
(define* (wait-for-tcp-port port marionette
#:key
(timeout 20)
+ (peek? #f)
(address `(make-socket-address AF_INET
INADDR_LOOPBACK
,port)))
"Wait for up to TIMEOUT seconds for PORT to accept connections in
MARIONETTE. ADDRESS must be an expression that returns a socket address,
-typically a call to 'make-socket-address'. Raise an error on failure."
+typically a call to 'make-socket-address'. When PEEK? is true, attempt to
+read a byte from the socket upon connection; retry if that gives the
+end-of-file object.
+
+Raise an error on failure."
;; Note: The 'connect' loop has to run within the guest because, when we
;; forward ports to the host, connecting to the host never raises
;; ECONNREFUSED.
(match (marionette-eval
- `(let* ((address ,address)
- (sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
- (let loop ((i 0))
+ `(let* ((address ,address))
+ (define (open-socket)
+ (socket (sockaddr:fam address) SOCK_STREAM 0))
+
+ (let loop ((sock (open-socket))
+ (i 0))
(catch 'system-error
(lambda ()
(connect sock address)
+ (when ,peek?
+ (let ((byte ((@ (ice-9 binary-ports) lookahead-u8)
+ sock)))
+ (when (eof-object? byte)
+ (close-port sock)
+ (throw 'system-error
+ "wait-for-tcp-port" "~A"
+ (list (strerror ECONNRESET))
+ (list ECONNRESET)))))
(close-port sock)
'success)
(lambda args
(if (< i ,timeout)
(begin
(sleep 1)
- (loop (+ 1 i)))
+ (loop (if (port-closed? sock)
+ (open-socket)
+ sock)
+ (+ 1 i)))
(list 'failure address))))))
marionette)
('success #t)
--
2.41.0
next prev parent reply other threads:[~2024-01-23 16:49 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 2/6] vm: Add ‘date’ field to <virtual-machine> Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 3/6] vm: Export <virtual-machine> accessors Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 4/6] vm: Add ‘cpu-count’ field to <virtual-machine> Ludovic Courtès
2024-01-23 16:48 ` Ludovic Courtès [this message]
2024-01-23 16:48 ` [bug#68677] [PATCH 6/6] services: Add ‘virtual-build-machine’ service Ludovic Courtès
2024-01-25 14:18 ` [bug#68677] [PATCH 0/6] Service for "virtual build machines" Simon Tournier
2024-01-29 11:25 ` Ludovic Courtès
2024-02-05 13:37 ` Ludovic Courtès
2024-02-05 15:45 ` Suhail via Guix-patches via
2024-02-07 17:33 ` Ludovic Courtès
2024-02-14 15:15 ` Simon Tournier
2024-02-10 22:35 ` bug#68677: " 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=85175dd568a9283816652a6124f14cd65505bb22.1706027375.git.ludo@gnu.org \
--to=ludo@gnu.org \
--cc=68677@debbugs.gnu.org \
/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).