Tcl Source Code

Artifact 103ff04134ffce8868883442da6e2edcef19e790:

Attachment "219400.server" to ticket [219400ffff] added by andreas_kupries 2001-09-08 02:03:26.

---

# -*- tcl -*-
# Server for Tcl bug 219400

variable firstread 1 

proc accept {sock addr port} { 
    fconfigure $sock -buffering none 
    fconfigure $sock -blocking 0 
    fileevent $sock r [list stuff $sock] 
}

proc stuff {sock} { 
    fileevent $sock r {} ;# this was in the original code but with them 
    ;# it's very hard to reproduce! 
    ;# sudo nice -n -20 for sender should do the 
    ;# job... ;) 
    
    if {[eof $sock]} { 
	puts "***EOF***" 
	exit 
    } 
    puts -nonewline stdout [read $sock] 

    variable firstread 
    variable delay 

    if {$firstread} { 
	set delay 0		 ;# That is a contorted way of saying
	after 2000 {set delay 1} ;# [after 2000]. It allows events in
	vwait delay              ;# the interim tough.
	## send response 
	puts $sock " " 
	set firstread 0 
    } 

    fileevent $sock r [list stuff $sock] 
} 

socket -server accept 40010 
vwait forever