4 files changed, 23 insertions(+), 50 deletions(-)

M gnu/build/marionette.scm
M gnu/tests/base.scm
M gnu/tests/messaging.scm
M gnu/tests/ssh.scm

@@ 1,5 1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;


@@ 25,6 25,7 @@
   #:export (marionette?
             make-marionette
             marionette-eval
+            wait-for-file
             marionette-control
             marionette-screen-text
             wait-for-screen-text


@@ 164,6 165,20 @@ QEMU monitor and to the guest's backdoor REPL."
      (newline repl)
      (read repl))))
 
+(define* (wait-for-file file marionette #:key (timeout 10))
+  "Wait until FILE exists in MARIONETTE; 'read' its content and return it.  If
+FILE has not shown up after TIMEOUT seconds, raise an error."
+  (marionette-eval
+   `(let loop ((i ,timeout))
+      (cond ((file-exists? ,file)
+             (call-with-input-file ,file read))
+            ((> i 0)
+             (sleep 1)
+             (loop (- i 1)))
+            (else
+             (error "file didn't show up" ,file))))
+   marionette))
+
 (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)

@@ 446,20 446,6 @@ functionality tests.")
             (define marionette
               (make-marionette (list #$command)))
 
-            (define (wait-for-file file)
-              ;; Wait until FILE exists in the guest; 'read' its content and
-              ;; return it.
-              (marionette-eval
-               `(let loop ((i 10))
-                  (cond ((file-exists? ,file)
-                         (call-with-input-file ,file read))
-                        ((> i 0)
-                         (sleep 1)
-                         (loop (- i 1)))
-                        (else
-                         (error "file didn't show up" ,file))))
-               marionette))
-
             (mkdir #$output)
             (chdir #$output)
 


@@ 478,12 464,12 @@ functionality tests.")
             ;; runs with the right UID/GID.
             (test-equal "root's job"
               '(0 0)
-              (wait-for-file "/root/witness"))
+              (wait-for-file "/root/witness" marionette))
 
             ;; Likewise for Alice's job.  We cannot know what its GID is since
             ;; it's chosen by 'groupadd', but it's strictly positive.
             (test-assert "alice's job"
-              (match (wait-for-file "/home/alice/witness")
+              (match (wait-for-file "/home/alice/witness" marionette)
                 ((1000 gid)
                  (>= gid 100))))
 


@@ 492,7 478,7 @@ functionality tests.")
             ;; that don't have a read syntax, hence the string.)
             (test-equal "root's job with command"
               "#<eof>"
-              (wait-for-file "/root/witness-touch"))
+              (wait-for-file "/root/witness-touch" marionette))
 
             (test-end)
             (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

@@ 80,21 80,6 @@
                                                     (number->string #$port)
                                                     "-:5222"))))
 
-            (define (guest-wait-for-file file)
-              ;; Wait until FILE exists in the guest; 'read' its content and
-              ;; return it.
-              (marionette-eval
-               `(let loop ((i 10))
-                  (cond ((file-exists? ,file)
-                         (call-with-input-file ,file read))
-                        ((> i 0)
-                         (begin
-                           (sleep 1))
-                         (loop (- i 1)))
-                        (else
-                         (error "file didn't show up" ,file))))
-               marionette))
-
             (define (host-wait-for-file file)
               ;; Wait until FILE exists in the host.
               (let loop ((i 60))


@@ 124,7 109,8 @@
 
             ;; Check XMPP service's PID.
             (test-assert "service process id"
-              (let ((pid (number->string (guest-wait-for-file #$pid-file))))
+              (let ((pid (number->string (wait-for-file #$pid-file
+                                                        marionette))))
                 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
                                  marionette)))
 

@@ 69,20 69,6 @@ When SFTP? is true, run an SFTP server test."
               (make-marionette (list #$command "-net"
                                      "user,hostfwd=tcp::2222-:22")))
 
-            (define (wait-for-file file)
-              ;; Wait until FILE exists in the guest; 'read' its content and
-              ;; return it.
-              (marionette-eval
-               `(let loop ((i 10))
-                  (cond ((file-exists? ,file)
-                         (call-with-input-file ,file read))
-                        ((> i 0)
-                         (sleep 1)
-                         (loop (- i 1)))
-                        (else
-                         (error "file didn't show up" ,file))))
-               marionette))
-
             (define (make-session-for-test)
               "Make a session with predefined parameters for a test."
               (make-session #:user "root"


@@ 141,7 127,7 @@ root with an empty password."
 
             ;; Check sshd's PID file.
             (test-equal "sshd PID"
-              (wait-for-file #$pid-file)
+              (wait-for-file #$pid-file marionette)
               (marionette-eval
                '(begin
                   (use-modules (gnu services herd)


@@ 166,7 152,7 @@ root with an empty password."
                    (channel-open-session channel)
                    (channel-request-exec channel "echo hello > /root/witness")
                    (and (zero? (channel-get-exit-status channel))
-                        (wait-for-file "/root/witness"))))))
+                        (wait-for-file "/root/witness" marionette))))))
 
             ;; Connect to the guest over SFTP.  Make sure we can write and
             ;; read a file there.