source: trunk/p2p/server.tcl @ 1251

Last change on this file since 1251 was 1251, checked in by mmc, 12 years ago

Added first cut of P2P network for job management. See README in this
directory for details.

File size: 4.4 KB
Line 
1# ----------------------------------------------------------------------
2#  LIBRARY: core server capability used for p2p infrastructure
3# ----------------------------------------------------------------------
4#  Michael McLennan (mmclennan@purdue.edu)
5# ======================================================================
6#  Copyright (c) 2008  Purdue Research Foundation
7# ======================================================================
8package require Itcl
9
10itcl::class Server {
11    inherit Handler
12
13    private variable _port  ;# stores the port that this server listens on
14
15    # name for this server (for log messages)
16    public variable servername "server"
17
18    # this code fragment gets invoked with each new client
19    public variable onconnect ""
20
21    # this code fragment gets invoked when client declares the protocol
22    public variable onprotocol ""
23
24    constructor {port args} {
25        #
26        # Process option switches for the server.
27        #
28        eval configure $args
29
30        #
31        # Start up the server at the specified port.  If the port
32        # number ends with a ?, then search for the first open port
33        # above that.  The actual port can be queried later via the
34        # "port" method.
35        #
36        if {[regexp {^[0-9]+$} $port]} {
37            socket -server [itcl::code $this accept] $port
38            set _port $port
39        } elseif {[regexp {^[0-9]+\?$} $port]} {
40            set pnum [string trimright $port ?]
41            set tries 500
42            while {[incr tries -1] > 0} {
43                if {[catch {socket -server [itcl::code $this accept] $pnum} result]} {
44                    incr pnum
45                } else {
46                    set _port $pnum
47                    break
48                }
49            }
50            if {$tries <= 0} {
51                error "can't find an open port for server at $port"
52            }
53            log system "$servername started at port $_port"
54        }
55    }
56
57    public method port {}
58    public method connectionSpeaks {cid protocol}
59
60    protected method handlerType {}
61
62    private method accept {cid addr port}
63}
64
65# ----------------------------------------------------------------------
66#  USAGE: port
67#
68#  Returns the port number that this server is listening on.  When
69#  the server is first created, this can be set to a hard-coded value,
70#  or to a value followed by a ?.  In that case, the server tries to
71#  find the first open port.  The actual port is reported by this
72#  method.
73# ----------------------------------------------------------------------
74itcl::body Server::port {} {
75    return $_port
76}
77
78# ----------------------------------------------------------------------
79#  USAGE: accept <cid> <addr> <port>
80#
81#  Invoked automatically whenever a client tries to connect to this
82#  server.  The <cid> is the file handle for this client.  The <addr>
83#  and <port> give the address and port number of the incoming client.
84# ----------------------------------------------------------------------
85itcl::body Server::accept {cid addr port} {
86    fileevent $cid readable [itcl::code $this handle $cid]
87    fconfigure $cid -buffering line
88    connectionSpeaks $cid DEFAULT
89    log system "accepted: $addr ($cid)"
90
91    if {[string length $onconnect] > 0} {
92        uplevel #0 [list $onconnect $cid $addr $port]
93    }
94}
95
96# ----------------------------------------------------------------------
97#  USAGE: connectionSpeaks <client> <protocol>
98#
99#  Used internally to define what protocol the entity on the other
100#  side of the connection speaks.  This is usually invoked when that
101#  entity sends the "protocol" message, and the built-in "protocol"
102#  command in the DEFAULT parser uses this method to register the
103#  protocol for the entity.
104# ----------------------------------------------------------------------
105itcl::body Server::connectionSpeaks {cid protocol} {
106    chain $cid $protocol
107
108    # if there's a callback for the protocol change, execute it here
109    if {[string length $onprotocol] > 0} {
110        uplevel #0 [list $onprotocol $cid $protocol]
111    }
112}
113
114# ----------------------------------------------------------------------
115#  USAGE: handlerType
116#
117#  Returns a descriptive string describing this handler.  Derived
118#  classes override this method to provide their own string.  Used
119#  for debug messages.
120# ----------------------------------------------------------------------
121itcl::body Server::handlerType {} {
122    return "server"
123}
Note: See TracBrowser for help on using the repository browser.