route-proto.tcl

CBRP协议（移动adhoc中基于分簇的路由协议）ns2下的源码

Class Agent/rtProto/Static -superclass Agent/rtProto

Agent/rtProto/Static proc init-all args {
    # The Simulator knows the entire topology.
    # Hence, the current compute-routes method in the Simulator class is
    # well suited.  We use it as is.
    [Simulator instance] compute-routes
}

#
# Session based unicast routing
#
Class Agent/rtProto/Session -superclass Agent/rtProto

Agent/rtProto/Session proc init-all args {
    [Simulator instance] compute-routes
}

Agent/rtProto/Session proc compute-all {} {
    [Simulator instance] compute-routes
}

#
#########################################################################
#
# Code below this line is experimental, and should be considered work
# in progress.  None of this code is used in production test-suites, or
# in the release yet, and hence should not be a problem to anyone.
#
Class Agent/rtProto/Direct -superclass Agent/rtProto
Agent/rtProto/Direct instproc init node {
    $self next $node
    $self instvar ns_ rtpref_ nextHop_ metric_ ifs_

    foreach node [$ns_ all-nodes-list] {
	set rtpref_($node) 255
	set nextHop_($node) ""
	set metric_($node) -1
    }
    foreach node [array names ifs_] {
	set rtpref_($node) [$class set preference_]
    }
}

Agent/rtProto/Direct instproc compute-routes {} {
    $self instvar ifs_ ifstat_ nextHop_ metric_ rtsChanged_
    set rtsChanged_ 0
    foreach nbr [array names ifs_] {
	if {$nextHop_($nbr) == "" && [$ifs_($nbr) up?] == "up"} {
	    set ifstat_($nbr) 1
	    set nextHop_($nbr) $ifs_($nbr)
	    set metric_($nbr) 1
	    incr rtsChanged_
	} elseif {$nextHop_($nbr) != "" && [$ifs_($nbr) up?] != "up"} {
	    set ifstat_($nbr) 0
	    set nextHop_($nbr) ""
	    set metric_($nbr) -1
	    incr rtsChanged_
	}
    }
}

#
# Distance Vector Route Computation
#
# Class Agent/rtProto/DV -superclass Agent/rtProto
Agent/rtProto/DV set UNREACHABLE	[rtObject set unreach_]
Agent/rtProto/DV set mid_		  0

Agent/rtProto/DV proc init-all args {
    if { [llength $args] == 0 } {
	set nodeslist [[Simulator instance] all-nodes-list]
    } else {
	eval "set nodeslist $args"
    }
    eval rtObject init-all $nodeslist
    foreach node $nodeslist {
	set proto($node) [[$node rtObject?] add-proto DV $node]
    }
    foreach node $nodeslist {
	foreach nbr [$node neighbors] {
	    set rtobj [$nbr rtObject?]
	    if { $rtobj != "" } {
		set rtproto [$rtobj rtProto? DV]
		if { $rtproto != "" } {
		    $proto($node) add-peer $nbr [$rtproto set addr_]
		}
	    }
	}
    }
}

