Version 3 of A socket bridge

Updated 2008-07-22 00:26:29 by effelsberg

From a request by GPS on Tclers' chat, came this simple server as a socket demo. Data from each client is simply relayed to the other, like on a telephone bridge.

Extending to more than 2 parties is left as an exercise.

  array set socks {}

  proc makebridge {p0 p1} {
      set l0 [socket -server [list connect 0] $p0]
      set l1 [socket -server [list connect 1] $p1]

  }

  proc connect {p sock addr port} {
      puts "Client on port $p: $sock from $addr:$port"
      global socks
      set socks($p) $sock
      fconfigure $sock -buffering none
      fconfigure $sock -blocking no
      fileevent $sock readable [list bridge $p]
  }

  proc close_bridge {} {
      global socks
      close $socks(0)
      close $socks(1)
      array set socks {}
  }

  proc bridge {p} {
      set q [expr {!$p}]
      global socks
      if {[eof $socks($p)]} {
          puts "Close port $p"
          close_bridge
      } elseif {[catch {set data [read $socks($p)]}]} {
          puts "Error on port $p: $::errorInfo"
          close_bridge
      } else {
          puts -nonewline $socks($q) $data
      }
  }

  makebridge 2000 2001
  vwait forever

To help others with the "exercise" (because the example above may lead into a wrong direction): There is no need to offer the same service on several ports. (Or as an exercise for the author of the above code: What happens if two clients connect to port 2000?)

Simplifying makebridge:

  proc makebridge {p} {
      socket -server connect $p
  }
  makebridge 2001

Connect keeps track of all connections by adding them to socks (which is a simple list now).

  set socks {}

  proc connect {sock addr port} {
      puts "Client connection: $addr:$port"
      global socks
      lappend socks $sock
      fconfigure $sock -buffering none -blocking false
      fileevent $sock readable [list bridge $sock]
  }

Bridge now forwards the message to all clients except the sender. I like to emphasize that we're working on channels, I'm using a similar program myself to bridge serial lines over a network. (Left as an exercise ...)

Plus a little helper from RS:

  proc lremove {l v} {
      set result [lsearch -all -inline -not -exact $l $v]
      return $result
  }

  proc bridge {channel} {
      global socks
      if {[eof $channel]} {
          puts "Close channel $channel"
          close $channel
          set socks [lremove $socks $channel]
      } else {
          set data [read $channel]
          foreach sock $socks {
              if {$sock != $channel} {
                  puts -nonewline $sock $data
              }
          }
      }
  }
  vwait forever

- Effe