~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/handoffClient/client.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # client.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 
 31 
 32 import HandoffClientUI System Application AnnounceListenManager
 33 
 34 
 35 Class HandoffClient -superclass Application
 36 
 37 Class BeaconAgent -superclass AnnounceListenManager
 38 
 39 
 40 BeaconAgent instproc init { } {
 41         $self next [$self get_option beaconaddr] [$self get_option mtusize]
 42 
 43         $self set host_name_ [localaddr]
 44         $self set announcer_ [new AnnounceListenManager \
 45                         [$self get_option gatewayaddr] \
 46                         [$self get_option mtusize]]
 47 }
 48 
 49 
 50 BeaconAgent instproc get_lastheard { addr } {
 51         $self instvar last_heard_
 52         if [info exists last_heard_($addr)] {
 53                 return $last_heard_($addr)
 54         } else {
 55                 # return a very large number
 56                 return 10000
 57         }
 58 }
 59 
 60 
 61 BeaconAgent instproc recv_announcement { basestation args } {
 62         $self instvar last_heard_
 63         $self set last_heard_($basestation) [clock seconds]
 64 }
 65 
 66 
 67 BeaconAgent instproc send_announcement { eth_addr wl_addr } {
 68         $self instvar announcer_ host_name_ observer_
 69 
 70         set def_route [[System instance] get_default_route]
 71 
 72         if {$def_route == ""} {
 73                 $observer_ log "No default route"
 74         } else {
 75                 $observer_ log "Deleting default route"
 76                 catch {[System instance] delete_default_route}
 77         }
 78         after 30
 79         $observer_ log "Adding new route for $eth_addr/$wl_addr"
 80         catch {[System instance] add_default_route $wl_addr}
 81 
 82         after 100
 83         $announcer_ announce "SetRoute $host_name_ $eth_addr"
 84 }
 85 
 86 
 87 BeaconAgent instproc attach { observer } {
 88         $self set observer_ $observer
 89 }
 90 
 91 
 92 HandoffClient instproc init { argv } {
 93         set name [string tolower [tk appname]]
 94         set cls "[string toupper [string index $name 0]][string \
 95                         range $name 1 end]"
 96         $self next $name
 97 
 98         set o [$self options]
 99         $self init_args $o
100         $self init_resources $o
101         set argv [$o parse_args $argv]
102         if { $argv != {} } {
103                 $self add_option basestations $argv
104         }
105 
106         $self instvar beaconAgent_ observer_
107         set beaconAgent_ [new BeaconAgent]
108         set observer_ [$self create_observer]
109         $beaconAgent_ attach $observer_
110         $observer_ attach $beaconAgent_
111 
112         System create_instance $observer_
113         $observer_ set_default [[System instance] get_default_route]
114 }
115 
116 
117 HandoffClient instproc create_observer { } {
118         return [new HandoffClientUI .]
119 }
120 
121 
122 HandoffClient instproc init_args o {
123         $o register_option -beaconaddr beaconaddr
124         $o register_option -gatewayaddr  gatewayaddr
125         $o register_option -basestations basestations
126         $o register_option -add          morebs
127 }
128 
129 HandoffClient instproc init_resources o {
130         set basestations {
131                 { brig {306 Soda} }
132                 { ajanta {405 Soda} }
133                 { giza {420A Soda} }
134                 { yacht {443 Soda} }
135                 { cruiser {443 Soda} }
136                 { carthage {514 Soda} }
137                 { dreadnaught {637 Soda} }
138                 { ketch {698 Soda} }
139         }
140 
141         $o add_default beaconaddr   255.255.255.255/1201
142         $o add_default gatewayaddr  128.32.41.3/3443
143         $o add_default basestations $basestations
144         $o add_default morebs       {}
145 
146         $o add_default mtusize      4096
147         $o add_default maxlogsize   100
148 }
149 
150 
151 #HandoffClient instproc add_option { resource value {level {}} } {
152 #       # FIXME: class_ is an instance variable of superclass Application
153 #       # I shouldn't be reading it directly here
154 #       $self instvar class_
155 #       if { $level=={} } {
156 #               option add $class_.$resource $value
157 #       } else {
158 #               option add $class_.$resource $value $level
159 #       }
160 #}
161 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.