Agent/rtProto/DV instproc init node {
    $self next $node
    $self instvar ns_ rtObject_ ifsUp_
    $self instvar preference_ rtpref_ nextHop_ nextHopPeer_ metric_ multiPath_

    set UNREACHABLE [$class set UNREACHABLE]
    foreach dest [$ns_ all-nodes-list] {
	set rtpref_($dest) $preference_
	set nextHop_($dest) ""
	set nextHopPeer_($dest) ""
	set metric_($dest)  $UNREACHABLE
    }
    set ifsUp_ ""
    set multiPath_ [[$rtObject_ set node_] set multiPath_]
    set updateTime [uniform 0.0 0.5]
    $ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/DV instproc add-peer {nbr agentAddr} {
    $self instvar peers_
    $self set peers_($nbr) [new rtPeer $agentAddr $class]
}

Agent/rtProto/DV instproc send-periodic-update {} {
    $self instvar ns_
    $self send-updates 1	;# Anything but 0
    set updateTime [expr [$ns_ now] + \
	    ([$class set advertInterval] * [uniform 0.9 1.1])]
    $ns_ at $updateTime "$self send-periodic-update"
}

Agent/rtProto/DV instproc compute-routes {} {
    $self instvar ns_ ifs_ rtpref_ metric_ nextHop_ nextHopPeer_
    $self instvar peers_ rtsChanged_ multiPath_

    set INFINITY [$class set INFINITY]
    set MAXPREF  [rtObject set maxpref_]
    set UNREACH	 [rtObject set unreach_]
    set rtsChanged_ 0
    foreach dst [$ns_ all-nodes-list] {
	set p [lindex $nextHopPeer_($dst) 0]
	if {$p != ""} {
	    set metric_($dst) [$p metric? $dst]
	    set rtpref_($dst) [$p preference? $dst]
	}

	set pf $MAXPREF
	set mt $INFINITY
	set nh(0) 0
	foreach nbr [array names peers_] {
	    set pmt [$peers_($nbr) metric? $dst]
	    set ppf [$peers_($nbr) preference? $dst]

	    # if peer metric not valid	continue
	    # if peer pref higher		continue
	    # if peer pref lower		set to latest values
	    # else peer pref equal
	    #	if peer metric higher	continue
	    #	if peer metric lower	set to latest values
	    #	else peer metrics equal	append latest values

	    if { $pmt < 0 || $pmt >= $INFINITY || $ppf > $pf || $pmt > $mt } \
		    continue
	    if { $ppf < $pf || $pmt < $mt } {
		set pf $ppf
		set mt $pmt
		unset nh	;# because we must compute *new* next hops
	    }
	    set nh($ifs_($nbr)) $peers_($nbr)
	}
	catch "unset nh(0)"
	if { $pf == $MAXPREF && $mt == $INFINITY } continue
	if { $pf > $rtpref_($dst) ||				\
		($metric_($dst) >= 0 && $mt > $metric_($dst)) }	\
		continue
	if {$mt >= $INFINITY} {
	    set mt $UNREACH
	}

	incr rtsChanged_
	if { $pf < $rtpref_($dst) || $mt < $metric_($dst) } {
	    set rtpref_($dst) $pf
	    set metric_($dst) $mt
	    set nextHop_($dst) ""
	    set nextHopPeer_($dst) ""
	    foreach n [array names nh] {
		lappend nextHop_($dst) $n
		lappend nextHopPeer_($dst) $nh($n)
		if !$multiPath_ break;
	    }
	    continue
	}
	
	set rtpref_($dst) $pf
	set metric_($dst) $mt
	set newNextHop ""
	set newNextHopPeer ""
	foreach rt $nextHop_($dst) {
	    if [info exists nh($rt)] {
		lappend newNextHop $rt
		lappend newNextHopPeer $nh($rt)
		unset nh($rt)
	    }
	}
	set nextHop_($dst) $newNextHop
	set nextHopPeer_($dst) $newNextHopPeer
	if { $multiPath_ || $nextHop_($dst) == "" } {
	    foreach rt [array names nh] {
		lappend nextHop_($dst) $rt
		lappend nextHopPeer_($dst) $nh($rt)
		if !$multiPath_ break
	    }
	}
    }
    set rtsChanged_
}

Agent/rtProto/DV instproc intf-changed {} {
    $self instvar ns_ peers_ ifs_ ifstat_ ifsUp_ nextHop_ nextHopPeer_ metric_
    set INFINITY [$class set INFINITY]
    set ifsUp_ ""
    foreach nbr [array names peers_] {
	set state [$ifs_($nbr) up?]
	if {$state != $ifstat_($nbr)} {
	    set ifstat_($nbr) $state
	    if {$state != "up"} {
		if ![info exists all-nodes] {
		    set all-nodes [$ns_ all-nodes-list]
		}
		foreach dest ${all-nodes} {
		    $peers_($nbr) metric $dest $INFINITY
		}
	    } else {
		lappend ifsUp_ $nbr
	    }
	}
    }
}

Agent/rtProto/DV proc get-next-mid {} {
    set ret [Agent/rtProto/DV set mid_]
    Agent/rtProto/DV set mid_ [expr $ret + 1]
    set ret
}

Agent/rtProto/DV proc retrieve-msg id {
    set ret [Agent/rtProto/DV set msg_($id)]
    Agent/rtProto/DV unset msg_($id)
    set ret
}

Agent/rtProto/DV instproc send-updates changes {
    $self instvar peers_ ifs_ ifsUp_

    if $changes {
	set to-send-to [array names peers_]
    } else {
	set to-send-to $ifsUp_
    }
    set ifsUp_ ""
    foreach nbr ${to-send-to} {
	if { [$ifs_($nbr) up?] == "up" } {
	    $self send-to-peer $nbr
	}
    }
}

Agent/rtProto/DV instproc send-to-peer nbr {
    $self instvar ns_ rtObject_ ifs_ peers_
    set INFINITY [$class set INFINITY]
    foreach dest [$ns_ all-nodes-list] {
	set metric [$rtObject_ metric? $dest]
	if {$metric < 0} {
	    set update($dest) $INFINITY
	} else {
	    set update($dest) [$rtObject_ metric? $dest]
	    foreach nh [$rtObject_ nextHop? $dest] {
		if {$nh == $ifs_($nbr)} {
		    set update($dest) $INFINITY
		}
	    }
	}
    }
    set id [$class get-next-mid]
    $class set msg_($id) [array get update]
#    set n [$rtObject_ set node_];					\
    puts stderr [concat [format ">>> %7.5f" [$ns_ now]]			\
	    "${n}([$n id]/[$self set addr_]) send update"		\
	    "to ${nbr}([$nbr id]/[$peers_($nbr) addr?]) id = $id"];	\
    set j 0;								\
    foreach i [lsort -command TclObjectCompare [array names update]] {	\
	puts -nonewline "\t${i}([$i id]) $update($i)";			\
        if {$j == 3} {							\
	    puts "";							\
	};								\
	set j [expr ($j + 1) % 4];					\
    };									\
    if $j { puts ""; }

    # XXX Note the singularity below...
    $self send-update [$peers_($nbr) addr?] $id [array size update]
}

Agent/rtProto/DV instproc recv-update {peerAddr id} {
    $self instvar peers_ ifs_ nextHopPeer_ metric_
    $self instvar rtsChanged_ rtObject_

    set INFINITY [$class set INFINITY]
    set UNREACHABLE  [$class set UNREACHABLE]
    set msg [$class retrieve-msg $id]
    array set metrics $msg
#    set n [$rtObject_ set node_];					\
    puts stderr [concat [format "<<< %7.5f" [[Simulator instance] now]]	\
	    "${n}([$n id]) recv update from peer $peerAddr id = $id"]
    foreach nbr [array names peers_] {
	if {[$peers_($nbr) addr?] == $peerAddr} {
	    set peer $peers_($nbr)
	    if { [array size metrics] > [Node set nn_] } {
		error "$class::$proc update $peerAddr:$msg:$count is larger than the simulation topology"
	    }
	    set metricsChanged 0
	    foreach dest [array names metrics] {
                set metric [expr $metrics($dest) + [$ifs_($nbr) cost?]]
		if {$metric > $INFINITY} {
		    set metric $INFINITY
		}
		if {$metric != [$peer metric? $dest]} {
		    $peer metric $dest $metric
		    incr metricsChanged
		}
	    }
	    if $metricsChanged {
		$self compute-routes
		incr rtsChanged_ $metricsChanged
		$rtObject_ compute-routes
	    } else {
		# dynamicDM multicast hack.
		# If we get a message from a neighbour, then something
		# at that neighbour has changed.  While this may not
		# cause any unicast changes on our end, dynamicDM
		# looks at neighbour's routing tables to compute
		# parent-child relationships, and has to do them
		# again.
		#
		$rtObject_ flag-multicast -1
	    }
	    return
	}
    }
    error "$class::$proc update $peerAddr:$msg:$count from unknown peer"
}

Agent/rtProto/DV proc compute-all {} {
    # Because proc methods are not inherited from the parent class.
}

### Local Variables:
### mode: tcl
### tcl-indent-level: 4
### tcl-default-application: ns
### End: