Changeset 1273 for trunk/p2p/server.tcl

Timestamp:

Feb 5, 2009, 6:17:23 AM (16 years ago)

Author:

mmc

Message:

Major reorganization of p2p code, and support for solicit/proffer
messages.

File:

• trunk/p2p/server.tcl (modified) (5 diffs)

trunk/p2p/server.tcl

@@ -11 +11 @@
 package require Itcl
 
+namespace eval p2p { # forward declaration }
+
+# ======================================================================
+#  USAGE: p2p::server ?-option value -option value ...?
+#
+#  Used to create a new peer-to-peer server object for this program.
+#  Recognizes the following options:
+#    -port ........ port number that the server listens on
+#    -protocols ... list of protocol root names that the server handles
+#               ... any other option supported by Server class
+# ======================================================================
+proc p2p::server {args} {
+    set port "?"
+    set protocols ""
+    set options ""
+    foreach {key val} $args {
+        switch -- $key {
+            -port { set port $val }
+            -protocols { set protocols $val }
+            default { lappend options $key $val }
+        }
+    }
+
+    if {[llength $protocols] == 0} {
+        error "server needs at least one value for -protocols"
+    }
+
+    # create the server
+    set server [eval Server ::#auto $port $options]
+
+    # install the protocols that this server recognizes
+    foreach name $protocols {
+        p2p::protocol::init $server $name
+    }
+    return $server
+}
+
+# ======================================================================
+#  CLASS: Server
+# ======================================================================
 itcl::class Server {
     inherit Handler
@@ -24 +64 @@
     # this code fragment gets invoked when client declares the protocol
     public variable onprotocol ""
+
+    # this code fragment gets invoked when client drops
+    public variable ondisconnect ""
 
     constructor {port args} {
@@ -59 +102 @@
 
     public method port {}
+    public method broadcast {args}
     public method connectionSpeaks {cid protocol}
 
+    protected method dropped {cid}
     protected method handlerType {}
 
@@ -80 +125 @@
 
 # ----------------------------------------------------------------------
+#  USAGE: broadcast ?-protocol <name>? ?-avoid <avoidList>? <message>
+#
+#  Sends a <message> to all clients connected to this server.  If a
+#  client address appears on the -avoid list, then that client is
+#  avoided.  If the -protocol is specified, then the message is sent
+#  only to clients who match the glob-style pattern for the protocol
+#  name.
+# ----------------------------------------------------------------------
+itcl::body Server::broadcast {args} {
+    set pattern "*"
+    set avoidList ""
+    set i 0
+    while {$i < [llength $args]} {
+        set option [lindex $args $i]
+        if {[string index $option 0] == "-"} {
+            switch -- $option {
+                -protocol {
+                    set pattern [lindex $args [expr {$i+1}]]
+                    incr i 2
+                }
+                -avoid {
+                    set avoidList [lindex $args [expr {$i+1}]]
+                    incr i 2
+                }
+                -- {
+                    incr i
+                    break
+                }
+                default {
+                    error "bad option \"$option\": should be -avoid, -protocol, or --"
+                }
+            }
+        } else {
+            break
+        }
+    }
+    if {$i != [llength $args]-1} {
+        error "wrong # args: should be \"broadcast ?-protocol pattern? ?-avoid clients? message\""
+    }
+    set message [lindex $args end]
+
+    set nmesgs 0
+    foreach cid [connections $pattern] {
+        set addr [lindex [connectionName $cid] 0]  ;# x.x.x.x (sockN)
+        if {[llength $avoidList] == 0 || [lsearch $avoidList $addr] < 0} {
+puts "  inbound => [connectionName $cid]"
+            if {[catch {puts $cid $message} result] == 0} {
+                incr nmesgs
+            } else {
+                log error "ERROR: broadcast failed for $cid: $result"
+                log error "  (message was $message)"
+            }
+        }
+    }
+    return $nmesgs
+}
+
+# ----------------------------------------------------------------------
 #  USAGE: accept <cid> <addr> <port>
 #
@@ -116 +219 @@
 
 # ----------------------------------------------------------------------
+#  USAGE: dropped <cid>
+#
+#  Invoked automatically whenever a client connection drops, to
+#  log the event and remove all trace of the client.  Invokes any
+#  command hook for this server to note the fact that the client
+#  has dropped.
+# ----------------------------------------------------------------------
+itcl::body Server::dropped {cid} {
+    # if there's a callback to handle the drop, execute it here
+    if {[string length $ondisconnect] > 0} {
+        uplevel #0 [list $ondisconnect [connectionName $cid]]
+    }
+
+    # call the base class method to clean up after the client
+    chain $cid
+}
+
+# ----------------------------------------------------------------------
 #  USAGE: handlerType
 #