# Copyright (C) 1997 - 2002, 2003 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:
# bug-dejagnu@gnu.org
#
# Connect to hostname using rlogin
#
proc rsh_open { hostname } {
global spawn_id
set tries 0
set result -1
if ![board_info $hostname exists rsh_prog] {
if { [which remsh] != 0 } {
set RSH remsh
} else {
set RSH rsh
}
} else {
set RSH [board_info $hostname rsh_prog];
}
if [board_info $hostname exists username] {
set rsh_useropts "-l [board_info $hostname username]"
} else {
set rsh_useropts ""
}
# get the hostname and port number from the config array
if [board_info $hostname exists name] {
set hostname [board_info $hostname name];
}
set hostname [lindex [split [board_info ${hostname} netport] ":"] 0]
if [board_info ${hostname} exists shell_prompt] {
set shell_prompt [board_info ${hostname} shell_prompt]
} else {
set shell_prompt ".*> "
}
if [board_info $hostname exists fileid] {
unset board_info($hostname,fileid);
}
spawn $RSH $rsh_useropts $hostname
if { $spawn_id < 0 } {
perror "invalid spawn id from $RSH"
return -1
}
send "\r\n"
while { $tries <= 3 } {
expect {
-re ".*$shell_prompt.*$" {
verbose "Got prompt\n"
set result 0
break
}
-re "TERM = .*$" {
warning "Setting terminal type to vt100"
set result 0
send "vt100\n"
break
}
"unknown host" {
exp_send "\003"
perror "telnet: unknown host"
break
}
"has logged on from" {
exp_continue
}
-re "isn't registered for Kerberos.*service.*$" {
warning "$RSH: isn't registered for Kerberos, please kinit"
catch close
catch wait
break
}
-re "Kerberos rcmd failed.*$" {
warning "$RSH: Kerberos rcmd failed, please kinit"
catch close
catch wait
break
}
-re "You have no Kerberos tickets.*$" {
warning "$RSH: No kerberos Tickets, please kinit"
catch close
catch wait
break
}
"Terminal type is" {
verbose "$RSH: connected, got terminal prompt" 2
set result 0
break
}
-re "trying normal rlogin.*$" {
warning "$RSH: trying normal rlogin."
catch close
catch wait
break
}
-re "unencrypted connection.*$" {
warning "$RSH: unencrypted connection, please kinit"
catch close
catch wait
break
}
-re "Sorry, shell is locked.*Connection closed.*$" {
warning "$RSH: already connected."
}
timeout {
warning "$RSH: timed out trying to connect."
}
eof {
perror "$RSH: got EOF while trying to connect."
break
}
}
incr tries
}
if { $result < 0 } {
# perror "$RSH: couldn't connect after $tries tries."
close -i $spawn_id
set spawn_id -1
} else {
set board_info($hostname,fileid) $spawn_id
}
return $spawn_id
}
#
# Download $srcfile to $destfile on $desthost.
#
proc rsh_download {desthost srcfile destfile} {
# must be done before desthost is rewritten
if [board_info $desthost exists rcp_prog] {
set RCP [board_info $desthost rcp_prog];
} else {
set RCP rcp
}
if [board_info $desthost exists rsh_prog] {
set RSH [board_info $desthost rsh_prog];
} else {
if { [which remsh] != 0 } {
set RSH remsh
} else {
set RSH rsh
}
}
if [board_info $desthost exists username] {
set rsh_useropts "-l [board_info $desthost username]"
set rcp_user "[board_info $desthost username]@"
} else {
set rsh_useropts ""
set rcp_user ""
}
if [board_info $desthost exists name] {
set desthost [board_info $desthost name];
}
if [board_info $desthost exists hostname] {
set desthost [board_info $desthost hostname];
}
set status [catch "exec $RSH $rsh_useropts $desthost rm -f $destfile |& cat" output]
set status [catch "exec $RCP $srcfile $rcp_user$desthost:$destfile |& cat" output]
if { $status == 0 } {
verbose "Copied $srcfile to $desthost:$destfile" 2
return $destfile;
} else {
verbose "Download to $desthost failed, $output."
return ""
}
}
proc rsh_upload {desthost srcfile destfile} {
if [board_info $desthost exists rcp_prog] {
set RCP [board_info $desthost rcp_prog];
} else {
set RCP rcp
}
if [board_info $desthost exists username] {
set rcp_user "[board_info $desthost username]@"
} else {
set rcp_user ""
}
if [board_info $desthost exists name] {
set desthost [board_info $desthost name];
}
if [board_info $desthost exists hostname] {
set desthost [board_info $desthost hostname];
}
set status [catch "exec $RCP $rcp_user$desthost:$srcfile $destfile" output];
if { $status == 0 } {
verbose "Copied $desthost:$srcfile to $destfile" 2
return $destfile;
} else {
verbose "Upload from $desthost failed, $output."
return ""
}
}
#
# Execute "$cmd $args[0]" on $boardname.
#
proc rsh_exec { boardname cmd args } {
if { [llength $args] > 0 } {
set pargs [lindex $args 0];
if { [llength $args] > 1 } {
set inp [lindex $args 1];
} else {
set inp "";
}
} else {
set pargs ""
set inp ""
}
verbose "Executing $boardname:$cmd $pargs < $inp"
if ![board_info $boardname exists rsh_prog] {
if { [which remsh] != 0 } {
set RSH remsh
} else {
set RSH rsh
}
} else {
set RSH [board_info $boardname rsh_prog];
}
if [board_info $boardname exists username] {
set rsh_useropts "-l [board_info $boardname username]"
} else {
set rsh_useropts ""
}
if [board_info $boardname exists name] {
set boardname [board_info $boardname name];
}
if [board_info $boardname exists hostname] {
set hostname [board_info $boardname hostname];
} else {
set hostname $boardname;
}
# If CMD sends any output to stderr, exec will think it failed. More often
# than not that will be true, but it doesn't catch the case where there is
# no output but the exit code is non-zero.
if { $inp == "" } {
set inp "/dev/null"
}
set status [catch "exec cat $inp | $RSH $rsh_useropts $hostname sh -c '$cmd $pargs \\; echo XYZ\\\${?}ZYX' |& cat" output]
verbose "$RSH output is $output"
# `status' doesn't mean much here other than rsh worked ok.
# What we want is whether $cmd ran ok.
if { $status != 0 } {
regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
return [list -1 "$RSH to $boardname failed for $cmd, $output"]
}
regexp "XYZ(\[0-9\]*)ZYX" $output junk status
verbose "rsh_exec: status:$status text:$output" 4
if { $status == "" } {
return [list -1 "Couldn't parse $RSH output, $output."]
}
regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
# Delete one trailing \n because that is what `exec' will do and we want
# to behave identical to it.
regsub "\n$" $output "" output
return [list [expr $status != 0] $output]
}