Posted to tcl by aspect at Sun Mar 18 02:08:57 GMT 2012view raw
- # 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