test-suite-mcache.tcl

NS-2.28的802.11e协议扩展源代码

# Test suite for HTTP server, client, proxy cache.
#
# Also tests TcpApp, which is an Application used to transmit 
# application-level data. Because current TCP isn't capable of this,
# we build this functionality based on byte-stream model of underlying 
# TCP connection.
# 
# $Header: /nfs/jade/vint/CVSROOT/ns-2/tcl/test/test-suite-mcache.tcl,v 1.5 1999/10/06 21:25:38 haoboy Exp $

#----------------------------------------------------------------------
# Related Files
#----------------------------------------------------------------------
#source misc.tcl
source topologies.tcl

#----------------------------------------------------------------------
# Misc setup
#----------------------------------------------------------------------
set tcl_precision 10


#----------------------------------------------------------------------
# Section 1: Base test class
#----------------------------------------------------------------------
Class Test

# Copied from Simulator::instance{}
Test proc instance {} {
	set t [Test info instances]
	if { $t != "" } {
		return $t
	}
	set tl [Test info subclass] 
	while { $tl != "" } {
		set ntl {}
		foreach t $tl {
			set tt [$t info instances]
			if { $tt != "" } {
				return $tt
			}
			set ntl [eval lappend ntl [$t info subclass]]
		}
		set tl $ntl
	}
	error "Cannot find instance of Test"
}

Test instproc init-instvar v {
	set cl [$self info class]
	while { "$cl" != "" } {
		foreach c $cl {
			if ![catch "$c set $v" val] {
				$self set $v $val
				return
			}
		}
		set parents ""
		foreach c $cl {
			if { $cl != "Object" } {
				set parents "$parents [$c info superclass]"
			}
		}
		set cl $parents
	}
}

Test instproc init {} {
	$self instvar ns_ trace_ net_ defNet_ testName_ node_ test_ topo_ \
			ntrace_

	set ns_ [new Simulator -multicast on]

	set cls [$self info class]
	set cls [split $cls /]
	set test_ [lindex $cls [expr [llength $cls] - 1]]

	global opts
	ns-random $opts(ns-random-seed)

	# XXX We only output LOGs, but no packet traces. 
	if ![info exists opts(net)] {
		set net_ $defNet_
	} else {
		set net_ $opts(net)
	}
	if ![Topology/$defNet_ info subclass Topology/$net_] {
		global argv0
		puts "$argv0: cannot run test $test_ over topology $net_"
		exit 1
	}

	set topo_ [new Topology/$net_ $ns_]
	foreach i [$topo_ array names node_] {
		# This would be cool, but lets try to be compatible
		# with test-suite.tcl as far as possible.
		#
		# $self instvar $i
		# set $i [$topo_ node? $i]
		#
		set node_($i) [$topo_ node? $i]
	}

	if {$net_ == $defNet_} {
		set testName_ "$test_"
	} else {
		set testName_ "$test_:$net_"
	}
}

Test instproc create-ranvar { dist args } {
	# options
	array set opts $args
	switch $dist {
		Constant {
			set tmp [new RandomVariable/Constant]
			$tmp set val_ $opts(avg)
		}
		Poisson {
			set tmp [new RandomVariable/Exponential]
			$tmp set avg_ $opts(avg)
		}
		Uniform {
			set tmp [new RandomVariable/Uniform]
			$tmp set min $opts(min)
			$tmp set max $opts(max)
		}
		Pareto {
			set tmp [new RandomVariable/Pareto]
			$tmp set avg_ $opts(avg)
			$tmp set shape_ $opts(shape)
		}
		default {
			error "Unknown random variable distribution $dist"
		}
	}
	if [info exists opts(rng)] {
		$tmp use-rng $opts(rng)
	}
	return $tmp
}

# Use this so derived class would have a chance to overwrite the default net
# of parent classes
Test instproc set-defnet { defnet } {
	$self instvar defNet_
	if ![info exists defNet_] {
		set defNet_ $defnet
	}
}

Test instproc inherit-set { name val } {
	$self instvar $name
	if ![info exists $name] {
		set $name $val
	}
}

Test instproc write-testconf { file } {
	$self instvar test_ net_
	puts $file "# TESTNAME: $test_"
	puts $file "# TOPOLOGY: $net_"
	global opts
	foreach n [lsort [array names opts]] {
		# XXX Remove this after validating existing traces
		if {$n == "quiet"} { continue }
		puts $file "# $n: $opts($n)" 
	}
}

Test instproc set-routing {} {
}

Test instproc set-members {} {
}

Test instproc finish {} {
	$self instvar ns_ trace_ ntrace_

	if [info exists trace_] {
		$ns_ flush-trace
		close $trace_
	}
	if [info exists ntrace_] {
		close $ntrace_
	}
	exit 0
}

