http-cache.tcl

对IEEE 802.11e里的分布式信道接入算法EDCA进行改进

	$snd set dst_addr_ $group
	$snd set dst_port_ 0
	$self add-upd-sender $snd
	$ns_ attach-agent $node_ $snd
	$node_ join-group $snd $group
}

Http/Cache/Inval/Mcast instproc join-update-group { group }  {
	$self instvar updListener_ updListenGroup_ ns_ node_

	set updListenGroup_ $group
	# One cache can only receive from one update group at a time
	if ![info exists updListener_] {
		set updListener_ [new Agent/HttpInval]
		$self add-upd-listener $updListener_
		$updListener_ set dst_addr_ $updListenGroup_
		$updListener_ set dst_port_ 0
		$ns_ attach-agent $node_ $updListener_
	}
	$node_ join-group $updListener_ $updListenGroup_
#	$node_ add-mark "Updating" "Orange"
}

Http/Cache/Inval/Mcast instproc leave-update-group {} {
	$self instvar updListener_ updListenGroup_ ns_ node_
	if ![info exists updListener_] {
		return
	}
	$node_ leave-group $updListener_ $updListenGroup_
	$node_ delete-mark "Updating"
}

# Set up a unicast heartbeat connection
Http/Cache/Inval/Mcast instproc setup-unicast-hb {} {
	Http instvar TRANSPORT_
	$self instvar node_ ns_

	set snk [new Agent/TCP/$TRANSPORT_]
	$snk set fid_ [Http set HB_FID_]
	$ns_ attach-agent $node_ $snk
	$snk listen
	set wrapper [new Application/TcpApp/HttpInval $snk]
	$wrapper set-app $self
	return $wrapper
}

# Establish state for server. Propagate until Top-Level Cache is reached
# Set up heartbeat connection along the way
Http/Cache/Inval/Mcast instproc server-join { server cache } {
	$self cmd join [$server id] $cache

	#puts "Server [$server id] joins cache [$self id]"

	$self instvar parent_
	if ![info exists parent_] {
		return
	}

	$self send $parent_ [$self get-joinsize] \
			"$parent_ server-join $server $self"

	# Establishing a tcp connection. 
	Http instvar TRANSPORT_
	$self instvar ns_ node_

	set tcp [new Agent/TCP/$TRANSPORT_]
	$tcp set fid_ [Http set HB_FID_]
	$ns_ attach-agent $node_ $tcp
	set dst [$parent_ setup-unicast-hb]
	set snk [$dst agent]
	$ns_ connect $tcp $snk
	#$tcp set dst_ [$snk set addr_] 
	$tcp set window_ 100

	set wrapper [new Application/TcpApp/HttpInval $tcp]
	$wrapper connect $dst
	$wrapper set-app $self

	$self set-pinv-agent $wrapper

	# If we haven't started it yet, start it.
	$self start-hbtimer
}

Http/Cache/Inval/Mcast instproc request-mpush { page } {
	$self instvar mpush_refresh_ ns_ hb_interval_
	if [info exists mpush_refresh_($page)] {
		# The page is already set as mandatory push, ignore it
		return
	}
	$self set-mandatory-push $page

	set server [lindex [split $page :] 0]
	set cache [$self parent-cache $server]

	set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_] \
		"$self send-refresh-mpush $cache $page"]
	# Forward the push request towards the web server
	$self send $cache [$self get-mpusize] "$cache request-mpush $page"
}

Http/Cache/Inval/Mcast instproc refresh-mpush { page } {
	$self cmd set-mandatory-push $page
}

Http/Cache/Inval/Mcast instproc send-refresh-mpush { cache page } {
	$self instvar mpush_refresh_ ns_ hb_interval_
	$self send $cache [$self get-mpusize] "$cache refresh-mpush $page"
	set mpush_refresh_($page) [$ns_ at [expr [$ns_ now] + $hb_interval_] \
		"$self send-refresh-mpush $cache $page"]
}

# XXX This is used when a mpush is timed out, where we don't need to 
# send explicit teardown, etc. 
Http/Cache/Inval/Mcast instproc cancel-mpush-refresh { page } {
	$self instvar mpush_refresh_ ns_ 
	if [info exists mpush_refresh_($page)] {
		$ns_ cancel $mpush_refresh_($page)
		#puts "[$ns_ now]: Cache [$self id] stops mpush"
	} else {
		error "Cache [$self id]: No mpush to stop!"
	}
}

Http/Cache/Inval/Mcast instproc stop-mpush { page } {
	# Cancel refresh messages
	$self cancel-mpush-refresh $page

	# Clear page push status
	$self cmd stop-mpush $page

	# Send explicit message to stop mpush
	set server [lindex [split $page :] 0]
	set cache [$self parent-cache $server]
	$self send $cache [$self get-mpusize] "$cache stop-mpush $page"
}

