1 | # ---------------------------------------------------------------------- |
---|
2 | # LIBRARY: handles the client side of the connection in the p2p |
---|
3 | # infrastructure |
---|
4 | # ---------------------------------------------------------------------- |
---|
5 | # Michael McLennan (mmclennan@purdue.edu) |
---|
6 | # ====================================================================== |
---|
7 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
8 | # |
---|
9 | # See the file "license.terms" for information on usage and |
---|
10 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
11 | # ====================================================================== |
---|
12 | package require Itcl |
---|
13 | |
---|
14 | namespace eval p2p { # forward declaration } |
---|
15 | |
---|
16 | # ====================================================================== |
---|
17 | # USAGE: p2p::client ?-option value -option value ...? |
---|
18 | # |
---|
19 | # Used to create a client connection to a peer-to-peer server. |
---|
20 | # Recognizes the following options: |
---|
21 | # -address ........... connect to server at this host:port |
---|
22 | # -sendprotocol ...... tell server we're speaking this protocol |
---|
23 | # -receiveprotocol ... server replies back with these commands |
---|
24 | # ====================================================================== |
---|
25 | proc p2p::client {args} { |
---|
26 | array set options { |
---|
27 | -address ? |
---|
28 | -sendprotocol "" |
---|
29 | -receiveprotocol "" |
---|
30 | } |
---|
31 | foreach {key val} $args { |
---|
32 | if {![info exists options($key)]} { |
---|
33 | error "bad option \"$key\": should be [join [lsort [array names options]] {, }]" |
---|
34 | } |
---|
35 | set options($key) $val |
---|
36 | } |
---|
37 | |
---|
38 | # create the client |
---|
39 | set client [eval Client ::#auto $options(-address)] |
---|
40 | |
---|
41 | # install the protocol for incoming commands |
---|
42 | p2p::protocol::init $client $options(-receiveprotocol) |
---|
43 | |
---|
44 | # tell the server what protocol we'll be speaking |
---|
45 | $client send [list protocol $options(-sendprotocol)] |
---|
46 | |
---|
47 | return $client |
---|
48 | } |
---|
49 | |
---|
50 | # ====================================================================== |
---|
51 | # CLASS: Client |
---|
52 | # ====================================================================== |
---|
53 | |
---|
54 | itcl::class Client { |
---|
55 | inherit Handler |
---|
56 | |
---|
57 | private variable _addr "" ;# address that this client is connected to |
---|
58 | private variable _sid "" ;# file handle for server connection |
---|
59 | |
---|
60 | constructor {addr args} { |
---|
61 | eval configure $args |
---|
62 | |
---|
63 | # |
---|
64 | # Connect to the server at the specified address, which is |
---|
65 | # specified as "host:port". |
---|
66 | # |
---|
67 | set alist [split $addr :] |
---|
68 | if {[llength $alist] != 2} { |
---|
69 | error "bad address \"$addr\": should be host:port" |
---|
70 | } |
---|
71 | foreach {host port} $alist break |
---|
72 | set _sid [socket $host $port] |
---|
73 | connectionName $_sid $host:$port |
---|
74 | connectionSpeaks $_sid DEFAULT |
---|
75 | |
---|
76 | fileevent $_sid readable [itcl::code $this handle $_sid] |
---|
77 | fconfigure $_sid -buffering line |
---|
78 | |
---|
79 | set _addr $addr |
---|
80 | } |
---|
81 | |
---|
82 | destructor { |
---|
83 | catch {close $_sid} |
---|
84 | } |
---|
85 | |
---|
86 | public method send {message} |
---|
87 | public method address {} |
---|
88 | } |
---|
89 | |
---|
90 | # ---------------------------------------------------------------------- |
---|
91 | # USAGE: send <message> |
---|
92 | # |
---|
93 | # Used to send a <message> off to the server. If the connection |
---|
94 | # was unexpectedly closed, then this method does nothing. |
---|
95 | # ---------------------------------------------------------------------- |
---|
96 | itcl::body Client::send {message} { |
---|
97 | if {"" != $_sid} { |
---|
98 | if {[eof $_sid]} { |
---|
99 | set _sid "" |
---|
100 | } else { |
---|
101 | log debug "outgoing message to [address]: $message" |
---|
102 | puts $_sid $message |
---|
103 | } |
---|
104 | } |
---|
105 | } |
---|
106 | |
---|
107 | # ---------------------------------------------------------------------- |
---|
108 | # USAGE: address |
---|
109 | # |
---|
110 | # Returns the address that this client is connected to. This is |
---|
111 | # the host:port passed in when the client was created. |
---|
112 | # ---------------------------------------------------------------------- |
---|
113 | itcl::body Client::address {} { |
---|
114 | return $_addr |
---|
115 | } |
---|