mechanisms.tcl

ns gpsr路由协议 在ns２平台下实现的 对大家很有好处

#
# RTMechanisms: routines for the router mechanisms paper
#
# this file contains primarily the support routines
# to manage the flows.  The policies defined by the
# tests are found in rtm_tests.tcl
#
# conventions:
# 	procs of the form "do_..."  are run periodically
#	instvars starting with Capitals are constants
#
Class RTMechanisms

source rtm_tests.tcl
source rtm_link.tcl

RTMechanisms instproc tcp_ref_bw { mtu rtt droprate } {
	if { $rtt == 0 || $droprate == 0 } {
		return "none"
	}
	$self vprint 9 "mtu: $mtu rtt: $rtt droprate: $droprate"
	set result [expr 1.22 * $mtu / ($rtt*sqrt($droprate))]
	set sqrt [expr sqrt($droprate) ]
	$self vprint 9 "sqrt: $sqrt result $result"
	return [expr 1.22 * $mtu / ($rtt*sqrt($droprate))]
}

RTMechanisms instproc frac { num denom } {
	if { $denom == 0 } {
		return 0.0
	}
	return [expr double($num) / $denom]
}

RTMechanisms instproc vprint args {
	$self instvar verbose_
	set level [lindex $args 0]
	set a [lrange $args 1 end]
	if { $level <= $verbose_ } {
		$self instvar ns_
		puts "[$ns_ now] $a"
		flush stdout
	}
}

#
# mmetric: maxmetric or minmetric in the ok box
#	op: one of "max" or "min"
#	flows: list of flows
#
RTMechanisms instproc mmetric { op flows } {
	$self instvar okboxfm_

	set bdrops [$okboxfm_ set bdrops_] ; # total bytes dropped
	set pdrops [$okboxfm_ set pdrops_] ; # total pkts dropped
	set ebdrops [$okboxfm_ set ebdrops_] ; # bytes dropped early (unforced)
	set epdrops [$okboxfm_ set epdrops_] ; # pkts drooped early (unforced)
	set fpdrops [expr $pdrops - $epdrops] ; # pkts dropped (forced)
	set fbdrops [expr $bdrops - $ebdrops] ; # bytes dropped (forced)

	if { $op == "max" } {
		set op ">"
		set metric -1.0
	} elseif { $op == "min" } {
		set op "<"
		set metric 1000000
	}

	set flow "none"

	set unforced_frac [$self frac $epdrops $pdrops]
	set forced_frac [expr 1 - $unforced_frac ]
	foreach f $flows {
		set fepdrops [$f set epdrops_]
		set fpdrops [$f set pdrops_]

		set fbdrops [$f set bdrops_]
		set febdrops [$f set ebdrops_]
			
		set forced_metric [$self frac [expr $fbdrops - $febdrops] $fbdrops]
		set unforced_metric [$self frac $fepdrops $epdrops]
		set fmetric [expr $forced_frac * $forced_metric + \
			$unforced_frac * $unforced_metric]
		if { [expr $fmetric $op $metric] } {
			set metric $fmetric
			set flow $f
		}
	}
	return "$flow $metric"
}

RTMechanisms instproc setstate { flow reason bandwidth droprate } { 
	$self instvar state_ ns_

	$self vprint 1 "SETSTATE: flow: $flow NEWSTATE (reason:$reason, bw: $bandwidth, droprate: $droprate)"

	set state_($flow,reason) $reason
	set state_($flow,bandwidth) $bandwidth
	set state_($flow,droprate) $droprate
	set state_($flow,ctime) [$ns_ now]
}

# set new allotment in pbox
RTMechanisms instproc pallot allotment {
	$self instvar badclass_ goodclass_
	$self instvar Maxallot_

	$self vprint 0 "PALLOT: Allots: pbox: $allotment, okbox: [expr $Maxallot_ - $allotment]"
	$badclass_ newallot $allotment
	$goodclass_ newallot [expr $Maxallot_ - $allotment]
}

# add a flow to the flow history array (for unresponsive test)
RTMechanisms instproc fhist-add { flow droprate bandwidth } {
	$self instvar hist_next_ Hist_max_
	$self instvar flowhist_

	# circular history buffer
	incr hist_next_
	if { $hist_next_ >= $Hist_max_ } {
		set hist_next_ 0
	}
	set flowhist_($hist_next_,name) $flow
	set flowhist_($hist_next_,droprate) $droprate
	set flowhist_($hist_next_,bandwidth) $bandwidth

	$self vprint 1 "HISTORY ADDITION: flow: $flow, droprate: $droprate, bw: $bandwidth"
	return $hist_next_
}

