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.

tbsetup/tbprerun.tcl

@@ -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)"