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