mechanisms.tcl

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

# basen on drop rate diffs between good and bad boxes
RTMechanisms instproc checkbw_droprate { droprateB droprateG } {
	$self instvar badclass_
	$self instvar npenalty_ cbqlink_

	set link_bw [expr [[$cbqlink_ link] set bandwidth_] / 8.0]
	set old_allot [$badclass_ allot]
	if { $droprateB < 2 * $droprateG } {
		set class_bw [expr $old_allot * $link_bw]
		set new_cbw [expr 0.5 * $class_bw]
		set new_allot [expr $new_cbw / $link_bw]
		$self vprint 0 "Penalty box: was $old_allot now $new_allot"
		return $new_allot
	}
	$self vprint 1 "Penalty box: $old_allot"
	return "ok"
}

#
# main routine to determine if there are bad flows to penalize
#
RTMechanisms instproc sched-detect {} {
	$self instvar Detect_interval_ detect_pending_
	$self instvar ns_
	if { $detect_pending_ == "true" } {
		$self vprint 2 "SCHEDULING DETECT (NO, ALREADY PENDING)"
		return
	}
	set now [$ns_ now]
	set then [expr $now + $Detect_interval_]
	set detect_pending_ true
	$ns_ at $then "$self do_detect"
	$self vprint 2 "SCHEDULING DETECT for $then"
}
	
RTMechanisms instproc do_detect {} {
	$self instvar ns_
	$self instvar last_detect_
	$self instvar Mintime_ Rtt_ Mtu_
	$self instvar okboxfm_
	$self instvar state_
	$self instvar detect_pending_

	$okboxfm_ dump

	set detect_pending_ false
	set now [$ns_ now]
	$self vprint 2 "DO_DETECT started at time $now, last: $last_detect_"
	set elapsed [expr $now - $last_detect_]
	set last_detect_ $now
	if { $elapsed < $Mintime_ } {
		puts "ERROR: do_detect: elapsed: $elapsed, min: $Mintime_"
		exit 1
	}

	set barrivals [$okboxfm_ set barrivals_]
	set parrivals [$okboxfm_ set parrivals_]
	set ndrops [$okboxfm_ set pdrops_] ; # drops == (total drops, incl epd)
	set droprateG [$self frac $ndrops $parrivals]

	set M [$self mmetric max "[$okboxfm_ flows]"]
	set badflow [lindex $M 0]
	set maxmetric [lindex $M 1]

	$self vprint 2 "DO_DETECT: droprateG: $droprateG (drops:$ndrops, arrs:$parrivals"
	if { $badflow == "none" } {
		$self vprint 1 "DO_DETECT: no candidate bad flows... returning"
		$self sched-detect
		# nobody
		return
	}
	$self vprint 2 "DO_DETECT: possible bad flow: $badflow ([$badflow set src_], [$badflow set dst_], [$badflow set flowid_]), maxmetric:$maxmetric"

	set known false
	if { [info exists state_($badflow,ctime)] } {
		set known true
		set flowage [expr $now - $state_($badflow,ctime)]
		if { $flowage < $Mintime_ } {
			$self vprint 1 "DO_DETECT: flow $badflow too young ($flowage)"
			$self sched-detect
			return
		}
	}

	# estimate the bw's arrival rate without knowing it directly
	#	note: in ns-1 maxmetric was a %age, here it is a frac
	set flow_bw_est [expr $maxmetric * $barrivals / $elapsed]
	$self vprint 9 "maxmetric $maxmetric barrivals $barrivals elapsed $elapsed"
	set guideline_bw  [$self tcp_ref_bw $Mtu_ $Rtt_ $droprateG]

	set friendly [$self test_friendly $badflow $flow_bw_est $guideline_bw]
	if { $friendly == "fail" } {
		# didn't pass friendly test
		$self setstate $badflow "UNFRIENDLY" $flow_bw_est $droprateG
		$self penalize $badflow $guideline_bw
		$self sched-reward
	} elseif { $known == "true" && $state_($badflow,reason) == "UNRESPONSIVE" } {
		# was unresponsive once already
		$self vprint 1 "WAS unresponsive once already"
		$self instvar PUFrac_
		set u [$self test_unresponsive_again \
		    $badflow $flow_bw_est $droprateG $PUFrac_ $PUFrac_]
		if { $u == "fail" } {
			# is still unresponsive
			$self setstate $badflow "UNRESPONSIVE2" \
			    $flow_bw_est $droprateG
			$self penalize $badflow $flow_bw_est
			$self sched-reward
		}
	} else {
		set nxt [$self fhist-add $badflow $droprateG $flow_bw_est]
		set u [$self test_unresponsive_initial \
		    $badflow $flow_bw_est $droprateG $nxt]
		if { $u == "fail" } {
			$self vprint 1 "FIRST TIME unresponsive"
			$self setstate $badflow "UNRESPONSIVE" \
			    $flow_bw_est $droprateG
		} elseif { [$self test_high $badflow $flow_bw_est $droprateG $elapsed] == "fail" } {
			$self setstate $badflow "HIGH" \
			    $flow_bw_est $droprateG
			$self penalize $badflow $flow_bw_est
			$self sched-reward
		} else {
			set ck1 [$self checkbw_fair $guideline_bw]
			set ck2 [$self checkbw_fair $flow_bw_est]
			if { $ck1 == "fail" || $ck2 == "fail" } {
				if { $ck1 == "ok" } {
					set nallot $ck2
				} elseif { $ck2 == "ok" } {
					set nallot $ck1
				} else {
					set nallot $ck2
					if { $ck1 < $ck2 } {
						set nallot $ck1
					}
				}
				$self pallot $nallot
			}
		}
	}
	$self sched-detect
	foreach f [$okboxfm_ flows] {
		$f reset
	}
	$okboxfm_ reset
	$self vprint 2 "do_detect complete..."
}


