source: trunk/p2p/handler.tcl @ 1723

Last change on this file since 1723 was 1273, checked in by mmc, 14 years ago

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

File size: 9.6 KB
Line 
1# ----------------------------------------------------------------------
2#  LIBRARY: Handler
3#  Base class for Client and Server.  Handles protocol declarations
4#  for messages received by the handler, and knows how to process
5#  messages.
6# ----------------------------------------------------------------------
7#  Michael McLennan (mmclennan@purdue.edu)
8# ======================================================================
9#  Copyright (c) 2008  Purdue Research Foundation
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itcl
15
16itcl::class Handler {
17    private variable _namesp    ;# maps protocol name => namespace of cmds
18    private variable _parser    ;# maps protocol name => parser for cmds
19    private variable _buffer    ;# maps connection => cmd buffer
20    private variable _protocol  ;# maps connection => protocol name
21    private variable _cname     ;# maps connection => nice name for debug
22    private common _counter 0
23
24    constructor {args} {
25        #
26        # Define the DEFAULT protocol, which clients/servers use when
27        # they first connect to define the protocol they intend to speak.
28        #
29        protocol DEFAULT
30        define DEFAULT protocol {version} {
31            variable handler
32            variable cid
33            $handler connectionSpeaks $cid $version
34            return ""
35        }
36        define DEFAULT exception {message} {
37            log error "ERROR: $message"
38        }
39
40        eval configure $args
41    }
42
43    destructor {
44        foreach protocol [array names _parser] {
45            interp delete $_parser($protocol)
46        }
47        foreach protocol [array names _namesp] {
48            namespace delete $_namesp($protocol)
49        }
50    }
51
52    public method protocol {name}
53    public method define {protocol name arglist body}
54    public method connections {{protocol *}}
55    public method connectionName {cid {name ""}}
56    public method connectionSpeaks {cid protocol}
57
58    protected method handle {cid}
59    protected method finalize {protocol}
60    protected method dropped {cid}
61    protected method handlerType {}
62}
63
64# ----------------------------------------------------------------------
65#  USAGE: protocol <name>
66#
67#  Used to define a protocol that this client/server recognizes.
68#  A protocol has an associated safe interpreter full of commands
69#  that the client/server recognizes.  When each connection is
70#  established, the other party must declare the  protocol that it
71#  intends to speak up front, so the client/server can select the
72#  appropriate interpreter for all incoming requests.
73# ----------------------------------------------------------------------
74itcl::body Handler::protocol {name} {
75    if {[info exists _namesp($name)]} {
76        error "protocol \"$name\" already defined"
77    }
78    set _namesp($name) "[namespace current]::bodies[incr _counter]"
79    namespace eval $_namesp($name) {}
80    set _parser($name) [interp create -safe]
81    foreach cmd [$_parser($name) eval {info commands}] {
82        $_parser($name) hide $cmd
83    }
84    $_parser($name) invokehidden proc unknown {args} {}
85    $_parser($name) expose error
86}
87
88# ----------------------------------------------------------------------
89#  USAGE: define <protocol> <name> <arglist> <body>
90#
91#  Used to define a command that this handler recognizes.  The command
92#  is called <name> in the safe interpreter associated with the given
93#  <protocol>, which should have been defined previously via the
94#  "protocol" method.  The new command exists with the same name in a
95#  special namespace in the main interpreter.  It is implemented with
96#  an argument list <arglist> and a <body> of Tcl code.
97# ----------------------------------------------------------------------
98itcl::body Handler::define {protocol name arglist body} {
99    if {![info exists _namesp($protocol)]} {
100        error "can't define command \"$name\": protocol \"$protocol\" doesn't exist"
101    }
102    proc [set _namesp($protocol)]::$name $arglist $body
103    $_parser($protocol) alias $name [set _namesp($protocol)]::$name
104    finalize $protocol
105}
106
107# ----------------------------------------------------------------------
108#  USAGE: connections ?<protocol>?
109#
110#  Returns a list of file handles for current connections that match
111#  the glob-style <protocol> pattern.  If no pattern is given, then
112#  it returns all connections.  Each handle can be passed to
113#  connectionName and connectionSpeaks to get more information.
114# ----------------------------------------------------------------------
115itcl::body Handler::connections {{pattern *}} {
116    set rlist ""
117    foreach cid [array names _protocol] {
118        if {[string match $pattern $_protocol($cid)]} {
119            lappend rlist $cid
120        }
121    }
122    return $rlist
123}
124
125# ----------------------------------------------------------------------
126#  USAGE: connectionName <sockId> ?<name>?
127#
128#  Used to set/get the nice name associated with a <sockId> connection.
129#  The nice name is used for log messages, and makes debugging easier
130#  than chasing around a bunch of "sock3" handle names.  If no name
131#  is specified, then it defaults to the file descriptor name.
132# ----------------------------------------------------------------------
133itcl::body Handler::connectionName {cid {name ""}} {
134    if {[string length $name] > 0} {
135        set _cname($cid) $name
136    }
137    if {[info exists _cname($cid)]} {
138        return "$_cname($cid) ($cid)"
139    }
140    return $cid
141}
142
143# ----------------------------------------------------------------------
144#  USAGE: connectionSpeaks <sockId> <protocol>
145#
146#  Used internally to define what protocol the entity on the other
147#  side of the connection speaks.  This is usually invoked when that
148#  entity sends the "protocol" message, and the built-in "protocol"
149#  command in the DEFAULT parser uses this method to register the
150#  protocol for the entity.
151# ----------------------------------------------------------------------
152itcl::body Handler::connectionSpeaks {cid protocol} {
153    if {"DEFAULT" != $protocol && ![info exists _parser($protocol)]} {
154        error "protocol \"$protocol\" not recognized"
155    }
156    set _protocol($cid) $protocol
157}
158
159# ----------------------------------------------------------------------
160#  USAGE: handle <cid>
161#
162#  Invoked automatically whenever a message comes in on the file
163#  handle <cid> from the entity on the other side of the connection.
164#  This handler reads the message and executes it in a safe
165#  interpreter, thereby responding to it.
166# ----------------------------------------------------------------------
167itcl::body Handler::handle {cid} {
168    if {[gets $cid request] < 0} {
169        dropped $cid
170    } elseif {[info exists _protocol($cid)]} {
171        # complete command? then process it below...
172        append _buffer($cid) $request "\n"
173        if {[info complete $_buffer($cid)]} {
174            set request $_buffer($cid)
175            set _buffer($cid) ""
176
177            # what protocol does this entity speak?
178            set protocol $_protocol($cid)
179
180            # Some commands need to know the identity of the entity
181            # on the other side of the connection.  Save it as a
182            # global variable in the namespace where the protocol
183            # command exists.
184            set [set _namesp($protocol)]::handler $this
185            set [set _namesp($protocol)]::cid $cid
186
187            # execute the incoming command...
188            set mesg " => "
189            if {[catch {$_parser($protocol) eval $request} result] == 0} {
190                if {[string length $result] > 0} {
191                    catch {puts $cid $result}
192                    append mesg "ok: $result"
193                }
194            } else {
195                catch {puts $cid [list exception $result]}
196                append mesg "exception: $result"
197            }
198            log debug "[handlerType] message from [connectionName $cid]: [string trimright $request \n] $mesg"
199        }
200    }
201}
202
203# ----------------------------------------------------------------------
204#  USAGE: finalize <protocol>
205#
206#  Called whenever a new command is added to the handler.  Updates
207#  the "unknown" command to report a proper usage message (including
208#  all valid keywords) when a bad command is encountered.
209# ----------------------------------------------------------------------
210itcl::body Handler::finalize {protocol} {
211    set p $_parser($protocol)
212    $p hide error
213    $p hide unknown
214    set cmds [lsort [$p invokehidden info commands]]
215    $p expose error
216    $p expose unknown
217
218    $p invokehidden proc unknown {cmd args} [format {
219        error "bad command \"$cmd\": should be %s"
220    } [join $cmds {, }]]
221}
222
223# ----------------------------------------------------------------------
224#  USAGE: dropped <cid>
225#
226#  Invoked automatically whenever a client connection drops, to
227#  log the event and remove all trace of the client.  Derived classes
228#  can override this method to perform other functions too.
229# ----------------------------------------------------------------------
230itcl::body Handler::dropped {cid} {
231    log system "dropped: [connectionName $cid]"
232
233    # connection has connection -- forget this entity
234    catch {close $cid}
235    catch {unset _buffer($cid)}
236    catch {unset _protocol($cid)}
237    catch {unset _cname($cid)}
238}
239
240# ----------------------------------------------------------------------
241#  USAGE: handlerType
242#
243#  Returns a descriptive string describing this handler.  Derived
244#  classes override this method to provide their own string.  Used
245#  for debug messages.
246# ----------------------------------------------------------------------
247itcl::body Handler::handlerType {} {
248    return "handler"
249}
Note: See TracBrowser for help on using the repository browser.