# Copyright (C) 1992 - 2002, 2003 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@gnu.org # # 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] } }