route-proto.tcl

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

#
#  Copyright (c) 1997 by the University of Southern California
#  All rights reserved.
#
#  Permission to use, copy, modify, and distribute this software and its
#  documentation in source and binary forms for non-commercial purposes
#  and without fee is hereby granted, provided that the above copyright
#  notice appear in all copies and that both the copyright notice and
#  this permission notice appear in supporting documentation. 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.
#
#  THE UNIVERSITY OF SOUTHERN CALIFORNIA makes no representations about
#  the suitability of this software for any purpose.  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.
#
#  Other copyrights might apply to parts of this software and are so
#  noted when applicable.
#

#
# Maintainer: <[e-mail]>.
#

# This file only contains the methods for dynamic routing
# Check ../lib/ns-route.tcl for the Simulator routing support
#
Class rtObject

rtObject set unreach_ -1

rtObject proc init-all args {
    foreach node $args {
	if { [$node rtObject?] == "" } {
	    set rtobj($node) [new rtObject $node]
	}
    }
    foreach node $args {	;# XXX
        $rtobj($node) compute-routes
    }
}

rtObject instproc init node {
    $self next
    $self instvar ns_ nullAgent_
    $self instvar nextHop_ rtpref_ metric_ node_ rtVia_ rtProtos_

    set ns_ [Simulator instance]
    set nullAgent_ [$ns_ set nullAgent_]

    $node init-routing $self
    set node_ $node
    foreach dest [$ns_ all-nodes-list] {
	set nextHop_($dest) ""
	if {$node == $dest} {
	    set rtpref_($dest) 0
	    set metric_($dest) 0
	    set rtVia_($dest) "Agent/rtProto/Local" ;# make dump happy
	} else {
	    set rtpref_($dest) [$class set maxpref_]
	    set metric_($dest) [$class set unreach_]
	    set rtVia_($dest)    ""
	    $node add-route [$dest id] $nullAgent_
	}
    }
    $self add-proto Direct $node
    $rtProtos_(Direct) compute-routes
#    $self compute-routes
}

rtObject instproc add-proto {proto node} {
    $self instvar ns_ rtProtos_
    set rtProtos_($proto) [new Agent/rtProto/$proto $node]
    $ns_ attach-agent $node $rtProtos_($proto)
    set rtProtos_($proto)
}

rtObject instproc lookup dest {
    $self instvar nextHop_ node_
    if {![info exists nextHop_($dest)] || $nextHop_($dest) == ""} {
	return -1
    } else {
	return [[$nextHop_($dest) set toNode_] id]
    }
}

rtObject instproc compute-routes {} {
    # choose the best route to each destination from all protocols
    $self instvar ns_ node_ rtProtos_ nullAgent_
    $self instvar nextHop_ rtpref_ metric_ rtVia_
    set protos ""
    set changes 0
    foreach p [array names rtProtos_] {
	if [$rtProtos_($p) set rtsChanged_] {
	    incr changes
	    $rtProtos_($p) set rtsChanged_ 0
	}
	lappend protos $rtProtos_($p)
    }
    if !$changes return

    set changes 0
    foreach dst [$ns_ all-nodes-list] {
	if {$dst == $node_} continue
	set nh ""
	set pf [$class set maxpref_]
	set mt [$class set unreach_]
	set rv ""
	foreach p $protos {
	    set pnh [$p set nextHop_($dst)]
	    if { $pnh == "" } continue

	    set ppf [$p set rtpref_($dst)]
	    set pmt [$p set metric_($dst)]
	    if {$ppf < $pf || ($ppf == $pf && $pmt < $mt) || $mt < 0} {
		set nh  $pnh
		set pf  $ppf
		set mt  $pmt
		set rv  $p
	    }
	}
	if { $nh == "" } {
	    # no route...  delete any existing routes
	    if { $nextHop_($dst) != "" } {
		$node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
		set nextHop_($dst) $nh
		set rtpref_($dst)  $pf
		set metric_($dst)  $mt
		set rtVia_($dst)   $rv
		incr changes
	    }
	} else {
	    if { $rv == $rtVia_($dst) } {
		# Current protocol still has best route.
		# See if changed
		if { $nh != $nextHop_($dst) } {
		    $node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
		    set nextHop_($dst) $nh
		    $node_ add-routes [$dst id] $nextHop_($dst)
		    incr changes
		}
		if { $mt != $metric_($dst) } {
		    set metric_($dst) $mt
		    incr changes
		}
		if { $pf != $rtpref_($dst) } {
		    set rtpref_($dst) $pf
		}
	    } else {
		if { $rtVia_($dst) != "" } {
		    set nextHop_($dst) [$rtVia_($dst) set nextHop_($dst)]
		    set rtpref_($dst)  [$rtVia_($dst) set rtpref_($dst)]
		    set metric_($dst)  [$rtVia_($dst) set metric_($dst)]
		}
		if {$rtpref_($dst) != $pf || $metric_($dst) != $mt} {
		    # Then new prefs must be better, or
		    # new prefs are equal, and new metrics are lower
		    $node_ delete-routes [$dst id] $nextHop_($dst) $nullAgent_
		    set nextHop_($dst) $nh
		    set rtpref_($dst)  $pf
		    set metric_($dst)  $mt
		    set rtVia_($dst)   $rv
		    $node_ add-routes [$dst id] $nextHop_($dst)
		    incr changes
		}
	    }
	}
    }
    foreach proto [array names rtProtos_] {
	$rtProtos_($proto) send-updates $changes
    }
    #
    # XXX
    # detailed multicast routing hooks must come here.
    # My idea for the hook will be something like:
    # set mrtObject [$node_ mrtObject?]
    # if {$mrtObject != ""} {
    #    $mrtObject recompute-mroutes $changes
    # }
    # $changes == 0	if only interfaces changed state.  Look at how
    #			Agent/rtProto/DV handles ifsUp_
    # $changes > 0	if new unicast routes were installed.
    #
    $self flag-multicast $changes
}

