[MG] September 17th 2005 - Here's a basic script to provide Port Forwarding. It's very simple, and could probably be spruced up a bit, but it works. (It was written for connecting to MUSH/MUD games, when you can't get through a firewall to connect to the port they run on, as most only allow connections to one port out of the box.)

[MG] Oct 7 2005 - Closed a socket which had been left open by mistake (the one in the Start proc, for determining the home IP address).

See [Burrow] for a nice stand alone kittable version of this
----
[hae] Nov 23 2009 - The [Tcllib] has the [multiplexer] package which can be used for this purpose, too.
----
======
 set remote(host) "mush.pennmush.org" ;# host to connect to
 set remote(port) "4201" ;# port to connect to
 set remote(eol) "lf" ;# should be "lf" if newline_one_char is Yes, or crlf if it's No.
                      ;# Or use "auto" if you prefer, but it may throw out an extra newline before every
                      ;# line of output
 
 set local(port) "1642" ;# where we listen for connections - use "0" to have the program assign a port
 
 proc Server {channel clientaddr clientport} {
   global conn remote
 
   set x [incr conn(num)]
   Log "Connection from $clientaddr registered (number $x)"
   set conn($x,out) $channel
   set conn($x,host) $clientaddr
   set conn($x,port) $clientport
   if { [catch {socket -async $remote(host) $remote(port)} conn($x,in)] } {
        close $channel
        catch {array unset conn $x,*}
        return;
      }
 
   fconfigure $conn($x,out) -translation {auto lf} -blocking 0 -buffering line
   fconfigure $conn($x,in) -translation {auto auto} -blocking 0 -buffering line
 
   fileevent $conn($x,out) readable [list channelData $x out in]
   fileevent $conn($x,in)  readable [list channelData $x in out]
 
 };# Server
 
 proc channelData {x 1st 2nd} {
   global conn
 
   if { [eof $conn($x,$1st)] || [catch {gets $conn($x,$1st)} data] } {
        catch {close $conn($x,in)}
        catch {close $conn($x,out)}
        if { $1st == "in" } {
             Log "Connection from $x's Client died."
           } else {
             Log "Connection from host on $x died."
           }
        return;
      }
   puts $conn($x,$2nd) $data
 
 };# channelData
 
 proc Start {} {
   global local conn
 
   array unset conn
   set conn(num) 0
   set conn(connected) 0
 
   if { [catch {socket -server Server $local(port)} conn(server)] } {
        Log "Unable to start Port-Forwarding: $conn(server)"
        unset -nocomplain conn(server)
      }
   set conn(conected) 1
 
   Log "Port-Forwarding Server Connected"
   set good 0
   foreach x [list www.google.com www.yahoo.com www.whois.sc www.pennmush.org www.talvo.com] {
            if { ![catch {socket $x 80} s] } {
                 Log "Listening for connections on: [lindex [fconfigure $s -sockname] 0]:$local(port)"
                 set good 1
                 close $s
                 break;
               }
           }
   if { !$good } {
        Log "Unable to determine home IP. Sorry!"
      }
 
 };# Start
 
 proc Log {txt} {
 
   .t insert end "$txt\n"
 
 };# Log
 
 proc main {} {
 
   pack [text .t -yscrollcommand ".s set" -wrap word] -side left -expand 1 -fill both -side left
   pack [scrollbar .s -command ".t yview"] -side left -fill y
   bind . <F1> {console show}
 
 };# main
 
 main
 Start
======
<<categories>> Internet