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