| 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 | |
|---|
| 19 | namespace eval p2p { # forward declaration } |
|---|
| 20 | |
|---|
| 21 | namespace 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 | # ====================================================================== |
|---|
| 37 | proc 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 | # ====================================================================== |
|---|
| 65 | proc 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 | log error "ERROR from client: $message" |
|---|
| 84 | } |
|---|
| 85 | |
|---|
| 86 | # define the rest of the protocol as registered earlier |
|---|
| 87 | set _tmpproto $name ;# used via "define" statements below |
|---|
| 88 | if {[catch $name2defn($name) err]} { |
|---|
| 89 | error $err "$err\n (while adding protocol $name to $obj)" |
|---|
| 90 | } |
|---|
| 91 | incr added |
|---|
| 92 | } |
|---|
| 93 | } |
|---|
| 94 | |
|---|
| 95 | if {$added == 0} { |
|---|
| 96 | error "can't find protocol definition matching \"$protocol\"" |
|---|
| 97 | } |
|---|
| 98 | return $version($protocol) |
|---|
| 99 | } |
|---|
| 100 | |
|---|
| 101 | # ====================================================================== |
|---|
| 102 | # USAGE: p2p::protocol::define <name> <args> <body> |
|---|
| 103 | # |
|---|
| 104 | # This gets called implicitly by the bodies of code invoked in the |
|---|
| 105 | # p2p::protocol::init statements above. Code bodies should contain |
|---|
| 106 | # a series of "define" statements, and this is the "define" that |
|---|
| 107 | # gets invoked, which passes the call onto the _tmpobj where the |
|---|
| 108 | # protocol is being installed. |
|---|
| 109 | # ====================================================================== |
|---|
| 110 | proc p2p::protocol::define {args} { |
|---|
| 111 | variable _tmpobj |
|---|
| 112 | variable _tmpproto |
|---|
| 113 | eval $_tmpobj define $_tmpproto $args |
|---|
| 114 | } |
|---|
