Posted to tcl by aspect at Sun Mar 18 02:08:57 GMT 2012view raw

  1.  
  2. # a lightweight expect-alike
  3. oo::class create explite {
  4.  
  5. variable chan
  6. variable opts
  7.  
  8. constructor {_chan args} {
  9. variable chan
  10.  
  11. variable opts
  12. set defaults {
  13. -timeout 0
  14. -timeoutcmd {}
  15. -eofcmd {}
  16. -linecmd {}
  17. -preamble {}
  18. }
  19.  
  20. set chan $_chan
  21. array set opts [dict merge $defaults $args]
  22.  
  23. chan configure $chan -blocking 0 -buffering none
  24. coroutine [namespace current]::coro my handle
  25. chan event $chan readable [namespace current]::coro
  26. }
  27.  
  28. destructor {
  29. #puts "NOOOOO!"
  30. }
  31.  
  32. method handle {} {
  33. variable chan
  34. variable opts
  35. #puts "Started coro: [info coroutine]"
  36. yield [info coroutine]
  37. #puts "Connected!"
  38. foreach {expect send} $opts(-preamble) {
  39. my wait_for $expect
  40. puts $chan $send
  41. }
  42. #puts "Logged in!"
  43. while {1} {
  44. my linehandler [my wait_for "\n"]
  45. }
  46. }
  47.  
  48. method linehandler {lines} {
  49. foreach line [split $lines \r\n] {
  50. if {$line == {}} continue
  51. if {$opts(-linecmd) != {}} {
  52. uplevel #0 [list {*}$opts(-linecmd) $line]
  53. } else {
  54. puts "Got a line: $line"
  55. }
  56. }
  57. }
  58.  
  59. method wait_for {pat} {
  60. variable chan
  61. variable opts
  62. if {$opts(-timeout) != {}} {
  63. after cancel [info coroutine] timeout
  64. # passing timeout back in as an arg is a bit ugly, tbh
  65. after $opts(-timeout) [info coroutine] timeout
  66. }
  67. set buf {}
  68. while {![string match *$pat* $buf]} {
  69. while {[set data [read $chan]] == ""} {
  70. if {[eof $chan]} {
  71. my destroy
  72. if {$opts(-eofcmd) != {}} {
  73. uplevel #0 {*}$opts(-eofcmd) eof
  74. }
  75. puts "EOF reading $chan"
  76. return -code error "EOF reading $chan"
  77. }
  78. if {[set res [yield]] != ""} {
  79. my destroy
  80. if {$opts(-timeoutcmd) != {}} {
  81. uplevel #0 {*}$opts(-timeoutcmd) $res
  82. }
  83. }
  84. }
  85. append buf $data
  86. }
  87. return $buf
  88. }
  89. }
  90.  
  91.  
  92. proc test {} {
  93. source telnet.tcl ;# dumb telnet options negotiation
  94.  
  95. global chan
  96.  
  97. set chan {}
  98.  
  99. proc connect {host port} {
  100. global chan
  101. set chan [::telnet::open $host $port]
  102. explite create ex $chan \
  103. -timeout 10000 \
  104. -timeoutcmd re_connect \
  105. -eofcmd re_connect \
  106. -linecmd get_line \
  107. -preamble {
  108. "ogin:" "root"
  109. "assword:" "feb.07"
  110. "#" {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}
  111. }
  112. }
  113.  
  114. proc re_connect {args} {
  115. global chan
  116. puts "Destroy handler called with $args"
  117. close $chan
  118. connect
  119. }
  120.  
  121. proc get_line {line} {
  122. set line [string trim $line \r\n]
  123. if {$line != "^_^"} {
  124. puts $line
  125. }
  126. }
  127.  
  128. connect 192.168.1.1 23
  129. }
  130.  
  131. if {$tcl_interactive} test
  132.