# 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-webcache.tcl,v 1.14 1999/09/20 17:42:47 haoboy Exp $#----------------------------------------------------------------------# Related Files#----------------------------------------------------------------------source misc.tclsource topologies.tcl#----------------------------------------------------------------------# Misc setup#----------------------------------------------------------------------set tcl_precision 10#----------------------------------------------------------------------# Topologies for cache testing#----------------------------------------------------------------------# 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]	$ns duplex-link $node_(s) $node_(e) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e) $node_(c) 10Mb 2ms DropTail	$ns duplex-link-op $node_(c) $node_(e) orient right	$ns duplex-link-op $node_(e) $node_(s) orient right}# Hierarchical cache, 1 server + 7 cache + 4 clients, server linked to # a top-level cacheClass Topology/cache2 -superclass SkelTopologyTopology/cache2 instproc init ns {	$self next	$self instvar node_	set node_(c0) [$ns node]	set node_(c1) [$ns node]	set node_(c2) [$ns node]	set node_(c3) [$ns node]	set node_(e0) [$ns node]	set node_(e1) [$ns node]	set node_(e2) [$ns node]	set node_(e3) [$ns node]	set node_(e4) [$ns node]	set node_(e5) [$ns node]	set node_(e6) [$ns node]	set node_(s0) [$ns node]	# between top-level cache: OC3	$ns duplex-link $node_(e0) $node_(e1) 155Mb 100ms DropTail	# server to top-level cache and inside a cache hierarchy: T1	$ns duplex-link $node_(s0) $node_(e0) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e0) $node_(e2) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e0) $node_(e3) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e1) $node_(e4) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e1) $node_(e5) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e2) $node_(e6) 10Mb 2ms DropTail	# client to caches: 10Mb ethernet	$ns duplex-link $node_(e2) $node_(c0) 10Mb 2ms DropTail	$ns duplex-link $node_(e6) $node_(c1) 10Mb 2ms DropTail	$ns duplex-link $node_(e4) $node_(c2) 10Mb 2ms DropTail	$ns duplex-link $node_(e1) $node_(c3) 10Mb 2ms DropTail	$ns duplex-link-op $node_(s0) $node_(e0) orient right	$ns duplex-link-op $node_(e0) $node_(e1) orient right	$ns duplex-link-op $node_(e0) $node_(e2) orient left-down	$ns duplex-link-op $node_(e0) $node_(e3) orient right-down	$ns duplex-link-op $node_(e2) $node_(e6) orient down	$ns duplex-link-op $node_(c0) $node_(e2) orient right	$ns duplex-link-op $node_(c1) $node_(e6) orient right	$ns duplex-link-op $node_(e1) $node_(e4) orient left-down	$ns duplex-link-op $node_(e1) $node_(e5) orient right-down	$ns duplex-link-op $node_(e4) $node_(c2) orient down	$ns duplex-link-op $node_(e1) $node_(c3) orient right	$self checkConfig $class $ns}# Hierarchical cache, 1 server + 7 cache + 4 clients, server linked to a # second-level cache.Class Topology/cache3 -superclass SkelTopologyTopology/cache3 instproc init ns {	$self next	$self instvar node_	set node_(c0) [$ns node]	set node_(c1) [$ns node]	set node_(c2) [$ns node]	set node_(c3) [$ns node]	set node_(e0) [$ns node]	set node_(e1) [$ns node]	set node_(e2) [$ns node]	set node_(e3) [$ns node]	set node_(e4) [$ns node]	set node_(e5) [$ns node]	set node_(e6) [$ns node]	set node_(s0) [$ns node]	# between top-level cache: OC3	$ns duplex-link $node_(e0) $node_(e1) 155Mb 100ms DropTail	# server to top-level cache and inside a cache hierarchy: T1	$ns duplex-link $node_(s0) $node_(e5) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e0) $node_(e2) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e0) $node_(e3) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e1) $node_(e4) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e1) $node_(e5) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e2) $node_(e6) 10Mb 2ms DropTail	# client to caches: 10Mb ethernet	$ns duplex-link $node_(e2) $node_(c0) 10Mb 2ms DropTail	$ns duplex-link $node_(e6) $node_(c1) 10Mb 2ms DropTail	$ns duplex-link $node_(e4) $node_(c2) 10Mb 2ms DropTail	$ns duplex-link $node_(e1) $node_(c3) 10Mb 2ms DropTail	$ns duplex-link-op $node_(e5) $node_(s0) orient right	$ns duplex-link-op $node_(e0) $node_(e1) orient right	$ns duplex-link-op $node_(e0) $node_(e2) orient left-down	$ns duplex-link-op $node_(e0) $node_(e3) orient right-down	$ns duplex-link-op $node_(e2) $node_(e6) orient down	$ns duplex-link-op $node_(c0) $node_(e2) orient right	$ns duplex-link-op $node_(c1) $node_(e6) orient right	$ns duplex-link-op $node_(e1) $node_(e4) orient left-down	$ns duplex-link-op $node_(e1) $node_(e5) orient right-down	$ns duplex-link-op $node_(e4) $node_(c2) orient down	$ns duplex-link-op $node_(e1) $node_(c3) orient right	$self checkConfig $class $ns}# Two level hierarchical cache. 1 server + 1 TLC + n 2nd caches with one # bottleneck link connecting TCL to other caches + n clientsClass Topology/BottleNeck -superclass SkelTopologyClass Topology/BottleNeck -superclass SkelTopologyTopology/BottleNeck instproc init { ns } {	$self next 	$self instvar node_ 	global opts	if [info exists opts(num-2nd-cache)] {		set n $opts(num-2nd-cache)	} else {		error "Topology/BottleNeck requires option num-2nd-cache"	}	set node_(s0) [$ns node]	# TLC is node e0	for {set i 0} {$i <= $n} {incr i} {		set node_(e$i) [$ns node]	}	# We create clients separately so we have consecutive ids for all 	# clients	for {set i 0} {$i < $n} {incr i} {		set node_(c$i) [$ns node]	}	# Between TLC and server: T1#	$ns duplex-link $node_(e$n) $node_(s0) 1.5Mb 100ms DropTail	# Server attached to a client via a LAN	$ns duplex-link $node_(e0) $node_(s0) 1.5Mb 100ms DropTail	#$ns duplex-link $node_(e0) $node_(s0) 10Mb 2ms DropTail	# Bottleneck link	$self instvar dummy_	set dummy_ [$ns node]	$ns duplex-link $node_(e$n) $dummy_ 1.5Mb 50ms DropTail	for {set i 0} {$i < $n} {incr i} {		$ns duplex-link $node_(e$i) $dummy_ 1.5Mb 50ms DropTail		$ns duplex-link $node_(c$i) $node_(e$i) 10Mb 2ms DropTail	}	$self checkConfig $class $ns}Topology/BottleNeck instproc start-monitor { ns } {	$self instvar qmon_ node_ dummy_	# Traffic between server and its primary cache	set qmon_(svr_f) [$ns monitor-queue $node_(s0) $node_(e0) ""]	set qmon_(svr_t) [$ns monitor-queue $node_(e0) $node_(s0) ""]	global opts	set n $opts(num-2nd-cache)	# Traffic between TLC and all others	set qmon_(btnk_f) [$ns monitor-queue $node_(e$n) $dummy_ ""]	set qmon_(btnk_t) [$ns monitor-queue $dummy_ $node_(e$n) ""]	# Traffic for all the rest links	for {set i 0} {$i < $n} {incr i} {		set qmon_(e${i}_d_f) [$ns monitor-queue $node_(e$i) $dummy_ ""]		set qmon_(e${i}_d_t) [$ns monitor-queue $dummy_ $node_(e$i) ""]		set qmon_(e${i}_c${i}_f) \			[$ns monitor-queue $node_(e$i) $node_(c$i) ""]		set qmon_(e${i}_c${i}_t) \			[$ns monitor-queue $node_(c$i) $node_(e$i) ""]	}	#puts "Monitors started at time [$ns now]"}Topology/BottleNeck instproc mon-stat {} {	$self instvar qmon_	set total_bw 0	foreach n [array names qmon_] {		set total_bw [expr $total_bw + \			double([$qmon_($n) set bdepartures_])]	}	set svr_bw [expr double([$qmon_(svr_f) set bdepartures_]) + \			double([$qmon_(svr_t) set bdepartures_])]	set btnk_bw [expr double([$qmon_(btnk_f) set bdepartures_]) + \			double([$qmon_(btnk_t) set bdepartures_])]	return [list total_bw $total_bw svr_bw $svr_bw btnk_bw $btnk_bw]}## Three level hierarchical cache, binary tree. #Class Topology/cache4 -superclass SkelTopologyTopology/cache4 instproc init { ns } {	$self next	$self instvar node_	# server attached to a leaf cache	set node_(s0) [$ns node]	# TLC is node e0	for {set i 0} {$i <= 6} {incr i} {		set node_(e$i) [$ns node]	}	# All clients attached to leaf caches	for {set i 0} {$i <= 3} {incr i} {		set node_(c$i) [$ns node]	}	# Bottleneck link between TLC and other caches	set dummy [$ns node]	$ns duplex-link $node_(e0) $dummy 100Mb 1ms DropTail	$ns duplex-link $dummy $node_(e1) 1.5Mb 50ms DropTail	$ns duplex-link $dummy $node_(e2) 1.5Mb 50ms DropTail	$ns duplex-link $node_(e1) $node_(e3) 1.5Mb 10ms DropTail	$ns duplex-link $node_(e1) $node_(e4) 1.5Mb 10ms DropTail	$ns duplex-link $node_(e2) $node_(e5) 1.5Mb 10ms DropTail	$ns duplex-link $node_(e2) $node_(e6) 1.5Mb 10ms DropTail	$ns duplex-link $node_(e3) $node_(c0) 10Mb 1ms DropTail	$ns duplex-link $node_(e4) $node_(c1) 10Mb 1ms DropTail	$ns duplex-link $node_(e5) $node_(c2) 10Mb 1ms DropTail	$ns duplex-link $node_(e6) $node_(c3) 10Mb 1ms DropTail	$ns duplex-link $node_(s0) $node_(e3) 10Mb 10ms DropTail		$ns duplex-link-op $node_(e0) $dummy orient down	$ns duplex-link-op $dummy $node_(e1) orient left-down	$ns duplex-link-op $dummy $node_(e2) orient right-down	$ns duplex-link-op $node_(e1) $node_(e3) orient left-down	$ns duplex-link-op $node_(e1) $node_(e4) orient right-down	$ns duplex-link-op $node_(e2) $node_(e5) orient left-down	$ns duplex-link-op $node_(e2) $node_(e6) orient right-down	$ns duplex-link-op $node_(e3) $node_(c0) orient down	$ns duplex-link-op $node_(e4) $node_(c1) orient down	$ns duplex-link-op $node_(e5) $node_(c2) orient down	$ns duplex-link-op $node_(e6) $node_(c3) orient down	$ns duplex-link-op $node_(s0) $node_(e3) orient right	$self checkConfig $class $ns}# Same as Topology/cache4, except adding a dynamic linksClass Topology/cache4d -superclass Topology/cache4Topology/cache4d instproc init { ns } {	$self next $ns	$self instvar node_	$ns rtmodel-at 500 down $node_(s0) $node_(e3)	$ns rtmodel-at 1000 up $node_(s0) $node_(e3)	$self checkConfig $class $ns}# 2-level topology with direct links from server to every client# Compare invalidation vs ttl with direct requestClass Topology/cache5 -superclass SkelTopologyTopology/cache5 instproc init { ns } {	$self next	$self instvar node_	global opts	if [info exists opts(num-2nd-cache)] {		set n $opts(num-2nd-cache)	} else {		error "Topology/BottleNeck requires option num-2nd-cache"	}	set node_(s0) [$ns node]	# TLC is node e0	for {set i 0} {$i <= $n} {incr i} {		set node_(e$i) [$ns node]	}	# We create clients separately so we have consecutive ids for all 	# clients	for {set i 0} {$i < $n} {incr i} {		set node_(c$i) [$ns node]	}	set sn [$ns node]	;# Dummy node for bottleneck link	$ns duplex-link $node_(e$n) $sn 1.5Mb 50ms DropTail	# Traffic on the duplex link. 	$self instvar qmon_	set qmon_(btnk_f) [$ns monitor-queue $node_(e$n) $sn ""]	set qmon_(btnk_t) [$ns monitor-queue $sn $node_(e$n) ""]	for {set i 0} {$i < $n} {incr i} {		$ns duplex-link $node_(e$i) $sn 1.5Mb 50ms DropTail		$ns duplex-link $node_(c$i) $node_(e$i) 10Mb 2ms DropTail		# Server attached to all clients, but its parent cache is e0		# delay to server is proportional to its distance to e0		set delay [expr 5 + $i*5]ms		$ns duplex-link $node_(e$i) $node_(s0) 1.5Mb $delay DropTail		set qmon_(svr_f$i) [$ns monitor-queue $node_(s0) $node_(e$i) ""]		set qmon_(svr_t$i) [$ns monitor-queue $node_(e$i) $node_(s0) ""]	}	$self checkConfig $class $ns}## Simple 2 node topology testing SimpleTcp and TcpApp#Class Topology/2node -superclass SkelTopologyTopology/2node instproc init { ns } {	$self next	$self instvar node_	set node_(0) [$ns node]	set node_(1) [$ns node]	$ns duplex-link $node_(0) $node_(1) 1.5Mb 10ms DropTail	$ns duplex-link-op $node_(0) $node_(1) orient right	$self checkConfig $class $ns}## 3 node linear topology testing SimpleTcp and TcpApp#Class Topology/3node -superclass SkelTopologyTopology/3node instproc init { ns } {	$self next 	$self instvar node_	set node_(0) [$ns node]	set node_(1) [$ns node]	set node_(2) [$ns node]	$ns duplex-link $node_(0) $node_(1) 1.5Mb 50ms DropTail	$ns duplex-link $node_(1) $node_(2) 1.5Mb 50ms DropTail	$ns duplex-link-op $node_(0) $node_(1) orient right	$ns duplex-link-op $node_(1) $node_(2) orient right}## 5 node topology testing HTTP cache, with 3 clients, one server and # one cache#Class Topology/5node -superclass SkelTopologyTopology/5node instproc init { ns } {	$self next	$self instvar node_	for {set i 0} {$i < 5} {incr i} {		set node_($i) [$ns node]	}	$ns duplex-link $node_(3) $node_(4) 1Mb 50ms DropTail	$ns duplex-link $node_(0) $node_(3) 1Mb 50ms DropTail	$ns duplex-link $node_(1) $node_(3) 1Mb 50ms DropTail	$ns duplex-link $node_(2) $node_(3) 1Mb 50ms DropTail	$ns duplex-link-op $node_(4) $node_(3) orient right	$ns duplex-link-op $node_(0) $node_(3) orient down	$ns duplex-link-op $node_(1) $node_(3) orient left	$ns duplex-link-op $node_(2) $node_(3) orient up}#----------------------------------------------------------------------# Section 1: Base test class#----------------------------------------------------------------------Class TestTest 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_	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)	if $opts(nam-trace-all) {		#set trace_ [open "$test_" w]		# test-all-template1 requires data file to be temp.rands :(		set trace_ [open "temp.rands" w]		$ns_ trace-all $trace_	}	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_"	}}# 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_	if [info exists trace_] {		$ns_ flush-trace		close $trace_	}	exit 0}Test instproc run {} {	$self instvar finishTime_ ns_ trace_	global opts	if $opts(nam-trace-all) {		$self write-testconf $trace_	}	$self set-routing	$self set-members	$ns_ at $finishTime_ "$self finish"	$ns_ run}# 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"		}	}}