source: trunk/p2p/protocols.tcl @ 2080

Last change on this file since 2080 was 2080, checked in by mmc, 11 years ago

Part 1 of a major reorganization of content. Moving "instant" to "builder"
and setting up "builder" more like the "gui" part as a package. Moving the
Rappture::object stuff from the builder into the main installation, so it
can be shared by the tester as well. Moving "driver" into gui/scripts
where it belongs. Creating a new "launcher.tcl" script that decides
which of the three parts to launch based on command line options. Still
need to sort out the Makefiles to get this all right...

File size: 4.7 KB
Line 
1# ----------------------------------------------------------------------
2#  P2P: protocol initialization and registration
3#
4#  This file contains p2p::init and p2p::connect routines used to
5#  add protocols to Client and Server objects in the p2p system.
6#  New protocols are stored in the various p-*.tcl files.  This
7#  code loads those files, obtains a list of known protocols, and
8#  then registers the latest version of a protocol in a given
9#  Client or Server connection.
10# ----------------------------------------------------------------------
11#  Michael McLennan (mmclennan@purdue.edu)
12# ======================================================================
13#  Copyright (c) 2008  Purdue Research Foundation
14#
15#  See the file "license.terms" for information on usage and
16#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17# ======================================================================
18
19namespace eval p2p { # forward declaration }
20
21namespace eval p2p::protocol {
22    variable name2defn  ;# maps protocol name => body of code defining it
23    variable version    ;# maps protocol name => highest /version number
24    variable _tmpobj    ;# used during init/define calls
25    variable _tmpproto  ;# used during init/define calls
26}
27
28# ======================================================================
29#  USAGE: p2p::protocol::register <name> <code>
30#
31#  Various p-*.tcl files use this to define a particular protocol
32#  called <name>.  Calling p2p::protocol::init adds that protocol to
33#  a particular Handler object.  This is done by executing the <code>,
34#  which invokes a series of "define" operations to define the
35#  protocol handlers.
36# ======================================================================
37proc p2p::protocol::register {name code} {
38    variable name2defn
39    variable version
40
41    # store the code needed for this version for later call to init
42    if {[info exists name2defn($name)]} {
43        error "protocol \"$name\" already exists"
44    }
45    set name2defn($name) $code
46
47    # extract the version number from the protocol and save the highest num
48    if {![regexp {(.+)/([0-9]+)$} $name match root vnum]} {
49        set root $name
50        set vnum 1
51    }
52    if {![info exists version($root)] || $vnum > $version($root)} {
53        set version($root) $vnum
54    }
55}
56
57# ======================================================================
58#  USAGE: p2p::protocol::init <handlerObj> <protocol>
59#
60#  Adds all protocol versions matching the <protocol> root name to
61#  the given <handlerObj> object.  For example, the <protocol> might
62#  be "a->b", and this routine will add "a->b/1", "a->b/2", etc.
63#  Returns the highest version of the protocol added to the object.
64# ======================================================================
65proc p2p::protocol::init {obj protocol} {
66    variable name2defn
67    variable version
68    variable _tmpobj
69    variable _tmpproto
70
71    # trim off any version number included in the protocol name
72    regexp {(.+)/[0-9]+$} $protocol match protocol
73
74    set plist $protocol
75    eval lappend plist [array names name2defn $protocol/*]
76    set _tmpobj $obj  ;# used via "define" statements in "catch" below
77
78    set added 0
79    foreach name $plist {
80        if {[info exists name2defn($name)]} {
81            $obj protocol $name
82            $obj define $name exception {message} {
83                variable cid
84                variable handler
85                log error "ERROR from client [$handler connectionName $cid]:  $message"
86            }
87            $obj define $name identity {name} {
88                variable cid
89                variable handler
90                $handler connectionName $cid $name
91                return ""
92            }
93
94            # define the rest of the protocol as registered earlier
95            set _tmpproto $name  ;# used via "define" statements below
96            if {[catch $name2defn($name) err]} {
97                error $err "$err\n    (while adding protocol $name to $obj)"
98            }
99            incr added
100        }
101    }
102
103    if {$added == 0} {
104        error "can't find protocol definition matching \"$protocol\""
105    }
106    return $version($protocol)
107}
108
109# ======================================================================
110#  USAGE: p2p::protocol::define <name> <args> <body>
111#
112#  This gets called implicitly by the bodies of code invoked in the
113#  p2p::protocol::init statements above.  Code bodies should contain
114#  a series of "define" statements, and this is the "define" that
115#  gets invoked, which passes the call onto the _tmpobj where the
116#  protocol is being installed.
117# ======================================================================
118proc p2p::protocol::define {args} {
119    variable _tmpobj
120    variable _tmpproto
121    eval $_tmpobj define $_tmpproto $args
122}
Note: See TracBrowser for help on using the repository browser.