Posted to tcl by jdc at Fri Oct 01 08:05:24 GMT 2010view raw

  1. % fconfigure stderr -buffering line
  2. % # Kill server when pipe closed by invoker.
  3. % proc bye args {
  4. if {![eof stdin]} { gets stdin ; return }
  5. puts stderr BYE
  6. exit
  7. }
  8. % # Server code. Bi-directional copy between 2 sockets.
  9. % proc geof {sok} {
  10. puts stderr DONE/$sok
  11. close $sok
  12. }
  13. % proc new {sok args} {
  14. puts stderr NEW/$sok
  15. global l srv
  16. fconfigure $sok -translation binary -buffering none
  17. lappend l $sok
  18. if {[llength $l]==2} {
  19. close $srv
  20. foreach {a b} $l break
  21. fcopy $a $b -command [list geof $a]
  22. fcopy $b $a -command [list geof $b]
  23. puts stderr 2COPY
  24. }
  25. puts stderr ...
  26. }
  27. % puts stderr SRV
  28. SRV
  29. % set l {}
  30. % set srv [socket -server new 9999]
  31. sock184
  32. % puts stderr WAITING
  33. WAITING
  34. % fileevent stdin readable bye
  35. % puts OK
  36. OK
  37. % vwait forever