diff options
Diffstat (limited to 'dejagnu/lib/kermit.exp')
| -rw-r--r-- | dejagnu/lib/kermit.exp | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/dejagnu/lib/kermit.exp b/dejagnu/lib/kermit.exp new file mode 100644 index 00000000000..6e1ac37777f --- /dev/null +++ b/dejagnu/lib/kermit.exp @@ -0,0 +1,180 @@ +# Copyright (C) 92, 93, 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc. + +# This program 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 2 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# Please email any bugs, comments, and/or additions to this file to: +# bug-dejagnu@prep.ai.mit.edu + +# +# Connect to DEST using kermit. Note that we're just using kermit as a +# simple serial or network connect program; we don't actually use Kermit +# protocol to do downloads. +# returns -1 if it failed, otherwise it returns +# the spawn_id. +# +proc kermit_open { dest args } { + global spawn_id + global board_info + + if [board_info $dest exists name] { + set dest [board_info $dest name]; + } + if [board_info ${dest} exists serial] { + set port [board_info ${dest} serial]; + set device "-l [board_info ${dest} serial]" + if [board_info ${dest} exists baud] { + append device " -b [board_info ${dest} baud]" + } + } else { + set port [board_info ${dest} netport]; + set device "-j [board_info ${dest} netport]"; + } + + set tries 0 + set result -1 + verbose "kermit $device" + eval spawn kermit $device + if { $spawn_id < 0 } { + perror "invalid spawn id from kermit" + return -1 + } + + expect { + -re ".*ermit.*>.*$" { + send "c\n" + expect { + -re "Connecting to.*$port.*Type the escape character followed by C to.*options.*\[\r\n\]$" { + verbose "Got prompt\n" + set result 0 + incr tries + } + timeout { + warning "Never got prompt from Kermit." + set result -1 + incr tries + if { $tries <= 2 } { + exp_continue + } + } + } + } + -re "Connection Closed.*$" { + perror "Never connected." + set result -1 + incr tries + if { $tries <= 2 } { + exp_continue + } + } + timeout { + warning "Timed out trying to connect." + set result -1 + incr tries + if { $tries<=2 } { + exp_continue + } + } + } + + if { $result < 0 } { + perror "Couldn't connect after $tries tries." + if [info exists board_info($dest,fileid)] { + unset board_info($dest,fileid); + } + return -1 + } else { + verbose "Kermit connection established with spawn_id $spawn_id." + set board_info($dest,fileid) $spawn_id + kermit_command $dest "set file type binary" "set transfer display none" + if [board_info $dest exists transmit_pause] { + kermit_command $dest "set transmit pause [board_info $dest transmit_pause]" + } + return $spawn_id + } +} + +# +# Send a list of commands to the Kermit session connected to DEST. +# +proc kermit_command { dest args } { + if [board_info $dest exists name] { + set dest [board_info $dest name]; + } + set shell_id [board_info $dest fileid]; + # Sometimes we have to send multiple ^\c sequences. Don't know + # why. + set timeout 2; + for { set i 1; } {$i<=5} {incr i} { + send -i $shell_id " c"; + expect { + -i $shell_id -re ".*Back at.*ermit.*>.*$" { set i 10;} + -i $shell_id timeout { + if { $i > 2 } { + warning "Unable to get prompt from kermit."; + } + } + } + } + foreach command $args { + set timeout 120 + send -i $shell_id "${command}\r"; + expect { + -i $shell_id -re ".*ermit.*>.*$" { } + -i $shell_id timeout { + perror "Response failed from kermit."; + return -1; + } + } + } + send -i $shell_id "c\r"; + expect { + -i $shell_id -re ".*other options.\[\r\n\]+" { } + -i $shell_id timeout { + perror "Unable to resume kermit connection."; + return -1; + } + } + return 0; +} + + +# +# Send STRING to DEST. +# +proc kermit_send { dest string args } { + if [board_info $dest exists transmit_pause] { + set f [open "/tmp/fff" "w"]; + puts -nonewline $f "$string"; + close $f; + set result [remote_transmit $dest /tmp/fff]; + remote_file build delete "/tmp/fff"; + return "$result"; + } else { + return [standard_send $dest $string]; + } +} + +# +# Transmit FILE directly to DEST as raw data. No translation is +# performed. +# +proc kermit_transmit { dest file args } { + if [board_info $dest exists transmit_pause] { + kermit_command $dest "transmit $file"; + return ""; + } else { + return [standard_transmit $dest $file]; + } +} |