Updated 2013-10-07 02:50:00 by RLE

2003-09-22 VI My first attempt at contributing. This is a simple telnet client which handles the initial handshakes. Tested with Solaris-5,6,7,8. A sample usage is
  set scr [list "gin:" "venkat\r\n" "word:" "mypwd\r\n" ">" "date\r\n" ">" "exit\r\n"]
  set r [vexpect [list telnet.server.com 23] $scr]

This logs in to telnet.server.com on the telnet port, gets the date and exits. Each alternate argument in script is something to expect and something to send.
 namespace eval ::vexpect {}
 
 
 proc vexpect::timedout {} {
     append vexpect::ret "Timed out looking for [lindex $vexpect::script $vexpect::scrindex]\n"
     set vexpect::exit 1
 }
 
 proc vexpect::check {t} {
     append vexpect::ret $t
     if {$vexpect::scrindex < 0} return
     set vexpect::bufferred "$vexpect::bufferred$t"
     if [regexp [lindex $vexpect::script $vexpect::scrindex] $vexpect::bufferred] {
         after cancel $vexpect::afid
         incr vexpect::scrindex
         vexpect::send [lindex $vexpect::script $vexpect::scrindex]
         set vexpect::bufferred ""
         incr vexpect::scrindex
         if {[lindex $vexpect::script $vexpect::scrindex] == "interact"} {
             set vexpect::scrindex -1
         } else {
             set vexpect::afid [after $vexpect::timeout vexpect::timedout]
         }
     }
 }
 
 
 proc vexpect::cr {} {
     global vexpect::f vexpect::started vexpect::debug vexpect::exit
 
     set t [read $vexpect::f]
     if [eof $vexpect::f] {set vexpect::exit 1}
     if {$started} {
         vexpect::check $t
     } else {
         binary scan $t c* a
         if {$debug} {
             puts "Deciphering: $a"
         }
         set idx 0
         while {$idx < [llength $a]} {
             if {[lindex $a $idx] == -1} {
                 if {$debug} {
                     puts "got -1"
                 }
                 incr idx
                 switch -- [lindex $a $idx] {
                     -2 - 
                     -3 - 
                     -4 - 
                     -5 {
                         set ope [lindex $a $idx]
                         if {$debug} {
                             puts " got $ope"
                         }
                         incr idx
                         set opt [lindex $a $idx]
                         if {$debug} {
                             puts " for $opt"
                         }
                         if {$ope == -3} {
                             if {$debug} {
                                 puts "Vexpect::Send reject at index $idx"
                             }
                             puts -nonewline $vexpect::f [binary format ccc -1 -4 $opt]
                             flush $vexpect::f
                         }
                     }
                     -6 - 
                     -7 - 
                     -8 - 
                     -9 - 
                     -10 - 
                     -11 - 
                     -12 -
                     -13 - 
                     -14 - 
                     -15 - 
                     -16 {
                         if {$debug} {
                             puts " got [lindex $a $idx]"
                         }
                     }
                 }
                 incr idx
             } else {
                 if {$debug} {
                     puts "Starting with $idx = [lindex $a $idx]"
                 }
                 set t [binary format c* [lrange $a $idx end]]
                 vexpect::check $t
                 set vexpect::started 1
                 break
             }
         }
     }
 }
 
 proc vexpect::send {text} {
    if [catch { puts -nonewline $vexpect::f $text; flush $vexpect::f}] {
        set vexpect::exit 1
    }
    return 1
 }
 
 proc vexpect {host scr} {
     set vexpect::script $scr
     set vexpect::started 0
     set vexpect::debug 0
     set vexpect::bufferred ""
     set vexpect::scrindex 0
     set vexpect::timeout 30000
     set vexpect::ret ""
 
     set port 23
     if {[llength $host] == 2} {
         set port [lindex $host 1]
     }
     set vexpect::f [socket [lindex $host 0] $port]
     fconfigure $vexpect::f -blocking false -buffering line -translation binary
     fileevent $vexpect::f readable { vexpect::cr }
     set vexpect::afid [after $vexpect::timeout vexpect::timedout]
     set vexpect::exit 0
     vwait vexpect::exit
     catch {close $vexpect::f}
     return $::vexpect::ret
 }
 
 proc bgerror {message} {
     global errorInfo errorCode
 
     puts stderr "$message\n$errorInfo\n$errorCode"
 
 }

[ CL's also working in this area, and plans to document more in November 2003. Relate to specific Expect pages.]

[Stanley] Yes, it works well.