Updated 2012-04-07 21:47:56 by RLE

dzach 2006-5-9 Here is my first take on fconnect - a bidirectional channel copying procedure, kind of a bidirectional fcopy.

fconnect uses non blocking sockets to do copying from channel to channel. I guess it could be modified to use blocking channels too, if so needed.
 # fconnect: bidirectionally connects two channels s1 s2
 proc fconnect {s1 s2} {
        fconfigure $s1 -blocking 0 -buffering none
        fconfigure $s2 -blocking 0 -buffering none
        fileevent $s1 readable [list copyData $s1 $s2]
        fileevent $s2 readable [list copyData $s2 $s1]
 }
 # passes data from one channel to the other
 proc copyData {from to} {
        if {[eof $from]} {
                close $from
                close $to
                return
        }
        puts -nonewline $to [read $from]
 }

That's it. The rest of the procs are used to stage a simple test:
 # server side handling or new sockets
 proc AcceptReq {sock ip port} {
        incr ::cnt
        set ::serv$::cnt $sock
        puts "created ::serv$::cnt=$sock"
 }
 # client side handling of socket A
 proc handleInputA sock {
        if {[eof $sock]} {
                close $sock
                return
        }
        if {[gets $sock line]<1} {
                return
        }
        puts "A: $line"
 }
 # client side handling of socket B
 proc handleInputB sock {
        if {[eof $sock]} {
                close $sock
                return
        }
        if {[gets $sock line]<1} {
                return
        }
        puts "B: $line"
 }

Here is a test: copy data coming to server from A to B's side. Due to socket creation timings, commands should be typed (pasted in) one at a time, or errors might occure
 set cnt 0

start a socket server for the test
 socket -server AcceptReq 1234

create a client side socket, A, and configure it to print the data it receives
 set A [socket localhost 1234]
        fconfigure $A -blocking 0 -buffering line
        fileevent $A readable [list handleInputA $A]

create a client side socket, B, and configure it to print the data it receives
 set B [socket localhost 1234]
        fconfigure $B -blocking 0 -buffering line
        fileevent $B readable [list handleInputB $B]

connect the two channels together at server side
 fconnect $serv1 $serv2

Now test the connection. Data sent to B gets copied at server side to A, so finally A receives it and prints it out
 puts $B "Hello"
 # A: Hello

Same with A
 puts $A "Hello"
 # B: Hello

I'm prety sure fconnect could be polished and optimized further, to suit other needs.


[Category Tcl syntax help]Category Command