rtObject instproc flag-multicast changes {
    $self instvar node_
    $node_ notify-mcast $changes
}

rtObject instproc intf-changed {} {
    $self instvar ns_ node_ rtProtos_ rtVia_ nextHop_ rtpref_ metric_
    foreach p [array names rtProtos_] {
	$rtProtos_($p) intf-changed
	$rtProtos_($p) compute-routes
    }
    $self compute-routes
}

rtObject instproc dump-routes chan {
    $self instvar ns_ node_ nextHop_ rtpref_ metric_ rtVia_

    if ![info proc SplitObjectCompare] {
	puts stderr "$class::$proc failed.  Update your TclCL library"
	return
    }

    if {$ns_ != ""} {
	set time [$ns_ now]
    } else {
	set time 0.0
    }
    puts $chan [concat "Node:\t${node_}([$node_ id])\tat t ="		\
	    [format "%4.2f" $time]]
    puts $chan "  Dest\t\t nextHop\tPref\tMetric\tProto"
    foreach dest [lsort -command SplitObjectCompare [$ns_ all-nodes-list]] {
	if {[llength $nextHop_($dest)] > 1} {
	    set p [split [$rtVia_($dest) info class] /]
	    set proto [lindex $p [expr [llength $p] - 1]]
	    foreach rt $nextHop_($dest) {
		puts $chan [format "%-5s(%d)\t%-5s(%d)\t%3d\t%4d\t %s"	 \
			$dest [$dest id] $rt [[$rt set toNode_] id]	 \
			$rtpref_($dest) $metric_($dest) $proto]
	    }
	} elseif {$nextHop_($dest) != ""} {
	    set p [split [$rtVia_($dest) info class] /]
	    set proto [lindex $p [expr [llength $p] - 1]]
	    puts $chan [format "%-5s(%d)\t%-5s(%d)\t%3d\t%4d\t %s"	 \
		    $dest [$dest id]					 \
		    $nextHop_($dest) [[$nextHop_($dest) set toNode_] id] \
		    $rtpref_($dest) $metric_($dest) $proto]
	} elseif {$dest == $node_} {
	    puts $chan [format "%-5s(%d)\t%-5s(%d)\t%03d\t%4d\t %s"	\
		    $dest [$dest id] $dest [$dest id] 0 0 "Local"]
	} else {
	    puts $chan [format "%-5s(%d)\t%-5s(%s)\t%03d\t%4d\t %s"	\
		    $dest [$dest id] "" "-" 255 32 "Unknown"]
	}
    }
}

rtObject instproc rtProto? proto {
    $self instvar rtProtos_
    if [info exists rtProtos_($proto)] {
	return $rtProtos_($proto)
    } else {
	return ""
    }
}

rtObject instproc nextHop? dest {
    $self instvar nextHop_
    $self set nextHop_($dest)
}

rtObject instproc rtpref? dest {
    $self instvar rtpref_
    $self set rtpref_($dest)
}

rtObject instproc metric? dest {
    $self instvar metric_
    $self set metric_($dest)
}

#
Class rtPeer

rtPeer instproc init {addr cls} {
    $self next
    $self instvar addr_ metric_ rtpref_
    set addr_ $addr
    foreach dest [[Simulator instance] all-nodes-list] {
	set metric_($dest) [$cls set INFINITY]
	set rtpref_($dest) [$cls set preference_]
    }
}

rtPeer instproc addr? {} {
    $self instvar addr_
    return $addr_
}

rtPeer instproc metric {dest val} {
    $self instvar metric_
    set metric_($dest) $val
}

rtPeer instproc metric? dest {
    $self instvar metric_
    return $metric_($dest)
}

rtPeer instproc preference {dest val} {
    $self instvar rtpref_
    set rtpref_($dest) $val
}

rtPeer instproc preference? dest {
    $self instvar rtpref_
    return $rtpref_($dest)
}

#
#Class Agent/rtProto -superclass Agent

Agent/rtProto proc init-all args {
    error "No initialisation defined"
}

Agent/rtProto instproc init node {
    $self next

    $self instvar ns_ node_ rtObject_ preference_ ifs_ ifstat_
    set ns_ [Simulator instance]

    catch "set preference_ [[$self info class] set preference_]" ret
    if { $ret == "" } {
	set preference_ [$class set preference_]
    }
    foreach nbr [$node set neighbor_] {
	set link [$ns_ link $node $nbr]
	set ifs_($nbr) $link
	set ifstat_($nbr) [$link up?]
    }
    set rtObject_ [$node rtObject?]
}

Agent/rtProto instproc compute-routes {} {
    error "No route computation defined"
}

Agent/rtProto instproc intf-changed {} {
    #NOTHING
}

Agent/rtProto instproc send-updates args {
    #NOTHING
}

Agent/rtProto proc compute-all {} {
    #NOTHING
}

#
# Static routing, the default
#