1
2 import Application SessionAddress TrafficSource TrafficSink mashutils
3
4 #XXX
5 import NetworkManager
6
7 Class FakeSessionAndAgent
8 FakeSessionAndAgent instproc init { } {
9 $self set net_ ""
10 }
11
12 FakeSessionAndAgent instproc network { } {
13 return [$self set net_]
14 }
15
16 FakeSessionAndAgent instproc data-net { net channel } {
17 if { $channel != 0 } {
18 puts stderr "Got data-net for unexpected channel $channel"
19 return
20 }
21 $self set net_ $net
22 }
23
24 # ignore these
25 FakeSessionAndAgent instproc set_maxchannel { n } { }
26 FakeSessionAndAgent instproc ctrl-net { net channel } { }
27 FakeSessionAndAgent instproc send-rtcp { s } { }
28
29 Class NetTestApplication -superclass Application
30
31 NetTestApplication instproc init argv {
32 $self next nettest
33
34 set o [$self options]
35 $o add_default haveSource 0
36 $o add_default haveSink 1
37 $o add_default runTime 0
38 $o add_default printInterval 0
39
40 $o register_boolean_option -source haveSource
41 $o register_boolean_option -nosource haveSource 0
42 $o register_boolean_option -sink haveSink
43 $o register_boolean_option -nosink haveSink 0
44 $o register_option -runfor runTime
45 $o register_option -printinterval printInterval
46
47
48 set argv [$o parse_args $argv]
49 if { [llength $argv] != 1 } {
50 $self usage
51 exit 1
52 }
53
54 $self instvar net_ source_ sink_ print_interval_
55 set addr [SessionAddress parse $argv]
56 set crap [new FakeSessionAndAgent]
57 set net_ [new [$addr net-class] $addr $crap $crap]
58
59 set print_interval_ [$self get_option printInterval]
60 set runtime [$self get_runtime]
61
62
63 if [$o get_option haveSource] {
64 set source_ [new TrafficSource]
65 $source_ network [$crap network]
66
67 #XXX
68 # $source_ rate ...
69 # $source_ pkt_size ...
70
71 puts "Source sending at [$source_ rate] bps, packet size [$source_ pkt_size]"
72 $source_ start
73 }
74
75 if [$o get_option haveSink] {
76 set sink_ [new TrafficSink]
77 $sink_ network [$crap network]
78
79 if { $print_interval_ == 0 && $runtime == 0 } {
80 set print_interval_ 2000
81 }
82 if { $print_interval_ != 0 } {
83 $self schedule-print
84 }
85 }
86
87 if { $runtime != 0 } {
88 after [expr 1000 * $runtime] "$self print-stats; exit"
89 }
90 }
91
92 NetTestApplication instproc usage { } {
93 puts stderr "XXX usage"
94 }
95
96
97 NetTestApplication instproc get_runtime { } {
98 set t [$self get_option runTime]
99 if { [regexp {([0-9]+) second} $t x s] } {
100 set t $s
101 } elseif { [regexp {([0-9]+) minute} $t x m] } {
102 set t [expr 60 * $m]
103 } elseif { [regexp {([0-9]+) hour} $t x h] } {
104 set t [expr 3600 * $m]
105 } elseif { [catch {expr $t}] } {
106 puts stderr "Can't parse runtime arg $t"
107 exit 1
108 }
109 return $t
110 }
111
112
113 NetTestApplication instproc schedule-print { } {
114 $self instvar print_interval_
115 after $print_interval_ "$self periodic-print"
116 }
117
118 NetTestApplication instproc periodic-print { } {
119 $self print-stats
120 $self schedule-print
121 }
122
123 NetTestApplication instproc format-lossrate { l } {
124 # XXX copied from tcl/vic/ui-main.tcl
125 if { $l < .1 } {
126 return "0%"
127 } elseif { $l < 9.9 } {
128 return [format "%.1f%%" $l]
129 } else {
130 return [format "%.0f%%" $l]
131 }
132 }
133
134 NetTestApplication instproc print-stats { } {
135 $self instvar sink_ net_
136
137 catch {$net_ print-stats}
138
139 set allstats [$sink_ get-all-stats]
140 foreach stat $allstats {
141 set src [lindex $stat 0]
142 set pkts [lindex $stat 1]
143 set drops [lindex $stat 2]
144 set rate [format_bps [lindex $stat 3]]
145 set lossrate [$self format-lossrate [lindex $stat 4]]
146
147 puts "Source $src has $pkts packets, $drops drops, rate $rate, lossrate $lossrate"
148 }
149
150 if { [llength $allstats] == 0 } {
151 puts "have no sources yet..."
152 }
153 }
154
155 new NetTestApplication $argv
156 vwait forever
157
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.