How can I modify this TCL client/server program to make the server continuously write data to a port?

Question

I read up on fileevent and fconfigure examples and was able to get an echo server working. I need some pointers on how I can modify this so that I can make the server write to channel every 10 seconds whenever a client connects to it.

Eventually, I want the client to process the continuous data stream.

Server:

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

This Server will accept connections and echo anything the client writes to the channel.

Client:

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

Answer 1

Understanding what protocol you want to implement is the key to getting socket servers right. In your case, if you're writing a message every 10 seconds and not listening for things from the client, your code becomes:

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
    }
}

Of course, if you're using Tcl 8.6 then you can write that a little clearer:

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

Client.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