http-cache.tcl

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

# Copyright (c) Xerox Corporation 1998. All rights reserved.
#
# License is granted to copy, to use, and to make and to use derivative
# works for research and evaluation purposes, provided that Xerox is
# acknowledged in all documentation pertaining to any such copy or
# derivative work. Xerox grants no other licenses expressed or
# implied. The Xerox trade name should not be used in any advertising
# without its written permission. 
#
# XEROX CORPORATION MAKES NO REPRESENTATIONS CONCERNING EITHER THE
# MERCHANTABILITY OF THIS SOFTWARE OR THE SUITABILITY OF THIS SOFTWARE
# FOR ANY PARTICULAR PURPOSE.  The software is provided "as is" without
# express or implied warranty of any kind.
#
# These notices must be retained in any copies of any part of this
# software. 
#
# Implementation of web cache
#
# $Header: /nfs/jade/vint/CVSROOT/ns-2/tcl/webcache/http-cache.tcl,v 1.11 1999/10/01 22:08:29 haoboy Exp $

Http/Cache instproc init args {
	eval $self next $args

	$self instvar node_ stat_
	$node_ color "yellow"	;# no page
	array set stat_ [list hit-num 0 barrival 0 ims-num 0]
}

Http instproc set-cachesize { size } {
	$self instvar pool_
	$pool_ set max_size_ $size
}

Http instproc get-cachesize {} {
	$self instvar pool_
	return [$pool_ set max_size_]
}

# It's the user's responsibility to connect clients to caches, and caches to
# servers. Note that a cache may connect to many other caches and servers, 
# but it has only one parent cache
Http/Cache instproc connect { server } {
	$self next $server
}

Http/Cache instproc disconnect { http } {
	$self instvar slist_ clist_

	if [$http info class Http/Cache] {
		error "Cannot disconnect a cache from another cache"
	}

	if {[lsearch $slist_ $http] >= 0} {
		$self disconnect-server $http
	} else {
		$self disconnect-client $http
	}
}

# XXX Should add pending_ handling into disconnect
Http/Cache instproc disconnect-server { server } {
	$self instvar ns_ slist_ node_
	set pos [lsearch $slist_ $server]
	if {$pos >= 0} {
		lreplace $slist_ $pos $pos
	} else { 
		error "Http::disconnect: not connected to $server"
	}
	set tcp [[$self get-cnc $server] agent]
	$self cmd disconnect $server
	$server disconnect $self
	$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
	$tcp close
	#puts "cache [$self id] disconnect from server [$server id]"

	# Clear all states related to the server. 
	# XXX Assume the server isn't a cache!
	$self instvar pending_
	foreach p [array names pending_] {
		if {$server == [lindex [split $p :] 0]} {
			unset pending_($p)
		}
	}
}

# XXX Should clean up client request states
Http/Cache instproc disconnect-client { client } {
	$self instvar ns_ clist_ node_
	set pos [lsearch $clist_ $client]
	if {$pos >= 0} {
		lreplace $clist_ $pos $pos
	} else { 
		error "Http/Cache::disconnect: not connected to $server"
	}
	set tcp [[$self get-cnc $client] agent]
	$self cmd disconnect $client
	$tcp proc done {} "$ns_ detach-agent $node_ $tcp; delete $tcp"
	$tcp close
	#puts "cache [$self id] disconnect from client [$client id]"

	# Clear all pending requests associated with the client
	$self instvar creq_
	foreach p [array names creq_] {
		set res {}
		for {set i 0} {$i < [llength $creq_($p)]} {incr i} {
			set clt [lindex $creq_($p) $i]
			if {$client != [lindex [split clt /] 0]} {
				lappend res $clt
			}
		}
		if {[llength $res] == 0} {
			unset creq_($p)
		} else {
			set creq_($p) $res
		}
	}
}

# Use this function to construct a cache hierarchy
Http/Cache instproc set-parent { server } {
	$self instvar parent_
	set parent_ $server
}


