Commit dbc0e7e6 authored by Kevin Tew's avatar Kevin Tew

tests/SyncTests.pm tests/Trafficgen.pm jons traceroute fixes, other fixes

parent 815e26d6
my $FFDEBUG = 0;
package TestBed::ForkFramework::Process;
use SemiModern::Perl;
use Mouse;
use POSIX ":sys_wait_h";
has 'pid' => (is => 'rw');
sub isalive { waitpid(shift->pid, WNOHANG) <= 0; }
sub wait { waitpid(shift->pid, 0); }
package TestBed::ForkFramework::Channel;
use SemiModern::Perl;
use Mouse;
......@@ -97,6 +106,11 @@ sub forkit {
}
}
sub spawn {
my ($worker) = @_;
forkit( sub { return TestBed::ForkFramework::Process->new( pid => $_[0]); } , $worker);
}
sub fork_redir {
my ($parent_worker, $worker) = @_;
my $redir = TestBed::ForkFramework::Redir->new;
......
......@@ -110,7 +110,7 @@ sub override {
sub prun {
my $results = TestBed::ForkFramework::ForEach::worksubs( @_);
die ("prun item failed", $results) if ($results->has_errors);
die ("prun item failed", Dumper($results)) if ($results->has_errors);
return $results;
}
......
......@@ -117,6 +117,34 @@ sub traceroute {
Tools::Network::traceroute($src, @_);
}
sub cartesian_ping{
my ($e) = shift;
my @nodes = $e->nodenames();
my @hosts = $e->hostnames();
my @work;
for (@nodes){
my $node1 = $_;
for (@hosts){
my $node2 = $_;
if ($node1 ne $node2){
push @work, sub{$e->ping_from_to($node1, $node2)};
}
}
}
TestBed::TestSuite::prun(@work);
}
sub ping_from_to($$$){
my ($e, $from, $to) = @_;
Tools::TBSSH::cmdcheckoutput($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -c 5 $to\"'",
sub {
return 1;
});
}
sub traceroute_ok {
my ($e) = shift;
my $src = $e->resolve(shift);
......@@ -149,7 +177,7 @@ takes an argument string such as "now link1 down"
=cut
sub tevc {
my ($e) = shift;
TestBed::Wrap::tevc::tevc($e->pid, $e->eid, @_);
TestBed::Wrap::tevc::tevc($e, @_);
}
=item C<< $e->tevc_at_host($host, @args) >>
......@@ -160,7 +188,7 @@ takes an argument string such as "now link1 down"
sub tevc_at_host {
my ($e) = shift;
TestBed::Wrap::tevc::tevc_at_host($e->pid, $e->eid, @_);
TestBed::Wrap::tevc::tevc_at_host($e, @_);
}
=item C<< $e->parallel_tevc($proc, $items) >>
......@@ -171,7 +199,7 @@ sub parallel_tevc {
my ($e, $proc, $items) = @_;
my $result = TestBed::ForkFramework::ForEach::work(sub {
my @tevc_cmd = $proc->(@_);
TestBed::Wrap::tevc::tevc($e->pid, $e->eid, @tevc_cmd);
TestBed::Wrap::tevc::tevc($e, @tevc_cmd);
}, $items);
if ($result->[0]) {
sayd($result->[2]);
......@@ -187,7 +215,7 @@ sub parallel_tevc_at_host {
my ($e, $host, $proc, $items) = @_;
my $result = TestBed::ForkFramework::ForEach::work(sub {
my @tevc_cmd = $proc->(@_);
TestBed::Wrap::tevc::tevc_at_host($e->pid, $e->eid, $host, @tevc_cmd);
TestBed::Wrap::tevc::tevc_at_host($e, $host, @tevc_cmd);
}, $items);
if ($result->[0]) {
sayd($result->[2]);
......
......@@ -45,15 +45,12 @@ by sshing to $host
=cut
sub tevc {
my ($pid, $eid, @args) = @_;
tevc_at_host($pid, $eid, $TBConfig::OPS_SERVER, @args);
}
sub tevc { tevc_at_host(shift, $TBConfig::OPS_SERVER, @_); }
sub tevc_at_host {
my ($pid, $eid, $host, @args) = @_;
my ($e, $host, @args) = @_;
my ($pid, $eid) = ($e->pid, $e->eid);
my $cmd = 'PATH=/usr/testbed/bin:$PATH tevc ' . "-e $pid/$eid " . join(" ", @args);
#say $cmd;
Tools::TBSSH::cmdsuccess($host, $cmd);
}
......
......@@ -27,7 +27,7 @@ sub args {
my $gid = $self->gid;
my $eid = $self->eid;
die "Odd number of args" . sayd(@_) if ((scalar @_) % 2 !=0);
confess ("Odd number of args" . sayd(@_)) if ((scalar @_) % 2 !=0);
return { 'pid' => $pid, 'gid' => $gid, 'eid' => $eid, @_ };
}
......
......@@ -34,7 +34,9 @@ sub get_free {
}
sub get_free_names {
keys %{shift->get_free(@_)};
my $x = shift;
sayd(keys %{$x->get_free(@_)});
keys %{$x->get_free(@_)};
}
sub get_free_node_names {
......
......@@ -33,7 +33,7 @@ returns 0 or 1
=cut
sub traceroute {
my ($src,$dest,@path) = @_;
Tools::TBSSH::cmdcheckoutput($src, "/usr/sbin/traceroute $dest",
Tools::TBSSH::cmdcheckoutput($src, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin traceroute $dest\"'",
sub {
my ($sshoutput) = @_;
my @lines = grep {!/^traceroute/} split(/\n/, $sshoutput) ;
......
......@@ -36,7 +36,7 @@ sub wrapped_ssh {
}
if (defined $checker) {
&$checker(@results) || die ($diemessage || "ssh checker of cmd $cmd failed");
&$checker(@results) || die ($diemessage || "ssh checker of cmd $cmd failed " . Dumper(\@results));
}
($results[2], @results);
}
......
......@@ -111,6 +111,7 @@ if (@ARGV) {
elsif (/ip/) { say Dumper($e->info(aspect => 'physical')) ;}
elsif (/it/) { say Dumper($e->info(aspect => 'traces')) ;}
elsif (/il/) { say Dumper($e->info(aspect => 'links')) ;}
elsif ($_ eq 'syncs') { prun( map { my $n = $_; sub { $e->node('node1')->ssh->cmdoutput('/usr/testbed/bin/emulab-sync'); } } (1..shift)); }
elsif (/watch/) { watch($e); }
elsif ($_ eq'ex') {
say $ARGV[0];
......
......@@ -55,10 +55,10 @@ use Data::Dumper;
if ($timing) { $ENV { 'HARNESS_TIMER' } = 1; }
if ($verbose) { $ENV { 'HARNESS_VERBOSE' } = 1; $ENV { 'HARNESS_COLOR' } = 1; }
if ($debug) { $ENV { 'TBTS_DEBUG' } = 1; }
if ($group) { $ENV { 'TBTS_GROUP' } = $group; }
if ($project) { $ENV { 'TBTS_PROJECT' } = $project; }
if ($xmlrpcurl) { $ENV { 'TBTS_XMLRPC_URL' } = $xmlrpcurl; }
if ($debug) { $ENV { 'TBTS_DEBUG' } = 1 ; $TBConfig::DEBUG_XML_CLIENT = 1 ; }
if ($group) { $ENV { 'TBTS_GROUP' } = $group ; $TBConfig::DEFAULT_GID = $group ; }
if ($project) { $ENV { 'TBTS_PROJECT' } = $project ; $TBConfig::DEFAULT_PID = $project ; }
if ($xmlrpcurl) { $ENV { 'TBTS_XMLRPC_URL' } = $xmlrpcurl ; $TBConfig::XMLRPC_SERVER = $xmlrpcurl ; }
use TBConfig;
if ($concurrent_prerun_jobs) { $TBConfig::concurrent_prerun_jobs = $concurrent_prerun_jobs; }
if ($concurrent_node_usage) { $TBConfig::concurrent_node_usage = $concurrent_node_usage; }
......
package ImageTests;
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More;
my $Sync= << 'END';
set ns [new Simulator]
source tb_compat.tcl
set node0 [$ns node]
set node1 [$ns node]
set node2 [$ns node]
tb-set-node-os $node0 @OS@
tb-set-node-os $node1 @OS@
tb-set-node-os $node2 @OS@
tb-set-sync-server $node0
$ns run
END
my $OS ="RHL90-STD";
sub sync_test {
my $e = shift;
my $eid = $e->eid;
my $ct = 500;
ok( $e->node('node0')->ssh->cmdsuccess("/usr/testbed/bin/emulab-sync -a -i $ct"), "$eid setup $ct node barrier" );
ok( $e->node('node1')->ssh->cmdsuccess("\'for x in `seq 1 $ct`; do :(){ /usr/testbed/bin/emulab-sync > /dev/null 2> /dev/null < /dev/null &};: ; done\'"), "$eid prun sh" );
}
rege(e('sync'), concretize($Sync, OS => $OS), \&sync_test, 2, 'ImageTest-sync test');
1;
package Event;
use SemiModern::Perl;
use Mouse;
has 'start' => (is => 'rw');
has 'end' => (is => 'rw');
has 'qty' => (is => 'rw');
sub update {
my ($s, $ts, $qty) = @_;
$s->end($ts);
$s->qty($qty + $s->qty);
}
package TrafficGenLister;
use SemiModern::Perl;
use Mouse;
use IO::Socket::INET;
use IO::Handle;
use Test::More;
has 'state' => (is=>'rw', 'default' => sub { [] } );
has 'events' => (is=>'rw', 'default' => sub { [ [], [] ] } );
has 'basetime' => (is=>'rw');
has 'socket' => (is=>'rw');
has 'traffic' => (is=>'rw', 'default' => sub { [] } );
sub init {
my ($s, $eid, $pid) = @_;
my $socket = IO::Socket::INET->new(Proto => 'tcp', PeerAddr => "node0.$eid.$pid.emulab.net:4443" ) or die "Socket Error: $@\n";
$socket->getline;
$socket->getline;
$s->socket($socket);
}
sub normalizeTimes {
my ($s, $ts) = @_;
return $ts - $s->basetime;
}
sub recordEvent {
my ($s, $id, $ts, $qty) = @_;
if ( !$qty and !$s->state->[$id] ) { } # noop
elsif ( $qty and !$s->state->[$id] ) { $s->state->[$id] = Event->new(start => $s->normalizeTimes($ts), qty => $qty); } # event start
elsif ( $qty and $s->state->[$id] ) { $s->state->[$id]->update($s->normalizeTimes($ts), $qty); } # event update
elsif ( !$qty and $s->state->[$id] ) { push @{ $s->events->[$id] }, $s->state->[$id]; $s->state->[$id] = undef; } # event end
}
sub parseline {
local $^W = 1;
use Carp qw(confess);
my $s = shift;
my $l = $s->socket->getline;
print $l;
my ($ts, $tcp, $udp) = ($l =~ /(\d+)\.\d+ \(icmp:\d+,\d+ tcp:(\d+),\d+ udp:(\d+),\d+ other:\d+,\d+\)/);
if (! defined $s->basetime) {
return $s->basetime($ts);
}
#event id 0 is tcp, 1 is udp
$s->recordEvent(0, $ts, $tcp);
$s->recordEvent(1, $ts, $udp);
}
sub print { shift->socket->print(shift); }
sub close {
my $s = shift;
$s->socket->close;
$s->recordEvent(0, 0, 0);
$s->recordEvent(1, 0, 0);
}
sub check {
my ($s, $id, $start, $expected_duration, $bytes, $desc) = @_;
#sayd($s->events->[$id]);
my ($event) = grep {
#say $_->start, " ", $start, " ", ($_->start - $start);
abs($_->start - $start) <= 1; } @{$s->events->[$id]};
die "*** Could not find traffic corresponding to \"$desc\"\n" unless (defined $event);
my $actual_duration = ($event->end - $event->start);
if (abs(($actual_duration - $expected_duration)) > 1) {
die "*** Traffic from \"$desc\" lasted for $actual_duration seconds when it was only suppose to last for $expected_duration seconds\n";
}
my $actual_bytes = $event->qty;
my $tol = 0.20;
if (abs($actual_bytes - $bytes) > $bytes*$tol) {
warn "*** Traffic from \"$desc\" generated $actual_bytes bytes of data but was expecting approximately $bytes bytes with a tolerance of " . sprintf("%.0f%%\n", $tol * 100);
}
}
sub check_ok {
my ($s, $id, $start, $expected_duration, $bytes, $desc) = @_;
check($s, $id, $start, $expected_duration, $bytes, $desc);
ok(1, $desc);
}
package ImageTests;
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More;
use TestBed::ForkFramework;
my $TrafficGen = <<'END';
set ns [new Simulator]
source tb_compat.tcl
set node0 [$ns node]
set node1 [$ns node]
tb-set-node-os $node0 @OS@
tb-set-node-os $node1 @OS@
set link1 [$ns duplex-link $node0 $node1 100Mb 0ms DropTail]
set udp0 [new Agent/UDP]
$ns attach-agent $node0 $udp0
set cbr_udp [new Application/Traffic/CBR]
$cbr_udp set packetSize_ 500
$cbr_udp set interval_ 0.05
$cbr_udp attach-agent $udp0
set null0 [new Agent/Null]
$ns attach-agent $node1 $null0
$ns connect $udp0 $null0
set tcp0 [new Agent/TCP]
$ns attach-agent $node1 $tcp0
set cbr_tcp [new Application/Traffic/CBR]
$cbr_tcp set packetSize_ 500
$cbr_tcp set interval_ 0.01
$cbr_tcp attach-agent $tcp0
set null1 [new Agent/Null]
$ns attach-agent $node0 $null1
$ns connect $tcp0 $null1
set tl [$ns event-timeline]
$tl at 10.0 "$cbr_udp start"
$tl at 12.0 "$cbr_udp stop"
$tl at 15.0 "$cbr_tcp start"
$tl at 17.0 "$cbr_tcp stop"
$tl at 20.0 "$cbr_udp start"
$tl at 20.0 "$cbr_tcp start"
$tl at 22.0 "$cbr_udp stop"
$tl at 22.0 "$cbr_tcp stop"
$link1 trace
$link1 trace_endnode 1
$ns rtproto Static
$ns run
END
sub traffic_gen_test {
my $e = shift;
my $eid = $e->eid;
my $pid = $e->pid;
my @n = map { my $s = TrafficGenLister->new; $s->init($eid, $pid); $s; } (1..2);
my $ppid = TestBed::ForkFramework::spawn( sub { $e->tevc("-w now tl start"); } );
map { $_->print("1000\n"); } @n;
while ($ppid->isalive) {
for (@n) {
$_->parseline;
}
};
die "tevc existed with non-zero status: $?\n" if ($? >> 8 != 0);
for (@n) {
$_->parseline;
$_->close;
$_->check_ok(1, 10, 2, 20000, '$tl at 10.0 "$cbr_udp start"');
$_->check_ok(1, 20, 2, 20000, '$tl at 20.0 "$cbr_udp start"');
$_->check_ok(0, 15, 2, 10000, '$tl at 15.0 "$cbr_tcp start"');
$_->check_ok(0, 20, 2, 10000, '$tl at 20.0 "$cbr_tcp start"');
}
}
my $OS ="RHL90-STD";
{
my $eid = 'trafficgen';
my $ns = concretize($TrafficGen, OS => $OS);
my $test_sub = sub { my $e = shift; traffic_gen_test($e);};
rege(e($eid), $ns, $test_sub, 8, 'ImageTest-trafficgen test');
}
1;
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