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