/[dejagnu]/dejagnu/lib/remote.exp
ViewVC logotype

Diff of /dejagnu/lib/remote.exp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by rsavoye, Mon Mar 17 02:25:07 2003 UTC revision 1.11 by bje, Thu Aug 7 03:42:43 2003 UTC
# Line 50  proc remote_open { args } { Line 50  proc remote_open { args } {
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
# Line 75  proc remote_raw_open { args } { Line 75  proc remote_raw_open { args } {
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
# Line 92  proc local_exec { commandline inp outp t Line 92  proc local_exec { commandline inp outp t
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    
# Line 178  proc local_exec { commandline inp outp t Line 178  proc local_exec { commandline inp outp t
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
# Line 236  proc local_exec { commandline inp outp t Line 236  proc local_exec { commandline inp outp t
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  #  #
# Line 282  proc standard_exec { hostname args } { Line 282  proc standard_exec { hostname args } {
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  #  #
# Line 340  proc standard_close { host } { Line 340  proc standard_close { host } {
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,
# Line 376  proc standard_reboot { host } { Line 376  proc standard_reboot { host } {
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 ""
# Line 396  proc remote_download { dest file args } Line 396  proc remote_download { dest file args }
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  #  #
# Line 416  proc standard_download {dest file destfi Line 416  proc standard_download {dest file destfi
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 ""
# Line 443  proc standard_download {dest file destfi Line 443  proc standard_download {dest file destfi
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 } {
# Line 473  proc standard_upload { dest srcfile dest Line 473  proc standard_upload { dest srcfile dest
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 ""
# Line 495  proc standard_upload { dest srcfile dest Line 495  proc standard_upload { dest srcfile dest
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  #  #
# Line 511  proc standard_upload { dest srcfile dest Line 511  proc standard_upload { dest srcfile dest
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    
# Line 541  proc call_remote { type proc dest args } Line 541  proc call_remote { type proc dest args }
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      }      }
# Line 573  proc call_remote { type proc dest args } Line 573  proc call_remote { type proc dest args }
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  #  #
# Line 593  proc remote_raw_transmit { dest file } { Line 593  proc remote_raw_transmit { dest file } {
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 ""
# Line 615  proc standard_transmit {dest file} { Line 615  proc standard_transmit {dest file} {
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
# Line 628  proc standard_transmit {dest file} { Line 628  proc standard_transmit {dest file} {
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  #  #
# Line 672  proc remote_raw_file { dest args } { Line 672  proc remote_raw_file { dest args } {
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  }  }
# Line 744  proc standard_file { dest op args } { Line 744  proc standard_file { dest op args } {
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  }  }
# Line 782  proc remote_spawn { dest commandline arg Line 782  proc remote_spawn { dest commandline arg
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  #  #
# Line 859  proc standard_spawn { dest commandline } Line 859  proc standard_spawn { dest commandline }
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] {
# Line 869  proc standard_spawn { dest commandline } Line 869  proc standard_spawn { dest commandline }
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  #  #
# Line 889  proc standard_spawn { dest commandline } Line 889  proc standard_spawn { dest commandline }
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" } {
# Line 963  proc remote_load { dest prog args } { Line 963  proc remote_load { dest prog args } {
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  #  #
# Line 991  proc remote_raw_load { dest prog args } Line 991  proc remote_raw_load { dest prog args }
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      }      }
# Line 1011  proc standard_load { dest prog args } { Line 1011  proc standard_load { dest prog args } {
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"
# Line 1023  proc standard_load { dest prog args } { Line 1023  proc standard_load { dest prog args } {
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
# Line 1040  proc standard_load { dest prog args } { Line 1040  proc standard_load { dest prog args } {
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    
# Line 1050  proc standard_load { dest prog args } { Line 1050  proc standard_load { dest prog args } {
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
# Line 1063  proc remote_raw_ld { dest prog } { Line 1063  proc remote_raw_ld { dest prog } {
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                  }                  }
# Line 1126  proc standard_wait { dest timeout } { Line 1126  proc standard_wait { dest timeout } {
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
# Line 1136  proc standard_wait { dest timeout } { Line 1136  proc standard_wait { dest timeout } {
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
# Line 1149  proc check_for_board_status  { variable Line 1149  proc check_for_board_status  { variable
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
# Line 1162  proc check_for_board_status  { variable Line 1162  proc check_for_board_status  { variable
1162              return [expr $result]              return [expr $result]
1163          }          }
1164      } else {      } else {
1165          return $nomatch_return;          return $nomatch_return
1166      }      }
1167  }  }
1168    
# Line 1174  proc check_for_board_status  { variable Line 1174  proc check_for_board_status  { variable
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    
# Line 1280  proc remote_expect { board timeout args Line 1280  proc remote_expect { board timeout args
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"

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26