64位系统下的纯Tcl Telnet程序telnet.tcl

###############################################################################
#
# 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"