'''`[chan] pending`''', a `[chan]` action, retrieves the amount of data pending in a [channel]'s buffer. ** Synopsis ** : '''chan pending''' ''mode channelId'' ** Documentation ** [TIP] [http://www.tcl.tk/cgi-bin/tct/tip/287%|%287]: resulted in `chan pending` ** Description ** Given ''mode'' which is either '''`input`''' or '''`output`''', returns the number of '''bytes''' in the corresponding Tcl buffer for the channel named ''channelId''. `chan pending` makes it safe to use `[chan gets]` with [socket%|%sockets], which can now be inspected to detect an excessively long line, providing an opportunity to prevent memory exhaustion. ** How to Use ** Use `chan pending` is with non-blocking channels, particularly [socket%|%sockets], used to deal with the case where the source is producing far more data than was expected before producing some particular delimiter, e.g., a newline character for `[gets]`. ====== proc accept {cb channel args} { global timeouts chan configure $channel -blocking 0 -buffersize 4096 chan event $channel readable [list doGets $channel $cb] set ::timeouts($channel) "" } proc doGets {channel callback} { global timeouts if {[chan gets $channel line] >= 0} { after cancel $timeouts($channel) set timeouts($channel) "" {*}$callback $channel $line } elseif {[chan eof $channel]} { chan close $channel after cancel $timeouts($channel) unset timeouts($channel) } else { # Must be blocked; check for excessive buffering if {[chan pending input $channel] > 1024} { # must be a line longer than a kilobyte; naughty! reject chan close $channel after cancel $timeouts($channel) unset timeouts($channel) } elseif {$timeouts($channel) eq ""} { # no line timeout watcher; install one that waits 10 seconds # from when the start of the line arrives to when the end of the # line arrives before killing the channel set timeouts($channel) [after 10000 killChannel $channel] } } } proc killChannel channel { global timeouts unset timeout($channel) chan close $channel } # Make the (server) socket socket -server [list accept processLineCallback] 12345 # This is where you'd add your code to handle each line proc processLineCallback {channel line} { # ... whatever ... puts $channel-->$line } ====== [LH] 2016-06-07 The above sample code does not work as intended. In my tests, the socket server accepted excessively long lines, close to 1MB, easily breaking the 1KB limit used in the code. In fact, `chan pending` can't deal with the case where a client is producing far more data than was expected. To do so, it should be called before `[gets]` is called, and not after, as in the sample code. The reason for this is explained on the `[gets]` wiki page, in the "Show discussion" part. In short, the moment `[gets]` is called we loose control of how many characters will be returned. Unfortunately, calling `chan pending` before `[gets]` will not help much because it only reports bytes pending in the internal Tcl buffer, and ignores bytes pending in the OS buffer. For example, in my tests, it consistently reported 0 before the first `[gets]` on a fresh client socket (I removed this redundant line from my test code below, so add it back, if you wish). Even if `chan pending` was taking into account the bytes pending in the OS buffer, we wouldn't know if an end-of-line character (or sequence) is among the pending bytes or not, so we couldn't make a decision if calling `[gets]` is safe anyway. Even if it worked, the above sample code has a fundamental deficiency: it relies on `[gets]` failing (I mean, returning -1) before `chan pending` can recognize a line that is too long. But `[gets]` fails only if all buffering resources have been exhausted, and this may cost megabytes of wasted memory. Not a good idea for a server handling thousands of clients. The only clean and reliable solution to the "excessively long line" problem I'm aware of is to modify [gets] by adding an optional "-max size" argument, in the spirit of [read] command. With the current Tcl I/O commands, the only reliable, but dirty, solution I'm aware of is to add to a socket server app the third layer of buffering, on top of the Tcl and OS buffers, with the help of [read channel size] command on binary sockets. Here is the code of my tests, run on Windows 8.1 with Wish 8.6.4. I removed the timeout and callback parts from the sample code, since they are irrelevant for this experiment. If you run this code on your platform, your millage may vary because the sample code is highly non-deterministic (different OS buffering strategies and many race conditions): ====== # utils.tcl set port 12345 proc ShowConsole args { if {[catch { console show }]} return set appName [file tail [file root [info script]]] array set "" [list -title $appName -exit exit] array set "" $args console title $(-title) set exit [list consoleinterp eval $(-exit)] console eval [list wm protocol . WM_DELETE_WINDOW $exit] wm withdraw . update } proc UseLogFile args { array set "" [list -file [file root [info script]].log -mode a] array set "" $args set ::logFile [open $(-file) $(-mode)] set timestamp [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S}] puts $::logFile \n$timestamp } proc log msg { puts $msg catch { update idletasks } if {![info exists ::logFile]} return puts $::logFile $msg flush $::logFile } proc prefix {str {length 60}} { if {[string length $str] <= $length} { return $str } return [string range $str 0 $length-1]... } ====== ====== # server.tcl source utils.tcl UseLogFile ShowConsole -exit { foreach socket [array names ::CLIENT] { CloseClient $socket EXIT } close $::serverSocket exit } proc CloseClient {socket {reason ""}} { log "--- closing client $::NUM($socket) ($reason)" unset ::CLIENT($socket) unset ::NUM($socket) close $socket } ### open server socket if {[catch {socket -server accept $port} serverSocket]} { log "*** can't open server socket on port $port: $serverSocket" exit } ### serve clients proc accept {channel args} { chan configure $channel -blocking 0 -buffersize 4096 chan event $channel readable "serve $channel" set ::CLIENT($channel) "" set ::NUM($channel) [incr ::clientNum] log "\n+++ new client $::NUM($channel)" } proc serve channel { if {[chan gets $channel line] >= 0} { log "< ([string length $line]) [prefix $line]" return } if {[chan eof $channel]} { CloseClient $channel EOF return } set pending [chan pending input $channel] if {$pending > 1024} { CloseClient $channel "LineTooLong, pending $pending" } } ====== ====== # client.tcl source utils.tcl UseLogFile ShowConsole proc try {cmd args} { if {![catch { {*}$cmd {*}$args } result]} { return $result } log "$cmd: $result" } proc emit line { set socket [try socket localhost $::port] log "> ([string length $line]) [prefix $line]" try puts $socket $line try flush $socket try close $socket } proc line length { set chunk [string repeat 0123456789 100] append line [string repeat $chunk [expr {$length/1000}]] append line [string range $chunk 0 [expr {$length%1000}]-1] return $line } emit [line 1000] emit [line 5000] emit [line 10000] emit [line 50000] emit [line 100000] emit [line 500000] emit [line 1000000] emit [line 5000000] log done ====== Here is the client's log showing that 1,000,000 character long line was still accepted by the server, while the 5,000,000 character long line was rejected: ====== 2016-06-07 19:42:51 > (1000) 012345678901234567890123456789012345678901234567890123456789... > (5000) 012345678901234567890123456789012345678901234567890123456789... > (10000) 012345678901234567890123456789012345678901234567890123456789... > (50000) 012345678901234567890123456789012345678901234567890123456789... > (100000) 012345678901234567890123456789012345678901234567890123456789... > (500000) 012345678901234567890123456789012345678901234567890123456789... > (1000000) 012345678901234567890123456789012345678901234567890123456789... > (5000000) 012345678901234567890123456789012345678901234567890123456789... puts: error writing "sock0000000004183240": connection reset by peer done ====== Finally, here is the server's log: ====== 2016-06-07 19:42:46 +++ new client 1 < (1000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 1 (EOF) +++ new client 2 < (5000) 012345678901234567890123456789012345678901234567890123456789... +++ new client 3 < (10000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 2 (EOF) +++ new client 4 < (50000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 3 (EOF) +++ new client 5 < (100000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 4 (EOF) +++ new client 6 < (500000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 5 (EOF) --- closing client 6 (EOF) +++ new client 7 < (1000000) 012345678901234567890123456789012345678901234567890123456789... --- closing client 7 (EOF) +++ new client 8 --- closing client 8 (LineTooLong, pending 28672) ====== <> Command | Channel