dev/nixpkgs
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

* Improved logging in the test driver.

Browse Source 
* Support subtests.

svn path=/nixos/trunk/; revision=25451
This commit is contained in:
Eelco Dolstra 2011-01-06 17:28:35 +00:00
parent f2a0929116
commit e343a16a36
5 changed files with 229 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
lib/test-driver/Logger.pm Normal file
View File

@ -0,0 +1,68 @@
package Logger;
use strict;
use Thread::Queue;
use XML::Writer;
sub new {
my ($class) = @_;
my $logFile = defined $ENV{LOGFILE} ? "$ENV{LOGFILE}" : "/dev/null";
my $log = new XML::Writer(OUTPUT => new IO::File(">$logFile"));
my $self = {
log => $log,
logQueue => Thread::Queue->new()
};
$self->{log}->startTag("logfile");
bless $self, $class;
return $self;
}
sub close {
my ($self) = @_;
$self->{log}->endTag("logfile");
$self->{log}->end;
}
sub drainLogQueue {
my ($self) = @_;
while (defined (my $item = $self->{logQueue}->dequeue_nb())) {
$self->{log}->dataElement("line", sanitise($item->{msg}), 'machine' => $item->{machine}, 'type' => 'serial');
}
}
sub maybePrefix {
my ($msg, $attrs) = @_;
$msg = $attrs->{machine} . ": " . $msg if defined $attrs->{machine};
return $msg;
}
sub nest {
my ($self, $msg, $coderef, $attrs) = @_;
print STDERR maybePrefix("$msg\n", $attrs);
$self->{log}->startTag("nest");
$self->{log}->dataElement("head", $msg, %{$attrs});
$self->drainLogQueue();
&$coderef;
$self->drainLogQueue();
$self->{log}->endTag("nest");
}
sub sanitise {
my ($s) = @_;
$s =~ s/[[:cntrl:]\xff]//g;
return $s;
}
sub log {
my ($self, $msg, $attrs) = @_;
chomp $msg;
print STDERR maybePrefix("$msg\n", $attrs);
$self->drainLogQueue();
$self->{log}->dataElement("line", $msg, %{$attrs});
}
1;

147
lib/test-driver/Machine.pm
View File

