lib/kermit.exp

   1 # Copyright (C) 1992-2019, 2020 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu; if not, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # Connect to DEST using Kermit. Note that we're just using Kermit as a
  20 # simple serial or network connect program; we don't actually use Kermit
  21 # protocol to do downloads.
  22 #
  23 # Returns -1 if it failed, otherwise it returns the spawn_id.
  24 #
  25 proc kermit_open {dest args} {
  26     global spawn_id
  27     global board_info
  28
  29     if {[board_info $dest exists name]} {
  30         set dest [board_info $dest name]
  31     }
  32     if {[board_info $dest exists serial]} {
  33         set port [board_info $dest serial]
  34         set device "-l [board_info $dest serial]"
  35         if {[board_info $dest exists baud]} {
  36             append device " -b [board_info $dest baud]"
  37         }
  38     } else {
  39         set port [board_info $dest netport]
  40         set device "-j [board_info $dest netport]"
  41     }
  42
  43     set tries 0
  44     set result -1
  45     verbose "kermit $device"
  46     eval spawn kermit $device
  47     if {$spawn_id < 0} {
  48         perror "invalid spawn id from Kermit"
  49         return -1
  50     }
  51
  52     expect {
  53         -re ".*ermit.*>.*$" {
  54             send "c\n"
  55             expect {
  56                 -re "Connecting to.*$port.*Type the escape character followed by C to.*options.*\[\r\n\]$" {
  57                     verbose "Got prompt\n"
  58                     set result 0
  59                     incr tries
  60                 }
  61                 timeout {
  62                     warning "Never got prompt from Kermit."
  63                     set result -1
  64                     incr tries
  65                     if {$tries <= 2} {
  66                         exp_continue
  67                     }
  68                 }
  69             }
  70         }
  71         -re "Connection Closed.*$" {
  72             perror "Never connected."
  73             set result -1
  74             incr tries
  75             if {$tries <= 2} {
  76                 exp_continue
  77             }
  78         }
  79         timeout                 {
  80             warning "Timed out trying to connect."
  81             set result -1
  82             incr tries
  83             if {$tries <= 2} {
  84                 exp_continue
  85             }
  86         }
  87     }
  88
  89     if {$result < 0} {
  90         perror "Couldn't connect after $tries tries."
  91         if {[info exists board_info($dest,fileid)]} {
  92             unset board_info($dest,fileid)
  93         }
  94         return -1
  95     } else {
  96         verbose "Kermit connection established with spawn_id $spawn_id."
  97         set board_info($dest,fileid) $spawn_id
  98         kermit_command $dest "set file type binary" "set transfer display none"
  99         if {[board_info $dest exists transmit_pause]} {
 100             kermit_command $dest "set transmit pause [board_info $dest transmit_pause]"
 101         }
 102         return $spawn_id
 103     }
 104 }
 105
 106 # Send a list of commands to the Kermit session connected to DEST.
 107 #
 108 proc kermit_command {dest args} {
 109     if {[board_info $dest exists name]} {
 110         set dest [board_info $dest name]
 111     }
 112     set shell_id [board_info $dest fileid]
 113
 114     # Sometimes we have to send multiple ^\c sequences. Don't know
 115     # why.
 116     set timeout 2
 117     for {set i 1} {$i <= 5} {incr i} {
 118         send -i $shell_id "\x1cc"
 119         expect {
 120             -i $shell_id -re ".*Back at.*ermit.*>.*$" {set i 10}
 121             -i $shell_id timeout {
 122                 if {$i > 2} {
 123                     warning "Unable to get prompt from kermit."
 124                 }
 125             }
 126         }
 127     }
 128     foreach command $args {
 129         set timeout 120
 130         send -i $shell_id "$command\r"
 131         expect {
 132             -i $shell_id -re ".*ermit.*>.*$" { }
 133             -i $shell_id timeout {
 134                 perror "Response failed from Kermit."
 135                 return -1
 136             }
 137         }
 138     }
 139     send -i $shell_id "c\r"
 140     expect {
 141         -i $shell_id -re {.*other options.[\r\n]+} { }
 142         -i $shell_id timeout {
 143             perror "Unable to resume Kermit connection."
 144             return -1
 145         }
 146     }
 147     return 0
 148 }
 149
 150 # Send STRING to DEST.
 151 #
 152 proc kermit_send {dest string args} {
 153     if {[board_info $dest exists transmit_pause]} {
 154         set f [open "/tmp/fff" "w"]
 155         puts -nonewline $f $string
 156         close $f
 157         set result [remote_transmit $dest /tmp/fff]
 158         remote_file build delete "/tmp/fff"
 159         return $result
 160     } else {
 161         return [standard_send $dest $string]
 162     }
 163 }
 164
 165 # Transmit FILE directly to DEST as raw data.
 166 # No translation is performed.
 167 #
 168 proc kermit_transmit {dest file args} {
 169     if {[board_info $dest exists transmit_pause]} {
 170         kermit_command $dest "transmit $file"
 171         return ""
 172     } else {
 173         return [standard_transmit $dest $file]
 174     }
 175 }