Commit 19f6ff2e authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap Moved xmlrpc test to their own directory

added osid xmlrpc calls and tests
parses linkinfo names
parent 0e1c5761
DOC
POD
-default run kill
buildup, teardown - Test::Class
Add parameterization examples
Add parse links from xmlserver
EXAMPLES
traffic generation`
test groupings
event system
convert more old tests
general result code handling
better parallel support
move xmlrpc tests to t/xmlrpc
MOSTLY DONE
Parse NodeInfo
LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable
TestSuite::Experiment::Macros should be a monadic language like JQuery
test groupings
event system
#!/usr/bin/perl
use SemiModern::Perl;
package TestBed::XMLRPC::Client::NodeInfo;
use SemiModern::Perl;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(parseNodeInfo);
use Data::Dumper;
our $ni= <<'END';
=head1 NAME
TestBed::XMLRPC::Client::NodeInfo
parses nodeInfo text returned from xmlrpc
=cut
my $ni= <<'END';
Experiment: tbres/tewkt
State: active
......@@ -18,28 +25,85 @@ node1 pc node1.tewkt.tbres.emulab.net
node2 pc node2.tewkt.tbres.emulab.net
END
my $li= <<'END';
Experiment: tbres/kk
State: active
Virtual Lan/Link Info:
ID Member/Proto IP/Mask Delay BW (Kbs) Loss Rate
--------------- --------------- --------------- --------- --------- ---------
lan1 node1:0 10.1.1.2 0.00 100000 0.00000000
ethernet 255.255.255.0 0.00 100000 0.00000000
lan1 node2:0 10.1.1.3 0.00 100000 0.00000000
ethernet 255.255.255.0 0.00 100000 0.00000000
link1 node1:1 10.1.2.2 25.00 100000 0.00000000
ethernet 255.255.255.0 25.00 100000 0.00000000
link1 node2:1 10.1.2.3 25.00 100000 0.00000000
ethernet 255.255.255.0 25.00 100000 0.00000000
Physical Lan/Link Mapping:
ID Member IP MAC NodeID
--------------- --------------- --------------- -------------------- ---------
lan1 node1:0 10.1.1.2 00:d0:b7:13:f3:87 pc32
1/1 <-> 8/35 cisco1
lan1 node2:0 10.1.1.3 00:03:47:94:ca:c1 pc49
4/1 <-> 8/22 cisco1
link1 node1:1 10.1.2.2 00:d0:b7:13:fa:d7 pc32
0/1 <-> 8/33 cisco1
link1 node2:1 10.1.2.3 00:02:b3:35:e6:29 pc49
3/1 <-> 8/21 cisco1
Virtual Queue Info:
ID Member Q Limit Type weight/min_th/max_th/linterm
--------------- --------------- ---------- ------- ----------------------------
lan1 node1:0 50 slots Tail 0/0/0/0
lan1 node2:0 50 slots Tail 0/0/0/0
link1 node1:1 50 slots Tail 0/0/0/0
link1 node2:1 50 slots Tail 0/0/0/0
END
=over 4
=item splitlines
=cut
sub splitlines {
my @lines = split(/\n/, $_[0]);
\@lines;
}
sub asplitmatch {
my ($pat, $array) = @_;
=item beforeaftermatch
Return lines from $array before and after matching $pattern
=cut
sub beforeaftermatch {
my ($pattern, $array) = @_;
my $i = 0;
my $d = 0;
for (@{$array}) {
if ($_ =~ $pat) {
if ($_ =~ $pattern) {
$d = $i;
last;
}
$i++;
};
my @a = @{$array};
my @aa = @a[($d+1) .. $#a];
\@aa;
my @before = @a[0 .. ($d-1)];
my @after = @a[($d+1) .. $#a];
(\@before, \@after);
}
sub project_nodes {
sub aftermatch {
[beforeaftermatch(@_)]->[1]
}
=item parse_node_names
parses out node1.tewkt.tbres.emulab.net from the output
node1 pc node1.tewkt.tbres.emulab.net
=cut
sub parse_node_names {
my ($nodes) = @_;
my @nodes;
for (@$nodes) {
......@@ -50,9 +114,81 @@ sub project_nodes {
\@nodes;
}
=item parseNodeInfo
parses nodeInfo text returned form xmlrpc server into a list of node names
=cut
sub parseNodeInfo {
my ($text) = @_;
project_nodes(asplitmatch(qr/---------------/, splitlines($text)));
parse_node_names(aftermatch(qr/---------------/, splitlines($text)));
}
=item chunkit
split into before and after chunks using delimiters
=cut
sub chunkit {
my ($array, @patterns) = @_;
my @chunks;
my ($block, $rest);
for (@patterns) {
($block, $rest) = beforeaftermatch($_, $array);
push @chunks, $block;
$array = $rest;
}
push @chunks, $rest;
@chunks;
}
=item unique
returns unique items from an array
=cut
sub unique {
my %hash;
for (@_) {
if( ! exists $hash{$_}) {
$hash{$_} = 1;
}
}
my @result;
while (my ($k, $v) = each %hash) {
push @result, $k;
}
@result;
}
=item parseLinkInfo
parses linkInfo text returned form xmlrpc server into a list of link names
=cut
sub parseLinkInfo {
my ($text) = @_;
my @chunks = chunkit(splitlines($text), 'Virtual Lan/Link Info:', 'Physical Lan/Link Mapping:', 'Virtual Queue Info:');
#say Dumper(\@chunks);
my @a = @{$chunks[1]};
#say Dumper(\@a);
my @b = @a[2 .. $#a];
#say Dumper(\@b);
my @links;
for (@b) {
if($_ =~ /^(\S+)/) {
push @links, $1;
}
}
@links = unique(@links);
#say Dumper(\@links);
\@links;
}
=back
=cut
1;
#!/usr/bin/perl
package TestBed::XMLRPC::Client::OSID;
use SemiModern::Perl;
use Mouse;
use Data::Dumper;
extends 'TestBed::XMLRPC::Client';
#autoloaded/autogenerated/method_missings/etc getlist info
sub info { shift->augment( 'osid' => shift, @_ ); }
1;
......@@ -16,8 +16,8 @@ Dooh
RedHatAnchient
Dooh
END
ok(concretize($a, OS=>'RedHatAnchient') eq $b);
ok(concretize($a, OS=>'RedHatAnchient') eq $b, 'concretize templating utility');
ok(0 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "hostname", sub { $_[0] =~ /ops.emulab.net/; } )]->[0]);
ok(1 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "false", sub { $_[2] } )]->[0]);
ok(0 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "true", sub { !$_[2]} )]->[0]);
ok(0 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "hostname", sub { $_[0] =~ /ops.emulab.net/; } )]->[0], 'ssh ops hostname');
ok(1 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "false", sub { $_[2] } )]->[0], 'ssh ops false return code');
ok(0 == [Tools::TBSSH::cmdcheckoutput($TBConfig::OPS_SERVER, "true", sub { !$_[2]} )]->[0], 'ssh ops true return code');
......@@ -6,4 +6,4 @@ use Tools::TBSSH;
use Data::Dumper;
use Test::More tests => 1;
ok(Tools::Network::test_traceroute($TBConfig::OPS_SERVER, 'boss.emulab.net', 'public-router', 'boss'));
ok(Tools::Network::test_traceroute($TBConfig::OPS_SERVER, 'boss.emulab.net', 'public-router', 'boss'), 'traceroute ops to boss');
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::XMLRPC::Client::Emulab;
use Test::More tests => 3;
use Time::Local;
use Data::Dumper;
use Tools;
use RPC::XML qw(time2iso8601);
my $emuclient = TestBed::XMLRPC::Client::Emulab->new();
ok($emuclient);
isa_ok($emuclient, 'TestBed::XMLRPC::Client::Emulab');
my $time = timegm(0,0,0,1,0,2008);
my $resp = $emuclient->news('starting' => time2iso8601($time));
ok($resp);
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite::Experiment::Macros tests => 3;
use Test::More;
use Data::Dumper;
my $teststr = "hello there";
like(echo($teststr), qr/$teststr/, "Experiment echo test");
ok(list_brief(), "Experiment getlist brief");
ok(list_full(), "Experiment getlist full");
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::XMLRPC::Client::OSID;
use Test::More tests => 7;
use Data::Dumper;
use Tools;
sub okcontains {
my ($hash, @keys) = @_;
ok(exists $hash->{$_}, "OSID list has $_") for (@keys);
}
my $osid = TestBed::XMLRPC::Client::OSID->new();
ok($osid, 'osid new works');
isa_ok($osid, 'TestBed::XMLRPC::Client::OSID');
my $resp = $osid->getlist;
ok($resp, 'getlist response');
okcontains($resp, 'RHL-STD', 'RHL90-STD', 'FBSD63-STD');
$resp = $osid->info('RHL-STD');
ok($osid, 'info response');
......@@ -40,7 +40,10 @@ sub usage {
print <<"USAGE";
./tbts
test
test - all topology tests
lib - all framework utility libraries
xmlrpc - all xmlrpc client modules
USAGE
print $ts;
}
......@@ -50,7 +53,7 @@ if (@ARGV) {
$_ = $cmd;
if (/critic/) { exec 'perlcritic .'; }
elsif (/lib/) { exec "$THARNESS t/lib/*.t t/lib/*/*.t"; }
elsif (/test/) { exec $THARNESS; }
elsif (/xmlrpc/) { exec "$THARNESS t/xmlrpc/*.t"; }
elsif (/test/) { exec "$THARNESS t/topologies/*.t"; }
elsif (/.*\.t$/) { exec "$THARNESS $cmd"; }
}
......
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