/[dejagnu]/dejagnu/contrib/bluegnu2.0.3/lib/remote.exp
ViewVC logotype

Diff of /dejagnu/contrib/bluegnu2.0.3/lib/remote.exp

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

revision 1.1.1.1 by rsavoye, Mon Feb 5 04:30:21 2001 UTC revision 1.2 by bje, Sat Aug 16 13:08:57 2003 UTC
# Line 4  Line 4 
4  # it under the terms of the GNU General Public License as published by  # it under the terms of the GNU General Public License as published by
5  # the Free Software Foundation; either version 2 of the License, or  # the Free Software Foundation; either version 2 of the License, or
6  # (at your option) any later version.  # (at your option) any later version.
7  #  #
8  # This program is distributed in the hope that it will be useful,  # This program is distributed in the hope that it will be useful,
9  # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
10  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11  # GNU General Public License for more details.  # GNU General Public License for more details.
12  #  #
13  # You should have received a copy of the GNU General Public License  # You should have received a copy of the GNU General Public License
14  # along with this program; if not, write to the Free Software  # along with this program; if not, write to the Free Software
15  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
# Line 24  Line 24 
24  # Remove at some point.  # Remove at some point.
25  set shell_id    0  set shell_id    0
26    
27  #  #
28  # Open a connection to a remote host or target. This requires the target_info  # Open a connection to a remote host or target. This requires the target_info
29  # array be filled in with the proper info to work. The old variables are also  # array be filled in with the proper info to work. The old variables are also
30  # still functional.  # still functional.
# Line 41  proc remote_open { args } { Line 41  proc remote_open { args } {
41      global reboot      global reboot
42      global shell_id      global shell_id
43      global spawn_id      global spawn_id
44      
45      if { [llength $args] == 0 } {      if { [llength $args] == 0 } {
46          set type "target"          set type "target"
47      } else {      } else {
# Line 92  proc remote_open { args } { Line 92  proc remote_open { args } {
92  #  #
93  # Close the remote connection.  # Close the remote connection.
94  #       shell_id - This is the id number returned by the any of the connection  #       shell_id - This is the id number returned by the any of the connection
95  #       procedures, or an index into one of the arrays.  #       procedures, or an index into one of the arrays.
96  #  #
97  proc remote_close { arg } {  proc remote_close { arg } {
98      # get the type of connection, host or target      # get the type of connection, host or target
# Line 141  proc telnet { args } { Line 141  proc telnet { args } {
141      global errno      global errno
142    
143      set hostname [lindex $args 0]      set hostname [lindex $args 0]
144        
145      # get the port number      # get the port number
146      if { [llength $args] > 1 } {      if { [llength $args] > 1 } {
147          set port [lindex $args 1]          set port [lindex $args 1]
148      } else {      } else {
149          set port 23          set port 23
150      }      }
151        
152      # get the hostname and port number from the config array      # get the hostname and port number from the config array
153      if [expr [string match "host" $hostname] || [string match "target" $hostname]] {      if [expr [string match "host" $hostname] || [string match "target" $hostname]] {
154          set type $hostname          set type $hostname
# Line 167  proc telnet { args } { Line 167  proc telnet { args } {
167      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic
168          set shell_prompt ".*> "          set shell_prompt ".*> "
169      }      }
170    
171      set tries 0      set tries 0
172      set result -1      set result -1
173      verbose "Starting a telnet connection to $hostname:$port" 2      verbose "Starting a telnet connection to $hostname:$port" 2
# Line 221  proc telnet { args } { Line 221  proc telnet { args } {
221                  warning "telnet: connection closed by foreign host."                  warning "telnet: connection closed by foreign host."
222                  break                  break
223              }              }
224              timeout {              timeout {
225                  exp_send "\003"                  exp_send "\003"
226                  warning "telnet: timed out trying to connect."                  warning "telnet: timed out trying to connect."
227              }              }
# Line 283  proc rlogin { arg } { Line 283  proc rlogin { arg } {
283      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic
284          set shell_prompt ".*> "          set shell_prompt ".*> "
285      }      }
286    
287      # get the right version of rlogin      # get the right version of rlogin
288      if ![info exists RLOGIN] {      if ![info exists RLOGIN] {
289          set RLOGIN rlogin          set RLOGIN rlogin
290      }      }
291        
292      # start connection and store the spawn_id      # start connection and store the spawn_id
293      verbose "Opening a $RLOGIN connection to $hostname" 2      verbose "Opening a $RLOGIN connection to $hostname" 2
294      spawn $RLOGIN $hostname      spawn $RLOGIN $hostname
# Line 300  proc rlogin { arg } { Line 300  proc rlogin { arg } {
300      if [info exists target_info($type,name)] {      if [info exists target_info($type,name)] {
301          set target_info($target_info($type,name),fileid) $spawn_id          set target_info($target_info($type,name),fileid) $spawn_id
302      }      }
303        
304      # try to connect to the target. We give up after 3 attempts. At one point      # try to connect to the target. We give up after 3 attempts. At one point
305      # we used to look for the prompt, but we may not know what it looks like.      # we used to look for the prompt, but we may not know what it looks like.
306      while { $tries <= 3 } {      while { $tries <= 3 } {
# Line 374  proc rlogin { arg } { Line 374  proc rlogin { arg } {
374                  catch wait                  catch wait
375                  break                  break
376              }              }
377              timeout     {              timeout     {
378                  warning "rlogin: timed out trying to connect."                  warning "rlogin: timed out trying to connect."
379              }              }
380              eof {              eof {
# Line 422  proc rlogin { arg } { Line 422  proc rlogin { arg } {
422      } else {      } else {
423          verbose "rlogin: connected to $hostname" 2          verbose "rlogin: connected to $hostname" 2
424      }      }
425        
426      return $spawn_id      return $spawn_id
427  }  }
428    
# Line 452  proc rsh { arg } { Line 452  proc rsh { arg } {
452      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic
453          set shell_prompt ".*> "          set shell_prompt ".*> "
454      }      }
455    
456      if ![info exists RSH] {      if ![info exists RSH] {
457          set RSH rsh          set RSH rsh
458      }      }
# Line 528  proc rsh { arg } { Line 528  proc rsh { arg } {
528              -re "Sorry, shell is locked.*Connection closed.*$" {              -re "Sorry, shell is locked.*Connection closed.*$" {
529                  warning "rsh: already connected."                  warning "rsh: already connected."
530              }              }
531              timeout {                    timeout {
532                 warning "rsh: timed out trying to connect."                 warning "rsh: timed out trying to connect."
533              }              }
534              eof {                        eof {
535                  perror "rsh: got EOF while trying to connect."                  perror "rsh: got EOF while trying to connect."
536                  break                  break
537              }              }
538          }          }
539          incr tries          incr tries
540      }      }
541        
542      if { $result < 0 } {      if { $result < 0 } {
543  #       perror "rsh: couldn't connect after $tries tries."  #       perror "rsh: couldn't connect after $tries tries."
544          set spawn_id -1          set spawn_id -1
# Line 627  proc tip { arg } { Line 627  proc tip { arg } {
627      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic      if ![info exists shell_prompt] {    # if no prompt, then set it to something generic
628          set shell_prompt ".*> "          set shell_prompt ".*> "
629      }      }
630    
631      spawn tip -v $port      spawn tip -v $port
632      if { $spawn_id < 0 } {      if { $spawn_id < 0 } {
633          perror "invalid spawn id from tip"          perror "invalid spawn id from tip"
# Line 636  proc tip { arg } { Line 636  proc tip { arg } {
636      set target_info(target,fileid) $spawn_id      set target_info(target,fileid) $spawn_id
637      set target_info($target_info(target,name),fileid) $spawn_id      set target_info($target_info(target,name),fileid) $spawn_id
638      expect {      expect {
639          -re ".*connected.*$" {          -re ".*connected.*$" {
640              send "\r\n"              send "\r\n"
641              expect {              expect {
642                  -re ".*$shell_prompt.*$" {                  -re ".*$shell_prompt.*$" {
# Line 660  proc tip { arg } { Line 660  proc tip { arg } {
660              incr tries              incr tries
661              if { $tries <= 2 } {              if { $tries <= 2 } {
662                  exp_continue                  exp_continue
663              }                    }
664          }          }
665          -re "Connection Closed.*$" {          -re "Connection Closed.*$" {
666              perror "Never connected."              perror "Never connected."
# Line 768  proc tip_download { shell_id file } { Line 768  proc tip_download { shell_id file } {
768  #  #
769  # Connect to using kermit  # Connect to using kermit
770  #     args - first is the device name, ie. /dev/ttyb  #     args - first is the device name, ie. /dev/ttyb
771  #         second is the optional baud rate. If this is "host" or "target" the  #         second is the optional baud rate. If this is "host" or "target" the
772  #         config array is used instead.  #         config array is used instead.
773  #     returns -1 if it failed, otherwise it returns  #     returns -1 if it failed, otherwise it returns
774  #         the spawn_id.  #         the spawn_id.
# Line 782  proc kermit { args } { Line 782  proc kermit { args } {
782          set baud 9600          set baud 9600
783      } else {      } else {
784          set baud [lindex $args 1]          set baud [lindex $args 1]
785      }      }
786    
787      if [expr [string match "host" [lindex $args 0]] || [string match "target" [lindex $arg 0]]] {      if [expr [string match "host" [lindex $args 0]] || [string match "target" [lindex $arg 0]]] {
788          set device $target_info(${type},serial)          set device $target_info(${type},serial)
# Line 792  proc kermit { args } { Line 792  proc kermit { args } {
792      } else {      } else {
793          set device [lindex $args 0]          set device [lindex $args 0]
794      }      }
795    
796      set tries 0      set tries 0
797      set result -1      set result -1
798      spawn kermit -l $device -b $baud      spawn kermit -l $device -b $baud
# Line 803  proc kermit { args } { Line 803  proc kermit { args } {
803      set target_info(${type},fileid) $spawn_id      set target_info(${type},fileid) $spawn_id
804      set target_info($target_info(${type},name),fileid) $spawn_id      set target_info($target_info(${type},name),fileid) $spawn_id
805      expect {      expect {
806          -re ".*ermit.*>.*$" {          -re ".*ermit.*>.*$" {
807              send "c\n"              send "c\n"
808              expect {              expect {
809                  -re ".*Connecting to $port.*Type the escape character followed by C to.*$" {                  -re ".*Connecting to $port.*Type the escape character followed by C to.*$" {
# Line 829  proc kermit { args } { Line 829  proc kermit { args } {
829                  exp_continue                  exp_continue
830              }              }
831          }          }
832          timeout                 {                    timeout                 {
833              warning "Timed out trying to connect."              warning "Timed out trying to connect."
834              set result -1              set result -1
835              incr tries              incr tries

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

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