Open Mash Cross Reference
mash/tcl/net/udpserver.tcl

   # udpserver.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1996-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/net/udpserver.tcl,v 1.10 2002/02/03 04:28:06 lim Exp $
  
  
  import UDPChannel
  
  # UDPChannel that maintains list of unicast
  # address/port pairs and optionally also a single mcast address/port;
  # all are sent data when 'send' is called.
  # It automatically times out addrs that haven't been refreshed in
  # 'timeout_' seconds (if timeout_ == 0 they persist forever);
  # the list can also be manually manipulated via
  # 'addAddr' and 'rmAddr' and 'timeoutAddrs'
  #
  Class UDPServer -superclass UDPChannel
  
  # spec indicates the port number to listen on; additionally,
  # if spec is a multicast addr, it is used in addition to unicast addrs
  # as a location to send 'announce' messages
  #
  UDPServer public init { {spec ""} {mtu 1024} } {
      $self instvar replyToList_ mcastAddr_ port_ child_ timeout_
  
      set timeout_ 60 ; # default timeout is 60 secs
      set replyToList_ ""
      set replyTimeList_ ""
  
      if [regexp {^[0-9]*$} $spec] {
          set port_ $spec
          set addr ""
      } else {
          set port_ [lindex [split $spec "/"] 1]
          set addr [lindex [split $spec "/"] 0]
          # if spec includes a name, turn it into IP addr
          set firstchar [string index $spec 0]
          if [string match \[a-zA-Z\] $firstchar] {
              set n [lindex [split $spec "/"] 0]
              set s [gethostbyname $n]
              if { $s == "" } {
                  puts "cannot find address for '$n'"
                  exit
              }
              set addr $s
          }
  
      }
      # addressblocks only allow even ports -- emulate this
      if {$port_ % 2 != 0} {
          puts "WARNING: you specified an odd port: decrementing 1"
          incr port_ -1
      }
  
      if {$addr != ""} {
          if [in_multicast $addr] {
              $self next $spec $mtu
              set mcastAddr_ $addr/$port_
              set child_ [new UDPServerChild $self $port_]
          } else {
              set mcastAddr_ -1
              set child_ [new UDPServerChild $self $addr/$port_]
          }
      } else {
          set mcastAddr_ -1
          set child_ [new UDPServerChild $self $port_]
      }
  
  }
  
  # add addr and/or refresh last update time
  # for addrspec in replyToList_
 UDPServer public addAddr {addrspec} {
     $self instvar replyToList_ replyTimeList_
 
     set l [lsearch $replyToList_ $addrspec]
     if {$l == -1} {
         lappend replyToList_ $addrspec
         lappend replyTimeList_ [clock seconds]
     } else {
         set replyTimeList_ [lreplace $replyTimeList_ $l $l [clock seconds]]
     }
 }
 
 # remove addr from replyTo list
 UDPServer public rmAddr {addrspec} {
     $self instvar replyToList_ replyTimeList_
 
     set loc [lsearch $replyToList_ $addrspec]
     if {$loc != -1} {
         set replyToList_ [lreplace $replyToList_ $loc $loc]
         set replyTimeList_ [lreplace $replyTimeList_ $loc $loc]
     } else {
         puts "UDPServer: Tried to remove addr not in reply list: `$addrspec'"
     }
 }
 
 # remove any addr not updated in last <em>timeout</em> seconds
 #
 UDPServer public timeoutAddrs {timeout} {
     $self instvar replyToList_ replyTimeList_
 
     if {$replyToList_ == ""} {return}
     set t [clock seconds]
     if {[llength $replyToList_] != [llength $replyTimeList_]} {
         puts "Error: reply lists lengths are different! \
                 [llength $replyToList_] != [llength $replyTimeList_]"
     }
     set cnt 0
     foreach i $replyTimeList_ {
         if {[expr $t - $i] > $timeout} {
             $self rmAddr [lindex $replyToList_ $cnt]
         }
         incr cnt
     }
 }
 
 # send <em>data</em> to everyone
 #
 UDPServer public announce {data} {
     $self instvar replyToList_ mcastAddr_ port_ timeout_
 
     if {$timeout_ > 0} {
         $self timeoutAddrs $timeout_
     }
 
     foreach i $replyToList_ {
         #puts "$i: $data"
         set sender [new UDPChannel $i]
         $sender send "$data"
         delete $sender
         after 50
     }
     if {$mcastAddr_ != -1} {
         $self send "$data"
     }
 
     # FIXME backward compatability: for clients that listen on the port
     # number they send to (i.e., well-known rather than ephemeral)
     regsub -all "/" "$replyToList_" " " tmp
     array set addrsOnly $tmp
     foreach i [array names addrsOnly] {
         set sender [new UDPChannel $i/$port_]
         $sender send "$data"
         delete $sender
     }
 }
 
 # set new timeout value
 UDPServer public timeout {t} {
     $self instvar timeout_
     set timeout_ $t
 }
 
 # Receive Stub: should be extended by subclasses
 UDPServer private recv {addr port data len} {
     puts "Msg from $addr/$port \[$len\]: $data"
 }
 
 
 # -----------
 
 # UDPServerChild is a UDPServer helper class: it simply monitors a
 # unicast address and passes along received packets to the parent
 # after adding the addresses to the replyTo list
 Class UDPServerChild -superclass UDPChannel
 
 #
 UDPServerChild instproc init {parent spec {mtu 1024}} {
     #puts "listening to unicast $spec"
     $self next $spec $mtu
     $self instvar parent_
     set parent_ $parent
 }
 
 #
 UDPServerChild instproc recv {addr port data size} {
     #puts "UDPServerChild::recv"
     $self instvar parent_
     $parent_ addAddr $addr/$port
     $parent_ recv $addr $port "$data" $size
 }