detaileddm.tcl

在Linux下做的QuadTree的程序

	  # check if the interface is my iif
	  if { $iif_($src) != $ifaceLabel } {
		return 0
	  }
	  if { [$r is-active] } {
		  $self send-join $src $grp
	  }
	  return 1		
	}
	# drop prunes to you on iif
	if { $iif_($src) == $ifaceLabel } {
		return 0
	}
	$ns instvar link_
	if { [detailedDM getLinkType $link_($id:$from)] == "lan" } {
		# if on a lan set the deletion timer
		$self instvar DelTimer_
		if ![info exists DelTimer_($src:$grp)] {
		  set DelTimer_($src:$grp) \
			[new Deletion/Iface/Timer $self $src $grp $ifaceLabel $ns]
		}
		$DelTimer_($src:$grp) schedule
		return 1
	}
	# if on p2p just call delete_oif
	$self delete_oif $src $grp $ifaceLabel
}

detailedDM instproc recv-graft { src group from msg } {
	$self instvar Node PruneTimer_ ns
	# send a graft ack
	$self send-unicast graftAck $src $group $from

	set id [$Node id]
#	puts "at [$ns now] node $id, recv-graft, src $src, grp $group from $from"

	if { $from == $id } {
		return 0
	}
	set r [$Node getRep $src $group]
#	puts "active [$r is-active]"
	if { $r == "" || ![$r is-active] && $src != $id } {
		# send a graft upstream
		$self send-graft $src $group
	}
	$Node instvar outLink_
	set oif $outLink_([$Node get-oifIndex $from])
	if [info exists DelTimer_($src:$group:$oif)] {
		$DelTimer_($src:$group:$oif) cancel
		delete $DelTimer_($src:$group:$oif)
		unset DelTimer_($src:$group:$oif)
	}

	# add the oif to the oiflist
	set iif [$self get_iif $src $group]
	$Node add-mfc $src $group $iif $oif
}

detailedDM instproc send-join { src grp } {
        set iif [$self get_iif $src $grp]   
        set rpf [$self get_rpf $src $grp]
        $self send-mcast join $src $grp $rpf $iif ""
}

detailedDM instproc recv-join { src grp from msg } {
        $self instvar Node DelTimer_
	set to [lindex $msg 0]
        # see if the message is destined to me
        set id [$Node id]
       if { $to != $id } {
		return 0
	}
	# if the deletion timer is running, clear it
	if [info exists DelTimer_($src:$grp)] {
		$DelTimer_($src:$grp) cancel
		delete $DelTimer_($src:$grp)
		unset DelTimer_($src:$grp)
	}
	set iif [$self get_iif $src $grp]
	set oif [$Node label2iface [$Node get-oifIndex $from]]	
	$Node add-mfc $src $grp $iif $oif
}

detailedDM instproc recv-graftAck { src grp from msg } {
	$self instvar RtxTimer_
	# if the retransmission timer is running, clear it
	if [info exists RtxTimer_($src:$grp)] {
		$RtxTimer_($src:$grp) cancel
		delete $RtxTimer_($src:$grp)
		unset RtxTimer_($src:$grp)
	}
}

detailedDM instproc recv-assert { src grp from msg } {
	$self instvar Node iif_ RPF_
	set r [$Node getRep $src $grp]
	if { $r == "" } {
		return 0
	}
	set iif [$Node get-oifIndex $from]
	if { $iif_($src) == $iif } {
	  # I am a downstream router, set the rpf
	  set RPF_($src:$grp) $from
	  return 1
	}
	# I am an upstream router, so check if the cache is active
	set oifObj [$Node label2iface $iif]
	if ![$r exists $oifObj] {
	 	return 0
	}
	$r instvar active_
	if !$active_($oifObj) {
		return 0
	}
	# I have active cache, so compare metric, and address
	# a- compare metric... later, TBD
	# b- compare add
	set id [$Node id]
	if { $from > $id } {
		# I lost the assert, delete oif
		$self delete_oif $src $grp $iif
		return 0
	}
	# I won the assert, send a winning assert
	$self send-assert $src $grp $iif
}

detailedDM instproc get_iif { src grp } {
	$self instvar iif_ Node
	if [info exists iif_($src)] {
		return $iif_($src)
	}
	if { $src == [$Node id] } {
		set iif -2
	} else {
		set iif [$self get-iif-label [$self get_rpf $src $grp]]
	}
	set iif_($src) $iif
	return $iif		
}

detailedDM instproc get_rpf { src grp } {
	$self instvar RPF_ ns Node
	if ![info exists RPF_($src:$grp)] {
		set nbr [$ns upstream-node [$Node id] $src]
		set RPF_($src:$grp) [$nbr id]
	}
	return $RPF_($src:$grp)
}	

detailedDM instproc send-unicast { which src group to } {
	$self instvar prune ns Node
	$prune target [$Node entry]
	$ns instvar Node_
	set id [$Node id]
	set nbr $Node_($to)
	set prune2 [[[$nbr getArbiter] getType [$self info class]] set prune]
	$ns connect $prune $prune2
	if { $which == "graft" } {
		$prune set class_ 31
	} else {
		# graft-ack
		$prune set class_ 32
	}
	$prune transmit $which $id $src $group
}

detailedDM instproc send-mcast { type src grp rpf oifLabel mesg } {
	# check that oif and rpf are not bogus.. 
	# 0 for rpf is needed for asserts

	# iif may be -2 in the source router
	if { $oifLabel < 0 } {
		return 0
	}
	$self instvar prune Node
	set oif [$Node label2iface $oifLabel]
	$prune target $oif

	$prune set dst_ [PIM set ALL_PIM_ROUTERS]
	
	switch $type {
		prune { set cls 30 }
		join { set cls 33 }
		assert { set cls 34 }
		default { puts "unknown type"; return 0 }
	}
	$prune set class_ $cls

	set id [$Node id]
	set msg "$type/$rpf/$mesg"
	$prune transmit $msg $id $src $grp
}

detailedDM instproc delete_oif { src grp oif } {
	$self instvar ns Node DelTimer_ PruneTimer_
	set r [$Node getRep $src $grp]
	if { $r == "" } {
		return -1
	}
	set oifObj [$Node label2iface $oif]
	$r disable $oifObj
	if { ![$r set nactive_] } {
		$self send-prune $src $grp
	}
	# destroy deletion timer
	if [info exists DelTimer_($src:$grp:$oif)] {
		delete $DelTimer_($src:$grp:$oif)
		unset DelTimer_($src:$grp:$oif)
	}
	if ![info exists PruneTimer_($src:$grp:$oif)] {
	  set PruneTimer_($src:$grp:$oif) \
		[new Prune/Iface/Timer $self $src $grp $oif $ns]
	}
	$PruneTimer_($src:$grp:$oif) schedule
}

detailedDM instproc timeoutPrune { oif src grp } {
	$self instvar Node PruneTimer_ ns
	set r [$Node getRep $src $grp]
	if { $r == "" } {
		return -1
	}

	# check if the oif is up
	set nbr [[$Node ifaceGetNode $oif] id]
	set link [$ns set link_([$Node id]:$nbr)]
	if { [$link up?] != "up" } {
		$PruneTimer_($src:$grp:$oif) schedule
		return 0
	}

	set oifObj [$Node label2iface $oif]
	if ![$r is-active] {
		$self send-graft $src $grp
	}
	$r insert $oifObj
	if [info exists PruneTimer_($src:$grp:$oif)] {
		$PruneTimer_($src:$grp:$oif) cancel
		delete $PruneTimer_($src:$grp:$oif)
		unset PruneTimer_($src:$grp:$oif)
	}
	return 1
}

detailedDM instproc stop {} {
	$self instvar RPF_ iif_ PruneTimer_ DelTimer_ RtxTimer_
	if [info exists RPF_] {
		unset RPF_
	}
        if [info exists iif_] {
                unset iif_
        }
        if [info exists DelTimer_] {
		foreach index [array names DelTimer_] {
			$DelTimer_($index) cancel
		}
                unset DelTimer_
        }
        if [info exists PruneTimer_] {
                foreach index [array names PruneTimer_] {
                	$PruneTimer_($index) cancel
                }
		unset PruneTimer_
        }
        if [info exists RtxTimer_] {
                foreach index [array names RtxTimer_] {
                	$RtxTimer_($index) cancel
                }
		unset RtxTimer_
        }
}

###############################################

Class GraftRtx/Timer -superclass Timer

GraftRtx/Timer set timeout 0.05

GraftRtx/Timer instproc init { protocol source group sim} {
	$self instvar src grp proto ns
	set src $source 
	set grp $group
	set proto $protocol
	set ns $sim
}

GraftRtx/Timer instproc schedule {} {
	$self sched [GraftRtx/Timer set timeout]
}

GraftRtx/Timer instproc timeout {} {
	$self instvar proto src grp
	$proto send-graft $src $grp
}

Class Iface/Timer -superclass Timer

Iface/Timer instproc init { protocol source group oiface sim} {
	$self instvar proto src grp oif ns
	set proto $protocol
	set src $source
	set grp $group
	set oif $oiface
	set ns $sim
}

Iface/Timer instproc schedule {} {
	$self sched [[$self info class] set timeout]
}

Class Prune/Iface/Timer -superclass Iface/Timer

Prune/Iface/Timer set timeout 0.5

Prune/Iface/Timer instproc timeout {} {
	$self instvar proto src grp oif
	$proto timeoutPrune $oif $src $grp
}

Class Deletion/Iface/Timer -superclass Iface/Timer

Deletion/Iface/Timer set timeout 0.1

Deletion/Iface/Timer instproc timeout {} {
	$self instvar proto src grp oif
	$proto delete_oif $src $grp $oif
}

###################################

Agent/Mcast/Prune instproc transmit { msg id src grp } {
	$self send $msg $id $src $grp
}

Class Agent/Mcast/Prune/detailedDM -superclass Agent/Mcast/Prune

Agent/Mcast/Prune/detailedDM instproc handle { msg from src grp } {
	$self instvar proto
	set L [split $msg /]
	set type [lindex $L 0]
	set L [lreplace $L 0 0]
	$proto recv-$type $src $grp $from $L
}