1# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
2# 2001, 2002, 2003 Free Software Foundation, Inc.
3#
4# This file is part of DejaGnu.
5#
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.
10#
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.
15#
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.
19
20#
21# Connect to hostname using rlogin
22#
23proc rsh_open { hostname } {
24    global spawn_id
25
26    set tries 0
27    set result -1
28
29    if ![board_info $hostname exists rsh_prog] {
30	if { [which remsh] != 0 } {
31	    set RSH remsh
32	} else {
33	    set RSH rsh
34	}
35    } else {
36	set RSH [board_info $hostname rsh_prog]
37    }
38
39    if [board_info $hostname exists username] {
40	set rsh_useropts "-l [board_info $hostname username]"
41    } else {
42	set rsh_useropts ""
43    }
44
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]
48    }
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]
52    } else {
53	set shell_prompt ".*> "
54    }
55
56    if [board_info $hostname exists fileid] {
57	unset board_info($hostname,fileid)
58    }
59
60    spawn $RSH $rsh_useropts $hostname
61    if { $spawn_id < 0 } {
62	perror "invalid spawn id from $RSH"
63	return -1
64    }
65
66    send "\r\n"
67    while { $tries <= 3 } {
68	expect {
69	    -re ".*$shell_prompt.*$" {
70		verbose "Got prompt\n"
71		set result 0
72		break
73	    }
74	    -re "TERM = .*$" {
75		warning "Setting terminal type to vt100"
76		set result 0
77		send "vt100\n"
78		break
79	    }
80	    "unknown host" {
81		exp_send "\003"
82		perror "telnet: unknown host"
83		break
84	    }
85	    "has logged on from" {
86		exp_continue
87	    }
88	    -re "isn't registered for Kerberos.*service.*$" {
89		warning "$RSH: isn't registered for Kerberos, please kinit"
90		catch close
91		catch wait
92		break
93	    }
94	    -re "Kerberos rcmd failed.*$" {
95		warning "$RSH: Kerberos rcmd failed, please kinit"
96		catch close
97		catch wait
98		break
99	    }
100	    -re "You have no Kerberos tickets.*$" {
101		warning "$RSH: No kerberos Tickets, please kinit"
102		catch close
103		catch wait
104		break
105	    }
106	    "Terminal type is" {
107		verbose "$RSH: connected, got terminal prompt" 2
108		set result 0
109		break
110	    }
111	    -re "trying normal rlogin.*$" {
112		warning "$RSH: trying normal rlogin."
113		catch close
114		catch wait
115		break
116	    }
117	    -re "unencrypted connection.*$" {
118		warning "$RSH: unencrypted connection, please kinit"
119		catch close
120		catch wait
121		break
122	    }
123	    -re "Sorry, shell is locked.*Connection closed.*$" {
124		warning "$RSH: already connected."
125	    }
126	    timeout {
127		warning "$RSH: timed out trying to connect."
128	    }
129	    eof {
130		perror "$RSH: got EOF while trying to connect."
131		break
132	    }
133	}
134	incr tries
135    }
136
137    if { $result < 0 } {
138	#	perror "$RSH: couldn't connect after $tries tries."
139	close -i $spawn_id
140	set spawn_id -1
141    } else {
142	set board_info($hostname,fileid) $spawn_id
143    }
144
145    return $spawn_id
146}
147
148#
149# Download $srcfile to $destfile on $desthost.
150#
151
152proc 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]
156    } else {
157        set RCP rcp
158    }
159
160    if [board_info $desthost exists rsh_prog] {
161	set RSH [board_info $desthost rsh_prog]
162    } else {
163	if { [which remsh] != 0 } {
164	    set RSH remsh
165	} else {
166	    set RSH rsh
167	}
168    }
169
170    if [board_info $desthost exists username] {
171	set rsh_useropts "-l [board_info $desthost username]"
172	set rcp_user "[board_info $desthost username]@"
173    } else {
174	set rsh_useropts ""
175	set rcp_user ""
176    }
177
178    if [board_info $desthost exists name] {
179	set desthost [board_info $desthost name]
180    }
181
182    if [board_info $desthost exists hostname] {
183	set desthost [board_info $desthost hostname]
184    }
185
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
190	return $destfile
191    } else {
192	verbose "Download to $desthost failed, $output."
193	return ""
194    }
195}
196
197proc rsh_upload {desthost srcfile destfile} {
198    if [board_info $desthost exists rcp_prog] {
199	set RCP [board_info $desthost rcp_prog]
200    } else {
201        set RCP rcp
202    }
203
204    if [board_info $desthost exists username] {
205	set rcp_user "[board_info $desthost username]@"
206    } else {
207	set rcp_user ""
208    }
209
210    if [board_info $desthost exists name] {
211	set desthost [board_info $desthost name]
212    }
213
214    if [board_info $desthost exists hostname] {
215	set desthost [board_info $desthost hostname]
216    }
217
218    set status [catch "exec $RCP $rcp_user$desthost:$srcfile $destfile" output]
219    if { $status == 0 } {
220	verbose "Copied $desthost:$srcfile to $destfile" 2
221	return $destfile
222    } else {
223	verbose "Upload from $desthost failed, $output."
224	return ""
225    }
226}
227
228#
229# Execute "$cmd $args[0]" on $boardname.
230#
231proc 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]
236	} else {
237	    set inp ""
238	}
239    } else {
240	set pargs ""
241	set inp ""
242    }
243
244    verbose "Executing $boardname:$cmd $pargs < $inp"
245
246    if ![board_info $boardname exists rsh_prog] {
247	if { [which remsh] != 0 } {
248	    set RSH remsh
249	} else {
250	    set RSH rsh
251	}
252    } else {
253	set RSH [board_info $boardname rsh_prog]
254    }
255
256    if [board_info $boardname exists username] {
257	set rsh_useropts "-l [board_info $boardname username]"
258    } else {
259	set rsh_useropts ""
260    }
261
262    if [board_info $boardname exists name] {
263	set boardname [board_info $boardname name]
264    }
265
266    if [board_info $boardname exists hostname] {
267	set hostname [board_info $boardname hostname]
268    } else {
269	set hostname $boardname
270    }
271
272
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.
276    if { $inp == "" } {
277	set inp "/dev/null"
278    }
279
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"]
287    }
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."]
292    }
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]
298}
299