tbprerun.tcl 3.45 KB
Newer Older
1 2
#!/usr/local/bin/tclsh

Christopher Alfeld's avatar
Christopher Alfeld committed
3 4 5 6 7 8 9 10 11 12 13 14 15 16
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
}

17 18 19 20 21 22 23 24 25 26 27 28 29
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)"
	}
    }
}


30 31 32 33 34
### 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
35
}
36 37 38 39 40 41
set scriptdir [file dirname $file]
if {$scriptdir == "."} {set scriptdir [pwd]}
###

set updir [file dirname $scriptdir]

Christopher Alfeld's avatar
Christopher Alfeld committed
42
set lockfile "/usr/testbed/locks/tblock"
43 44
set ns2ir "$updir/ir/ns2ir/parse.tcl"
set assign "$updir/ir/assign.tcl"
45
set handle_ip "$updir/ir/handle_ip.tcl"
46 47
set avail "$updir/db/avail"
set ptopgen "$updir/db/ptopgen"
48
set ptopfile "/tmp/testbed[pid].ptop"
49 50 51 52 53
set reserve "$updir/db/nalloc"
set libir "$updir/ir/libir.tcl"

source $libir
namespace import TB_LIBIR::ir
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

if {$argc != 1} {
    puts stderr "Syntax: $argv0 <ns-file>"
    exit 1
}

set nsFile [lindex $argv 0]
set t [split $nsFile .]
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
}

Christopher Alfeld's avatar
Christopher Alfeld committed
71 72 73 74 75
outs "Input: $nsFile"
outs "Output: $irFile"
outs "Log: $logFile"
outs ""
outs "Beginning Testbed pre run for $nsFile. [clock format [clock seconds]]"
76 77

if {! [file exists $nsFile]} {
Christopher Alfeld's avatar
Christopher Alfeld committed
78
    outs stderr "$nsFile does not exist"
79 80 81
    exit 1
}

Christopher Alfeld's avatar
Christopher Alfeld committed
82
outs "Parsing ns input."
83
if {[catch "exec $ns2ir $nsFile $irFile >@ $logFp 2>@ $logFp" err]} {
Christopher Alfeld's avatar
Christopher Alfeld committed
84
    outs stderr "Error parsing ns input. ($err)"
85 86 87
    exit 1
}
if {! [file exists $irFile]} {
Christopher Alfeld's avatar
Christopher Alfeld committed
88
    outs stderr "$irFile not generated.  Make sure you have a 'run' command in your ns file."
89 90 91
    exit 1
}

92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
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."
	exit 1
    }
    set delay [lindex $wait $waiti]
    incr waiti
    outs "World is locked.  Waiting $delay seconds"
    after [expr $delay * 1000]
}
close $lockfp

107
outs "Determining available resources."
108
if {[catch "exec $avail type=pc ver extras | $ptopgen > $ptopfile 2>@ $logFp" err]} {
109
    outs stderr "Error determining available resources. ($err)"
110
    unlock
111 112
    exit 1
}
113

Christopher Alfeld's avatar
Christopher Alfeld committed
114
outs "Allocating resources - This may take a while."
115
if {[catch "exec $assign $irFile $ptopfile >@ $logFp 2>@ $logFp" err]} {
116 117
    outs stderr "Error allocating resources.  See $logFile and assign.log for more info."
    unlock
118 119 120
    exit 1
}

121 122 123 124 125 126 127
ir read $irFile
set nodemap [ir get /virtual/nodes]
set machines {}
foreach pair $nodemap {
    lappend machines [lindex $pair 1]
}

128
outs "Reserving resources."
129 130
if {[catch "exec $reserve $prefix $machines >@ $logFp 2>@ $logFp" err]} {
    outs stderr "Error reserving resources. ($err)"
131
    unlock
132 133
    exit 1
}
134

135 136
unlock

137 138 139 140 141 142
outs "Allocating IP addresses."
if {[catch "exec $handle_ip $irFile $nsFile >@ $logFp 2>@ $logFp" err]} {
    outs stderr "Error allocating IP addresses. ($err)"
    exit 1
}

Christopher Alfeld's avatar
Christopher Alfeld committed
143
outs "Setup finished - $irFile generated."
144 145