50 |
|
|
51 |
# Shudder... |
# Shudder... |
52 |
if { $reboot && $type == "target" } { |
if { $reboot && $type == "target" } { |
53 |
reboot_target; |
reboot_target |
54 |
} |
} |
55 |
|
|
56 |
return [call_remote "" open $type]; |
return [call_remote "" open $type] |
57 |
} |
} |
58 |
|
|
59 |
proc remote_raw_open { args } { |
proc remote_raw_open { args } { |
60 |
return [eval call_remote raw open $args]; |
return [eval call_remote raw open $args] |
61 |
} |
} |
62 |
|
|
63 |
# Run the specified COMMANDLINE on the local machine, redirecting input |
# Run the specified COMMANDLINE on the local machine, redirecting input |
75 |
# the kill command will be invoked. |
# the kill command will be invoked. |
76 |
# |
# |
77 |
proc local_exec { commandline inp outp timeout } { |
proc local_exec { commandline inp outp timeout } { |
78 |
# TCL's exec is a pile of crap. It does two very inappropriate things; |
# TCL's exec is a pile of crap. It does two very inappropriate things |
79 |
# firstly, it has no business returning an error if the program being |
# firstly, it has no business returning an error if the program being |
80 |
# executed happens to write to stderr. Secondly, it appends its own |
# executed happens to write to stderr. Secondly, it appends its own |
81 |
# error messages to the output of the command if the process exits with |
# error messages to the output of the command if the process exits with |
92 |
# no way to timeout programs that hang. *sigh* |
# no way to timeout programs that hang. *sigh* |
93 |
# |
# |
94 |
if { "$inp" == "" && "$outp" == "" } { |
if { "$inp" == "" && "$outp" == "" } { |
95 |
set id -1; |
set id -1 |
96 |
set result [catch "eval spawn \{${commandline}\}" pid]; |
set result [catch "eval spawn \{${commandline}\}" pid] |
97 |
if { $result == 0 } { |
if { $result == 0 } { |
98 |
set result2 0; |
set result2 0 |
99 |
} else { |
} else { |
100 |
set pid 0; |
set pid 0 |
101 |
set result2 5; |
set result2 5 |
102 |
} |
} |
103 |
} else { |
} else { |
104 |
# Can you say "uuuuuugly"? I knew you could! |
# Can you say "uuuuuugly"? I knew you could! |
105 |
# All in the name of non-infinite hangs. |
# All in the name of non-infinite hangs. |
106 |
if { $inp != "" } { |
if { $inp != "" } { |
107 |
set inp "< $inp"; |
set inp "< $inp" |
108 |
set mode "r"; |
set mode "r" |
109 |
} else { |
} else { |
110 |
set mode "w"; |
set mode "w" |
111 |
} |
} |
112 |
|
|
113 |
set use_tee 0; |
set use_tee 0 |
114 |
# We add |& cat so that TCL exec doesn't freak out if the |
# We add |& cat so that TCL exec doesn't freak out if the |
115 |
# program writes to stderr. |
# program writes to stderr. |
116 |
if { $outp == "" } { |
if { $outp == "" } { |
117 |
set outp "|& cat" |
set outp "|& cat" |
118 |
} else { |
} else { |
119 |
set outpf "$outp"; |
set outpf "$outp" |
120 |
set outp "> $outp" |
set outp "> $outp" |
121 |
if { $inp != "" } { |
if { $inp != "" } { |
122 |
set use_tee 1; |
set use_tee 1 |
123 |
} |
} |
124 |
} |
} |
125 |
# Why do we use tee? Because open can't redirect both input and output. |
# Why do we use tee? Because open can't redirect both input and output. |
126 |
if { $use_tee } { |
if { $use_tee } { |
127 |
set result [catch {open "| ${commandline} $inp |& tee $outpf" RDONLY} id] ; |
set result [catch {open "| ${commandline} $inp |& tee $outpf" RDONLY} id] |
128 |
} else { |
} else { |
129 |
set result [catch {open "| ${commandline} $inp $outp" $mode} id] ; |
set result [catch {open "| ${commandline} $inp $outp" $mode} id] |
130 |
} |
} |
131 |
|
|
132 |
if { $result != 0 } { |
if { $result != 0 } { |
133 |
global errorInfo |
global errorInfo |
134 |
return [list -1 "open of $commandline $inp $outp failed: $errorInfo"]; |
return [list -1 "open of $commandline $inp $outp failed: $errorInfo"] |
135 |
} |
} |
136 |
set pid [pid $id]; |
set pid [pid $id] |
137 |
set result [catch "spawn -leaveopen $id" result2]; |
set result [catch "spawn -leaveopen $id" result2] |
138 |
} |
} |
139 |
# Prepend "-" to each pid, to generate the "process group IDs" needed by |
# Prepend "-" to each pid, to generate the "process group IDs" needed by |
140 |
# kill. |
# kill. |
141 |
set pgid "-[join $pid { -}]"; |
set pgid "-[join $pid { -}]" |
142 |
verbose "pid is $pid $pgid"; |
verbose "pid is $pid $pgid" |
143 |
if { $result != 0 || $result2 != 0 } { |
if { $result != 0 || $result2 != 0 } { |
144 |
# This shouldn't happen. |
# This shouldn't happen. |
145 |
global errorInfo; |
global errorInfo |
146 |
if [info exists errorInfo] { |
if [info exists errorInfo] { |
147 |
set foo $errorInfo; |
set foo $errorInfo |
148 |
} else { |
} else { |
149 |
set foo ""; |
set foo "" |
150 |
} |
} |
151 |
verbose "spawn -open $id failed, $result $result2, $foo"; |
verbose "spawn -open $id failed, $result $result2, $foo" |
152 |
catch "close $id"; |
catch "close $id" |
153 |
return [list -1 "spawn failed"]; |
return [list -1 "spawn failed"] |
154 |
} |
} |
155 |
|
|
156 |
set got_eof 0; |
set got_eof 0 |
157 |
set output ""; |
set output "" |
158 |
|
|
159 |
# Wait for either $timeout seconds to elapse, or for the program to |
# Wait for either $timeout seconds to elapse, or for the program to |
160 |
# exit. |
# exit. |
161 |
expect { |
expect { |
162 |
-i $spawn_id -timeout $timeout -re ".+" { |
-i $spawn_id -timeout $timeout -re ".+" { |
163 |
append output $expect_out(buffer); |
append output $expect_out(buffer) |
164 |
if { [string length $output] < 512000 } { |
if { [string length $output] < 512000 } { |
165 |
exp_continue -continue_timer; |
exp_continue -continue_timer |
166 |
} |
} |
167 |
} |
} |
168 |
timeout { |
timeout { |
169 |
warning "program timed out."; |
warning "program timed out." |
170 |
} |
} |
171 |
eof { |
eof { |
172 |
set got_eof 1; |
set got_eof 1 |
173 |
} |
} |
174 |
} |
} |
175 |
|
|
178 |
# However, TCL has no kill primitive, so we have to execute an external |
# However, TCL has no kill primitive, so we have to execute an external |
179 |
# command in order to execute the execution. (English. Gotta love it.) |
# command in order to execute the execution. (English. Gotta love it.) |
180 |
if { ! $got_eof } { |
if { ! $got_eof } { |
181 |
verbose "killing $pid $pgid"; |
verbose "killing $pid $pgid" |
182 |
# This is very, very nasty. SH, instead of EXPECT, is used to |
# This is very, very nasty. SH, instead of EXPECT, is used to |
183 |
# run this in the background since, on older CYGWINs, a |
# run this in the background since, on older CYGWINs, a |
184 |
# strange file I/O error occures. |
# strange file I/O error occures. |
185 |
exec sh -c "exec > /dev/null 2>&1 && (kill -2 $pgid || kill -2 $pid) && sleep 5 && (kill -15 $pgid || kill $pid) && sleep 5 && (kill -9 $pgid || kill -9 $pid) &"; |
exec sh -c "exec > /dev/null 2>&1 && (kill -2 $pgid || kill -2 $pid) && sleep 5 && (kill -15 $pgid || kill $pid) && sleep 5 && (kill -9 $pgid || kill -9 $pid) &" |
186 |
} |
} |
187 |
# This will hang if the kill doesn't work. Nothin' to do, and it's not ok. |
# This will hang if the kill doesn't work. Nothin' to do, and it's not ok. |
188 |
catch "close -i $spawn_id"; |
catch "close -i $spawn_id" |
189 |
set r2 [catch "wait -i $spawn_id" wres]; |
set r2 [catch "wait -i $spawn_id" wres] |
190 |
if { $id > 0 } { |
if { $id > 0 } { |
191 |
set r2 [catch "close $id" res]; |
set r2 [catch "close $id" res] |
192 |
} else { |
} else { |
193 |
verbose "waitres is $wres" 2; |
verbose "waitres is $wres" 2 |
194 |
if { $r2 == 0 } { |
if { $r2 == 0 } { |
195 |
set r2 [lindex $wres 3]; |
set r2 [lindex $wres 3] |
196 |
if { [llength $wres] > 4 } { |
if { [llength $wres] > 4 } { |
197 |
if { [lindex $wres 4] == "CHILDKILLED" } { |
if { [lindex $wres 4] == "CHILDKILLED" } { |
198 |
set r2 1; |
set r2 1 |
199 |
} |
} |
200 |
} |
} |
201 |
if { $r2 != 0 } { |
if { $r2 != 0 } { |
202 |
set res "$wres"; |
set res "$wres" |
203 |
} else { |
} else { |
204 |
set res ""; |
set res "" |
205 |
} |
} |
206 |
} else { |
} else { |
207 |
set res "wait failed"; |
set res "wait failed" |
208 |
} |
} |
209 |
} |
} |
210 |
if { $r2 != 0 || $res != "" || ! $got_eof } { |
if { $r2 != 0 || $res != "" || ! $got_eof } { |
211 |
verbose "close result is $res"; |
verbose "close result is $res" |
212 |
set status 1; |
set status 1 |
213 |
} else { |
} else { |
214 |
set status 0; |
set status 0 |
215 |
} |
} |
216 |
verbose "output is $output"; |
verbose "output is $output" |
217 |
if { $outp == "" } { |
if { $outp == "" } { |
218 |
return [list $status $output]; |
return [list $status $output] |
219 |
} else { |
} else { |
220 |
return [list $status ""]; |
return [list $status ""] |
221 |
} |
} |
222 |
} |
} |
223 |
|
|
224 |
# |
# |
225 |
# Execute the supplied program on HOSTNAME. There are four optional arguments; |
# Execute the supplied program on HOSTNAME. There are four optional arguments |
226 |
# the first is a set of arguments to pass to PROGRAM, the second is an |
# the first is a set of arguments to pass to PROGRAM, the second is an |
227 |
# input file to feed to stdin of PROGRAM, the third is the name of an |
# input file to feed to stdin of PROGRAM, the third is the name of an |
228 |
# output file where the output from PROGRAM should be written, and |
# output file where the output from PROGRAM should be written, and |
236 |
# |
# |
237 |
proc remote_exec { hostname program args } { |
proc remote_exec { hostname program args } { |
238 |
if { [llength $args] > 0 } { |
if { [llength $args] > 0 } { |
239 |
set pargs [lindex $args 0]; |
set pargs [lindex $args 0] |
240 |
} else { |
} else { |
241 |
set pargs "" |
set pargs "" |
242 |
} |
} |
243 |
|
|
244 |
if { [llength $args] > 1 } { |
if { [llength $args] > 1 } { |
245 |
set inp "[lindex $args 1]"; |
set inp "[lindex $args 1]" |
246 |
} else { |
} else { |
247 |
set inp "" |
set inp "" |
248 |
} |
} |
249 |
|
|
250 |
if { [llength $args] > 2 } { |
if { [llength $args] > 2 } { |
251 |
set outp "[lindex $args 2]"; |
set outp "[lindex $args 2]" |
252 |
} else { |
} else { |
253 |
set outp "" |
set outp "" |
254 |
} |
} |
255 |
|
|
256 |
# 300 is probably a lame default. |
# 300 is probably a lame default. |
257 |
if { [llength $args] > 3 } { |
if { [llength $args] > 3 } { |
258 |
set timeout "[lindex $args 3]"; |
set timeout "[lindex $args 3]" |
259 |
} else { |
} else { |
260 |
set timeout 300 |
set timeout 300 |
261 |
} |
} |
262 |
|
|
263 |
verbose -log "Executing on $hostname: $program $pargs $inp $outp (timeout = $timeout)" 2; |
verbose -log "Executing on $hostname: $program $pargs $inp $outp (timeout = $timeout)" 2 |
264 |
|
|
265 |
# Run it locally if appropriate. |
# Run it locally if appropriate. |
266 |
if { ![is_remote $hostname] } { |
if { ![is_remote $hostname] } { |
267 |
return [local_exec "$program $pargs" $inp $outp $timeout]; |
return [local_exec "$program $pargs" $inp $outp $timeout] |
268 |
} else { |
} else { |
269 |
return [call_remote "" exec $hostname $program $pargs $inp $outp]; |
return [call_remote "" exec $hostname $program $pargs $inp $outp] |
270 |
} |
} |
271 |
} |
} |
272 |
|
|
273 |
proc standard_exec { hostname args } { |
proc standard_exec { hostname args } { |
274 |
return [eval rsh_exec \"$hostname\" $args]; |
return [eval rsh_exec \"$hostname\" $args] |
275 |
} |
} |
276 |
|
|
277 |
# |
# |
282 |
|
|
283 |
proc remote_close { host } { |
proc remote_close { host } { |
284 |
while { 1 } { |
while { 1 } { |
285 |
set result [call_remote "" close "$host"]; |
set result [call_remote "" close "$host"] |
286 |
if { [remote_pop_conn $host] != "pass" } { |
if { [remote_pop_conn $host] != "pass" } { |
287 |
break; |
break |
288 |
} |
} |
289 |
} |
} |
290 |
return $result; |
return $result |
291 |
} |
} |
292 |
|
|
293 |
proc remote_raw_close { host } { |
proc remote_raw_close { host } { |
294 |
return [call_remote raw close "$host"]; |
return [call_remote raw close "$host"] |
295 |
} |
} |
296 |
|
|
297 |
proc standard_close { host } { |
proc standard_close { host } { |
298 |
global board_info |
global board_info |
299 |
|
|
300 |
if [board_info ${host} exists fileid] { |
if [board_info ${host} exists fileid] { |
301 |
set shell_id [board_info ${host} fileid]; |
set shell_id [board_info ${host} fileid] |
302 |
set pid -1; |
set pid -1 |
303 |
|
|
304 |
verbose "Closing the remote shell $shell_id" 2 |
verbose "Closing the remote shell $shell_id" 2 |
305 |
if [board_info ${host} exists fileid_origid] { |
if [board_info ${host} exists fileid_origid] { |
306 |
set oid [board_info ${host} fileid_origid]; |
set oid [board_info ${host} fileid_origid] |
307 |
set pid [pid $oid]; |
set pid [pid $oid] |
308 |
unset board_info(${host},fileid_origid); |
unset board_info(${host},fileid_origid) |
309 |
} else { |
} else { |
310 |
set result [catch "exp_pid -i $shell_id" pid]; |
set result [catch "exp_pid -i $shell_id" pid] |
311 |
if { $result != 0 || $pid <= 0 } { |
if { $result != 0 || $pid <= 0 } { |
312 |
set result [catch "pid $shell_id" pid]; |
set result [catch "pid $shell_id" pid] |
313 |
if { $result != 0 } { |
if { $result != 0 } { |
314 |
set pid -1; |
set pid -1 |
315 |
} |
} |
316 |
} |
} |
317 |
} |
} |
318 |
if { $pid > 0 } { |
if { $pid > 0 } { |
319 |
verbose "doing kill, pid is $pid"; |
verbose "doing kill, pid is $pid" |
320 |
# This is very, very nasty. SH, instead of EXPECT, is used |
# This is very, very nasty. SH, instead of EXPECT, is used |
321 |
# to run this in the background since, on older CYGWINs, a |
# to run this in the background since, on older CYGWINs, a |
322 |
# strange file I/O error occures. |
# strange file I/O error occures. |
323 |
set pgid "-[join $pid { -}]"; |
set pgid "-[join $pid { -}]" |
324 |
exec sh -c "exec > /dev/null 2>&1 && (kill -2 $pgid || kill -2 $pid) && sleep 5 && (kill $pgid || kill $pid) && sleep 5 && (kill -9 $pgid || kill -9 $pid) &"; |
exec sh -c "exec > /dev/null 2>&1 && (kill -2 $pgid || kill -2 $pid) && sleep 5 && (kill $pgid || kill $pid) && sleep 5 && (kill -9 $pgid || kill -9 $pid) &" |
325 |
} |
} |
326 |
verbose "pid is $pid"; |
verbose "pid is $pid" |
327 |
catch "close -i $shell_id"; |
catch "close -i $shell_id" |
328 |
if [info exists oid] { |
if [info exists oid] { |
329 |
catch "close $oid"; |
catch "close $oid" |
330 |
} |
} |
331 |
catch "wait -i $shell_id"; |
catch "wait -i $shell_id" |
332 |
unset board_info(${host},fileid); |
unset board_info(${host},fileid) |
333 |
verbose "Shell closed."; |
verbose "Shell closed." |
334 |
} |
} |
335 |
return 0; |
return 0 |
336 |
} |
} |
337 |
|
|
338 |
# |
# |
340 |
# characters. |
# characters. |
341 |
# |
# |
342 |
proc remote_binary { host } { |
proc remote_binary { host } { |
343 |
return [call_remote "" binary "$host"]; |
return [call_remote "" binary "$host"] |
344 |
} |
} |
345 |
|
|
346 |
proc remote_raw_binary { host } { |
proc remote_raw_binary { host } { |
347 |
return [call_remote raw binary "$host"]; |
return [call_remote raw binary "$host"] |
348 |
} |
} |
349 |
|
|
350 |
|
|
351 |
|
|
352 |
proc remote_reboot { host } { |
proc remote_reboot { host } { |
353 |
clone_output "\nRebooting ${host}\n"; |
clone_output "\nRebooting ${host}\n" |
354 |
# FIXME: don't close the host connection, or all the remote |
# FIXME: don't close the host connection, or all the remote |
355 |
# procedures will fail. |
# procedures will fail. |
356 |
# remote_close $host; |
# remote_close $host |
357 |
set status [call_remote "" reboot "$host"]; |
set status [call_remote "" reboot "$host"] |
358 |
if [board_info $host exists name] { |
if [board_info $host exists name] { |
359 |
set host [board_info $host name]; |
set host [board_info $host name] |
360 |
} |
} |
361 |
if { [info proc ${host}_init] != "" } { |
if { [info proc ${host}_init] != "" } { |
362 |
${host}_init $host; |
${host}_init $host |
363 |
} |
} |
364 |
return $status; |
return $status |
365 |
} |
} |
366 |
|
|
367 |
proc standard_reboot { host } { |
proc standard_reboot { host } { |
368 |
return ""; |
return "" |
369 |
} |
} |
370 |
# |
# |
371 |
# Download file FILE to DEST. If the optional DESTFILE is specified, |
# Download file FILE to DEST. If the optional DESTFILE is specified, |
376 |
|
|
377 |
proc remote_download { dest file args } { |
proc remote_download { dest file args } { |
378 |
if { [llength $args] > 0 } { |
if { [llength $args] > 0 } { |
379 |
set destfile [lindex $args 0]; |
set destfile [lindex $args 0] |
380 |
} else { |
} else { |
381 |
set destfile [file tail $file]; |
set destfile [file tail $file] |
382 |
} |
} |
383 |
|
|
384 |
if { ![is_remote $dest] } { |
if { ![is_remote $dest] } { |
385 |
if { $destfile == "" || $destfile == $file } { |
if { $destfile == "" || $destfile == $file } { |
386 |
return $file; |
return $file |
387 |
} else { |
} else { |
388 |
set result [catch "exec cp -p $file $destfile" output]; |
set result [catch "exec cp -p $file $destfile" output] |
389 |
if [regexp "same file|are identical" $output] { |
if [regexp "same file|are identical" $output] { |
390 |
set result 0 |
set result 0 |
391 |
set output "" |
set output "" |
396 |
} |
} |
397 |
if { $result != 0 || $output != "" } { |
if { $result != 0 || $output != "" } { |
398 |
perror "remote_download to $dest of $file to $destfile: $output" |
perror "remote_download to $dest of $file to $destfile: $output" |
399 |
return ""; |
return "" |
400 |
} else { |
} else { |
401 |
return $destfile; |
return $destfile |
402 |
} |
} |
403 |
} |
} |
404 |
} |
} |
405 |
|
|
406 |
return [call_remote "" download $dest $file $destfile]; |
return [call_remote "" download $dest $file $destfile] |
407 |
} |
} |
408 |
|
|
409 |
# |
# |
416 |
if [board_info $dest exists nfsdir] { |
if [board_info $dest exists nfsdir] { |
417 |
set destdir [board_info $dest nfsdir] |
set destdir [board_info $dest nfsdir] |
418 |
if [board_info $dest exists nfsroot_server] { |
if [board_info $dest exists nfsroot_server] { |
419 |
set dest [board_info $dest nfsroot_server]; |
set dest [board_info $dest nfsroot_server] |
420 |
} else { |
} else { |
421 |
set dest ""; |
set dest "" |
422 |
} |
} |
423 |
set destfile "$destdir/$destfile"; |
set destfile "$destdir/$destfile" |
424 |
} |
} |
425 |
|
|
426 |
if { "$dest" != "" } { |
if { "$dest" != "" } { |
427 |
set result [rsh_download $dest $file $destfile]; |
set result [rsh_download $dest $file $destfile] |
428 |
if { $result == $destfile } { |
if { $result == $destfile } { |
429 |
return $orig_destfile; |
return $orig_destfile |
430 |
} else { |
} else { |
431 |
return $result; |
return $result |
432 |
} |
} |
433 |
} |
} |
434 |
|
|
435 |
set result [catch "exec cp -p $file $destfile" output]; |
set result [catch "exec cp -p $file $destfile" output] |
436 |
if [regexp "same file|are identical" $output] { |
if [regexp "same file|are identical" $output] { |
437 |
set result 0 |
set result 0 |
438 |
set output "" |
set output "" |
443 |
} |
} |
444 |
if { $result != 0 || $output != "" } { |
if { $result != 0 || $output != "" } { |
445 |
perror "remote_download to $dest of $file to $destfile: $output" |
perror "remote_download to $dest of $file to $destfile: $output" |
446 |
return ""; |
return "" |
447 |
} else { |
} else { |
448 |
return $orig_destfile; |
return $orig_destfile |
449 |
} |
} |
450 |
} |
} |
451 |
|
|
452 |
proc remote_upload {dest srcfile args} { |
proc remote_upload {dest srcfile args} { |
453 |
if { [llength $args] > 0 } { |
if { [llength $args] > 0 } { |
454 |
set destfile [lindex $args 0]; |
set destfile [lindex $args 0] |
455 |
} else { |
} else { |
456 |
set destfile [file tail $srcfile]; |
set destfile [file tail $srcfile] |
457 |
} |
} |
458 |
|
|
459 |
if { ![is_remote $dest] } { |
if { ![is_remote $dest] } { |
460 |
if { $destfile == "" || $srcfile == $destfile } { |
if { $destfile == "" || $srcfile == $destfile } { |
461 |
return $srcfile; |
return $srcfile |
462 |
} |
} |
463 |
set result [catch "exec cp -p $srcfile $destfile" output]; |
set result [catch "exec cp -p $srcfile $destfile" output] |
464 |
return $destfile; |
return $destfile |
465 |
} |
} |
466 |
|
|
467 |
return [call_remote "" upload $dest $srcfile $destfile]; |
return [call_remote "" upload $dest $srcfile $destfile] |
468 |
} |
} |
469 |
|
|
470 |
proc standard_upload { dest srcfile destfile } { |
proc standard_upload { dest srcfile destfile } { |
473 |
if [board_info $dest exists nfsdir] { |
if [board_info $dest exists nfsdir] { |
474 |
set destdir [board_info $dest nfsdir] |
set destdir [board_info $dest nfsdir] |
475 |
if [board_info $dest exists nfsroot_server] { |
if [board_info $dest exists nfsroot_server] { |
476 |
set dest [board_info $dest nfsroot_server]; |
set dest [board_info $dest nfsroot_server] |
477 |
} else { |
} else { |
478 |
set dest ""; |
set dest "" |
479 |
} |
} |
480 |
set srcfile "$destdir/$srcfile"; |
set srcfile "$destdir/$srcfile" |
481 |
} |
} |
482 |
|
|
483 |
if { "$dest" != "" } { |
if { "$dest" != "" } { |
484 |
return [rsh_upload $dest $srcfile $destfile]; |
return [rsh_upload $dest $srcfile $destfile] |
485 |
} |
} |
486 |
|
|
487 |
set result [catch "exec cp -p $srcfile $destfile" output]; |
set result [catch "exec cp -p $srcfile $destfile" output] |
488 |
if [regexp "same file|are identical" $output] { |
if [regexp "same file|are identical" $output] { |
489 |
set result 0 |
set result 0 |
490 |
set output "" |
set output "" |
495 |
} |
} |
496 |
if { $result != 0 || $output != "" } { |
if { $result != 0 || $output != "" } { |
497 |
perror "remote_upload to $dest of $file to $destfile: $output" |
perror "remote_upload to $dest of $file to $destfile: $output" |
498 |
return ""; |
return "" |
499 |
} else { |
} else { |
500 |
return $destfile; |
return $destfile |
501 |
} |
} |
502 |
|
|
503 |
return [rsh_upload $dest $srcfile $destfile]; |
return [rsh_upload $dest $srcfile $destfile] |
504 |
} |
} |
505 |
|
|
506 |
# |
# |
511 |
|
|
512 |
proc call_remote { type proc dest args } { |
proc call_remote { type proc dest args } { |
513 |
if [board_info $dest exists name] { |
if [board_info $dest exists name] { |
514 |
set dest [board_info $dest name]; |
set dest [board_info $dest name] |
515 |
} |
} |
516 |
|
|
517 |
if { $dest != "host" && $dest != "build" && $dest != "target" } { |
if { $dest != "host" && $dest != "build" && $dest != "target" } { |
518 |
if { ![board_info $dest exists name] } { |
if { ![board_info $dest exists name] } { |
519 |
global board; |
global board |
520 |
|
|
521 |
if [info exists board] { |
if [info exists board] { |
522 |
blooie |
blooie |
523 |
} |
} |
524 |
load_board_description $dest; |
load_board_description $dest |
525 |
} |
} |
526 |
} |
} |
527 |
|
|
528 |
set high_prot "" |
set high_prot "" |
529 |
if { $type != "raw" } { |
if { $type != "raw" } { |
530 |
if [board_info $dest exists protocol] { |
if [board_info $dest exists protocol] { |
531 |
set high_prot "${dest} [board_info $dest protocol]"; |
set high_prot "${dest} [board_info $dest protocol]" |
532 |
} else { |
} else { |
533 |
set high_prot "${dest} [board_info $dest generic_name]"; |
set high_prot "${dest} [board_info $dest generic_name]" |
534 |
} |
} |
535 |
} |
} |
536 |
|
|
541 |
if { $try != "" } { |
if { $try != "" } { |
542 |
if { [info proc "${try}_${proc}"] != "" } { |
if { [info proc "${try}_${proc}"] != "" } { |
543 |
verbose "call_remote calling ${try}_${proc}" 3 |
verbose "call_remote calling ${try}_${proc}" 3 |
544 |
set result [eval ${try}_${proc} \"$dest\" $args]; |
set result [eval ${try}_${proc} \"$dest\" $args] |
545 |
break; |
break |
546 |
} |
} |
547 |
} |
} |
548 |
} |
} |
549 |
set ft "[board_info $dest file_transfer]" |
set ft "[board_info $dest file_transfer]" |
550 |
if { [info proc "${ft}_${proc}"] != "" } { |
if { [info proc "${ft}_${proc}"] != "" } { |
551 |
verbose "calling ${ft}_${proc} $dest $args" 3 |
verbose "calling ${ft}_${proc} $dest $args" 3 |
552 |
set result2 [eval ${ft}_${proc} \"$dest\" $args]; |
set result2 [eval ${ft}_${proc} \"$dest\" $args] |
553 |
} |
} |
554 |
if ![info exists result] { |
if ![info exists result] { |
555 |
if [info exists result2] { |
if [info exists result2] { |
556 |
set result $result2; |
set result $result2 |
557 |
} else { |
} else { |
558 |
set result ""; |
set result "" |
559 |
} |
} |
560 |
} |
} |
561 |
return $result; |
return $result |
562 |
} |
} |
563 |
foreach try "${high_prot} [board_info $dest file_transfer] [board_info $dest connect] telnet standard" { |
foreach try "${high_prot} [board_info $dest file_transfer] [board_info $dest connect] telnet standard" { |
564 |
verbose "looking for ${try}_${proc}" 4 |
verbose "looking for ${try}_${proc}" 4 |
565 |
if { $try != "" } { |
if { $try != "" } { |
566 |
if { [info proc "${try}_${proc}"] != "" } { |
if { [info proc "${try}_${proc}"] != "" } { |
567 |
verbose "call_remote calling ${try}_${proc}" 3 |
verbose "call_remote calling ${try}_${proc}" 3 |
568 |
return [eval ${try}_${proc} \"$dest\" $args]; |
return [eval ${try}_${proc} \"$dest\" $args] |
569 |
} |
} |
570 |
} |
} |
571 |
} |
} |
573 |
return "" |
return "" |
574 |
} |
} |
575 |
error "No procedure for '$proc' in call_remote" |
error "No procedure for '$proc' in call_remote" |
576 |
return -1; |
return -1 |
577 |
} |
} |
578 |
|
|
579 |
# |
# |
580 |
# Send FILE through the existing session established to DEST. |
# Send FILE through the existing session established to DEST. |
581 |
# |
# |
582 |
proc remote_transmit { dest file } { |
proc remote_transmit { dest file } { |
583 |
return [call_remote "" transmit "$dest" "$file"]; |
return [call_remote "" transmit "$dest" "$file"] |
584 |
} |
} |
585 |
|
|
586 |
proc remote_raw_transmit { dest file } { |
proc remote_raw_transmit { dest file } { |
587 |
return [call_remote raw transmit "$dest" "$file"]; |
return [call_remote raw transmit "$dest" "$file"] |
588 |
} |
} |
589 |
|
|
590 |
# |
# |
593 |
# |
# |
594 |
proc standard_transmit {dest file} { |
proc standard_transmit {dest file} { |
595 |
if [board_info ${dest} exists name] { |
if [board_info ${dest} exists name] { |
596 |
set dest [board_info ${dest} name]; |
set dest [board_info ${dest} name] |
597 |
} |
} |
598 |
if [board_info ${dest} exists baud] { |
if [board_info ${dest} exists baud] { |
599 |
set baud [board_info ${dest} baud]; |
set baud [board_info ${dest} baud] |
600 |
} else { |
} else { |
601 |
set baud 9600; |
set baud 9600 |
602 |
} |
} |
603 |
set shell_id [board_info ${dest} fileid]; |
set shell_id [board_info ${dest} fileid] |
604 |
|
|
605 |
set lines 0 |
set lines 0 |
606 |
set chars 0; |
set chars 0 |
607 |
set fd [open $file r] |
set fd [open $file r] |
608 |
while { [gets $fd cur_line] >= 0 } { |
while { [gets $fd cur_line] >= 0 } { |
609 |
set errmess "" |
set errmess "" |
615 |
} |
} |
616 |
set chars [expr $chars + ([string length $cur_line] * 10)] |
set chars [expr $chars + ([string length $cur_line] * 10)] |
617 |
if { $chars > $baud } { |
if { $chars > $baud } { |
618 |
sleep 1; |
sleep 1 |
619 |
set chars 0 |
set chars 0 |
620 |
} |
} |
621 |
verbose "." 3 |
verbose "." 3 |
628 |
} |
} |
629 |
|
|
630 |
proc remote_send { dest string } { |
proc remote_send { dest string } { |
631 |
return [call_remote "" send "$dest" "$string"]; |
return [call_remote "" send "$dest" "$string"] |
632 |
} |
} |
633 |
|
|
634 |
proc remote_raw_send { dest string } { |
proc remote_raw_send { dest string } { |
635 |
return [call_remote raw send "$dest" "$string"]; |
return [call_remote raw send "$dest" "$string"] |
636 |
} |
} |
637 |
|
|
638 |
proc standard_send { dest string } { |
proc standard_send { dest string } { |
639 |
if ![board_info $dest exists fileid] { |
if ![board_info $dest exists fileid] { |
640 |
perror "no fileid for $dest" |
perror "no fileid for $dest" |
641 |
return "no fileid for $dest"; |
return "no fileid for $dest" |
642 |
} else { |
} else { |
643 |
set shell_id [board_info $dest fileid] |
set shell_id [board_info $dest fileid] |
644 |
verbose "shell_id in standard_send is $shell_id" 3 |
verbose "shell_id in standard_send is $shell_id" 3 |
645 |
verbose "send -i [board_info $dest fileid] -- {$string}" 3 |
verbose "send -i [board_info $dest fileid] -- {$string}" 3 |
646 |
if [catch "send -i [board_info $dest fileid] -- {$string}" errorInfo] { |
if [catch "send -i [board_info $dest fileid] -- {$string}" errorInfo] { |
647 |
return "$errorInfo"; |
return "$errorInfo" |
648 |
} else { |
} else { |
649 |
return ""; |
return "" |
650 |
} |
} |
651 |
} |
} |
652 |
} |
} |
653 |
|
|
654 |
proc file_on_host { op file args } { |
proc file_on_host { op file args } { |
655 |
return [eval remote_file host \"$op\" \"$file\" $args]; |
return [eval remote_file host \"$op\" \"$file\" $args] |
656 |
} |
} |
657 |
|
|
658 |
proc file_on_build { op file args } { |
proc file_on_build { op file args } { |
659 |
return [eval remote_file build \"$op\" \"$file\" $args]; |
return [eval remote_file build \"$op\" \"$file\" $args] |
660 |
} |
} |
661 |
|
|
662 |
proc remote_file { dest args } { |
proc remote_file { dest args } { |
663 |
return [eval call_remote \"\" file \"$dest\" $args]; |
return [eval call_remote \"\" file \"$dest\" $args] |
664 |
} |
} |
665 |
|
|
666 |
proc remote_raw_file { dest args } { |
proc remote_raw_file { dest args } { |
667 |
return [eval call_remote raw file \"$dest\" $args]; |
return [eval call_remote raw file \"$dest\" $args] |
668 |
} |
} |
669 |
|
|
670 |
# |
# |
672 |
# |
# |
673 |
|
|
674 |
proc standard_file { dest op args } { |
proc standard_file { dest op args } { |
675 |
set file [lindex $args 0]; |
set file [lindex $args 0] |
676 |
verbose "dest in proc standard_file is $dest" 3; |
verbose "dest in proc standard_file is $dest" 3 |
677 |
if { ![is_remote $dest] } { |
if { ![is_remote $dest] } { |
678 |
switch $op { |
switch $op { |
679 |
cmp { |
cmp { |
680 |
set otherfile [lindex $args 1]; |
set otherfile [lindex $args 1] |
681 |
if { [file exists $file] && [file exists $otherfile] |
if { [file exists $file] && [file exists $otherfile] |
682 |
&& [file size $file] == [file size $otherfile] } { |
&& [file size $file] == [file size $otherfile] } { |
683 |
set r [remote_exec build cmp "$file $otherfile"]; |
set r [remote_exec build cmp "$file $otherfile"] |
684 |
if { [lindex $r 0] == 0 } { |
if { [lindex $r 0] == 0 } { |
685 |
return 0; |
return 0 |
686 |
} |
} |
687 |
} |
} |
688 |
return 1; |
return 1 |
689 |
} |
} |
690 |
tail { |
tail { |
691 |
return [file tail $file]; |
return [file tail $file] |
692 |
} |
} |
693 |
dirname { |
dirname { |
694 |
if { [file pathtype $file] == "relative" } { |
if { [file pathtype $file] == "relative" } { |
695 |
set file [remote_file $dest absolute $file]; |
set file [remote_file $dest absolute $file] |
696 |
} |
} |
697 |
set result [file dirname $file]; |
set result [file dirname $file] |
698 |
if { $result == "" } { |
if { $result == "" } { |
699 |
return "/"; |
return "/" |
700 |
} |
} |
701 |
return $result; |
return $result |
702 |
} |
} |
703 |
join { |
join { |
704 |
return [file join [lindex $args 0] [lindex $args 1]]; |
return [file join [lindex $args 0] [lindex $args 1]] |
705 |
} |
} |
706 |
absolute { |
absolute { |
707 |
return [unix_clean_filename $dest $file]; |
return [unix_clean_filename $dest $file] |
708 |
} |
} |
709 |
exists { |
exists { |
710 |
return [file exists $file]; |
return [file exists $file] |
711 |
} |
} |
712 |
delete { |
delete { |
713 |
foreach x $args { |
foreach x $args { |
714 |
if { [file exists $x] && [file isfile $x] } { |
if { [file exists $x] && [file isfile $x] } { |
715 |
exec rm -f $x; |
exec rm -f $x |
716 |
} |
} |
717 |
} |
} |
718 |
return; |
return |
719 |
} |
} |
720 |
} |
} |
721 |
} |
} |
722 |
switch $op { |
switch $op { |
723 |
exists { |
exists { |
724 |
# mmmm, quotes. |
# mmmm, quotes. |
725 |
set status [remote_exec $dest "sh -c 'exit `\[ -f $file \]`'"]; |
set status [remote_exec $dest "sh -c 'exit `\[ -f $file \]`'"] |
726 |
return [lindex $status 0]; |
return [lindex $status 0] |
727 |
} |
} |
728 |
delete { |
delete { |
729 |
set file "" |
set file "" |
730 |
# Allow multiple files to be deleted at once. |
# Allow multiple files to be deleted at once. |
731 |
foreach x $args { |
foreach x $args { |
732 |
append file " $x"; |
append file " $x" |
733 |
} |
} |
734 |
verbose "remote_file deleting $file" |
verbose "remote_file deleting $file" |
735 |
set status [remote_exec $dest "rm -f $file"]; |
set status [remote_exec $dest "rm -f $file"] |
736 |
return [lindex $status 0]; |
return [lindex $status 0] |
737 |
} |
} |
738 |
} |
} |
739 |
} |
} |
744 |
# |
# |
745 |
proc unix_clean_filename { dest file } { |
proc unix_clean_filename { dest file } { |
746 |
if { [file pathtype $file] == "relative" } { |
if { [file pathtype $file] == "relative" } { |
747 |
set file [remote_file $dest join [pwd] $file]; |
set file [remote_file $dest join [pwd] $file] |
748 |
} |
} |
749 |
set result ""; |
set result "" |
750 |
foreach x [split $file "/"] { |
foreach x [split $file "/"] { |
751 |
if { $x == "." || $x == "" } { |
if { $x == "." || $x == "" } { |
752 |
continue; |
continue |
753 |
} |
} |
754 |
if { $x == ".." } { |
if { $x == ".." } { |
755 |
set rlen [expr [llength $result] - 2]; |
set rlen [expr [llength $result] - 2] |
756 |
if { $rlen >= 0 } { |
if { $rlen >= 0 } { |
757 |
set result [lrange $result 0 $rlen]; |
set result [lrange $result 0 $rlen] |
758 |
} else { |
} else { |
759 |
set result "" |
set result "" |
760 |
} |
} |
761 |
continue; |
continue |
762 |
} |
} |
763 |
lappend result $x; |
lappend result $x |
764 |
} |
} |
765 |
return "/[join $result /]" |
return "/[join $result /]" |
766 |
} |
} |
782 |
|
|
783 |
if ![is_remote $dest] { |
if ![is_remote $dest] { |
784 |
if [info exists board_info($dest,fileid)] { |
if [info exists board_info($dest,fileid)] { |
785 |
unset board_info($dest,fileid); |
unset board_info($dest,fileid) |
786 |
} |
} |
787 |
verbose "remote_spawn is local" 3; |
verbose "remote_spawn is local" 3 |
788 |
if [board_info $dest exists name] { |
if [board_info $dest exists name] { |
789 |
set dest [board_info $dest name]; |
set dest [board_info $dest name] |
790 |
} |
} |
791 |
|
|
792 |
verbose "spawning command $commandline" |
verbose "spawning command $commandline" |
793 |
|
|
794 |
if { [llength $args] > 0 } { |
if { [llength $args] > 0 } { |
795 |
if { [lindex $args 0] == "readonly" } { |
if { [lindex $args 0] == "readonly" } { |
796 |
set result [catch { open "| ${commandline} |& cat" "r" } id]; |
set result [catch { open "| ${commandline} |& cat" "r" } id] |
797 |
if { $result != 0 } { |
if { $result != 0 } { |
798 |
return -1; |
return -1 |
799 |
} |
} |
800 |
} else { |
} else { |
801 |
set result [catch {open "| ${commandline}" "w"} id] ; |
set result [catch {open "| ${commandline}" "w"} id] |
802 |
if { $result != 0 } { |
if { $result != 0 } { |
803 |
return -1; |
return -1 |
804 |
} |
} |
805 |
} |
} |
806 |
set result [catch "spawn -leaveopen $id" result2]; |
set result [catch "spawn -leaveopen $id" result2] |
807 |
if { $result == 0 && $result2 == 0} { |
if { $result == 0 && $result2 == 0} { |
808 |
verbose "setting board_info($dest,fileid) to $spawn_id" 3 |
verbose "setting board_info($dest,fileid) to $spawn_id" 3 |
809 |
set board_info($dest,fileid) $spawn_id; |
set board_info($dest,fileid) $spawn_id |
810 |
set board_info($dest,fileid_origid) $id; |
set board_info($dest,fileid_origid) $id |
811 |
return $spawn_id; |
return $spawn_id |
812 |
} else { |
} else { |
813 |
# This shouldn't happen. |
# This shouldn't happen. |
814 |
global errorInfo; |
global errorInfo |
815 |
if [info exists errorInfo] { |
if [info exists errorInfo] { |
816 |
set foo $errorInfo; |
set foo $errorInfo |
817 |
} else { |
} else { |
818 |
set foo ""; |
set foo "" |
819 |
} |
} |
820 |
verbose "spawn -open $id failed, $result $result2, $foo"; |
verbose "spawn -open $id failed, $result $result2, $foo" |
821 |
catch "close $id"; |
catch "close $id" |
822 |
return -1; |
return -1 |
823 |
} |
} |
824 |
} else { |
} else { |
825 |
set result [catch "spawn $commandline" pid]; |
set result [catch "spawn $commandline" pid] |
826 |
if { $result == 0 } { |
if { $result == 0 } { |
827 |
verbose "setting board_info($dest,fileid) to $spawn_id" 3 |
verbose "setting board_info($dest,fileid) to $spawn_id" 3 |
828 |
set board_info($dest,fileid) $spawn_id; |
set board_info($dest,fileid) $spawn_id |
829 |
return $spawn_id; |
return $spawn_id |
830 |
} else { |
} else { |
831 |
verbose -log "spawn of $commandline failed"; |
verbose -log "spawn of $commandline failed" |
832 |
return -1; |
return -1 |
833 |
} |
} |
834 |
} |
} |
835 |
} |
} |
836 |
|
|
837 |
# Seems to me there should be a cleaner way to do this. |
# Seems to me there should be a cleaner way to do this. |
838 |
if { "$args" == "" } { |
if { "$args" == "" } { |
839 |
return [call_remote "" spawn "$dest" "$commandline"]; |
return [call_remote "" spawn "$dest" "$commandline"] |
840 |
} else { |
} else { |
841 |
return [call_remote "" spawn "$dest" "$commandline" $args]; |
return [call_remote "" spawn "$dest" "$commandline" $args] |
842 |
} |
} |
843 |
} |
} |
844 |
|
|
845 |
proc remote_raw_spawn { dest commandline } { |
proc remote_raw_spawn { dest commandline } { |
846 |
return [call_remote raw spawn "$dest" "$commandline"]; |
return [call_remote raw spawn "$dest" "$commandline"] |
847 |
} |
} |
848 |
|
|
849 |
# |
# |
859 |
set RSH rsh |
set RSH rsh |
860 |
} |
} |
861 |
} else { |
} else { |
862 |
set RSH [board_info $dest rsh_prog]; |
set RSH [board_info $dest rsh_prog] |
863 |
} |
} |
864 |
|
|
865 |
if ![board_info $dest exists username] { |
if ![board_info $dest exists username] { |
869 |
} |
} |
870 |
|
|
871 |
if [board_info $dest exists hostname] { |
if [board_info $dest exists hostname] { |
872 |
set remote [board_info $dest hostname]; |
set remote [board_info $dest hostname] |
873 |
} else { |
} else { |
874 |
set remote $dest; |
set remote $dest |
875 |
} |
} |
876 |
|
|
877 |
spawn $RSH $rsh_useropts $remote $commandline; |
spawn $RSH $rsh_useropts $remote $commandline |
878 |
set board_info($dest,fileid) $spawn_id; |
set board_info($dest,fileid) $spawn_id |
879 |
return $spawn_id; |
return $spawn_id |
880 |
} |
} |
881 |
|
|
882 |
# |
# |
889 |
proc remote_load { dest prog args } { |
proc remote_load { dest prog args } { |
890 |
global tool |
global tool |
891 |
|
|
892 |
set dname [board_info $dest name]; |
set dname [board_info $dest name] |
893 |
set cache "[getenv REMOTELOAD_CACHE]/$tool/$dname/[file tail $prog]"; |
set cache "[getenv REMOTELOAD_CACHE]/$tool/$dname/[file tail $prog]" |
894 |
set empty [is_remote $dest]; |
set empty [is_remote $dest] |
895 |
if { [board_info $dest exists is_simulator] || [getenv REMOTELOAD_CACHE] == "" } { |
if { [board_info $dest exists is_simulator] || [getenv REMOTELOAD_CACHE] == "" } { |
896 |
set empty 0; |
set empty 0 |
897 |
} else { |
} else { |
898 |
for { set x 0; } {$x < [llength $args] } {incr x} { |
for { set x 0; } {$x < [llength $args] } {incr x} { |
899 |
if { [lindex $args $x] != "" } { |
if { [lindex $args $x] != "" } { |
900 |
set empty 0; |
set empty 0 |
901 |
break; |
break |
902 |
} |
} |
903 |
} |
} |
904 |
} |
} |
905 |
if $empty { |
if $empty { |
906 |
global sum_program; |
global sum_program |
907 |
|
|
908 |
if [info exists sum_program] { |
if [info exists sum_program] { |
909 |
if ![target_info exists objcopy] { |
if ![target_info exists objcopy] { |
910 |
set_currtarget_info objcopy [find_binutils_prog objcopy]; |
set_currtarget_info objcopy [find_binutils_prog objcopy] |
911 |
} |
} |
912 |
if [is_remote host] { |
if [is_remote host] { |
913 |
set dprog [remote_download host $prog "a.out"]; |
set dprog [remote_download host $prog "a.out"] |
914 |
} else { |
} else { |
915 |
set dprog $prog; |
set dprog $prog |
916 |
} |
} |
917 |
set status [remote_exec host "[target_info objcopy]" "-O srec $dprog ${dprog}.sum"]; |
set status [remote_exec host "[target_info objcopy]" "-O srec $dprog ${dprog}.sum"] |
918 |
if [is_remote host] { |
if [is_remote host] { |
919 |
remote_file upload ${dprog}.sum ${prog}.sum; |
remote_file upload ${dprog}.sum ${prog}.sum |
920 |
} |
} |
921 |
if { [lindex $status 0] == 0 } { |
if { [lindex $status 0] == 0 } { |
922 |
set sumout [remote_exec build "$sum_program" "${prog}.sum"]; |
set sumout [remote_exec build "$sum_program" "${prog}.sum"] |
923 |
set sum [lindex $sumout 1]; |
set sum [lindex $sumout 1] |
924 |
regsub "\[\r\n \t\]+$" "$sum" "" sum; |
regsub "\[\r\n \t\]+$" "$sum" "" sum |
925 |
} else { |
} else { |
926 |
set sumout [remote_exec build "$sum_program" "${prog}"]; |
set sumout [remote_exec build "$sum_program" "${prog}"] |
927 |
set sum [lindex $sumout 1]; |
set sum [lindex $sumout 1] |
928 |
regsub "\[\r\n \t\]+$" "$sum" "" sum; |
regsub "\[\r\n \t\]+$" "$sum" "" sum |
929 |
} |
} |
930 |
remote_file build delete ${prog}.sum; |
remote_file build delete ${prog}.sum |
931 |
} |
} |
932 |
if [file exists $cache] { |
if [file exists $cache] { |
933 |
set same 0; |
set same 0 |
934 |
if [info exists sum_program] { |
if [info exists sum_program] { |
935 |
set id [open $cache "r"]; |
set id [open $cache "r"] |
936 |
set oldsum [read $id]; |
set oldsum [read $id] |
937 |
close $id; |
close $id |
938 |
if { $oldsum == $sum } { |
if { $oldsum == $sum } { |
939 |
set same 1; |
set same 1 |
940 |
} |
} |
941 |
} else { |
} else { |
942 |
if { [remote_file build cmp $prog $cache] == 0 } { |
if { [remote_file build cmp $prog $cache] == 0 } { |
943 |
set same 1; |
set same 1 |
944 |
} |
} |
945 |
} |
} |
946 |
if { $same } { |
if { $same } { |
947 |
set fd [open "${cache}.res" "r"]; |
set fd [open "${cache}.res" "r"] |
948 |
gets $fd l1; |
gets $fd l1 |
949 |
set result [list $l1 [read $fd]]; |
set result [list $l1 [read $fd]] |
950 |
close $fd; |
close $fd |
951 |
} |
} |
952 |
} |
} |
953 |
} |
} |
954 |
if ![info exists result] { |
if ![info exists result] { |
955 |
set result [eval call_remote \"\" load \"$dname\" \"$prog\" $args]; |
set result [eval call_remote \"\" load \"$dname\" \"$prog\" $args] |
956 |
# Not quite happy about the "pass" condition, but it makes sense if |
# Not quite happy about the "pass" condition, but it makes sense if |
957 |
# you think about it for a while-- *why* did the test not pass? |
# you think about it for a while-- *why* did the test not pass? |
958 |
if { $empty && [lindex $result 0] == "pass" } { |
if { $empty && [lindex $result 0] == "pass" } { |
963 |
} |
} |
964 |
if [file exists $dir] { |
if [file exists $dir] { |
965 |
if [info exists sum_program] { |
if [info exists sum_program] { |
966 |
set id [open $cache "w"]; |
set id [open $cache "w"] |
967 |
puts -nonewline $id "$sum"; |
puts -nonewline $id "$sum" |
968 |
close $id; |
close $id |
969 |
} else { |
} else { |
970 |
remote_exec build cp "$prog $cache"; |
remote_exec build cp "$prog $cache" |
971 |
} |
} |
972 |
set id [open "${cache}.res" "w"]; |
set id [open "${cache}.res" "w"] |
973 |
puts $id [lindex $result 0]; |
puts $id [lindex $result 0] |
974 |
puts -nonewline $id [lindex $result 1]; |
puts -nonewline $id [lindex $result 1] |
975 |
close $id; |
close $id |
976 |
} |
} |
977 |
} |
} |
978 |
} |
} |
979 |
} |
} |
980 |
return $result; |
return $result |
981 |
} |
} |
982 |
|
|
983 |
proc remote_raw_load { dest prog args } { |
proc remote_raw_load { dest prog args } { |
984 |
return [eval call_remote raw load \"$dest\" \"$prog\" $args ]; |
return [eval call_remote raw load \"$dest\" \"$prog\" $args ] |
985 |
} |
} |
986 |
|
|
987 |
# |
# |
991 |
|
|
992 |
proc standard_load { dest prog args } { |
proc standard_load { dest prog args } { |
993 |
if { [llength $args] > 0 } { |
if { [llength $args] > 0 } { |
994 |
set pargs [lindex $args 0]; |
set pargs [lindex $args 0] |
995 |
} else { |
} else { |
996 |
set pargs "" |
set pargs "" |
997 |
} |
} |
998 |
|
|
999 |
if { [llength $args] > 1 } { |
if { [llength $args] > 1 } { |
1000 |
set inp "[lindex $args 1]"; |
set inp "[lindex $args 1]" |
1001 |
} else { |
} else { |
1002 |
set inp "" |
set inp "" |
1003 |
} |
} |
1011 |
|
|
1012 |
if [is_remote $dest] { |
if [is_remote $dest] { |
1013 |
set remotefile "/tmp/[file tail $prog].[pid]" |
set remotefile "/tmp/[file tail $prog].[pid]" |
1014 |
set remotefile [remote_download $dest $prog $remotefile]; |
set remotefile [remote_download $dest $prog $remotefile] |
1015 |
if { $remotefile == "" } { |
if { $remotefile == "" } { |
1016 |
verbose -log "Download of $prog to [board_info $dest name] failed." 3 |
verbose -log "Download of $prog to [board_info $dest name] failed." 3 |
1017 |
return "unresolved" |
return "unresolved" |
1023 |
return "unresolved" |
return "unresolved" |
1024 |
} |
} |
1025 |
} |
} |
1026 |
set status [remote_exec $dest $remotefile $pargs $inp]; |
set status [remote_exec $dest $remotefile $pargs $inp] |
1027 |
remote_file $dest delete $remotefile; |
remote_file $dest delete $remotefile |
1028 |
} else { |
} else { |
1029 |
set status [remote_exec $dest $prog $pargs $inp]; |
set status [remote_exec $dest $prog $pargs $inp] |
1030 |
} |
} |
1031 |
if { [lindex $status 0] < 0 } { |
if { [lindex $status 0] < 0 } { |
1032 |
verbose -log "Couldn't execute $prog, [lindex $status 1]" 3 |
verbose -log "Couldn't execute $prog, [lindex $status 1]" 3 |
1040 |
verbose -log -- "$output" 2 |
verbose -log -- "$output" 2 |
1041 |
} |
} |
1042 |
if { $status == 0 } { |
if { $status == 0 } { |
1043 |
return [list "pass" $output]; |
return [list "pass" $output] |
1044 |
} else { |
} else { |
1045 |
return [list "fail" $output]; |
return [list "fail" $output] |
1046 |
} |
} |
1047 |
} |
} |
1048 |
|
|
1050 |
# Loads PROG into DEST. |
# Loads PROG into DEST. |
1051 |
# |
# |
1052 |
proc remote_ld { dest prog } { |
proc remote_ld { dest prog } { |
1053 |
return [eval call_remote \"\" ld \"$dest\" \"$prog\"]; |
return [eval call_remote \"\" ld \"$dest\" \"$prog\"] |
1054 |
} |
} |
1055 |
|
|
1056 |
proc remote_raw_ld { dest prog } { |
proc remote_raw_ld { dest prog } { |
1057 |
return [eval call_remote raw ld \"$dest\" \"$prog\"]; |
return [eval call_remote raw ld \"$dest\" \"$prog\"] |
1058 |
} |
} |
1059 |
|
|
1060 |
# Wait up to TIMEOUT seconds for the last spawned command on DEST to |
# Wait up to TIMEOUT seconds for the last spawned command on DEST to |
1063 |
# produced by the command. |
# produced by the command. |
1064 |
|
|
1065 |
proc remote_wait { dest timeout } { |
proc remote_wait { dest timeout } { |
1066 |
return [eval call_remote \"\" wait \"$dest\" $timeout]; |
return [eval call_remote \"\" wait \"$dest\" $timeout] |
1067 |
} |
} |
1068 |
|
|
1069 |
proc remote_raw_wait { dest timeout } { |
proc remote_raw_wait { dest timeout } { |
1070 |
return [eval call_remote raw wait \"$dest\" $timeout]; |
return [eval call_remote raw wait \"$dest\" $timeout] |
1071 |
} |
} |
1072 |
|
|
1073 |
# The standard wait procedure, used for commands spawned on the local |
# The standard wait procedure, used for commands spawned on the local |
1074 |
# machine. |
# machine. |
1075 |
proc standard_wait { dest timeout } { |
proc standard_wait { dest timeout } { |
1076 |
set output ""; |
set output "" |
1077 |
set status -1; |
set status -1 |
1078 |
|
|
1079 |
if [info exists exp_close_result] { |
if [info exists exp_close_result] { |
1080 |
unset exp_close_result; |
unset exp_close_result |
1081 |
} |
} |
1082 |
remote_expect $dest $timeout { |
remote_expect $dest $timeout { |
1083 |
-re ".+" { |
-re ".+" { |
1084 |
append output $expect_out(buffer); |
append output $expect_out(buffer) |
1085 |
if { [string length $output] > 512000 } { |
if { [string length $output] > 512000 } { |
1086 |
remote_close $dest; |
remote_close $dest |
1087 |
set status 1; |
set status 1 |
1088 |
} else { |
} else { |
1089 |
exp_continue -continue_timer; |
exp_continue -continue_timer |
1090 |
} |
} |
1091 |
} |
} |
1092 |
timeout { |
timeout { |
1093 |
warning "program timed out."; |
warning "program timed out." |
1094 |
} |
} |
1095 |
eof { |
eof { |
1096 |
if [board_info $dest exists fileid_origid] { |
if [board_info $dest exists fileid_origid] { |
1097 |
global board_info; |
global board_info |
1098 |
|
|
1099 |
set id [board_info $dest fileid]; |
set id [board_info $dest fileid] |
1100 |
set oid [board_info $dest fileid_origid]; |
set oid [board_info $dest fileid_origid] |
1101 |
verbose "$id $oid" |
verbose "$id $oid" |
1102 |
unset board_info($dest,fileid); |
unset board_info($dest,fileid) |
1103 |
unset board_info($dest,fileid_origid); |
unset board_info($dest,fileid_origid) |
1104 |
catch "close -i $id"; |
catch "close -i $id" |
1105 |
# I don't believe this. You HAVE to do a wait, even tho |
# I don't believe this. You HAVE to do a wait, even tho |
1106 |
# it won't work! stupid ()*$%*)(% expect... |
# it won't work! stupid ()*$%*)(% expect... |
1107 |
catch "wait -i $id"; |
catch "wait -i $id" |
1108 |
set r2 [catch "close $oid" res]; |
set r2 [catch "close $oid" res] |
1109 |
if { $r2 != 0 } { |
if { $r2 != 0 } { |
1110 |
verbose "close result is $res"; |
verbose "close result is $res" |
1111 |
set status 1; |
set status 1 |
1112 |
} else { |
} else { |
1113 |
set status 0; |
set status 0 |
1114 |
} |
} |
1115 |
} else { |
} else { |
1116 |
set s [wait -i [board_info $dest fileid]]; |
set s [wait -i [board_info $dest fileid]] |
1117 |
if { [lindex $s 0] != 0 && [lindex $s 2] == 0 } { |
if { [lindex $s 0] != 0 && [lindex $s 2] == 0 } { |
1118 |
set status [lindex $s 3]; |
set status [lindex $s 3] |
1119 |
if { [llength $s] > 4 } { |
if { [llength $s] > 4 } { |
1120 |
if { [lindex $s 4] == "CHILDKILLED" } { |
if { [lindex $s 4] == "CHILDKILLED" } { |
1121 |
set status 1; |
set status 1 |
1122 |
} |
} |
1123 |
} |
} |
1124 |
} |
} |
1126 |
} |
} |
1127 |
} |
} |
1128 |
|
|
1129 |
remote_close $dest; |
remote_close $dest |
1130 |
return [list $status $output]; |
return [list $status $output] |
1131 |
} |
} |
1132 |
|
|
1133 |
# This checks the value cotained in the variable named "variable" in |
# This checks the value cotained in the variable named "variable" in |
1136 |
# output from the wrapper is removed from the variable. |
# output from the wrapper is removed from the variable. |
1137 |
|
|
1138 |
proc check_for_board_status { variable } { |
proc check_for_board_status { variable } { |
1139 |
upvar $variable output; |
upvar $variable output |
1140 |
|
|
1141 |
# If all programs of this board have a wrapper that always outputs a |
# If all programs of this board have a wrapper that always outputs a |
1142 |
# status message, then the absence of it means that the program |
# status message, then the absence of it means that the program |
1149 |
} |
} |
1150 |
|
|
1151 |
if [regexp "(^|\[\r\n\])\\*\\*\\* EXIT code" $output] { |
if [regexp "(^|\[\r\n\])\\*\\*\\* EXIT code" $output] { |
1152 |
regsub "^.*\\*\\*\\* EXIT code " $output "" result; |
regsub "^.*\\*\\*\\* EXIT code " $output "" result |
1153 |
regsub "\[\r\n\].*$" $result "" result; |
regsub "\[\r\n\].*$" $result "" result |
1154 |
regsub -all "(^|\[\r\n\]|\r\n)\\*\\*\\* EXIT code \[^\r\n\]*(\[\r\n\]\[\r\n\]?|$)" $output "" output; |
regsub -all "(^|\[\r\n\]|\r\n)\\*\\*\\* EXIT code \[^\r\n\]*(\[\r\n\]\[\r\n\]?|$)" $output "" output |
1155 |
regsub "^\[^0-9\]*" $result "" result |
regsub "^\[^0-9\]*" $result "" result |
1156 |
regsub "\[^0-9\]*$" $result "" result |
regsub "\[^0-9\]*$" $result "" result |
1157 |
verbose "got board status $result" 3 |
verbose "got board status $result" 3 |
1162 |
return [expr $result] |
return [expr $result] |
1163 |
} |
} |
1164 |
} else { |
} else { |
1165 |
return $nomatch_return; |
return $nomatch_return |
1166 |
} |
} |
1167 |
} |
} |
1168 |
|
|
1174 |
# |
# |
1175 |
|
|
1176 |
proc remote_expect { board timeout args } { |
proc remote_expect { board timeout args } { |
1177 |
global errorInfo errorCode; |
global errorInfo errorCode |
1178 |
global remote_suppress_flag; |
global remote_suppress_flag |
1179 |
|
|
1180 |
set spawn_id [board_info $board fileid]; |
set spawn_id [board_info $board fileid] |
1181 |
|
|
1182 |
if { [llength $args] == 1 } { |
if { [llength $args] == 1 } { |
1183 |
set args "[lindex $args 0]"; |
set args "[lindex $args 0]" |
1184 |
} |
} |
1185 |
|
|
1186 |
set res {} |
set res {} |
1187 |
set got_re 0; |
set got_re 0 |
1188 |
set need_append 1; |
set need_append 1 |
1189 |
|
|
1190 |
set orig "$args"; |
set orig "$args" |
1191 |
|
|
1192 |
set error_sect ""; |
set error_sect "" |
1193 |
set save_next 0; |
set save_next 0 |
1194 |
|
|
1195 |
if { $spawn_id == "" } { |
if { $spawn_id == "" } { |
1196 |
# This should be an invalid spawn id. |
# This should be an invalid spawn id. |
1197 |
set spawn_id 1000; |
set spawn_id 1000 |
1198 |
} |
} |
1199 |
|
|
1200 |
for { set i 0; } { $i < [llength $args] } { incr i ; } { |
for { set i 0; } { $i < [llength $args] } { incr i ; } { |
1201 |
if { $need_append } { |
if { $need_append } { |
1202 |
append res "\n-i $spawn_id "; |
append res "\n-i $spawn_id " |
1203 |
set need_append 0; |
set need_append 0 |
1204 |
} |
} |
1205 |
|
|
1206 |
set x "[lrange $args $i $i]"; |
set x "[lrange $args $i $i]" |
1207 |
regsub "^\n*\[ \]*" "$x" "" x; |
regsub "^\n*\[ \]*" "$x" "" x |
1208 |
|
|
1209 |
if { $x == "-i" || $x == "-timeout" || $x == "-ex" } { |
if { $x == "-i" || $x == "-timeout" || $x == "-ex" } { |
1210 |
append res "$x "; |
append res "$x " |
1211 |
set next [expr ${i}+1]; |
set next [expr ${i}+1] |
1212 |
append res "[lrange $args $next $next]"; |
append res "[lrange $args $next $next]" |
1213 |
incr i; |
incr i |
1214 |
continue; |
continue |
1215 |
} |
} |
1216 |
if { $x == "-n" || $x == "-notransfer" || $x == "-nocase" || $x == "-indices" } { |
if { $x == "-n" || $x == "-notransfer" || $x == "-nocase" || $x == "-indices" } { |
1217 |
append res "${x} "; |
append res "${x} " |
1218 |
continue; |
continue |
1219 |
} |
} |
1220 |
if { $x == "-re" } { |
if { $x == "-re" } { |
1221 |
append res "${x} "; |
append res "${x} " |
1222 |
set next [expr ${i}+1]; |
set next [expr ${i}+1] |
1223 |
set y [lrange $args $next $next]; |
set y [lrange $args $next $next] |
1224 |
append res "${y} "; |
append res "${y} " |
1225 |
set got_re 1; |
set got_re 1 |
1226 |
incr i; |
incr i |
1227 |
continue; |
continue |
1228 |
} |
} |
1229 |
if { $got_re } { |
if { $got_re } { |
1230 |
set need_append 0; |
set need_append 0 |
1231 |
append res "$x "; |
append res "$x " |
1232 |
set got_re 0; |
set got_re 0 |
1233 |
if { $save_next } { |
if { $save_next } { |
1234 |
set save_next 0; |
set save_next 0 |
1235 |
set error_sect [lindex $args $i]; |
set error_sect [lindex $args $i] |
1236 |
} |
} |
1237 |
} else { |
} else { |
1238 |
if { ${x} == "eof" } { |
if { ${x} == "eof" } { |
1239 |
set save_next 1; |
set save_next 1 |
1240 |
} elseif { ${x} == "default" || ${x} == "timeout" } { |
} elseif { ${x} == "default" || ${x} == "timeout" } { |
1241 |
if { $error_sect == "" } { |
if { $error_sect == "" } { |
1242 |
set save_next 1; |
set save_next 1 |
1243 |
} |
} |
1244 |
} |
} |
1245 |
append res "${x} "; |
append res "${x} " |
1246 |
set got_re 1; |
set got_re 1 |
1247 |
} |
} |
1248 |
} |
} |
1249 |
|
|
1250 |
if [info exists remote_suppress_flag] { |
if [info exists remote_suppress_flag] { |
1251 |
if { $remote_suppress_flag } { |
if { $remote_suppress_flag } { |
1252 |
set code 1; |
set code 1 |
1253 |
} |
} |
1254 |
} |
} |
1255 |
if ![info exists code] { |
if ![info exists code] { |
1256 |
set res "\n-timeout $timeout $res"; |
set res "\n-timeout $timeout $res" |
1257 |
set body "expect \{\n-i $spawn_id -timeout $timeout $orig\}"; |
set body "expect \{\n-i $spawn_id -timeout $timeout $orig\}" |
1258 |
set code [catch {uplevel $body} string]; |
set code [catch {uplevel $body} string] |
1259 |
} |
} |
1260 |
|
|
1261 |
if {$code == 1} { |
if {$code == 1} { |
1262 |
if { $error_sect != "" } { |
if { $error_sect != "" } { |
1263 |
set code [catch {uplevel $error_sect} string]; |
set code [catch {uplevel $error_sect} string] |
1264 |
} else { |
} else { |
1265 |
warning "remote_expect statement without a default case?!"; |
warning "remote_expect statement without a default case?!" |
1266 |
return; |
return |
1267 |
} |
} |
1268 |
} |
} |
1269 |
|
|
1280 |
|
|
1281 |
# Push the current connection to HOST onto a stack. |
# Push the current connection to HOST onto a stack. |
1282 |
proc remote_push_conn { host } { |
proc remote_push_conn { host } { |
1283 |
global board_info; |
global board_info |
1284 |
|
|
1285 |
set name [board_info $host name]; |
set name [board_info $host name] |
1286 |
|
|
1287 |
if { $name == "" } { |
if { $name == "" } { |
1288 |
return "fail"; |
return "fail" |
1289 |
} |
} |
1290 |
|
|
1291 |
if ![board_info $host exists fileid] { |
if ![board_info $host exists fileid] { |
1292 |
return "fail"; |
return "fail" |
1293 |
} |
} |
1294 |
|
|
1295 |
set fileid [board_info $host fileid]; |
set fileid [board_info $host fileid] |
1296 |
set conninfo [board_info $host conninfo]; |
set conninfo [board_info $host conninfo] |
1297 |
if ![info exists board_info($name,fileid_stack)] { |
if ![info exists board_info($name,fileid_stack)] { |
1298 |
set board_info($name,fileid_stack) {} |
set board_info($name,fileid_stack) {} |
1299 |
} |
} |
1300 |
set board_info($name,fileid_stack) [list $fileid $conninfo $board_info($name,fileid_stack)]; |
set board_info($name,fileid_stack) [list $fileid $conninfo $board_info($name,fileid_stack)] |
1301 |
unset board_info($name,fileid); |
unset board_info($name,fileid) |
1302 |
if [info exists board_info($name,conninfo)] { |
if [info exists board_info($name,conninfo)] { |
1303 |
unset board_info($name,conninfo); |
unset board_info($name,conninfo) |
1304 |
} |
} |
1305 |
return "pass"; |
return "pass" |
1306 |
} |
} |
1307 |
|
|
1308 |
# Pop a previously-pushed connection from a stack. You should have closed the |
# Pop a previously-pushed connection from a stack. You should have closed the |
1309 |
# current connection before doing this. |
# current connection before doing this. |
1310 |
proc remote_pop_conn { host } { |
proc remote_pop_conn { host } { |
1311 |
global board_info; |
global board_info |
1312 |
|
|
1313 |
set name [board_info $host name]; |
set name [board_info $host name] |
1314 |
|
|
1315 |
if { $name == "" } { |
if { $name == "" } { |
1316 |
return "fail"; |
return "fail" |
1317 |
} |
} |
1318 |
if ![info exists board_info($name,fileid_stack)] { |
if ![info exists board_info($name,fileid_stack)] { |
1319 |
return "fail"; |
return "fail" |
1320 |
} |
} |
1321 |
set stack $board_info($name,fileid_stack); |
set stack $board_info($name,fileid_stack) |
1322 |
if { [llength $stack] < 3 } { |
if { [llength $stack] < 3 } { |
1323 |
return "fail"; |
return "fail" |
1324 |
} |
} |
1325 |
set board_info($name,fileid) [lindex $stack 0]; |
set board_info($name,fileid) [lindex $stack 0] |
1326 |
set board_info($name,conninfo) [lindex $stack 1]; |
set board_info($name,conninfo) [lindex $stack 1] |
1327 |
set board_info($name,fileid_stack) [lindex $stack 2]; |
set board_info($name,fileid_stack) [lindex $stack 2] |
1328 |
return "pass"; |
return "pass" |
1329 |
} |
} |
1330 |
|
|
1331 |
# |
# |
1332 |
# Swap the current connection with the topmost one on the stack. |
# Swap the current connection with the topmost one on the stack. |
1333 |
# |
# |
1334 |
proc remote_swap_conn { host } { |
proc remote_swap_conn { host } { |
1335 |
global board_info; |
global board_info |
1336 |
set name [board_info $host name]; |
set name [board_info $host name] |
1337 |
|
|
1338 |
if ![info exists board_info($name,fileid)] { |
if ![info exists board_info($name,fileid)] { |
1339 |
return "fail"; |
return "fail" |
1340 |
} |
} |
1341 |
|
|
1342 |
set fileid $board_info($name,fileid); |
set fileid $board_info($name,fileid) |
1343 |
if [info exists board_info($name,conninfo)] { |
if [info exists board_info($name,conninfo)] { |
1344 |
set conninfo $board_info($name,conninfo); |
set conninfo $board_info($name,conninfo) |
1345 |
} else { |
} else { |
1346 |
set conninfo {} |
set conninfo {} |
1347 |
} |
} |
1348 |
if { [remote_pop_conn $host] != "pass" } { |
if { [remote_pop_conn $host] != "pass" } { |
1349 |
set board_info($name,fileid) $fileid; |
set board_info($name,fileid) $fileid |
1350 |
set board_info($name,conninfo) $conninfo; |
set board_info($name,conninfo) $conninfo |
1351 |
return "fail"; |
return "fail" |
1352 |
} |
} |
1353 |
set newfileid $board_info($name,fileid); |
set newfileid $board_info($name,fileid) |
1354 |
set newconninfo $board_info($name,conninfo); |
set newconninfo $board_info($name,conninfo) |
1355 |
set board_info($name,fileid) $fileid; |
set board_info($name,fileid) $fileid |
1356 |
set board_info($name,conninfo) $conninfo; |
set board_info($name,conninfo) $conninfo |
1357 |
remote_push_conn $host; |
remote_push_conn $host |
1358 |
set board_info($name,fileid) $newfileid; |
set board_info($name,fileid) $newfileid |
1359 |
set board_info($name,conninfo) $newconninfo; |
set board_info($name,conninfo) $newconninfo |
1360 |
return "pass"; |
return "pass" |
1361 |
} |
} |
1362 |
|
|
1363 |
set sum_program "testcsum"; |
set sum_program "testcsum" |