如何修改这个TCL客户端/服务器程序，使服务器连续向端口写入数据

Question

我阅读了fileevent和fconfigure的示例，并能够使echo服务器正常工作。我需要一些关于如何修改这一点的指针，这样每当客户端连接到服务器时，我就可以让服务器每10秒写入一次通道

最终，我希望客户端能够处理连续的数据流。

服务器：

proc accept {chan addr port} {
global echo
puts "connection accepted from $addr:$port"
set echo(addr,$chan) [list $addr $port]
fconfigure $chan -buffering line
fileevent $chan readable [list Echo $chan]
}
proc Echo {sock} {
global echo
if {[eof $sock] || [catch {gets $sock line}]} {
close $sock
puts "Close $echo(addr,$sock)"
unset echo(addr,$sock)
} else {
puts $sock $line
puts $line
}
}
set s [socket -server accept 12345]
vwait forever

此服务器将接受连接并回显客户端写入通道的任何内容。

客户：

set conn [socket localhost 12345]
fconfigure $conn -buffering line
puts $conn "Hello world"

Answer 1

了解要实现的协议是正确使用套接字服务器的关键。在你的情况下，如果你每10秒写一条消息，而没有听客户的消息，你的代码就会变成：

proc accept {chan addr port} {
global echo
puts "connection accepted from $addr:$port"
fconfigure $chan -buffering line
WriteMessagePeriodically $chan 10000
}
proc WriteMessagePeriodically {chan delay} {
# Reschedule first to keep timer drift down; we'll cancel if the write fails
set id [after $delay [list WriteMessagePeriodically $chan $delay]]
if {[catch {
puts $chan "This is a message"
# That will error out if the socket is closed
}]} {
after cancel $id
close $chan
}
}

当然，如果你使用的是Tcl 8.6，那么你可以写得更清楚一点：

proc WriteMessagePeriodically {chan delay} {
# Reschedule first to keep timer drift down; we'll cancel if the write fails
set id [after $delay [list WriteMessagePeriodically $chan $delay]]
try {
puts $chan "This is a message"
# That will error out if the socket is closed
} on error {} {
after cancel $id
close $chan
}
}

Answer 2

Server.tcl

proc accept {chan addr port} {
global echo
puts "connection accepted from $addr:$port"
set echo(addr,$chan) "$chan - [list $addr $port]"
fconfigure $chan -buffering line
fileevent $chan readable [list Echo $chan]
}
proc Echo {sock} {
global echo
if {[eof $sock] || [catch {gets $sock line}]} {
catch {close $sock}
puts "Close $echo(addr,$sock)"
unset echo(addr,$sock)
} else {
set line [string trim $line]
if {$line eq {}} {
catch {close $sock}
puts "Close $echo(addr,$sock)"
unset echo(addr,$sock)
return
}
puts "Received '$line' from Client $echo(addr,$sock)"
puts "Waiting for 10 seconds"
after 10000
set serverResp [expr {$line+1}]
puts "Sending '$serverResp' to Client"
puts $sock $serverResp
}
}
set s [socket -server accept 12345]
puts "Server started on port 12345"
vwait forever

客户端.tcl

set conn [socket localhost 12345]
fconfigure $conn -buffering line
fileevent $conn readable [list Echo $conn]
# Client starts the communication
puts "Sending '0' to Server"
puts $conn "0"
proc Echo {sock} {
if {[eof $sock] || [catch {gets $sock line}]} {
catch {close $sock}
puts "Unable to read data from server. So, client is exiting..."
exit 1
} else {
set line [string trim $line]
if {$line eq {}} {
puts "Unable to read data from server. So, client is exiting..."
exit 1
}
puts "Received '$line' from Server"
set clientResp [expr {$line+1}]
puts "Sending '$clientResp' to Server"
puts $sock $clientResp
}
}
vwait forever