1
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
2
# 2001, 2002, 2003 Free Software Foundation, Inc.
4
# This file is part of DejaGnu.
6
# DejaGnu is free software; you can redistribute it and/or modify it
7
# under the terms of the GNU General Public License as published by
8
# the Free Software Foundation; either version 2 of the License, or
9
# (at your option) any later version.
11
# DejaGnu is distributed in the hope that it will be useful, but
12
# WITHOUT ANY WARRANTY; without even the implied warranty of
13
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14
# General Public License for more details.
16
# You should have received a copy of the GNU General Public License
17
# along with DejaGnu; if not, write to the Free Software Foundation,
18
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21
# Connect to hostname using rlogin
23
proc rsh_open { hostname } {
29
if ![board_info $hostname exists rsh_prog] {
30
if { [which remsh] != 0 } {
36
set RSH [board_info $hostname rsh_prog]
39
if [board_info $hostname exists username] {
40
set rsh_useropts "-l [board_info $hostname username]"
45
# get the hostname and port number from the config array
46
if [board_info $hostname exists name] {
47
set hostname [board_info $hostname name]
49
set hostname [lindex [split [board_info ${hostname} netport] ":"] 0]
50
if [board_info ${hostname} exists shell_prompt] {
51
set shell_prompt [board_info ${hostname} shell_prompt]
53
set shell_prompt ".*> "
56
if [board_info $hostname exists fileid] {
57
unset board_info($hostname,fileid)
60
spawn $RSH $rsh_useropts $hostname
61
if { $spawn_id < 0 } {
62
perror "invalid spawn id from $RSH"
67
while { $tries <= 3 } {
69
-re ".*$shell_prompt.*$" {
70
verbose "Got prompt\n"
75
warning "Setting terminal type to vt100"
82
perror "telnet: unknown host"
85
"has logged on from" {
88
-re "isn't registered for Kerberos.*service.*$" {
89
warning "$RSH: isn't registered for Kerberos, please kinit"
94
-re "Kerberos rcmd failed.*$" {
95
warning "$RSH: Kerberos rcmd failed, please kinit"
100
-re "You have no Kerberos tickets.*$" {
101
warning "$RSH: No kerberos Tickets, please kinit"
107
verbose "$RSH: connected, got terminal prompt" 2
111
-re "trying normal rlogin.*$" {
112
warning "$RSH: trying normal rlogin."
117
-re "unencrypted connection.*$" {
118
warning "$RSH: unencrypted connection, please kinit"
123
-re "Sorry, shell is locked.*Connection closed.*$" {
124
warning "$RSH: already connected."
127
warning "$RSH: timed out trying to connect."
130
perror "$RSH: got EOF while trying to connect."
138
# perror "$RSH: couldn't connect after $tries tries."
142
set board_info($hostname,fileid) $spawn_id
149
# Download $srcfile to $destfile on $desthost.
152
proc rsh_download {desthost srcfile destfile} {
153
# must be done before desthost is rewritten
154
if [board_info $desthost exists rcp_prog] {
155
set RCP [board_info $desthost rcp_prog]
160
if [board_info $desthost exists rsh_prog] {
161
set RSH [board_info $desthost rsh_prog]
163
if { [which remsh] != 0 } {
170
if [board_info $desthost exists username] {
171
set rsh_useropts "-l [board_info $desthost username]"
172
set rcp_user "[board_info $desthost username]@"
178
if [board_info $desthost exists name] {
179
set desthost [board_info $desthost name]
182
if [board_info $desthost exists hostname] {
183
set desthost [board_info $desthost hostname]
186
set status [catch "exec $RSH $rsh_useropts $desthost rm -f $destfile |& cat" output]
187
set status [catch "exec $RCP $srcfile $rcp_user$desthost:$destfile |& cat" output]
188
if { $status == 0 } {
189
verbose "Copied $srcfile to $desthost:$destfile" 2
192
verbose "Download to $desthost failed, $output."
197
proc rsh_upload {desthost srcfile destfile} {
198
if [board_info $desthost exists rcp_prog] {
199
set RCP [board_info $desthost rcp_prog]
204
if [board_info $desthost exists username] {
205
set rcp_user "[board_info $desthost username]@"
210
if [board_info $desthost exists name] {
211
set desthost [board_info $desthost name]
214
if [board_info $desthost exists hostname] {
215
set desthost [board_info $desthost hostname]
218
set status [catch "exec $RCP $rcp_user$desthost:$srcfile $destfile" output]
219
if { $status == 0 } {
220
verbose "Copied $desthost:$srcfile to $destfile" 2
223
verbose "Upload from $desthost failed, $output."
229
# Execute "$cmd $args[0]" on $boardname.
231
proc rsh_exec { boardname cmd args } {
232
if { [llength $args] > 0 } {
233
set pargs [lindex $args 0]
234
if { [llength $args] > 1 } {
235
set inp [lindex $args 1]
244
verbose "Executing $boardname:$cmd $pargs < $inp"
246
if ![board_info $boardname exists rsh_prog] {
247
if { [which remsh] != 0 } {
253
set RSH [board_info $boardname rsh_prog]
256
if [board_info $boardname exists username] {
257
set rsh_useropts "-l [board_info $boardname username]"
262
if [board_info $boardname exists name] {
263
set boardname [board_info $boardname name]
266
if [board_info $boardname exists hostname] {
267
set hostname [board_info $boardname hostname]
269
set hostname $boardname
273
# If CMD sends any output to stderr, exec will think it failed. More often
274
# than not that will be true, but it doesn't catch the case where there is
275
# no output but the exit code is non-zero.
280
set status [catch "exec cat $inp | $RSH $rsh_useropts $hostname sh -c '$cmd $pargs \\; echo XYZ\\\${?}ZYX' |& cat" output]
281
verbose "$RSH output is $output"
282
# `status' doesn't mean much here other than rsh worked ok.
283
# What we want is whether $cmd ran ok.
284
if { $status != 0 } {
285
regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
286
return [list -1 "$RSH to $boardname failed for $cmd, $output"]
288
regexp "XYZ(\[0-9\]*)ZYX" $output junk status
289
verbose "rsh_exec: status:$status text:$output" 4
290
if { $status == "" } {
291
return [list -1 "Couldn't parse $RSH output, $output."]
293
regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
294
# Delete one trailing \n because that is what `exec' will do and we want
295
# to behave identical to it.
296
regsub "\n$" $output "" output
297
return [list [expr $status != 0] $output]