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

  1. proc transfer {src dest} {
  2. set data [read $src]
  3. if {[eof $src] || [eof $dest]} {
  4. close $src
  5. close $dest
  6. }
  7. catch {
  8. puts -nonewline $dest $data
  9. flush $dest
  10. }
  11. }
  12.  
  13. proc conn {socket args} {
  14. variable conns
  15. set s [socket georgeps.dsl.xmission.com 8888]
  16. puts "connection $socket $args -> $s"
  17. fconfigure $s -blocking 0 -translation binary
  18. fconfigure $socket -blocking 0 -translation binary
  19. fileevent $s readable [list transfer $s $socket]
  20. fileevent $socket readable [list transfer $socket $s]
  21. }
  22. socket -server conn 80
  23. vwait forever