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

marionette: Add wait-for-unix-socket.

Browse source 
* gnu/build/marionette.scm (wait-for-unix-socket): New variable.
This commit is contained in:
Chris Marusich 2018-07-30 22:50:16 -07:00
parent 4dd53a83b5
commit cb29343940
No known key found for this signature in database
GPG key ID: DD409A15D822469D
1 changed files with 25 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
gnu/build/marionette.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; 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)