alioth/nixpkgs
3
0
Fork 0
forked from mirrors/nixpkgs
Code Releases 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 POSIX qw(dup2);
use FileHandle; use FileHandle;
use Cwd; use Cwd;
use File::Basename;
# Stuff our PID in the multicast address/port to prevent collissions # Stuff our PID in the multicast address/port to prevent collissions
@ -58,6 +59,7 @@ sub new {
socket => undef, socket => undef,
stateDir => "$tmpDir/vm-state-$name", stateDir => "$tmpDir/vm-state-$name",
monitor => undef, monitor => undef,
log => $args->{log},
}; };
mkdir $self->{stateDir}, 0700; mkdir $self->{stateDir}, 0700;
@ -69,8 +71,13 @@ sub new {
sub log { sub log {
my ($self, $msg) = @_; my ($self, $msg) = @_;
chomp $msg; $self->{log}->log($msg, { machine => $self->{name} });
print STDERR $self->{name}, ": $msg\n"; }
sub nest {
my ($self, $msg, $coderef, $attrs) = @_;
$self->{log}->nest($msg, $coderef, { %{$attrs || {}}, machine => $self->{name} });
} }
@ -146,7 +153,8 @@ sub start {
while (<$serialP>) { while (<$serialP>) {
chomp; chomp;
s/\r$//; 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) = @_; my ($self) = @_;
return if $self->{connected}; 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"; }; $self->start;
alarm 300;
readline $self->{socket} or die; local $SIG{ALRM} = sub { die "timed out waiting for the guest to connect\n"; };
alarm 0; alarm 300;
readline $self->{socket} or die;
alarm 0;
$self->log("connected to guest root shell"); $self->log("connected to guest root shell");
$self->{connected} = 1; $self->{connected} = 1;
});
} }
sub waitForShutdown { sub waitForShutdown {
my ($self) = @_; my ($self) = @_;
return unless $self->{booted}; return unless $self->{booted};
waitpid $self->{pid}, 0; $self->nest("waiting for the VM to power off", sub {
$self->{pid} = 0; waitpid $self->{pid}, 0;
$self->{booted} = 0; $self->{pid} = 0;
$self->{connected} = 0; $self->{booted} = 0;
$self->{connected} = 0;
});
} }
@ -243,13 +257,11 @@ sub isUp {
} }
sub execute { sub execute_ {
my ($self, $command) = @_; my ($self, $command) = @_;
$self->connect; $self->connect;
$self->log("running command: $command");
print { $self->{socket} } ("( $command ); echo '|!=EOF' \$?\n"); print { $self->{socket} } ("( $command ); echo '|!=EOF' \$?\n");
my $out = ""; 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 { sub succeed {
my ($self, @commands) = @_; my ($self, @commands) = @_;
my $res; my $res;
foreach my $command (@commands) { foreach my $command (@commands) {
my ($status, $out) = $self->execute($command); $self->nest("must succeed: $command", sub {
if ($status != 0) { my ($status, $out) = $self->execute_($command);
$self->log("output: $out"); if ($status != 0) {
die "command `$command' did not succeed (exit code $status)\n"; $self->log("output: $out");
} die "command `$command' did not succeed (exit code $status)\n";
$res .= $out; }
$res .= $out;
});
} }
return $res; return $res;
} }
@ -290,27 +316,33 @@ sub mustSucceed {
sub waitUntilSucceeds { sub waitUntilSucceeds {
my ($self, $command) = @_; my ($self, $command) = @_;
retry sub { $self->nest("waiting for success: $command", sub {
my ($status, $out) = $self->execute($command); retry sub {
return 1 if $status == 0; my ($status, $out) = $self->execute($command);
}; return 1 if $status == 0;
};
});
} }
sub waitUntilFails { sub waitUntilFails {
my ($self, $command) = @_; my ($self, $command) = @_;
retry sub { $self->nest("waiting for failure: $command", sub {
my ($status, $out) = $self->execute($command); retry sub {
return 1 if $status != 0; my ($status, $out) = $self->execute($command);
}; return 1 if $status != 0;
};
});
} }
sub fail { sub fail {
my ($self, $command) = @_; my ($self, $command) = @_;
my ($status, $out) = $self->execute($command); $self->nest("must fail: $command", sub {
die "command `$command' unexpectedly succeeded" my ($status, $out) = $self->execute_($command);
if $status == 0; die "command `$command' unexpectedly succeeded"
if $status == 0;
});
} }
@ -322,20 +354,24 @@ sub mustFail {
# Wait for an Upstart job to reach the "running" state. # Wait for an Upstart job to reach the "running" state.
sub waitForJob { sub waitForJob {
my ($self, $jobName) = @_; my ($self, $jobName) = @_;
retry sub { $self->nest("waiting for job ‘$jobName’", sub {
my ($status, $out) = $self->execute("initctl status $jobName"); retry sub {
return 1 if $out =~ /start\/running/; my ($status, $out) = $self->execute("initctl status $jobName");
}; return 1 if $out =~ /start\/running/;
};
});
} }
# Wait until the specified file exists. # Wait until the specified file exists.
sub waitForFile { sub waitForFile {
my ($self, $fileName) = @_; my ($self, $fileName) = @_;
retry sub { $self->nest("waiting for file ‘$fileName’", sub {
my ($status, $out) = $self->execute("test -e $fileName"); retry sub {
return 1 if $status == 0; my ($status, $out) = $self->execute("test -e $fileName");
} return 1 if $status == 0;
}
});
} }
sub startJob { sub startJob {
@ -356,10 +392,12 @@ sub stopJob {
# Wait until the machine is listening on the given TCP port. # Wait until the machine is listening on the given TCP port.
sub waitForOpenPort { sub waitForOpenPort {
my ($self, $port) = @_; my ($self, $port) = @_;
retry sub { $self->nest("waiting for TCP port $port", sub {
my ($status, $out) = $self->execute("nc -z localhost $port"); retry sub {
return 1 if $status == 0; 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("."); my $dir = $ENV{'out'} || Cwd::abs_path(".");
$filename = "$dir/${filename}.png" if $filename =~ /^\w+$/; $filename = "$dir/${filename}.png" if $filename =~ /^\w+$/;
my $tmp = "${filename}.ppm"; my $tmp = "${filename}.ppm";
$self->sendMonitorCommand("screendump $tmp"); my $name = basename($filename);
system("convert $tmp ${filename}") == 0 $self->nest("making screenshot ‘$name’", sub {
or die "cannot convert screenshot"; $self->sendMonitorCommand("screendump $tmp");
unlink $tmp; system("convert $tmp ${filename}") == 0
or die "cannot convert screenshot";
unlink $tmp;
}, { image => $name } );
} }
@ -471,7 +512,9 @@ sub sendKeys {
sub sendChars { sub sendChars {
my ($self, $chars) = @_; 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 Machine;
use Term::ReadLine; use Term::ReadLine;
use IO::File; use IO::File;
use XML::Writer; use Logger;
$SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly $SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly
STDERR->autoflush(1); STDERR->autoflush(1);
my $logFile = defined $ENV{LOGFILE} ? "$ENV{LOGFILE}" : "/dev/null"; my $log = new Logger;
my $log = new XML::Writer(OUTPUT => new IO::File(">$logFile"));
$log->startTag("logfile");
my %vms; my %vms;
@ -20,7 +18,7 @@ my $context = "";
sub createMachine { sub createMachine {
my ($args) = @_; my ($args) = @_;
my $vm = Machine->new($args); my $vm = Machine->new({%{$args}, log => $log});
$vms{$vm->name} = $vm; $vms{$vm->name} = $vm;
return $vm; return $vm;
} }
@ -32,7 +30,9 @@ foreach my $vmScript (@ARGV) {
sub startAll { 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 { sub runTests {
if (defined $ENV{tests}) { if (defined $ENV{tests}) {
eval "$context $ENV{tests}"; eval "$context $ENV{tests}";
@ -77,6 +91,10 @@ sub runTests {
# Copy all the *.gcda files. # 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"); $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 { END {
foreach my $vm (values %vms) { foreach my $vm (values %vms) {
if ($vm->{pid}) { if ($vm->{pid}) {
print STDERR "killing ", $vm->{name}, " (pid ", $vm->{pid}, ")\n"; $log->log("killing " . $vm->{name} . " (pid " . $vm->{pid} . ")");
kill 9, $vm->{pid}; kill 9, $vm->{pid};
} }
} }
$log->endTag("logfile"); $log->close();
$log->end;
} }

1
lib/testing.nix
View file

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

66
tests/login.nix
View file

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