## tcl/mcast/DM.tcl## Copyright (C) 1997 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.# # Ported/Modified by Polly Huang (USC/ISI), http://www-scf.usc.edu/~bhuang# Class DM -superclass McastProtocolDM set PruneTimeout  0.5DM set CacheMissMode pimdm ;#or dvmrp (lowercase)DM instproc init { sim node } {	$self instvar mctrl_	set mctrl_ [new Agent/Mcast/Control $self]	$node attach $mctrl_	Timer/Iface/Prune set timeout [[$self info class] set PruneTimeout]	$self next $sim $node}DM instproc join-group  { group } {	$self instvar node_	$self next $group	set listOfReps [$node_ getReps * $group]	foreach r $listOfReps {		if ![$r is-active] {			$self send-ctrl "graft" [$r set srcID_] $group			set nbr [$node_ rpf-nbr [$r set srcID_]]			set nbrs($nbr) 1		}	}	foreach nbr [array names nbrs] {		if [$nbr is-lan?] {			# for each LAN we maintain an array of  counters 			# of how many local receivers we have on the lan 			# for a given group			$nbr instvar receivers_			if [info exists receivers_($group)] {				incr receivers_($group)			} else {				set receivers_($group) 1			}		}	}}DM instproc leave-group { group } {        $self next $group	$self instvar node_	# lan: decrement counters	set listOfReps [$node_ getReps * $group]	foreach r $listOfReps {		set nbr [$node_ rpf-nbr [$r set srcID_]]		set nbrs($nbr) 1	}	foreach nbr [array names nbrs] {		if [$nbr is-lan?] {			$nbr instvar receivers_			if { [info exists receivers_($group)] && \					$receivers_($group) > 0 } {				incr receivers_($group) -1			}		}	}}DM instproc handle-wrong-iif { srcID group iface } {	$self instvar node_ ns_	set inlink  [$node_ iif2link $iface]	set from [$inlink src]	$self send-ctrl "prune" $srcID $group [$from id]	return 0 ;# don't call this method two times}DM instproc handle-cache-miss  { srcID group iface } {	DM instvar CacheMissMode	$self handle-cache-miss-$CacheMissMode $srcID $group $iface	return 1 ;#call again}DM instproc handle-cache-miss-pimdm { srcID group iface } {        $self instvar node_ ns_		if { $iface >= 0 } {		set rpf_nbr [$node_ rpf-nbr $srcID]		set inlink  [$node_ iif2link $iface]		set rpflink [$ns_ link $rpf_nbr $node_]		if { $inlink != $rpflink } {			set from [$inlink src]			$self send-ctrl "prune" $srcID $group [$from id]			return 0; #drop this packet		}		set rpfoif [$node_ iif2oif $iface]	} else {		set rpfoif ""	}	set alloifs [$node_ get-all-oifs]	set oiflist ""	foreach oif $alloifs {		if {$oif == $rpfoif} {			continue ;#exclude incoming iface		}		set dst [[$node_ oif2link $oif] dst]		if { [$dst is-lan?] && [$dst rpf-nbr $srcID] != $node_  } {			# exclude also lan oifs for which we are not forwarders			# this constitutes a form of "centralized" assert mechanism			continue 		}		lappend oiflist $oif	}	#set idx [lsearch $oiflist $rpfoif]	#set oiflist [lreplace $oiflist $idx $idx]	$node_ add-mfc $srcID $group $iface $oiflist}DM instproc handle-cache-miss-dvmrp { srcID group iface } {        $self instvar node_ ns_	set oiflist ""        foreach nbr [$node_ neighbors] {		# peek into other nodes' routing tables to simulate 		# child-parent relationship maintained by dvmrp		set rpfnbr [$nbr rpf-nbr $srcID]		if { $rpfnbr == $node_ } {			set link [$ns_ link $node_ $nbr]			lappend oiflist [$node_ link2oif $link]		}			}	$node_ add-mfc $srcID $group $iface $oiflist}DM instproc drop { replicator src dst iface} {	$self instvar node_ ns_        if { $iface < 0 } {                # optimization for sender: if no listeners, set the ignore bit, 		# so this function isn't called for every packet.		$replicator set ignore_ 1        } else {		set from [[$node_ iif2link $iface] src]		if [$from is-lan?] {			$self send-ctrl "prune" $src $dst		} else {			$self send-ctrl "prune" $src $dst [$from id]		}	}}DM instproc recv-prune { from src group iface} {        $self instvar node_ PruneTimer_ ns_	set r [$node_ getReps $src $group]	if { $r == "" } { 		return 0	}	set id [$node_ id]	set tmpoif [$node_ iif2oif $iface]	if { [$r is-active-target $tmpoif] } {		$r disable $tmpoif		if ![$r is-active] {			if { $src != $id } {				# propagate prune only if the disabled oif				# was the last one				$self send-ctrl prune $src $group			}		}	}	if ![info exists PruneTimer_($src:$group:$tmpoif)] {		set PruneTimer_($src:$group:$tmpoif) \				[new Timer/Iface/Prune $self $src $group $tmpoif $ns_]	}	$PruneTimer_($src:$group:$tmpoif) schedule}DM instproc recv-graft { from src group iface} {        $self instvar node_ PruneTimer_ ns_	set id [$node_ id]        set r [$node_ getReps $src $group]	if { $r == "" } {		if { $id == $src } {			set iif "?"		} else {			set rpfnbr [$node_ rpf_nbr $src]			set rpflnk [$ns_ link $src $id]			set iif [$node_ link2iif $rpflnk]		}		$node_ add-mfc $src $group $iif ""	        set r [$node_ getReps $src $group]	}         if { ![$r is-active] && $src != $id } {                # propagate the graft                $self send-ctrl graft $src $group        }	set tmpoif [$node_ iif2oif $iface]        $r enable $tmpoif	if [info exists PruneTimer_($src:$group:$tmpoif)] {		delete $PruneTimer_($src:$group:$tmpoif)		unset  PruneTimer_($src:$group:$tmpoif)	}}# send a graft/prune for src/group up to the source or towards $toDM instproc send-ctrl { which src group { to "" } } {        $self instvar mctrl_ ns_ node_	if { $to != "" } {		set n [$ns_ get-node-by-id $to]		# we don't want to send anything to a lanNode		if [$n is-lan?] return		set toid $to	} else {		set toid $src	}	set nbr [$node_ rpf-nbr $toid]	if [$nbr is-lan?] {		# we're requested to send via a lan: $nbr		$nbr instvar receivers_		# send a graft/prune only if there're no other receivers on the lan		if { [info exists receivers_($group)] && \				$receivers_($group) > 0 } return 		# need to send: find the next hope node		set nbr [$nbr rpf-nbr $toid]	}	$ns_ simplex-connect $mctrl_ \			[[[$nbr getArbiter] getType [$self info class]] set mctrl_]        if { $which == "prune" } {                $mctrl_ set class_ 30        } else {                $mctrl_ set class_ 31        }                $mctrl_ send $which [$node_ id] $src $group}DM instproc timeoutPrune { oif src grp } {	$self instvar node_ PruneTimer_ ns_	set r [$node_ getReps $src $grp]	$r insert $oif	if [info exists PruneTimer_($src:$grp:$oif)] {		delete $PruneTimer_($src:$grp:$oif)		unset PruneTimer_($src:$grp:$oif)	}	return}Class Timer/Iface/Prune -superclass Timer/IfaceTimer/Iface/Prune set timeout 0.5Timer/Iface/Prune instproc timeout {} {	$self instvar proto_ src_ grp_ oif_	$proto_ timeoutPrune $oif_ $src_ $grp_}