marionette: Avoid use of SIGALRM for timeouts.

* gnu/build/marionette.scm (make-marionette)[accept*]: New procedures.
Remove calls to 'sigaction'.  Use 'accept*' instead of 'accept'.
This commit is contained in:
Ludovic Courtès 2016-11-22 22:57:41 +01:00
parent 106b389e52
commit ad17470551
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 9 additions and 8 deletions

View File

@ -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)))))))))))