test-suite-red-v1.tcl

柯老师网站上找到的

	exec xgraph -bb -tk -nl -m -lx 0,100 -ly 0,100 -x "% of data bytes" -y "% of discards" $flowgraphfile &
	exit 0
}

proc tcpDumpAll { tcpSrc interval label } { 
        proc dump { src interval label } {  
                ns at [expr [ns now] + $interval] "dump $src $interval $label"
		puts time=[ns now]/class=$label/ack=[$src get ack]
        }
        puts $label:window=[$tcpSrc get window]/packet-size=[$tcpSrc get packet-size]
        ns at 0.0 "dump $tcpSrc $interval $label"
}       


proc flowDump { link fm flow category } {
	$fm dump $category
	$fm resetcounters
}

proc flowDump1 { link fm flow } {
	$fm dump 
	$fm resetcounters
}

proc test_red1 {} {
	global s1 s2 r1 r2 s3 s4 randseed
	create_testnet2
        set stoptime 10.0
	set testname test_red1
	
	set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
	$tcp1 set window 15

	set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s3 1]
	$tcp2 set window 15

	set ftp1 [$tcp1 source ftp]
	set ftp2 [$tcp2 source ftp]

	ns at 0.0 "$ftp1 start"
	ns at 3.0 "$ftp2 start"
	ns at $stoptime "plotQueue $testname"

	tcpDump $tcp1 5.0

	# trace only the bottleneck link
	[ns link $r1 $r2] trace [openTrace $stoptime $testname ]

	puts seed=[ns random $randseed]
	ns run
}

# For this test the average queue size in measured in bytes.
proc test_red1_bytes {} {
	global s1 s2 r1 r2 s3 s4 randseed
	create_testnet2
        set stoptime 10.0
	set testname test_red1_bytes
        [ns link $r1 $r2] set queue_in_bytes true
        [ns link $r1 $r2] set bytes true
	[ns link $r1 $r2] set mean_pktsize 1000
	# the following 3 lines really don't matter
	# here because only 1-way traffic is being monitored,
	# but rather is for consistency
        [ns link $r2 $r1] set queue_in_bytes true
        [ns link $r2 $r1] set bytes true
	[ns link $r2 $r1] set mean_pktsize 1000
	
	set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
	$tcp1 set window 15

	set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s3 1]
	$tcp2 set window 15

	set ftp1 [$tcp1 source ftp]
	set ftp2 [$tcp2 source ftp]

	ns at 0.0 "$ftp1 start"
	ns at 3.0 "$ftp2 start"
	ns at $stoptime "plotQueue $testname"

	tcpDump $tcp1 5.0

	# trace only the bottleneck link
	[ns link $r1 $r2] trace [openTrace $stoptime $testname ]

	puts seed=[ns random $randseed]
	ns run
}

proc test_ecn {} { 
        global s1 s2 r1 r2 s3 s4 randseed
        create_testnet2
	Agent/TCP set old_ecn_ 1
        set stoptime 10.0
        set testname test_ecn 
        [ns link $r1 $r2] set setbit true

        set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
        $tcp1 set window 15
        $tcp1 set ecn 1

        set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s3 1]
        $tcp2 set window 15
        $tcp2 set ecn 1
        
        set ftp1 [$tcp1 source ftp]
        set ftp2 [$tcp2 source ftp]
        
        ns at 0.0 "$ftp1 start"
        ns at 3.0 "$ftp2 start"
        ns at $stoptime "plotQueue $testname"
        
        tcpDump $tcp1 5.0
        
        # trace only the bottleneck link
        [ns link $r1 $r2] trace [openTrace $stoptime $testname ]
        
        puts seed=[ns random $randseed]
        ns run
}

# "Red2" changes some of the RED gateway parameters.
# This should give worse performance than "red1".
proc test_red2 {} {
	global s1 s2 r1 r2 s3 s4
	global randseed
	create_testnet2
	[ns link $r1 $r2] set thresh 5
	[ns link $r1 $r2] set maxthresh 10
	[ns link $r1 $r2] set q_weight 0.003
	set stoptime 10.0
	set testname test_red2
	
	set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
	$tcp1 set window 15

	set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s3 1]
	$tcp2 set window 15

	set ftp1 [$tcp1 source ftp]
	set ftp2 [$tcp2 source ftp]

	ns at 0.0 "$ftp1 start"
	ns at 3.0 "$ftp2 start"
	ns at $stoptime "plotQueue $testname"

	tcpDump $tcp1 5.0

	# trace only the bottleneck link
	[ns link $r1 $r2] trace [openTrace $stoptime $testname ]

	puts seed=[ns random $randseed]
	ns run
}

# The queue is measured in "packets".
proc test_red_twoway {} {
	global s1 s2 r1 r2 s3 s4 randseed
	create_testnet2
	set stoptime 10.0
	set testname test_red_twoway
	
	set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
	$tcp1 set window 15
	set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s4 1]
	$tcp2 set window 15
	set ftp1 [$tcp1 source ftp]
	set ftp2 [$tcp2 source ftp]

	set tcp3 [ns_create_connection tcp-reno $s3 tcp-sink $s1 2]
	$tcp3 set window 15
	set tcp4 [ns_create_connection tcp-reno $s4 tcp-sink $s2 3]
	$tcp4 set window 15
	set ftp3 [$tcp3 source ftp]
	set telnet1 [$tcp4 source telnet] ; $telnet1 set interval 0

	ns at 0.0 "$ftp1 start"
	ns at 2.0 "$ftp2 start"
	ns at 3.5 "$ftp3 start"
	ns at 1.0 "$telnet1 start"
	ns at $stoptime "plotQueue $testname"

	tcpDump $tcp1 5.0

	# trace only the bottleneck link
	[ns link $r1 $r2] trace [openTrace $stoptime $testname]

	puts seed=[ns random $randseed]
	ns run
}

