Commit 4350000e authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap - Refactor of SSH - added tevc, linktest, single node test, traceroute

parent eaa705b0
......@@ -13,6 +13,7 @@ our $XMLRPC_VERSION = "0.1";
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
our $SSL_CLIENT_KEY = glob("~/.ssl/emulabkeyout.pem");
our $EMULAB_USER = get_emulab_user();
our $DEFAULT_PID = 'tbres';
our $DEBUG_XML_CLIENT = (hostname() =~ /tan/);
sub get_emulab_user {
......
test groupings
linkinfo
linktest
event system
convert more old tests
general result code handling
better parallel support
THINKING ABOUT IT
Test::Class
......
......@@ -4,9 +4,11 @@ use SemiModern::Perl;
package TestBed::TestSuite::Experiment;
use Mouse;
use TestBed::XMLRPC::Client::Experiment;
use Tools::PingTest;
use TestBed::Wrap::tevc;
use TestBed::Wrap::linktest;
use Tools::TBSSH;
use Data::Dumper;
use TestBed::TestSuite::Node;
extends 'Exporter', 'TestBed::XMLRPC::Client::Experiment';
require Exporter;
......@@ -17,19 +19,43 @@ push @EXPORT, qw(e ep launchpingkill launchpingswapkill);
sub ep { TestBed::TestSuite::Experiment->new }
sub e { TestBed::TestSuite::Experiment->new('pid'=> shift, 'eid' => shift) }
sub nodes {
my ($e) = @_;
my @node_instances = map { TestBed::TestSuite::Node->new('experiment' => $e, 'name'=>$_); } @{$e->nodeinfo()};
\@node_instances;
}
sub ping_test {
my ($e) = @_;
my $nodes = $e->nodeinfo();
for (@$nodes) {
ping($_);
for (@{$e->nodes}) {
$_->ping();
}
}
sub single_node_tests {
my ($e) = @_;
for (@{$e->nodes}) {
say $_->name;
$_->single_node_tests();
}
}
sub ssh_hostname_test {
sub link_test {
my ($e) = @_;
TestBed::Wrap::linktest::link_test($e->pid, $e->eid);
}
sub tevc {
my ($e) = shift;
my $pid = $e->pid;
my $eid = $e->eid;
TestBed::Wrap::tevc::tevc($e->pid, $e->eid, @_);
}
sub hostname_test {
my ($e) = @_;
my $nodes = $e->nodeinfo();
for (@$nodes) {
Tools::TBSSH::sshhostname($_, $TBConfig::EMULAB_USER);
for (@{$e->nodes}) {
$_->sshcmddump("uname -a");
}
}
......
#!/usr/bin/perl
package TestBed::TestSuite::Node;
use SemiModern::Perl;
use Mouse;
#use TestBed::XMLRPC::Client::Node;
use Tools::Network;
use Tools::TBSSH;
use Data::Dumper;
has 'name' => ( isa => 'Str', is => 'rw');
has 'experiment' => ( is => 'rw');
sub ping_test {
my ($self) = @_;
ping($self->name);
}
sub ssh_hostname_test { shift->cmdsuccess("hostname"); }
sub sudo_test { shift->cmdsuccess("sudo ls"); }
sub mounted_test { shift->cmdsuccess("mount"); }
sub single_node_tests {
my ($self) = @_;
my $ssh = $self->ssh();
$ssh->cmdsuccess("hostname");
$ssh->cmdsuccess("sudo ls");
$ssh->cmdsuccess("mount");
}
sub ssh {
my $self = shift;
my $ssh = Tools::TBSSH::ssh($self->name, $TBConfig::EMULAB_USER);
}
sub sshcmddump {
my $self = shift;
my $ssh = $self->ssh;
$ssh->cmddump(@_);
}
1;
#!/usr/bin/perl
package TestBed::Wrap::linktest;
use SemiModern::Perl;
use TBConfig;
use Data::Dumper;
use Tools;
use Tools::TBSSH;
=pod
sleep 10;
test_cmd 'linktest1', [], "run_linktest.pl -v -L 1 -l 1 -e $pid/$eid";
sleep 2;
test_cmd 'linktest2', [], "run_linktest.pl -v -L 2 -l 2 -e $pid/$eid";
sleep 2;
test_cmd 'linktest3', [], "run_linktest.pl -v -L 3 -l 3 -e $pid/$eid";
sleep 2;
test_cmd 'linktest4', [], "run_linktest.pl -v -L 4 -l 4 -e $pid/$eid";
=cut
sub linktest {
my ($pid, $eid) = @_;
my $ssh = Tools::TBSSH::ssh($TBConfig::OPS_SERVER, $TBConfig::EMULAB_USER);
sleep 8;
for my $i (1..4) {
sleep 2;
$ssh->cmdsuccessdump("run_linktest.pl -v -L $i -l $i -e $pid/$eid");
}
}
1;
......@@ -6,13 +6,6 @@ use TBConfig;
use Data::Dumper;
use Tools;
use Tools::TBSSH;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(tevc);
my $loglevel = "INFO";
$loglevel = "DEBUG";
my $logger = init_tbts_logger("Wrap::tevc", undef, "INFO", "SCREEN");
=pod
tevc -e proj/expt time objname event [args ...]
......@@ -33,12 +26,10 @@ tevc -e testbed/myexp +20 cbr0 stop
=cut
sub tevc {
my ($args) = @_;
$args ||= '';
my $ssh = Tools::TBSSH::sshtty($TBConfig::OPS_SERVER, $TBConfig::EMULAB_USER);
my $cmd = 'PATH=/usr/testbed/bin:$PATH tevc ' . $args;
my ($pid, $eid, @args) = @_;
my $cmd = 'PATH=/usr/testbed/bin:$PATH tevc ' . "-e $pid/$eid " . join(" ", @args);
say $cmd;
$ssh->cmdcatout($cmd);
Tools::TBSSH::cmdsuccessdump($TBConfig::OPS_SERVER, $cmd);
}
1;
......@@ -8,7 +8,16 @@ use Log::Log4perl qw(get_logger :levels);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(prettytimestamp timestamp sayts sayperl slurp splat toperl
init_tbts_logger);
init_tbts_logger concretize);
sub concretize {
my $text = shift;
my %repl = @_;
while (my ($k, $v) = each %repl) {
$text =~ s/\@$k\@/$v/;
}
$text;
}
sub slurp {
my ($fn) = @_;
......
#!/usr/bin/perl
package Tools::Network;
use SemiModern::Perl;
use Net::Ping;
use Tools::TBSSH;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(ping test_traceroute);
use Data::Dumper;
sub ping {
my ($host) = @_;
my $p = Net::Ping->new('tcp', 2);
$p->ping($host);
}
sub test_traceroute ($$@) {
my ($src,$dest,@path) = @_;
Tools::TBSSH::cmdcheckoutput($src, "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;
}
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;
}
return 1;
});
}
1;
#!/usr/bin/perl
use SemiModern::Perl;
use Net::Ping;
package Tools::PingTest;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(ping);
use Data::Dumper;
sub ping {
my ($host) = @_;
my $p = Net::Ping->new('tcp', 2);
$p->ping($host);
}
1;
#!/usr/bin/perl
package Tools::TBSSH;
use SemiModern::Perl;
use Net::SSH::Perl;
use Net::SFTP;
use Data::UUID;
package Tools::TBSSH;
use Data::Dumper;
use TBConfig;
sub uuid {
my $ug = new Data::UUID;
......@@ -25,21 +25,30 @@ sub path_to_last_part {
}
}
sub sshtty {
ssh(@_, use_tty => 1);
}
sub ssh {
my ($host, $user, @options) = @_;
my $ssh = Net::SSH::Perl->new($host, protocol => "2", options => [ "ForwardAgent yes" ], @options);
$user ||= $TBConfig::EMULAB_USER;
my $ssh = Net::SSH::Perl->new($host, protocol => "2", options => [ "ForwardAgent yes" ], use_tty => 1, @options);
$ssh->login($user);
return $ssh
}
sub sshhostname {
my ($host, $user) = @_;
my $ssh = ssh($host, $user);
print [$ssh->cmd('uname -a')]->[0];
return $ssh
sub cmdcheckoutput {
my ($host, $cmd, $checker) = @_;
my $ssh = ssh($host, $TBConfig::EMULAB_USER);
$ssh->cmdcheckoutput($cmd, $checker);
}
sub cmdsuccess {
my ($host, $cmd) = @_;
my $ssh = ssh($host, $TBConfig::EMULAB_USER);
$ssh->cmdsuccess($cmd);
}
sub cmdsuccessdump {
my ($host, $cmd) = @_;
my $ssh = ssh($host, $TBConfig::EMULAB_USER);
$ssh->cmdsuccessdump($cmd);
}
sub pulldirastar {
......@@ -61,12 +70,33 @@ sub pulldirastar {
package Net::SSH::Perl::SSH2;
use SemiModern::Perl;
use Net::SSH::Perl::Constants qw( :protocol :msg2 CHAN_INPUT_CLOSED CHAN_INPUT_WAIT_DRAIN );
use Data::Dumper;
sub cmdcheckoutput {
my ($ssh, $cmd, $checker) = @_;
my @results = $ssh->cmd($cmd);
if (defined $checker) {
&$checker(@results) || die "ssh checker of cmd $cmd failed";
}
($results[2], $ssh, @results);
}
sub cmdsuccess {
my ($ssh, $cmd) = @_;
$ssh->cmdcheckoutput($cmd, sub { $_[2] == 0; } );
}
sub cmdsuccessdump {
my ($ssh, $cmd) = @_;
$ssh->cmdcheckoutput($cmd, sub { print Dumper(\@_); $_[2] == 0; } );
}
sub cmdcatout {
sub cmddump {
my $ssh = shift;
my @results = $ssh->cmd(@_);
say $results[1];
say "DONE ttycmdcatout";
say Dumper(\@results);
say "DONE cmddump";
($results[2], $ssh, @results);
}
sub cmd_debug {
......
#!/usr/bin/perl
use lib 'lib';
use SemiModern::Perl;
use TBConfig;
use TestBed::TestSuite::Experiment::Macros;
use Data::Dumper;
use Tools::TBSSH;
......@@ -21,35 +22,36 @@ NSEND
sub usage {
say <<"END"
./sc
start eid
end eid
ping eid
ni eid // nodeinfo
li eid // linkinfo
./sc CMD EID ARGS
CMD = start
swapin
swapout
end
ping
ni // nodeinfo
li // linkinfo
END
}
my $pid = 'tbres';
my $pid = $TBConfig::DEFAULT_PID;
if (@ARGV) {
$_ = $ARGV[0];
my $eid = $ARGV[1];
$_ = shift;
my $eid = shift;
my $e = e($pid, $eid);
if (/--help/) { usage; }
elsif (/end/) { $e->end(); }
elsif ( /ping/ ) {
my $nodes = $e->nodeinfo();
for (@$nodes) {
say;
use Tools::PingTest;
ping($_);
}
}
elsif (/ping/ ) { $e->ping_test; }
elsif (/swapin/) { $e->swapin_wait; }
elsif (/swapout/) { $e->swapout_wait; }
elsif (/start/) { $e->startexp_ns_wait($ns); }
elsif (/ni/) { say Dumper($e->nodeinfo) ;}
elsif (/li/) { say Dumper($e->linkinfo) ;}
elsif (/tevc/) { tevc("-e $pid/$eid now link1 down"); }
elsif (/tevc/) { $e->tevc(@ARGV); }
elsif (/single_node_tests/) { $e->single_node_tests; }
else {
}
}
else {
usage;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use Tools;
use Tools::TBSSH;
use Data::Dumper;
use Test::More tests => 4;
my $a = <<'END';
Dooh
@OS@
Dooh
END
my $b = <<'END';
Dooh
RedHatAnchient
Dooh
END
ok(concretize($a, OS=>'RedHatAnchient') eq $b);
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]);
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use Tools::Network;
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'));
......@@ -49,6 +49,7 @@ if (@ARGV) {
my $cmd = $ARGV[0];
$_ = $cmd;
if (/critic/) { exec 'perlcritic .'; }
elsif (/lib/) { exec "$THARNESS t/lib/*.t t/lib/*/*.t"; }
elsif (/test/) { exec $THARNESS; }
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