# 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: /cvsroot/nsnam/ns-2/tcl/test/test-suite-mcache.tcl,v 1.15 2006/01/24 23:00:06 sallyfloyd Exp $#----------------------------------------------------------------------# Related Files#----------------------------------------------------------------------#source misc.tclremove-all-packet-headers       ; # removes all except commonadd-packet-header Flags IP TCP HttpInval ; # hdrs reqd for validation test # FOR UPDATING GLOBAL DEFAULTS:Agent/TCP set precisionReduce_ false ;   # default changed on 2006/1/24.Agent/TCP set rtxcur_init_ 6.0 ;      # Default changed on 2006/01/21Agent/TCP set updated_rttvar_ false ;  # Variable added on 2006/1/21Agent/TCP set tcpTick_ 0.1# The default for tcpTick_ is being changed to reflect a changing reality.Agent/TCP set rfc2988_ false# The default for rfc2988_ is being changed to true.Agent/TCP set useHeaders_ false# The default is being changed to useHeaders_ true.Agent/TCP set windowInit_ 1# The default is being changed to 2.Agent/TCP set singledup_ 0# The default is being changed to 1source topologies.tcl#----------------------------------------------------------------------# Misc setup#----------------------------------------------------------------------set tcl_precision 10Agent/TCP set minrto_ 0# The default is being changed to minrto_ 1#----------------------------------------------------------------------# 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 classesTest 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.tclproc 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 scriptproc 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 clientClass Topology/2node -superclass SkelTopologyTopology/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 SkelTopologyTopology/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 serverClass Topology/cache0 -superclass SkelTopologyTopology/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 sideClass Topology/cache1 -superclass SkelTopologyTopology/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 SkelTopologyTopology/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 SkelTopologyTopology/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 sessionsClass Topology/mess-h -superclass SkelTopologyTopology/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.5KAgent/TCP/FullTcp set nodelay_ true	;# don't use Nagle's algorithmPagePool/Media set page_size_ 1000# QA-related setupApplication/MediaApp/QA set LAYERBW_ 2500 ;# Byte rate of layer consumptionApplication/MediaApp/QA set MAXACTIVELAYERS_ 10Application/MediaApp/QA set SRTTWEIGHT_ 0.95Application/MediaApp/QA set SMOOTHFACTOR_ 4Application/MediaApp/QA set MAXBKOFF_ 100Application/MediaApp/QA set pref_srtt_ 0.6Application/MediaApp/QA set debug_output_ 0#----------------------------------------------------------------------# Base class for web cache testing#----------------------------------------------------------------------Class Test-mcache -superclass TestTest-mcache set startTime_ 10Test-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)] {