1 # snap-api.tcl --
2 #
3 # OTcl class wrappers for SRMv2 API
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 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/snap-api.tcl,v 1.4 2002/02/03 04:25:43 lim Exp $
32
33
34 Class SRMv2_Session
35 Class SRMv2_Source
36
37
38 SRMv2_Session instproc init {addr sport rport {ttl 16}} {
39 $self next
40
41 $self instvar addr_ sport_ ttl_ rport_
42 set addr_ $addr
43 set sport_ $sport
44 set rport_ $rport
45 set ttl_ $ttl
46
47 $self instvar srm_session_
48 set srm_session_ [srm_create_session $addr $sport $rport $ttl]
49
50 if { $srm_session_ == {} } return
51 srm_callbacks $srm_session_ "$self callback srm_recv" \
52 "$self callback srm_should_recover" \
53 "$self callback srm_read_adu" \
54 "$self callback srm_source_update" \
55 "$self callback srm_recv_cid"
56 }
57
58
59 SRMv2_Session public destroy {} {
60 $self instvar srm_session_
61 # FIXME: must destroy all source otcl objects as well
62 if { $srm_session_ != {} } {
63 srm_destroy_session $srm_session_
64 }
65 $self next
66 }
67
68
69 SRMv2_Session public srm_session {} {
70 return [$self set srm_session_]
71 }
72
73
74 SRMv2_Session public reset {addr sport rport {ttl 16}} {
75 $self instvar srm_session_
76 return [srm_reset_session $srm_session_ reset $addr $sport $rport $ttl]
77 }
78
79
80 SRMv2_Session public delay_until_full_packet { {flag {}} } {
81 $self instvar srm_session_
82 if { $flag=={} } {
83 return [srm_delay_until_full_packet $srm_session_]
84 } else {
85 return [srm_delay_until_full_packet $srm_session_ $flag]
86 }
87 }
88
89
90 SRMv2_Session public bandwidth { {bps {}} } {
91 $self instvar srm_session_
92 if { $bps=={} } {
93 return [srm_session_bandwidth $srm_session_]
94 } else {
95 srm_session_bandwidth $srm_session_ $bps
96 }
97 }
98
99
100 SRMv2_Session public drop_probability { {dropProb {}} } {
101 $self instvar srm_session_
102 if { $dropProb=={} } {
103 return [srm_drop_probability $srm_session_]
104 } else {
105 return [srm_drop_probability $srm_session_ $dropProb]
106 }
107 }
108
109
110 SRMv2_Session public callback_object { args } {
111 $self instvar srm_session_ callback_obj_
112 if { [llength $args]==0 } {
113 if [info exists callback_obj_] {
114 return $callback_obj_
115 } else {
116 return {}
117 }
118 } else {
119 set object [lindex $args 0]
120 if { $object=={} } {
121 catch { unset callback_obj_ }
122 } else {
123 set callback_obj_ $object
124 }
125 }
126 }
127
128
129 SRMv2_Session private callback { method srm_source args } {
130 $self instvar callback_obj_ sources_
131 if [info exists callback_obj_] {
132 set obj $callback_obj_
133 } else { set obj $self }
134
135 if ![info exists sources_($srm_source)] {
136 SRMv2_Source create_remote_source $self $srm_source
137 }
138
139 eval [list $obj] [list $method] $sources_($srm_source) $args
140 }
141
142
143 SRMv2_Session private new_source { srm_source src } {
144 $self instvar sources_
145 set sources_($srm_source) $src
146 }
147
148
149 SRMv2_Session public srm_recv { src cid seqno data } {
150 }
151
152
153 SRMv2_Session public srm_should_recover { src cid sseq eseq } {
154 return 1
155 }
156
157
158 SRMv2_Session public srm_read_adu { src cid seqno } {
159 error "application must redefine the SRMv2_Session::srm_read_adu\
160 method"
161 }
162
163
164 SRMv2_Session public srm_source_update { src info } {
165 }
166
167
168 SRMv2_Session public srm_recv_cid { src cid parent name } {
169 }
170
171
172 SRMv2_Source public init { args } {
173 SRMv2_Source instvar remotesrc_
174 $self instvar srm_source_ sess_
175 if ![info exists remotesrc_] {
176 # we are creating a local source
177 set sess_ [lindex $args 0]
178 set srcid [lindex $args 1]
179 if { $srcid=={} } {
180 set srm_source_ [srm_create_source \
181 [$sess_ srm_session]]
182 } else {
183 set srm_source_ [srm_create_source \
184 [$sess_ srm_session] $srcid]
185 }
186 } else {
187 # we are creating a remote source
188 set sess_ [lindex $args 0]
189 set srm_source_ [lindex $args 1]
190 }
191
192 $sess_ new_source $srm_source_ $self
193 }
194
195
196 SRMv2_Source proc.private create_remote_source { sess srm_source } {
197 $self instvar remotesrc_ remotesrc_cnt_
198 set remotesrc_ 1
199 if ![info exists remotesrc_cnt_] { set remotesrc_cnt_ 0 }
200 incr remotesrc_cnt_
201
202 # don't want to use "new" here coz I want this code to be
203 # otcl-only (and otcl doesn't have the "new" proc)
204 set s [SRMv2_Source _o_srmv2src$remotesrc_cnt_ $sess $srm_source]
205 unset remotesrc_
206 $sess new_source $srm_source $s
207 return $s
208 }
209
210
211 SRMv2_Source public destroy {} {
212 # FIXME: what should we do here
213 $self next
214 }
215
216
217 SRMv2_Source public srm_source {} {
218 return [$self set srm_source_]
219 }
220
221
222 SRMv2_Source public session {} {
223 return [$self set sess_]
224 }
225
226
227 SRMv2_Source public app_info { args } {
228 $self instvar srm_source_
229 if {[llength $args] > 0} {
230 srm_app_info $srm_source_ [lindex $args 0]
231 } else {
232 return [srm_app_info $srm_source_]
233 }
234 }
235
236
237 SRMv2_Source public calloc { {parent_cid 0} {name {}} } {
238 $self instvar srm_source_
239 return [srm_calloc $srm_source_ $parent_cid $name]
240 }
241
242
243 SRMv2_Source public get_container_name { cid } {
244 $self instvar srm_source_
245 return [srm_get_container_name $srm_source_ $cid]
246 }
247
248
249 SRMv2_Source public get_parent_cid { cid } {
250 $self instvar srm_source_
251 return [srm_get_parent_cid $srm_source_ $cid]
252 }
253
254
255 SRMv2_Source public send { cid data } {
256 $self instvar srm_source_
257 return [srm_send $srm_source_ $cid $data]
258 }
259
260
261 SRMv2_Source public recover { cid sseq eseq } {
262 $self instvar srm_source_
263 return [srm_recover $srm_source_ $cid $sseq $eseq]
264 }
265
266
267 SRMv2_Source public source_id { } {
268 $self instvar srm_source_
269 return [srm_get_source_id $srm_source_]
270 }
271
272
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.