Commit 6c13f2b2 authored by Kevin Tew's avatar Kevin Tew

testswap beginnings of tevc

parent ff0eb4c6
......@@ -8,6 +8,7 @@ use Data::Dumper;
use MIME::Base64;
our $XMLRPC_SERVER = "https://boss.emulab.net:3069/usr/testbed";
our $OPS_SERVER = "users.emulab.net";
our $XMLRPC_VERSION = "0.1";
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
our $SSL_CLIENT_KEY = glob("~/.ssl/emulabkeyout.pem");
......
test groupings
linkinfo
linktest
event system
tests
convert more old tests
THINKING ABOUT IT
Test::Class
......@@ -11,4 +12,4 @@ MOSTLY DONE
LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable
Work on TestSuite::Experiment::Macros
TestSuite::Experiment::Macros should be a monadic language like JQuery
......@@ -2,23 +2,24 @@
use SemiModern::Perl;
package TestBed::TestSuite::Experiment::Macros;
use TestBed::XMLRPC::Client::Pretty;
use Data::Dumper;
require Exporter;
our @ISA = qw(Test::More);
our @EXPORT =qw(e ep echo newexp batchexp list list_brief list_full);
our @EXPORT =qw(e ep echo newexp batchexp list list_brief list_full
plistexps);
use TestBed::TestSuite::Experiment;
use Test::More;
sub echo { ep()->echo(@_); }
sub _newexp { my $e = e(shift, shift); $e->batchexp_ns(shift, @_); $e }
sub _newexp_wait { my $e = e(shift, shift); $e->batchexp_ns_wait(shift, @_); $e }
sub newexp { _newexp(@_); }
sub newexp_wait { _newexp_wait(@_); }
sub batchexp { _newexp(@_); }
sub batchexp_wait { _newexp_wait(@_); }
sub batchexp { my $e = e(shift, shift); $e->batchexp_ns(@_); $e }
sub batchexp_wait { my $e = e(shift, shift); $e->batchexp_ns_wait(@_); $e }
sub newexp { batchexp(@_, batch => 0); }
sub newexp_wait { batchexp_wait(@_, batch => 0); }
sub list { ep()->getlist; }
sub list_brief { ep()->getlist_brief; }
sub list_full { ep()->getlist_full; }
sub plistexps { pretty_listexp(list_full); }
1;
#!/usr/bin/perl
package TestBed::Wrap::tevc;
use SemiModern::Perl;
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 ...]
where the time parameter is one of:
* now
* +seconds (floating point or integer)
* [[[[yy]mm]dd]HH]MMss
For example, you could issue this sequence of events.
tevc -e testbed/myexp now cbr0 set interval_=0.2
tevc -e testbed/myexp +10 cbr0 start
tevc -e testbed/myexp +15 link0 down
tevc -e testbed/myexp +17 link0 up
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;
say $cmd;
$ssh->cmdcatout($cmd);
}
1;
......@@ -35,6 +35,10 @@ sub waitforswapped {
$self->augment_func_code( 'statewait', 'state' => 'swapped' )
&& die sprintf("wait for swapin %s failed", $self->eid);
}
sub startexp_ns { batchexp_ns(@_, 'batch' => 0); }
sub startexp_ns_wait { batchexp_ns_wait(@_, 'batch' => 0); }
sub batchexp_ns_wait {
my $self = shift;
$self->batchexp_ns(@_);
......@@ -61,7 +65,7 @@ sub gen_expinfo_funcs {
my ($package) = caller();
for my $funcname (qw(mapping linkinfo shaping) ) {
my $sub = sub {
shift->augment_func('expinfo', 'show' => $funcname );
shift->augment_func_output('expinfo', 'show' => $funcname );
};
inject_sub($package . '::' . $funcname, $sub);
}
......
#!/usr/bin/perl
package TestBed::XMLRPC::Client::Pretty;
use SemiModern::Perl;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(pretty_listexp);
use Data::Dumper;
sub pretty_listexp {
my ($h) = @_;
while(my ($pk, $v) = each %$h) {
while(my ($gk, $v) = each %$v) {
for my $e (@$v) {
my $eid;
if ( exists $e->{'name'} ) { $eid = sprintf("%s %s", $e->{'name'}, $e->{'state'});}
else { $eid = $e; }
say "$pk :: $gk :: $eid";
}
}
}
}
1;
......@@ -25,11 +25,19 @@ 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);
$ssh->login($user);
return $ssh
}
sub sshhostname {
my ($host, $user) = @_;
my $ssh = Net::SSH::Perl->new($host, protocol => "2", options => [ "ForwardAgent yes" ]);
$ssh->login($user);
my $ssh = ssh($host, $user);
print [$ssh->cmd('uname -a')]->[0];
return $ssh
}
......@@ -51,9 +59,16 @@ sub pulldirastar {
}
package Net::SSH::Perl::SSH2;
use strict;
use SemiModern::Perl;
use Net::SSH::Perl::Constants qw( :protocol :msg2 CHAN_INPUT_CLOSED CHAN_INPUT_WAIT_DRAIN );
sub cmdcatout {
my $ssh = shift;
my @results = $ssh->cmd(@_);
say $results[1];
say "DONE ttycmdcatout";
}
sub cmd_debug {
my $ssh = shift;
my($cmd, $stdin) = @_;
......
......@@ -4,10 +4,7 @@ use SemiModern::Perl;
use TestBed::TestSuite::Experiment::Macros;
use Data::Dumper;
use Tools::TBSSH;
sub listexps {
output(list_full)
}
use TestBed::Wrap::tevc;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -18,28 +15,29 @@ set node1 [$ns node]
set node2 [$ns node]
set lan1 [$ns make-lan "$node1 $node2" 100Mb 0ms]
set link1 [$ns duplex-link $node1 $node2 100Mb 50ms DropTail]
$ns run
NSEND
sub output {
my ($h) = @_;
while(my ($pk, $v) = each %$h) {
while(my ($gk, $v) = each %$v) {
for my $e (@$v) {
my $eid;
if ( exists $e->{'name'} ) { $eid = sprintf("%s %s", $e->{'name'}, $e->{'state'});}
else { $eid = $e; }
say "$pk :: $gk :: $eid";
}
}
}
sub usage {
say <<"END"
./sc
start eid
end eid
ping eid
ni eid // nodeinfo
li eid // linkinfo
END
}
my $pid = 'tbres';
if (@ARGV) {
$_ = $ARGV[0];
my $eid = $ARGV[1];
my $e = e($pid, $eid);
if (/end/) { $e->end(); }
if (/--help/) { usage; }
elsif (/end/) { $e->end(); }
elsif ( /ping/ ) {
my $nodes = $e->nodeinfo();
for (@$nodes) {
......@@ -48,10 +46,14 @@ if (@ARGV) {
ping($_);
}
}
elsif (/start/) { $e->batchexp_ns_wait($ns); }
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"); }
}
else {
listexps();
usage;
plistexps;
}
# vim: ft=perl:
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