http-cache.tcl

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

	# Compute how many IMSs have been sent so far
	$self instvar stat_
	incr stat_(ims-num)

	$self evTrace E IMS p $pageid c [$cl id] s [$server id] z $size \
		t [$self get-cachetime $pageid] m [$self get-modtime $pageid]
	$self send-request $server IMS $pageid $size \
			modtime [$self get-modtime $pageid]
	return 0
}


# Old style TTL, using a single fixed threshold
Class Http/Cache/TTL/Plain -superclass Http/Cache/TTL

Http/Cache/TTL/Plain set updateThreshold_ 100

Http/Cache/TTL/Plain instproc init { args } {
	eval $self next $args
	$self instvar thresh_
	set thresh_ [[$self info class] set updateThreshold_]
}

Http/Cache/TTL/Plain instproc is-expired { pageid } {
	$self instvar ns_ thresh_
	set cktime [expr [$ns_ now] - [$self get-cachetime $pageid]]
	if {$cktime < $thresh_} {
		return 0
	}
	return 1
}


Class Http/Cache/TTL/Omniscient -superclass Http/Cache/TTL

# Assume every cache has exact knowledge of when a page will change
Http/Cache/TTL/Omniscient instproc is-expired { pageid } {
	$self instvar ns_ 

	set nmt [expr [$self get-modtime $pageid] + [$self get-age $pageid]]
	if {[$ns_ now] >= $nmt} {
		return 1
	} 
	return 0
}


#----------------------------------------------------------------------
# Http cache with invalidation -- Base Class
#----------------------------------------------------------------------

Http/Cache/Inval instproc mark-invalid {} {
	$self instvar node_
	$node_ color "red"
}

Http/Cache/Inval instproc mark-valid {} {
	$self instvar node_ 
	$node_ color "blue"
}

Http/Cache/Inval instproc mark-leave {} {
	$self instvar node_ 
	$node_ add-mark down "cyan"
}

Http/Cache/Inval instproc mark-rejoin {} {
	$self instvar node_ 
	$node_ delete-mark down
}

Http/Cache/Inval instproc answer-request-REF { cl pageid args } {
	if ![$self exist-page $pageid] {
		error "At [$ns_ now], cache [$self id] gets a REF of a non-cacheable page."
	}

	# Send my new page back
	set pginfo [$self get-page $pageid]
	set size [$self get-size $pageid]
	$self evTrace E SND c [$cl id] t REF p $pageid z $size
	$self send $cl $size \
		"$cl get-response-REF $self $pageid $pginfo"
}

Http/Cache/Inval instproc get-response-GET { server pageid args } {
	# Check sstate
	set sid [[lindex [split $pageid :] 0] id]
	set cid [$server id]
	$self check-sstate $sid $cid
	eval $self next $server $pageid $args
}

# Only get the new page cached, do nothing else
Http/Cache/Inval instproc get-response-REF { server pageid args } {
	$self instvar creq_ id_ 

	# Check sstate
	set sid [[lindex [split $pageid :] 0] id]
	set cid [$server id]
	$self check-sstate $sid $cid

	array set data $args
	if {[$self get-modtime $pageid] > $data(modtime)} {
		# XXX We may get an old page because we are doing full TCP
		# and an update is sent *during* a regular refetch, which is 
		# sent through several smaller packets. 
#$self instvar ns_
#error "At [$ns_ now], cache $self ($id_) refetched an old page\
#$pageid ($data(modtime), new time [$self get-modtime $pageid])\
#from [$server id]"
puts stderr "At [$ns_ now], cache $self ($id_) refetched an old page\
$pageid ($data(modtime), new time [$self get-modtime $pageid])\
from [$server id]"
		# Do nothing; send back the newer page
	} else {
		# The page is re-validated by replacing the old entry
		eval $self enter-page $pageid $args
		$self evTrace E UPD p $pageid m [$self get-modtime $pageid] \
				z [$self get-size $pageid] s [$server id]
	}
	eval $self answer-pending-requests $pageid [$self get-page $pageid]

	$self instvar node_ marks_ ns_
	set mk [lindex $marks_($pageid) 0]
	$node_ delete-mark $mk
	set marks_($pageid) [lreplace $marks_($pageid) 0 0]
	$node_ color "blue"
}

# Always consistent?
Http/Cache/Inval instproc is-consistent { cl type pageid } {
	return [$self is-valid $pageid]
}

Http/Cache/Inval instproc refetch-pending { cl type pageid } {
	# Invalid page, prepare a refetch. 
	$self instvar creq_ 
	if [info exists creq_($pageid)] {
		if [regexp $cl:* $creq_($pageid)] {
			# This page already requestsed by this client
			return 1
		}
		# This page already requested by other clients, add ourselves
		# to the returning list and return
		lappend creq_($pageid) $cl/$type
		return 1
	}
	# Setup a refetch pending state
	lappend creq_($pageid) $cl/$type
	return 0
}

# Send a refetch. Forward the request to our parent
Http/Cache/Inval instproc refetch { cl type pageid } {
	$self instvar parent_

	set size [$self get-refsize]
	set server [lindex [split $pageid :] 0]

	if [info exists parent_] {
		set par $parent_
	} else {
		# We are the root cache (TLC), directly contact the 
		# web server
		set par $server
	}

	$self evTrace E REF p $pageid s [$server id] z $size
	$self send-request $par REF $pageid $size

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


#----------------------------------------------------------------------
# Invalidation cache with multicast heartbeat invalidation
#----------------------------------------------------------------------

Http/Cache/Inval/Mcast instproc init args {
	eval $self next $args
	$self add-to-map
}

# When we enter a new page into cache, we'll have to register the server
# in case we haven't know anything about it. The right place to do it 
# is in get-response-GET, because a cache will only enter a new page 
# after a cache miss, where it issues a GET.
Http/Cache/Inval/Mcast instproc get-response-GET { server pageid args } {
	eval $self next $server $pageid $args

	# XXX Assume once server-neighbor cache relationship is fixed, they
	# never change.
# 	debug 1
	set sid [[lindex [split $pageid :] 0] id]
	set cid [$server id]
	$self register-server $cid $sid
}

Http/Cache/Inval/Mcast instproc set-parent { parent } {
	$self next $parent
	# Establish a cache entry in state table
	$self cmd set-parent $parent
}

# I'm a listener (child)
Http/Cache/Inval/Mcast instproc join-inval-group { group } {
	$self instvar invalListener_ invListenGroup_ ns_ node_

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

	$self add-inval-listener $invalListener_
	$ns_ attach-agent $node_ $invalListener_

	# XXX assuming simulator already started
	$node_ join-group $invalListener_ $group
}

# I'm a sender (parent)
Http/Cache/Inval/Mcast instproc init-inval-group { group } {
	$self instvar invalSender_ invSndGroup_ ns_ node_
	if [info exists invalSender_] {
		return
	}
	set invalSender_ [new Agent/HttpInval]
	set invSndGroup_ $group
	$invalSender_ set dst_addr_ $group
	$invalSender_ set dst_port_ 0

	$self add-inval-sender $invalSender_
	$ns_ attach-agent $node_ $invalSender_
	$node_ join-group $invalSender_ $group

	# XXX We should put this somewhere else... But where???
	$self start-hbtimer
}

# Another "breakdown" version of parent-cache() is in cache-miss()
Http/Cache/Inval/Mcast instproc parent-cache { server } {
	$self instvar parent_
	
	set par [$self cmd parent-cache [$server id]]
	if {$par == ""} {
		# (par == "") means parent cache in the virtual distribution
		# tree is the default, which is parent_
		if [info exists parent_] {
			set par $parent_
		} else {
			# We are the root cache (TLC), directly contact the 
			# web server
			set par $server
		}
	}
	return $par
}

# Send a refetch.
# 
# We should ask our parent in the virtual distribution tree 
# of the corresponding web server, instead of our parent in the 
# cache hierarchy.
Http/Cache/Inval/Mcast instproc refetch { cl type pageid } {
	set size [$self get-refsize]
	set server [lindex [split $pageid :] 0]
	set par [$self parent-cache $server]

	$self evTrace E REF p $pageid s [$server id] z $size
	$self send-request $par REF $pageid $size

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

# Cache miss, get it from our parent cache in the virtual distribution
# tree of the web server
Http/Cache/Inval/Mcast instproc cache-miss { cl type pageid } {
	$self instvar parent_ pending_ creq_ ;# pending client 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
	}

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

	# We directly query the server map without using TCL's version
	# of parent-cache() to mask details...
	set par [$self cmd parent-cache [$server id]]
	if {$par == ""} {
		if [info exists parent_] {
			# Use default server map, i.e., parent cache
			set par $parent_
		} else {
			# This is a TLC, and the request is for another server
			# in another hierarchy (because we don't have it in our
			# server map, nor do we have a parent cache). Now we 
			# need to find out what's the corresponding TLC of 
			# the web server so as to setup invalidation path.
			#
			# Send a direct request to server to ask about TLC
			$self instvar ns_ id_
			#puts "[$ns_ now]: $id_ send TLC"
			$self send-request $server TLC $pageid $size
			# We'll send another request to the TLC after we get 
			# its addr
			return
		}
	}
	$self send-request $par $type $pageid $size
}

# This allows a server passes invalidation to any cache via unicast
# XXX Whenever a node only wants to do an invalidation, call "cmd recv-inv"
Http/Cache/Inval/Mcast instproc invalidate { pageid modtime } {
	if [$self recv-inv $pageid $modtime] {
		# Unicast invalidation to parent.
		$self instvar parent_ 
		if ![info exists parent_] {
			# This must be a root cache, should we do anything? 
			return
		}
		set size [$self get-invsize]
		$self evTrace E SND t INV c [$parent_ id] p $pageid z $size
		
		# Mark invalidation packet as another fid
		set agent [[$self get-cnc $parent_] agent]
		set fid [$agent set fid_]
		$agent set fid_ [Http set PINV_FID_]
		$self send $parent_ $size \
				"$parent_ invalidate $pageid $modtime"
		$agent set fid_ $fid
	}
}

Http/Cache/Inval/Mcast instproc get-request { cl type pageid args } {
	eval $self next $cl $type $pageid $args
	if {(($type == "GET") || ($type == "REF")) && \
		[$self exist-page $pageid]} {
		$self count-request $pageid
		if [$self is-unread $pageid] {
			$self send-req-notify $pageid
			$self set-read $pageid
		}
	}
}

# Do the same thing as if getting a request
Http/Cache/Inval/Mcast instproc get-req-notify { pageid } {
	$self count-request $pageid
	if [$self is-unread $pageid] {
		# Continue to forward the request only if our page is 
		# also unread
		$self set-read $pageid
		$self send-req-notify $pageid
	}
}

# Request notification goes along a single path in the virtual distribution
# tree towards the web server. It's not multicast to anybody else
Http/Cache/Inval/Mcast instproc send-req-notify { pageid } {
	set server [lindex [split $pageid :] 0]
	set par [$self parent-cache $server]
	$self send $par [$self get-ntfsize] "$par get-req-notify $pageid"
}

# (1) setup an invalidation record is set to invalidate my children; 
# (2) Unicast the new page to my parent;
# (3) Update my own page records
# (4) Setting up a repair group to send out the new page (once and for all)
Http/Cache/Inval/Mcast instproc push-update { pageid args } {
	# Update page, possibly push the page to children
	if [eval $self recv-push $pageid $args] {
		# XXX We should probably check if we have pending request for 
		# this page. If so, we should use this pushed page to answer 
		# those pending requests, and then mark this page as read.

		# unicast push to parent
		$self instvar parent_ 
		if [info exists parent_] {
			# If we are root, don't forward the data packet to
			# anybody. Otherwise unicast the new page to my parent
			set pginfo [$self get-page $pageid]
			set size [$self get-size $pageid]
			$self evTrace E UPD c [$parent_ id] p $pageid z $size
			$self send $parent_ $size \
				"$parent_ push-update $pageid $pginfo"
		}
		$self push-children $pageid
	}
}

Http/Cache/Inval/Mcast instproc init-update-group { group } {
	$self instvar ns_ node_ updSender_ updSendGroup_

	# Allow a cache to have multiple update groups. 
	set snd [new Agent/HttpInval]