session.tcl

跑leach需要的

Class SessionSim -superclass Simulator
SessionSim set MixMode_ 0
SessionSim set rc_ 0

### Create a session helper that associates with the src agent ###
SessionSim instproc create-session { srcNode srcAgent } {
    $self instvar session_

    set nid [$srcNode id]
    set dst [$srcAgent set dst_addr_]
    set session_($nid:$dst:$nid) [new SessionHelper]
    $session_($nid:$dst:$nid) set-node $nid
    if {[SessionSim set rc_]} {
	$session_($nid:$dst:$nid) set rc_ 1
    }
	
    # If exists nam-traceall, we'll insert an intermediate trace object
    set trace [$self get-nam-traceall]
    if {$trace != ""} {
	# This will write every packet sent and received to 
	# the nam trace file
	set p [$self create-trace SessEnque $trace $nid $dst "nam"]
	$srcAgent target $p
	$p target $session_($nid:$dst:$nid)
    } else {
	$srcAgent target $session_($nid:$dst:$nid)
    }

    return $session_($nid:$dst:$nid)
}

SessionSim instproc update-loss-dependency { src dst owner agent group } {
    $self instvar session_ routingTable_ loss_

    set loss_rcv 1
    set tmp $dst
    while {$tmp != $owner} {
	set next [$routingTable_ lookup $tmp $owner]
	if {[info exists loss_($next:$tmp)] && $loss_($next:$tmp) != 0} {
	    if {$loss_rcv} {
		#puts "update-loss-rcv $loss_($next:$tmp) $next $tmp $agent"
		set dep_loss [$session_($src:$group:$owner) update-loss-rcv $loss_($next:$tmp) $agent]
	    } else {
		#puts "update-loss-rcv $loss_($next:$tmp) $next $tmp $dep_loss"
		set dep_loss [$session_($src:$group:$owner) update-loss-loss $loss_($next:$tmp) $dep_loss]
	    }

	    if {$dep_loss == 0} { 
		return 
	    }
	    set loss_rcv 0
	}
	set tmp $next
    }

    if [info exists dep_loss] {
	$session_($src:$group:$owner) update-loss-top $dep_loss
    }
}

SessionSim instproc join-group { rcvAgent group } {
    $self instvar session_ routingTable_ delay_ bw_

    foreach index [array names session_] {
	set tri [split $index :]
	if {[lindex $tri 1] == $group} {
	    set src [lindex $tri 0]
	    set dst [[$rcvAgent set node_] id]
	    set delay 0
	    set accu_bw 0
	    set ttl 0
	    set tmp $dst
	    while {$tmp != $src} {
		set next [$routingTable_ lookup $tmp $src]
		set delay [expr $delay + $delay_($tmp:$next)]
		if {$accu_bw} {
		    set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
		} else {
		    set accu_bw $bw_($tmp:$next)
		}
		incr ttl
		set tmp $next
	    }
	    
	    # Create nam queues for all receivers if traceall is turned on
	    # XXX 
	    # nam will deal with the issue whether all groups share a 
	    # single queue per receiver. The simulator simply writes 
	    # this information there
	    $self puts-nam-config "G -t [$self now] -i $group -a $dst"
	    
	    # And we should add a trace object before each receiver,
	    # because only this will capture the packet before it 
	    # reaches the receiver and after it left the sender
	    set f [$self get-nam-traceall]
	    if {$f != ""} { 
		set p [$self create-trace SessDeque $f $src $dst "nam"]
		$p target $rcvAgent
		$session_($index) add-dst $accu_bw $delay $ttl $dst $p
		$self update-loss-dependency $src $dst $src $p $group
	    } else {
		#puts "add-dst $accu_bw $delay $ttl $src $dst"
		$session_($index) add-dst $accu_bw $delay $ttl $dst $rcvAgent
		$self update-loss-dependency $src $dst $src $rcvAgent $group
	    }
	}
    }
}

SessionSim instproc leave-group { rcvAgent group } {
    $self instvar session_

    foreach index [array names session_] {
	set tri [split $index :]
	if {[lindex $tri 1] == $group} {
	    #$session_($index) delete-dst [[$rcvAgent set node_] id] $rcvAgent
		set dst [[$rcvAgent set node_] id]
		# remove the receiver from packet distribution list
		$self puts-nam-traceall \
			"G -t [$self now] -i $group -x $dst"
	}
    }
}

SessionSim instproc insert-loss { lossmodule from to } {
    $self instvar loss_ bw_ Node_

    if {[SessionSim set MixMode_] && [$self detailed-link? [$from id] [$to id]]} {
	$self lossmodel $lossmodule $from $to
    } elseif [info exists bw_([$from id]:[$to id])] {
	set loss_([$from id]:[$to id]) $lossmodule
    }
}

SessionSim instproc get-delay { src dst } {
    $self instvar routingTable_ delay_
    set delay 0
    set tmp $src
    while {$tmp != $dst} {
	set next [$routingTable_ lookup $tmp $dst]
	set delay [expr $delay + $delay_($tmp:$next)]
	set tmp $next
    }
    return $delay
}