# Copied from Http/Server
# Let the client side to do the actual connection ($ns connect)
Http/Cache instproc alloc-connection { client fid } {
	Http instvar TRANSPORT_
	$self instvar ns_ clist_ node_ id_ fid_

	lappend clist_ $client
	set snk [new Agent/TCP/$TRANSPORT_]
	$snk set fid_ $fid
	$ns_ attach-agent $node_ $snk
	$snk listen
	set wrapper [new Application/TcpApp $snk]
	$self cmd connect $client $wrapper
	#puts "Cache $id_ connected to client [$client id]"
	return $wrapper
}

# Parameters different from Http/Client::send-request. This one needs 
# size of the request because it may need to forward a client's request to 
# a server.
Http/Cache instproc send-request { server type pageid size args } {
	$self instvar ns_ pending_	;# pending requests, includes those 
					;# from itself

	# Don't bother sending a request to a not-connected server
	if ![$self is-connected $server] {
		return
	}
	set pending_($pageid) [$ns_ now]
	$self send $server $size \
	    "$server get-request $self $type $pageid size $size [join $args]"
}

# By constructing page id as tuple (server name, page id) we build in 
# support for multiple web servers
Http/Cache instproc get-request { cl type pageid args } {
	$self instvar slist_ clist_ ns_ id_ pending_ stat_

	incr stat_(hit-num)
	array set data $args
	if ![info exists data(size)] {
		error "Http/Cache $id_: client [$cl id] must include request size in its request"
	}

	if [$self exist-page $pageid] {
		$self cache-hit $cl $type $pageid 
	} else {
		$self cache-miss $cl $type $pageid
	}
}

# Cache miss, get it from the server
Http/Cache instproc cache-miss { cl type pageid } {
	$self instvar parent_ pending_ \
		creq_ ;# pending client requests

	# Another client requests for the page
	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. If parent_ == 0,
	# which means this is a root cache, directly contact the server
	set server [lindex [split $pageid :] 0]
	if [info exists parent_] {
		set server $parent_
	}

	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
}

# Check if page $pageid is consistent. If not, refetch the page from server.
Http/Cache instproc is-consistent { cl type pageid } {
	return 1
}

Http/Cache instproc refetch-pending { cl type pageid } {
	return 0
}

Http/Cache instproc refetch args {
	# Do nothing
}

Http/Cache instproc cache-hit { cl type pageid } {
	# page found in cache, return it to client
	if ![$self is-consistent $cl $type $pageid] {
		# Page expired and is being refetched, waiting...
		if ![$self refetch-pending $cl $type $pageid] {
			$self refetch $cl $type $pageid
		}
		return
	}
	set server [lindex [split $pageid :] 0]
	$self evTrace E HIT p $pageid c [$cl id] s [$server id]

	# XXX don't send any response here. Classify responses according
	# to request type.
	eval $self answer-request-$type $cl $pageid [$self get-page $pageid]
}

# A response may come from: 
# (1) a missed client request,
Http/Cache instproc get-response-GET { server pageid args } {
	array set data $args

	if ![info exists data(noc)] {
		# Cacheable page, continue...
		if ![$self exist-page $pageid] {
			# Cache the page if it's not in the pool
			eval $self enter-page $pageid $args
			$self evTrace E ENT p $pageid m $data(modtime) \
					z $data(size) s [$server id]
		} else {
			$self instvar id_ ns_
			# A pushed page may come before a response!
			puts stderr "At [$ns_ now], cache $id_ has requested a page which it already has."
		}
	}
	# If non-cacheable page, don't cache the page. However, still need to
	# answer all pending requests
	eval $self answer-pending-requests $pageid $args

	$self instvar stat_
	incr stat_(barrival) $data(size)

	$self instvar node_
	$node_ color "blue"	;# valid page
}

Http/Cache instproc answer-pending-requests { pageid args } {
	$self instvar creq_ pending_

	array set data $args
	if [info exists creq_($pageid)] {
		# Forward the new page to every client that has requested it
		foreach clt $creq_($pageid) {
			set tmp [split $clt /]
			set cl [lindex $tmp 0]
			set type [lindex $tmp 1]
			eval $self answer-request-$type $cl $pageid $args
		}
		unset creq_($pageid)
		unset pending_($pageid)
	} else {
		unset pending_($pageid)
	}
}

