Commit 37efc78c authored by Kevin Tew's avatar Kevin Tew

ImageTests

parent 53f96eaf
ImageTest
ImageTest - Traffic Generation
OldTests
Cleanup SSH
Retry Prep
Painpoints
=================================
Teststeps - don't run certian parts create, swapin, run, swapout, end,
implemented for parallel tests
Teststeps - don't run certian parts create, swapin, run, swapout, end, implemented for parallel tests
Testlayout - Suites and Tests
Testoutput -
......@@ -16,13 +16,9 @@ TODO
TIMEOUT of XMLRPC Calls
TESTLWP
scp cleanup
chmod +x
cmdline params (-D)
VERBOSENESS
Add basic image-test parameterization examples
EXAMPLES, Get some tests
traffic generation
convert more old tests
STILL MESSY
XMLRPC/Client/Experiment TestSuite/Experiment dsl
......@@ -36,7 +32,6 @@ LATER
test groupings
Large External Tars and Resources for experiements
buildup, teardown using Test::Class
create BSD virtual machine for testing
Parallel TODOS
clean up FFF, Roles, constructors
......
......@@ -61,7 +61,7 @@ sub successful { ! shift->has_errors;}
sub sorted_results {
return map { $_->result } (sort { $a->itemid <=> $b->itemid } @{shift->successes});
}
sub handle_result {
sub handleResult {
my ($self, $result) = @_;
if ( $result->is_error ) { $self->push_error($result); }
else { $self->push_success($result); }
......@@ -74,6 +74,7 @@ use Mouse;
has 'result' => ( is => 'rw');
has 'error' => ( is => 'rw');
has 'itemid' => ( is => 'rw');
has 'name' => ( is => 'rw');
sub is_error { shift->error; }
......@@ -163,8 +164,8 @@ sub process_select {
eval {
for my $r ($selector->can_read($self->selecttimeout)) {
my ($rh, $wh, $eof, $ch) = @$r;
if (defined (my $result = $ch->receive)) {
$self->handleResult($result);
if (defined (my $itemResult = $ch->receive)) {
$self->handleItemResult($itemResult);
unless ( $eof ) {
if( my $jobid = $self->nextJob ) {
......@@ -228,8 +229,8 @@ sub fffork {
}
sub doItem { die "HAVE TO IMPLEMENT doItem"; }
sub handleResult { recordResult(@_); }
sub recordResult { shift->results->handle_result(shift); }
sub handleItemResult { recordItemResult(@_); }
sub recordItemResult { shift->results->handleResult(shift); }
sub schedule { 0; }
package TestBed::ForkFramework::ForEach;
......@@ -423,13 +424,14 @@ use TestBed::ParallelRunner::ErrorConstants;
sub return_and_report {
my ($s, $result) = @_;
$s->recordResult($result);
$s->recordItemResult($result);
$s->return_node_resources($s->task($result->itemid));
}
sub handleResult {
sub handleItemResult {
my ($s, $result) = @_;
my $executor = $s->tasks->[$result->itemid]->item;
$result->name($executor->e->eid);
if ($executor->can('handleResult')) {
my $rc = $executor->handleResult($s, $result);
if ($rc == RETURN_AND_REPORT) { $s->return_and_report($result) }
......
......@@ -58,6 +58,10 @@ sub runtests {
$concurrent_pre_runs ||= $TBConfig::concurrent_prerun_jobs;
$concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
if ( $TBConfig::single ) {
$Executors = [ (grep { $_->e->eid eq $TBConfig::single } @$Executors) ];
}
#prerun step
my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prep }, $Executors);
if ($result->has_errors) {
......
......@@ -105,25 +105,31 @@ sub prep {
sub checkno {
my $stage = shift;
return grep { $_ = $stage } @{ $TBConfig::exclude_steps };
return grep { $_ eq $stage } @{ $TBConfig::exclude_steps };
}
sub execute {
my $s = shift;
my $e = $s->e;
my $run_exception;
my $swapout_exception;
eval { $e->swapin_wait; } unless checkno('swapin');
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $@;
my $swapin_exception = $@;
eval { $s->proc->($e); } unless checkno('run');
my $run_exception = $@;
unless ($swapin_exception) {
eval { $s->proc->($e); } unless checkno('run');
$run_exception = $@;
eval { $e->swapout_wait; } unless checkno('swapout');
my $swapout_exception = $@;
eval { $e->swapout_wait; } unless checkno('swapout');
$swapout_exception = $@;
}
eval { $e->end_wait; } unless checkno('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $swapin_exception;
die TestBed::ParallelRunner::Executor::RunError->new( original => $run_exception ) if $run_exception;
die TestBed::ParallelRunner::Executor::SwapoutError->new( original => $swapout_exception ) if $swapout_exception;
die TestBed::ParallelRunner::Executor::KillError->new( original => $end_exception ) if $end_exception;
......
......@@ -101,17 +101,26 @@ sub ping_test {
}
sub wait_for_nodes_to_activate {
my ($e) = shift;
my ($e, $timeout) = (shift, shift);
my $start = time;
for (@_) {
while ($e->node($_)->ping) { }
while ($e->node($_)->ping) {
sleep 1;
if ((time - $start) > $timeout) { die "Timeout before $_ activated"; }
}
}
}
sub traceroute {
my ($e) = shift;
my $src = $e->resolve(shift);
my $dest = $e->resolve(shift);
Tools::Network::traceroute($src, $dest, @_);
Tools::Network::traceroute($src, @_);
}
sub traceroute_ok {
my ($e) = shift;
my $src = $e->resolve(shift);
Tools::Network::traceroute_ok($src, @_);
}
=item C<< $e->single_node_tests() >>
......
......@@ -33,7 +33,7 @@ sub single_node_tests {
my $ssh = $s->ssh();
my $eid = $s->experiment->eid;
my $name = $s->name;
$ssh->cmdmatch("hostname", qr/$name/, "$eid $name hostname died");
$ssh->cmdmatch("hostname", qr/$name/i, "$eid $name hostname died");
$ssh->cmdmatch("sudo id", qr/uid=0\(root\)/, "$eid $name sudo died");
$ssh->cmdmatch("mount", qr{/proj/}, "$eid $name mountdied");
}
......
......@@ -41,7 +41,7 @@ sub linktest {
for my $i (1..4) {
sleep 2;
my $cmd = 'PATH=/usr/testbed/bin:$PATH '. "run_linktest.pl -v -L $i -l $i -e $pid/$eid";
say $cmd;
#say $cmd;
$results && $ssh->cmdsuccess($cmd);
}
!$results;
......
......@@ -30,7 +30,7 @@ sub loghole {
my ($e, @args) = @_;
my ($pid, $eid) = ($e->pid, $e->eid);
my $cmd = 'PATH=/usr/testbed/bin:$PATH loghole ' . "-e $pid/$eid " . join(" ", @args);
say $cmd;
#say $cmd;
Tools::TBSSH::cmdsuccess($TBConfig::OPS_SERVER, $cmd);
}
......
......@@ -53,7 +53,7 @@ sub tevc {
sub tevc_at_host {
my ($pid, $eid, $host, @args) = @_;
my $cmd = 'PATH=/usr/testbed/bin:$PATH tevc ' . "-e $pid/$eid " . join(" ", @args);
say $cmd;
#say $cmd;
Tools::TBSSH::cmdsuccess($host, $cmd);
}
......
......@@ -3,10 +3,8 @@ package Tools::Network;
use SemiModern::Perl;
use Net::Ping;
use Tools::TBSSH;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw();
use Data::Dumper;
use Test::More;
=head1 NAME
......@@ -33,29 +31,31 @@ sub ping {
ssh to host $src and executes a traceroute to $dest ensuring it follows the path specified
returns 0 or 1
=cut
sub traceroute ($$@) {
sub traceroute {
my ($src,$dest,@path) = @_;
Tools::TBSSH::cmdcheckoutput($src, "traceroute $dest",
Tools::TBSSH::cmdcheckoutput($src, "/usr/sbin/traceroute $dest",
sub {
local $_ = $_[0];
local @_ = grep {!/^traceroute/} split /\n/;
if (@_+0 != @path+0) {
printf "*** traceroute $src->$dest: expected %d hops but got %d.\n",
@path+0, @_+0;
return 0;
my ($sshoutput) = @_;
my @lines = grep {!/^traceroute/} split(/\n/, $sshoutput) ;
if ( (scalar @lines) != (scalar @path) ) {
die sprintf("*** traceroute $src->$dest: expected %d hops but got %d.\n$sshoutput", (scalar @path), (scalar @lines));
}
for (my $i = 0; $i < @_; $i++) {
local $_ = $_[$i];
my ($n) = /^\s*\d+\s*(\S+)/;
next if $n eq $path[$i];
printf "*** traceroute $src->$dest: expected %s for hop %d but got %s\n",
$path[0], $i+1, $n;
return 0;
for (0 .. ((scalar @lines)-1) ) {
my $hop = $path[$_];
my $line = $lines[$_];
my ($host) = ($line =~ /^\s*\d+\s*(\S+)/);
next if $host eq $hop;
die sprintf("*** traceroute $src->$dest: expected %s for hop %d but got %s\n$sshoutput", $hop, $_+1, $host);
}
return 1;
});
}
sub traceroute_ok {
my ($src,$dest,@path) = @_;
ok(traceroute(@_), "traceroute $src to $dest");
}
=back
=cut
......
......@@ -34,11 +34,11 @@ use Data::Dumper;
my $concurrent_prerun_jobs;
my $concurrent_node_usage;
my $exclude_steps;
my $single;
my $result = GetOptions (
"d" => \$debug,
"debug" => \$debug,
"d|debug" => \$debug,
"define=s%" => \$cmdline_defines,
# "jobs=i" => \$pjobs,
"jobs=i" => \$pjobs,
"logging=i" => \$logging,
"timing" => \$timing,
"verbose" => \$verbose,
......@@ -47,7 +47,8 @@ use Data::Dumper;
"group=s" => \$group,
"cprj=i" => \$concurrent_prerun_jobs,
"cnu=i" => \$concurrent_node_usage,
"exsteps=s@" => \$exclude_steps,
"exsteps=s" => \$exclude_steps,
"single=s" => \$single,
);
if ($pjobs > 1) { $ENV { 'HARNESS_OPTIONS' } = "j$pjobs"; }
......@@ -62,7 +63,8 @@ use Data::Dumper;
if ($concurrent_prerun_jobs) { $TBConfig::concurrent_prerun_jobs = $concurrent_prerun_jobs; }
if ($concurrent_node_usage) { $TBConfig::concurrent_node_usage = $concurrent_node_usage; }
if ($cmdline_defines) { $TBConfig::cmdline_defines = $cmdline_defines; }
if ($exclude_steps) { $TBConfig::exclude_steps = $exclude_steps; }
if ($exclude_steps) { $TBConfig::exclude_steps = [split(/ /, $exclude_steps)]; }
if ($single) { $TBConfig::single = $single; }
}
sub usage {
......@@ -73,17 +75,24 @@ sub usage {
use File::Find;
find(\&scandir_t, 't');
find(\&scandir_tests, 'tests');
=pod old options
-j --jobs=i parallel jobs
-t --timing
-v --verbose
=cut
print <<"USAGE";
TestBed TestSwap
./tbts OPTIONS TESTSUITE|TESTFILE
-d --debug
-g --group=GROUPNAME
-j --jobs=i parallel jobs
-p --project=PROJECTNAME
-t --timing
-v --verbose
-x --xmlrpcurl=XMLRPCURL
--define OS=FBSD410-UPDATE
--cprj=4 => \$concurrent_prerun_jobs,
--cnu=20 => \$concurrent_node_usage,
--exsteps "swapout end"
--exsteps "create swapin swapout end"
--exsteps "run"
TESTSUITES:
test - all topology tests
......
......@@ -122,16 +122,16 @@ set lan0 [$ns make-lan "$node0 $node00 $node000 $node0000 " 1Mb 0ms]
set lan1 [$ns make-lan "$node0000 $node00000 " 100Mb 0ms]
set lan00 [$ns make-lan "$node001 $node0010 $node00100 $node00000 " 1Mb 0ms]
tb-set-node-lan-params $node0 $lan0 100ms 1Mb 0.0
tb-set-node-lan-params $node00 $lan0 100ms 1Mb 0.0
tb-set-node-lan-params $node000 $lan0 100ms 1Mb 0.0
tb-set-node-lan-params $node0000 $lan0 100ms 1Mb 0.0
tb-set-node-lan-params $node0000 $lan1 50ms 100Mb 0.0
tb-set-node-lan-params $node00000 $lan1 50ms 100Mb 0.0
tb-set-node-lan-params $node001 $lan00 100ms 1Mb 0.0
tb-set-node-lan-params $node0010 $lan00 100ms 1Mb 0.0
tb-set-node-lan-params $node00100 $lan00 100ms 1Mb 0.0
tb-set-node-lan-params $node00000 $lan00 100ms 1Mb 0.0
tb-set-node-lan-params $node0 $lan0 100ms 1Mb 0.01
tb-set-node-lan-params $node00 $lan0 100ms 1Mb 0.01
tb-set-node-lan-params $node000 $lan0 100ms 1Mb 0.01
tb-set-node-lan-params $node0000 $lan0 100ms 1Mb 0.01
tb-set-node-lan-params $node0000 $lan1 50ms 100Mb 0.01
tb-set-node-lan-params $node00000 $lan1 50ms 100Mb 0.01
tb-set-node-lan-params $node001 $lan00 100ms 1Mb 0.01
tb-set-node-lan-params $node0010 $lan00 100ms 1Mb 0.01
tb-set-node-lan-params $node00100 $lan00 100ms 1Mb 0.01
tb-set-node-lan-params $node00000 $lan00 100ms 1Mb 0.01
$ns rtproto Static
......@@ -149,7 +149,7 @@ tb-set-node-os $nodeA @OS@
tb-set-node-os $nodeB @OS@
set linkAB [$ns duplex-link $nodeA $nodeB 64kb 50ms DropTail]
tb-set-link-loss $linkAB 0.0
tb-set-link-loss $linkAB 0.1
$ns rtproto Static
$ns run
......@@ -237,35 +237,32 @@ $ns run
END
=pod
sub router_test {
test_traceroute 'node0', 'node4', qw(node2-link0 node3-link2 node4-link3);
test_traceroute 'node4', 'node0', qw(node3-link3 node2-link2 node0-link0);
my $e = shift;
$e->traceroute_ok('node0', 'node4', qw(node2-link0 node3-link2 node4-link3));
$e->traceroute_ok('node4', 'node0', qw(node3-link3 node2-link2 node0-link0));
test_traceroute 'node0', 'node1', qw(node2-link0 node1-link1);
test_traceroute 'node1', 'node0', qw(node2-link1 node0-link0);
$e->traceroute_ok('node0', 'node1', qw(node2-link0 node1-link1));
$e->traceroute_ok('node1', 'node0', qw(node2-link1 node0-link0));
test_traceroute 'node1', 'node4', qw(node2-link1 node3-link2 node4-link3);
test_traceroute 'node4', 'node1', qw(node3-link3 node2-link2 node1-link1);
$e->traceroute_ok('node1', 'node4', qw(node2-link1 node3-link2 node4-link3));
$e->traceroute_ok('node4', 'node1', qw(node3-link3 node2-link2 node1-link1));
}
sub router_manual_test {
test_traceroute 'node1', 'nodeA', qw(node3-lan nodeA-link);
test_traceroute 'nodeA', 'node1', qw(node3-link node1-lan);
my $e = shift;
$e->traceroute_ok('node1', 'nodeA', qw(node3-lan nodeA-link));
$e->traceroute_ok('nodeA', 'node1', qw(node3-link node1-lan));
test_traceroute 'node2', 'nodeA', qw(node3-lan nodeA-link);
test_traceroute 'nodeA', 'node2', qw(node3-link node2-lan);
$e->traceroute_ok('node2', 'nodeA', qw(node3-lan nodeA-link));
$e->traceroute_ok('nodeA', 'node2', qw(node3-link node2-lan));
test_traceroute 'node3', 'nodeA', qw(nodeA-link);
test_traceroute 'nodeA', 'node3', qw(node3-link);
$e->traceroute_ok('node3', 'nodeA', qw(nodeA-link));
$e->traceroute_ok('nodeA', 'node3', qw(node3-link));
test_traceroute 'node1', 'node3', qw(node3-lan);
test_traceroute 'node3', 'node1', qw(node1-lan);
$e->traceroute_ok('node1', 'node3', qw(node3-lan));
$e->traceroute_ok('node3', 'node1', qw(node1-lan));
}
#['router', $Router, '5 node routing experiement'],
#['routermanual', $RouterManual, 'Tests manual routing and tb-set-ip/netmask.'],
=cut
my $OS ="RHL90-STD";
my $image_basic_tests = [
......@@ -276,6 +273,13 @@ my $image_basic_tests = [
['linktesthilat', $LinkTestHilat,'Test linktest on a topo with long delays.'],
['linktestlobw', $LinkTestLoBW, 'Test linktest on a topo with low bandwidth.'],
];
my $router_test = sub { my $e = shift; router_test($e); basic_test($e); };
my $router_manual_test = sub { my $e = shift; basic_test($e); router_manual_test($e); };
my $image_router_tests = [
['router', $Router, '5 node routing experiement', $router_test],
['routermanual', $RouterManual, 'Tests manual routing and tb-set-ip/netmask.', $router_manual_test],
];
sub basic_test {
my $e = shift;
......@@ -284,13 +288,30 @@ my $e = shift;
ok($e->linktest, "$eid linktest");
}
sub osmatch {
shift =~ /^(.*tb-set-node-os.*)$/m;
return $1;
}
for (@$image_basic_tests) {
my ($eid, $orig_ns, $desc) = @$_;
my $ns = concretize($orig_ns, OS => $OS);
say "$eid\n$ns\n$desc";
#say "$eid -- " . osmatch($ns);
rege(e($eid), $ns, \&basic_test, 2, $desc);
}
=pod
for (@$image_router_tests) {
my ($eid, $orig_ns, $desc, $testsub) = @$_;
my $ns = concretize($orig_ns, OS => $OS, RTPROTO => 'Static');
rege(e($eid), $ns, $testsub, 8, $desc);
}
=cut
rege(e('routerstatic'), concretize($Router, OS => $OS, RTPROTO => 'Static'), $router_test, 8, '5 node routing experiement - static');
#rege(e('routersession'), concretize($Router, OS => $OS, RTPROTO => 'Session'), $router_test, 8, '5 node routing experiement - session');
rege(e('routermanual'), concretize($RouterManual, OS => $OS), $router_manual_test, 10, 'Tests manual routing and tb-set-ip/netmask.');
sub sync_test {
my %cmds = (
'0' => <<'END',
......@@ -338,8 +359,8 @@ END
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->splatex($cmds{$n}, 'startcmd'.$n.'.sh'); } } @ids ), "$eid prun splat" );
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->ssh->cmdoutput('./startcmd'.$n.'.sh'); } } @ids ), "$eid prun sh" );
my @results = prunout( map { my $n = $_; sub { $e->node('node'.$n)->slurp('node'.$n.'res'); } } @ids );
ok( /^0\n1\n2\n$/, "noderes") for (@results[0..2]);
ok( /^3\n4\n$/, "noderes") for (@results[3..4]);
ok( $results[$_] =~ /^0\n1\n2\n$/, "noderes$_") for (0..2);
ok( $results[$_] =~ /^3\n4\n$/, "noderes$_") for (3..4);
}
rege(e('sync'), concretize($Sync, OS => $OS), \&sync_test, 7, 'ImageTest-sync test');
......
......@@ -73,7 +73,7 @@ EOF
sub testbody($){
my ($e) = @_;
$e->wait_for_nodes_to_activate(qw(a1 b1));
$e->wait_for_nodes_to_activate(60 * 30, qw(a1 b1)); #thirty minute timeout
ok($e->traceroute('a1', 'b1', qw(a1-lan0)), 'traceroute between a1 and b1');
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment