ssmmcastcomp.tcl

ssm multicast extension for ns-2

#
# tcl/ssm-mcast/SSMMcastComp.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.
#
# Contributed by Polly Huang (USC/ISI), http://www-scf.usc.edu/~bhuang
#
# Contributed by Tiago Camilo (DEI/UC)

Class SSMMcastComp

SSMMcastComp instproc init sim {
	$self instvar ns_

	set ns_ $sim
	$self init-groups
	$ns_ maybeEnableTraceAll $self {}
}

SSMMcastComp instproc id {} {
	return 0
}

SSMMcastComp instproc trace { f nop {op ""} } {
        $self instvar ns_ dynT_
	if {$op == "nam" && [info exists dynT_]} {
		foreach tr $dynT_ {
			$tr namattach $f
		}
	} else {
		lappend dynT_ [$ns_ create-trace Generic $f $self $self $op]
	}
}

##### Main computation functions #####
SSMMcastComp instproc reset-mroutes {} {
	$self instvar ns_

	foreach node [$ns_ all-nodes-list] {
		foreach group [$self groups?] {
		    set class_info [$node info class]
		    if {$class_info != "LanNode"} {
			$node clearReps * $group
		    }
		}
	}
}

SSMMcastComp instproc compute-mroutes {} {
	$self reset-mroutes
	foreach group [$self groups?] {
		$self compute-tree $src $group
	}
}

SSMMcastComp instproc compute-tree { src group } {
	foreach mem [$self members? $src $group] {
		$self compute-branch $src $group $mem
	}
}


SSMMcastComp instproc compute-branch { src group nodeh } {
	$self instvar ns_

	### set (S,G) join target
	set tt [$self new-source-group? $src $group]
		set target $src

	for {
		set downstreamtmp ""
		set tmp $nodeh
	} { $downstreamtmp != $target } {
		set downstreamtmp $tmp
		set tmp [$tmp rpf-nbr $target]
	} {

		if {[SessionSim set MixMode_] && $downstreamtmp != "" && ![$ns_ detailed-link? [$tmp id] [$downstreamtmp id]]} {
		    break
		}


		### set iif : RPF link interface label
		if {$tmp == $target} {
		    # at src or RP
		    set iif -1
		} else {
		    set rpfl [$ns_ link [$tmp rpf-nbr $target] $tmp]

		    if {[SessionSim set MixMode_] && $rpfl == ""} {
			# in mix mode: default -1 unless find a
			# detailed link on the rpf path
			set iif -1
			set ttmp $tmp
			while {$ttmp != $target} {
			    set rpfl [$ns_ link [$ttmp rpf-nbr $target] $ttmp]
			    if {$rpfl != ""} {
				set iif [$rpfl if-label?]
				break
			    }
			    set ttmp [$ttmp rpf-nbr $target]
			}
		    } else {
			# in regular detailed mode
			set iif [$rpfl if-label?]
		    }
		}

		### set oif : RPF link
		set oiflist ""
		if { $downstreamtmp != "" } {
			set rpfnbr [$downstreamtmp rpf-nbr $target]
			if { $rpfnbr == $tmp } {
			    set rpflink [$ns_ link $tmp $downstreamtmp]
			    if {$rpflink != ""} {
				set oiflist [$tmp link2oif $rpflink]
			    }
			}
		}

		if { [set r [$tmp getReps [$src id] $group]] != "" } {
			if [$r is-active] {
				# puts "reach merging point, $group [$src id] [$target id] [$tmp id] [$nodeh id], iif $iif, oif $oiflist"
				if { $oiflist != "" } {
					$r insert [lindex $oiflist 0]
				}
				break
			} else {
				# puts "hasn't reached merging point, $group [$src id] [$target id] [$tmp id] [$nodeh id], iif $iif, oif $oiflist"
				# so continue to insert the oif
				if { $oiflist != "" } {
					$r insert [lindex $oiflist 0]
				}
			}
		} else {
			# hasn't reached merging point,
			# puts "so keep creating (S,G) like a graft, $group [$src id] [$target id] [$tmp id] [$nodeh id], iif $iif, oif $oiflist"
			$tmp add-mfc [$src id] $group $iif $oiflist
		}
	}
}


