Skip to content
GitLab
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
e8a01e54
Commit
e8a01e54
authored
May 25, 2006
by
Dan Gebhardt
Browse files
Improved and simplified scheduling of tests.
Iperf processes timeout after trying too long.
parent
4d4f8c26
Changes
1
Hide whitespace changes
Inline
Side-by-side
pelab/bgmon/bgmon.pl
View file @
e8a01e54
...
...
@@ -58,7 +58,8 @@ sub usage {
#*****************************************
my
%MAX_SIMU_TESTS
=
(
latency
=>
"
10
",
bw
=>
"
1
");
my
$iperfduration
=
10
;
my
$iperftimeout
=
30
;
#kill an iperf process lasting longer than this.
# percentage of testing period to wait after a test process abnormally exits
# note: 0.1 = 10%
my
%TEST_FAIL_RETRY
=
(
latency
=>
0.3
,
...
...
@@ -88,7 +89,6 @@ $ERRID{unknown} = -3;
#*****************************************
my
%opt
=
();
#getopt(\%opt,"s:p:h");
getopts
("
s:p:e:d:i:h
",
\
%opt
);
#if ($opt{h}) { exit &usage; }
...
...
@@ -163,7 +163,7 @@ for (my $i = 0; $i < $resultDBlimit; $i++) {
}
}
my
$subtimer_reset
=
100
;
my
$subtimer_reset
=
100
;
# subtimer reaches 0 this many times thru poll loop
my
$subtimer
=
$subtimer_reset
;
#decrement every poll-loop.
while
(
1
)
{
...
...
@@ -177,19 +177,7 @@ while (1) {
#try to run tests on queue
if
(
$subtimer
==
0
){
foreach
my
$testtype
(
keys
%waitq
){
my
$arrlen
=
scalar
(
@
{
$waitq
{
$testtype
}});
#DONOT use "foreach" here, since the call to spawnTest
# may add to waitq
for
(
my
$i
=
0
;
$i
<
$arrlen
;
$i
++
){
#get oldest element. (take off, but put right back until
# sure it got processed)
my
$destnode
=
pop
@
{
$waitq
{
$testtype
}};
push
@
{
$waitq
{
$testtype
}},
$destnode
;
if
(
-
1
!=
spawnTest
(
$destnode
,
$testtype
)
){
pop
@
{
$waitq
{
$testtype
}};
#sent successfully, so pop node
}
}
# print "QW-".$testtype."_len=".scalar(@{$waitq{$testtype}})."\n";
if
(
scalar
(
@
{
$waitq
{
$testtype
}})
!=
0
){
print
time_all
()
.
"
$testtype
";
foreach
my
$node
(
@
{
$waitq
{
$testtype
}}){
...
...
@@ -197,6 +185,9 @@ while (1) {
}
print
"
\n
";
}
#
# Run next scheduled test
spawnTest
(
undef
,
$testtype
);
}
}
...
...
@@ -208,8 +199,8 @@ while (1) {
my
$pid
=
$testevents
{
$destaddr
}{
$testtype
}{"
pid
"};
if
(
$pid
!=
0
){
use
POSIX
"
:sys_wait_h
";
my
$
cnt
=
waitpid
(
$pid
,
&WNOHANG
);
if
(
$
cnt
!=
0
)
my
$
kid
=
waitpid
(
$pid
,
&WNOHANG
);
if
(
$
kid
!=
0
)
{
if
(
$?
==
0
){
#process finished, so mark it's "finished" flag
...
...
@@ -229,7 +220,20 @@ while (1) {
my
$filename
=
createtmpfilename
(
$destaddr
,
$testtype
);
unlink
(
$filename
)
or
warn
"
can't delete temp file
";
}
}
}
#TODO: if this process is bandwidth, kill it if it has
# been running too long (iperf has a looong timeout)
elsif
(
$testtype
eq
"
bw
"
&&
time_all
()
>
$testevents
{
$destaddr
}{
$testtype
}{"
tstamp
"}
+
$iperftimeout
)
{
kill
'
TERM
',
$pid
;
print
time_all
()
.
"
killed
$destaddr
, pid=
$pid
\n
";
}
}
#check for finished events
...
...
@@ -423,7 +427,6 @@ sub callbackFunc($$$) {
#change values and/or initialize
if
(
$eventtype
eq
"
EDIT
"
){
print
"
EDIT
\n
";
my
$linkdest
=
event_notification_get_string
(
$handle
,
$notification
,
"
linkdest
");
...
...
@@ -437,12 +440,13 @@ sub callbackFunc($$$) {
$testevents
{
$linkdest
}{
$testtype
}{"
flag_scheduled
"}
=
0
;
$testevents
{
$linkdest
}{
$testtype
}{"
timeOfNextRun
"}
=
time_all
();
print
(
"
EDIT:
\n
");
print
(
"
linkdest=
$linkdest
\n
"
.
"
testype =
$testtype
\n
"
.
"
testper=
$testper
\n
"
);
}
elsif
(
$eventtype
eq
"
INIT
"
){
print
"
INIT
\n
";
print
"
INIT
:
";
my
$testtype
=
event_notification_get_string
(
$handle
,
$notification
,
"
testtype
");
...
...
@@ -475,6 +479,7 @@ sub callbackFunc($$$) {
time_all
();
}
}
print
"
$testtype
$testper
\n
";
}
elsif
(
$eventtype
eq
"
SINGLE
"
){
print
"
SINGLE
\n
";
...
...
@@ -516,20 +521,22 @@ sub callbackFunc($$$) {
#############################################################################
#
# Run a test with the oldest destination on the Q.
# destination given in parameters is added to Q.
# if undef is given for destination, just run dest at head of Q.
#
sub
spawnTest
($$)
{
my
(
$linkdest
,
$testtype
)
=
@_
;
use
Errno
qw(EAGAIN)
;
#exit and don't fork if the max number of tests is already being run
if
(
getRunningTestsCnt
(
$testtype
)
>=
$MAX_SIMU_TESTS
{
$testtype
}
){
# print "Testcnt = ".getRunningTestsCnt($testtype);
# print "Too many running tests of type $testtype\n";
#add this to queue if it doesn't exist already
#this seach is inefficient... use a hash? sparse array? sorted list?
my
$flag_duplicate
=
0
;
#
#Add to queue if it doesn't exist already
# this seach is inefficient... use a hash? sparse array? sorted list?
my
$flag_duplicate
=
0
;
if
(
$linkdest
ne
undef
){
foreach
my
$element
(
@
{
$waitq
{
$testtype
}}
){
if
(
$element
eq
$linkdest
){
$flag_duplicate
=
1
;
...
...
@@ -537,12 +544,22 @@ sub spawnTest($$)
}
if
(
$flag_duplicate
==
0
){
unshift
@
{
$waitq
{
$testtype
}},
$linkdest
;
# print
"WAIT Q: ADDED $linkdest
\n";
# print
time_all()." added $linkdest to Q $testtype
\n";
}
}
#exit and don't fork if the max number of tests is already being run
if
(
getRunningTestsCnt
(
$testtype
)
>=
$MAX_SIMU_TESTS
{
$testtype
}
){
return
-
1
;
}
#set the destination to be head of Q.
if
(
scalar
@
{
$waitq
{
$testtype
}}
==
0
){
return
0
;
}
$linkdest
=
pop
@
{
$waitq
{
$testtype
}};
print
time_all
()
.
"
running
$linkdest
/
$testtype
\n
";
FORK:
{
if
(
my
$pid
=
fork
){
#parent
...
...
@@ -569,7 +586,7 @@ sub spawnTest($$)
#command line for "BANDWIDTH TEST"
# print "###########bwtest\n";
exec
"
$workingdir
"
.
"
iperf -c
$linkdest
-t
10
-p
$iperfport
>
$filename
"
"
iperf -c
$linkdest
-t
$iperfduration
-p
$iperfport
>
$filename
"
or
die
"
can't exec: $!
";
}
else
{
warn
"
bad testtype:
$testtype
";
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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