1 # application-megatest.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 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/megatest/application-megatest.tcl,v 1.8 2002/02/03 04:27:46 lim Exp $
32
33 #import Application AnnounceListenManager/MeGa/Client/Video Network
34 import Application AnnounceListenManager/MeGa/Client Network
35
36 Class MeGaTester -superclass Application
37
38 MeGaTester public init argv {
39 $self next megatester
40
41 set o [$self options]
42 $self init_args $o
43 $self init_resources $o
44 $o parse_args $argv
45 $self init_local
46
47 $self init_test
48 }
49
50 MeGaTester private init_args o {
51 $self next $o
52
53 $o register_boolean_option -diff diffSession
54
55 $o register_option -ngw gwNum
56 $o register_option -int interval
57 $o register_option -megactrl megaCtrl
58 $o register_option -maxsbw maxSessionBW
59 $o register_option -unicast unicast
60 }
61
62 MeGaTester private init_resources o {
63 $self next $o
64
65 # MeGa Resources
66 $o add_default megaCtrl 224.4.5.24/50000/1
67 # multicast is default
68 $o add_default megaRecvPort 0
69
70 # (scuba) default session bandwidth (kb/s).
71 $o add_default maxSessionBW 1000000
72
73 # 60 seconds max startup wait for first message
74 $o add_default megaStartupWait 60
75
76 $o add_default interval 5000
77 $o add_default gwNum 1
78 }
79
80 MeGaTester private init_test {} {
81
82 $self instvar int_ gwnum_ port_ specs_
83 set int_ [$self get_option interval]
84 set gwnum_ [$self get_option gwNum]
85 set port_ 10000
86 set specs_ 5000
87
88 set i 0
89 while { $i < $gwnum_ } {
90 after [expr int($i*$int_+0.5)] "$self start_client $i"
91 incr i
92 }
93 }
94
95 MeGaTester private start_client id {
96 $self instvar port_ clients_ specs_
97
98 if { [$self get_option unicast] == "" } {
99 set rportspec 0
100 set megaspec [$self get_option megaCtrl]
101 } else {
102 set ctrlrport [expr $port_ + 2]
103 set rportspec $port_:$ctrlrport
104 incr port_ 4
105 set addr [intoa [lookup_host_addr [$self get_option unicast]]]
106 set megaspec [$self get_option megaCtrl]
107 # set megaspec $addr/60000:$ctrlrport/1
108 }
109 if { [$self get_option diffSession] != "" } {
110 incr specs_ 1
111 }
112 set sname test:$specs_:0:IN:IP4:test
113 set a [expr 10 + (($specs_ / (256*256)) % 256)]
114 set b [expr ($specs_ / 256) % 256]
115 set c [expr $specs_ % 256]
116 set sspec 224.$a.$b.$c/4444/1
117 puts "new TestClient $sname $sspec $megaspec $rportspec"
118 set clients_($id) [new TestClient $sname $sspec $megaspec $rportspec]
119 }
120
121 Class TestClient
122
123 TestClient public init { sname sspec megaspec rportspec } {
124 $self next
125
126 $self instvar al_ sessionbw_
127 set sessionbw_ [$self get_option maxSessionBW]
128 set bw [expr 0.02*$sessionbw_]
129 set al_ [new AnnounceListenManager/MeGa/Client $self $self \
130 $megaspec $bw megatest sdp $sname $sspec \
131 $rportspec h261 ]
132 $al_ start 1
133 }
134
135 TestClient private reset_spec s {
136 $self instvar cn_ dn_
137
138 set s [split $s /]
139 set addr [lindex $s 0]
140 set ports [split [lindex $s 1] :]
141 set sport [lindex $ports 0]
142 set rport [lindex $ports 1]
143 set ttl [lindex $s 3]
144 set dn_ [new Network]
145 $dn_ open $addr $sport $rport $ttl
146 set cn_ [new Network]
147 $cn_ open $addr [expr $sport + 1] [expr $rport + 1] $ttl
148 }
149
150 TestClient private have_network {} {
151 $self instvar dn_
152 return [info exists dn_]
153 }
154
155 TestClient private session-addr {} {
156 $self instvar dn_
157 if ![$self have_network] {
158 return none
159 }
160 return [$dn_ addr]
161 }
162
163 TestClient private session-sport {} {
164 $self instvar dn_
165 if ![$self have_network] {
166 return none
167 }
168 return [$dn_ sport]
169 }
170
171 TestClient private session-rport {} {
172 $self instvar dn_
173 if ![$self have_network] {
174 return none
175 }
176 return [$dn_ rport]
177 }
178
179 TestClient private session-ttl {} {
180 $self instvar dn_
181 if ![$self have_network] {
182 return none
183 }
184 return [$dn_ ttl]
185 }
186
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.