SSMMcastComp instproc prune-branch { src group nodeh } {
	$self instvar ns_

	### set (S,G) prune target
	set tt [$self new-source-group? $src $group]

	set target $src


	for {
		set downstreamtmp ""
		set tmp $nodeh
	} { $downstreamtmp != $target } {
		set downstreamtmp $tmp
		set tmp [$tmp rpf-nbr $target]
	} {
		set iif -1
		set oif ""
		if { $downstreamtmp != "" } {
			set rpfnbr [$downstreamtmp rpf-nbr $target]
			if { $rpfnbr == $tmp } {
				set oif [$tmp link2oif [$ns_ link $tmp $downstreamtmp]]
			}
		}

		if { [set r [$tmp getReps [$src id] $group]] != "" } {
			if { $oif != "" } {
				$r disable $oif
			}

			if [$r is-active] {
				break
			}
		} else {
			break
		}
	}

}

# notify(): adapt to rtglib dynamics
SSMMcastComp instproc notify {} {
	#$self instvar ctrrpcomp
	$self compute-mroutes
}

#
# utility functions to track Source, Group, and Member State
#
SSMMcastComp instproc init-groups {} {
	$self instvar ns_
	#$self set Glist_ ""

	foreach node [$ns_ all-nodes-list] {
		$self set SGlist_($node) ""
	}
}

SSMMcastComp instproc add-new-source-group { group src } {
    #$self instvar Glist_
    $self instvar SGlist_
    set group [expr $group]


    set srcID [$src id]
    if ![info exist SGlist_($srcID)] {
        set SGlist_($srcID) ""
    }
    if {[lsearch $SGlist_($srcID) $group] < 0} {
        lappend SGlist_($srcID) $group
    }
}

SSMMcastComp instproc add-new-member {group node src} {
    #$self instvar Mlist_

    $self instvar Mlist_

    set group [expr $group]

    set srcID [$src id]

    
    $self add-new-source-group $group $src

    if ![info exist Mlist_($srcID,$group)] {
        set Mlist_($srcID,$group) ""
    }

    if {[lsearch $Mlist_($srcID,$group) $node] < 0} {
        lappend Mlist_($srcID,$group) $node
    }

}

SSMMcastComp instproc new-source? {group node srcID} {
    $self instvar SGlist_
    $self instvar ns_
    set group [expr $group]

    set nodesrc [$ns_ get-node-by-id $srcID]
    $self add-new-source-group $group $nodesrc

    if {[lsearch $SGlist_($srcID) $group] < 0} {
        return 1
    } else {
    	return 0
    }
}

SSMMcastComp instproc groups? {} {
	$self set SGlist_
}

SSMMcastComp instproc members? {src group} {
	$self instvar Mlist_
	set group [expr $group]
	set srcID [$src id]
	if ![info exists Mlist_($srcID,$group)] {
		set Mlist_($srcID,$group) ""
	}
	set Mlist_($srcID,$group)
}


SSMMcastComp instproc remove-member {group node src} {
    #$self instvar Mlist_ Glist_ SGlist_
    $self instvar Mlist_ SGlist_
    set group [expr $group]
    set srcID [$src id]

    set k [lsearch $Mlist_($srcID,$group) $node]
    if {$k < 0} {
	puts "warning: removing non-member"
    } else {
	set Mlist_($srcID,$group) [lreplace $Mlist_($srcID,$group) $k $k]
    }
    if { $Mlist_($srcID,$group) == "" } {
	set k [lsearch $SGlist_($srcID) $group]
	if {$k < 0} {
	    puts "warning: removing non-existing group"
	} else {
	    set SGlist_($srcID) [lreplace $SGlist_($srcID) $k $k]
	}
    }

}


SSMMcastComp instproc new-source-group? {src group} {
	$self instvar SGlist_
	set group [expr $group]
	set srcID [$src id]
	if [info exists SGlist($srcID)$group] {
		return SGlist($srcID)$group
	} else {
		return ""
	}
}

SSMMcastComp instproc treetype {group tree} {
	$self set treetype_([expr $group]) $tree
}

SSMMcastComp instproc switch-treetype group {
	$self instvar treetype_ dynT_
	set group [expr $group]

	if [info exists dynT_] {
		foreach tr $dynT_ {
			$tr annotate "$group switch tree type"
		}
	}
	
	set src 1

	set treetype_($group) "SPT"
	$self add-new-source-group $group $src
	$self compute-mroutes
}