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
......@@ -13,119 +13,193 @@ if (! getopts($optlist, \%options)) {
die;
}
my $detail;
my $detail = "0";
if (defined($options{"d"})) {
$detail = $options{"d"};
if ($detail =~ /^([0-9]+)$/) {
$detail = $1;
}
else {
die("argument to -d must be integer, not '$detail'.");
}
} else {
$detail = "0";
($options{"d"} =~ /^([0-9]+)$/) or die "argument to -d must be integer, not '$detail'.";
$detail = $1;
}
if (@ARGV != 2) {
printf( "Usage:\ndbtopper [-d <detaillevel>] <pid> <eid>\n" );
die;
}
if (@ARGV != 2) { die "Usage:\ndbtopper [-d <detaillevel>] <pid> <eid>\n"; }
my $pid = $ARGV[0];
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 " .
"WHERE pid='$pid' AND eid='$eid'");
my %nodeip = ();
# I can visualize topologies again, Topper!
print "graph G {\n";
#my %lanips = ();
my $nodes = ();
my $links = ();
while (my ($ips, $type, $vname) = $result->fetchrow) {
$ips =~ s/^\d\://g;
$ips =~ s/\s\d\:/ /g;
$ips =~ s/^192\.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) {
print "{node [label = \"$vname($type) $ips\", shape = box, ";
$label = $i . "(" . $nodes{$i}{"type"} . ") " . $nodes{$i}{"ips"};
} else {
print "{node [label = \"$vname\", shape = box, ";
$label = $i;
}
print "{node [label = \"$label\", shape = box, color = skyblue] " . gvclean($i) . "}\n";
}
print "color = skyblue";
$vname =~ s/[^\w]/_/g;
print "] $vname}\n";
# $lanips{ $vname } .=
}
foreach my $lan (keys %links) {
if ((keys %{$links{$lan}}) == 2) {
# amalgamate into 2 member link.
my $a = (keys %{$links{$lan}})[0];
my $b = (keys %{$links{$lan}})[1];
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 " .
"WHERE pid='$pid' AND eid='$eid'");
print "}\n";
my %lansize = ();
my %lanmap = ();
my %landesc = ();
my %lanput = ();
my %singlemap = ();
exit;
sub min {
my ($a, $b) = @_;
if ($a < $b) { return $a; }
return $b;
}
while (my ($vname, $delay, $bandwidth, $lossrate, $member) = $result->fetchrow) {
$member =~ /^([^\:]+)\:/;
my $fullnodename = $1;
my $nodename = $fullnodename;
$nodename =~ s/[^\w]/_/g;
sub combineloss {
my ($a, $b) = @_;
# print "$a $b";
# $a = $a / 100.0;
# $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;
if ($bandwidth >= 1000000) {
$desc = sprintf( "%.0f", ($bandwidth / 1000000) ) . "Gb";
sub reportbw {
my $bandwidth = shift;
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) {
$desc = sprintf( "%.0f", ($bandwidth / 1000) ) . "Mb";
return sprintf( "%.1f", ($bandwidth / 1000) ) . "Mb";
} elsif ($bandwidth >= 5) {
return sprintf( "%.0f", $bandwidth ) . "kb";
} else {
$desc = sprintf( "%.0f", $bandwidth ) . "kb";
return sprintf( "%.1f", $bandwidth ) . "kb";
}
}
if ($delay > 0) {
$desc .= " " . sprintf( "%1.0f", $delay ) . "msec";
}
sub reportdelay {
my $delay = shift;
if ($delay == 0) { return "0msec"; }
if ($lossrate > 0) {
$desc .= " " . sprintf( "%1.1f", ($lossrate / 100) ) . "\%loss";
if ($delay >= 10) {
return sprintf( "%.0f", $delay ) . "msec";
} else {
return sprintf( "%.1f", $delay ) . "msec";
}
}
if ($detail > 0) {
$landesc{ $vname } = $desc;
sub reportloss {
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 {
$landesc{ $vname } = "";
return sprintf( "%.3f", $losspct ) . "\%loss";
}
}
foreach $i (keys %lanmap) {
my @foo = split ",", $lanmap{$i};
if (scalar( @foo ) == 2) {
print "$foo[0] -- $foo[1] [label = \"$landesc{$i}\"];\n";
sub gendesc {
my ($delay0, $delay1, $bw0, $bw1, $loss0, $loss1) = @_;
my $desc = "";
if ($bw0 == $bw1) {
$desc .= reportbw( $bw0 ) . " ";
} else {
my $lanname = "$i";
if (!exists $lanput{$i}) {
$lanput{$i} = 1;
print "{node [label = $lanname, shape = box, ";
print "color = green";
print "] $lanname}\n";
$desc .= reportbw( $bw0 ) . "/" . reportbw( $bw1 ) . " ";
}
if ($delay0 == $delay1) {
if ($delay0 != 0) {
$desc .= reportdelay( $delay0 ) . " ";
}
foreach $j (@foo) {
print "$j -- $lanname [label = \"$landesc{$i}\"];\n";
} else {
$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;
}
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