test-suite-webcache.tcl

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

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)]} {
			#puts stderr "unknown option $key";
			#usage
			continue
		}
		if {$opt_wants_arg($key)} {
			incr i
			set opts($key) [lindex $argv $i]
		} else {
			set opts($key) [expr !opts($key)]
		}
	}
}

# 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
	#set prot $opts(prot)

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

Class Test-Cache -superclass Test

# Page lifetime is a uniform distribution in [min, max].
Test-Cache set startTime_ 10

Test-Cache instproc init {} {
	$self next
	$self instvar startTime_
	set startTime_ [$class set startTime_]
	$self set-pagepool

	global opts
	if [info exists opts(hb-interval)] {
		Http/Client set hb_interval_ $opts(hb-interval)
		Http/Cache/Inval/Mcast set hb_interval_ $opts(hb-interval)
		Http/Server/Inval/Yuc set hb_interval_ $opts(hb-interval)
	}
	if [info exists opts(upd-interval)] {
		Http/Cache/Inval/Mcast set upd_interval_ $opts(upd-interval)
	}
	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)
	}
	
	$self instvar ns_
	$ns_ color 40 red
	$ns_ color 41 orange

	# Set default transport to SimpleTcp
	Http set TRANSPORT_ SimpleTcp
}

# Allow global options to preempt, and derived classes to overwrite.
Test-Cache instproc set-server-type { servertype } {
	$self instvar serverType_ 
	global opts
	if [info exists opts(server)] {
		set serverType_ $opts(server)
	} else {
		set serverType_ $servertype
	}
}

Test-Cache instproc set-cache-type { cachetype } {
	$self instvar cacheType_ 
	global opts
	if [info exists opts(cache)] {
		set cacheType_ $opts(cache)
	} else {
		set cacheType_ $cachetype
	}
}

Test-Cache instproc set-client-type { clienttype } {
	$self instvar clientType_
	global opts
	if [info exists opts(client)] {
		set clientType_ $opts(client)
	} else {
		set clientType_ $clienttype
	}
}

Test-Cache instproc set-pagepool {} {
	$self instvar startTime_ finishTime_ pgp_
	global opts
	if [info exists opts(page-file)] {
		set pgp_ [new PagePool/Trace $opts(page-file)]
		set max [$pgp_ get-poolsize]
		set tmp [new RandomVariable/Uniform]
		$tmp set min_ 0
		$tmp set max_ [expr $max - 1]
		$pgp_ ranvar $tmp

		$pgp_ set start_time_ $startTime_
		set finishTime_ [expr [$pgp_ get-duration] + $startTime_]
	} else {
		# Use PagePool/Math
		set pgp_ [new PagePool/Math]
		# Size generator
		set tmp [new RandomVariable/Constant]
		$tmp set val_ $opts(avg-page-size)
		$pgp_ ranvar-size $tmp

		# Age generator
		$self instvar ageRNG_
		if ![info exists ageRNG_] {
			set ageRNG_ [new RNG]
			$ageRNG_ seed $opts(ns-random-seed)
		}
		set tmp [new RandomVariable/Exponential]
		$tmp use-rng $ageRNG_
		$tmp set avg_ $opts(avg-page-age)
		$pgp_ ranvar-age $tmp

		$pgp_ set start_time_ $startTime_
		set finishTime_ [expr $startTime_ + $opts(duration)]
	}
#	puts "Start at $startTime_, stop at $finishTime_"
}

Test-Cache instproc set-req-generator { client } {
	$self instvar pgp_ reqRNG_

	global opts
	if ![info exists reqRNG_] {
		set reqRNG_ [new RNG]
		$reqRNG_ seed $opts(ns-random-seed)
	}
	set tmp [new RandomVariable/Exponential]
	$tmp use-rng $reqRNG_
	$tmp set avg_ $opts(avg-req-interval)
	$client set-interval-generator $tmp
	$client set-page-generator $pgp_
}

Test-Cache instproc create-members {} {
	$self instvar client_ server_ cache_ log_ test_ pgp_ node_ ns_ \
		serverType_ cacheType_ clientType_

	set st $serverType_
	set ct $cacheType_
	set lt $clientType_

	global opts
	if $opts(enable-log) {
		set log_ [open "$test_.log" w]
		$self write-testconf $log_
	}

	foreach n [array names node_] {
		set type [string range $n 0 0]
		set num [string range $n 1 end]
		if {$num == ""} {
			set num 0
		}
		switch $type {
			s {
			 set server_($num) [new Http/Server$st $ns_ $node_($n)]
			 $server_($num) set-page-generator $pgp_
			 if $opts(enable-log) {
				 $server_($num) log $log_
			 }
			}
			e {
			 set cache_($num) [new Http/Cache$ct $ns_ $node_($n)]
			 if $opts(enable-log) {
				 $cache_($num) log $log_
			 }
			}
			c {
			  set client_($num) [new Http/Client$lt $ns_ $node_($n)]
			  $self set-req-generator $client_($num)
			  if $opts(enable-log) {
				  $client_($num) log $log_
			  }
			}
		}
	}
}

