# the source of the example code: https://www.tcl.tk/man/tcl8.5/tutorial/Tcl42.html
# paste it in a fixed width character terminal for better reading
proc serverOpen {channel addr port} {
puts "serverOpen: channel: $channel - from Address: $addr Port: $port"
puts "The default state for blocking is: [fconfigure $channel -blocking]"
puts "The default buffer size is: [fconfigure $channel -buffersize ]"
# Set this channel to be non-blocking.
fconfigure $channel -blocking 0
set bl [fconfigure $channel -blocking]
puts "After fconfigure the state for blocking is: $bl"
# Change the buffer size to be smaller
fconfigure $channel -buffersize 12
puts "After fconfigure buffer size is: [fconfigure $channel -buffersize ]\n"
# When input is available, read it.
# the script is executed at the (global level)
# in the interpreter in which the fileevent command was invoked
# the file event handler is deleted if it ever returns an error (man fileevent)
# the event is triggered and the script is run only when the first data comes in
# 'Server' is just a name, such that readLine can be used in other contexts, too
fileevent $channel readable "readLine Server $channel"
}
proc readLine {who channel} {
global didRead
global blocked
puts "readLine: There is input for $who on $channel"
# on the first iteration of the while loop below there is no 'eol',
# the channel is in non-blocking mode, so the read fails and nothing is read, see 'man 3tcl gets'
# on the second iteration of the 'while' loop below, this does succeed
set len [gets $channel line]
# the channel is non-blocking, but it may be "blocked", see 'man fblocked'
# 1 if blocked, 0 if not blocked
set blocked [fblocked $channel]
puts "Characters Read: $len Fblocked: $blocked"
# -1 is not enough data, see 'man 3tcl gets'
if {$len < 0} {
if {$blocked} {
# not enough to read
puts "Input is blocked"
} else {
# the 'eof' case
puts "The socket was closed - closing my end"
# this closes the new channel created by 'socket -server' for the new connection
# the server itself is closed in the last line of the script
close $channel;
}
} else {
puts "Read $len characters: $line"
puts $channel "This is a return"
flush $channel;
}
incr didRead;
# puts "readLine: didRead = $didRead"
}
set server [socket -server serverOpen 33000]
# after 120 update; # This kicks MS-Windows machines for this application
# no call for serverOpen here
# puts {before the first vwait}
# vwait didRead
# puts {after the first vwait}
# puts {before socket client}
# this sends a connection request to the server listening on port 33000
# the server creates a (new channel) on a new port especially for this connection
# and then it makes the client connect to this new channel
# also now the server triggers an event that will run serverOpen when processed
set sock [socket 127.0.0.1 33000]
# puts {after socket client}
# if the first vwait is commented, then serverOpen is called here
# puts {before the second vwait}
# vwait didRead
# puts {after the second vwait}
set bl [fconfigure $sock -blocking]
set bu [fconfigure $sock -buffersize]
puts "Original setting for sock: Sock blocking: $bl buffersize: $bu"
fconfigure $sock -blocking No
fconfigure $sock -buffersize 8;
set bl [fconfigure $sock -blocking]
set bu [fconfigure $sock -buffersize]
puts "Modified setting for sock: Sock blocking: $bl buffersize: $bu\n"
# Send a line to the server -- NOTE flush
set didRead 0
# this makes fileevent to trigger an event that calls lineRead when processed
puts -nonewline $sock "A Test Line"
flush $sock;
# if the first two vwait's are commented, then both serverOpen and readLine are called here
# puts {before the third vwait}
# vwait didRead
# puts {after the third vwait}
# this sends "NewLine\n" immediately after "Read 18 characters: A Test Line"
# readLine is run only on 'wait didRead', which reads the fileevent event
# so this iterates two times
while {$didRead < 2} {
puts "while: didRead = $didRead"
# Wait for didRead to be set
vwait didRead
if {$blocked} {
puts $sock "Newline"
flush $sock
puts "SEND NEWLINE"
}
}
# this reads the readLine "This is a return" message
set len [gets $sock line]
puts "Return line: $len -- $line"
# this closes the client socket
close $sock
# puts {before last vwait}
# this processes the last fileevent event that calls readLine for the last time
# now readLine closes the new channel because it sees that it is closed on the client side
vwait didRead
# this closes the server, which is still listening on the 30000 port
catch {close $server}
# so 'socket' creates and manages the connection
# similarly to a pipe or a fifo (see ~/linux/misc/bash/fifo.txt)
# 'man 3tcl gets' (three cases)
# the three non-blocking cases are:
# successfully read
# not enough data, returns -1 and it's blocked
# 'eof', returns -1 and it's not blocked
