Posted to tcl by mjanssen at Tue Oct 23 20:32:30 GMT 2007view pretty

proc transfer {src dest} {
   set data [read $src]
   if {[eof $src] || [eof $dest]} {
       close $src
       close $dest
   }
   catch {
     puts -nonewline $dest $data
     flush $dest
   }
}

proc conn {socket args} {
   variable conns
   set s [socket georgeps.dsl.xmission.com 8888]
   puts "connection $socket $args -> $s"
   fconfigure $s -blocking 0 -translation binary
   fconfigure $socket -blocking 0 -translation binary
   fileevent $s readable [list transfer $s $socket]
   fileevent $socket readable [list transfer $socket $s]
}
socket -server conn 80
vwait forever