test-suite-webcache.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-webcache.tcl,v 1.14 1999/09/20 17:42:47 haoboy Exp $

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

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


#----------------------------------------------------------------------
# Topologies for cache testing
#----------------------------------------------------------------------

# 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]

	$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 cache
Class Topology/cache2 -superclass SkelTopology

Topology/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 SkelTopology

Topology/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 clients
Class Topology/BottleNeck -superclass SkelTopology

Class Topology/BottleNeck -superclass SkelTopology

Topology/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 SkelTopology

Topology/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 links
Class Topology/cache4d -superclass Topology/cache4

Topology/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 request
Class Topology/cache5 -superclass SkelTopology

Topology/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 SkelTopology

Topology/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 SkelTopology

Topology/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 SkelTopology

Topology/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 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_

	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 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_

	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.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"
		}
	}
}