mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
marionette: Add #:address parameter to 'wait-for-tcp-port'.
* gnu/build/marionette.scm (wait-for-tcp-port): Add #:address parameter. Honor it, and improve error reporting in the 'failure case.
This commit is contained in:
parent
8a588eb871
commit
52aceda4fd
1 changed files with 26 additions and 19 deletions
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
@ -196,19 +196,24 @@ (define* (wait-for-file file marionette
|
|||
(error "file didn't show up" file))))
|
||||
|
||||
(define* (wait-for-tcp-port port marionette
|
||||
#:key (timeout 20))
|
||||
#:key
|
||||
(timeout 20)
|
||||
(address `(make-socket-address AF_INET
|
||||
INADDR_LOOPBACK
|
||||
,port)))
|
||||
"Wait for up to TIMEOUT seconds for PORT to accept connections in
|
||||
MARIONETTE. Raise an error on failure."
|
||||
MARIONETTE. ADDRESS must be an expression that returns a socket address,
|
||||
typically a call to 'make-socket-address'. 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
|
||||
`(begin
|
||||
(let ((sock (socket PF_INET SOCK_STREAM 0)))
|
||||
`(let* ((address ,address)
|
||||
(sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
|
||||
(let loop ((i 0))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(connect sock AF_INET INADDR_LOOPBACK ,port)
|
||||
(connect sock address)
|
||||
(close-port sock)
|
||||
'success)
|
||||
(lambda args
|
||||
|
@ -216,11 +221,13 @@ (define* (wait-for-tcp-port port marionette
|
|||
(begin
|
||||
(sleep 1)
|
||||
(loop (+ 1 i)))
|
||||
'failure))))))
|
||||
(list 'failure address))))))
|
||||
marionette)
|
||||
('success #t)
|
||||
('failure
|
||||
(error "nobody's listening on port" port))))
|
||||
(('failure address)
|
||||
(error "nobody's listening on port"
|
||||
(list (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
|
||||
(sockaddr:port address))))))
|
||||
|
||||
(define* (wait-for-unix-socket file-name marionette
|
||||
#:key (timeout 20))
|
||||
|
|
Loading…
Reference in a new issue