# The queue is measured in "bytes".
proc test_red_twowaybytes {} {
	global s1 s2 r1 r2 s3 s4 randseed
	create_testnet2
	set stoptime 10.0
	set testname test_red_twowaybytes
	[ns link $r1 $r2] set bytes true
	[ns link $r2 $r1] set bytes true
	[ns link $r1 $r2] set queue_in_bytes true
	[ns link $r2 $r1] set queue_in_bytes true
		
	set tcp1 [ns_create_connection tcp-reno $s1 tcp-sink $s3 0]
	$tcp1 set window 15
	set tcp2 [ns_create_connection tcp-reno $s2 tcp-sink $s4 1]
	$tcp2 set window 15
	set ftp1 [$tcp1 source ftp]
	set ftp2 [$tcp2 source ftp]

	set tcp3 [ns_create_connection tcp-reno $s3 tcp-sink $s1 2]
	$tcp3 set window 15
	set tcp4 [ns_create_connection tcp-reno $s4 tcp-sink $s2 3]
	$tcp4 set window 15
	set ftp3 [$tcp3 source ftp]
	set telnet1 [$tcp4 source telnet] ; $telnet1 set interval 0

	ns at 0.0 "$ftp1 start"
	ns at 2.0 "$ftp2 start"
	ns at 3.5 "$ftp3 start"
	ns at 1.0 "$telnet1 start"
	ns at $stoptime "plotQueue $testname"

	tcpDump $tcp1 5.0

	# trace only the bottleneck link
	[ns link $r1 $r2] trace [openTrace $stoptime $testname]

	puts seed=[ns random $randseed]
	ns run
}

proc new_tcp { startTime source dest window class dump size } {
	set tcp [ns_create_connection tcp-reno $source tcp-sink $dest $class ]
	$tcp set window $window
	if {$size > 0}  {$tcp set packet-size $size }
	set ftp [$tcp source ftp]
	ns at $startTime "$ftp start"
        if {$dump == 1 } {tcpDumpAll $tcp 20.0 $class }
}

proc new_cbr { startTime source dest pktSize interval class } {
 	set cbr [ns_create_cbr $source $dest $pktSize $interval $class ]
	ns at $startTime "$cbr start"
}

proc flows {} {
	global s1 s2 r1 r2 s3 s4 r1fm qgraphfile flowfile 
        set stoptime 500.0
	set testname test_two
	
	create_testnet2
	[ns link $r1 $r2] set mean_pktsize 1000
	[ns link $r2 $r1] set mean_pktsize 1000
	[ns link $r1 $r2] set queue-limit 100
	[ns link $r2 $r1] set queue-limit 100

	create_flowstats 
	[ns link $r1 $r2] set bytes true
	[ns link $r1 $r2] set wait false

        new_tcp 1.0 $s1 $s3 100 1 1 1000
	new_tcp 1.2 $s2 $s4 100 2 1 50
	new_cbr 1.4 $s1 $s4 190 0.003 3

	ns at $stoptime "$r1fm flush"
	ns at $stoptime "finish_flow $testname"

	ns run
}

proc test_flows {} {
	global category awkprocedure randseed
   	set category 1
	set awkprocedure unforcedmakeawk
	set seed [ns random $randseed]
	puts seed=$seed
	flows 
}

proc test_flows1 {} {
	global category awkprocedure randseed
   	set category 0
	set awkprocedure forcedmakeawk
	set seed [ns random $randseed]
	puts seed=$seed 
	flows 
}

proc test_flowsAll {} {
	global s1 s2 r1 r2 s3 s4 r1fm qgraphfile flowfile awkprocedure
	global randseed
        set stoptime 500.0
	set testname test_two
	set awkprocedure allmakeawk
	
	create_testnet2
	[ns link $r1 $r2] set mean_pktsize 1000
	[ns link $r2 $r1] set mean_pktsize 1000
	[ns link $r1 $r2] set queue-limit 100
	[ns link $r2 $r1] set queue-limit 100

	create_flowstats1  
	[ns link $r1 $r2] set bytes true
	[ns link $r1 $r2] set wait false

        new_tcp 1.0 $s1 $s3 100 1 1 1000
	new_tcp 1.2 $s2 $s4 100 2 1 50
	new_cbr 1.4 $s1 $s4 190 0.003 3

	ns at $stoptime "$r1fm flush"
	ns at $stoptime "finish_flow $testname"

	puts seed=[ns random $randseed]
	ns run
}

if { $argc != 1 && $argc != 2 } {
	puts stderr {usage: ns test-suite-red.tcl testname <randseed> }
	exit 1
}
if { $argc == 2 } {
	global randseed
	set randseed [lindex $argv 1]
	puts "setting random number seed to $randseed"
	set argv [lindex $argv 0]
}
if { "[info procs test_$argv]" != "test_$argv" } {
	puts stderr "$argv: no such test: $argv"
}
test_$argv