Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
6c13f2b2
Commit
6c13f2b2
authored
Mar 26, 2009
by
Kevin Tew
Browse files
testswap beginnings of tevc
parent
ff0eb4c6
Changes
8
Hide whitespace changes
Inline
Side-by-side
testsuite/testswap/TBConfig.pm
View file @
6c13f2b2
...
...
@@ -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
");
...
...
testsuite/testswap/TODO
View file @
6c13f2b2
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
testsuite/testswap/lib/TestBed/TestSuite/Experiment/Macros.pm
View file @
6c13f2b2
...
...
@@ -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
;
testsuite/testswap/lib/TestBed/Wrap/tevc.pm
0 → 100644
View file @
6c13f2b2
#!/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
;
testsuite/testswap/lib/TestBed/XMLRPC/Client/Experiment.pm
View file @
6c13f2b2
...
...
@@ -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
);
}
...
...
testsuite/testswap/lib/TestBed/XMLRPC/Client/Pretty.pm
0 → 100644
View file @
6c13f2b2
#!/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
;
testsuite/testswap/lib/Tools/TBSSH.pm
View file @
6c13f2b2
...
...
@@ -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
)
=
@_
;
...
...
testsuite/testswap/sc
View file @
6c13f2b2
...
...
@@ -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:
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment