File: test-suite-srm.tcl

package info (click to toggle)
ns2 2.35%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 78,796 kB
  • sloc: cpp: 172,923; tcl: 107,130; perl: 6,391; sh: 6,143; ansic: 5,846; makefile: 816; awk: 525; csh: 355
file content (350 lines) | stat: -rw-r--r-- 9,131 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
#
# Copyright (c) 1998 University of Southern California.
# All rights reserved.                                            
#                                                                
# Redistribution and use in source and binary forms are permitted
# provided that the above copyright notice and this paragraph are
# duplicated in all such forms and that any documentation, advertising
# materials, and other materials related to such distribution and use
# acknowledge that the software was developed by the University of
# Southern California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived from
# this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
# 


# This test suite is for validating SRM
# To run all tests: test-all-srm
# to run individual test:
# ns test-suite-srm.tcl srm-chain
# ns test-suite-srm.tcl srm-star
# ....
#
# To view a list of available test to run with this script:
# ns test-suite-srm.tcl
#

#remove-all-packet-headers       ; # removes all except common
#add-packet-header Flags IP TCP SRM aSRM SRMEXT; 
# hdrs reqd for validation test

Class TestSuite

Class Test/srm-chain -superclass TestSuite
# Simple chain topology

Class Test/srm-star -superclass TestSuite
# Simple star topology

Class Test/srm-adapt-rep -superclass TestSuite
# simple 8 node star topology, runs for 10s, tests Adaptive repair timers.

Class Test/srm-adapt-req -superclass TestSuite
# simple 8 node star topology, runs for 10s, tests Adaptive request timers.

#Class Test/srm-chain-session -superclass TestSuite
# session simulations using srm in chain topo



proc usage {} {
    global argv0
    puts stderr "usage: ns $argv0 <tests> "
    puts "Valid Tests: srm-chain srm-star adapt-rep-timer adapt-req-timer\
	    srm-chain-session"
    exit 1
}

Class Topology

Topology instproc init {} {
    $self instvar nmax_ n_
}

Topology instproc totalnodes? {} {
    $self instvar nmax_ 
    return $nmax_
}

Topology instproc node? num {
    $self instvar n_
    return $n_($num)
}

Topology instproc src? {} {
    $self instvar src_
    return $src_
}

Class Topology/chain5 -superclass Topology

Topology/chain5 instproc init ns {
    $self instvar nmax_ n_ src_
    set nmax_ 5
    for {set i 0} {$i <= $nmax_} {incr i} {
	set n_($i) [$ns node]
    }
    $self next
    set chainMax [expr $nmax_ - 1]
    set j 0
    for {set i 1} {$i <= $chainMax} {incr i} {
	$ns duplex-link $n_($i) $n_($j) 1.5Mb 10ms DropTail
	$ns duplex-link-op $n_($j) $n_($i) orient right
	set j $i
    }
    set src_ 0
    $ns duplex-link $n_([expr $nmax_ - 2]) $n_($nmax_) 1.5Mb 10ms DropTail
    $ns duplex-link-op $n_([expr $nmax_ - 2]) $n_($nmax_) orient right-up
    $ns duplex-link-op $n_([expr $nmax_ - 2]) $n_([expr $nmax_-1]) orient right-down

    #$ns queue-limit $n_(0) $n_(1) 2	;# q-limit is 1 more than max #packets in q.
    #$ns queue-limit $n_(1) $n_(0) 2 
    
}

Class Topology/star8 -superclass Topology

Topology/star8 instproc init ns {
    $self instvar nmax_ n_ src_
    set nmax_ 8
    for {set i 0} {$i <= $nmax_} {incr i} {
	set n_($i) [$ns node]
    }
    $self next
    for {set i 1} {$i <= $nmax_} {incr i} {
	$ns duplex-link $n_($i) $n_(0) 1.5Mb 10ms DropTail
    }
    set src_ 1
}

TestSuite instproc finish {src} {
    global opts
    $self instvar ns_ n_
    $src stop
    $ns_ flush-trace
    if {$opts(quiet) == "false"} {
    	puts "finishing.."
    }
    exit 0
}

TestSuite instproc set-mcast {src num time} {
    global opts
    $self instvar ns_ n_ g_
    if {$opts(quiet) == "false"} {
    	puts "seting mcast.."
    }
    set mh [$ns_ mrtproto CtrMcast {}]
    $ns_ at 0.3 "$mh switch-treetype $g_"
    
    # now the multicast, and the agents
    #set srmSimType Deterministic
    set fid 0
    for {set i 0} {$i <= $num} {incr i} {
	set srm($i) [new Agent/SRM/Deterministic]
	$srm($i) set dst_addr_ $g_
	$srm($i) set dst_port_ 0
	$srm($i) set fid_ [incr fid]
	$ns_ at 1.0 "$srm($i) start"
	$ns_ attach-agent $n_($i) $srm($i)
    }
    # Attach a data source to srm(1)
    set packetSize 800
    set s [new Agent/CBR]
    $s set interval_ 0.04
    # Agent/CBR is an old form, used in backward compatibility mode only.
    # set s [new Application/Traffic/CBR]
    # 6400 bits/packet, 25 packets per second, 160Kbps
    $s set packetSize_ $packetSize
    # $s set rate_ 160Kb
    # $s attach-agent $srm($src)
    $srm($src) traffic-source $s
    $srm($src) set packetSize_ $packetSize
    $s set fid_ 0
    $ns_ at 3.0 "$srm($src) start-source"

    $ns_ at $time "$self finish $s"
}