SessionSim instproc get-bw { src dst } {
    $self instvar routingTable_ bw_
    set accu_bw 0
    set tmp $src
    while {$tmp != $dst} {
	set next [$routingTable_ lookup $tmp $dst]
	if {$accu_bw} {
	    set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
	} else {
	    set accu_bw $bw_($tmp:$next)
	}
	set tmp $next
    }
    return $accu_bw
}

SessionSim instproc node args {
    $self instvar sessionNode_
    if {[llength $args] == 0} {
        set node [new SessionNode]
    } else {
	set node [new SessionNode $args]
    }
    set sessionNode_([$node id]) $node
    $node set ns_ $self
    return $node
}

SessionSim instproc simplex-link { n1 n2 bw delay type } {
    $self instvar bw_ delay_ linkAttr_
    set sid [$n1 id]
    set did [$n2 id]

    set bw_($sid:$did) [bw_parse $bw]
    set delay_($sid:$did) [delay_parse $delay]

	set linkAttr_($sid:$did:ORIENT) ""
	set linkAttr_($sid:$did:COLOR) "black"
}

SessionSim instproc duplex-link { n1 n2 bw delay type } {
    $self simplex-link $n1 $n2 $bw $delay $type
    $self simplex-link $n2 $n1 $bw $delay $type

    $self session-register-nam-linkconfig [$n1 id]:[$n2 id]
}

SessionSim instproc simplex-link-of-interfaces { n1 n2 bw delay type } {
    $self simplex-link $n1 $n2 $bw $delay $type
}

SessionSim instproc duplex-link-of-interfaces { n1 n2 bw delay type } {
    $self simplex-link $n1 $n2 $bw $delay $type
    $self simplex-link $n2 $n1 $bw $delay $type

    $self session-register-nam-linkconfig [$n1 id]:[$n2 id]
}

### mix mode detailed link
SessionSim instproc detailed-node { id address } {
    $self instvar Node_

    if { [Simulator info vars EnableMcast_] != "" } {
	warn "Flag variable Simulator::EnableMcast_ discontinued.\n\t\
		Use multicast methods as:\n\t\t\
		% set ns \[new Simulator -multicast on]\n\t\t\
		% \$ns multicast"
	$self multicast
	Simulator unset EnableMcast_
    }
    if ![info exist Node_($id)] {
	set node [new [Simulator set node_factory_] $address]
	# Do not count this a "real" node, and keep the old node id. 
	Node set nn_ [expr [Node set nn_] - 1]
	$node set id_ $id
	set Node_($id) $node
	return $node
    } else {
	return $Node_($id)
    }
}

SessionSim instproc detailed-duplex-link { from to } {
    $self instvar bw_ delay_

    SessionSim set MixMode_ 1
    set fromNode [$self detailed-node [$from id] [$from set address_]]
    set toNode [$self detailed-node [$to id] [$from set address_]]

    $self simulator-duplex-link $fromNode $toNode $bw_([$from id]:[$to id]) $delay_([$from id]:[$to id]) DropTail
}

SessionSim instproc simulator-duplex-link { n1 n2 bw delay type args } {
	$self instvar link_
	set i1 [$n1 id]
	set i2 [$n2 id]
	if [info exists link_($i1:$i2)] {
		$self remove-nam-linkconfig $i1 $i2
	}

	eval $self simulator-simplex-link $n1 $n2 $bw $delay $type $args
	eval $self simulator-simplex-link $n2 $n1 $bw $delay $type $args
}

SessionSim instproc simulator-simplex-link { n1 n2 bw delay qtype args } {
	$self instvar link_ queueMap_ nullAgent_
	set sid [$n1 id]
	set did [$n2 id]
	
	if [info exists queueMap_($qtype)] {
		set qtype $queueMap_($qtype)
	}
	# construct the queue
	set qtypeOrig $qtype
	switch -exact $qtype {
		ErrorModule {
			if { [llength $args] > 0 } {
				set q [eval new $qtype $args]
			} else {
				set q [new $qtype Fid]
			}
		}
		intserv {
			set qtype [lindex $args 0]
			set q [new Queue/$qtype]
		}
		default {
			set q [new Queue/$qtype]
		}
	}

	# Now create the link
	switch -exact $qtypeOrig {
		RTM {
                        set c [lindex $args 1]
                        set link_($sid:$did) [new CBQLink       \
                                        $n1 $n2 $bw $delay $q $c]
                }
                CBQ -
                CBQ/WRR {
                        # assume we have a string of form "linktype linkarg"
                        if {[llength $args] == 0} {
                                # default classifier for cbq is just Fid type
                                set c [new Classifier/Hash/Fid 33]
                        } else {
                                set c [lindex $args 1]
                        }
                        set link_($sid:$did) [new CBQLink       \
                                        $n1 $n2 $bw $delay $q $c]
                }
                intserv {
                        #XX need to clean this up
                        set link_($sid:$did) [new IntServLink   \
                                        $n1 $n2 $bw $delay $q	\
						[concat $qtypeOrig $args]]
                }
                default {
                        set link_($sid:$did) [new SimpleLink    \
                                        $n1 $n2 $bw $delay $q]
                }
        }
	$n1 add-neighbor $n2
	
	#XXX yuck
	if {[string first "RED" $qtype] != -1} {
		$q link [$link_($sid:$did) set link_]
	}
	
	set trace [$self get-ns-traceall]
	if {$trace != ""} {
		$self trace-queue $n1 $n2 $trace
	}
	set trace [$self get-nam-traceall]
	if {$trace != ""} {
		$self namtrace-queue $n1 $n2 $trace
	}
	
	# Register this simplex link in nam link list. Treat it as 
	# a duplex link in nam
	$self register-nam-linkconfig $link_($sid:$did)
}

