1#!/usr/bin/tclsh 2 3proc SpawnEchoServer {fd host port} { 4 fconfigure $fd -encoding binary -translation binary -blocking no -buffering none 5 fileevent $fd readable "EchoBack $fd" 6 # --- puts stderr "Connected: [fconfigure $fd -peername]" 7} 8 9proc EchoBack {fd} { 10 11 # --- puts stderr "READ-READY" 12 13 while 1 { 14 15 # --- puts stderr "READING 4096" 16 set r [read $fd 4096] 17 if {$r == ""} { 18 if {[eof $fd]} { 19 # --- puts stderr "EOF. Closing" 20 close $fd 21 return 22 } 23 24 # --- puts stderr "SPURIOUS, giving up read" 25 return 26 } 27 28 # Set blocking for a short moment of sending 29 # in order to prevent losing data that must wait 30 31 # --- puts stderr "SENDING [string bytelength $r] bytes" 32 fconfigure $fd -blocking yes 33 puts -nonewline $fd $r 34 fconfigure $fd -blocking no 35 36 if {[fblocked $fd]} { 37 # --- puts stderr "NO MORE DATA" 38 # Nothing more to read 39 return 40 } 41 42 # --- puts stderr "AGAIN" 43 44 } 45 46} 47 48socket -server SpawnEchoServer $argv 49puts stderr "SERVER READY" 50 51vwait tk 52