From cb29343940dfffe8863c0a6b1e2b3494c7836b53 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Mon, 30 Jul 2018 22:50:16 -0700 Subject: marionette: Add wait-for-unix-socket. * gnu/build/marionette.scm (wait-for-unix-socket): New variable. --- gnu/build/marionette.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gnu/build') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 61284b8980..f94eab5cc0 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,7 @@ (define-module (gnu build marionette) marionette-eval wait-for-file wait-for-tcp-port + wait-for-unix-socket marionette-control marionette-screen-text wait-for-screen-text @@ -214,6 +216,29 @@ (define* (wait-for-tcp-port port marionette ('failure (error "nobody's listening on port" port)))) +(define* (wait-for-unix-socket file-name marionette + #:key (timeout 20)) + "Wait for up to TIMEOUT seconds for FILE-NAME, a Unix domain socket, to +accept connections in MARIONETTE. Raise an error on failure." + (match (marionette-eval + `(begin + (let ((sock (socket PF_UNIX SOCK_STREAM 0))) + (let loop ((i 0)) + (catch 'system-error + (lambda () + (connect sock AF_UNIX ,file-name) + 'success) + (lambda args + (if (< i ,timeout) + (begin + (sleep 1) + (loop (+ 1 i))) + 'failure)))))) + marionette) + ('success #t) + ('failure + (error "nobody's listening on unix domain socket" file-name)))) + (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) -- cgit v1.2.3