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

Open Mash Cross Reference
mash/tcl/as/al-platform.tcl

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

  1 # al-platform.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1999-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/as/al-platform.tcl,v 1.6 2002/02/26 20:41:40 weitsang Exp $
 32 
 33 
 34 import AnnounceListenManager/AS Timer/Adaptive/ConstBW
 35 
 36 # Modifications to hm so that AS1 platforms can communicate on a global
 37 # multicast channel and be aware of the presence of other AS1 platforms.
 38 # Useful for wide-area services like distributed recording.
 39 Class AnnounceListenManager/AS/Platform -superclass AnnounceListenManager/AS
 40 
 41 AnnounceListenManager/AS/Platform instproc init { agent spec bw helper} {
 42         $self next $spec $bw platform
 43         $self set agent_ $agent
 44 
 45         set t [new Timer/Adaptive/ConstBW/2step $bw 30000]
 46         $t randomize
 47         set h [$helper get_timer]
 48         #puts "helper timer = $h"
 49         $t local_helper $h
 50         $self timer $t
 51         $t threshold 10000
 52 }
 53 
 54 # Platform keeps track of the number of hosts in it's local platform,
 55 # plus the number of platforms world wide
 56 AnnounceListenManager/AS/Platform instproc recv_announcement { addr port data size } {
 57         $self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_ agent_
 58         set t [$self get_timer]
 59         $t sample_size $size
 60 #puts ""
 61 #puts "$self ($class): recv {$data}"
 62 #puts ""
 63         #puts "^^^ [AnnounceListenManager/AS info body version]"
 64         #puts "^^^heritage is [$class info heritage]"
 65         #puts "version is [$class version]"
 66         set o [split $data \n]
 67         if { [lindex $o 0] != "ASCP v[AnnounceListenManager/AS version]" } {
 68                 # FIXME
 69                 set msg "$self ($class): received non-ASCP v[AnnounceListenManager/AS version] announcement from $addr."
 70                 if { $atype_ == "hm" } {
 71                         $self instvar agent_
 72                         $agent_ log $msg
 73                 } else {
 74                         puts stderr $msg
 75                 }
 76 
 77                 return
 78         }
 79         set atype [lindex $o 1]
 80         set aspec [lindex $o 2]
 81         set srv_name [lindex $o 3]
 82         set srv_loc [lindex $o 4]
 83         set srv_inst [lindex $o 5]
 84         set ssg_port [lindex $o 6]
 85         set ad [join [lrange $o 7 end] \n]
 86 
 87         # Special case death packet.
 88         if { $srv_name == "DEATH" } {
 89                 set msg "Received death packet from $aspec at $addr - exiting."
 90                 if { $srv_loc == $atype_ } {
 91                         if { $atype_ == "hm" } {
 92                                 $self instvar agent_
 93                                 $agent_ log $msg
 94                         } else {
 95                                 puts stderr $msg
 96                         }
 97                         $self announce_death
 98                         exit 0
 99                 }
100                 $self recv_msg $atype $aspec $addr DEATH $srv_loc \
101                         $srv_inst $ssg_port "$ad"
102                 return
103         }
104         # Synchronous bye
105         if { $srv_name == "bye" } {
106                 $self delete_agent $aspec
107                 return
108         }
109 
110         #if ![info exists agenttab_($aspec)] 
111 
112         set pid [lindex [split $aspec @] 0]
113         #puts "pid=$pid"
114         set platformid [lindex [split $aspec @] 1]
115         #puts "platformid=$platformid"
116         set aspec $platformid
117         if ![info exists agenttab_($platformid)] {
118                 # new platform
119                 $self instvar avgdelta_
120                 $self register $atype $aspec $addr $srv_name $srv_inst "$ad"
121                 $t incr_nsrcs
122                 set timeout [$self get_option startupWait]
123                 set avgdelta_($aspec) [expr $timeout / 8]
124                 lappend agentbytype_($atype) $aspec
125 
126 
127         } else {
128                 set now [gettimeofday]
129                 set delta [expr $now - $lastann_($aspec,abs)]
130                 $self instvar avgdelta_
131                 set avgdelta_($platformid) \
132                                 [expr 0.875*$avgdelta_($aspec)+0.125*$delta]
133 
134         }
135         set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
136         set lastann_($aspec,abs) [gettimeofday]
137         set lastann_($aspec,ascii) [gettimeofday ascii]
138         $self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
139                         $ssg_port "$ad"
140 }
141 
142 
143 AnnounceListenManager/AS/Platform instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
144         $self instvar agent_
145 
146         # For now, this is the only type of message we should be
147         # recving on the global channel
148         switch $atype {
149                 platform {
150 
151                 }
152                 default {
153                         puts "Error: atype=$atype"
154                         exit
155                 }
156         }
157 
158 }
159 
160 #
161 # We build a simple message since we only use this to announce
162 # our presence.
163 AnnounceListenManager/AS/Platform instproc send_announcement {} {
164         $self instvar id1_ id2_
165 
166         set o "ASCP v[AnnounceListenManager/AS version]"
167         set n platform
168         set o $o\n$n
169         set n [$self agent_instance]
170         set o $o\n$n
171         set n -
172         set o $o\n$n
173         set n -
174         set o $o\n$n
175         set n -
176         set o $o\n$n
177         set n -
178         set o $o\n$n
179 
180         $self announce $o
181 }
182 
183 # When you hear from another platform, there's only one message type, update
184 # Is there anything we have to do here?
185 # Everything else taken care of in recv_announcement?
186 AnnounceListenManager/AS/Platform instproc handle_platform_msg { aspec msg addr srv_name srv_inst } {
187         $self instvar agent_
188 
189         switch $srv_name {
190 
191         }
192 
193 
194 }
195 
196 # Instead of sending our instance, send platform id
197 AnnounceListenManager/AS/Platform public agent_instance {} {
198         $self instvar agent_
199         return "[pid]@[$agent_ get_option megaCtrl]"
200 }
201 
202 # For now, do nothing, but agent should be notified, keep list of platforms/attributes
203 AnnounceListenManager/AS/Platform instproc register { atype aspec addr srv_name srv_inst msg } {
204         $self instvar agent_
205 
206 }
207 
208 AnnounceListenManager/AS/Platform instproc unregister { atype aspec addr srv_name srv_inst ad } {
209         $self instvar agent_
210 
211 }
212 
213 
214 #
215 #
216 #
217 
218 # Timer divided among 2 variables, global (num platforms) and local (num hosts)
219 Class Timer/Adaptive/ConstBW/2step -superclass Timer/Adaptive/ConstBW
220 
221 
222 
223 
224 
225 # Set the helper timer which is to be contacted to determine how many local
226 # sources are sharing the announcement responsibility
227 Timer/Adaptive/ConstBW/2step public local_helper { local } {
228         $self instvar local_
229         set local_ $local
230 }
231 
232 
233 
234 # This method recomputes the new timeout interval
235 Timer/Adaptive/ConstBW/2step private adapt {interval} {
236         $self instvar avgsize_ bw_ nsrcs_ local_ thresh_
237 
238         set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
239         set l [expr [$local_ nsrcs 0] + 1]
240         set t [expr $t / $l]
241         if { $t < $thresh_ } {
242                 return $thresh_
243         } else {
244                 return $t
245         }
246 }
247 

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