#
# main routine to determine if there are restricted flows
# that are now behaving better
#

RTMechanisms instproc sched-reward {} {
	$self instvar Reward_interval_ reward_pending_ 
	$self instvar ns_
	if { $reward_pending_ == "true" } {
		$self vprint 2 "SCHEDULING REWARD (NO, ALREADY PENDING)"
		return
	}
	set now [$ns_ now]
	set then [expr $now + $Reward_interval_]
	set reward_pending_ true
	$ns_ at $then "$self do_reward"
	$self vprint 1 "SCHEDULING REWARD for $then"
}
RTMechanisms instproc do_reward {} {
	$self instvar ns_
	$self instvar last_reward_ reward_pending_
	$self instvar Mintime_
	$self instvar state_
	$self instvar pboxfm_ okboxfm_
	$self instvar npenalty_
	$self instvar Mtu_ Rtt_

	$pboxfm_ dump

	set reward_pending_ false
	set now [$ns_ now]
	$self vprint 2 "DO_REWARD starting at $now, last: $last_reward_"
### Is this wrong? - question from Ion Stoica.
### When is $last_reward_ set when a flow is first penalized?
### What if the "penalize" and "reward" cycles are not in sync?
### So that "$now - $last_reward_" is long, but that flow has
### not been categorized in this box for that period of time?
	set elapsed [expr $now - $last_reward_]

	set last_reward_ $now

	if { $npenalty_ == 0 } {
		return
	}

	set parrivals [$pboxfm_ set parrivals_]
	set pdepartures [$pboxfm_ set pdepartures_]
	set pdrops [$pboxfm_ set pdrops_]
	set barrivals [$pboxfm_ set barrivals_]
	set badBps [expr $barrivals / $elapsed]
	set pflows [$pboxfm_ flows] ; # all penalized flows


	$self vprint 1 "DO_REWARD: droprateB: [$self frac $pdrops $parrivals] (pdrops: $pdrops, parr: $parrivals pdep: $pdepartures)"
	$self vprint 1 "DO_REWARD: badbox pool of flows: $pflows"

	if { $parrivals == 0 && $elapsed > $Mintime_ } {
		# nothing!, everybody becomes good
		$self vprint 1 "do_reward: no bad flows, reward all"
		foreach f $pflows {
			$self unpenalize $f
		}
		set npenalty_ 0
		return
	}

	set droprateB [$self frac $pdrops $parrivals]
	set M [$self mmetric min "$pflows"]
	set goodflow [lindex $M 0]
	set goodmetric [lindex $M 1]
	if { $goodflow == "none" } {
		#none
		$self sched-reward
		return
	}
	set flowage [expr $now - $state_($goodflow,ctime)]
	$self vprint 2 "found flow $goodflow as potential good-guy (age: $flowage)"
	if { $flowage < $Mintime_ } {
		$self vprint 1 "DO_REWARD: flow $goodflow too young ($flowage) to be rewarded"
		$self sched-reward
		return
	}


	set pgoodarrivals [$okboxfm_ set parrivals_]
	set ngdrops [$okboxfm_ set pdrops_]
	set droprateG [$self frac $ngdrops $pgoodarrivals]


	# assume we have per-flow arrival stats in bad box
	#set flow_bw_est [expr $goodmetric * $barrivals / $elapsed]
	set flow_bw_est [expr [$goodflow set barrivals_] / $elapsed]
	
	# if it was unfriendly and is now friendly, reward
	# if it was unresp and is now resp + friendly, reward
	# if it was high and is now !high + friendly, reward
	#
	switch $state_($goodflow,reason) {
		"UNFRIENDLY" {
			set fr [$self test_friendly $goodflow $flow_bw_est \
			    [$self tcp_ref_bw $Mtu_ $Rtt_ $droprateB]]
			if { $fr == "ok" } {
				$self setstate $goodflow "OK" $flow_bw_est $droprateB
				$self unpenalize $goodflow
			}
		}

		"UNRESPONSIVE" {
			$self instvar RUBFrac_
			$self instvar RUDFrac_
			set unr [$self test_unresponsive_again $goodflow $RUBFrac_ $RUDFrac_]
			if { $unr == "ok" } {
			    set fr [$self test_friendly $goodflow $flow_bw_est \
			      [$self tcp_ref_bw $Mtu_ $Rtt_ $droprateB]]
			    if { $fr == "ok" } {
				$self setstate $goodflow "OK" $flow_bw_est $droprateB
				$self unpenalize $goodflow
			    }
			}
		}

		"HIGH" {
			set h [$self test_high $goodflow $flow_bw_est $droprateB $elapsed]
			if { $h == "ok" } {
			    set fr [$self test_friendly $goodflow $flow_bw_est \
			      [$self tcp_ref_bw $Mtu_ $Rtt_ $droprateB]]
			    if { $fr == "ok" } {
				$self setstate $goodflow "OK" $flow_bw_est $droprateB
				$self unpenalize $goodflow
			    }
			}
		}
	}
	if { $npenalty_ > 0 } {
		$self checkbw_droprate $droprateB $droprateG
	}
	$self sched-reward
	foreach f [$pboxfm_ flows] {
		$f reset
	}
	$pboxfm_ reset
	$self vprint 2 "do_reward complete..."
}