Http/Cache instproc answer-request-GET { cl pageid args } {
	# In response to a GET, we should always return
	# our copy of the page.
	array set data $args
	$self send $cl $data(size) \
		"$cl get-response-GET $self $pageid $args"
	$self evTrace E SND c [$cl id] p $pageid z $data(size)
}


#----------------------------------------------------------------------
# Cache with consistency protocol based on TTL
#----------------------------------------------------------------------
Class Http/Cache/TTL -superclass Http/Cache

Http/Cache/TTL set updateThreshold_ 0.1

Http/Cache/TTL instproc init args {
	eval $self next $args

	# Default value
	$self instvar thresh_
	set thresh_ [Http/Cache/TTL set updateThreshold_]
}

Http/Cache/TTL instproc set-thresh { th } {
	$self instvar thresh_
	set thresh_ $th
}

# XXX we should store modtime of IMS requests somewhere. Then we can check 
# if that modtime matches this cache's newest modtime when it gets an IMS
# response back from the server
Http/Cache/TTL instproc answer-request-IMS { client pageid args } {
	if ![$self exist-page $pageid] {
		error "At [$ns_ now], cache [$self id] gets an IMS of a non-cacheable page."
	}

	set mt [$self get-modtime $pageid]
	if ![$client exist-page $pageid] {
		error "client [$client id] IMS a page which it doesn't have"
	}
	if {$mt < [$client get-modtime $pageid]} {
		error "client [$client id] IMS a newer page"
	}

	if {$mt > [$client get-modtime $pageid]} {
		# We should send back the new page, even if we got a 
		# "not-modified-since"
		set pginfo [$self get-page $pageid]
		set size [$self get-size $pageid]
	} else {
		set size [$self get-invsize]
		set pginfo "size $size modtime $mt time [$self get-cachetime $pageid]"
	}
	$self evTrace E SND c [$client id] t IMS z $size
	$self send $client $size \
		"$client get-response-IMS $self $pageid $pginfo"
}

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

	# Alex cache
	# Invalidate when:(CurTime-LastCheckTime) > Thresh*(CurTime-CreateTime)
	array set data $args
	if {$data(modtime) > [$self get-modtime $pageid]} {
		# Newer page, cache it
		eval $self enter-page $pageid $args
		$self evTrace E ENT p $pageid m [$self get-modtime $pageid] \
		    z [$self get-size $pageid] s [$server id]
		# XXX Set cache entry time to server's entry time so that
		# we would have the same expiration time
		$self set-cachetime $pageid $data(time)
	} else {
		# Update entry last validation time
		$self set-cachetime $pageid [$ns_ now]
	}
	eval $self answer-pending-requests $pageid [$self get-page $pageid]

	# Compute total bytes arrived
	$self instvar stat_
	incr stat_(barrival) $data(size)
}


Http/Cache/TTL instproc is-expired { pageid } {
	$self instvar thresh_ ns_
	set cktime [expr [$ns_ now] - [$self get-cachetime $pageid]]
	set age [expr ([$ns_ now] - [$self get-modtime $pageid]) * $thresh_]
	if {$cktime <= $age} {
		# Not expired
		return 0
	}
	return 1
}

Http/Cache/TTL instproc is-consistent { cl type pageid } { 
	return ![$self is-expired $pageid]
}

Http/Cache/TTL instproc refetch-pending { cl type pageid } {
	# Page expired, validate it
	$self instvar creq_ 
	if [info exists creq_($pageid)] {
		if [regexp $cl:* $creq_($pageid)] {
			# This page already requestsed by this client
			return 1
		}
		# This page is already requested by other clients. Add 
		# the new client to the requester list, do not request it again
		lappend creq_($pageid) $cl/$type
		return 1
	}
	# Set up a refetch pending state
	lappend creq_($pageid) $cl/$type
	return 0
}

Http/Cache/TTL instproc refetch { cl type pageid } {
	$self instvar parent_

	# Send an If-Modified-Since
	set server [lindex [split $pageid :] 0]
	set size [$self get-imssize]
	if [info exists parent_] {
		set server $parent_
	}