Posted to tcl by aspect at Sun Mar 18 02:08:57 GMT 2012view pretty
# a lightweight expect-alike oo::class create explite { variable chan variable opts constructor {_chan args} { variable chan variable opts set defaults { -timeout 0 -timeoutcmd {} -eofcmd {} -linecmd {} -preamble {} } set chan $_chan array set opts [dict merge $defaults $args] chan configure $chan -blocking 0 -buffering none coroutine [namespace current]::coro my handle chan event $chan readable [namespace current]::coro } destructor { #puts "NOOOOO!" } method handle {} { variable chan variable opts #puts "Started coro: [info coroutine]" yield [info coroutine] #puts "Connected!" foreach {expect send} $opts(-preamble) { my wait_for $expect puts $chan $send } #puts "Logged in!" while {1} { my linehandler [my wait_for "\n"] } } method linehandler {lines} { foreach line [split $lines \r\n] { if {$line == {}} continue if {$opts(-linecmd) != {}} { uplevel #0 [list {*}$opts(-linecmd) $line] } else { puts "Got a line: $line" } } } method wait_for {pat} { variable chan variable opts if {$opts(-timeout) != {}} { after cancel [info coroutine] timeout # passing timeout back in as an arg is a bit ugly, tbh after $opts(-timeout) [info coroutine] timeout } set buf {} while {![string match *$pat* $buf]} { while {[set data [read $chan]] == ""} { if {[eof $chan]} { my destroy if {$opts(-eofcmd) != {}} { uplevel #0 {*}$opts(-eofcmd) eof } puts "EOF reading $chan" return -code error "EOF reading $chan" } if {[set res [yield]] != ""} { my destroy if {$opts(-timeoutcmd) != {}} { uplevel #0 {*}$opts(-timeoutcmd) $res } } } append buf $data } return $buf } } proc test {} { source telnet.tcl ;# dumb telnet options negotiation global chan set chan {} proc connect {host port} { global chan set chan [::telnet::open $host $port] explite create ex $chan \ -timeout 10000 \ -timeoutcmd re_connect \ -eofcmd re_connect \ -linecmd get_line \ -preamble { "ogin:" "root" "assword:" "feb.07" "#" {cd /var/log; dd=x; touch messages.0; while true; do d=`ls -l messages.0`; if [ "$d" == "$dd" ]; then sleep 5; echo '^_^'; else dd="$d"; kill $pid; tail -n 9999 -f /var/log/messages & pid=$!; fi; done} } } proc re_connect {args} { global chan puts "Destroy handler called with $args" close $chan connect } proc get_line {line} { set line [string trim $line \r\n] if {$line != "^_^"} { puts $line } } connect 192.168.1.1 23 } if {$tcl_interactive} test