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

Open Mash Cross Reference
mash/tcl/srmv2/source-srmv2.tcl

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

  1 # source-srmv2.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-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 Timer/Periodic
 32 Class SRMv2_RReqTimer -superclass Timer/Periodic
 33 
 34 SRMv2_RReqTimer instproc init { range agent } {
 35         $self instvar agent_ range_
 36         set agent_ $agent
 37         set range_ $range
 38         $self next
 39 
 40         # Weight (C2/C1) = 1 now.
 41         $self randomize "yes" 1
 42 }
 43 
 44 
 45 # Exponential backoff
 46 SRMv2_RReqTimer instproc timeout { } {
 47         $self instvar agent_ range_ period_
 48         $self instvar id_
 49 
 50 #       [$agent_ set session_] send-rreq $id_ $range_
 51         set period_ [expr 2 * $period_]
 52 }
 53 
 54 SRMv2_Source instproc oid { name } {
 55         $self instvar oid_
 56         if [info exists oid_($name)] {
 57                 return $oid_($name)
 58         }
 59 }
 60 
 61 SRMv2_Source instproc last { name } {
 62         $self instvar last_
 63         if [info exists last_($name)] {
 64                 return $last_($name)
 65         } else {
 66                 return 0
 67         }
 68 }
 69 
 70 SRMv2_Source instproc oid-exists { name } {
 71         $self instvar oid_
 72         return [info exists oid_($name)]
 73 }
 74 
 75 SRMv2_Source instproc name { oid } {
 76         $self instvar names_
 77         if [info exists names_($oid)] {
 78                 return $names_($oid)
 79         }
 80 }
 81 
 82 #
 83 # Create an oid
 84 #
 85 SRMv2_Source instproc create-oid { name } {
 86         $self instvar oid_ names_ cnt_ prio_ last_
 87 
 88         incr cnt_
 89         set names_($cnt_) $name
 90         set oid_($name) $cnt_
 91 
 92         set last_($name) 0
 93         set prio_($name) 1
 94         set rreq_($name) {}
 95 
 96         return $cnt_
 97 }
 98 
 99 # Gaps is a sorted list of missing ranges (start, end),
100 # both included in the range.
101 # The source ID is now the traditional IP address + user ID + instance
102 # This will become a variable length source address.
103 
104 SRMv2_Source instproc init-vars { session srcID } {
105         $self instvar cnt_ ns_ max_announce_ session_
106         $self instvar id_
107 
108         set max_announce_ 10
109         set cnt_ 0
110         set session_ $session
111         set id_ $srcID
112 
113         random 0
114 }
115 
116 #
117 # combo has the format oid:name
118 #
119 SRMv2_Source instproc add-binding { combo id } {
120         $self instvar oid_ rreq_ names_ last_ cnt_
121 
122         set l [split $combo ":"]
123         set name [lindex $l 0]
124         set oid [lindex $l 1]
125 
126         set oid_($name) $oid
127         set names_($oid) $name
128         set last_($name) 0
129         set rreq_($name) {}
130 
131         #
132         # Detect missing binds and generate
133         # a repair request.
134         #
135 
136         if {$oid - $cnt_  != 1}  {
137                 $self send-rreq $id 0 ($cnt_+1) ($oid-1)
138                 set cnt_ $oid
139         }
140 }
141 
142 # Increase the priority of this
143 # Object since it was changed since the
144 # last time it's state was announced.
145 # This is unused if the agent represents a remote
146 # data source. We really should fix this, since
147 # ours is a "scalable" reliable multicast toolkit.
148 SRMv2_Source instproc update-objinfo { oid first last } {
149         $self instvar prio_ last_
150         $self instvar is_
151 
152         set name [$self name $oid]
153 
154         incr prio_($name)
155 
156         # If some bytes were missing, send an
157         # SRMv2 repair request
158         if {$first - $last_($name) > 1} {
159                 $self send-rreq $id_ $oid ($last_($name)+1) ($first-1)
160         }
161 
162         # Update last only if the data is new
163         if {$last > $last_($name)} {
164                 set last_($name) $last
165         }
166 }
167 
168 
169 SRMv2_Source instproc get-recent { } {
170         $self instvar prio_ max_announce_
171 
172         set cdf 0
173         foreach name [array names prio_] {
174                 set cdf [expr $cdf + $prio_($name)]
175         }
176         set hits { }
177         set probs { }
178 
179         for {set i 0} {$i < $max_announce_} {incr i} {
180                 set r [expr [random]/double(0x7fffffff) * $cdf]
181                 lappend probs $r
182         }
183         lsort -real $probs
184         set index 0
185         set cdf   0
186         foreach name [array names prio_] {
187                 set start $cdf
188                 set cdf  [expr $cdf + $prio_($name)]
189                 set curr [lindex $probs $index]
190 #puts "$start <= $curr <= $cdf"
191                 if [expr ($start <= $curr) && ($curr <= $cdf)] {
192                         set l [$self last $name]
193                         lappend hits "$name:$l"
194                         # Set it back to the base value (1)
195                         # since this is the beginning of the next
196                         # session announcement cycle.
197                         set prio_($name) 1
198                         incr index
199                 }
200         }
201         return $hits
202 }
203 
204 
205 SRMv2_Source instproc detect-loss { oid left right } {
206         $self instvar last_ rreq_ names_
207 
208         set name [$self name $oid]
209 #       puts "detect-loss $left $right $last_($name)"
210 
211         if {$right < 0 || $left < 0 }  {
212                 puts "Invalid range $left-$right"
213                 return
214         }
215         if {$left == [expr $last_($name) + 1]} {
216                 set last_($name) $right
217                 return;
218         }
219 
220         #
221         # Handle the first case specially
222         #
223         puts "rreqs($name) : $rreq_($name)"
224         if {$last_($name) < $left} {
225                 set r "$oid:[expr $last_($name)+1]-[expr $left-1]"
226                 set id [new SRMv2_RReqTimer $r $self]
227                 $id start 1000
228                 puts "id = $id"
229                 set rreq_($name) [linsert $rreq_($name) end \
230                                 [list [expr $last_($name)+1] [expr $left-1] $id]]
231                 set last_($name) $right
232                 puts "Inserting range [expr $last_($name)+1] [expr $left-1] $id"
233                 return
234         }
235         set last_($name) $right
236         for {set i 0} {$i < [llength $rreq_($name)]} {incr i} {
237                 set start [lindex 0 $g]
238                 set end   [lindex 1 $g]
239 
240                 if {$right <= $start} {
241                         break
242                 }
243                 if {$left > $end} {
244                         continue
245                 }
246                 if {$left <= $start && $right >= $end} {
247                         lreplace rreq_($name) $i $i
248                         puts "In splitting."
249                         if {$left != $start} {
250                                 set split_right [list ($right+1) $end]
251                                 set rreq_($name) [linsert $rreq_($name) $i $split_right]
252                         }
253                         if {$left != $start} {
254                                 set split_left [list $start ($left-1)]
255                                 set rreq_($name) [linsert $rreq_($name) $i $split_left]
256                         }
257                         return
258                 }
259         }
260 
261         # We'll worry about the remaining conditions later,
262         # since they currently won't occur in our protocol.
263 }
264 
265 

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