Posted to tcl by stever at Wed Dec 03 19:04:52 GMT 2008view raw

  1. lappend auto_path .
  2. package require Thread
  3.  
  4. if {$argc > 0} {
  5. set port [lindex $argv 0]
  6. } else {
  7. set port 9001
  8. }
  9.  
  10. socket -server _ClientConnect $port
  11. proc _ClientConnect {sock host port} {
  12. # Tcl holds a reference to the client socket during
  13. # this callback, so we can't transfer the channel to our
  14. # worker thread immediately. Instead, we'll schedule an
  15. # after event to create the worker thread and transfer
  16. # the channel once we've re-entered the event loop.
  17. after idle [list ClientConnect $sock $host $port]
  18. }
  19. proc ClientConnect {sock host port} {
  20. # Create a separate thread to manage this client. The
  21. # thread initialization script defines all of the client
  22. # communication procedures and puts the thread in its
  23. # event loop.
  24. set thread [thread::create {
  25. proc ReadLine {sock} {
  26. if {[catch {gets $sock line} len] || [eof $sock]} {
  27. catch {close $sock}
  28. thread::release
  29. } elseif {$len >= 0} {
  30. EchoLine $sock $line
  31. }
  32. }
  33. proc EchoLine {sock line} {
  34. if {[string equal -nocase $line quit]} {
  35. SendMessage $sock \
  36. "Closing connection to Echo server"
  37. catch {close $sock}
  38. thread::release
  39. } else {
  40. SendMessage $sock $line
  41. eval $line
  42. }
  43. }
  44. proc SendMessage {sock msg} {
  45. if {[catch {puts $sock $msg} error]} {
  46. puts stderr "Error writing to socket: $error"
  47. catch {close $sock}
  48. thread::release
  49. }
  50. }
  51. # Enter the event loop
  52. thread::wait
  53. }]
  54.  
  55. # Release the channel from the main thread. We use
  56. # thread::detach/thread::attach in this case to prevent
  57. # blocking thread::transfer and synchronous thread::send
  58. # commands from blocking our listening socket thread.
  59.  
  60. thread::detach $sock
  61.  
  62. # Copy the value of the socket ID into the
  63. # client's thread
  64. thread::send -async $thread [list set sock $sock]
  65. # Attach the communication socket to the client-servicing
  66. # thread, and finish the socket setup.
  67. thread::send -async $thread {
  68. thread::attach $sock
  69. fconfigure $sock -buffering line -blocking 0
  70. fileevent $sock readable [list ReadLine $sock]
  71. SendMessage $sock "Connected to Echo server"
  72. }
  73. }
  74.  
  75. vwait forever
  76.  
  77.