Commit 673a4db8 authored by Christopher Alfeld's avatar Christopher Alfeld

Working PERL .in versions.

parent ba892674
#!/usr/bin/perl -w
# tbend
# This cleans up the state after a testbed experiment is finished.
$TBROOT = "@prefix@";
$TBDB = "@TBDBNAME@";
$TBSETUPLIB = "$TBROOT/lib";
$ENV{'PATH'} = "$TBROOT/libexec:$TBROOT/libexec/ir" .
":$TBROOT/libexec/ns2ir:$TBROOT/sbin:$TBROOT/bin";
push(@INC,$TBSETUPLIB);
require libtbsetup;
require 'ctime.pl';
if ($#ARGV != 1) {
print STDERR "Syntax: $0 pid eid\n";
exit(1);
}
($pid,$eid) = @ARGV;
use DBI;
$dbh=&tbs_initdbi($TBDB);
$prefix = "$pid-$eid";
$logfile = "$prefix-end.log";
&tbs_initlog($logfile);
&tbs_out("Id: $prefix\n");
&tbs_out("Log: $logfile\n");
&tbs_out("\n");
&tbs_out("Ending Testbed run for $prefix. " . &ctime(time) . "\n");
&tbs_out("Finding resources.\n");
$sth = $dbh->prepare("SELECT node_id FROM reserved \
WHERE eid=\"$eid\" AND pid=\"$pid\"");
$sth->execute;
@nodes = ();
while (@row = $sth->fetchrow_array) {
push(@nodes,$row[0]);
}
$sth->finish;
&tbs_out("Resetting VLANs\n");
if (&tbs_exec("resetvlans " . join(" ",@nodes))) {
&tbs_out("Failed to reset VLANs\n");
exit(1);
}
&tbs_out("Removing delay entries\n");
foreach (@nodes) {
$sth = $dbh->prepare("DELETE FROM delays WHERE node_id = \"$_\"");
$sth->execute;
$sth->finish;
}
&tbs_out("Freeing resources\n");
if (&tbs_exec("nfree $pid $eid")) {
&tbs_out("Failed to free resources.\n");
exit(1);
}
&tbs_out("Cleanup finished - " . &ctime(time) . "\n");
0;
#!/usr/local/bin/tclsh
proc outs {args} {
global logFp
if {[llength $args] == 1} {
set out stdout
set s [lindex $args 0]
} else {
set out [lindex $args 0]
set s [lindex $args 1]
}
puts $out $s
puts $logFp $s
}
### Bootstrapping code. The whole purpose of this is to find the
# directory containing the script.
set file [info script]
while {![catch "file readlink $file" newfile]} {
set file $newfile
}
set scriptdir [file dirname $file]
if {$scriptdir == "."} {set scriptdir [pwd]}
###
if {[file exists $scriptdir/ns2ir]} {
# development tree
set updir [file dirname $scriptdir]
} else {
# install tree
set updir [file dirname $scriptdir]/lib
set scriptdir [file dirname $scriptdir]/lib
set bindir [file dirname $scriptdir]/bin
set sbindir [file dirname $scriptdir]/sbin
}
set nfree "$bindir/nfree"
set libir "$scriptdir/ir/libir.tcl"
set resetvlans "$sbindir/resetvlans"
load $updir/sql.so
if {$argc != 3 && $argc != 2} {
puts stderr "Syntax: $argv0 <pid> <eid>"
exit 1
}
if {$argc == 3} {
puts stderr "Warning: Ignoring IR file argument."
}
set DB [sql connect]
sql selectdb $DB tbdb
set pid [lindex $argv 0]
set eid [lindex $argv 1]
set id "$pid-$eid"
set logFile "${id}_end.log"
if {[catch "open $logFile a+" logFp]} {
puts stderr "Could not open $logFile for writing."
exit 1
}
outs "Log: $logFile"
outs ""
outs "Ending Testbed run for $id. [clock format [clock seconds]]"
outs "Unallocating resources"
sql query $DB "select node_id from reserved where eid=\"$eid\" and pid=\"$pid\""
set machines {}
while {[set machine [sql fetchrow $DB]] != {}} {
lappend machines $machine
}
outs "Resetting VLANs"
if {[catch "exec $resetvlans $machines >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error reseting vlans ($err)"
exit 1
}
outs "Removing delay entries"
foreach machine $machines {
sql exec $DB "delete from delays where node_id = \"$machine\""
}
if {[catch "exec $nfree $pid $eid >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error freeing resources. ($err)"
exit 1
}
#!/usr/bin/perl -w
# tbprerun
# This is the first program in the tbprerun/tbrun/tbend sequence.
# It's main purpose is to parse the NS input and translate this into
# IR and database.
# Settings
# maxruns is the maximum number of times to run the assignment loop
$maxruns = 5;
# Setting up the paths
$TBROOT = "@prefix@";
$TBSETUPLIB = "$TBROOT/lib";
$TBIRLIB = "$TBROOT/lib/ir";
$ENV{'PATH'} = "/usr/bin:$TBROOT/libexec:$TBROOT/libexec/ir"
. ":$TBROOT/libexec/ns2ir:$TBROOT/sbin:$TBROOT/bin";
push(@INC,$TBSETUPLIB);
push(@INC,$TBIRLIB);
require libtbsetup;
require libir;
require 'ctime.pl';
if ($#ARGV != 2) {
print STDERR "Syntax: $0 pid eid ns_file\n";
exit(1);
}
($pid,$eid,$nsfile) = @ARGV;
$prefix = &tbs_prefix($nsfile);
$irfile = "$prefix.ir";
$logfile = "$prefix.log";
$ptopfile = "/tmp/testbed$$.ptop";
$id = "$pid-$eid";
# This will hold the list of nodes currently assigned.
@nodes = ();
# This routine is called after reservation and frees the reservation.
sub cleanup {
&tbs_exec("nfree $eid $pid");
};
&tbs_initlog($logfile);
&tbs_out("Input: $nsfile\n");
&tbs_out("Output: $irfile\n");
&tbs_out("Log: $logfile\n");
&tbs_out("\n");
&tbs_out("Beginning pre run for $pid-$eid ($nsfile). "
. &ctime(time) . "\n");
if (! -r $nsfile) {
&tbs_out("$nsfile does not exist or is not readable.\n");
exit(1);
}
&tbs_out("Parsing ns input.\n");
if (&tbs_exec("parse.tcl $id $nsfile $irfile")) {
&tbs_out("Parsing failed.\n");
exit(1);
}
if (! -r $irfile) {
&tbs_out("Parse failed to produce output.\n");
&tbs_out(" Make sure you have a 'run' command in your ns file.\n");
exit(1);
}
&tbs_out("Post parsing NS input.");
if (&tbs_exec("postparse $nsfile $irfile")) {
&tbs_out("Postparsing failed.\n");
exit(1);
}
# Now we do a loop with assign/nalloc until we work or give up
$run = 0;
$done = 0;
&tbs_out("Starting assignment.\n");
while ($done == 0) {
$run++;
if ($run > $maxruns) {
&tbs_out("Too many runs - Giving up.\n");
exit(1);
}
&tbs_out("Run: $run\n");
&tbs_out("Determining available resources.\n");
if (&tbs_exec("avail | ptopgen > $ptopfile")) {
&tbs_out("Failed to determine available resources.\n");
exit(1);
}
&tbs_out("Allocating resources - This may take a while.\n");
if (&tbs_exec("assign_wrapper $irfile $ptopfile")) {
&tbs_out("Failed to allocate resources.\n");
&tbs_out(" See $logfile and assign.log for more info.\n");
} else {
# now we need to read what resources are needed from the IR file
eval {&ir_read($irfile)};
if ($@) {
&tbs_out("Could not read $irfile - ($@)\n");
exit(1);
}
$raw = eval {&ir_get("/virtual/nodes")};
if ($@) {
&tbs_out("Could not load /virtual/nodes - ???\n");
exit(1);
}
@nodes = ();
foreach (split("\n",$raw)) {
@info = split;
push(@nodes,$info[1]);
}
&tbs_out("Attempting to reserve resources.\n");
if (&tbs_exec("nalloc $pid $eid " . join(" ",@nodes))) {
&tbs_out("Could not reserve resources.\n");
} else {
&tbs_out("Resources successfully reserved.\n");
$done = 1;
}
}
}
&tbs_out("Syncing database with assignment.\n");
if (&tbs_exec("postassign $irfile")) {
&tbs_out("Error syncing.\n");
&cleanup();
exit(1);
}
&tbs_out("!!! Any further errors will result in partial DB state.\n");
&tbs_out("Allocating IP addresses.\n");
if (&tbs_exec("handle_ip $irfile $nsfile")) {
&tbs_out("Failed to allocate IP addresses.\n");
&cleanup();
exit(1);
}
&tbs_out("Setting up OS state.\n");
if (&tbs_exec("handle_os $irfile $nsfile")) {
&tbs_out("Failed to set up OS state.\n");
&cleanup();
exit(1);
}
&tbs_out("Pre run finished - " . &ctime(time) . "\n");
0;
#!/usr/local/bin/tclsh
proc outs {args} {
global logFp
if {[llength $args] == 1} {
set out stdout
set s [lindex $args 0]
} else {
set out [lindex $args 0]
set s [lindex $args 1]
}
puts $out $s
puts $logFp $s
}
set wait {15 30 60 600 600}
proc lock {} {
global wait lockfile
outs "Locking the world!"
set waiti 0
while {[catch "open $lockfile {WRONLY CREAT EXCL}" lockfp]} {
if {$wait == [llength $waiti]} {
outs stderr "Giving up on locking. If no other tbprerun is running then remove $lockfile manually."
exit 1
}
set delay [lindex $wait $waiti]
incr waiti
outs "World is locked. Waiting $delay seconds"
after [expr $delay * 1000]
}
close $lockfp
}
proc unlock {} {
global lockfile
outs "Unlocking the world!"
if {! [file exists $lockfile]} {
outs stderr "Error: World already unlocked - DB may be corrupted."
} else {
if {[catch "file delete -force $lockfile" err]} {
outs stderr "Error unlocking world ($err)"
}
}
}
proc cleanup {} {
global pid eid nfree logFp
outs "Cleaning up and freeing resources!"
if {[catch "exec $nfree $pid $eid >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error freeing resources. ($err)"
exit 1
}
}
### Bootstrapping code. The whole purpose of this is to find the
# directory containing the script.
set file [info script]
while {![catch "file readlink $file" newfile]} {
set file $newfile
}
set scriptdir [file dirname $file]
if {$scriptdir == "."} {set scriptdir [pwd]}
###
if {[file exists $scriptdir/ns2ir]} {
# development tree
set updir [file dirname $scriptdir]
set sqldir $updir/lib
} else {
# install tree
set topdir [file dirname $scriptdir]
}
load $topdir/lib/sql.so
set lockfile "$topdir/locks/tblock"
set ns2ir "$topdir/libexec/ns2ir/parse.tcl"
set postparse "$topdir/libexec/ns2ir/postparse"
set assign "$topdir/libexec/ir/assign_wrapper"
set postassign "$topdir/libexec/ir/postassign"
set handle_ip "$topdir/libexec/ir/handle_ip"
set handle_os "$topdir/libexec/ir/handle_os"
set avail "$topdir/sbin/avail"
set ptopgen "$topdir/libexec/ptopgen"
set ptopfile "/tmp/testbed[pid].ptop"
set reserve "$topdir/bin/nalloc"
set nfree "$topdir/bin/nfree"
set libir "$topdir/lib/ir/libir.tcl"
set maxtries 5
source $libir
namespace import TB_LIBIR::ir
if {$argc != 3} {
puts stderr "Syntax: $argv0 <pid> <eid> <ns-file>"
exit 1
}
set DB [sql connect]
sql selectdb $DB tbdb
set nsFile [lindex $argv 2]
set t [split $nsFile .]
set pid [lindex $argv 0]
set eid [lindex $argv 1]
set id "$pid-$eid"
set prefix [join [lrange $t 0 [expr [llength $t] - 2]] .]
set irFile "$prefix.ir"
set logFile "$prefix.log"
if {[catch "open $logFile w" logFp]} {
puts stderr "Could not open $logFile for writing."
exit 1
}
outs "Input: $nsFile"
outs "Output: $irFile"
outs "Log: $logFile"
outs ""
outs "Beginning Testbed pre run for $nsFile. [clock format [clock seconds]]"
if {! [file exists $nsFile]} {
outs stderr "$nsFile does not exist"
exit 1
}
outs "Parsing ns input."
if {[catch "exec $ns2ir $id $nsFile $irFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error parsing ns input. ($err)"
exit 1
}
if {! [file exists $irFile]} {
outs stderr "$irFile not generated. Make sure you have a 'run' command in your ns file."
exit 1
}
outs "Post Parsing ns input."
if {[catch "exec $postparse $nsFile $irFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error post parsing ns input. ($err)"
exit 1
}
set done 0
set tries 0
while {$done == 0} {
incr tries
lock
outs "Determining available resources."
if {[catch "exec $avail | $ptopgen > $ptopfile 2>@ $logFp" err]} {
outs stderr "Error determining available resources. ($err)"
unlock
exit 1
}
unlock
outs "Allocating resources - This may take a while."
if {[catch "exec $assign $irFile $ptopfile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error allocating resources. See $logFile and assign.log for more info."
exit 1
}
ir read $irFile
set nodemap [ir get /virtual/nodes]
set machines {}
foreach pair $nodemap {
lappend machines [lindex $pair 1]
}
lock
outs "Checking if resources still available."
set done 1
foreach machine $machines {
sql query $DB "select node_id from reserved where node_id=\"$machine\""
if {[sql fetchrow $DB] != {}} {
set done 0
sql endquery $DB
break
}
sql endquery $DB
}
if {$done == 1} {
outs "Reserving resources."
if {[catch "exec $reserve $pid $eid $machines >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error reserving resources. ($err)"
unlock
exit 1
}
} else {
if {$tries >= $maxtries} {
outs "Resources unavailable. Giving up!"
unlock
exit 1
} else {
outs "Resources unavailable. Retrying."
}
}
unlock
}
outs "Syncing database with assignment."
if {[catch "exec $postassign $irFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error syncing database. ($err)"
cleanup
exit 1
}
outs "Allocating IP addresses."
if {[catch "exec $handle_ip $irFile $nsFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error allocating IP addresses. ($err)"
cleanup
exit 1
}
outs "Parsing OS information."
if {[catch "exec $handle_os $irFile $nsFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error parsing OS information. ($err)"
cleanup
exit 1
}
outs "Setup finished - $irFile generated."
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