OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [dejagnu/] [lib/] [rsh.exp] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Copyright (C) 97, 98, 1999 Free Software Foundation, Inc.
2
 
3
# This program is free software; you can redistribute it and/or modify
4
# it under the terms of the GNU General Public License as published by
5
# the Free Software Foundation; either version 2 of the License, or
6
# (at your option) any later version.
7
#
8
# This program is distributed in the hope that it will be useful,
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11
# GNU General Public License for more details.
12
#
13
# You should have received a copy of the GNU General Public License
14
# along with this program; if not, write to the Free Software
15
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
16
 
17
# Please email any bugs, comments, and/or additions to this file to:
18
# DejaGnu@cygnus.com
19
 
20
#
21
# Connect to hostname using rlogin
22
#
23
proc rsh_open { hostname } {
24
    global spawn_id
25
 
26
    set tries 0
27
    set result -1
28
 
29
    # get the hostname and port number from the config array
30
    if [board_info $hostname exists name] {
31
        set hostname [board_info $hostname name];
32
    }
33
    set hostname [lindex [split [board_info ${hostname} netport] ":"] 0]
34
    if [board_info ${hostname} exists shell_prompt] {
35
        set shell_prompt [board_info ${hostname} shell_prompt]
36
    } else {
37
        set shell_prompt ".*> "
38
    }
39
 
40
    if [board_info $hostname exists fileid] {
41
        unset board_info($hostname,fileid);
42
    }
43
 
44
    if ![board_info $hostname exists rsh_prog] {
45
        if { [which remsh] != 0 } {
46
            set RSH remsh
47
        } else {
48
            set RSH rsh
49
        }
50
    } else {
51
        set RSH [board_info $hostname rsh_prog];
52
    }
53
 
54
    spawn $RSH $hostname
55
    if { $spawn_id < 0 } {
56
        perror "invalid spawn id from rsh"
57
        return -1
58
    }
59
 
60
    send "\r\n"
61
    while { $tries <= 3 } {
62
        expect {
63
            -re ".*$shell_prompt.*$" {
64
                verbose "Got prompt\n"
65
                set result 0
66
                break
67
            }
68
            -re "TERM = .*$" {
69
                warning "Setting terminal type to vt100"
70
                set result 0
71
                send "vt100\n"
72
                break
73
            }
74
            "unknown host" {
75
                exp_send "\003"
76
                perror "telnet: unknown host"
77
                break
78
            }
79
            "has logged on from" {
80
                exp_continue
81
            }
82
            -re "isn't registered for Kerberos.*service.*$" {
83
                warning "rsh: isn't registered for Kerberos, please kinit"
84
                catch close
85
                catch wait
86
                break
87
            }
88
            -re "Kerberos rcmd failed.*$" {
89
                warning "rsh: Kerberos rcmd failed, please kinit"
90
                catch close
91
                catch wait
92
                break
93
            }
94
            -re "You have no Kerberos tickets.*$" {
95
                warning "rsh: No kerberos Tickets, please kinit"
96
                catch close
97
                catch wait
98
                break
99
            }
100
            "Terminal type is" {
101
                verbose "rsh: connected, got terminal prompt" 2
102
                set result 0
103
                break
104
            }
105
            -re "trying normal rlogin.*$" {
106
                warning "rsh: trying normal rlogin."
107
                catch close
108
                catch wait
109
                break
110
            }
111
            -re "unencrypted connection.*$" {
112
                warning "rsh: unencrypted connection, please kinit"
113
                catch close
114
                catch wait
115
                break
116
            }
117
            -re "Sorry, shell is locked.*Connection closed.*$" {
118
                warning "rsh: already connected."
119
            }
120
            timeout {
121
               warning "rsh: timed out trying to connect."
122
            }
123
            eof {
124
                perror "rsh: got EOF while trying to connect."
125
                break
126
            }
127
        }
128
        incr tries
129
    }
130
 
131
    if { $result < 0 } {
132
#       perror "rsh: couldn't connect after $tries tries."
133
        close -i $spawn_id
134
        set spawn_id -1
135
    } else {
136
        set board_info($hostname,fileid) $spawn_id
137
    }
138
 
139
    return $spawn_id
140
}
141
 
