ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

marionette: Add 'wait-for-tcp-port'.

Browse source 
* 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:
Ludovic Courtès 2018-06-01 10:01:05 +02:00
parent 5ede50b850
commit 7a4e2eaab3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 29 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gnu/build/marionette.scm
View file

@ -26,6 +26,7 @@ (define-module (gnu build marionette)
make-marionette
marionette-eval
wait-for-file
wait-for-tcp-port
marionette-control
marionette-screen-text
wait-for-screen-text
@ -187,6 +188,32 @@ (define* (wait-for-file file marionette
('failure
(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)
"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)

19
gnu/tests/dict.scm
View file

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -96,22 +96,7 @@ (define %dico-socket
;; Wait until dicod is actually listening.
;; TODO: Use a PID file instead.
(test-assert "connect inside"
(marionette-eval
'(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))
(wait-for-tcp-port 2628 marionette))
(test-assert "connect"
(let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))