diff options
| -rw-r--r-- | gnu/build/marionette.scm | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 9399c55313..d36e1c8d09 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -93,6 +93,13 @@ QEMU monitor and to the guest's backdoor REPL." "-device" "virtio-serial" "-device" "virtconsole,chardev=repl")) + (define (accept* port) + (match (select (list port) '() (list port) timeout) + (((port) () ()) + (accept port)) + (_ + (error "timeout in 'accept'" port)))) + (let ((monitor (socket AF_UNIX SOCK_STREAM 0)) (repl (socket AF_UNIX SOCK_STREAM 0))) (bind monitor (file->sockaddr "monitor")) @@ -117,26 +124,20 @@ QEMU monitor and to the guest's backdoor REPL." (primitive-exit 1)))) (pid (format #t "QEMU runs as PID ~a~%" pid) - (sigaction SIGALRM - (lambda (signum) - (display "time is up!\n") ;FIXME: break - #t)) - (alarm timeout) - (match (accept monitor) + (match (accept* monitor) ((monitor-conn . _) (display "connected to QEMU's monitor\n") (close-port monitor) (wait-for-monitor-prompt monitor-conn) (display "read QEMU monitor prompt\n") - (match (accept repl) + (match (accept* repl) ((repl-conn . addr) (display "connected to guest REPL\n") (close-port repl) (match (read repl-conn) ('ready (alarm 0) - (sigaction SIGALRM SIG_DFL) (display "marionette is ready\n") (marionette (append command extra-options) pid monitor-conn repl-conn))))))))))) |