source: trunk/p2p/handler.tcl @ 4503

Last change on this file since 4503 was 3177, checked in by mmc, 8 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 9.2 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) 2004-2012  HUBzero Foundation, LLC
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}
62
63# ----------------------------------------------------------------------
64#  USAGE: protocol <name>
65#
66#  Used to define a protocol that this client/server recognizes.
67#  A protocol has an associated safe interpreter full of commands
68#  that the client/server recognizes.  When each connection is
69#  established, the other party must declare the  protocol that it
70#  intends to speak up front, so the client/server can select the
71#  appropriate interpreter for all incoming requests.
72# ----------------------------------------------------------------------
73itcl::body Handler::protocol {name} {
74    if {[info exists _namesp($name)]} {
75        error "protocol \"$name\" already defined"
76    }
77    set _namesp($name) "[namespace current]::bodies[incr _counter]"
78    namespace eval $_namesp($name) {}
79    set _parser($name) [interp create -safe]
80    foreach cmd [$_parser($name) eval {info commands}] {
81        $_parser($name) hide $cmd
82    }
83    $_parser($name) invokehidden proc unknown {args} {}
84    $_parser($name) expose error
85}
86
87# ----------------------------------------------------------------------
88#  USAGE: define <protocol> <name> <arglist> <body>
89#
90#  Used to define a command that this handler recognizes.  The command
91#  is called <name> in the safe interpreter associated with the given
92#  <protocol>, which should have been defined previously via the
93#  "protocol" method.  The new command exists with the same name in a
94#  special namespace in the main interpreter.  It is implemented with
95#  an argument list <arglist> and a <body> of Tcl code.
96# ----------------------------------------------------------------------
97itcl::body Handler::define {protocol name arglist body} {
98    if {![info exists _namesp($protocol)]} {
99        error "can't define command \"$name\": protocol \"$protocol\" doesn't exist"
100    }
101    proc [set _namesp($protocol)]::$name $arglist $body
102    $_parser($protocol) alias $name [set _namesp($protocol)]::$name
103    finalize $protocol
104}
105
106# ----------------------------------------------------------------------
107#  USAGE: connections ?<protocol>?
108#
109#  Returns a list of file handles for current connections that match
110#  the glob-style <protocol> pattern.  If no pattern is given, then
111#  it returns all connections.  Each handle can be passed to
112#  connectionName and connectionSpeaks to get more information.
113# ----------------------------------------------------------------------
114itcl::body Handler::connections {{pattern *}} {
115    set rlist ""
116    foreach cid [array names _protocol] {
117        if {[string match $pattern $_protocol($cid)]} {
118            lappend rlist $cid
119        }
120    }
121    return $rlist
122}
123
124# ----------------------------------------------------------------------
125#  USAGE: connectionName <sockId> ?<name>?
126#
127#  Used to set/get the nice name associated with a <sockId> connection.
128#  The nice name is used for log messages, and makes debugging easier
129#  than chasing around a bunch of "sock3" handle names.  If no name
130#  is specified, then it defaults to the file descriptor name.
131# ----------------------------------------------------------------------
132itcl::body Handler::connectionName {cid {name ""}} {
133    if {[string length $name] > 0} {
134        set _cname($cid) $name
135    }
136    if {[info exists _cname($cid)]} {
137        return "$_cname($cid) ($cid)"
138    }
139    return $cid
140}
141
142# ----------------------------------------------------------------------
143#  USAGE: connectionSpeaks <sockId> <protocol>
144#
145#  Used internally to define what protocol the entity on the other
146#  side of the connection speaks.  This is usually invoked when that
147#  entity sends the "protocol" message, and the built-in "protocol"
148#  command in the DEFAULT parser uses this method to register the
149#  protocol for the entity.
150# ----------------------------------------------------------------------
151itcl::body Handler::connectionSpeaks {cid protocol} {
152    if {"DEFAULT" != $protocol && ![info exists _parser($protocol)]} {
153        error "protocol \"$protocol\" not recognized"
154    }
155    set _protocol($cid) $protocol
156}
157
158# ----------------------------------------------------------------------
159#  USAGE: handle <cid>
160#
161#  Invoked automatically whenever a message comes in on the file
162#  handle <cid> from the entity on the other side of the connection.
163#  This handler reads the message and executes it in a safe
164#  interpreter, thereby responding to it.
165# ----------------------------------------------------------------------
166itcl::body Handler::handle {cid} {
167    if {[gets $cid request] < 0} {
168        dropped $cid
169    } elseif {[info exists _protocol($cid)]} {
170        # complete command? then process it below...
171        append _buffer($cid) $request "\n"
172        if {[info complete $_buffer($cid)]} {
173            set request $_buffer($cid)
174            set _buffer($cid) ""
175
176            # what protocol does this entity speak?
177            set protocol $_protocol($cid)
178
179            # Some commands need to know the identity of the entity
180            # on the other side of the connection.  Save it as a
181            # global variable in the namespace where the protocol
182            # command exists.
183            set [set _namesp($protocol)]::handler $this
184            set [set _namesp($protocol)]::cid $cid
185
186            # execute the incoming command...
187            set mesg " => "
188            if {[catch {$_parser($protocol) eval $request} result] == 0} {
189                if {[string length $result] > 0} {
190                    catch {puts $cid $result}
191                    append mesg "ok: $result"
192                }
193            } else {
194                catch {puts $cid [list exception $result]}
195                append mesg "exception: $result"
196            }
197            log debug "incoming message from [connectionName $cid]: [string trimright $request \n] $mesg"
198        }
199    }
200}
201
202# ----------------------------------------------------------------------
203#  USAGE: finalize <protocol>
204#
205#  Called whenever a new command is added to the handler.  Updates
206#  the "unknown" command to report a proper usage message (including
207#  all valid keywords) when a bad command is encountered.
208# ----------------------------------------------------------------------
209itcl::body Handler::finalize {protocol} {
210    set p $_parser($protocol)
211    $p hide error
212    $p hide unknown
213    set cmds [lsort [$p invokehidden info commands]]
214    $p expose error
215    $p expose unknown
216
217    $p invokehidden proc unknown {cmd args} [format {
218        error "bad command \"$cmd\": should be %s"
219    } [join $cmds {, }]]
220}
221
222# ----------------------------------------------------------------------
223#  USAGE: dropped <cid>
224#
225#  Invoked automatically whenever a client connection drops, to
226#  log the event and remove all trace of the client.  Derived classes
227#  can override this method to perform other functions too.
228# ----------------------------------------------------------------------
229itcl::body Handler::dropped {cid} {
230    log system "dropped: [connectionName $cid]"
231
232    # connection has connection -- forget this entity
233    catch {close $cid}
234    catch {unset _buffer($cid)}
235    catch {unset _protocol($cid)}
236    catch {unset _cname($cid)}
237}
Note: See TracBrowser for help on using the repository browser.