Test instproc run {} {
	$self instvar finishTime_ ns_ trace_

	$self set-routing
	$self set-members

	$ns_ set-abort-proc "$ns_ flush-trace; \
		$self finish"
	$ns_ at $finishTime_ "$self finish"
	$ns_ run
}

Simulator instproc set-abort-proc { exp } {
	$self instvar abortProc_
	set abortProc_ $exp
}

Simulator instproc abort {} {
	$self instvar abortProc_
	eval $abortProc_
}

# option processing copied from John's ~ns/tcl/ex/rbp_demo.tcl
proc default_options {} {
	global opts opt_wants_arg raw_opt_info

	# raw_opt_info can be set in user's script

	while {$raw_opt_info != ""} {
		if {![regexp "^\[^\n\]*\n" $raw_opt_info line]} {
			break
		}
		regsub "^\[^\n\]*\n" $raw_opt_info {} raw_opt_info
		set line [string trim $line]
		if {[regexp "^\[ \t\]*#" $line]} {
			continue
		}
		if {$line == ""} {
			continue
		} elseif [regexp {^([^ ]+)[ ]+([^ ]+)$} $line dummy key value] {
			set opts($key) $value
			set opt_wants_arg($key) 1
		} elseif [regexp {^([^ ]+)[ ]*$} $line dummy key] {
			# So we don't need to assign opt($key)
			set opt_wants_arg($key) 1
		} else {
			set opt_wants_arg($key) 0
			error "unknown stuff \"$line\" in raw_opt_info"
		}
	}
}

proc process_args {} {
	global argc argv opts opt_wants_arg

	default_options
	for {set i 0} {$i < $argc} {incr i} {
		set key [lindex $argv $i]
		if {$key == "-?" || $key == "--help" || $key == "-help" || $key == "-h"} {
			usage
		}
		regsub {^--} $key {} key
		if {![info exists opt_wants_arg($key)]} {
			continue
		}
		if {$opt_wants_arg($key)} {
			incr i
			set opts($key) [lindex $argv $i]
		} else {
			set opts($key) [expr !opts($key)]
		}
	}
}

# XXX User can reset/append raw_opt_info in their scripts. 
# At the end of user test script, call proc run to start.
# Startup procedure, called at the end of the script
proc run {} {
	global argc argv opts raw_opt_info

	# We don't actually have any real arguments, but we do have 
	# various initializations, which the script depends on.
	process_args

	# Calling convention by test-all-template1: 
	# ns <file> <test> [QUIET]
	set prot [lindex $argv 0]
	set opts(prot) $prot
	if {$argc > 1} {
		set opts(quiet) 1
	} else {
		set opts(quiet) 0
	}
	set test [new Test/$prot]
	$test run
}


#----------------------------------------------------------------------
# Section 2 Base class for cache testing
#----------------------------------------------------------------------

# Simple 2 node, one server, one client
Class Topology/2node -superclass SkelTopology

Topology/2node instproc init { ns } {
	$self next 
	$self instvar node_

	set node_(c) [$ns node]
	set node_(s) [$ns node]

	# A modem link + a T1 cross-country link
	$ns duplex-link $node_(c) $node_(s) 10Mb 2ms DropTail
	$ns duplex-link-op $node_(c) $node_(s) orient right
	$ns duplex-link-op $node_(c) $node_(s) queuePos 0.5

	# Possible congestion near the client
	$ns queue-limit $node_(c) $node_(s) 10
}

#
# 3 node linear topology testing SimpleTcp and TcpApp
#
Class Topology/3node -superclass SkelTopology

Topology/3node instproc init { ns } {
	$self next 
	$self instvar node_

	set node_(c) [$ns node]
	set node_(1) [$ns node]
	set node_(s) [$ns node]

	# A modem link + a T1 cross-country link
	$ns duplex-link $node_(c) $node_(1) 56Kb 100ms DropTail
	$ns duplex-link $node_(1) $node_(s) 1.5Mb 50ms DropTail
	$ns duplex-link-op $node_(c) $node_(1) orient right
	$ns duplex-link-op $node_(1) $node_(s) orient right
	$ns duplex-link-op $node_(c) $node_(1) queuePos 0.5
	$ns duplex-link-op $node_(1) $node_(s) queuePos 0.5

	# Possible congestion near the client
	$ns queue-limit $node_(c) $node_(1) 10
	$ns queue-limit $node_(1) $node_(c) 10
}

# Simplest topology: 1 client + 1 cache + 1 server
Class Topology/cache0 -superclass SkelTopology

