From 5fa7cc5335d64a790d7f0f784a11b25b040cc443 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jun 2017 23:21:24 +0200 Subject: 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. --- gnu/build/marionette.scm | 17 ++++++++++++++++- gnu/tests/base.scm | 20 +++----------------- gnu/tests/messaging.scm | 18 ++---------------- gnu/tests/ssh.scm | 18 ++---------------- 4 files changed, 23 insertions(+), 50 deletions(-) (limited to 'gnu') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 506d6da420..424f2b6713 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 +;;; Copyright © 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +25,7 @@ (define-module (gnu build marionette) #:export (marionette? make-marionette marionette-eval + wait-for-file marionette-control marionette-screen-text wait-for-screen-text @@ -164,6 +165,20 @@ (define (marionette-eval exp marionette) (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 f5bbfafee3..8389b67f68 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -446,20 +446,6 @@ (define test (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 @@ (define (wait-for-file file) ;; 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 @@ (define (wait-for-file file) ;; that don't have a read syntax, hence the string.) (test-equal "root's job with command" "#" - (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 cefb52534a..b76b8e8434 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -80,21 +80,6 @@ (define marionette (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 @@ (define (host-wait-for-file file) ;; 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 5f06151081..9c83a9cd48 100644 --- a/gnu/tests/ssh.scm +++ b/gnu/tests/ssh.scm @@ -69,20 +69,6 @@ (define marionette (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 @@ (define (call-with-connected-session/auth proc) ;; 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 @@ (define (call-with-connected-session/auth proc) (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. -- cgit v1.2.3