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

Open Mash Cross Reference
mash/tcl/nsdr/source-sap.tcl

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

  1 # source-sap.tcl --
  2 #
  3 #       Handles creation, and transmission, of a SAP announcement
  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 import ProgramSource AnnounceListenManager Timer
 32 
 33 Class Timer/Adaptive/SAP -superclass Timer/Adaptive
 34 
 35 Timer/Adaptive/SAP public init { alm } {
 36         $self set alm_ $alm
 37         $self next
 38 }
 39 
 40 
 41 Timer/Adaptive/SAP private adapt {interval} {
 42         $self instvar alm_
 43         return [expr 1000*[$alm_ interval 1]]
 44 }
 45 
 46 
 47 # Used privately by ProgramSource/SAP.
 48 Class AnnounceListenManager/SAP/Nsdr -superclass AnnounceListenManager/SAP
 49 
 50 #
 51 AnnounceListenManager/SAP/Nsdr public init {s mtu scope} {
 52         set ttl [$self get_option sapTTL]
 53         set spec "[$scope sapAddr]/none/$ttl"
 54         $self next $spec $mtu
 55 
 56         $self set bw_ [$scope bw]
 57         $self set s_ $s
 58         $self set avgsize_ 500
 59         $self set nsrcs_ 0
 60 }
 61 
 62 #
 63 AnnounceListenManager/SAP/Nsdr public destroy {} {
 64         $self next
 65 }
 66 
 67 #
 68 AnnounceListenManager/SAP/Nsdr private recv_announcement args {
 69         $self instvar s_
 70         eval $s_ recv $self $args
 71 }
 72 
 73 #
 74 AnnounceListenManager/SAP/Nsdr public sample_size {size} {
 75         $self instvar avgsize_
 76         set avgsize_ [expr $avgsize_ + ($size-$avgsize_)>>3]
 77 }
 78 
 79 #
 80 AnnounceListenManager/SAP/Nsdr public incrnsrcs {n} {
 81         $self instvar nsrcs_
 82         incr nsrcs_ $n
 83 }
 84 
 85 #
 86 AnnounceListenManager/SAP/Nsdr public interval {rand} {
 87         $self instvar avgsize_ nsrcs_ bw_
 88 
 89         set i [expr 8 * $avgsize_ * $nsrcs_ / $bw_]
 90         if {$rand != 0} {
 91                 # random in U[2/3,4/3] as per SAP spec
 92                 set r1 [expr [random]/double(0x7fffffff)]
 93                 set r2 [expr ($r1*2.0/3.0) + 2.0/3.0]
 94                 set i [expr int($i*$r2)]
 95         }
 96         #FIXME
 97         if {$i < 5} {
 98                 set i 5
 99         }
100         return $i
101 }
102 
103 #
104 AnnounceListenManager/SAP/Nsdr public start {msg} {
105         $self instvar nsrcs_
106         incr nsrcs_
107         $self timer $msg [new Timer/Adaptive/SAP $self]
108         $self next $msg
109 }
110 
111 #
112 AnnounceListenManager/SAP/Nsdr private send_announcement {msg} {
113         set text [$msg set msgtext_]
114         $self sample_size [string length $text]
115         $self announce $text
116 }
117 
118 
119 # Retrieves program descriptions via the Session Announcement
120 # Protocol (SAP).
121 Class ProgramSource/SAP -superclass ProgramSource
122 
123 # Initializes a new object.  <i>ui</i> is passed on to
124 # ProgramSource::init.  <i>bw</i> is the aggregate bandwidth
125 # allocate to the SAP channel (which is used for determining
126 # the timeout interval as well as for announcing new programs).
127 # <i>args</i> contains a list of  multicast scope zones
128 # (e.g., 224.2.128.0/17 for global sap) within which this
129 # object should listen for SAP announcements.
130 ProgramSource/SAP public init {ui args} {
131         $self next $ui
132 
133         $self instvar scopes_ addrs_ cache_ announce_file_
134         set scopes_ {}
135         set addrs_ {}
136         foreach scope $args {
137                 lappend scopes_ $scope
138                 set al [new AnnounceListenManager/SAP/Nsdr $self 2048 $scope]
139                 lappend addrs_ $al
140         }
141 
142         #FIXME need a way to disable this
143         set dir [$self get_option cachedir]
144         if {![info exists cache_] && $dir != ""} {
145                 set o [$self options]
146                 set addr [$o get_option SAPaddress]
147                 set cache_ [file join $dir global-$addr]
148         }
149         $self readcache
150         set write_interval [$self get_option cacheWriteInterval]
151         if {$write_interval != ""} {$self periodic-writecache $write_interval }
152 
153         #FIXME
154         set a [lindex $addrs_ 0]
155         if {$a == ""} {
156                 set announce_file_ ""
157         } else {
158                 set if [[$a set snet_] interface]
159                 set announce_file_ [file join $dir announce-$if]
160         }
161 
162         if [file readable $announce_file_] {
163                 $self instvar sdp_
164 
165                 set fp [open $announce_file_ r]
166                 set msgs [$sdp_ parse [read $fp]]
167                 close $fp
168 
169                 file delete $announce_file_
170 
171                 foreach m $msgs {
172                         set p [new Program $m]
173                         $self announce $p
174                 }
175         }
176 }
177 
178 #
179 ProgramSource/SAP public destroy {} {
180         $self next
181         $self instvar addrs_
182         foreach a $addrs_ { delete $a }
183 }
184 
185 # Used to set the name of the tag for this program source in the
186 # user interface.
187 ProgramSource/SAP public name {} {
188         return "SAP: Global"
189 }
190 
191 # Returns the list of scopes this object knows about
192 ProgramSource/SAP public scopes {} {
193         return [$self set scopes_]
194 }
195 
196 # Called by an AnnounceListenManager/SAP/Nsdr object when an
197 # announcement is received.  Invokes ProgramSource::recv
198 # and then sets a timeout on this announcement.
199 ProgramSource/SAP public recv {child addr port data size} {
200         # keep nsrcs_ array up to date for this child by watching the
201         # change in the size of the progs_ array when the message is
202         # processed.
203         $self instvar progs_
204         set old [array size progs_]
205         set objs [$self next $data]
206         $child incrnsrcs [expr [array size progs_] - $old]
207 
208         # update average announcement size
209         $child sample_size $size
210 
211         # set timeouts
212         $self instvar progs_ timeouts_
213         foreach o $objs {
214                 # calculate timeout with a minimum of 30 mins as per sap spec
215                 set t [expr 10 * [$child interval 0]]
216                 if {$t < 1800} { set t 1800 }
217 
218                 $self timeout $o $t
219         }
220 }
221 
222 # hack since tcl expr can't do unsigned comparison
223 ProgramSource/SAP private timestamp-gt {a b} {
224         if {$b == 0} { return 1 }
225         if {$a > 0 && $b < 0} { return 0 }
226         return [expr $a > $b]
227 }
228 
229 #
230 ProgramSource/SAP public announce {prog} {
231         $self instvar announce_file_ rcvr_
232 
233         foreach msg [$prog set msgs_] {
234                 set al [$self alof $msg]
235                 $al start $msg
236 
237                 if {$announce_file_ != ""} {
238                         if [catch {set fp [open $announce_file_ a]} m] {
239                                 $self warn "couldn't open announcements file\
240                                                 for writing: $m"
241                                 continue
242                         }
243                         puts $fp [$msg set msgtext_]
244                         close $fp
245                 }
246         }
247 
248         $rcvr_ addprog $self $prog
249 
250         set end 0
251         foreach t [[$prog base] set alltimedes_] {
252                 set newend [$t set endtime_]
253                 if [$self timestamp-gt $newend $end] { set end $newend }
254         }
255         if {$end != 0} {
256                 set wait [expr $end - 2208988800 - [clock seconds]]
257                 if {$wait <= 0} {
258                         $self stop-announce $prog
259                 } else {
260                         after [expr int($wait * 1000)] "$self stop-announce $prog"
261                 }
262         }
263 }
264 
265 #
266 ProgramSource/SAP public stop-announce {prog} {
267         $self instvar announce_file_ sdp_ rcvr_
268 
269         foreach msg [$prog set msgs_] {
270                 set al [$self alof $msg]
271                 $al stop $msg
272 
273                 set backup $announce_file_
274                 append backup "~"
275                 file delete $backup
276                 set backup_good 1
277                 if {[catch {file copy $announce_file_ $backup} m] \
278                                 || [catch {set fp [open $backup r]} m] \
279                                 || [catch {set fp2 [open $announce_file_ w]} m]} {
280                         $self warn "couldn't fix announcement file: $m"
281                         set backup_good 0
282                         continue
283                 }
284 
285                 set buffer ""
286                 while { ![eof $fp] } {
287                         set line [gets $fp]
288                         if {![eof $fp] && [string compare $line "v=0"] != 0} {
289                                 append buffer $line
290                                 append buffer \n
291                                 continue
292                         }
293 
294                         if {[string trim $buffer] != ""} {
295                                 #FIXME
296                                 set msg2 [$sdp_ parse $buffer]
297                                 if {[$msg unique_key] != [$msg2 unique_key]} {
298                                         puts $fp2 $buffer
299                                 }
300                                 delete $msg2
301                         }
302 
303                         set buffer $line
304                         append buffer \n
305                 }
306                 close $fp
307                 close $fp2
308 
309                 if {![file size $announce_file_]} {
310                         file delete $announce_file_
311                 }
312                 if {$backup_good} {
313                         file delete $backup
314                 }
315         }
316 
317         $rcvr_ removeprog $self $prog
318 }
319 
320 # FIXME should be elsewhere
321 ProgramSource/SAP private alof {msg} {
322         $self instvar scopes_ addrs_
323 
324         #FIXME
325         if [$msg have_field c] {
326                 set addr [$msg set caddr_]
327         } else {
328                 set media [lindex [$msg set allmedia_] 0]
329                 set addr [$media set caddr_]
330         }
331         set addr [lindex [split $addr /] 0]
332 
333         set i 0
334         set found 0
335         set len [llength $scopes_]
336         while {$i < $len} {
337                 set scope [lindex $scopes_ $i]
338                 if [$scope contains $addr] {
339                         set found 1
340                         break
341                 }
342                 incr i
343         }
344         if {$found == 0} {
345                 $self fatal "Program/SAP got address ($addr) not in any known scope"
346         }
347 
348         return [lindex $addrs_ $i]
349 }
350 

~ [ 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.