1 # al.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 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/net/al.tcl,v 1.24 2002/02/03 04:28:05 lim Exp $
32
33
34 import Network Timer
35
36
37 AnnounceListenManager public init { spec {mtu 1500} } {
38 $self next $mtu
39
40 $self instvar data_ snet_ rnet_
41 set data_ ""
42 set snet_ ""
43 set rnet_ ""
44
45 # check if this is just a port number
46 if [regexp {^[0-9]*$} $spec] {
47 # Unicast UDP server
48 set rnet_ [new Network]
49 $rnet_ open $spec
50 } else {
51 set ab [new AddressBlock/Simple $spec]
52 set addr [$ab addr]
53 set sport [$ab sport]
54 set rport [$ab rport]
55 set ttl [$ab ttl]
56 delete $ab
57
58 set snet_ [new Network]
59 if [in_multicast $addr] {
60 $snet_ open $addr $sport $rport $ttl
61 set rnet_ $snet_
62 } else {
63 # unicast. Open a unicast send connection and a UDP
64 # server connection if needed.
65 if { $rport != 0 } {
66 set rnet_ [new Network]
67 $rnet_ open $rport
68 }
69 $snet_ open $addr $sport 0 1
70 }
71 }
72
73
74 if { $snet_ != "" } {
75 $snet_ loopback 1
76 $self send_network $snet_
77 }
78 if { $rnet_ != "" } {
79 $self recv_network $rnet_
80 }
81 }
82
83
84 AnnounceListenManager public destroy {} {
85 $self instvar snet_ rnet_ timers_
86 if { $rnet_==$snet_ } {
87 delete $snet_
88 } else {
89 if { $snet_ != "" } {
90 delete $snet_
91 }
92 if { $rnet_ != "" } {
93 delete $rnet_
94 }
95 }
96 if [info exists timers_] {
97 foreach t [array names timers_] {
98 delete $timers_($t)
99 }
100 }
101 $self next
102 }
103
104
105 # Use this method to set the timer object(s) associated with the
106 # AnnounceListenManager object.
107 # <ul>
108 # <li> <tt>$alm timer [new Timer/Periodic]</tt>. This will set the timer
109 # for the default announcement; every time the timer expires, the
110 # <tt>send_announcement</tt> method is invoked without any arguments
111 # <li> You can also create more than one announcement, each with its own
112 # timer: <tt>$alm timer $data [new Timer/Periodic]</tt>. Every time the
113 # timer expires, the <tt>send_announcement</tt> method is invoked with
114 # <tt>$data</tt> as its argument. The default <tt>send_announcement</tt>
115 # will send <tt>$data</tt> as part of the announcement packet.
116 # </ul>
117 # The manager assumes control of the timer object;
118 # so the application must not try to delete the object itself.
119 # If the timer argument to this method is an empty string, it deletes the
120 # existing timer
121 AnnounceListenManager public timer {args} {
122 $self instvar timers_
123 if {[llength $args]==1} {
124 set d __default_timer__
125 set t [lindex $args 0]
126 if {$t!={}} { $t proc timeout { } "$self send_announcement" }
127 } else {
128 set d [lindex $args 0]
129 set t [lindex $args 1]
130 if {$t!={}} { $t proc timeout { } \
131 [list $self send_announcement $d] }
132 }
133
134 # remember whether the timer is currently active or not
135 if [info exists timers_($d)] {
136 set sched [$timers_($d) is_sched]
137 delete $timers_($d)
138 } else {
139 set sched 0
140 }
141
142 if {$t!={}} {
143 set timers_($d) $t
144 if $sched {
145 # reschedule the timer
146 $t start
147 }
148 } else {
149 catch {unset timers_($d)}
150 }
151 return $t
152 }
153
154
155 # Use this method to retrieve the timer object(s) associated with this
156 # object. If no argument is specified, the timer for the default announcement
157 # is returned; If an argument <tt>$data</tt> is specified, then the timer
158 # associated with the announcement for <tt>$data</tt> is returned. This
159 # method returns an empty string if there is no associated timer object
160 AnnounceListenManager public get_timer {args} {
161 $self instvar timers_
162 if {[llength $args]==0} {
163 set d __default_timer__
164 } else {
165 set d [lindex $args 0]
166 }
167
168 if [info exists timers_($d)] { return $timers_($d) } else { return "" }
169 }
170
171
172 # Call this method to initiate the announcement operation.
173 # If this method is invoked without any arguments, it initiates
174 # the default announcement. When an argument is specified, a
175 # new announcement for that argument is initiated.
176 # If the application hasn't created a Timer object for this
177 # announcement (see AnnounceListenManager::timer),
178 # this method will create a default randomized Timer/Periodic object
179 # set to a timeout of 5 seconds
180 AnnounceListenManager public start {args} {
181 if { [llength $args]==0 } {
182 set t [$self get_timer]
183 } else {
184 set d [lindex $args 0]
185 set t [$self get_timer $d]
186 }
187
188 if { $t=={} } {
189 set t [new Timer/Periodic]
190 $t randomize 1
191 if [info exists d] { $self timer $d $t } else { $self timer $t}
192 }
193
194 if [info exists d] {$self send_announcement $d} \
195 else {$self send_announcement}
196 $t start
197 }
198
199
200 # Call this method to stop the AnnounceListenManager operation.
201 # If this method is invoked without any arguments, it stops
202 # all announcements. When an argument is specified,
203 # the announcement for that argument is stopped.
204 AnnounceListenManager public stop {args} {
205 $self instvar timers_
206 if {[llength $args]==0} {
207 foreach d [array names timers_] {
208 $timers_($d) cancel
209 }
210 } else {
211 set d [lindex $args 0]
212 $timers_($d) cancel
213 }
214 }
215
216
217 # Subclass this method to handle the received announcement
218 AnnounceListenManager public recv_announcement { addr port data len } {
219 puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
220 }
221
222
223 # Subclass this method if you wish to construct and send the announcement
224 # in a different manner
225 AnnounceListenManager public send_announcement {args} {
226 $self instvar data_
227 #puts "sending announcement for $self"
228 if {[llength $args]==0} {
229 if { $data_!={} } { $self announce $data_ }
230 } else {
231 $self announce [lindex $args 0]
232 }
233 }
234
235
236 # Call this method to set the default announcement that this object
237 # must send out
238 AnnounceListenManager public set_announcement { data } {
239 $self set data_ $data
240 }
241
242
243 # Call this method to retrieve the current default announcement that is
244 # being sent out
245 AnnounceListenManager public get_announcement { } {
246 return [$self set data_]
247 }
248
249 # Sets the announcement ttl
250 AnnounceListenManager public ttl {num} {
251 $self instvar snet_
252 $snet_ ttl $num
253 }
254
255
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.