142
#
143
# Download $srcfile to $destfile on $desthost.
144
#
145
 
146
proc rsh_download {desthost srcfile destfile} {
147
    if [board_info $desthost exists name] {
148
        set desthost [board_info $desthost name];
149
    }
150
 
151
    if [board_info $desthost exists hostname] {
152
        set desthost [board_info $desthost hostname];
153
    }
154
 
155
    if ![board_info $desthost exists rcp_prog] {
156
        set RCP rcp
157
    } else {
158
        set RCP [board_info $desthost rcp_prog];
159
    }
160
 
161
    set status [catch "exec $RCP $srcfile $desthost:$destfile |& cat" output]
162
    if { $status == 0 } {
163
        verbose "Copied $srcfile to $desthost:$destfile" 2
164
        return $destfile;
165
    } else {
166
        verbose "Download to $desthost failed, $output."
167
        return ""
168
    }
169
}
170
 
171
proc rsh_upload {desthost srcfile destfile} {
172
    if [board_info $desthost exists name] {
173
        set desthost [board_info $desthost name];
174
    }
175
 
176
    if [board_info $desthost exists hostname] {
177
        set desthost [board_info $desthost hostname];
178
    }
179
 
180
    if ![board_info $desthost exists rcp_prog] {
181
        set RCP rcp
182
    } else {
183
        set RCP [board_info $desthost rcp_prog];
184
    }
185
 
186
    set status [catch "exec $RCP $desthost:$srcfile $destfile" output];
187
    if { $status == 0 } {
188
        verbose "Copied $desthost:$srcfile to $destfile" 2
189
        return $destfile;
190
    } else {
191
        verbose "Upload from $desthost failed, $output."
192
        return ""
193
    }
194
}
195
 
196
#
197
# Execute "$cmd $args[0]" on $boardname.
198
#
199
proc rsh_exec { boardname cmd args } {
200
    if { [llength $args] > 0 } {
201
        set pargs [lindex $args 0];
202
        if { [llength $args] > 1 } {
203
            set inp [lindex $args 1];
204
        } else {
205
            set inp "";
206
        }
207
    } else {
208
        set pargs ""
209
        set inp ""
210
    }
211
 
212
    verbose "Executing $boardname:$cmd $pargs < $inp"
213
 
214
    if [board_info $boardname exists name] {
215
        set boardname [board_info $boardname name];
216
    }
217
 
218
    if [board_info $boardname exists hostname] {
219
        set hostname [board_info $boardname hostname];
220
    } else {
221
        set hostname $boardname;
222
    }
223
 
224
    if ![board_info $hostname exists rsh_prog] {
225
        if { [which remsh] != 0 } {
226
            set RSH remsh
227
        } else {
228
            set RSH rsh
229
        }
230
    } else {
231
        set RSH [board_info $hostname rsh_prog];
232
    }
233
 
234
    # If CMD sends any output to stderr, exec will think it failed.  More often
235
    # than not that will be true, but it doesn't catch the case where there is
236
    # no output but the exit code is non-zero.
237
    if { $inp == "" } {
238
        set inp "/dev/null"
239
    }
240
    set status [catch "exec cat $inp | $RSH $boardname sh -c '$cmd $pargs \\; echo XYZ\\\${?}ZYX' |& cat" output]
241
    verbose "rsh output is $output"
242
    # `status' doesn't mean much here other than rsh worked ok.
243
    # What we want is whether $cmd ran ok.
244
    if { $status != 0 } {
245
        regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
246
        return [list -1 "rsh to $boardname failed for $cmd, $output"]
247
    }
248
    regexp "XYZ(\[0-9\]*)ZYX" $output junk status
249
    verbose "rsh_exec: status:$status text:$output" 4
250
    if { $status == "" } {
251
        return [list -1 "Couldn't parse rsh output, $output."]
252
    }
253
    regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output
254
    # Delete one trailing \n because that is what `exec' will do and we want
255
    # to behave identical to it.
256
    regsub "\n$" $output "" output
257
    return [list [expr $status != 0] $output]
258
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.