* In the test driver, connect to the QEMU monitor so that we can send

it special commands such as "screendump", "sendkey" and so on.
* Take screenshots using the "screendump" command.  This has the
  advantage over "scrot" that it also supports taking a picture of the
  console, and is not affected by weird X visuals.

svn path=/nixos/trunk/; revision=19837
This commit is contained in:
Eelco Dolstra 2010-02-05 16:51:37 +00:00
parent 5b60c280d7
commit fc805fe541
2 changed files with 58 additions and 15 deletions

View File

@ -48,6 +48,7 @@ sub new {
connectedQueue => Thread::Queue->new(),
socket => undef,
stateDir => "$tmpDir/$name",
monitor => undef,
};
mkdir $self->{stateDir}, 0700;
@ -82,33 +83,50 @@ sub start {
$self->log("starting vm");
my ($read, $write) = FileHandle::pipe;
# Create a socket pair for the serial line input/output of the VM.
my ($serialP, $serialC);
socketpair($serialP, $serialC, PF_UNIX, SOCK_STREAM, 0) or die;
# Create a Unix domain socket to which QEMU's monitor will connect.
my $monitorPath = $self->{stateDir} . "/monitor";
unlink $monitorPath;
my $monitorS;
socket($monitorS, PF_UNIX, SOCK_STREAM, 0) or die;
bind($monitorS, sockaddr_un($monitorPath)) or die "cannot bind monitor socket: $!";
listen($monitorS, 1) or die;
# Start the VM.
my $pid = fork();
die if $pid == -1;
if ($pid == 0) {
close $read;
dup2(fileno($write), fileno(STDOUT));
dup2(fileno($write), fileno(STDERR));
close $serialP;
close $monitorS;
open NUL, "</dev/null" or die;
dup2(fileno(NUL), fileno(STDIN));
dup2(fileno($serialC), fileno(STDOUT));
dup2(fileno($serialC), fileno(STDERR));
$ENV{TMPDIR} = $self->{stateDir};
$ENV{QEMU_OPTS} = "-nographic -no-reboot -redir tcp:65535::514 -net nic,vlan=1 -net socket,vlan=1,mcast=$mcastAddr";
$ENV{QEMU_OPTS} = "-nographic -no-reboot -redir tcp:65535::514 -net nic,vlan=1 -net socket,vlan=1,mcast=$mcastAddr -monitor unix:./monitor";
$ENV{QEMU_KERNEL_PARAMS} = "hostTmpDir=$ENV{TMPDIR}";
chdir $self->{stateDir} or die;
exec $self->{startCommand};
die;
}
close $write;
# Wait until QEMU connects to the monitor.
accept($self->{monitor}, $monitorS) or die;
$self->waitForMonitorPrompt;
threads->create(\&processQemuOutput, $self, $read)->detach;
# Process serial line output.
close $serialC;
sub processQemuOutput {
my ($self, $read) = @_;
threads->create(\&processSerialOutput, $self, $serialP)->detach;
sub processSerialOutput {
my ($self, $serialP) = @_;
$/ = "\r\n";
while (<$read>) {
while (<$serialP>) {
chomp;
print STDERR $self->name, "# $_\n";
$self->{connectedQueue}->enqueue(1) if $_ eq "===UP===";
@ -123,6 +141,29 @@ sub start {
}
# Send a command to the monitor and wait for it to finish. TODO: QEMU
# also has a JSON-based monitor interface now, but it doesn't support
# all commands yet. We should use it once it does.
sub sendMonitorCommand {
my ($self, $command) = @_;
syswrite $self->{monitor}, "$command\n";
return $self->waitForMonitorPrompt;
}
# Wait until the monitor sends "(qemu) ".
sub waitForMonitorPrompt {
my ($self) = @_;
my $res = "";
my $s;
while (sysread($self->{monitor}, $s, 1024)) {
$res .= $s;
last if $res =~ s/\(qemu\) $//;
}
return $res;
}
# Call the given code reference repeatedly, with 1 second intervals,
# until it returns 1 or a timeout is reached.
sub retry {
@ -310,8 +351,12 @@ sub unblock {
# Take a screenshot of the X server on :0.0.
sub screenshot {
my ($self, $filename) = @_;
my $scrot = $ENV{'scrot'} or die;
$self->mustSucceed("$scrot /hostfs/$ENV{out}/${filename}.png");
$filename = "$ENV{'out'}/${filename}.png" if $filename =~ /^\w+$/;
my $tmp = "${filename}.ppm";
$self->sendMonitorCommand("screendump $tmp");
system("convert $tmp ${filename}") == 0
or die "cannot convert screenshot";
unlink $tmp;
}

View File

@ -15,9 +15,7 @@ rec {
name = "vm-test-run";
inherit tests;
scrot = "${pkgs.scrot}/bin/scrot";
buildInputs = [ pkgs.qemu_kvm ];
buildInputs = [ pkgs.qemu_kvm pkgs.imagemagick ];
buildCommand =
''