04/06: marionette: Avoid use of SIGALRM for timeouts.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit ad17470551d3e7fdc8e91930d37716e136b1080d
Author: Ludovic Courtès <address@hidden>
Date:   Tue Nov 22 22:57:41 2016 +0100

    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'.
---
 gnu/build/marionette.scm |   17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 9399c55..d36e1c8 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)))))))))))