A socket bridge

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

aspect - I wrote the original snippet some time ago, and am glad to see the improvements here (and a little embarrassed at using two ports in the first example) .. here's another one. I like lremove a lot, along with the Additional list functions scattered about the wiki .. but it feels a bit out of place here, as we're really using $socks as a (very simple) set. What's the easiest way to do sets in Tcl? The keys of an array form a set! As a bonus we get to print some more useful information on disconnect:

  array set socks {}

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

  proc bridge {channel} {
      global socks
      if {[eof $channel]} {
          puts "Disconnect: $socks($channel)"
          close $channel
          unset socks($channel)
      } else {
          set data [read $channel]
          foreach sock $socks {
              if {$sock != $channel} {
                  puts -nonewline $sock $data
              }
          }
      }
  }

  vwait forever

Now this can be made into a chat server with only a few lines changed ...

Category Tutorial

Category Networking