bst.tcl

跑leach需要的

#
# tcl/mcast/BST.tcl
#
#
# Copyright (C) 1998 by USC/ISI
# All rights reserved.                                            
#                                                                
# Redistribution and use in source and binary forms are permitted
# provided that the above copyright notice and this paragraph are
# duplicated in all such forms and that any documentation, advertising
# materials, and other materials related to such distribution and use
# acknowledge that the software was developed by the University of
# Southern California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived from
# this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
# 
#
#
# Written by Yuri Pryadkin
# Modified by Nader Saelhi
#
###############
# Implementation of a simple shared bi-directional tree protocol.  No
# timers.  Nodes send grafts/prunes toward the RP to join/leave the
# group.  The user needs to set two protocol variables: 
#
# "BST set RP_($group) $node" - indicates that $node 
#                               acts as an RP for the $group

Class BST -superclass McastProtocol

BST instproc init { sim node } {
	$self instvar mctrl_ oiflist_
	BST instvar RP_

	set mctrl_ [new Agent/Mcast/Control $self]
	$node attach $mctrl_
	$self next $sim $node
}

BST instproc start {} {
	$self instvar node_ oiflist_
	BST instvar RP_

	# need to do it in start when unicast routing is computed
	foreach grpx [array names RP_] {
                set grp [expr $grpx]
#	      	$self dbg "BST: grp $grp, node [$node_ id]"
               	if { [string compare $grp $grpx] } {
			set RP_($grp) $RP_(grpx)
			unset RP_($grpx)
               	}
		set rpfiif [$node_ from-node-iface $RP_($grp)]
#		$self dbg "BST: rpfiif $rpfiif"
		if { $rpfiif != "?" } {
			set rpfoif [$node_ iif2oif $rpfiif]
		} else {
			set rpfoif ""
		}

		# initialize with the value of rpfoif
		set oiflist_($grp) $rpfoif
		set neighbors [$node_ set neighbor_]
		if [info exists neighbors] {
			for {set i 0} {$i < [llength $neighbors]} {incr i} {
				set neighbor [lindex $neighbors $i]
				set class_info [$neighbor info class]
				if {$class_info == "LanNode"} {
					# This node is on a LAN, we
					# must designate a router for
					# the mcast group   
					$neighbor designate-ump-router $grp \
					    $RP_($grp)
				}
			}
		}
	}

}

BST instproc join-group  { group {src "x"} } {
	$self instvar node_ ns_ oiflist_
	BST instvar RP_
	
	set nbr [$node_ rpf-nbr $RP_($group)]
	set nbrs($nbr) 1
	$node_ add-mark m1 blue "[$node_ get-shape]"
	foreach nbr [array names nbrs] {
		if [$nbr is-lan?] {
			$nbr instvar receivers_
			if [info exists receivers_($group)] {
				incr receivers_($group)
			} else {
				$self send-ctrl "graft" $RP_($group) $group
				set receivers_($group) 1
			}
		}
		$self next $group ; #annotate
	}

	if { ![$node_ check-local $group] || [$node_ getReps "x" \
					      $group] == ""} { 
# 		$self dbg "Sending join-group"
		$self send-ctrl "graft" $RP_($group) $group
	}

}

BST instproc leave-group { group {src "x"} } {
	BST instvar RP_ 

	$self next $group ;#annotate
	$self instvar node_ oiflist_

	set nbr [$node_ rpf-nbr $RP_($group)]
	if  [$nbr is-lan?] {
		$nbr instvar receivers_
		if [info exists receivers_($group)] {
			if {$receivers_($group) > 0} {
				incr receivers_($group) -1
				if {$receivers_($group) == 0} {
					$node_ delete-mark m1
					$self send-ctrl "prune" $RP_($group) $group
				}
			}
		} else {
			# Nobody has joined yet
			return
		}
	} else {
		set rpfiif [$node_ from-node-iface $RP_($group)]
		if { $rpfiif != "?" } {
			set rpfoif [$node_ iif2oif $rpfiif]
		} else {
			set rpfoif ""
		}
		if { $oiflist_($group) == \
			 $rpfoif && ![$node_ check-local $group] } {
			# propagate
			$self send-ctrl "prune" $RP_($group) $group
			$node_ delete-mark m1
		} else {
			$node_ delete-mark m1
			$node_ add-mark m2 red circle
		}
	}

}

