test-suite-red-v1.tcl

柯老师网站上找到的

#
# Copyright (c) 1995 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the Computer Systems
#	Engineering Group at Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /nfs/jade/vint/CVSROOT/ns-2/tcl/test/test-suite-red-v1.tcl,v 1.4 1999/09/17 22:48:10 heideman Exp $
#
# This test suite reproduces most of the tests from the following note:
# Floyd, S., 
# Ns Simulator Tests for Random Early Detection (RED), October 1996.
# URL ftp://ftp.ee.lbl.gov/papers/redsims.ps.Z.
#

#
# This file uses the ns-1 interfaces, not the newere v2 interfaces.
# Don't copy this code for use in new simulations,
# copy the new code with the new interfaces!
#

#
#
# To run all tests: test-all-red
#       
# The default value for ns_red(linterm) has been changed from 50 (its
#  old value)to 10.

set flowfile fairflow.tr
set flowgraphfile fairflow.xgr
set pthresh 100
set randseed 0

# to generate flow graph with unforced drops:
#       set category 1
#       set awkprocedure unforcedmakeawk
# to generate flow graph with forced drops:
#       set category 0
#       set awkprocedure forcedmakeawk

# Create a simple six node topology:
#
#        s1		    s3
#         \ 		    /
# 10Mb,2ms \  1.5Mb,20ms   / 10Mb,4ms
#           r1 --------- r2
# 10Mb,3ms /		   \ 10Mb,5ms
#         /		    \
#        s2		    s4 
#
proc create_testnet2 { } {

	global s1 s2 r1 r2 s3 s4 
	set s1 [ns node]
	set s2 [ns node]
	set r1 [ns node]
	set r2 [ns node]
	set s3 [ns node]
	set s4 [ns node]

	ns_duplex $s1 $r1 10Mb 2ms drop-tail
	ns_duplex $s2 $r1 10Mb 3ms drop-tail
	set L [ns_duplex $r1 $r2 1.5Mb 20ms red]
	[lindex $L 0] set queue-limit 25
	[lindex $L 1] set queue-limit 25
	ns_duplex $s3 $r2 10Mb 4ms drop-tail
	ns_duplex $s4 $r2 10Mb 5ms drop-tail
}

proc finish file {

	#
	# split queue/drop events into two separate files.
	# we don't bother checking for the link we're interested in
	# since we know only such events are in our trace file
	#
	set awkCode {
		{
			if (($1 == "+" || $1 == "-" ) && \
			  ($5 == "tcp" || $5 == "ack"))
				print $2, $8 + ($11 % 90) * 0.01 >> "temp.p";
			else if ($1 == "d")
				print $2, $8 + ($11 % 90) * 0.01 >> "temp.d";
		}
	}

	set f [open temp.rands w]
	puts $f "TitleText: $file"
	puts $f "Device: Postscript"
	
	exec rm -f temp.p temp.d 
	exec touch temp.d temp.p
	exec awk $awkCode out.tr

	puts $f \"packets
	flush $f
	exec cat temp.p >@ $f
	flush $f
	# insert dummy data sets so we get X's for marks in data-set 4
	puts $f [format "\n\"skip-1\n0 1\n\n\"skip-2\n0 1\n\n"]

	puts $f \"drops
	flush $f
	#
	# Repeat the first line twice in the drops file because
	# often we have only one drop and xgraph won't print marks
	# for data sets with only one point.
	#
	exec head -1 temp.d >@ $f
	exec cat temp.d >@ $f
	close $f
	exec xgraph -bb -tk -nl -m -x time -y packet temp.rands &
	
	exit 0
}

proc plotQueue file {

	#
	# Plot the queue size and average queue size, for RED gateways.
	#
	set awkCode {
		{
			if ($1 == "Q" && NF>2) {
				print $2, $3 >> "temp.q";
				set end $2
			}
			else if ($1 == "a" && NF>2)
				print $2, $3 >> "temp.a";
		}
	}
	set f [open temp.queue w]
	puts $f "TitleText: $file"
	puts $f "Device: Postscript"

	exec rm -f temp.q temp.a 
	exec touch temp.a temp.q
	exec awk $awkCode out.tr

	puts $f \"queue
	flush $f
	exec cat temp.q >@ $f
	flush $f
	puts $f \n\"ave_queue
	flush $f
	exec cat temp.a >@ $f
	###puts $f \n"thresh
	###puts $f 0 [[ns link $r1 $r2] get thresh]
	###puts $f $end [[ns link $r1 $r2] get thresh]
	close $f
	exec xgraph -bb -tk -x time -y queue temp.queue &
}

#
# Arrange for tcp source stats to be dumped for $tcpSrc every
# $interval seconds of simulation time
#
proc tcpDump { tcpSrc interval } {
	proc dump { src interval } {
		ns at [expr [ns now] + $interval] "dump $src $interval"
		puts [ns now]/cwnd=[$src get cwnd]/ssthresh=[$src get ssthresh]/ack=[$src get ack]
	}
	ns at 0.0 "dump $tcpSrc $interval"
}

