Commit 085a8fe6 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap Added parallel_tevc, splat, loghole

parent dedcdc77
......@@ -6,6 +6,12 @@ REQUIREMENTS
INSTALLATION INSTRUCTIONS
perl ./localcpan.pl #this install dependencies in your homdir if you don't have root access to do it yourself
When prompted:
UUID state storage [/tmp] (HIT ENTER)
default umask [0007] (HIT ENTER)
Which SSL install path do you want to use? [/usr] (HIT ENTER)
Do you want to run the live tests (y/N) ? [N] (HIT ENTER)
add export PERL5LIB=~/lib/perl5 to your environment
copy TBConfig.pm.in to TBConfig.pm and edit it to point to your emulab SSL client certificate and corresponding decrypted private key.
......
......@@ -9,6 +9,7 @@ use MIME::Base64;
our $XMLRPC_SERVER = $ENV{'TBTS_XMLRPC_URL'} || "https://boss.emulab.net:3069/usr/testbed";
our $OPS_SERVER = "users.emulab.net";
our $XMLRPC_VERSION = "0.1";
our $XMLRPC_SERVER_TIMEOUT = 60 * 10; #seconds
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
our $SSL_CLIENT_KEY = glob("~/.ssl/decrypted_emulab.key");
our $EMULAB_USER = get_emulab_user();
......
......@@ -2,6 +2,11 @@ DOCS TODO
Overview / howto write a test
TODO
TIMEOUT of XMLRPC Calls
TESTLWP
scp cleanup
chmod +x
wait for end of experiment
cmdline params (-D)
VERBOSENESS
Add basic image-test parameterization examples
......
......@@ -204,6 +204,36 @@ sub redir_std_fork {
}
}
sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); }
sub jobDone { }
package TestBed::ForkFramework::ForEach;
use SemiModern::Perl;
use Mouse;
has 'iter' => ( isa => 'CodeRef' , is => 'rw');
extends 'TestBed::ForkFramework::Scheduler';
sub spawnWorker { shift->nextJob; }
sub nextJob {
my @res = shift->iter->();
$res[0];
}
sub work {
my ($proc, $items) = @_;
my $s = TestBed::ForkFramework::ForEach->new(
'workers' => [],
'results' => [],
'items' => $items,
'errors' => [],
'proc' => $proc,
'iter' => TestBed::ForkFramework::Scheduler::_gen_iterator($items),
'selector' => IO::Select->new);
$s->workloop;
}
package TestBed::ForkFramework::MaxWorkersScheduler;
use SemiModern::Perl;
use Mouse;
......@@ -243,8 +273,6 @@ sub nextJob {
$s->{'pos'}++;
$pos;
}
sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); }
sub jobDone { }
package TestBed::ForkFramework::RateScheduler;
use SemiModern::Perl;
......@@ -309,6 +337,5 @@ sub nextJob {
return;
}
}
sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); }
sub jobDone { my ($s, $itemid) = @_; $s->{'currnodes'} -= $s->weight->[$itemid]; }
1;
......@@ -95,15 +95,15 @@ sub setup_test_builder_ouputs {
$b->todo_output($out);
}
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
#use Carp;
#$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
our $SUBTESTS = 0;
our $ENABLE_SUBTESTS_FEATURE = 0;
sub tap_wrapper {
my ($te) = @_;
if ($SUBTESTS) {
if ($ENABLE_SUBTESTS_FEATURE) {
TestBed::ForkFramework::Scheduler->redir_std_fork( sub {
my ($in, $out, $err, $pid) = @_;
#while(<$out>) { print "K2" . $_; }
......@@ -112,10 +112,10 @@ sub tap_wrapper {
while ( defined( my $result = $tapp->next ) ) {
#sayd($result);
}
ok(1, $te->desc) if $SUBTESTS && $tapp;
ok(1, $te->desc) if $ENABLE_SUBTESTS_FEATURE && $tapp;
},
sub {
reset_test_builder($te->test_count) if $SUBTESTS;
reset_test_builder($te->test_count) if $ENABLE_SUBTESTS_FEATURE;
setup_test_builder_ouputs(*STDOUT, *STDERR);
$te->run_ensure_kill;
});
......@@ -123,8 +123,6 @@ sub tap_wrapper {
else {
$te->run_ensure_kill;
}
return 0;
}
......
......@@ -5,6 +5,8 @@ use Mouse;
use TestBed::XMLRPC::Client::Experiment;
use TestBed::Wrap::tevc;
use TestBed::Wrap::linktest;
use TestBed::Wrap::loghole;
use Tools;
use Tools::TBSSH;
use Data::Dumper;
use TestBed::TestSuite;
......@@ -39,6 +41,28 @@ sub link {
TestBed::TestSuite::Link->new('experiment' => $e, 'name' => $linkname);
}
=item C<< $e->nodenames() >>
returns a list of node names representing each node in the experiment
=cut
sub nodenames {
my ($e) = @_;
my $nodenames = $e->nodeinfo();
return wantarray ? @{$nodenames} : $nodenames;
}
=item C<< $e->hostnames() >>
returns a list of node hostnames representing each node in the experiment
=cut
sub hostnames {
my ($e) = @_;
my $nodenames = $e->nodeinfo();
my @hostnames = map { $_ =~ /([^\.]*)/; $1 } @$nodenames;
return wantarray ? @hostnames : \@hostnames;
}
=item C<< $e->nodes() >>
returns a list of node objects representing each node in the experiment
......@@ -90,6 +114,57 @@ sub tevc {
TestBed::Wrap::tevc::tevc($e->pid, $e->eid, @_);
}
=item C<< $e->parallel_tevc($proc, $items) >>
runs tevc on ops for each cmdline produced by calling $proc on each $item.
=cut
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);
}, $items);
if ($result->[0]) {
sayd($result->[2]);
die 'TestBed::ParallelRunner::runtests died during parallel_tevc';
}
}
=item C<< $e->loghole($cmd) >>
=cut
sub loghole {
my ($e) = shift;
TestBed::Wrap::loghole::loghole($e, @_);
}
=item C<< $e->loghole_sync_allnodes($cmd) >>
=cut
sub loghole_sync_allnodes {
my ($e) = shift;
my @hostnames = $e->hostnames;
TestBed::Wrap::loghole::loghole($e, "sync @hostnames");
}
=item C<< $e->splat($cmd) >>
=cut
sub splat {
my ($e, $data, $fn) = @_;
my $temp = splat_to_temp($data);
my $rc = 0;
for (@{$e->nodes}) {
my $user = $TBConfig::EMULAB_USER;
my $host = $_->name;
my $dest = "$user\@$host:$fn";
my @results = $_->scp($temp, $dest);
$rc ||= $results[0];
die "splat to $dest failed" if $rc;
}
return !$rc;
}
=item C<< $e->linkup($linkname) >>
uses tevc to bring down a link
......
......@@ -36,16 +36,25 @@ sub single_node_tests {
$ssh->cmdsuccess("mount");
}
=item C<$n->ssh>
=item C<< $n->ssh >>
returns a $ssh connection to the node
=cut
sub ssh {
my $self = shift;
my $fqname = $self->name . "." . $self->experiment->eid . "." . $self->experiment->pid . ".emulab.net";
my $ssh = Tools::TBSSH::instance($fqname);
return Tools::TBSSH::instance($self->name);
}
=item C<< $n->scp($lfile, $rfile) >>
returns a $ssh connection to the node
=cut
sub scp {
my $self = shift;
return Tools::TBSSH::scp($self->name, @_);
}
=back
=cut
......
#!/usr/bin/perl
package TestBed::Wrap::loghole;
use SemiModern::Perl;
use TBConfig;
use Data::Dumper;
use Tools;
use Tools::TBSSH;
=pod
loghole -e proj/expt [args ...]
=cut
=head1 NAME
TestBed::Wrap::loghole
=over 4
=item C<loghole($pid, $eid, $arg)>
executes loghole on $pid and $eid with $arg string such as "now link1 down"
by sshing to ops
=back
=cut
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;
Tools::TBSSH::cmdsuccess($TBConfig::OPS_SERVER, $cmd);
}
1;
......@@ -21,7 +21,7 @@ BEGIN {
}
#constructs RPC::XML::Client with 10 minute socket timeout
my $HTTP_TIMEOUT = (60 * 10);
my $HTTP_TIMEOUT = $TBConfig::XMLRPC_SERVER_TIMEOUT;
has 'client' => ( isa => 'RPC::XML::Client', is => 'rw', default => sub {
my $c = RPC::XML::Client->new($TBConfig::XMLRPC_SERVER, 'timeout' => ($HTTP_TIMEOUT));
$c->{'__useragent'}->timeout($HTTP_TIMEOUT);
......
......@@ -7,8 +7,8 @@ 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 concretize yn_prompt);
our @EXPORT = qw(prettytimestamp timestamp sayts sayperl slurp toperl
init_tbts_logger concretize yn_prompt splat_to_temp);
=head1 NAME
......@@ -204,6 +204,15 @@ sub yn_prompt {
return $r;
}
sub splat_to_temp {
my $data = shift;
use File::Temp;
my $tmp = File::Temp->new;
print $tmp $data;
close $tmp;
return $tmp;
}
=back
=cut
......
......@@ -23,14 +23,12 @@ sub instance {
sub wrapped_ssh {
my ($invocant, $user, $cmd, $checker) = @_;
my @results;
if (ref $invocant) {
@results = $invocant->cmd($cmd);
}
my $ssh;
if (ref $invocant) { $ssh = $invocant }
else {
my $ssh = Tools::TBSSH->new('host' => $invocant, 'user' => $user);
@results = $ssh->cmd($cmd);
$ssh = Tools::TBSSH->new('host' => $invocant, 'user' => $user);
}
my @results = $ssh->cmd($cmd);
if (defined $checker) {
&$checker(@results) || die "ssh checker of cmd $cmd failed";
......@@ -38,6 +36,19 @@ sub wrapped_ssh {
($results[2], @results);
}
sub wrapped_scp {
my ($invocant, $user, $lfile, $rfile) = @_;
my $ssh;
if (ref $invocant) { $ssh = $invocant }
else {
$ssh = Tools::TBSSH->new('host' => $invocant, 'user' => $user);
}
my @results = $ssh->scp_worker($lfile, $rfile);
($results[2], @results);
}
sub cmdcheckoutput {
my ($host, $cmd, $checker) = @_;
return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, $checker);
......@@ -63,6 +74,11 @@ sub cmdfailuredump {
return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { print Dumper(\@_); $_[2] != 0; } );
}
sub scp {
my ($host, @files) = @_;
return wrapped_scp($host, $TBConfig::EMULAB_USER, @files);
}
=head1 NAME
Tools::TBSSH
......
......@@ -16,11 +16,26 @@ sub cmd {
my $host = $ssh->host;
my $user = $ssh->user;
my $sshcmd = "ssh -x -o BatchMode=yes -o StrictHostKeyChecking=no $user\@$host $cmd";
say $sshcmd if ($TBConfig::DEBUG_XML_CLIENT);
run3($sshcmd, undef, \$out, \$err);
my $rc = $? >> 8;
($out, $err, $rc);
}
sub scp_worker {
my ($ssh, @files) = @_;
my $out;
my $err;
my $host = $ssh->host;
my $user = $ssh->user;
my $sshcmd = "scp -o BatchMode=yes -o StrictHostKeyChecking=no @files";
say $sshcmd if ($TBConfig::DEBUG_XML_CLIENT);
run3($sshcmd, undef, \$out, \$err);
my $rc = $? >> 8;
($out, $err, $rc);
}
=head1 NAME
Tools::TBSSH
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::TwoNodeLan, sub {
my $e = shift;
$e->loghole_sync_allnodes;
}));
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::SingleNode, sub {
my $e = shift;
$e->parallel_tevc( sub {my $n = $_[0]; return "now $n"; }, [$e->hostnames]));
}));
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::TwoNodeLan, sub {
my $e = shift;
$e->splat("JUNK", "junk.txt");
}));
......@@ -2,7 +2,7 @@
use SemiModern::Perl;
use TestBed::TestSuite;
use BasicNSs;
use Test::More tests => 4;
use Test::More;
use Data::Dumper;
my $linkupdowntest = sub {
......
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