Test-Cache instproc set-routing {} {
	$self instvar ns_ mh_
	set mh_ [$ns_ mrtproto CtrMcast {}]
	$ns_ rtproto Session
}

Test-Cache instproc set-members {} {
	$self instvar ns_ finishTime_ startTime_
	$ns_ at $startTime_ "$self start-connection"
#	$ns_ at $finishTime_ "$self finish-connection"
}

Test-Cache instproc set-groups {} {
	# Dummy proc
}

Test-Cache instproc start-connection {} {
	$self instvar ns_

	$self create-members
	$self set-connections
	$self set-groups

	# Let initializations settles down, then start requests
	$ns_ at [expr [$ns_ now] + 10] "$self start-requests"
}

# Empty
Test-Cache instproc set-groups {} {
}

# Empty
Test-Cache instproc set-connections {} {
}

Test-Cache instproc finish {} {
	$self instvar log_
	if [info exists log_] {
		close $log_
	}
	$self next
}


#----------------------------------------------------------------------
# Section 3: 
# Tests of transport protocols and application data transmission over TCP
#----------------------------------------------------------------------

#
# Test SimpleTcp
#
Class Test/SimpleTcp -superclass Test

Test/SimpleTcp instproc init {} {
	$self set-defnet 2node
	$self next
	$self instvar startTime_ finishTime_
	set startTime_ 10
	set finishTime_ 20
	Http set TRANSPORT_ SimpleTcp
}

Test/SimpleTcp instproc set-routing {} {
	$self instvar ns_
	$ns_ rtproto Session
}

Test/SimpleTcp instproc set-members {} {
	$self instvar ns_ src_ dst_ node_ ftp1_

	$ns_ at 1.0 "$self start-connection 0 1"
	$ns_ at 9.0 "$self finish-connection 0 1"
}

# Connect TCP source and destination after simulator starts
Test/SimpleTcp instproc start-connection { s d } {
	$self instvar ns_ src_ dst_ node_

	set src_ [new Agent/TCP/SimpleTcp]
	set dst_ [new Agent/TCP/SimpleTcp]
	$src_ set fid_ 0
	$dst_ set fid_ 0
	$ns_ attach-agent $node_($s) $src_
	$ns_ attach-agent $node_($d) $dst_
	$ns_ connect $src_ $dst_ 

	$src_ set dst_addr_ [$dst_ set agent_addr_]
	$src_ set dst_port_ [$dst_ set agent_port_]
	$src_ set window_ 100
	$dst_ listen
	$ns_ at [expr [$ns_ now] + 1.0] "$src_ send 1000"
	$ns_ at [expr [$ns_ now] + 3.0] "$dst_ send 100"
}

Test/SimpleTcp instproc finish-connection { s d } {
	$self instvar ns_ src_ dst_ node_
	$src_ close
}

#
# Base class for testing TcpApp over SimpleTcp and FullTcp
#
Class Test-TcpApp -superclass Test

Test-TcpApp instproc set-routing {} {
	$self instvar ns_
	$ns_ rtproto Session
}

Class Test/TcpApp-2node -superclass Test-TcpApp

Test/TcpApp-2node instproc init {} {
	$self set-defnet 2node
	$self next
	$self instvar startTime_ finishTime_ ns_
	set startTime_ 10
	set finishTime_ 50
	$ns_ color 1 red
	$ns_ color 2 blue
}

Test/TcpApp-2node instproc send1 {} {
	$self instvar app1_ app2_
	$app1_ send 40 "$app2_ recv1 40"
}

Test/TcpApp-2node instproc send2 {} {
	$self instvar app1_ app2_ ns_
	$app2_ send 1024 "$app1_ recv2 1024"
	$ns_ at [expr [$ns_ now] + 1.0] "$self send2"
}

Application/TcpApp instproc recv1 { sz } {
	set now [[Simulator instance] now]
	#puts "$now app2 receives data $sz bytes from app1"
}

Application/TcpApp instproc recv2 { sz } {
	set now [[Simulator instance] now]
	#puts "$now app1 receives data $sz bytes from app1"
}

Test/TcpApp-2node instproc set-members {} { 
	$self instvar app1_ app2_ ns_ node_

	set tcp1 [new Agent/TCP/FullTcp]
	set tcp2 [new Agent/TCP/FullTcp]
	$tcp1 set window_ 100
	$tcp1 set fid_ 1
	$tcp2 set window_ 100
	$tcp2 set fid_ 2
	$tcp2 set iss_ 1224
	$ns_ attach-agent $node_(0) $tcp1
	$ns_ attach-agent $node_(1) $tcp2
	$ns_ connect $tcp1 $tcp2
	$tcp2 listen

	set app1_ [new Application/TcpApp $tcp1]
	set app2_ [new Application/TcpApp $tcp2]
	$app1_ connect $app2_

	$ns_ at 1.0 "$self send1"
	$ns_ at 1.2 "$self send2"
}


#----------------------------------------------------------------------
# Section 4: Tests of Cache
#----------------------------------------------------------------------

