Skip to content
Snippets Groups Projects
Commit adfb268c authored by Chad Barb's avatar Chad Barb
Browse files

Fixed issues with delay and lossrate aggregation.

(punting for today on indicating directions for non-symmetric attributes,
though both are listed.)
parent fb8a2fce
No related branches found
No related tags found
No related merge requests found
...@@ -13,119 +13,193 @@ if (! getopts($optlist, \%options)) { ...@@ -13,119 +13,193 @@ if (! getopts($optlist, \%options)) {
die; die;
} }
my $detail; my $detail = "0";
if (defined($options{"d"})) { if (defined($options{"d"})) {
$detail = $options{"d"}; ($options{"d"} =~ /^([0-9]+)$/) or die "argument to -d must be integer, not '$detail'.";
if ($detail =~ /^([0-9]+)$/) { $detail = $1;
$detail = $1;
}
else {
die("argument to -d must be integer, not '$detail'.");
}
} else {
$detail = "0";
} }
if (@ARGV != 2) { if (@ARGV != 2) { die "Usage:\ndbtopper [-d <detaillevel>] <pid> <eid>\n"; }
printf( "Usage:\ndbtopper [-d <detaillevel>] <pid> <eid>\n" );
die;
}
my $pid = $ARGV[0]; my $pid = $ARGV[0];
my $eid = $ARGV[1]; my $eid = $ARGV[1];
# my $result = DBQueryFatal("SELECT vname FROM delays WHERE pid='$pid' AND eid='$eid""
my $result = DBQueryFatal("SELECT ips, type, vname FROM virt_nodes " . my $result = DBQueryFatal("SELECT ips, type, vname FROM virt_nodes " .
"WHERE pid='$pid' AND eid='$eid'"); "WHERE pid='$pid' AND eid='$eid'");
my %nodeip = (); my $nodes = ();
my $links = ();
# I can visualize topologies again, Topper!
print "graph G {\n";
#my %lanips = ();
while (my ($ips, $type, $vname) = $result->fetchrow) { while (my ($ips, $type, $vname) = $result->fetchrow) {
$ips =~ s/^\d\://g; $ips =~ s/^\d\://g;
$ips =~ s/\s\d\:/ /g; $ips =~ s/\s\d\:/ /g;
$ips =~ s/^192\.168//g; $ips =~ s/^192\.168//g;
$ips =~ s/\s192\.168/ /g; $ips =~ s/\s192\.168/ /g;
$nodeip{ $vname } = $ips;
$nodes{$vname}{"ips"} = $ips;
$nodes{$vname}{"type"} = $type;
# $nodes{$vname}{"color"} = "skyblue";
}
$result = DBQueryFatal("SELECT vname, delay, bandwidth, lossrate," .
"rdelay, rbandwidth, rlossrate," .
"member FROM virt_lans " .
"WHERE pid='$pid' AND eid='$eid'");
while (my ($vname, $delay, $bandwidth, $lossrate, $rdelay, $rbandwidth, $rlossrate, $member) =
$result->fetchrow) {
$member =~ s/\:.*//;
$links{$vname}{$member}{"delay"} = $delay;
$links{$vname}{$member}{"bw"} = $bandwidth;
$links{$vname}{$member}{"loss"} = $lossrate;
$links{$vname}{$member}{"rdelay"} = $rdelay;
$links{$vname}{$member}{"rbw"} = $rbandwidth;
$links{$vname}{$member}{"rloss"} = $rlossrate;
}
print "graph G {\n";
foreach my $i (keys %nodes) {
my $label = "";
if ($detail > 0) { if ($detail > 0) {
print "{node [label = \"$vname($type) $ips\", shape = box, "; $label = $i . "(" . $nodes{$i}{"type"} . ") " . $nodes{$i}{"ips"};
} else { } else {
print "{node [label = \"$vname\", shape = box, "; $label = $i;
} }
print "{node [label = \"$label\", shape = box, color = skyblue] " . gvclean($i) . "}\n";
}
print "color = skyblue"; foreach my $lan (keys %links) {
if ((keys %{$links{$lan}}) == 2) {
$vname =~ s/[^\w]/_/g; # amalgamate into 2 member link.
print "] $vname}\n"; my $a = (keys %{$links{$lan}})[0];
my $b = (keys %{$links{$lan}})[1];
# $lanips{ $vname } .= my $delaya2b = $links{$lan}{$a}{"delay"} + $links{$lan}{$b}{"rdelay"};
} my $delayb2a = $links{$lan}{$b}{"delay"} + $links{$lan}{$a}{"rdelay"};
my $bwa2b = min( $links{$lan}{$a}{"bw"}, $links{$lan}{$b}{"rbw"} );
my $bwb2a = min( $links{$lan}{$b}{"bw"}, $links{$lan}{$a}{"rbw"} );
my $lossa2b = combineloss( $links{$lan}{$a}{"loss"}, $links{$lan}{$b}{"rloss"} );
my $lossb2a = combineloss( $links{$lan}{$b}{"loss"}, $links{$lan}{$a}{"rloss"} );
my $desc = "";
if ($detail > 0) {
$desc = gendesc( $delaya2b, $delayb2a, $bwa2b, $bwb2a, $lossa2b, $lossb2a );
}
print gvclean($a) . " -- " . gvclean($b). " [label = \"$desc\"];\n";
} else {
# make a lan node.
print "{node [label = \"$lan\", shape = box, color = green] " . gvclean($lan) . "}\n";
foreach my $node (keys %{$links{$lan}}) {
my $delayin = $links{$lan}{$node}{"delay"};
my $delayout = $links{$lan}{$node}{"rdelay"};
my $bwin = $links{$lan}{$node}{"bw"};
my $bwout = $links{$lan}{$node}{"rbw"};
my $lossin = $links{$lan}{$node}{"loss"};
my $lossout = $links{$lan}{$node}{"rloss"};
my $desc = "";
if ($detail > 0) {
$desc = gendesc( $delayin, $delayout, $bwin, $bwout, $lossin, $lossout );
}
print gvclean($lan) . " -- " . gvclean($node) . " [label = \"$desc\"];\n";
}
}
}
$result = DBQueryFatal("SELECT vname, delay, bandwidth, lossrate, member FROM virt_lans " . print "}\n";
"WHERE pid='$pid' AND eid='$eid'");
my %lansize = (); exit;
my %lanmap = ();
my %landesc = ();
my %lanput = ();
my %singlemap = ();
sub min {
my ($a, $b) = @_;
if ($a < $b) { return $a; }
return $b;
}
while (my ($vname, $delay, $bandwidth, $lossrate, $member) = $result->fetchrow) { sub combineloss {
$member =~ /^([^\:]+)\:/; my ($a, $b) = @_;
my $fullnodename = $1; # print "$a $b";
my $nodename = $fullnodename; # $a = $a / 100.0;
$nodename =~ s/[^\w]/_/g; # $b = $b / 100.0;
return (1.0 - ((1.0 - $a) * (1.0 - $b)));
}
$lanmap{$vname} .= $nodename . ","; sub gvclean {
my $n = shift;
$n =~ s/\W/_/g;
return $n;
}
my $desc; sub reportbw {
if ($bandwidth >= 1000000) { my $bandwidth = shift;
$desc = sprintf( "%.0f", ($bandwidth / 1000000) ) . "Gb"; if ($bandwidth >= 5000000) {
return sprintf( "%.0f", ($bandwidth / 1000000) ) . "Gb";
} elsif ($bandwidth >= 1000000) {
return sprintf( "%.1f", ($bandwidth / 1000000) ) . "Gb";
} elsif ($bandwidth >= 5000) {
return sprintf( "%.0f", ($bandwidth / 1000) ) . "Mb";
} elsif ($bandwidth >= 1000) { } elsif ($bandwidth >= 1000) {
$desc = sprintf( "%.0f", ($bandwidth / 1000) ) . "Mb"; return sprintf( "%.1f", ($bandwidth / 1000) ) . "Mb";
} elsif ($bandwidth >= 5) {
return sprintf( "%.0f", $bandwidth ) . "kb";
} else { } else {
$desc = sprintf( "%.0f", $bandwidth ) . "kb"; return sprintf( "%.1f", $bandwidth ) . "kb";
} }
}
if ($delay > 0) { sub reportdelay {
$desc .= " " . sprintf( "%1.0f", $delay ) . "msec"; my $delay = shift;
} if ($delay == 0) { return "0msec"; }
if ($lossrate > 0) { if ($delay >= 10) {
$desc .= " " . sprintf( "%1.1f", ($lossrate / 100) ) . "\%loss"; return sprintf( "%.0f", $delay ) . "msec";
} else {
return sprintf( "%.1f", $delay ) . "msec";
} }
}
if ($detail > 0) { sub reportloss {
$landesc{ $vname } = $desc; my $losspct = shift;
$losspct *= 100;
if ($losspct < 0.0001) { return "0\%loss"; }
if ($losspct > 5) {
return sprintf( "%.0f", $losspct ) . "\%loss";
} elsif ($losspct > 1) {
return sprintf( "%.1f", $losspct ) . "\%loss";
} elsif ($losspct > 0.1) {
return sprintf( "%.2f", $losspct ) . "\%loss";
} else { } else {
$landesc{ $vname } = ""; return sprintf( "%.3f", $losspct ) . "\%loss";
} }
} }
foreach $i (keys %lanmap) { sub gendesc {
my @foo = split ",", $lanmap{$i}; my ($delay0, $delay1, $bw0, $bw1, $loss0, $loss1) = @_;
if (scalar( @foo ) == 2) { my $desc = "";
print "$foo[0] -- $foo[1] [label = \"$landesc{$i}\"];\n";
if ($bw0 == $bw1) {
$desc .= reportbw( $bw0 ) . " ";
} else { } else {
my $lanname = "$i"; $desc .= reportbw( $bw0 ) . "/" . reportbw( $bw1 ) . " ";
if (!exists $lanput{$i}) { }
$lanput{$i} = 1;
print "{node [label = $lanname, shape = box, "; if ($delay0 == $delay1) {
print "color = green"; if ($delay0 != 0) {
print "] $lanname}\n"; $desc .= reportdelay( $delay0 ) . " ";
} }
foreach $j (@foo) { } else {
print "$j -- $lanname [label = \"$landesc{$i}\"];\n"; $desc .= reportdelay( $delay0 ) . "/" . reportdelay( $delay1 ) . " ";
}
if ($loss0 == $loss1) {
if ($loss0 != 0.0) {
$desc .= reportloss( $loss0 ) . " ";
} }
} else {
$desc .= reportloss( $loss0 ) . "/" . reportloss( $loss1 ) . " ";
} }
}
print "}\n"; $desc =~ s/\s$//g;
return $desc;
}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment