TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

marionette: Add #:peek? to ‘wait-for-tcp-port?’. 

* gnu/build/marionette.scm (wait-for-tcp-port): Add #:peek? parameter
and honor it.

Change-Id: Ie7515a5223299390ab8af6fe5aa3cf63ba5c8078
This commit is contained in:
Ludovic Courtès 2024-01-23 14:27:30 +01:00
parent b0a5c0742f
commit 5f34796dc4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gnu/build/marionette.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
@ -223,29 +223,49 @@ FILE has not shown up after TIMEOUT seconds, raise an error."
(define* (wait-for-tcp-port port marionette (define* (wait-for-tcp-port port marionette
#:key #:key
(timeout 20) (timeout 20)
(peek? #f)
(address `(make-socket-address AF_INET (address `(make-socket-address AF_INET
INADDR_LOOPBACK INADDR_LOOPBACK
,port))) ,port)))
"Wait for up to TIMEOUT seconds for PORT to accept connections in "Wait for up to TIMEOUT seconds for PORT to accept connections in
MARIONETTE. ADDRESS must be an expression that returns a socket address, 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 ;; Note: The 'connect' loop has to run within the guest because, when we
;; forward ports to the host, connecting to the host never raises ;; forward ports to the host, connecting to the host never raises
;; ECONNREFUSED. ;; ECONNREFUSED.
(match (marionette-eval (match (marionette-eval
`(let* ((address ,address) `(let* ((address ,address))
(sock (socket (sockaddr:fam address) SOCK_STREAM 0))) (define (open-socket)
(let loop ((i 0)) (socket (sockaddr:fam address) SOCK_STREAM 0))
(let loop ((sock (open-socket))
(i 0))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock address) (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) (close-port sock)
'success) 'success)
(lambda args (lambda args
(if (< i ,timeout) (if (< i ,timeout)
(begin (begin
(sleep 1) (sleep 1)
(loop (+ 1 i))) (loop (if (port-closed? sock)
(open-socket)
sock)
(+ 1 i)))
(list 'failure address)))))) (list 'failure address))))))
marionette) marionette)
('success #t) ('success #t)