1 # Copyright
(C
) 1992-2019, 2020 Free Software Foundation
, Inc.
3 # This file is part of DejaGnu.
5 # DejaGnu is free software
; you can redistribute it and
/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation
; either version
3 of the License
, or
8 #
(at your option
) any later version.
10 # DejaGnu is distributed in the hope that it will be useful
, but
11 # WITHOUT
ANY WARRANTY
; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License
for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with DejaGnu
; if not
, write to the Free Software Foundation
,
17 # Inc.
, 51 Franklin Street
- Fifth Floor
, Boston
, MA
02110-1301, USA.
19 #
Connect to HOSTNAME using rsh
(1).
21 proc rsh_open
{ hostname
} {
27 if {![board_info $hostname
exists rsh_prog
]} {
28 if { [which remsh
] != 0 } {
34 set RSH
[board_info $hostname rsh_prog
]
37 if {[board_info $hostname
exists username
]} {
38 set rsh_useropts
"-l [board_info $hostname username]"
43 #
Get the hostname and port number from the config array.
44 if {[board_info $hostname
exists name]} {
45 set hostname
[board_info $hostname
name]
47 set hostname
[lindex
[split
[board_info $hostname netport
] ":"] 0]
48 if {[board_info $hostname
exists shell_prompt
]} {
49 set shell_prompt
[board_info $hostname shell_prompt
]
51 set shell_prompt
".*> "
54 if {[board_info $hostname
exists fileid
]} {
55 unset board_info
($hostname
,fileid
)
58 spawn $RSH $rsh_useropts $hostname
59 if { $spawn_id
< 0 } {
60 perror
"invalid spawn id from $RSH"
65 while { $tries
<= 3 } {
67 -re
".*$shell_prompt.*$" {
68 verbose
"Got prompt\n"
73 warning
"Setting terminal type to vt100"
80 perror
"telnet: unknown host"
83 "has logged on from" {
86 -re
"isn't registered for Kerberos.*service.*$" {
87 warning
"$RSH: isn't registered for Kerberos, please kinit"
92 -re
"Kerberos rcmd failed.*$" {
93 warning
"$RSH: Kerberos rcmd failed, please kinit"
98 -re
"You have no Kerberos tickets.*$" {
99 warning
"$RSH: No kerberos Tickets, please kinit"
105 verbose
"$RSH: connected, got terminal prompt" 2
109 -re
"trying normal rlogin.*$" {
110 warning
"$RSH: trying normal rlogin."
115 -re
"unencrypted connection.*$" {
116 warning
"$RSH: unencrypted connection, please kinit"
121 -re
"Sorry, shell is locked.*Connection closed.*$" {
122 warning
"$RSH: already connected."
125 warning
"$RSH: timed out trying to connect."
128 perror
"$RSH: got EOF while trying to connect."
139 set board_info
($hostname
,fileid
) $spawn_id
145 # Download SRCFILE to DESTFILE
on DESTHOST.
147 proc rsh_download
{desthost srcfile destfile
} {
148 # must be done before desthost is rewritten
149 if {[board_info $desthost
exists rcp_prog
]} {
150 set RCP
[board_info $desthost rcp_prog
]
155 if {[board_info $desthost
exists rsh_prog
]} {
156 set RSH
[board_info $desthost rsh_prog
]
158 if { [which remsh
] != 0 } {
165 if {[board_info $desthost
exists username
]} {
166 set rsh_useropts
"-l [board_info $desthost username]"
167 set rcp_user
"[board_info $desthost username]@"
173 if {[board_info $desthost
exists name]} {
174 set desthost
[board_info $desthost
name]
177 if {[board_info $desthost
exists hostname
]} {
178 set desthost
[board_info $desthost hostname
]
181 set status [catch
"exec $RSH $rsh_useropts $desthost rm -f $destfile |& cat" output]
182 set status [catch
"exec $RCP $srcfile $rcp_user$desthost:$destfile |& cat" output]
183 if { $
status == 0 } {
184 verbose
"Copied $srcfile to $desthost:$destfile" 2
187 verbose
"Download to $desthost failed, $output."
192 proc rsh_upload
{desthost srcfile destfile
} {
193 if {[board_info $desthost
exists rcp_prog
]} {
194 set RCP
[board_info $desthost rcp_prog
]
199 if {[board_info $desthost
exists username
]} {
200 set rcp_user
"[board_info $desthost username]@"
205 if {[board_info $desthost
exists name]} {
206 set desthost
[board_info $desthost
name]
209 if {[board_info $desthost
exists hostname
]} {
210 set desthost
[board_info $desthost hostname
]
213 set status [catch
"exec $RCP $rcp_user$desthost:$srcfile $destfile" output]
214 if { $
status == 0 } {
215 verbose
"Copied $desthost:$srcfile to $destfile" 2
218 verbose
"Upload from $desthost failed, $output."
223 #
Execute CMD
on BOARDNAME.
225 proc rsh_exec
{ boardname
program pargs inp outp
} {
228 verbose
"Executing on $boardname: $program $pargs < $inp"
230 if {![board_info $boardname
exists rsh_prog
]} {
231 if { [which remsh
] != 0 } {
237 set RSH
[board_info $boardname rsh_prog
]
240 if {[board_info $boardname
exists username
]} {
241 set rsh_useropts
"-l [board_info $boardname username]"
246 if {[board_info $boardname
exists name]} {
247 set boardname
[board_info $boardname
name]
250 if {[board_info $boardname
exists hostname
]} {
251 set hostname
[board_info $boardname hostname
]
253 set hostname $boardname
256 #
If CMD sends
any output to stderr
, exec will think it failed.
257 # More often than not that will be true
, but it doesn
't catch the
258 # case where there is no output but the exit code is non-zero.
263 set ret [local_exec "$RSH $rsh_useropts $hostname sh -c '$
program $pargs
\\; echo XYZ
\\\$
{?
}ZYX
'" $inp $outp $timeout]
264 set status [lindex $ret 0]
265 set output [lindex $ret 1]
267 verbose "$RSH status is $status, output is $output"
269 # `status' doesn
't mean much here other than rsh worked ok.
270 # What we want is whether $program ran ok. Return $status
271 # if the program timed out, status will be 1 indicating that
272 # rsh ran and failed. If rsh fails, we will get FAIL rather
273 # than UNRESOLVED - this will help the problem be noticed.
274 if { $status != 0 } {
275 regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
276 return [list $status "$RSH to $boardname failed for $program, $output"]
278 if { [regexp "XYZ(\[0-9\]*)ZYX" $output junk status] == 0 } {
281 verbose "rsh_exec: status:$status text:$output" 4
282 if { $status eq "" } {
283 return [list -1 "Couldn't
parse $RSH output
, $output.
"]
285 regsub
"XYZ(\[0-9\]*)ZYX\n?" $output "" output
286 return [list
[expr
{$
status != 0}] $output
]