Topology/cache0 instproc init ns {
	$self next
	$self instvar node_

	set node_(c) [$ns node]
	set node_(e) [$ns node]
	set node_(s) [$ns node]

	# A modem link + a T1 cross-country link
	$ns duplex-link $node_(c) $node_(e) 56Kb 100ms DropTail
	$ns duplex-link $node_(e) $node_(s) 1.5Mb 50ms DropTail
	$ns duplex-link-op $node_(c) $node_(e) orient right
	$ns duplex-link-op $node_(e) $node_(s) orient right
	$ns duplex-link-op $node_(c) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(e) $node_(s) queuePos 0.5

	$ns queue-limit $node_(c) $node_(e) 2
	$ns queue-limit $node_(e) $node_(c) 2
	$ns queue-limit $node_(e) $node_(s) 5
	$ns queue-limit $node_(s) $node_(e) 5
}

# Same as cache0 but with the bottleneck link at the server side
Class Topology/cache1 -superclass SkelTopology

Topology/cache1 instproc init ns {
	$self next
	$self instvar node_

	set node_(c) [$ns node]
	set node_(e) [$ns node]
	set node_(s) [$ns node]

	# A modem link + a T1 cross-country link
	$ns duplex-link $node_(c) $node_(e) 1.5Mb 50ms DropTail
	$ns duplex-link $node_(e) $node_(s) 56Kb 100ms DropTail
	$ns duplex-link-op $node_(c) $node_(e) orient right
	$ns duplex-link-op $node_(e) $node_(s) orient right
	$ns duplex-link-op $node_(c) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(e) $node_(s) queuePos 0.5

	$ns queue-limit $node_(c) $node_(e) 5
	$ns queue-limit $node_(e) $node_(c) 5
	$ns queue-limit $node_(e) $node_(s) 2
	$ns queue-limit $node_(s) $node_(e) 2
}

#
# 4 nodes: one server, one cache, 2 clients
#
Class Topology/4node -superclass SkelTopology

Topology/4node instproc init ns {
	$self next
	$self instvar node_

	set node_(c0) [$ns node]
	set node_(c1) [$ns node]
	set node_(e) [$ns node]
	set node_(s) [$ns node]

	# Ethernet from clients to cache
	$ns duplex-link $node_(c0) $node_(e) 1.5Mb 50ms DropTail
	$ns duplex-link $node_(c1) $node_(e) 1.5Mb 50ms DropTail
	# 56K link from cache to server
	$ns duplex-link $node_(e) $node_(s) 56K 100ms DropTail

	$ns duplex-link-op $node_(c0) $node_(e) orient left
	$ns duplex-link-op $node_(c1) $node_(e) orient down
	$ns duplex-link-op $node_(e) $node_(s) orient left
	$ns duplex-link-op $node_(c0) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(c1) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(e) $node_(s) queuePos 0.5

	$ns queue-limit $node_(c0) $node_(e) 5
	$ns queue-limit $node_(e) $node_(c0) 5
	$ns queue-limit $node_(c1) $node_(e) 5
	$ns queue-limit $node_(e) $node_(c1) 5
	$ns queue-limit $node_(e) $node_(s) 2
	$ns queue-limit $node_(s) $node_(e) 2
}


#
# Heterogeneous 4 nodes: one server, one cache, 2 clients
#
Class Topology/4node-h -superclass SkelTopology

Topology/4node-h instproc init ns {
	$self next
	$self instvar node_

	set node_(c0) [$ns node]
	set node_(c1) [$ns node]
	set node_(e) [$ns node]
	set node_(s) [$ns node]

	# Ethernet from clients to cache
	# node c0: abundant bw, node c1: limited bw
	$ns duplex-link $node_(c0) $node_(e) 1.5Mb 50ms DropTail
	$ns duplex-link $node_(c1) $node_(e) 56Kb 50ms DropTail
	# 56K link from cache to server
	$ns duplex-link $node_(e) $node_(s) 56Kb 100ms DropTail

	$ns duplex-link-op $node_(c0) $node_(e) orient left
	$ns duplex-link-op $node_(c1) $node_(e) orient down
	$ns duplex-link-op $node_(e) $node_(s) orient left
	$ns duplex-link-op $node_(c0) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(c1) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(e) $node_(s) queuePos 0.5

	$ns queue-limit $node_(c0) $node_(e) 5
	$ns queue-limit $node_(e) $node_(c0) 5
	$ns queue-limit $node_(c1) $node_(e) 2
	$ns queue-limit $node_(e) $node_(c1) 2
	$ns queue-limit $node_(e) $node_(s) 2
	$ns queue-limit $node_(s) $node_(e) 2
}

# 10 continuous TCP sessions and 10 continuous RAP sessions
Class Topology/mess-h -superclass SkelTopology

