Telnet is a fairly general protocol for 8-bit byte oriented communications.
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.
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 <script> until <expression>" loop
# The "until" keyword is optional
#
# It is as fast as builtin "while" command for loops with
# more than just a few iterations.
#
if {[string compare $arg3 {}]} {
if {[string compare $arg2 until]} {
return -code 1 "Error: do script ?until? expression"
}
} else {
# copy the expression to arg3, if only
# two arguments are supplied
set arg3 $arg2
}
set ret [catch { uplevel $script } result]
switch $ret {
0 -
4 {}
3 {return}
default {
return -code $ret $result
}
}
set ret [catch {uplevel [list while "!($arg3)" $script]} result]
return -code $ret $result
}