diff options
| -rw-r--r-- | lib/test-driver/Logger.pm | 68 | ||||
| -rw-r--r-- | lib/test-driver/Machine.pm | 147 | ||||
| -rw-r--r-- | lib/test-driver/test-driver.pl | 35 | ||||
| -rw-r--r-- | lib/testing.nix | 1 | ||||
| -rw-r--r-- | tests/login.nix | 66 |
5 files changed, 229 insertions, 88 deletions
diff --git a/lib/test-driver/Logger.pm b/lib/test-driver/Logger.pm new file mode 100644 index 00000000000..b2d31b8820f --- /dev/null +++ b/lib/test-driver/Logger.pm @@ -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; diff --git a/lib/test-driver/Machine.pm b/lib/test-driver/Machine.pm index abf08c7fcf2..e540da7b1c5 100644 --- a/lib/test-driver/Machine.pm +++ b/lib/test-driver/Machine.pm @@ -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); + }); } diff --git a/lib/test-driver/test-driver.pl b/lib/test-driver/test-driver.pl index 77df6cd2bd2..db92a951b16 100644 --- a/lib/test-driver/test-driver.pl +++ b/lib/test-driver/test-driver.pl @@ -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(); } diff --git a/lib/testing.nix b/lib/testing.nix index 4d1c389de48..f02d4de251c 100644 --- a/lib/testing.nix +++ b/lib/testing.nix @@ -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" \ diff --git a/tests/login.nix b/tests/login.nix index c4524612295..944d9932fcc 100644 --- a/tests/login.nix +++ b/tests/login.nix @@ -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; + }; ''; } |