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