Commit 734f5b50 authored by Christopher Alfeld's avatar Christopher Alfeld
Browse files

Added lots more error checking and now supports the set-lan-loss command.

parent 07e191a1
#!/usr/bin/perl -w
#!/usr/bin/perl
# This handles some of the TB commands.
......@@ -16,6 +16,12 @@ if ($#ARGV != 1) {
($nsfile,$irfile) = @ARGV;
use DBI;
$driver = "mysql";
$dbh = DBI->connect("DBI:$driver:database=tbdb;host=localhost")
|| die "Could not connect to DB.\n";
# This contains a list of error messages
@ERRORS = ();
......@@ -33,6 +39,45 @@ if ($@) {
}
@nodes = split("\n",$raw);
# Set up a nodes array, just membership
foreach (@nodes) {
split;
$nodes{$_[0]} = 1;
}
# Read in lans from ir file.
$raw = eval {&ir_get("/topology/lans")};
if ($@) {
print STDERR "Incomplete IR - No /topology/lans ($@)\n";
exit(1);
}
# Shove it in a membership array
foreach (split("\n",$raw)) {
split;
$lans{$_[0]} = 1;
}
# Read in links
$raw = eval {&ir_get("/topology/links")};
if ($@) {
print STDERR "Incomplete IR - No /topology/links ($@)\n";
exit(1);
}
# Shove it in a membership array
foreach (split("\n",$raw)) {
split;
$links{"$_[1]:$_[3]"} = 1;
}
# Read in possible hardware types - we add shark_shelf manually
$hwtypes{"shark-shelf"} = 1;
$sth = $dbh->prepare("SELECT type from node_types");
$sth->execute;
while (@row = $sth->fetchrow_array) {
$hwtypes{$row[0]} = 1;
}
$sth->finish;
open(NSFILE,$nsfile) || do {
print STDERR "Could not open $nsfile\n";
exit(1);
......@@ -46,22 +91,63 @@ while (<NSFILE>) {
@line = split;
if ($line[1] eq "set-hardware") {
if ($#line != 3) {
print "!\n";
push(@ERRORS,"Syntax: set-hardware node type");
} else {
# hwtype(node) = type
$hwtype{$line[2]} = $line[3];
next;
}
if (! defined($nodes{$line[2]})) {
push(@ERRORS,"$line[2] is not a valid node.");
next;
}
if (! defined($hwtypes{$line[3]})) {
push(@ERRORS,"$line[3] is not a valid hw type.");
next;
}
# hwtype(node) = type
$hwtype{$line[2]} = $line[3];
} elsif ($line[1] eq "set-link-loss") {
if ($#line != 4) {
push(@ERRORS,"Syntax: set-link-loss src dst loss_rate");
next;
}
if ((! defined($nodes{$line[2]})) &&
(! defined($lans{$line[2]}))) {
push(@ERRORS,"$line[2] is not a valid node.");
next;
}
if ((! defined($nodes{$line[3]})) &&
(! defined($lans{$line[3]}))) {
push(@ERRORS,"$line[3] is not a valid node.");
next;
}
if (! defined($links{"$line[2]:$line[3]"})) {
push(@ERRORS,"No link between $line[2] and $line[3]");
next;
}
if ( ((! ($line[4] =~ /^[0-9]+(\.[0-9]+)?$/)) &&
(! ($line[4] =~ /^\.[0-9]+$/))) ||
($line[4] < 0) || ($line[4] > 1)) {
push(@ERRORS,"$line[4] not between 0.0 and 1.0");
next;
}
# linkloss(src:dst) = loss
$linkloss{"$line[2]:$line[3]"} = $line[4];
} elsif ($line[1] eq "set-lan-loss") {
if ($#line != 3) {
push(@ERRORS,"Syntax: set-lan-loss lan loss_rate");
} else {
# linkloss(src:dst) = loss
if ( (! ($line[4] =~ /[0-9]*(\.[0-9]+)?/)) ||
($line[4] < 0) || ($line[4] > 1)) {
push(@ERRORS,"$line[4] must be between 0.0 and 1.0");
} else {
$linkloss{"$line[2]:$line[3]"} = $line[4];
if (! defined($lans{$line[2]})) {
push(@ERRORS,"$line[2] is not a valid lan.");
next;
}
if ( ((! ($line[3] =~ /^[0-9]+(\.[0-9]+)?$/)) &&
(! ($line[3] =~ /^\.[0-9]+$/))) ||
($line[3] < 0) || ($line[3] > 1)) {
push(@ERRORS, "$line[3] not between 0.0 and 1.0");
next;
}
# lanloss(lan) = loss
$lanloss{$line[2]} = $line[3];
}
}
}
......@@ -106,4 +192,22 @@ foreach (@links) {
}
&ir_set("/topology/links",join("\n",@newlinks) . "\n");
# Set lan loss
$raw = eval{&ir_get("/topology/lans")};
if ($@) {
print STDERR "Incomplete IR - Could not find /topology/lans\n";
exit(1);
}
@links = split("\n",$raw);
@newlinks = ();
foreach (@links) {
@info = split;
if (defined($lanloss{$info[0]})) {
push(@newlans,"$_ $lanloss{$info[0]}");
} else {
push(@newlans,"$_ 0.0");
}
}
&ir_set("/topology/lans",join("\n",@newlans) . "\n");
&ir_write($irfile);
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