#
# test simplest http setup: one client + one server
#
Class Test/http1 -superclass Test

Test/http1 instproc init {} {
	$self set-defnet 3node
	$self next
	$self instvar finishTime_ 
	set finishTime_ 40

	# Use simple tcp agent
	Http set TRANSPORT_ SimpleTcp
}

Test/http1 instproc set-members {} {
	$self instvar ns_ src_ dst_ node_ ftp1_

#	set ftp1_ [$src_ attach-app FTP]
	$ns_ at 1.0 "$self start-connection 1 0"
	$ns_ at 9.0 "$self finish-connection 1 0"
	$ns_ at 10.0 "$self start-connection 1 2"
	$ns_ at 19.0 "$self finish-connection 1 2"
}

# Connect TCP source and destination after simulator starts
Test/http1 instproc start-connection { s d } {
	$self instvar ns_ src_ dst_ node_

	set src_ [new Http/Client $ns_ $node_($s)]
	set dst_ [new Http/Server $ns_ $node_($d)]
	$src_ connect $dst_
	$src_ send-request $dst_ GET $dst_:1
}

Test/http1 instproc finish-connection { s d } {
	$self instvar ns_ src_ dst_ node_

	$src_ disconnect $dst_
}

Test/http1 instproc set-routing {} {
	$self instvar ns_
	$ns_ rtproto Session
}

Class Test/http1f -superclass Test/http1

Test/http1f instproc init args {
	eval $self next $args
	Http set TRANSPORT_ FullTcp
}


#
# Testing HTTP with one cache, one client and one server
#
Class Test/http2 -superclass Test

Test/http2 instproc init {} {
	$self set-defnet 3node
	$self next
	$self instvar finishTime_ 
	set finishTime_ 40

	Http set TRANSPORT_ SimpleTcp
}

Test/http2 instproc set-routing {} {
	$self instvar ns_
	$ns_ rtproto Session
}

Test/http2 instproc set-members {} {
	$self instvar ns_ node_ client_ cache_ server_

	set client_ [new Http/Client $ns_ $node_(0)]
	set cache_ [new Http/Cache $ns_ $node_(1)]
	set server_ [new Http/Server $ns_ $node_(2)]

	$ns_ at 1.0 "$self start-connection"
	$ns_ at 9.0 "$self finish-connection"
	$ns_ at 21.0 "$self start-connection"
	$ns_ at 29.0 "$self finish-connection"
}

# Connect TCP source and destination after simulator starts
Test/http2 instproc start-connection {} {
	$self instvar ns_ client_ server_ cache_ node_

	$client_ connect $cache_
	$cache_ connect $server_
	$cache_ set-parent $server_
	$client_ send-request $cache_ GET $server_:1 
}

Test/http2 instproc finish-connection {} {
	$self instvar client_ server_ cache_

	$client_ disconnect $cache_
	$cache_ disconnect $server_
}

Class Test/http2f -superclass Test/http2

Test/http2f instproc init args {
	eval $self next $args
	Http set TRANSPORT_ FullTcp
}


#----------------------------------------------------------------------
# Testing HTTP with one cache, multiple client and one server
#----------------------------------------------------------------------
Class Test/http3 -superclass Test

Test/http3 instproc init {} {
	$self set-defnet 5node
	$self next
	$self instvar finishTime_ 
	set finishTime_ 40

	Http set TRANSPORT_ SimpleTcp
}

Test/http3 instproc set-routing {} {
	$self instvar ns_
	$ns_ rtproto Session
}

Test/http3 instproc set-members {} {
	$self instvar ns_ client_ cache_ server_ node_ test_

	set client_(0) [new Http/Client $ns_ $node_(0)]
	set client_(1) [new Http/Client $ns_ $node_(1)]
	set client_(2) [new Http/Client $ns_ $node_(2)]
	set cache_ [new Http/Cache $ns_ $node_(3)]
	set server_ [new Http/Server $ns_ $node_(4)]

	$ns_ at 1.0 "$self start-connection"
	$ns_ at 9.0 "$self finish-connection"

	# XXX
	# 
	# (1) If we set connection restarts time to 10.0, then we may
	# have a request sent out at 10.0 *before* the connection is 
	# actually re-established, which will result in the lose of a 
	# request packet and the blocking of subsequent requests.
	# 
	# (2) Currently when a connection is shut down, we do *NOT* 
	# clean up pending requests. This will result in the possible
	# blocking of requests after the connection is re-established. 
	# This test illustrates this effect.
	# 
	# The cleaning of a cache after disconnection is currently *NOT*
	# implemented. It can be disconnected but its behavior after
	# re-connection is not defined. NOTE: disconnection means 
	# explicitly call Http::disconnect(). Link dynamics and losses 
	# are supported.

	$ns_ at 9.9 "$self start-connection"
	$ns_ at 19.0 "$self finish-connection"
}

# Connect TCP source and destination after simulator starts
Test/http3 instproc start-connection {} {
	$self instvar ns_ client_ server_ cache_ node_