aboutsummaryrefslogtreecommitdiff
path: root/lib/rsh.exp
blob: 5b583c6d4da35492fd141743dad8edb48f395d83 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
# Copyright (C) 1992-2019, 2020 Free Software Foundation, Inc.
#
# This file is part of DejaGnu.
#
# DejaGnu 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 3 of the License, or
# (at your option) any later version.
#
# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.

# Connect to HOSTNAME using rsh(1).
#
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 } {
	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 on BOARDNAME.
#
proc rsh_exec { boardname program pargs inp outp } {
    global timeout

    verbose "Executing on $boardname: $program $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 eq "" } {
	set inp "/dev/null"
    }

    set ret [local_exec "$RSH $rsh_useropts $hostname sh -c '$program $pargs \\; echo XYZ\\\${?}ZYX'" $inp $outp $timeout]
    set status [lindex $ret 0]
    set output [lindex $ret 1]

    verbose "$RSH status is $status, output is $output"

    # `status' doesn't mean much here other than rsh worked ok.
    # What we want is whether $program ran ok.  Return $status
    # if the program timed out, status will be 1 indicating that
    # rsh ran and failed.  If rsh fails, we will get FAIL rather
    # than UNRESOLVED - this will help the problem be noticed.
    if { $status != 0 } {
	regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
	return [list $status "$RSH to $boardname failed for $program, $output"]
    }
    if { [regexp "XYZ(\[0-9\]*)ZYX" $output junk status] == 0 } {
	set status ""
    }
    verbose "rsh_exec: status:$status text:$output" 4
    if { $status eq "" } {
	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]
}