1 # address-block.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/address-block.tcl,v 1.26 2003/06/03 20:06:45 aswan Exp $
32
33
34 import Configuration
35 import mashutils
36 import SessionAddress
37
38 Class AddressBlock -superclass SessionAddress -configuration {
39 defaultTTL 1
40 maxbw -1
41 }
42
43 # a version of AddressBlock that doesn't use
44 # rtp port number heuristics
45 Class AddressBlock/Simple -superclass AddressBlock
46
47 # addr/port[:port]/fmt/ttl/layercnt
48 AddressBlock instproc init spec {
49 $self next
50 $self set network_class_ NetworkManager
51 $self set nchan_ 0
52 foreach s [split $spec ,] {
53 set err [$self parse $s]
54 #FIXME fatal exit on error --- callee should handle
55 if { $err != "" } {
56 $self fatal $err
57 }
58 }
59 }
60
61 AddressBlock instproc fmt {} {
62 $self instvar fmt_
63 if [info exists fmt_] { return $fmt_ } else { return "" }
64 }
65
66 AddressBlock instproc data-port p {
67 return [expr $p &~ 1]
68 }
69
70 AddressBlock/Simple instproc data-port p {
71 return $p
72 }
73
74 AddressBlock instproc ctrl-port p {
75 return [expr [$self data-port $p] + 1]
76 }
77
78 AddressBlock instproc addr {{k 0}} {
79 return [$self set addr_($k)]
80 }
81
82 AddressBlock instproc sport {{k 0}} {
83 return [$self set sport_($k)]
84 }
85
86 AddressBlock instproc rport {{k 0}} {
87 return [$self set rport_($k)]
88 }
89
90 AddressBlock instproc ttl {{k 0}} {
91 $self instvar ttl_
92 if [info exists ttl_($k)] { return $ttl_($k) } else { return {} }
93 }
94
95 AddressBlock instproc nchan {} {
96 return [$self set nchan_]
97 }
98
99 AddressBlock instproc maxbw {} {
100 $self instvar maxbw_
101 if [info exists maxbw_(0)] {
102 return $maxbw_(0)
103 }
104 return ""
105 }
106
107 #
108 # FIXME fatal errors should be handled elsewhere
109 #
110 AddressBlock instproc parse s {
111 set dst [split $s /]
112 set n [llength $dst]
113 if { $n < 2 } {
114 error "must specify both address and port in the form addr/port ($s)"
115 }
116 set addr [lindex $dst 0]
117 set ports [split [lindex $dst 1] :]
118 set sport [lindex $ports 0]
119 if { [llength $ports] == 1 } {
120 set rport $sport
121 } else {
122 set rport [lindex $ports 1]
123 }
124 set firstchar [string index $addr 0]
125 if [string match \[a-zA-Z\] $firstchar] {
126 set s [gethostbyname $addr]
127 if { $s == "" } {
128 error "cannot lookup host name: $addr"
129 }
130 set addr $s
131 }
132
133 foreach port "$sport $rport" {
134 if { ![string match \[0-9\]* $port] || $port >= 65536 } {
135 error "illegal port '$port'"
136 }
137 }
138
139 set ttl [$self get_option defaultTTL]
140
141 set cnt 1
142 if { $n >= 3 } {
143 set fmt [lindex $dst 2]
144 if { $n==3 && [regexp {^[0-9]+$} $fmt] } {
145 # this is an integer field; it must be the ttl
146 set ttl $fmt
147 set fmt {}
148 }
149
150 if { $n >= 4 } {
151 set ttl [lindex $dst 3]
152 if { $n > 4 } {
153 set cnt [lindex $dst 4]
154 if { ![string match \[0-9\]* $cnt] ||
155 $cnt >= 20 } {
156 error "$dst: bad layered addr count"
157 }
158 if { $n > 5 } {
159 error "$dst: malformed address"
160 }
161 }
162 }
163 }
164 if { $ttl < 0 || $ttl > 255 } {
165 error "$dst: invalid ttl ($ttl)"
166 }
167
168 # Handle layered addresses: port numbers are
169 # incremented by 2 for each layer, ip addresses
170 # are incremented by 1 for each layer.
171 # This is a little messy since we have to be
172 # careful not to screw up ssm addresses which are
173 # specified as source@group (e.g., 10.0.0.1@232.1.1.1)
174 set oct [split $addr .]
175 set len [llength $oct]
176 set base [join [lrange $oct 0 [expr $len-2]] .]
177 set off [lindex $oct end]
178
179 $self instvar addr_ sport_ rport_ ttl_ nchan_
180
181 set i 0
182 while { $i < $cnt } {
183 set sp [$self data-port $sport]
184 set rp [$self data-port $rport]
185
186 set addr_($nchan_) $base.$off
187 set sport_($nchan_) $sp
188 set rport_($nchan_) $rp
189 set ttl_($nchan_) $ttl
190
191 if [in_multicast $addr] {
192 #FIXME need to handle carry!
193 incr off
194 }
195 incr sport 2
196 incr rport 2
197 incr i
198 incr nchan_
199 }
200
201 #FIXME this only works right for single layer case!
202 #FIXME this goes elsewhere anyway
203
204 if { [info exists fmt] && $fmt != "" } {
205 $self set fmt_ $fmt
206 # $self add_option videoFormat $fmt
207 # #FIXME compat with vat
208 # $self add_option audioFormat $fmt
209 }
210
211 ####FIXME resetting the format for the whole app here seems really bad
212 #### the addr block could be for mega or some other non-data addr
213
214 ###if { [info exists fmt] && $fmt != "" && $fmt != "1" } {
215 ### $self add_option videoFormat $fmt
216 ### #FIXME compat with vat
217 ### $self add_option audioFormat $fmt
218 ###}
219
220 if [info exists confid] {
221 $self add_option confid $confid
222 }
223 if [info exists ttl] {
224 $self add_option defaultTTL $ttl
225 }
226 #FIXME
227 $self bandwidth_heuristic
228 }
229
230 AddressBlock instproc bandwidth_heuristic {} {
231 #
232 # if the max bandwidth wasn't set, pick one based on the
233 # session ttls. Then use the max bandwidth to compute the
234 # fraction allocated to rtcp (control) traffic. We have
235 # to do this before creating the session manager since it
236 # will use the result to compute a time to the first report.
237 # bw is in kbits/sec and we want bytes/ms so we divide by 8.
238 #
239 $self instvar nchan_ addr_ ttl_ maxbw_
240 set i 0
241 while { $i < $nchan_ } {
242 set maxbw [$self get_option maxbw]
243 if { $maxbw <= 0 } {
244 set ttl $ttl_($i)
245 if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
246 set maxbw 10000000
247 } elseif { $ttl <= 64 } {
248 set maxbw 4000000
249 } elseif { $ttl <= 128 } {
250 set maxbw 1000000
251 } elseif { $ttl <= 192 } {
252 set maxbw 128000
253 } else {
254 set maxbw 56000
255 }
256 }
257 set maxbw_($i) $maxbw
258 incr i
259 }
260 }
261
262
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.