Topology/mess-h instproc init ns {
	$self next
	$self instvar node_

	set node_(c0) [$ns node]
	set node_(c1) [$ns node]
	set node_(e) [$ns node]
	set node_(s) [$ns node]

	set d1 [$ns node]
	set d2 [$ns node]

	# Ethernet from clients to cache
	# node c0: abundant bw, node c1: limited bw
	$ns duplex-link $node_(c0) $node_(e) 1.5Mb 50ms DropTail
	$ns duplex-link $node_(c1) $node_(e) 56Kb 50ms DropTail
	# 56K*20 links from cache to server
	$ns duplex-link $node_(e) $d1 1.5Mb 50ms DropTail
	$ns duplex-link $d2 $node_(s) 56Kb 50ms DropTail
	$ns duplex-link $d1 $d2 1.5Mb 100ms DropTail

	$ns duplex-link-op $node_(c0) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(c1) $node_(e) queuePos 0.5
	$ns duplex-link-op $node_(e) $d1 queuePos 0.5
	$ns duplex-link-op $d2 $d1 queuePos 0.5
	$ns duplex-link-op $node_(s) $d2 queuePos 0.5

	# Buffer: 1 RTT at every link, but 4 RTT at the bottleneck link
	$ns queue-limit $node_(c0) $node_(e) 18
	$ns queue-limit $node_(e) $node_(c0) 18
	$ns queue-limit $node_(c1) $node_(e) 3
	$ns queue-limit $node_(e) $node_(c1) 3
	$ns queue-limit $node_(e) $d1 18
	$ns queue-limit $d1 $node_(e) 18
	# 1 RTT for the bottleneck link
	$ns queue-limit $d1 $d2 37
	$ns queue-limit $d2 $d1 37
	# 1 RTT for web server link
	$ns queue-limit $d2 $node_(s) 3
	$ns queue-limit $node_(s) $d2 3

	# Create rap and tcp nodes
	for {set i 0} {$i < 10} {incr i} {
		set node_(t$i) [$ns node]	;# TCP client
		set node_(T$i) [$ns node]	;# TCP server
		set node_(r$i) [$ns node]	;# RAP client
		set node_(R$i) [$ns node]	;# RAP server

		# clients connect to cache, servers connect to dummy
		$ns duplex-link $node_(t$i) $d1 1.5Mb 50ms DropTail
		$ns duplex-link $node_(T$i) $d2 1.5Mb 50ms DropTail
		$ns duplex-link $node_(r$i) $d1 1.5Mb 50ms DropTail
		$ns duplex-link $node_(R$i) $d2 1.5Mb 50ms DropTail
		# Set all queue limits to 1 RTT
		$ns queue-limit $node_(t$i) $d1 18
		$ns queue-limit $d1 $node_(t$i) 18
		$ns queue-limit $node_(T$i) $d2 18
		$ns queue-limit $d2 $node_(T$i) 18
		$ns queue-limit $node_(r$i) $d1 18
		$ns queue-limit $d1 $node_(r$i) 18
		$ns queue-limit $node_(R$i) $d2 18
		$ns queue-limit $d2 $node_(R$i) 18
	}
}


Agent/TCP/FullTcp set segsize_ 1500 	;# segment size 1.5K
Agent/TCP/FullTcp set nodelay_ true	;# don't use Nagle's algorithm
PagePool/Media set page_size_ 1000

# QA-related setup
Application/MediaApp/QA set LAYERBW_ 2500 ;# Byte rate of layer consumption
Application/MediaApp/QA set MAXACTIVELAYERS_ 10
Application/MediaApp/QA set SRTTWEIGHT_ 0.95
Application/MediaApp/QA set SMOOTHFACTOR_ 4
Application/MediaApp/QA set MAXBKOFF_ 100
Application/MediaApp/QA set pref_srtt_ 0.6
Application/MediaApp/QA set debug_output_ 0


#----------------------------------------------------------------------
# Base class for web cache testing
#----------------------------------------------------------------------
Class Test-mcache -superclass Test

Test-mcache set startTime_ 10

Test-mcache instproc init {} {
	$self next
	$self instvar startTime_ log_
	set startTime_ [$class set startTime_]

	# XXX This is the main output of the test suite
	global opts
	if $opts(enable-log) {
		set log_ [open "temp.rands" w]
		$self write-testconf $log_
	}

	# By default set to selective push
	$self set-pagepool

	global opts
	if [info exists opts(cache-ims-size)] {
		Http set IMSSize_ $opts(cache-ims-size)
	}
	if [info exists opt(server-inv-size)] {
		Http set INVSize_ $opt(server-inv-size)
	}
	if [info exists opts(cache-ref-size)] {
		Http set REFSize_ $opts(cache-ref-size)
	}
	if [info exists opts(client-req-size)] {
		Http set REQSize_ $opts(client-req-size)
	}
}

# Allow global options to preempt, and derived classes to overwrite.
Test-mcache instproc set-server-type { servertype } {
	$self instvar serverType_