Posted to tcl by kostix at Sat Nov 28 14:40:27 GMT 2009view pretty
proc usage {{error ""}} {
if {$error != ""} {
puts stderr $error
}
puts stderr "Usage: [file tail [info name]] REMOTE_HOST:REMOTE_PORT\
\[LOCAL_HOST:\]LOCAL_PORT"
}
if {[llength $argv] != 2} {
usage "Wrong number of arguments"
exit 1
}
foreach {rhost rport} [split [lindex $argv 0] :] break
foreach {lhost lport} [split [lindex $argv 1] :] break
if {$rhost == "" || $rport == ""} {
usage "Destination host or port missing"
exit 1
}
if {$lhost == ""} {
if {$lport == ""} {
usage "Missing local port"
exit 1
} else {
set lhost localhost
}
} else {
if {$lport == ""} {
if {[llength [split [lindex $argv 1] :]] == 1} {
# "non-empty string w/o :" case:
set lport $lhost
set lhost localhost
} else {
usage "Missing local port"
exit 1
}
}
}
puts dest=<$rhost>:<$rport>,src=<$lhost>:<$lport>
proc accept {rhost rport local chost cport} {
if {[catch {socket $rhost $rport} remote]} {
close $local
} else {
foreach sock {local remote} {
fconfigure [set $sock] -blocking no -buffering none -translation binary
fileevent $local readable [list pass $local $remote]
fileevent $remote readable [list pass $remote $local]
}
}
}
proc pass {from to} {
if {[eof $from]} {
close $from
close $to
} else {
puts -nonewline $to [read $from]
}
}
socket -server [list accept $rhost $rport] -myaddr $lhost $lport
vwait forever