proc openTrace { stopTime testName } {
	global r1 k1    
	set traceFile [open out.tr w]
	ns at $stopTime \
		"close $traceFile ; finish $testName"
	set T [ns trace]
	$T attach $traceFile
	return $T
}

proc create_flowstats {} {

	global r1 r2 r1fm flowfile pthresh category

	set r1fm [new flowmgr srcdstcls]
	set flowdesc [open $flowfile w]
	$r1fm attach $flowdesc
## 2 "categories" of drops
        $r1fm ndropcats 2
## after 100 total packets have been dropped, invoke flowDump
        $r1fm cat-drops-pthresh $category $pthresh
	$r1fm cat-drops-pcallback $category flowDump 
	[ns link $r1 $r2] flow-mgr $r1fm
}

proc create_flowstats1 {} {

	global r1 r2 r1fm flowfile pthresh 

#	set r1fm [new flowmgr srcdstcls]
 	set r1fm [new flowmgr redsrcdstcls]
	set flowdesc [open $flowfile w]
	$r1fm attach $flowdesc
## 2 "categories" of drops
        $r1fm ndropcats 2
## after 100 total packets have been dropped, invoke flowDump1
        $r1fm total-drops-pthresh $pthresh
	$r1fm total-drops-pcallback flowDump1 
	[ns link $r1 $r2] flow-mgr $r1fm
}

#
# awk code used to produce:
#       x axis: # arrivals for this flow+category / # total arrivals [bytes]
#       y axis: # drops for this flow+category / # drops this category [pkts]
proc unforcedmakeawk { } {
        set awkCode {
            BEGIN { print "\"flow 0" }
            {
                if ($2 != prev) {
                        print " "; print "\"flow " $2; print 100.0 * $9/$13, 100.0 * $10 / $14; prev = $2
                } else
                        print 100.0 * $9 / $13, 100.0 * $10 / $14
            }
        }
        return $awkCode
}

#
# awk code used to produce:
#       x axis: # arrivals for this flow+category / # total arrivals [bytes]
#       y axis: # drops for this flow+category / # drops this category [bytes]
proc forcedmakeawk { } {
        set awkCode {
            BEGIN { print "\"flow 0" }
            {
                if ($2 != prev) {
                        print " "; print "\"flow " $2; print 100.0 * $9/$13, 100.0 * $11 / $15; prev = $2
                } else
                        print 100.0 * $9 / $13, 100.0 * $11 / $15
            }
        }
        return $awkCode
}

#
# awk code used to produce:
#      x axis: # arrivals for this flow+category / # total arrivals [bytes]
#      y axis: # drops for this flow / # drops [pkts and bytes combined]
proc allmakeawk { } {
        set awkCode {
            BEGIN { print "\"flow 0"; cat0=0; cat1=0}
            {
                if ($1 != prevtime && cat1 + cat0 > 0){
			cat1_part = frac_packets * cat1 / ( cat1 + cat0 ) 
			cat0_part = frac_bytes * cat0 / ( cat1 + cat0 ) 
                        print 100.0 * frac_arrivals, 100.0 * ( cat1_part + cat0_part )
			frac_bytes = 0; frac_packets = 0; frac_arrivals = 0;
			cat1 = 0; cat0 = 0;
			prevtime = $1
		}
		if ($2 != prev) {
			print " "; print "\"flow "prev;
			prev = $2
		}
		if ($3==0) {  
			if ($15>0) {frac_bytes = $11 / $15} 
			else {frac_bytes = 0}
			cat0 = $14
		} else if ($3==1) { 
			if ($14>0) {frac_packets = $10 / $14}
			else {frac_packets = 0}
			if ($13>0) {frac_arrivals = ( $9 / $13 )} 
			else {frac_arrivals = 0}
			cat1 = $14
		}
		prevtime = $1
            }
	    END {
		cat1_part = frac_packets * cat1 / ( cat1 + cat0 ) 
		cat0_part = frac_bytes * cat0 / ( cat1 + cat0 ) 
                print 100.0 * frac_arrivals, 100.0 * ( cat1_part + cat0_part )
	    }
        }
        return $awkCode
}

proc create_flow_graph { graphtitle graphfile } {
        global flowfile awkprocedure
        set tmpfile1 /tmp/fg1[pid]
        set tmpfile2 /tmp/fg2[pid]

        exec rm -f $graphfile
        set outdesc [open $graphfile w]
        #
        # this next part is xgraph specific
        #
        puts $outdesc "TitleText: $graphtitle"
        puts $outdesc "Device: Postscript"

        exec rm -f $tmpfile1 $tmpfile2
        puts "writing flow xgraph data to $graphfile..."

        exec sort -n +1 -o $flowfile $flowfile
        exec awk [$awkprocedure] $flowfile >@ $outdesc
        close $outdesc
}

proc finish_flow { file } {
	global flowgraphfile
	create_flow_graph $file $flowgraphfile
	puts "running xgraph..."