# handle-wrong-iif
# This function does nothing
BST instproc handle-wrong-iif { srcID group iface } {
	$self instvar node_ oiflist_
	BST instvar RP_
	
#    	$self dbg "BST: wrong iif $iface, src $srcID, grp $group"
#    	$self dbg "\t oiflist: $oiflist_($group)"

	set rep [$node_ getReps "x" $group]

	$node_ add-mfc "x" $group $iface $oiflist_($group)
	set iif [$node_ lookup-iface "x" $group]
	if { $iface >= 0 } {
		set oif [$node_ iif2oif $iface]
		set rpfiif [$node_ from-node-iface $RP_($group)]
		if { $iface == $rpfiif } {
			# forward direction: disable oif to RP
			$rep disable [$node_ iif2oif $rpfiif]
		} else {
			# reverse direction: disable where it came from
			$rep disable $oif
			if { $node_ != $RP_($group) } {
				$rep insert [$node_ iif2oif $rpfiif]
			}
		}
	}
	$node_ change-iface "x" $group $iif $iface
	return 1 ;#classify packet again
}

# handle-cache-miss
# Creates a (*, G) entry for a group.  
BST instproc handle-cache-miss { srcID group iface } {
	$self instvar node_  ns_ oiflist_
	BST instvar RP_
	
	if { [$node_ getReps "x" $group] != "" } {
		error
	}

	
#      	$self dbg \
#  	    "handle-cache-miss, src: $srcID, group: $group, iface: $iface"
#     	$self dbg \
#  	    "********* miss: adding <x, $group, $iface, $oiflist_($group)>"

	# Check if the node is on a LAN.  If so we should NOT resume
	# if:
	#	1) The node is not the next upstream router, and
	#	2) The incoming interface is to a LanNode, and
	#	3) The node is not a source.

 	if {$iface != -1} {
		# if the node is not a source (3)
 		set neighbors [$node_ set neighbor_]
		if [info exists neighbors] {
			for {set i 0} {$i < [llength $neighbors]} {incr i} {
				set neighbor [lindex $neighbors $i]
				set nbr [$node_ rpf-nbr $RP_($group)]
				if {[$neighbor is-lan?] && \
					[$nbr info class] != "LanNode"} {
					# The node is directly
					# connected to RP --or at
					# least not via LanNode
					$neighbor instvar up_
					set up [$neighbor set up_($group)]
					if {$node_ != $up} {
						# If not the upstream
						# router (1) 
						if [$self link2lan? $neighbor \
							$iface] {
							# The interface is to 
							# the LAN
							return 0
						}
					}
				}
			}
		}
 	}
    
	$node_ add-mfc "x" $group $iface $oiflist_($group)

	if { $iface > 0 } {
		#disable reverse iface
		set rep [$node_ getReps "x" $group]
		$rep disable [$node_ iif2oif $iface]
	}
	return 1 ;# classify the packet again.
}

BST instproc drop { replicator src dst iface} {
	$self instvar node_ ns_
	BST instvar RP_
	
	# No downstream listeners? Just drop the packet. No purning is
	# necessary  
# 	$self dbg "drops src: $src, dst: $dst, replicator: [$replicator set srcID_]"
	
	if {$iface >= 0} {
		# so, this packet came from outside of the node.
		# Since PIM works based on explicit join mechanism,
		# the only action is to drop unwanted packets.
# 		$self dbg "drops the unwanted packet"
	}
}

BST instproc recv-prune { from src group iface} {
	$self instvar node_ ns_ oiflist_ 
	BST instvar RP_ 
# 	$self dbg "received a prune from: $from, src: $src, grp: $group, if: $iface"

	set rep [$node_ getReps "x" $group]
	if {$rep != ""} {
		set oif [$node_ iif2oif $iface]
		set idx [lsearch $oiflist_($group) $oif]
		if { $idx >= 0 } {
			set oiflist_($group) [lreplace $oiflist_($group) $idx $idx]
			$rep disable $oif
			set rpfiif [$node_ from-node-iface $RP_($group)]
			if { $rpfiif != "?" } {
				set rpfoif [$node_ iif2oif $rpfiif]
			} else {
				set rpfoif ""
			}
			if { $oiflist_($group) == $rpfoif && ![$node_ check-local $group] } {
				# propagate
				$node_ delete-mark m2
				$self send-ctrl "prune" $RP_($group) $group
			}
		}
	}
}

BST instproc recv-graft { from to group iface } {
	$self instvar node_ ns_ oiflist_
	BST instvar RP_
	
#  	$self dbg "received a graft from: $from, to: $to, if: $iface"
	set oif [$node_ iif2oif $iface]
	set rpfiif [$node_ from-node-iface $RP_($group)]
	if { $rpfiif != "?" } {
		set rpfoif [$node_ iif2oif $rpfiif]
	} else {