# Assume ops to be performed is 'orient' only
# XXX Poor hack. What should we do without a link object??
SessionSim instproc duplex-link-op { n1 n2 op args } {
	$self instvar linkAttr_ bw_

	set sid [$n1 id]
	set did [$n2 id]

	if ![info exists bw_($sid:$did)] {
		error "Non-existent link [$n1 id]:[$n2 id]"
	}

	switch $op {
		"orient" {
			set linkAttr_($sid:$did:ORIENT) $args
			set linkAttr_($did:$sid:ORIENT) $args
		}
		"color" {
			set ns [Simulator instance]
			$ns puts-nam-traceall \
				[eval list "l -t [$self now] -s $sid -d $did \
-S COLOR -c $args -o $linkAttr_($sid:$did:COLOR)"]
			$ns puts-nam-traceall \
				[eval list "l -t [$self now] -s $did -d $sid \
-S COLOR -c $args -o $linkAttr_($sid:$did:COLOR)"]
			eval set attr_($sid:$did:COLOR) $args
			eval set attr_($did:$sid:COLOR) $args
		}
		default {
			eval puts "Duplex link option $args not implemented \
in SessionSim"
		}
	} 
}

# nam support for session sim, Contributed by Haobo Yu
# Because here we don't have a link object, we need to have a new 
# link register method
SessionSim instproc session-register-nam-linkconfig link {
	$self instvar sessionLinkConfigList_ bw_ linkAttr_
	if [info exists sessionLinkConfigList_] {
		# Check whether the reverse simplex link is registered,
		# if so, don't register this link again.
		# We should have a separate object for duplex link.
		set tmp [split $link :]
		set i1 [lindex $tmp 0]
		set i2 [lindex $tmp 1]
		if [info exists bw_($i2:$i1)] {
			set pos [lsearch $sessionLinkConfigList_ $i2:$i1]
			if {$pos >= 0} {
				set a1 $linkAttr_($i2:$i1:ORIENT)
				set a2 $linkAttr_($link:ORIENT)
				if {$a1 == "" && $a2 != ""} {
					# If this duplex link has not been 
					# assigned an orientation, do it.
					set sessionLinkConfigList_ [lreplace $sessionLinkConfigList_ $pos $pos]
				} else {
					return
				}
			}
		}

		# Remove $link from list if it's already there
		set pos [lsearch $sessionLinkConfigList_ $link]
		if {$pos >= 0} {
			set sessionLinkConfigList_ \
				[lreplace $sessionLinkConfigList_ $pos $pos]
		}
	}
	lappend sessionLinkConfigList_ $link
}

# write link configurations
SessionSim instproc dump-namlinks {} {
    $self instvar bw_ delay_ sessionLinkConfigList_ linkAttr_

    set ns [Simulator instance]
    foreach lnk $sessionLinkConfigList_ {
	set tmp [split $lnk :]
	set i1 [lindex $tmp 0]
	set i2 [lindex $tmp 1]
	$ns puts-nam-traceall \
		"l -t * -s $i1 -d $i2 -S UP -r $bw_($lnk) -D \
		$delay_($lnk) -o $linkAttr_($lnk:ORIENT)"
    }
}

SessionSim instproc dump-namnodes {} {
        $self instvar sessionNode_
        if ![$self is-started] {
                return
        }
        foreach nn [array names sessionNode_] {
                if ![$sessionNode_($nn) is-lan?] {
                        $sessionNode_($nn) dump-namconfig
                }
        }
}     

### Routing support
SessionSim instproc compute-routes {} {
    #
    # call hierarchical routing, if applicable
    #
    if [Simulator hier-addr?] {
	$self compute-hier-routes 
    } else {
	$self compute-flat-routes
    }
}

SessionSim instproc compute-flat-routes {} {
	$self instvar bw_
	#
	# Compute all the routes using the route-logic helper object.
	#
        set r [$self get-routelogic]
	foreach ln [array names bw_] {
		set L [split $ln :]
		set srcID [lindex $L 0]
		set dstID [lindex $L 1]
	        if {$bw_($ln) != 0} {
			$r insert $srcID $dstID