marionette: Factorize 'wait-for-file'.

* gnu/build/marionette.scm (wait-for-file): New procedure.
* gnu/tests/base.scm (run-mcron-test)[test](wait-for-file): Remove.
Pass second argument in 'wait-for-file' calls.
* gnu/tests/ssh.scm (run-ssh-test)[test](wait-for-file): Remove.
Pass second argument in 'wait-for-file' calls.
* gnu/tests/messaging.scm (run-xmpp-test)[test](guest-wait-for-file):
Remove.
Use 'wait-for-file' instead, with second argument.

4 files changed, 23 insertions, 50 deletions

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 506d6da420a..424f2b6713e 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.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)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index f5bbfafee35..8389b67f68f 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -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)))))
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index cefb52534ac..b76b8e84341 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -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)))
 
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 5f061510818..9c83a9cd481 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -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.