Commit d4f2ac72 authored by Christopher Alfeld's avatar Christopher Alfeld
Browse files

Changed to minimize locking time. Now locks to extract current view, unlocks

, runs assign, lock's again to see if resources are still available, and if
not retries.
parent ff479ad2
......@@ -14,6 +14,24 @@ proc outs {args} {
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!"
......@@ -38,12 +56,16 @@ 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 updir [file dirname $scriptdir]/lib
set scriptdir [file dirname $scriptdir]/lib/tbsetup
set sqldir $updir
}
load $sqldir/sql.so
set lockfile "/usr/testbed/locks/tblock"
set ns2ir "$scriptdir/ns2ir/parse.tcl"
set postparse "$scriptdir/ns2ir/postparse.tcl"
......@@ -55,6 +77,7 @@ set ptopgen "$updir/db/ptopgen"
set ptopfile "/tmp/testbed[pid].ptop"
set reserve "$updir/db/nalloc"
set libir "$scriptdir/ir/libir.tcl"
set maxtries 5
source $libir
namespace import TB_LIBIR::ir
......@@ -64,6 +87,9 @@ if {$argc != 3} {
exit 1
}
set DB [sql connect]
sql selectdb $DB tbdb
set nsFile [lindex $argv 2]
set t [split $nsFile .]
set pid [lindex $argv 0]
......@@ -105,51 +131,64 @@ if {[catch "exec $postparse $nsFile $irFile >@ $logFp 2>@ $logFp" err]} {
exit 1
}
outs "Locking the world!"
set wait {15 30 60 600 600}
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."
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
}
set delay [lindex $wait $waiti]
incr waiti
outs "World is locked. Waiting $delay seconds"
after [expr $delay * 1000]
}
close $lockfp
outs "Determining available resources."
if {[catch "exec $avail | $ptopgen > $ptopfile 2>@ $logFp" err]} {
outs stderr "Error determining available resources. ($err)"
unlock
exit 1
}
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."
unlock
exit 1
}
ir read $irFile
set nodemap [ir get /virtual/nodes]
set machines {}
foreach pair $nodemap {
lappend machines [lindex $pair 1]
}
outs "Reserving resources."
if {[catch "exec $reserve $pid $eid $machines >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error reserving resources. ($err)"
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."
unlock
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!"
exit 1
} else {
outs "Resources unavailable. Retrying."
}
}
unlock
exit 1
}
unlock
outs "Allocating IP addresses."
if {[catch "exec $handle_ip $irFile $nsFile >@ $logFp 2>@ $logFp" err]} {
outs stderr "Error allocating IP addresses. ($err)"
......
Supports Markdown
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