marionette: Add 'wait-for-tcp-port'.
* gnu/build/marionette.scm (wait-for-tcp-port): New procedure. * gnu/tests/dict.scm (run-dicod-test)["connect inside"]: Use it instead of the inline loop.
This commit is contained in:
parent
5ede50b850
commit
7a4e2eaab3
|
@ -26,6 +26,7 @@
|
||||||
make-marionette
|
make-marionette
|
||||||
marionette-eval
|
marionette-eval
|
||||||
wait-for-file
|
wait-for-file
|
||||||
|
wait-for-tcp-port
|
||||||
marionette-control
|
marionette-control
|
||||||
marionette-screen-text
|
marionette-screen-text
|
||||||
wait-for-screen-text
|
wait-for-screen-text
|
||||||
|
@ -187,6 +188,32 @@ FILE has not shown up after TIMEOUT seconds, raise an error."
|
||||||
('failure
|
('failure
|
||||||
(error "file didn't show up" file))))
|
(error "file didn't show up" file))))
|
||||||
|
|
||||||
|
(define* (wait-for-tcp-port port marionette
|
||||||
|
#:key (timeout 20))
|
||||||
|
"Wait for up to TIMEOUT seconds for PORT to accept connections in
|
||||||
|
MARIONETTE. 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 loop ((i 0))
|
||||||
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(connect sock AF_INET INADDR_LOOPBACK ,port)
|
||||||
|
'success)
|
||||||
|
(lambda args
|
||||||
|
(if (< i ,timeout)
|
||||||
|
(begin
|
||||||
|
(sleep 1)
|
||||||
|
(loop (+ 1 i)))
|
||||||
|
'failure))))))
|
||||||
|
marionette)
|
||||||
|
('success #t)
|
||||||
|
('failure
|
||||||
|
(error "nobody's listening on port" port))))
|
||||||
|
|
||||||
(define (marionette-control command marionette)
|
(define (marionette-control command marionette)
|
||||||
"Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as
|
"Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as
|
||||||
\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc)
|
\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -96,22 +96,7 @@
|
||||||
;; Wait until dicod is actually listening.
|
;; Wait until dicod is actually listening.
|
||||||
;; TODO: Use a PID file instead.
|
;; TODO: Use a PID file instead.
|
||||||
(test-assert "connect inside"
|
(test-assert "connect inside"
|
||||||
(marionette-eval
|
(wait-for-tcp-port 2628 marionette))
|
||||||
'(begin
|
|
||||||
(use-modules (ice-9 rdelim))
|
|
||||||
(let ((sock (socket PF_INET SOCK_STREAM 0)))
|
|
||||||
(let loop ((i 0))
|
|
||||||
(pk 'try i)
|
|
||||||
(catch 'system-error
|
|
||||||
(lambda ()
|
|
||||||
(connect sock AF_INET INADDR_LOOPBACK 2628))
|
|
||||||
(lambda args
|
|
||||||
(pk 'connection-error args)
|
|
||||||
(when (< i 20)
|
|
||||||
(sleep 1)
|
|
||||||
(loop (+ 1 i))))))
|
|
||||||
(read-line sock 'concat)))
|
|
||||||
marionette))
|
|
||||||
|
|
||||||
(test-assert "connect"
|
(test-assert "connect"
|
||||||
(let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
|
(let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
|
||||||
|
|
Loading…
Reference in New Issue