#
# Support for multiple hierarchies
#
# Top-Level Caches (TLCs) need to exchange invalidations with each other,
# so they are both sender and receiver in this multicast group. 
Http/Cache/Inval/Mcast instproc join-tlc-group { group } {
	$self instvar tlcAgent_ tlcGroup_ ns_ node_

	if [info exists tlcAgent_] {
		return 
	}
	set tlcAgent_ [new Agent/HttpInval]
	set tlcGroup_ $group
	$tlcAgent_ set dst_addr_ $group
	$tlcAgent_ set dst_port_ 0

	$self add-inval-sender $tlcAgent_
	$self add-inval-listener $tlcAgent_
	$ns_ attach-agent $node_ $tlcAgent_
	$node_ join-group $tlcAgent_ $group
}

Http/Cache/Inval/Mcast instproc get-response-TLC { server pageid tlc } {
	# Continue query...
# 	debug 1
	$self register-server [$tlc id] [$server id]
	$self instvar ns_ id_
#	puts "[$ns_ now]: Cache $id_ knows server [$server id] -> tlc [$tlc id]"
	$self send-request $tlc GET $pageid [$self get-reqsize]
}


#----------------------------------------------------------------------
# Http/Cache/Inval/Mcast/Perc
# 
# Multicast invalidation + two way liveness message + invalidation 
# filtering. Must be used with Http/Server/Inval/Ucast/Perc
# 
# Requires C++ support. This is why we have this long name. :( 
#
# Procedures: 
# - Server's new page: the server injects it into the cache hierarchy by
#   sending it to its parent cache, which in turn forwards it up the tree.
# - Every cache keeps a cost for each cached page. 
#----------------------------------------------------------------------

# XXX Do not check-sstate{} when getting a response. Because we are doing 
# direct request, those responses will always come from the server
Http/Cache/Inval/Mcast/Perc instproc check-sstate {sid cid} {
	$self instvar direct_request_
	if !$direct_request_ {
		# If not using direct request, check sstate
		$self cmd check-sstate $sid $cid
	}
}

# Because we are doing direct request, we'll get a lot of responses 
# directly from the server, and we'll have cid == sid. We don't want to
# register this into our server map, because the server map is used 
# for forwarding pro formas. Therefore, we wrap up register-server to
# direct requests to all our *UNKNOWN* servers to our parent. 
#
# Note this won't disrupt server entries via JOIN, because they are 
# established before any request is sent.
Http/Cache/Inval/Mcast/Perc instproc register-server {cid sid} {
	$self instvar parent_ direct_request_
# 	debug 1
	if {$direct_request_ && [info exists parent_]} {
		$self cmd register-server [$parent_ id] $sid
	} 
}

# Allows direct request
Http/Cache/Inval/Mcast/Perc instproc cache-miss { cl type pageid } {
	$self instvar direct_request_

	if !$direct_request_ {
		# If not use direct request, fall back to previous method
		$self next $cl $type $pageid
		return
	}

	# If use direct request, send a request to the web server to ask 
	# for the page, and then send a pro forma when get the request 

	$self instvar parent_ pending_ creq_ ;# pending client requests
	$self instvar dreq_ ;# pending direct requests
		
	lappend creq_($pageid) $cl/$type

	# XXX If there's a previous requests going on we won't send another
	# request for the same page.
	if [info exists pending_($pageid)] {
		return
	}

	$self instvar dreq_
	set dreq_($pageid) 1

	# Page not found, directly contact the server and get the page. 
	set server [lindex [split $pageid :] 0]
	set size [$self get-reqsize]
	$self evTrace E MISS p $pageid c [$cl id] s [$server id] z $size
	$self send-request $server $type $pageid $size
}

# Allows direct request
Http/Cache/Inval/Mcast/Perc instproc refetch { cl type pageid } {
	$self instvar direct_request_

	if !$direct_request_ {
		$self next $cl $type $pageid
		return
	}

	$self instvar dreq_
	set dreq_($pageid) 1

	set size [$self get-refsize]
	set server [lindex [split $pageid :] 0]
	$self evTrace E REF p $pageid s [$server id] z $size 
	$self send-request $server REF $pageid $size

	$self instvar node_ marks_ ns_
	lappend marks_($pageid) $pageid:[$ns_ now]
	$node_ add-mark $pageid:[$ns_ now] "brown"
}

# Whenever get a request, send a pro forma up
Http/Cache/Inval/Mcast/Perc instproc get-response-GET { server pageid args } {
	# First, answer children's requests, etc.
	eval $self next $server $pageid $args

	# Then send a pro forma if it's a direct request
	$self instvar dreq_ 
	if [info exists dreq_($pageid)] {
		# If this page is result of a direct request, send a pro forma
		eval $self send-proforma $pageid $args
		unset dreq_($pageid)
	}
}

