http-server.tcl

来自「一款用来进行网络模拟的软件」· TCL 代码 · 共 551 行 · 第 1/2 页

Http/Server instproc set-parent-cache { cache } {
	# Dummy proc
}


#----------------------------------------------------------------------
# Http server modifying pages in the way as described in Pei Cao et al's 
# ICDCS'97 paper. Used to test the simulator
#----------------------------------------------------------------------

Class Http/Server/epa -superclass Http/Server

Http/Server/epa instproc start-update { interval } {
	$self instvar pm_itv_ ns_
	set pm_itv_ $interval
	$ns_ at [expr [$ns_ now] + $pm_itv_] "$self modify-page"
}

# Schedule next page modification using another way
Http/Server/epa instproc schedule-nextmod { time pageid } {
	$self instvar ns_ pm_itv_
	$ns_ at [expr [$ns_ now]+$pm_itv_] "$self modify-page $pageid"
}

# Change the page id to be modified. The pageid given in argument makes 
# no sense at all.
Http/Server/epa instproc modify-page args {
	$self instvar pgtr_
	set pageid $self:[$pgtr_ pick-pagemod]
	eval $self next $pageid
}

# Do not schedule modification during page generation.
Http/Server/epa instproc gen-pageinfo { pageid } {
	$self instvar ns_ pgtr_ 

	if [$self exist-page $pageid] {
		error "$self: shouldn't use gen-page for existing pages"
	}

	set id [lindex [split $pageid :] end]

	set modtime [$self gen-init-modtime $id]
	if [info exists pgtr_] {
		set pginfo [$pgtr_ gen-page $id $modtime]
	} else {
		set pginfo "size 2000 age 50 modtime $modtime"
	}
	array set data $pginfo
	set age $data(age)

	$self instvar modtimes_ modseq_
	set modseq_($pageid) 0
	set modtimes_($pageid:0) $modtime

	return [join $pginfo]
}


#----------------------------------------------------------------------
# Base Http invalidation server
#----------------------------------------------------------------------
Http/Server/Inval instproc modify-page { pageid } {
	$self next $pageid
	$self instvar ns_ id_
	$self invalidate $pageid [$ns_ now]
}

Http/Server/Inval instproc handle-request-REF { pageid args } {
	return [eval $self handle-request-GET $pageid $args]
}


#----------------------------------------------------------------------
# Old unicast invalidation Http server. For compatibility
# Server with single unicast invalidation
#----------------------------------------------------------------------
Class Http/Server/Inval/Ucast -superclass Http/Server/Inval

# We need to maintain a list of all caches who have gotten a page from this
# server.
Http/Server/Inval/Ucast instproc get-request { client type pageid args } {
        eval $self next $client $type $pageid $args

        # XXX more efficient representation?
        $self instvar cacheList_
        if [info exists cacheList_($pageid)] {
                set pos [lsearch $cacheList_($pageid) $client]
        } else {
                set pos -1
        }

        # If it's a new cache, put it there
        # XXX we should eventually have a timer for each cache entry, so 
        # we can get rid of old cache entries
        if {$pos < 0 && [regexp "Cache" [$client info class]]} {
                lappend cacheList_($pageid) $client
        }
}

Http/Server/Inval/Ucast instproc invalidate { pageid modtime } {
        $self instvar cacheList_ 

        if ![info exists cacheList_($pageid)] {
                return
        }
        foreach c $cacheList_($pageid) {
                # Send invalidation to every cache, assuming a connection 
                # exists between the server and the cache
                set size [$self get-invsize]

		# Mark invalidation packet as another fid
		set agent [[$self get-cnc $c] agent]
		set fid [$agent set fid_]
		$agent_ set fid_ [Http set PINV_FID_]
                $self send $c $size \
                        "$c invalidate $pageid $modtime"
		$agent_ set fid_ $fid
                $self evTrace S INV p $pageid m $modtime z $size
        }
}


#----------------------------------------------------------------------
# (Y)et another (U)ni(C)ast invalidation server
#
# It has a single parent cache. Whenever a page is updated in this server
# it informs the parent cache, which will in turn propagate the update
# (or invalidation) to the whole cache hierarchy.
#----------------------------------------------------------------------
Http/Server/Inval/Yuc instproc set-tlc { tlc } {
	$self instvar tlc_
	set tlc_ $tlc
}

