tbprerun.tcl 3.66 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
45
46
set ns2ir "$scriptdir/ns2ir/parse.tcl"
set postparse "$scriptdir/ns2ir/postparse.tcl"
set assign "$scriptdir/ir/assign.tcl"
set handle_ip "$scriptdir/ir/handle_ip.tcl"
47
48
set avail "$updir/db/avail"
set ptopgen "$updir/db/ptopgen"
49
set ptopfile "/tmp/testbed[pid].ptop"
50
set reserve "$updir/db/nalloc"
51
set libir "$scriptdir/ir/libir.tcl"
52
53
54

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

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
72
73
74
75
76
outs "Input: $nsFile"
outs "Output: $irFile"
outs "Log: $logFile"
outs ""
outs "Beginning Testbed pre run for $nsFile. [clock format [clock seconds]]"
77
78

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

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

93
94
95
96
97
98
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
}

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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

114
outs "Determining available resources."
115
if {[catch "exec $avail | $ptopgen > $ptopfile 2>@ $logFp" err]} {
116
    outs stderr "Error determining available resources. ($err)"
117
    unlock
118
119
    exit 1
}
120

Christopher Alfeld's avatar
Christopher Alfeld committed
121
outs "Allocating resources - This may take a while."
122
if {[catch "exec $assign $irFile $ptopfile >@ $logFp 2>@ $logFp" err]} {
123
124
    outs stderr "Error allocating resources.  See $logFile and assign.log for more info."
    unlock
125
126
127
    exit 1
}

128
129
130
131
132
133
134
ir read $irFile
set nodemap [ir get /virtual/nodes]
set machines {}
foreach pair $nodemap {
    lappend machines [lindex $pair 1]
}

Christopher Alfeld's avatar
Christopher Alfeld committed
135
outs "Reserving resources."
136
137
if {[catch "exec $reserve $prefix $machines >@ $logFp 2>@ $logFp" err]} {
    outs stderr "Error reserving resources. ($err)"
138
    unlock
139
140
    exit 1
}
141

142
143
unlock

144
145
146
147
148
outs "Allocating IP addresses."
if {[catch "exec $handle_ip $irFile $nsFile >@ $logFp 2>@ $logFp" err]} {
    outs stderr "Error allocating IP addresses. ($err)"
    exit 1
}
149

Christopher Alfeld's avatar
Christopher Alfeld committed
150
outs "Setup finished - $irFile generated."
151
152