'''[http://tools.ietf.org/html/rfc854%|%Telnet]''' is a fairly general protocol for 8-bit byte oriented communications. ** See Also ** [Poor Man's Expect]: [VI] 2003-09-23: a Tcl-only telnet (subset) client implementation [tcltelnet], by [TJM%|%Todd J Martin]: a pure Tcl telnet client [tcl telnet], by [DKF]: a telnet-like remote execution protocol [tcl3270]: an application which can talk to IBM mainframes via IBM's 3250 terminal protocol, and includes commands fro screen ** Reference ** [RFC] [http://tools.ietf.org/html/rfc854%|%854], Telnet Protocol: [RFC] [http://tools.ietf.org/html/rfc855%|%855], Telnet Option Specifications: [http://www.telnet.org/%|%telnet.org]: applications, places to telnet, etc [http://www.protocols.com/pbook/tcpip9.htm#TELNET%|%TELNET], [http://www.protocols.com%|%protocols.com]: ** Non-Tcl Tools ** [http://www.chiark.greenend.org.uk/~sgtatham/putty/%|%PuTTY]: A free implementation of the telnet and [ssh] protocols for [Unix] and [Microsoft Windows%|%Windows]. ** Example: plink ** ====== set f [open |[list plink -telnet 172.27.154.212] w+] fconfigure $f -blocking 0 -buffering none read $f puts $f help\n read $f ====== Tested on windows only. ** Telnet, by Tim Crone ** [TDC] The code below is exhibiting problems in its outside-the-library implementation, and I don't have time to fix them at the moment. [TDC]: Below is a collection of functions that sit in a library I created. I've successfully used it on Linux and Windows, and since it's native TCL it should work anywhere else. dTelnetInit instantiates a standards-based telnet session with a normal telnet server. Tested on TCL>=8.3. I don't use the hunt mode much, so it probably has some latent bugs. The standard connection (mask 32) works for me against telnet servers I've tried: Linux (RH 9), a terminal server, and a couple other hosts. YMMV. Since I've only included a couple of options, it's pretty simple to confuse it... Feel free to add telnet options, it should be fairly obvious. To Do: get it to work only in event mode. Most of the overhead is done, but I've never had cause to do it since it works fine in file buffer mode. There's a lot of overhead that's probably not useful outside my library... but I know if I change it I'll break it. I've munged a few things to eliminate the more specific features, but it should work 'off the page.' This particular code is in the public domain... obviously. ====== ############################################################################### # # Procedure : dTelnetInit # # Purpose : Instantiates a telnet session # # Arguments : ip : [In] IP address to be telnetted # mask : [In] Subnet Mask, addresses to be attempted sequentially # Default Value - 32 # port : [In] Port Number to establish # Default Value - 23 # timeout : [In] Timeout # Default Value - 250 # # Author : tcrone # # Returns : Handles the Telnet session # ############################################################################### proc dTelnetInit {ip {port 23} {mask 32} {timeout 250}} { # From RFC 854: set GA 249 set WILL 251 set WONT 252 set DO 253 set DONT 254 set IAC 255 set OPTIONS [list 3 1] ;# SuppressGoAhead (RFC 858), Echo (RFC 857) set telnetSocket [dSocketInit $ip $port $mask $timeout] if {$telnetSocket=="Err"} { return Err } set initOutput [dEventRead $telnetSocket 1000 0 1] ;# No errcheck, binary set textOutput "" set servOutput "" for {set i 0} {$i<[string length $initOutput]} {incr i} { if {[scan [string index $initOutput $i] %c]==$IAC} { incr i if {[lsearch [list $WILL $WONT] [scan [string index $initOutput $i] %c]]!=-1} { ;# The option handling routines have another byte incr i set OptionValue [scan [string index $initOutput $i] %c] if {[lsearch $OPTIONS $OptionValue]==-1} { ;# Option not found, DONT append servOutput [binary format ccc $IAC $DONT $OptionValue] puts "Rejecting Telnet Option $OptionValue" } else { ;# Option was found, DO append servOutput [binary format ccc $IAC $DO $OptionValue] puts "Accepting Telnet Option $OptionValue" } } elseif {[lsearch [list $DO $DONT] [scan [string index $initOutput $i] %c]]!=-1} { incr i set OptionValue [scan [string index $initOutput $i] %c] if {[lsearch $OPTIONS $OptionValue]==-1} { ;# Option not found, WONT append servOutput [binary format ccc $IAC $WONT $OptionValue] puts "Requesting Reject of Telnet Option $OptionValue" } else { ;# Option was found, WILL append servOutput [binary format ccc $IAC $WILL $OptionValue] puts "Requesting Telnet Option $OptionValue" } } else { puts "Ignoring unknown telnet server command" ;# Just a miscellaneous telnet server command } } else { ;# A non-command, add to output buffer append textOutput [string index $initOutput $i] } } ;# Loop over string dBufferWrite $telnetSocket $servOutput 1 return $telnetSocket ;# In so doing we lose the initial output from the telnet session, if it's not properly negotiated. } proc dEventRead {buffer {timeout 250} {errcheck 0} {binary 0}} { global connectState set afterId [after $timeout {set connectState Err}] fileevent $buffer readable "dHandleRead $afterId $buffer $errcheck $binary" # # Wait until the previously scheduled delayed command or # the file event handler sets the variable connectState # vwait connectState return $connectState } proc dHandleRead {afterId buffer {errcheck 0} {binary 0}} { after cancel $afterId fileevent $buffer readable "" global connectState set connectState [dBufferRead $buffer $errcheck $binary] } ############################################################################### # # Procedure : dSocketInit # # Purpose : Establishes a socket connection to the IP address # # Arguments : ip : [In] IP address of the host # mask : [In] Subnet Mask # Default Value - 32 # port : [In] Port Number to establish # timeout : [In] Timeout # Default Value - 250 # # Author : tcrone # # Returns : Err / Handler of the socket connection # ############################################################################### proc dSocketInit {ip port {mask 32} {timeout 250}} { ##### # Initializes the socket session to the passed ip and port, or browses the # network _up_ based on the mask. If 1.1.1.1/0 is passed, for example, # 1.1.1.1 will be the first attempt. If 1.1.1.2/0, 1.1.1.2 will be the # first attempt, and 1.1.1.3 the next. The function will stop at the # first successful telnet session regardless. The calling function should # verify that the correct machine has been found. # Additionally, if the ip is 5 or 7 octets long, the final octet is stripped # and used in place of the port, regardless of what that happens to be or # where it was set. This could potentially yield unexpected results, but # the long and short of it is that "port" is treated as a general passed # default for the application and that the extended IP form is the actual # destination port, where available. # Pass the ip address, port, an optional mask integer, and a timeout setting in milliseconds. ##### set ipvalue 0. set lastindex 0 set splitIP [split $ip .] if {[llength $splitIP]==5 || [llength $splitIP]==7} { ;# with 5 or 7 octets, the last octet is interpreted as the port number. set nport [string range $ip [expr [string last . $ip] + 1] [string length $ip]] if {$nport!=""} { set port $nport } set ip [string range $ip 0 [expr [string last . $ip] - 1]] } for {set x 0} {$x<[string length $ip]} {incr x} { if [expr [string equal "[string index $ip $x]" "."] || \ [expr $x==[expr [string length $ip]-1]]] { set ipvalue [expr $ipvalue*256] set ipvalue [expr $ipvalue+ \ [string range $ip $lastindex \ [expr $x-[string equal "[string index $ip $x]" "."]]]] set lastindex [expr $x+1] } } set ipmax [expr $ipvalue / [expr pow(2,[expr 31-$mask])] * [expr pow(2,[expr 31-$mask])]] ;# Remove the masked part for {set x $mask} {$x<32} {set x [expr $x + 1]} { set ipmax [expr $ipmax + [expr pow(2,[expr 31-$x])]] ;# Add the maximum mask back in } for {set x $ipvalue} {$x<=$ipmax} {set x [expr $x + 1]} { set curip "[expr int([expr $x / 256 / 256 / 256])].[expr int([expr $x / 256 / 256]) % 256].[expr int([expr $x / 256]) % 256].[expr int(fmod($x,256))]" set dTelnetLocal [dClientSocket $curip $port $timeout] if {$dTelnetLocal=={Err}} { puts "Cannot open $curip for telnet to port $port. Moving on." } else { puts "Connected to $curip on port $port." if [catch {fconfigure $dTelnetLocal -blocking false -buffering none}] { puts "Cannot configure $curip." dBufferClose $dTelnetLocal return Err } return $dTelnetLocal } } return Err } ##### # dClientSocket and dGetErrorStatus: based on code by Csaba Nemethi ##### set connectState false proc dClientSocket {host port timeout} { global connectState set connectState "" # # Create a client socket and connect # it to the server asynchronously # set channel [socket -async $host $port] # # Schedule a command for execution timeout milliseconds later # set afterId [after $timeout {set connectState "timeout"}] # # Create a file event handler to be called when the # connection attempt is either completed or fails # fileevent $channel writable "dGetErrorStatus $channel $afterId" # # Wait until the previously scheduled delayed command or # the file event handler sets the variable connectState # vwait connectState if {[string compare $connectState ""] == 0} { return $channel } else { close $channel return Err } } proc dGetErrorStatus {channel afterId} { # # Assign the current error status of the socket (an # error message or an empty string) to connectState # global connectState set connectState [fconfigure $channel -error] # # Cancel the execution of the peviously scheduled # delayed command and delete the file event handler # after cancel $afterId fileevent $channel writable "" } ############################################################################### # # Procedure : dBufferRead # # Purpose : Reads the new in-buffer of BufferIn # # Arguments : BufferIn : [In] Handler of the file / connection # errcheck : [In] error checking condition value # binary : [In] Forces the channel to binary mode for the read # # Author : tcrone # # Returns : Value read from handler # ############################################################################### proc dBufferRead {BufferIn {errcheck 0} {binary 0}} { ##### # Reads the new in-buffer of BufferIn. # Returns Err on a read error, or the input buffer. ##### set bufferSize 1024 set DataIn "" if {$binary!=0} { set oldEnc [fconfigure $BufferIn -translation] fconfigure $BufferIn -translation binary do { if [catch {read $BufferIn $bufferSize} dataTemp] { puts "Cannot read input buffer $BufferIn" return Err } else { set DataIn $DataIn$dataTemp ;# append problems on 8.3? } } until {[string length $dataTemp]==0} fconfigure $BufferIn -translation $oldEnc } else { if [catch {read $BufferIn} dataTemp] { puts "Cannot read input buffer $BufferIn" return Err } else { regexp -all -- {[\001-\177]+} $dataTemp DataIn } } return $DataIn } ############################################################################### # # Procedure : dBufferWrite # # Purpose : Writes the DataOut buffer to BufferOut # # Arguments : BufferOut : [In] Handler of the connection / file # DataOut : [In] Data to be written to output # binary : [In] Forces the channel to binary mode for the write # # Author : tcrone # # Returns : Err / Success # ############################################################################### proc dBufferWrite {BufferOut DataOut {binary 0}} { ##### # Writes the DataOut buffer to BufferOut. # Returns Err on a write error, or Success. ##### if {$binary!=0} { set oldEnc [fconfigure $BufferOut -encoding] fconfigure $BufferOut -encoding binary } if [catch {puts -nonewline $BufferOut $DataOut}] { puts "Cannot write to output buffer." return Err } # if [catch {flush $BufferOut}] { # puts "Cannot flush output buffer." # return Err # } if {$binary!=0} { fconfigure $BufferOut -encoding $oldEnc } return Success } ############################################################################### # # Procedure : dBufferOpen # # Purpose : Opens the Name for Mode access # # Arguments : Name : [In] Name of the file or the serial port # Mode : [In] Mode of connection # searchPath : [In] path of the file or serial port # Default Value - 0 # # Author : tcrone # # Returns : Err / Success # ############################################################################### proc dBufferOpen {Name Mode {searchPath 0}} { ##### # Opens the Name for Mode access ##### global auto_path if {$searchPath==0} { if {[catch {open $Name $Mode} Buffer]} { puts "Cannot open $Name for $Mode access." return Err } return $Buffer } elseif {$searchPath==1} { ;# search known paths if {![catch {open $Name $Mode} Buffer]} { return $Buffer } for {set x 0} {$x<[llength $auto_path]} {incr x} { set tempName [format "%s/%s" [lindex $auto_path $x] $Name] if {![catch {open $tempName $Mode} Buffer]} { return $Buffer } } ;# searched base tcl_pkgPath for {set x 0} {$x<[llength $auto_path]} {incr x} { if {![catch {glob -directory [lindex $auto_path $x] *} pathFiles]} { for {set y 0} {$y<[llength $pathFiles]} {incr y} { if {[file isdirectory [lindex $pathFiles $y]]} { set tempName [format "%s/%s" [lindex $pathFiles $y] $Name] if {![catch {open $tempName $Mode} Buffer]} { return $Buffer } } } } } ;# searched tcl_pkgPath subdirectories (one level) } else { ;# search passed paths if {![catch {open $Name $Mode} Buffer]} { return $Buffer } for {set x 0} {$x<[llength $searchPath]} {incr x} { set tempName [format "%s/%s" [lindex $searchPath $x] $Name] if {![catch {open $tempName $Mode} Buffer]} { return $Buffer } } } puts "Cannot open $Name for $Mode access." return Err } ############################################################################### # # Procedure : dBufferClose # # Purpose : Closed the buffer # # Arguments : Buffer : [In] Handler of the connection / file # # Author : tcrone # # Returns : Err / Success # ############################################################################### proc dBufferClose {Buffer} { ##### # Closes the Buffer ##### if [catch {close $Buffer}] { puts "Could not close the buffer $Buffer." return Err } return Success } # Done by Reinhard Max # at the Texas Tcl Shoot-Out 2000 # in Austin, Texas. proc do {script arg2 {arg3 {}}} { # # Implements a "do