diff --git a/vis/dbtopper.in b/vis/dbtopper.in
index aa20b6b22fa51c20220a661575a8a3f14853c9f4..b320fa36955ca2ee58397efc7da3b1441eaf75af 100755
--- a/vis/dbtopper.in
+++ b/vis/dbtopper.in
@@ -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;
+}