source: tags/1.3.9/p2p/client.tcl @ 5224

Last change on this file since 5224 was 3177, checked in by mmc, 12 years ago

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

File size: 3.7 KB
Line 
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# ======================================================================
12package require Itcl
13
14namespace 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# ======================================================================
25proc 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
54itcl::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# ----------------------------------------------------------------------
96itcl::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# ----------------------------------------------------------------------
113itcl::body Client::address {} {
114    return $_addr
115}
Note: See TracBrowser for help on using the repository browser.