TestSuite instproc set-session {src num time } {
    $self instvar ns_ n_ g_
    puts "running session-mcast"
    set fid 0
    for {set i 0} {$i <= $num} {incr i} {
	set srm($i) [new Agent/SRM/Deterministic]
	$srm($i) set dst_addr_ $g_
	$srm($i) set fid_ [incr fid]
	$ns_ at 1.0 "$srm($i) start"
	$ns_ attach-agent $n_($i) $srm($i)
	set sessionhelper($i) [$ns_ create-session $n_($i) $srm($i)]
    }
    # Attach a data source to srm(0)
    set packetSize 800
    set s [new Agent/CBR]
    $s set interval_ 0.04
    $s set packetSize_ $packetSize
    $srm(0) traffic-source $s
    $srm(0) set packetSize_ $packetSize
    $s set fid_ 0
    $ns_ at 3.5 "$srm(0) start-source"
    
    set loss_module [new SRMErrorModel]
    $loss_module drop-packet 2 10 1
    $loss_module drop-target [$ns_ set nullAgent_]
    $ns_ at 1.25 "$sessionhelper(0) insert-depended-loss $loss_module $srm(1) $srm(0) $g_"
    $ns_ at $time "$self finish $s"
}

TestSuite instproc init {} {
    $self instvar ns_ n_ g_ testName_ topo_ net_ time_ num_
    if {$testName_ == "srm-chain-session"} {
	set ns_ [new SessionSim]
	$ns_ namtrace-all [open temp.rands w]
    } else {
	set ns_ [new Simulator -multicast on]
	$ns_ trace-all [open temp.rands w]
	#$ns_ namtrace-all [open out.nam w]
    }
    set g_ [Node allocaddr]
    set topo_ [new Topology/$net_ $ns_]
    set nmax [$topo_ totalnodes?]
    for {set i 0} {$i <= $nmax} {incr i} { 
	set n_($i) [$topo_ node? $i]
    }
    set src [$topo_ src?]
    if {$testName_ == "srm-chain-session"} {
	$self set-session $src $num_ $time_
    } else {
	$self set-mcast $src $num_ $time_
    }
}


Test/srm-chain instproc init {} {
    $self instvar ns_ testName_ net_ time_ num_
    set testName_ srm-chain
    set net_ chain5
    set time_ 4.0
    set num_ 5
    $self next
}

Test/srm-chain instproc run {} {
    $self instvar ns_ n_
    set loss_module [new SRMErrorModel]
    $loss_module drop-packet 2 10 1
    $loss_module drop-target [$ns_ set nullAgent_]
    $ns_ at 1.25 "$ns_ lossmodel $loss_module $n_(0) $n_(1)"
    $ns_ run

}

Test/srm-star instproc init {} {
    $self instvar ns_ testName_ net_ time_ num_
    set testName_ srm-star
    set net_ star8
    set time_ 4.0
    set num_ 8
    $self next
}

Test/srm-star instproc run {} {
    $self instvar ns_ n_
    set loss_module [new SRMErrorModel]
    $loss_module drop-packet 2 10 1
    $loss_module drop-target [$ns_ set nullAgent_]
    $ns_ at 1.25 "$ns_ lossmodel $loss_module $n_(1) $n_(0)"
    $ns_ run
}



Test/srm-adapt-rep instproc init {} {
    $self instvar ns_ testName_ net_ time_ num_
    set testName_ srm-adapt-rep
    set net_ star8
    set time_ 10.0
    set num_ 8
    $self next
}

Test/srm-adapt-rep instproc run {} {
    $self instvar ns_ n_
    $n_(0) shape "other"
    $n_(1) shape "box"
    $ns_ duplex-link-op $n_(0) $n_(1) queuePos 0
    set loss_module [new SRMErrorModel]
    $loss_module drop-packet 2 200 1
    $loss_module drop-target [$ns_ set nullAgent_]
    $ns_ lossmodel $loss_module $n_(0) $n_(2)
    $ns_ run
}

Test/srm-adapt-req instproc init {} {
    $self instvar ns_ testName_ net_ time_ num_
    set testName_ srm-adapt-req
    set net_ star8
    set time_ 10.0
    set num_ 8
    $self next
}

Test/srm-adapt-req instproc run {} {
    $self instvar ns_ n_
    $n_(0) shape "other"
    $n_(1) shape "box"
    $ns_ duplex-link-op $n_(0) $n_(1) queuePos 0
    set loss_module [new SRMErrorModel]
    $loss_module drop-packet 2 200 1
    $loss_module drop-target [$ns_ set nullAgent_]
    $ns_ lossmodel $loss_module $n_(1) $n_(0)
    $ns_ run
}

#Test/srm-chain-session instproc init {} {
#    $self instvar ns_ testName_ net_ time_ num_
#    set testName_ srm-chain-session
#    set net_ chain5
#    set time_ 4.0
#    set num_ 5
#    $self next
#}

#Test/srm-chain-session instproc run {} {
#    $self instvar ns_
#    $ns_ run
#}

proc runtest {arg} {
    global opts
    set opts(quiet) false
    set b [llength $arg]
    if {$b == 1} {
	set test $arg
    } elseif {$b == 2} {
	set test [lindex $arg 0]
	set second [lindex $arg 1]
	if {$second == "QUIET" || $second == "quiet"} {
		set opts(quiet) true
	}
    } else {
	usage
    }
    if [catch {set t [new Test/$test]} result] {
	puts stderr $result
	puts "Error: Unknown test:$test"
	usage
	exit 1
    }
    $t run
}

global argv argv0
runtest $argv