Posted to tcl by mjanssen at Tue Oct 23 20:32:30 GMT 2007view raw
- 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