Http/Server/Inval/Yuc instproc get-tlc { tlc } {
	$self instvar tlc_
	return $tlc_
}

Http/Server/Inval/Yuc instproc next-hb {} {
	Http/Server/Inval/Yuc instvar hb_interval_ 
	return [expr $hb_interval_ * [uniform 0.9 1.1]]
}

# XXX Must do this when the caching hierachy is ready
Http/Server/Inval/Yuc instproc set-parent-cache { cache } {
	$self instvar pcache_
	set pcache_ $cache

	# Send JOIN
	#puts "[$self id] joins cache [$pcache_ id]"
	$self send $pcache_ [$self get-joinsize] \
		"$pcache_ server-join $self $self"

	# Establish an invalidation connection using TCP
	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 [$pcache_ 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 add-inval-sender $wrapper

	# Start heartbeat after some time, otherwise TCP connection may 
	# not be well established...
	$self instvar ns_
	$ns_ at [expr [$ns_ now] + [$self next-hb]] "$self heartbeat"
}

Http/Server/Inval/Yuc instproc heartbeat {} {
	$self instvar pcache_ ns_

	$self cmd send-hb
	$ns_ at [expr [$ns_ now] + [$self next-hb]] \
		"$self heartbeat"
}

Http/Server/Inval/Yuc instproc get-request { cl type pageid args } {
	eval $self next $cl $type $pageid $args
	if {($type == "GET") || ($type == "REF")} {
		$self count-request $pageid
	}
}

Http/Server/Inval/Yuc instproc invalidate { pageid modtime } {
	$self instvar pcache_ id_ enable_upd_

	if ![info exists pcache_] {
		error "Server $id_ doesn't have a parent cache!"
	}

	# One more invalidation
	$self count-inval $pageid

	if [$self is-pushable $pageid] {
		$self push-page $pageid $modtime
		return
	}

	# Send invalidation to every cache, assuming a connection 
	# exists between the server and the cache
#	set size [$self get-invsize]
	# Mark invalidation packet as another fid
#	set agent [[$self get-cnc $pcache_] agent]
#	set fid [$agent set fid_]
#	$agent set fid_ [Http set PINV_FID_]
#	$self send $pcache_ $size "$pcache_ invalidate $pageid $modtime"
#	$agent set fid_ $fid

	$self cmd add-inv $pageid $modtime
	$self evTrace S INV p $pageid m $modtime 
}

Http/Server/Inval/Yuc instproc push-page { pageid modtime } {
	$self instvar pcache_ id_

	if ![info exists pcache_] {
		error "Server $id_ doesn't have a parent cache!"
	}
	# Do not send invalidation, instead send the new page to 
	# parent cache
	set size [$self get-size $pageid]
	set pageinfo [$self get-page $pageid]

	# Mark invalidation packet as another fid
	set agent [[$self get-cnc $pcache_] agent]
	set fid [$agent set fid_]
	$agent set fid_ [Http set PINV_FID_]
	$self send $pcache_ $size \
		"$pcache_ push-update $pageid $pageinfo"
	$agent set fid_ $fid
	$self evTrace S UPD p $pageid m $modtime z $size
}

Http/Server/Inval/Yuc instproc get-req-notify { pageid } {
	$self count-request $pageid
}

Http/Server/Inval/Yuc instproc handle-request-TLC { pageid args } {
	$self instvar tlc_
	array set data $args
	lappend res $data(size)	;# Same size of queries
	lappend res $tlc_
	return $res
}


#----------------------------------------------------------------------
# server + support for compound pages. 
# 
# A compound page is considered to be a frequently changing main page
# and several component pages which are usually big static images.
#
# XXX This is a naive implementation, which assumes single page and 
# fixed page size for all pages
#----------------------------------------------------------------------
Class Http/Server/Compound -superclass Http/Server

# Invalidation server for compound pages
Class Http/Server/Inval/MYuc -superclass \
		{ Http/Server/Inval/Yuc Http/Server/Compound}