← Back to branch summary

~ubuntu-branches/ubuntu/dapper/dejagnu/dapper

« back to all changes in this revision

Viewing changes to lib/kermit.exp

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Jacobowitz
  • Date: 2004-02-09 15:07:58 UTC
  • Revision ID: james.westby@ubuntu.com-20040209150758-oaj7r5zrop60v8sb
Tags: upstream-1.4.4
Import upstream version 1.4.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/kermit.exp
 
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
# Connect to DEST using Kermit. Note that we're just using Kermit as a
 
21
# simple serial or network connect program; we don't actually use Kermit
 
22
# protocol to do downloads.
 
23
#
 
24
# Returns -1 if it failed, otherwise it returns the spawn_id.
 
25
#
 
26
proc kermit_open {dest args} {
 
27
    global spawn_id
 
28
    global board_info
 
29
 
 
30
    if [board_info $dest exists name] {
 
31
        set dest [board_info $dest name]
 
32
    }
 
33
    if [board_info ${dest} exists serial] {
 
34
        set port [board_info ${dest} serial]
 
35
        set device "-l [board_info ${dest} serial]"
 
36
        if [board_info ${dest} exists baud] {
 
37
            append device " -b [board_info ${dest} baud]"
 
38
        }
 
39
    } else {
 
40
        set port [board_info ${dest} netport]
 
41
        set device "-j [board_info ${dest} netport]"
 
42
    }
 
43
 
 
44
    set tries 0
 
45
    set result -1
 
46
    verbose "kermit $device"
 
47
    eval spawn kermit $device
 
48
    if {$spawn_id < 0} {
 
49
        perror "invalid spawn id from Kermit"
 
50
        return -1
 
51
    }
 
52
 
 
53
    expect {
 
54
        -re ".*ermit.*>.*$" {
 
55
            send "c\n"
 
56
            expect {
 
57
                -re "Connecting to.*$port.*Type the escape character followed by C to.*options.*\[\r\n\]$" {
 
58
                    verbose "Got prompt\n"
 
59
                    set result 0
 
60
                    incr tries
 
61
                }
 
62
                timeout {
 
63
                    warning "Never got prompt from Kermit."
 
64
                    set result -1
 
65
                    incr tries
 
66
                    if {$tries <= 2} {
 
67
                        exp_continue
 
68
                    }
 
69
                }
 
70
            }
 
71
        }
 
72
        -re "Connection Closed.*$" {
 
73
            perror "Never connected."
 
74
            set result -1
 
75
            incr tries
 
76
            if {$tries <= 2} {
 
77
                exp_continue
 
78
            }
 
79
        }
 
80
        timeout                 {
 
81
            warning "Timed out trying to connect."
 
82
            set result -1
 
83
            incr tries
 
84
            if {$tries <= 2} {
 
85
                exp_continue
 
86
            }
 
87
        }
 
88
    }
 
89
 
 
90
    if {$result < 0} {
 
91
        perror "Couldn't connect after $tries tries."
 
92
        if [info exists board_info($dest,fileid)] {
 
93
            unset board_info($dest,fileid)
 
94
        }
 
95
        return -1
 
96
    } else {
 
97
        verbose "Kermit connection established with spawn_id $spawn_id."
 
98
        set board_info($dest,fileid) $spawn_id
 
99
        kermit_command $dest "set file type binary" "set transfer display none"
 
100
        if [board_info $dest exists transmit_pause] {
 
101
            kermit_command $dest "set transmit pause [board_info $dest transmit_pause]"
 
102
        }
 
103
        return $spawn_id
 
104
    }
 
105
}
 
106
 
 
107
# Send a list of commands to the Kermit session connected to DEST.
 
108
#
 
109
proc kermit_command {dest args} {
 
110
    if [board_info $dest exists name] {
 
111
        set dest [board_info $dest name]
 
112
    }
 
113
    set shell_id [board_info $dest fileid]
 
114
 
 
115
    # Sometimes we have to send multiple ^\c sequences. Don't know
 
116
    # why.
 
117
    set timeout 2
 
118
    for {set i 1} {$i <= 5} {incr i} {
 
119
        send -i $shell_id "c"
 
120
        expect {
 
121
            -i $shell_id -re ".*Back at.*ermit.*>.*$" {set i 10}
 
122
            -i $shell_id timeout {
 
123
                if {$i > 2} {
 
124
                    warning "Unable to get prompt from kermit."
 
125
                }
 
126
            }
 
127
        }
 
128
    }
 
129
    foreach command $args {
 
130
        set timeout 120
 
131
        send -i $shell_id "${command}\r"
 
132
        expect {
 
133
            -i $shell_id -re ".*ermit.*>.*$" { }
 
134
            -i $shell_id timeout {
 
135
                perror "Response failed from Kermit."
 
136
                return -1
 
137
            }
 
138
        }
 
139
    }
 
140
    send -i $shell_id "c\r"
 
141
    expect {
 
142
        -i $shell_id -re ".*other options.\[\r\n\]+" { }
 
143
        -i $shell_id timeout {
 
144
            perror "Unable to resume Kermit connection."
 
145
            return -1
 
146
        }
 
147
    }
 
148
    return 0
 
149
}
 
150
 
 
151
# Send STRING to DEST.
 
152
#
 
153
proc kermit_send {dest string args} {
 
154
    if [board_info $dest exists transmit_pause] {
 
155
        set f [open "/tmp/fff" "w"]
 
156
        puts -nonewline $f "$string"
 
157
        close $f
 
158
        set result [remote_transmit $dest /tmp/fff]
 
159
        remote_file build delete "/tmp/fff"
 
160
        return "$result"
 
161
    } else {
 
162
        return [standard_send $dest $string]
 
163
    }
 
164
}
 
165
 
 
166
# Transmit FILE directly to DEST as raw data.
 
167
# No translation is performed.
 
168
#
 
169
proc kermit_transmit {dest file args} {
 
170
    if [board_info $dest exists transmit_pause] {
 
171
        kermit_command $dest "transmit $file"
 
172
        return ""
 
173
    } else {
 
174
        return [standard_transmit $dest $file]
 
175
    }
 
176
}