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.master
Ludovic Courtès
parent
d782de172c
commit
5fa7cc5335
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue