Commit 70631f66 authored by Christopher Alfeld's avatar Christopher Alfeld

Changed format of error messages to be more like 'make' and more noticable.

parent a2cf8ef9
......@@ -216,7 +216,7 @@ sub getbandwidth {
# Open the TOP file
$topfile = "$pid-$eid-$$.top";
open(TOPFILE,"> $topfile") || do {
print STDERR "Could not open $topfile.\n";
print STDERR "$0: *** Could not open $topfile.\n";
exit(1);
};
......@@ -372,7 +372,7 @@ while (1) {
" and a.type != \"shark\"");
if ($numnodes < $minimum_nodes) {
print STDERR "Insufficient nodes available.\n";
print STDERR "$0: *** Insufficient nodes available.\n";
exit(2);
}
......@@ -436,10 +436,10 @@ while (1) {
last SWITCH1;
};
/^interswitch$/ && do {
print STDERR "Unsupported link type: interswitch.\n";
print STDERR "$0: *** Unsupported link type: interswitch.\n";
};
/^direct$/ && do {
print STDERR "Unsupported link type: direct.\n";
print STDERR "$0: *** Unsupported link type: direct.\n";
};
print "Found garbage: $line\n";
}
......@@ -494,7 +494,7 @@ while (1) {
if ($desires > 0) {
$exitcode += 16;
}
print "Reached run limit. Giving up.\n";
print "$0: *** Reached run limit. Giving up.\n";
exit($exitcode);
}
$currentrun++;
......@@ -807,7 +807,8 @@ foreach $vlan (keys(%vlans)) {
$dbh->do("insert into vlans (id,pid,eid,virtual,members) values" .
" (0,\"$pid\",\"$eid\",\"$lan\",\"" .
join(" ",@$members) . "\")") || do {
print STDERR "Could not update vlans table. Giving up.\n";
print STDERR "$0: *** Could not update vlans table." .
" Giving up.\n";
exit(1);
};
}
......@@ -819,7 +820,8 @@ foreach $delay (keys(%delays)) {
",delay,bandwidth,lossrate,vname)" .
" values (\"$pid\",\"$eid\",\"$pnode\",\"$int0\",\"$int1\"".
",$delay,$bandwidth,$lossrate,\"$vname\")") || do {
print STDERR "Could not update delays table. Giving up.\n";
print STDERR "$0: *** Could not update delays table." .
" Giving up.\n";
exit(1);
};
}
......@@ -833,7 +835,8 @@ foreach $vnodeport (keys(%portmap)) {
$dbh->do("insert into portmap (pid,eid,vnode,vport,pport)" .
" values (\"$pid\",\"$eid\",\"$vnode\"" .
",\"$vport\",\"$pport\")") || do {
print STDERR "Could not update portmap table. Giving up.\n";
print STDERR "$0: *** Could not update portmap table." .
" Giving up.\n";
exit(1);
};
# Shark Hack
......@@ -843,7 +846,8 @@ foreach $vnodeport (keys(%portmap)) {
foreach $shark (@{$sharkshelves{$vnode}}) {
$dbh->do("update interfaces set IPalias=\"$ips{$shark}\" where" .
" node_id = \"$shelf-$i\"") || do {
print STDERR "Could not update IPalias for $shelf-$i.\n";
print STDERR "$0: *** Could not update IPalias" .
" for $shelf-$i.\n";
exit(1);
};
$i++;
......@@ -851,8 +855,8 @@ foreach $vnodeport (keys(%portmap)) {
} else {
$dbh->do("update interfaces set IP=\"$ips{$vnodeport}\" where" .
" node_id = \"$v2pmap{$vnode}\" and iface = \"$pport\"") || do {
print STDERR "Could not update interfaces table.\n" .
" Giving up.\n";
print STDERR "$0: *** Could not update interfaces" .
" table. Giving up.\n";
exit(1);
};
}
......@@ -897,7 +901,7 @@ foreach $pair (@nodepairs) {
" tarballs=\"$tarfiles\"," .
" startupcmd=\"$startupcmd\"" .
" where node_id=\"$pnode\"")) {
print STDERR "Could not update nodes table.\n" .
print STDERR "$0: *** Could not update nodes table." .
" Giving up.\n";
exit(1);
}
......@@ -914,7 +918,7 @@ foreach $pair (@nodepairs) {
" startstatus=\"none\"," .
" ready=0" .
" where node_id=\"$pnode\"")) {
print STDERR "Could not update nodes table.\n" .
print STDERR "$0: *** Could not update nodes table." .
" Giving up.\n";
exit(1);
}
......@@ -931,7 +935,8 @@ foreach $pnode (keys(%p2vmap)) {
$vname = (split(":",$shark))[0];
$dbh->do("update reserved set vname=\"$vname\" where" .
" node_id = \"$pnode-$i\"") || do {
print STDERR "Could not update reserved table. Giving up.\n";
print STDERR "$0: *** Could not update reserved" .
" table. Giving up.\n";
exit(1);
};
$i++;
......@@ -939,7 +944,8 @@ foreach $pnode (keys(%p2vmap)) {
} else {
$dbh->do("update reserved set vname=\"$vnode\"" .
" where node_id = \"$pnode\"") || do {
print STDERR "Could not update reserved table. Giving up.\n";
print STDERR "$0: *** Could not update reserved" .
" table. Giving up.\n";
exit(1);
};
}
......
......@@ -90,7 +90,7 @@ LanLink instproc fill_ips {} {
}
}
if {$ip == {}} {
perror "ERROR: Ran out of IP addresses in subnet $subnet."
perror "Ran out of IP addresses in subnet $subnet."
set ip "255.255.255.255"
}
$node ip $port $ip
......
......@@ -56,7 +56,7 @@ proc var_import {varspec} {
###
proc perror {msg} {
var_import ::GLOBALS::errors
puts stderr $msg
puts stderr "$0: *** $msg"
set errors 1
}
......@@ -271,7 +271,7 @@ proc parse_bw {bspec} {
Gb {return [expr int($bw*1000)]}
Gbps {return [expr int($bw*1000)]}
default {
perror "ERROR: Unknown bandwidth unit $unit."
perror "Unknown bandwidth unit $unit."
return 100
}
}
......@@ -291,7 +291,7 @@ proc parse_delay {dspec} {
ms {return [expr int($delay)]}
ns {return [expr int($delay/1000)]}
default {
perror "ERROR: Unknown delay unit $unit."
perror "Unknown delay unit $unit."
return 0
}
}
......@@ -307,6 +307,6 @@ source ${GLOBALS::nsfile}
sql disconnect ${GLOBALS::DB}
if {${GLOBALS::ran} == 0} {
perror "ERROR: No 'Simulator run' statement found."
perror "No 'Simulator run' statement found."
}
exit ${GLOBALS::errors}
......@@ -84,11 +84,11 @@ Simulator instproc duplex-link {n1 n2 bw delay type args} {
}
set error 0
if {! [$n1 info class Node]} {
perror "duplex-link $n1 $n2: $n1 is not a node."
perror "\[duplex-link] $n1 is not a node."
set error 1
}
if {! [$n2 info class Node]} {
perror "duplex-link $n1 $n2: $n2 is not a node."
perror "\[duplex-link] $n2 is not a node."
set error 1
}
if {$error} {return}
......@@ -160,12 +160,12 @@ Simulator instproc run {} {
# Check node names.
foreach node [lsort [array names node_list]] {
if {! [regexp {^[-0-9A-Za-z]+$} $node]} {
perror "Invalid node name: $node. Can only contain \[-0-9A-Za-z\] due to DNS limitations."
perror "\[run] Invalid node name $node. Can only contain \[-0-9A-Za-z\] due to DNS limitations."
}
}
foreach lan [lsort [array names lanlink_list]] {
if {! [regexp {^[-0-9A-Za-z]+$} $lan]} {
perror "Invalid lan/link name: $lan. Can only contain \[-0-9A-Za-z\] for symmetry with node DNS limitations."
perror "\[run] Invalid lan/link name $lan. Can only contain \[-0-9A-Za-z\] for symmetry with node DNS limitations."
}
}
......@@ -188,11 +188,11 @@ Simulator instproc run {} {
# This creates an attachment between <node> and <agent>.
Simulator instproc attach-agent {node agent} {
if {! [$agent info class Agent]} {
perror "$agent is not an Agent."
perror "\[attach-agent] $agent is not an Agent."
return
}
if {! [$node info class Node]} {
perror "$node is not a Node."
perror "\[attach-agent] $node is not a Node."
return
}
$agent set_node $node
......@@ -203,11 +203,11 @@ Simulator instproc attach-agent {node agent} {
Simulator instproc connect {src dst} {
set error 0
if {! [$src info class Agent]} {
perror "$src is not an Agent."
perror "\[connect] $src is not an Agent."
set error 1
}
if {! [$dst info class Agent]} {
perror "$dst is not an Agent."
perror "\[connect] $dst is not an Agent."
set error 1
}
if {$error} {return}
......@@ -280,7 +280,7 @@ Simulator instproc get_subnet {} {
return $subnet_base.$i
}
}
perror "ERROR: Ran out of subnets."
perror "Ran out of subnets."
}
# use_subnet
......
......@@ -24,12 +24,12 @@ namespace eval TBCOMPAT {
variable IP
set caller [lindex [info level -1] 0]
if {[regexp $IP $ip] == 0} {
perror "ERROR: $caller - $ip is not a valid IP address."
perror "$caller - $ip is not a valid IP address."
return
}
set port [$node find_port $obj]
if {$port == -1} {
perror "ERROR: $caller - $node is not connected to $obj."
perror "$caller - $node is not connected to $obj."
return
}
$node ip $port $ip
......@@ -61,7 +61,7 @@ namespace eval TBCOMPAT {
proc tb-set-ip {node ip} {
$node instvar portlist
if {[llength $portlist] != 1} {
perror "Error: tb-set-ip - $node does not have a single connection."
perror "\[tb-set-ip] $node does not have a single connection."
return
}
::TBCOMPAT::set-ip $node [lindex $portlist 0] $ip
......@@ -71,21 +71,21 @@ proc tb-set-ip-interface {src dst ip} {
set reallink [$sim find_link $src $dst]
if {$reallink == {}} {
perror \
"ERROR: tb-set-ip-interface - No connection between $src and $dst."
"\[tb-set-ip-interface] No connection between $src and $dst."
return
}
::TBCOMPAT::set-ip $src $reallink $ip
}
proc tb-set-ip-lan {src lan ip} {
if {[$lan info class] != "Lan"} {
perror "ERROR: tb-set-ip-lan - $lan is not a LAN."
perror "\[tb-set-ip-lan] $lan is not a LAN."
return
}
::TBCOMPAT::set-ip $src $lan $ip
}
proc tb-set-ip-link {src link ip} {
if {[$link info class] != "Link"} {
perror "ERROR: tb-set-ip-link - $link is not a link."
perror "\[tb-set-ip-link] $link is not a link."
return
}
::TBCOMPAT::set-ip $src $link $ip
......@@ -95,7 +95,7 @@ proc tb-set-ip-link {src link ip} {
proc tb-set-hardware {node type args} {
var_import ::TBCOMPAT::hwtypes
if {! [info exists hwtypes($type)]} {
perror "ERROR: tb-set-hardware - Invalid hardware type $type."
perror "\[tb-set-hardware] Invalid hardware type $type."
return
}
$node set type $type
......@@ -104,7 +104,7 @@ proc tb-set-node-os {node os} {
if {! ${GLOBALS::anonymous}} {
var_import ::TBCOMPAT::osids
if {! [info exists osids($os)]} {
perror "ERROR: tb-set-node-os - Invalid osid $os."
perror "\[tb-set-node-os] Invalid osid $os."
return
}
}
......@@ -115,7 +115,7 @@ proc tb-set-node-cmdline {node cmdline} {
}
proc tb-set-node-rpms {node args} {
if {$args == {}} {
perr "ERROR: tb-set-node-rpms - No rpms given."
perror "\[tb-set-node-rpms] No rpms given."
return
}
$node set rpms $args
......@@ -125,18 +125,18 @@ proc tb-set-node-startup {node cmd} {
}
proc tb-set-node-tarfiles {node args} {
if {$args == {}} {
perror "ERROR: tb-set-node-tarfiles - tb-set-node-tarfiles <node> (<dir> <tar>)+"
perror "\[tb-set-node-tarfiles] tb-set-node-tarfiles <node> (<dir> <tar>)+"
return
}
if {[expr [llength $args] % 2] != 0} {
perror "ERROR: tb-set-node-tarfiles - Arguments should be node and series of pairs."
perror "\[tb-set-node-tarfiles] Arguments should be node and series of pairs."
return
}
$node set tarfiles $args
}
proc tb-set-node-deltas {node args} {
if {$args == {}} {
perror "ERROR: tb-set-node-deltas - No deltas given."
perror "\[tb-set-node-deltas] No deltas given."
return
}
$node set deltas $args
......@@ -155,7 +155,7 @@ proc tb-set-link-loss {srclink args} {
set sim [$srclink set sim]
set reallink [$sim find_link $srclink $dst]
if {$reallink == {}} {
perror "ERROR: tb-set-link-loss - No link between $srclink and $dst."
perror "\[tb-set-link-loss] No link between $srclink and $dst."
return
}
} else {
......@@ -164,7 +164,7 @@ proc tb-set-link-loss {srclink args} {
}
if {([regexp $FLOAT $lossrate] == 0) ||
($lossrate > 1.0)} {
perror "ERROR: tb-set-link-loss - $lossrate is not a valid loss rate."
perror "\[tb-set-link-loss] $lossrate is not a valid loss rate."
}
$srclink instvar loss
set adjloss [expr 1-sqrt(1-$lossrate)]
......@@ -175,12 +175,12 @@ proc tb-set-link-loss {srclink args} {
proc tb-set-lan-loss {lan lossrate} {
var_import ::TBCOMPAT::FLOAT
if {[$lan info class] != "Lan"} {
perror "ERROR: tb-set-lan-loss - $lan is not a lan."
perror "\[tb-set-lan-loss] $lan is not a lan."
return
}
if {([regexp $FLOAT $lossrate] == 0) ||
($lossrate > 1.0)} {
perror "ERROR: tb-set-lan-loss - $lossrate is not a valid loss rate."
perror "\[tb-set-lan-loss] $lossrate is not a valid loss rate."
}
$lan instvar loss
set adjloss [expr 1-sqrt(1-$lossrate)]
......@@ -191,32 +191,32 @@ proc tb-set-lan-loss {lan lossrate} {
proc tb-set-node-lan-delay {node lan delay} {
if {[$node info class] != "Node"} {
perror "ERROR: tb-set-node-lan-delay - $node is not a node."
perror "\[tb-set-node-lan-delay] $node is not a node."
return
}
if {[$lan info class] != "Lan"} {
perror "ERROR: tb-set-node-lan-delay - $lan is not a lan."
perror "\[tb-set-node-lan-delay] $lan is not a lan."
return
}
set port [$lan get_port $node]
if {$port == {}} {
perror "ERROR: tb-set-node-lan-delay - $node is not in $lan."
perror "\[tb-set-node-lan-delay] $node is not in $lan."
return
}
$lan set delay([list $node $port]) [parse_delay $delay]
}
proc tb-set-node-lan-bandwidth {node lan bw} {
if {[$node info class] != "Node"} {
perror "ERROR: tb-set-node-lan-delay - $node is not a node."
perror "\[tb-set-node-lan-delay] $node is not a node."
return
}
if {[$lan info class] != "Lan"} {
perror "ERROR: tb-set-node-lan-delay - $lan is not a lan."
perror "\[tb-set-node-lan-delay] $lan is not a lan."
return
}
set port [$lan get_port $node]
if {$port == {}} {
perror "ERROR: tb-set-node-lan-delay - $node is not in $lan."
perror "\[tb-set-node-lan-delay] $node is not in $lan."
return
}
$lan set bandwidth([list $node $port]) [parse_bw $bw]
......@@ -224,21 +224,21 @@ proc tb-set-node-lan-bandwidth {node lan bw} {
proc tb-set-node-lan-loss {node lan loss} {
var_import ::TBCOMPAT::FLOAT
if {[$node info class] != "Node"} {
perror "ERROR: tb-set-node-lan-delay - $node is not a node."
perror "\[tb-set-node-lan-delay] $node is not a node."
return
}
if {[$lan info class] != "Lan"} {
perror "ERROR: tb-set-node-lan-delay - $lan is not a lan."
perror "\[tb-set-node-lan-delay] $lan is not a lan."
return
}
set port [$lan get_port $node]
if {$port == {}} {
perror "ERROR: tb-set-node-lan-delay - $node is not in $lan."
perror "\[tb-set-node-lan-delay] $node is not in $lan."
return
}
if {([regexp $FLOAT $loss] == 0) ||
($loss > 1.0)} {
perror "ERROR: tb-set-link-loss - $loss is not a valid loss rate."
perror "\[tb-set-link-loss] $loss is not a valid loss rate."
}
$lan set loss([list $node $port]) $loss
}
......
......@@ -35,7 +35,7 @@ Agent instproc set_application {application} {
Agent instproc connect {dst} {
$self instvar destination
if {$destination != {}} {
perror "connect: $self already has a destination: $destination."
perror "\[connect] $self already has a destination: $destination."
return
}
set destination $dst
......@@ -49,20 +49,20 @@ Agent/UDP instproc connect {dst} {
$self instvar destination
set error 0
if {$node == {}} {
perror "connect: $self is not attached to a node."
perror "\[connect] $self is not attached to a node."
set error 1
}
if {$application == {}} {
perror "connect: $self does not have an attached application."
perror "\[connect] $self does not have an attached application."
set error 1
}
set dest [$destination set node]
if {$dest == {}} {
perror "connect: $destination is not attached to a node."
perror "\[connect] $destination is not attached to a node."
set error 1
}
if {[llength [$node set portlist]] != 1} {
perror "connect: $node must have exactly one link to be a traffic generator."
perror "\[connect] $node must have exactly one link to be a traffic generator."
set error 1
}
set gateport [lindex [$node set portlist] 0]
......@@ -75,7 +75,7 @@ Agent/UDP instproc connect {dst} {
}
}
if {$gate == {}} {
perror "No gateway found for $node."
perror "\[connect] No gateway found for $node."
set error 1
}
if {$error} {return}
......@@ -102,16 +102,16 @@ Agent/Null instproc connect {dst} {
$self instvar destination
set error 0
if {$node == {}} {
perror "connect: $self is not attached to a node."
perror "\[connect] $self is not attached to a node."
set error 1
}
set dest [$destination set node]
if {$dest == {}} {
perror "connect: $destination is not attached to a node."
perror "\[connect] $destination is not attached to a node."
set error 1
}
if {[llength [$node set portlist]] != 1} {
perror "connect: $node must have exactly one link to be a traffic consumer."
perror "\[connect] $node must have exactly one link to be a traffic consumer."
set error 1
}
set gateport [lindex [$node set portlist] 0]
......@@ -124,7 +124,7 @@ Agent/Null instproc connect {dst} {
}
}
if {$gate == {}} {
perror "connect: No gateway found for $node."
perror "\[connect] No gateway found for $node."
set error 1
}
if {$error} {return}
......
......@@ -60,41 +60,42 @@ $sth = $dbh->prepare("SELECT state from experiments where pid = \"$pid\"" .
" and eid = \"$eid\"");
$sth->execute();
if (! (($state) = $sth->fetchrow_array())) {
&tbs_out("No entry in experiments table. Insane.\n");
&tbs_out("$0: *** No entry in experiments table. Insane.\n");
exit(1);
}
if ($force == 0) {
if ($state eq "active") {
&tbs_out("Experiment already running. Try swapping out first.\n");
&tbs_out("$0: *** Experiment already running." .
" Try swapping out first.\n");
exit(1);
} elsif ($state ne "swapped") {
&tbs_out("Experiment in strange state: $state.\n");
&tbs_out("$0: *** Experiment in strange state: $state.\n");
exit(1);
}
} elsif ($state ne "swapped") {
&tbs_out("WARNING: Ignoring experimental state of $state.\n");
&tbs_out("$0: *** WARNING: Ignoring experimental state of $state.\n");
}
if (! $dbh->do("UPDATE experiments set state = \"terminating\" " .
"where pid=\"$pid\" and eid=\"$eid\"")) {
&tbs_out("Could not set intermediate experiment state.\n");
&tbs_out("$0: *** Could not set intermediate experiment state.\n");
}
&tbs_out("Clearing virtual state.\n");
if (! $dbh->do("DELETE from virt_nodes where pid = \"$pid\"" .
" and eid = \"$eid\"")) {
&tbs_out("Could not clear virt_nodes table.\n");
&tbs_out("$0: *** Could not clear virt_nodes table.\n");
$errors = 1;
}
if (! $dbh->do("DELETE from virt_lans where pid = \"$pid\"" .
" and eid = \"$eid\"")) {
&tbs_out("Could not clear virt_lans table.\n");
&tbs_out("$0: *** Could not clear virt_lans table.\n");
$errors = 1;
}
if (! $dbh->do("DELETE from portmap where pid = \"$pid\"" .
" and eid = \"$eid\"")) {
&tbs_out("Could not clear portmap table.\n");
&tbs_out("$0: *** Could not clear portmap table.\n");
$errors = 1;
}
$sth->finish();
......@@ -103,7 +104,7 @@ if ($errors == 0) {
&tbs_out("Marking as ended.\n");
if (! $dbh->do("UPDATE experiments set state = \"ended\"" .
" where pid=\"$pid\" and eid=\"$eid\"")) {
&tbs_out("Could not set experiment state.\n");
&tbs_out("$0: *** Could not set experiment state.\n");
$errors = 1;
}
}
......
......@@ -62,19 +62,19 @@ $sth = $dbh->prepare("SELECT state from experiments where pid = \"$pid\"" .
" and eid = \"$eid\"");
$sth->execute();
if (! (($state) = $sth->fetchrow_array())) {
&tbs_out("No entry in experiments table. Insane.\n");
&tbs_out("$0: *** No entry in experiments table. Insane.\n");
exit(1);
}
$sth->finish();
if ($state ne "new") {
&tbs_out("Experiment is not in the proper state: $state\n");
&tbs_out("$0: *** Experiment is not in the proper state: $state\n");
exit(1);
}
$sth = $dbh->prepare("UPDATE experiments set state = \"prerunning\"" .
"where pid = \"$pid\" and eid = \"$eid\"");
if (! $sth->execute()) {
&tbs_out("Failed to set intermediate state.\n");
&tbs_out("$0: *** Failed to set intermediate state.\n");
exit(1);
}
$sth->finish();
......@@ -85,15 +85,15 @@ sub cleanup {
if (! $dbh->do("DELETE from virt_nodes where pid = \"$pid\"" .
" and eid = \"$eid\"")) {
&tbs_out("Could not clear virt_nodes table.\n");
&tbs_out("$0: *** Could not clear virt_nodes table.\n");
}
if (! $dbh->do("DELETE from virt_lans where pid = \"$pid\"" .
" and eid = \"$eid\"")) {
&tbs_out("Could not clear virt_lans table.\n");
&tbs_out("$0: *** Could not clear virt_lans table.\n");
}
if (! $dbh->do("UPDATE experiments set state = \"new\"" .
"where pid = \"$pid\" and eid = \"$eid\"")) {
&tbs_out("Could not reset experiment state.\n");
&tbs_out("$0: *** Could not reset experiment state.\n");
}
};
......@@ -101,7 +101,7 @@ sub cleanup {
# and tb-* handling.
&tbs_out("Running parser.\n");
if (&tbs_exec("parse.tcl $pid $eid $nsfile")) {
&tbs_out("Parsing failed.\n");
&tbs_out("$0: *** Parsing failed.\n");
exit(1);
}
......@@ -109,7 +109,7 @@ if (&tbs_exec("parse.tcl $pid $eid $nsfile")) {
$sth = $dbh->prepare("UPDATE experiments set state = \"swapped\"" .
"where pid = \"$pid\" and eid = \"$eid\"");
if (! $sth->execute()) {
&tbs_out("Failed to set state.\n");
&tbs_out("$0: *** Failed to set state.\n");
cleanup;
exit(1);
}
......@@ -118,4 +118,3 @@ $sth->finish();
&tbs_out("Pre run finished - " . &ctime(time) . "\n");
0;
......@@ -64,35 +64,36 @@ sub cleanup {
if ($cleanvlans) {
&tbs_out("Removing VLANs\n");
if (&tbs_exec("snmpit -reset $pid $eid")) {
&tbs_out("Failed to clean up VLANs\n");
&tbs_out("$0: *** Failed to clean up VLANs\n");
$errors = 1;
}
&tbs_out("Backing up VLAN configuration\n");
if (&tbs_exec("savevlans")) {
&tbs_out("WARNING: Failed to back up VLAN configuration\n");
&tbs_out("$0: *** WARNING: Failed to back up" .
" VLAN configuration\n");
}
}
&tbs_out("Freeing up nodes.\n");
if (&tbs_exec("nfree $pid $eid")) {
&tbs_out("Could not free resources.\n");
&tbs_out("$0: *** Could not free resources.\n");
}
&tbs_out("Resetting DB.\n");
if (! $dbh->do("DELETE from delays where ".
"pid = \"$pid\" and eid=\"$eid\"")) {
&tbs_out("Could not clear delays table.\n");
&tbs_out("$0: *** Could not clear delays table.\n");
$errors = 1;
}
if (! $dbh->do("DELETE from vlans where ".
"pid = \"$pid\" and eid = \"$eid\"")) {
&tbs_out("Could not clear vlans table.\n");
&tbs_out("$0: *** Could not clear vlans table.\n");
$errors = 1;
}
if (! $dbh->do("UPDATE experiments set state = \"swapped\"" .
"where pid = \"$pid\" and eid = \"$eid\"")) {
&tbs_out("Could not reset experiment state.\n");
&tbs_out("$0: *** Could not reset experiment state.\n");
$errors = 1;
}
};
......@@ -104,28 +105,28 @@ $sth = $dbh->prepare("SELECT state from experiments where pid = \"$pid\"" .
" and eid = \"$eid\"");
$sth->execute();
if (! (($state) = $sth->fetchrow_array())) {
&tbs_out("No entry in experiments table. Insane.\n");
&tbs_out("$0: *** No entry in experiments table. Insane.\n");
exit(1);
}
if ($state eq "active") {
&tbs_out("Experiment is already running. Must be swapped out first.\n");
&tbs_out("$0: *** Experiment is already running. Must be swapped out first.\n");
exit(1);
} elsif ($state ne "swapped") {
&tbs_out("Experiment is not in the swapped state: $state.\n");
&tbs_out("$0: *** Experiment is not in the swapped state: $state.\n");
exit(1);
}
$sth = $dbh->prepare("UPDATE experiments set state = \"activating\"" .
"where pid = \"$pid\" and eid = \"$eid\"");
if (! $sth->execute()) {
&tbs_out("Failed to set intermediate state.\n");
&tbs_out("$0: *** Failed to set intermediate state.\n");
}
$sth->finish();
# This does all the virtual to physical mapping and updating the DB state.
&tbs_out("Mapping to physical reality\n");
if ($exitcode = &tbs_exec("assign_wrapper $pid $eid")) {
&tbs_out("Failed to map to reality.\n");
&tbs_out("$0: *** Failed to map to reality.\n");
cleanup;
# Pass exit code through
exit($exitcode >> 8);
......@@ -136,7 +137,7 @@ if ($TESTMODE) {
&tbs_out("Testing run - Stopping here.\n");
if (! $dbh->do("UPDATE experiments set state=\"testing\"" .
" where pid=\"$pid\" and eid=\"$eid\"")) {
&tbs_out("Could not set state to tested.\n");
&tbs_out("$0: *** Could not set state to tested.\n");
cleanup;
exit(1);
}
......@@ -147,7 +148,7 @@ if ($TESTMODE) {
&tbs_out("Setting up VLANs\n");
if (&tbs_exec("snmpit -t $pid $eid")) {
&tbs_out("Failed to set up VLANs\n");
&tbs_out("$0: *** Failed to set up VLANs\n");
cleanup;
exit(1);
}
......@@ -159,26 +160,26 @@ $cleanvlans = 1;
&tbs_out("Backing up VLAN configuration\n");
if (&tbs_exec("savevlans")) {
&tbs_out("WARNING: Failed to back up VLAN configuration\n");
&tbs_out("$0: *** WARNING: Failed to back up VLAN configuration\n");
}
&tbs_out("Setting up mountpoints\n");
if (&tbs_exec("exports_setup")) {
&tbs_out("Failed to setup mountpoints.\n");
&tbs_out("$0: *** Failed to setup mountpoints.\n");
cleanup;
exit(1);
}
&tbs_out("Resetting OS and rebooting.\n");
if (&tbs_exec("os_setup $pid $eid")) {
&tbs_out("Failed to reset OS and reboot nodes.\n");
&tbs_out("$0: *** Failed to reset OS and reboot nodes.\n");
cleanup;
exit(1);
}
&tbs_out("Setting up named maps.\n");
if (&tbs_exec("named_setup")) {
&tbs_out("WARNING: Failed to add node names to named map.\n");
&tbs_out("$0: *** WARNING: Failed to add node names to named map.\n");
#
# This is a non-fatal error.
#
......@@ -186,7 +187,7 @@ if (&tbs_exec("named_setup")) {
&tbs_out("Setting up email lists.\n");
if (&tbs_exec("genelists")) {
&tbs_out("WARNING: Failed to update email lists.\n");
&tbs_out("$0: *** WARNING: Failed to update email lists.\n");
#
# This is a non-fatal error.
#
......@@ -195,7 +196,7 @@ if (&tbs_exec("genelists")) {
&tbs_out("Marking as running.\n");
if (! $dbh->do("UPDATE experiments set state=\"active\"" .
" where pid=\"$pid\" and eid=\"$eid\"")) {
&tbs_out("Could not set experiment state.\n");
&tbs_out("$0: *** Could not set experiment state.\n");
cleanup;
exit(1);
}
......
......@@ -65,32 +65,33 @@ $sth = $dbh->prepare("SELECT state from experiments where pid = \"$pid\"" .
" and eid = \"$eid\"");
$sth->execute();