@ -7,6 +7,7 @@ use IO::Handle;
use POSIX qw(dup2);
use FileHandle;
use Cwd;
use File::Basename;
# Stuff our PID in the multicast address/port to prevent collissions
@ -58,6 +59,7 @@ sub new {
socket => undef,
stateDir => "$tmpDir/vm-state-$name",
monitor => undef,
log => $args->{log},
};
mkdir $self->{stateDir}, 0700;
@ -69,8 +71,13 @@ sub new {
sub log {
my ($self, $msg) = @_;
chomp $msg;
print STDERR $self->{name}, ": $msg\n";
$self->{log}->log($msg, { machine => $self->{name} });
}
sub nest {
my ($self, $msg, $coderef, $attrs) = @_;
$self->{log}->nest($msg, $coderef, { %{$attrs || {}}, machine => $self->{name} });
}
@ -146,7 +153,8 @@ sub start {
while (<$serialP>) {
chomp;
s/\r$//;
print STDERR $self->name, "# $_\n";
print STDERR $self->{name}, "# $_\n";
$self->{log}->{logQueue}->enqueue({msg => $_, machine => $self->{name}}); # !!!
}
}
@ -214,26 +222,32 @@ sub connect {
my ($self) = @_;
return if $self->{connected};
$self->start;
$self->nest("waiting for the VM to finish booting", sub {
local $SIG{ALRM} = sub { die "timed out waiting for the guest to connect\n"; };
alarm 300;
readline $self->{socket} or die;
alarm 0;
$self->start;
local $SIG{ALRM} = sub { die "timed out waiting for the guest to connect\n"; };
alarm 300;
readline $self->{socket} or die;
alarm 0;
$self->log("connected to guest root shell");
$self->{connected} = 1;
$self->log("connected to guest root shell");
$self->{connected} = 1;
});
}
sub waitForShutdown {
my ($self) = @_;
return unless $self->{booted};
waitpid $self->{pid}, 0;
$self->{pid} = 0;
$self->{booted} = 0;
$self->{connected} = 0;
$self->nest("waiting for the VM to power off", sub {
waitpid $self->{pid}, 0;
$self->{pid} = 0;
$self->{booted} = 0;
$self->{connected} = 0;
});
}
@ -243,13 +257,11 @@ sub isUp {
}
sub execute {
sub execute_ {
my ($self, $command) = @_;
$self->connect;
$self->log("running command: $command");
print { $self->{socket} } ("( $command ); echo '|!=EOF' \$?\n");
my $out = "";
@ -268,17 +280,31 @@ sub execute {
}
sub execute {
my ($self, $command) = @_;
my @res;
$self->nest("running command: $command", sub {
@res = $self->execute_($command);
});
return @res;
}
sub succeed {
my ($self, @commands) = @_;
my $res;
foreach my $command (@commands) {
my ($status, $out) = $self->execute($command);
if ($status != 0) {
$self->log("output: $out");
die "command `$command' did not succeed (exit code $status)\n";
}
$res .= $out;
$self->nest("must succeed: $command", sub {
my ($status, $out) = $self->execute_($command);
if ($status != 0) {
$self->log("output: $out");
die "command `$command' did not succeed (exit code $status)\n";
}
$res .= $out;
});
}
return $res;
}
@ -290,27 +316,33 @@ sub mustSucceed {
sub waitUntilSucceeds {
my ($self, $command) = @_;
retry sub {
my ($status, $out) = $self->execute($command);
return 1 if $status == 0;
};
$self->nest("waiting for success: $command", sub {
retry sub {
my ($status, $out) = $self->execute($command);
return 1 if $status == 0;
};
});
}
sub waitUntilFails {
my ($self, $command) = @_;
retry sub {
my ($status, $out) = $self->execute($command);
return 1 if $status != 0;
};
$self->nest("waiting for failure: $command", sub {
retry sub {
my ($status, $out) = $self->execute($command);
return 1 if $status != 0;
};
});
}
sub fail {
my ($self, $command) = @_;
my ($status, $out) = $self->execute($command);
die "command `$command' unexpectedly succeeded"
if $status == 0;
$self->nest("must fail: $command", sub {
my ($status, $out) = $self->execute_($command);
die "command `$command' unexpectedly succeeded"
if $status == 0;
});
}
@ -322,20 +354,24 @@ sub mustFail {
# Wait for an Upstart job to reach the "running" state.
sub waitForJob {
my ($self, $jobName) = @_;
retry sub {
my ($status, $out) = $self->execute("initctl status $jobName");
return 1 if $out =~ /start\/running/;
};
$self->nest("waiting for job ‘$jobName’", sub {
retry sub {
my ($status, $out) = $self->execute("initctl status $jobName");
return 1 if $out =~ /start\/running/;
};
});
}
# Wait until the specified file exists.
sub waitForFile {
my ($self, $fileName) = @_;
retry sub {
my ($status, $out) = $self->execute("test -e $fileName");
return 1 if $status == 0;
}
$self->nest("waiting for file ‘$fileName’", sub {
retry sub {
my ($status, $out) = $self->execute("test -e $fileName");
return 1 if $status == 0;
}
});
}
sub startJob {
@ -356,10 +392,12 @@ sub stopJob {
# Wait until the machine is listening on the given TCP port.
sub waitForOpenPort {
my ($self, $port) = @_;
retry sub {
my ($status, $out) = $self->execute("nc -z localhost $port");
return 1 if $status == 0;
}
$self->nest("waiting for TCP port $port", sub {
retry sub {
my ($status, $out) = $self->execute("nc -z localhost $port");
return 1 if $status == 0;
}
});
}
@ -415,10 +453,13 @@ sub screenshot {
my $dir = $ENV{'out'} || Cwd::abs_path(".");
$filename = "$dir/${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;
my $name = basename($filename);
$self->nest("making screenshot ‘$name’", sub {
$self->sendMonitorCommand("screendump $tmp");
system("convert $tmp ${filename}") == 0
or die "cannot convert screenshot";
unlink $tmp;
}, { image => $name } );
}
@ -471,7 +512,9 @@ sub sendKeys {
sub sendChars {
my ($self, $chars) = @_;
$self->sendKeys(split //, $chars);
$self->nest("sending keys ‘$chars’", sub {
$self->sendKeys(split //, $chars);
});
}

35
lib/test-driver/test-driver.pl
View File

@ -4,15 +4,13 @@ use strict;
use Machine;
use Term::ReadLine;
use IO::File;
use XML::Writer;
use Logger;
$SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly
STDERR->autoflush(1);
my $logFile = defined $ENV{LOGFILE} ? "$ENV{LOGFILE}" : "/dev/null";
my $log = new XML::Writer(OUTPUT => new IO::File(">$logFile"));
$log->startTag("logfile");
my $log = new Logger;
my %vms;
@ -20,7 +18,7 @@ my $context = "";
sub createMachine {
my ($args) = @_;
my $vm = Machine->new($args);
my $vm = Machine->new({%{$args}, log => $log});
$vms{$vm->name} = $vm;
return $vm;
}
@ -32,7 +30,9 @@ foreach my $vmScript (@ARGV) {
sub startAll {
$_->start foreach values %vms;
$log->nest("starting all VMs", sub {
$_->start foreach values %vms;
});
}
@ -44,6 +44,20 @@ sub testScript {
}
my $nrTests = 0;
my $nrSucceeded = 0;
sub subtest {
my ($name, $coderef) = @_;
$log->nest("subtest: $name", sub {
$nrTests++;
&$coderef;
$nrSucceeded++;
});
}
sub runTests {
if (defined $ENV{tests}) {
eval "$context $ENV{tests}";
@ -77,6 +91,10 @@ sub runTests {
# Copy all the *.gcda files.
$vm->execute("for d in $gcovDir/nix/store/*/.build/linux-*; do for i in \$(cd \$d && find -name '*.gcda'); do echo \$i; mkdir -p $coverageDir/\$(dirname \$i); cp -v \$d/\$i $coverageDir/\$i; done; done");
}
if ($nrTests != 0) {
#$log->dataElement("line", "$nrSucceeded out of $nrTests tests succeeded");
}
}
@ -92,12 +110,11 @@ sub createDisk {
END {
foreach my $vm (values %vms) {
if ($vm->{pid}) {
print STDERR "killing ", $vm->{name}, " (pid ", $vm->{pid}, ")\n";
$log->log("killing " . $vm->{name} . " (pid " . $vm->{pid} . ")");
kill 9, $vm->{pid};
}
}
$log->endTag("logfile");
$log->end;
$log->close();
}

1
lib/testing.nix
View File

@ -24,6 +24,7 @@ rec {
libDir=$out/lib/perl5/site_perl
mkdir -p $libDir
cp ${./test-driver/Machine.pm} $libDir/Machine.pm
cp ${./test-driver/Logger.pm} $libDir/Logger.pm
wrapProgram $out/bin/nixos-test-driver \
--prefix PATH : "${imagemagick}/bin" \

66
tests/login.nix
View File

@ -6,43 +6,55 @@
testScript =
''
$machine->mustSucceed("useradd -m alice");
$machine->mustSucceed("(echo foobar; echo foobar) | passwd alice");
subtest "create user", sub {
$machine->succeed("useradd -m alice");
$machine->succeed("(echo foobar; echo foobar) | passwd alice");
};
# Log in as alice on a virtual console.
$machine->waitForJob("tty1");
$machine->sendChars("alice\n");
$machine->waitUntilSucceeds("pgrep login");
$machine->execute("sleep 2"); # urgh: wait for `Password:'
$machine->sendChars("foobar\n");
$machine->waitUntilSucceeds("pgrep -u alice bash");
$machine->sendChars("touch done\n");
$machine->waitForFile("/home/alice/done");
# Log in as alice on a virtual console.
subtest "virtual console login", sub {
$machine->waitForJob("tty1");
$machine->sendChars("alice\n");
$machine->waitUntilSucceeds("pgrep login");
$machine->execute("sleep 2"); # urgh: wait for `Password:'
$machine->sendChars("foobar\n");
$machine->waitUntilSucceeds("pgrep -u alice bash");
$machine->sendChars("touch done\n");
$machine->waitForFile("/home/alice/done");
};
# Check whether switching VTs works.
$machine->sendKeys("alt-f10");
$machine->waitUntilSucceeds("[ \$(fgconsole) = 10 ]");
$machine->execute("sleep 2"); # allow fbcondecor to catch up (not important)
$machine->screenshot("syslog");
subtest "virtual console switching", sub {
$machine->sendKeys("alt-f10");
$machine->waitUntilSucceeds("[ \$(fgconsole) = 10 ]");
$machine->execute("sleep 2"); # allow fbcondecor to catch up (not important)
$machine->screenshot("syslog");
};
# Check whether ConsoleKit/udev gives and removes device
# ownership as needed.
$machine->mustSucceed("chvt 1");
$machine->execute("sleep 1"); # urgh
$machine->mustSucceed("getfacl /dev/snd/timer | grep -q alice");
$machine->mustSucceed("chvt 2");
$machine->execute("sleep 1"); # urgh
$machine->mustFail("getfacl /dev/snd/timer | grep -q alice");
subtest "device permissions", sub {
$machine->succeed("chvt 1");
$machine->execute("sleep 1"); # urgh
$machine->succeed("getfacl /dev/snd/timer | grep -q alice");
$machine->succeed("chvt 2");
$machine->execute("sleep 1"); # urgh
$machine->fail("getfacl /dev/snd/timer | grep -q alice");
};
# Log out.
$machine->mustSucceed("chvt 1");
$machine->sendChars("exit\n");
$machine->waitUntilFails("pgrep -u alice bash");
$machine->screenshot("mingetty");
subtest "virtual console logout", sub {
$machine->succeed("chvt 1");
$machine->sendChars("exit\n");
$machine->waitUntilFails("pgrep -u alice bash");
$machine->screenshot("mingetty");
};
# Check whether ctrl-alt-delete works.
$machine->sendKeys("ctrl-alt-delete");
$machine->waitForShutdown;
subtest "ctrl-alt-delete", sub {
$machine->sendKeys("ctrl-alt-delete");
$machine->waitForShutdown;
};
'';
}