# find entry in hist buffer with lowest droprate, return its index
# used for unresponsive test
RTMechanisms instproc fhist-mindroprate flow {
	$self instvar Hist_max_
	$self instvar flowhist_
	set dr 100000000
	set idx -1

	for { set i 0 } { $i < $Hist_max_ } { incr i } {
		if { [info exists flowhist_($i,name)] &&
		     $flowhist_($i,name) == $flow &&
		     $flowhist_($i,droprate) < $dr } {
			set dr $flowhist_($i,droprate)
			set idx $i
		}
	}
	$self vprint 1 "HISTORY MINDR SEARCH (flow: $flow): hmax: $Hist_max_, index: $idx"
	return $idx
}

RTMechanisms instproc print_good_and_bad { label } {
	$self instvar ns_
	$self instvar okboxfm_ pboxfm_
	$self instvar badclass_

	set now [$ns_ now]
	set ballot [$badclass_ allot]

	puts [format "time %5.1f $label goodflows: [$okboxfm_ flows], badflows: [$pboxfm_ flows] (allot %4.2f, droprate: ??)" $now $ballot]
}

RTMechanisms instproc print_allot_change { oallot nallot } {
	puts [format "pbox allotment changed from %6.5f to %6.5f" $oallot $nallot]
}

#
# move a flow to the bad box
# ie penalize a flow
#
RTMechanisms instproc penalize { badflow guideline_bw } {
	$self instvar npenalty_ badslot_ cbqlink_
	$self instvar badclass_
	$self instvar okboxfm_ pboxfm_
	$self instvar Max_cbw_

	$self vprint 1 "penalizing flow $badflow, guideline bw: $guideline_bw"

	incr npenalty_
	set classifier [$cbqlink_ classifier]

	#
	# add the bad flow to the cbq/mechanisms classifier
	# the underlying object (badcl_) is already in $badslot_
	#
	set src [$badflow set src_]
	set dst [$badflow set dst_]
	set fid [$badflow set flowid_]
	$classifier set-hash auto $src $dst $fid $badslot_

	#
	# remove flow record from ok fmon
	# add it to pbox f mon
	#
	set okcl [$okboxfm_ classifier]
	set okslot [$okcl del-hash $src $dst $fid]
	$okcl clear $okslot
	set bcl [$pboxfm_ classifier]
	set bslot [$bcl installNext $badflow]
	$badflow reset
	$bcl set-hash auto $src $dst $fid $bslot

	#
	# reallocate allotment
	#

	set new_pbw [expr 0.5 * $guideline_bw * $npenalty_ ]
	$self vprint 1 "npenalty $npenalty_ guideline_bw $guideline_bw"
	if { $new_pbw > $Max_cbw_ } {
		set $new_pbw $Max_cbw_
	}
	$self instvar badclass_
	# link bw is in bits/sec
	set bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]
	$self vprint 1 "new_pbw $new_pbw bw $bw" 
	set nallot [expr $new_pbw / $bw]

	$self pallot $nallot
	$self vprint 2 "penalize done.."
}

#
# move a flow to the good box
# ie stop penalizing a flow
#
RTMechanisms instproc unpenalize goodflow {
	$self instvar npenalty_ badslot_ badhead_ cbqlink_
	$self instvar okboxfm_ pboxfm_
	$self instvar badclass_

	incr npenalty_ -1

	set classifier [$cbqlink_ classifier]
	$self vprint 0 "UNPENALIZE flow $goodflow"

	#
	# delete the bad flow from the cbq/mechanisms classifier
	# this flow will return to the "default" case in the classifier
	# do not "clear" the entry, as that would lose the reference
	# to $badclass_ in the CBQ classifier
	#
	set src [$goodflow set src_]
	set dst [$goodflow set dst_]
	set fid [$goodflow set flowid_]
	$classifier del-hash $src $dst $fid

	#
	# remove flow record from pbox fmon
	# add it to okbox box fmon
	#
	set pcl [$pboxfm_ classifier]
	set pslot [$pcl del-hash $src $dst $fid]
	$pcl clear $pslot
	set gcl [$okboxfm_ classifier]
	set gslot [$gcl installNext $goodflow]
	$goodflow reset
	$gcl set-hash auto $src $dst $fid $gslot

	#
	# reallocate allotment
	#

	set bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]
	set oallot [$badclass_ allot]
	set cbw [expr $oallot * $bw]
	set new_cbw [expr $npenalty_ * $cbw / ($npenalty_ + 1)]
	set nallot [expr $new_cbw / $bw]

	$self pallot $nallot
	$self vprint 2 "unpenalize done..."
}

# Check if bandwidth in penalty box should be adjusted.
# basen on some change in npenalty_
RTMechanisms instproc checkbw_fair guideline_bw {
	$self instvar badclass_
	$self instvar npenalty_ cbqlink_

	if { $guideline_bw == "none" } {
		return "ok"
	}

	set new_cbw [expr 0.5 * $guideline_bw * $npenalty_]
	set link_bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]
	set old_allot [$badclass_ allot]
	set class_bw [expr $old_allot * $link_bw]
	if { $new_cbw < $class_bw } {
		set new_allot [expr $new_cbw / $link_bw]
		return $new_allot
	}
	return "ok"
}

# Check if bandwidth in penalty box should be adjusted.