Commit 504e8e9f authored by Christopher Alfeld's avatar Christopher Alfeld

Added exitonwarn library to everything.

Fixed some warnings in assign_wrapper that were subsequently caught.

exitonwarn is a library that, when used in a script, causes it to exit 255
when warnings are sent.  It still shows all warnings, just does an ugly
perl hack to error on script termination.
parent 425a1de9
......@@ -26,7 +26,7 @@ LIBEXEC_STUFF = mkprojdir rmproj mkacct-ctrl rmacct-ctrl \
webstartexp webendexp webbatchexp webkillbatchexp \
assign_wrapper ptopgen
LIB_STUFF = libtbsetup.pm libtestbed.pm snmpit_intel.pm \
LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
snmpit_cisco.pm snmpit_lib.pm snmpit_apc.pm
#
......
......@@ -27,6 +27,10 @@ $DELAYCAPACITY = @DELAYCAPACITY@;
$TBROOT = "@prefix@";
$ENV{'PATH'} = "/usr/bin:$TBROOT/libexec:$TBROOT/sbin:$TBROOT/bin";
$TBDB = "@TBDBNAME@";
$TBLIB = "$TBROOT/lib";
push(@INC,$TBLIB);
require exitonwarn;
$dbh = DBI->connect("DBI:mysql:database=$TBDB;host=localhost") ||
die "Could not connect to DB.\n";
......@@ -398,7 +402,7 @@ while (1) {
" nodes as a left join reserved as b" .
" on a.node_id=b.node_id" .
" where b.node_id is null" .
" and a.role='testnode'");
" and a.role='testnode' and a.type!='dnard'");
if ($numnodes < $minimum_nodes) {
print STDERR "$0: *** Insufficient nodes available.\n";
......@@ -995,12 +999,15 @@ foreach $pnode (keys(%p2vmap)) {
foreach $vnodeport (keys(%portbw)) {
($vnode,$vport) = split(":",$vnodeport);
$pnode = $v2pmap{$vnode};
$pport = $portmap{$vnodeport};
$dbh->do("update interfaces set current_speed=\"$portbw{$vnodeport}\"" .
" where node_id=\"$pnode\" and iface=\"$pport\"") || do {
print STDERR "$0: *** Could not update current_speed on" .
" interfaces. Giving up.\n";
exit(1);
}
# SHARK HACK
if (defined($v2pmap{$vnode})) {
$pnode = $v2pmap{$vnode};
$pport = $portmap{$vnodeport};
$dbh->do("update interfaces set current_speed=\"$portbw{$vnodeport}\"" .
" where node_id=\"$pnode\" and iface=\"$pport\"") || do {
print STDERR "$0: *** Could not update current_speed on" .
" interfaces. Giving up.\n";
exit(1);
}
}
}
$warnings = 0;
$SIG{__WARN__} = sub { print STDERR $_[0];$warnings++; };
END {
if ($warnings > 0) {
print STDERR "$warnings warnings.\n";
# This actually causes perl to complain and exit with 255
exit(1);
}
}
1;
......@@ -10,6 +10,9 @@ $switch_speed = 100;
use DBI;
my $TBDB = "@TBDBNAME@";
my $dbh = DBI->connect("DBI:mysql:database=$TBDB;host=localhost");
my $TBROOT = "@prefix@";
push(@INC,"$TBROOT/lib");
require exitonwarn;
%switches=();
%used_switches=();
......@@ -58,7 +61,6 @@ $sharklinks = "";
foreach $node (keys(%nodes)) {
if ($node =~ /^sh/) {
print "node $node shark-shelf:1\n";
$sharklinks .= "link link-$node $node:$node/eth0 cisco1 100 1\n";
} else {
$text = "node $node $nodes{$node}:1 $classes{$nodes{$node}}:1";
$delay_capacity = $nodetypes{$nodes{$node}};
......@@ -107,12 +109,27 @@ sub get_ifacebw {
}
};
# SHARK
$sth = $dbh->prepare("SELECT node_id1,node_id2 from wires" .
" where type=\"Dnard\"");
$sth->execute;
while (($node1,$node2) = $sth->fetchrow_array) {
if (defined($nodes{$node1}) &&
(defined($nodes{$node2}) || defined($switches{$node2}))) {
# Hack until the DB makes sense
if ($node2 ne "cisco1") {next;}
print "link link-$node1 $node1:$node1/eth0 $node2 100 1\n";
}
}
$sth->finish;
# END SHARK
$sth = $dbh->prepare("SELECT node_id1,card1,port1,node_id2,card2,port2" .
" from wires where type=\"Node\"");
$sth->execute;
while (($node1,$card1,$port1,$node2,$card2,$port2) =
$sth->fetchrow_array) {
if (defined($nodes{$node1}) &&
if ((defined($nodes{$node1}) || defined($switches{$node1})) &&
(defined($nodes{$node2}) || defined($switches{$node2}))) {
$iface1 = get_iface($node1,$card1,$port1);
$iface2 = get_iface($node2,$card2,$port2);
......@@ -126,13 +143,29 @@ while (($node1,$card1,$port1,$node2,$card2,$port2) =
if (defined($switches{$node2})) {
$used_switches{$node2} = 1;
}
# !!! - Here we use our knowledge that in the wires table links
# to the switch always come as node2.
print "link link-$node1:$iface1-$node2:$iface2 $node1:$node1/$iface1" .
" $node2:$iface2 $bw 1\n";
}
if (defined($switches{$node1})) {
$used_switches{$node1} = 1;
}
if (defined($switches{$node1}) && defined($switches{$node2})) {
# interswitch link
if (defined($interconnects{"$node1:$node2"})) {
$interconnects{"$node1:$node2"} += $bw;
} else {
$interconnects{"$node1:$node2"} = $bw;
}
} else {
# !!! - Here we use our knowledge that in the wires table links
# to the switch always come as node2.
print "link link-$node1:$iface1-$node2:$iface2 $node1:$node1/$iface1" .
" $node2:$iface2 $bw 1\n";
}
}
}
$sth->finish;
foreach $interconnect (keys(%interconnects)) {
($src,$dst) = split(":",$interconnect);
print "link link-$interconnect $src $dst $interconnects{$interconnect} 1\n";
}
print $sharklinks;
......
......@@ -20,6 +20,7 @@ push(@INC,$TBSETUPLIB);
# Turn off line buffering.
$| = 1;
require exitonwarn;
require libtbsetup;
$dolog = 1;
......
......@@ -21,6 +21,7 @@ push(@INC,$TBSETUPLIB);
# Turn off line buffering.
$| = 1;
require exitonwarn;
require libtbsetup;
if ($#ARGV < 2 || $#ARGV > 3 ||
......
......@@ -5,6 +5,8 @@
my $TBROOT = "@prefix@";
my $DBNAME = "@TBDBNAME@";
push(@INC,"$TBROOT/lib");
require exitonwarn;
#
# Turn off line buffering on output
......
......@@ -24,6 +24,7 @@ push(@INC,$TBSETUPLIB);
# Turn off line buffering.
$| = 1;
require exitonwarn;
require libtbsetup;
$dolog = 1;
......
......@@ -23,6 +23,7 @@ push(@INC,$TBSETUPLIB);
# Turn off line buffering.
$| = 1;
require exitonwarn;
require libtbsetup;
$dolog = 1;
......
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