URL
https://opencores.org/ocsvn/or1k_old/or1k_old/trunk
Subversion Repositories or1k_old
[/] [or1k_old/] [trunk/] [insight/] [dejagnu/] [lib/] [telnet.exp] - Rev 1782
Compare with Previous | Blame | View Log
# Copyright (C) 97, 98, 1999 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# Please email any bugs, comments, and/or additions to this file to:
# DejaGnu@cygnus.com
#
# Connect using telnet. This takes two arguments. The first one is the
# hostname, and the second is the optional port number. This sets
# the fileid field in the config array, and returns -1 for error, or the
# spawn id.
#
proc telnet_open { hostname args } {
global verbose
global connectmode
global spawn_id
global timeout
global board_info
set raw 0;
if { [llength $args] > 0 } {
if { [lindex $args 0] == "raw" } {
set raw 1;
}
}
set port 23
if [board_info $hostname exists name] {
set connhost [board_info $hostname name]
} else {
set connhost $hostname
}
if [board_info $connhost exists hostname] {
set hostname [board_info $connhost hostname];
}
if [file exists /usr/kerberos/bin/telnet] {
set telnet /usr/kerberos/bin/telnet;
} else {
set telnet telnet;
}
# Instead of unsetting it, let's return it. One connection at a
# time, please.
if [board_info $connhost exists fileid] {
return [board_info $connhost fileid];
}
# get the hostname and port number from the config array
if [board_info $connhost exists netport] {
set type $hostname
set hosttmp [split [board_info $connhost netport] ":"]
set hostname [lindex $hosttmp 0]
if { [llength $hosttmp] > 1 } {
set port [lindex $hosttmp 1]
}
unset hosttmp
} else {
set type target
}
if [board_info $connhost exists shell_prompt] {
set shell_prompt [board_info $connhost shell_prompt]
}
if ![info exists shell_prompt] { # if no prompt, then set it to something generic
set shell_prompt ".*> "
}
set tries 0
set result -1
set need_respawn 1;
verbose "Starting a telnet connection to $hostname:$port $shell_prompt" 2
while { $result < 0 && $tries <= 3 } {
if { $need_respawn } {
set need_respawn 0;
spawn $telnet $hostname $port;
}
expect {
"Trying " {
exp_continue;
}
-re "$shell_prompt.*$" {
verbose "Got prompt\n"
set result 0
}
-re "nt Name:|ogin:" {
if [board_info $connhost exists telnet_username] {
exp_send "[board_info $connhost telnet_username]\n";
exp_continue;
}
if [board_info $connhost exists username] {
exp_send "[board_info $connhost username]\n";
exp_continue;
}
perror "telnet: need to login"
break
}
"assword:" {
if [board_info $connhost exists telnet_password] {
exp_send "[board_info $connhost telnet_password]\n";
exp_continue;
}
if [board_info $connhost exists password] {
exp_send "[board_info $connhost password]\n";
exp_continue;
}
perror "telnet: need a password"
break
}
-re "advance.*y/n.*\\?" {
exp_send "n\n";
exp_continue;
}
-re {([Aa]dvanced|[Ss]imple) or ([Ss]imple|[Aa]dvanced)} {
exp_send "simple\n";
exp_continue;
}
"Connected to" {
exp_continue
}
"unknown host" {
exp_send "\003"
perror "telnet: unknown host"
break
}
"VxWorks Boot" {
exp_send "@\n";
sleep 20;
exp_continue;
}
-re "Escape character is.*\\.\[\r\n\]" {
if { $raw || [board_info $connhost exists dont_wait_for_prompt] } {
set result 0;
} else {
if [board_info $connhost exists send_initial_cr] {
exp_send "\n"
}
exp_continue
}
}
"has logged on from" {
exp_continue
}
"You have no Kerberos tickets" {
warning "telnet: no kerberos Tickets, please kinit"
break
}
-re "Connection refused.*$" {
catch "exp_send \"\003\"" foo;
sleep 5;
warning "telnet: connection refused."
}
-re "Sorry, this system is engaged.*" {
exp_send "\003"
warning "telnet: already connected."
}
"Connection closed by foreign host.*$" {
warning "telnet: connection closed by foreign host."
break
}
-re "\[\r\n\]+" {
exp_continue
}
timeout {
exp_send "\n"
}
eof {
warning "telnet: got unexpected EOF from telnet."
catch close;
catch wait;
set need_respawn 1;
sleep 5;
}
}
incr tries
}
# we look for this here again cause it means something went wrong, and
# it doesn't always show up in the expect in buffer till the server times out.
if [info exists expect_out(buffer)] {
if [regexp "assword:|ogin:" $expect_out(buffer)] {
perror "telnet: need to supply a login and password."
}
}
if { $result < 0 } {
catch close
catch wait
set spawn_id -1
}
if { $spawn_id >= 0 } {
verbose "setting board_info($connhost,fileid) to $spawn_id" 3
set board_info($connhost,fileid) $spawn_id
}
return $spawn_id
}
#
# Put the telnet connection into binary mode.
#
proc telnet_binary { hostname } {
if [board_info $hostname exists fileid] {
remote_send $hostname "";
remote_expect $hostname 5 {
-re "telnet> *$" {}
default {}
}
remote_send $hostname "set binary\n"
remote_expect $hostname 5 {
-re "Format is .*telnet> *$" {
remote_send $hostname "toggle binary\n";
exp_continue;
}
-re "Negotiating network ascii.*telnet> *$" {
remote_send $hostname "toggle binary\n";
exp_continue;
}
-re "Negotiating binary.*\[\r\n\].*$" { }
-re "binary.*unknown argument.*telnet> *$" {
remote_send $hostname "mode character\n";
}
-re "Already operating in binary.*\[\r\n\].*$" { }
timeout {
warning "Never got binary response from telnet."
}
}
}
}
proc telnet_transmit { dest file args } {
return [standard_transmit $dest $file];
}