# Same treatment as get-response-GET
Http/Cache/Inval/Mcast/Perc instproc get-response-REF { server pageid args } {
	eval $self next $server $pageid $args
	$self instvar dreq_
	if [info exists dreq_($pageid)] {
		eval $self send-proforma $pageid $args
		unset dreq_($pageid)
	}
}

# XXX We need special handling for multiple hierarchies. If we cannot find 
# the server in our server map, we directly call the server's routine to 
# find out its TLC. This doesn't make the simulation artificial, though, 
# because in our previous direct response from the server, we could have
# easily gotten its TLC. 
Http/Cache/Inval/Mcast/Perc instproc send-proforma { pageid args } {
	set server [lindex [split $pageid :] 0]
	set par [$self parent-cache $server]
	if {$par == $server} {
		# If we are the primary cache, don't send anything
		return
	} elseif {$par == ""} {
		# XXX 
		# We are the TLC, and we don't have a server entry. This 
		# means that the server resides in another hierarchy. 
		# Query the global server-to-TLC map to unicast this 
		# pro forma to that TLC...
		set par [$server get-tlc]
		#puts "TLC [$self id] learned about server [$server id] by pro forma"
	}
	$self send $par [$self get-pfsize] \
		"$par recv-proforma $self $pageid [join $args]"
	$self evTrace E SPF p $pageid c [$par id]
}

Http/Cache/Inval/Mcast/Perc instproc get-response-IMS { server pageid args } {
	$self instvar ns_ 

	array set data $args
	if {$data(modtime) <= [$self get-modtime $pageid]} {
		# The page we got from the pro forma is indeed most up-to-date
		return
	}
	# The server has changed the page since the pro forma is sent
	# We need to send invalidations to invalidate the page
	$self invalidate $pageid 
	eval $self enter-page $pageid $args
	$self mark-valid
}

Http/Cache/Inval/Mcast/Perc instproc mark-valid-hdr {} {
	$self instvar node_
	$node_ color "orange"
}

Http/Cache/Inval/Mcast/Perc instproc recv-proforma { cache pageid args } {
	$self instvar stat_
	# count pro forma as one TLC hit
	incr stat_(hit-num)

	$self evTrace E RPF p $pageid c [$cache id]

	array set data $args
	if ![$self exist-page $pageid] {
		# Page doesn't exists. Create an entry for page header, and
		# forward it towards the web server
		eval $self enter-metadata $pageid $args
		$self mark-valid-hdr

		set server [lindex [split $pageid :] 0]
		set par [$self parent-cache $server]
		if {$par == $server} {
			# If we are the primary cache, validate this 
			# pro forma by sending an IMS
			$self send-request $par IMS $pageid \
				[$self get-imssize] modtime $data(modtime)
		} else {
			eval $self send-proforma $pageid $args
		}
	} elseif [$self is-valid $pageid] {
		# Valid page, check if this is a newer one
		set mt [$self get-modtime $pageid]
		if {$data(modtime) < $mt} {
			# If the pro forma is older, should invalidate our
			# children so that they'll invalidate their stuff
			$self recv-inv $pageid $data(modtime)
			return
		} elseif {$data(modtime) > $mt} {
			# If the pro forma is about a newer page, 
			# first invalidate our page, so that we have an 
			# invalidation record to let our children know the 
			# page is invalid. Then enter the page metadata.
			# 
			# XXX Should check for existence of page content
			$self recv-inv $pageid $data(modtime)
			eval $self enter-metadata $pageid $args
			$self mark-valid-hdr
			eval $self send-proforma $pageid $args
		}
		# Drop the pro forma if it's the same as our page.
		# XXX count the pro forma as a request to this page, and
		# send a request notification towards the web server. 
		# Mark the page as read if it's originally unread.
		$self count-request $pageid
		if [$self is-unread $pageid] {
			$self set-read $pageid
		}
	} else {
		# Invalid page, check if we should set a valid page header
		# so that invalidations will be forwarded.
		array set data $args
		set mt [$self get-modtime $pageid]
		if {$data(modtime) < $mt} {
			# We already have the most up-to-date page, so are
			# our parents. Do nothing
			return
		} 
		# The pro forma is newer, put in the new meta-data and 
		# set the page as valid_header but not valid_page
		# Note if a page is invalid, its modtime is that of the 
		# newest page.
		# 
		# XXX Should test for the existence of page content by 
		# looking at the size of the pro forma.
		eval $self enter-metadata $pageid $args
		$self mark-valid-hdr

		eval $self send-proforma $pageid $args
	}
}