394 lines
10 KiB
Tcl
394 lines
10 KiB
Tcl
#
|
|
# Copyright 2004-2008 University of Zagreb, Croatia.
|
|
#
|
|
# Redistribution and use in source and binary forms, with or without
|
|
# modification, are permitted provided that the following conditions
|
|
# are met:
|
|
# 1. Redistributions of source code must retain the above copyright
|
|
# notice, this list of conditions and the following disclaimer.
|
|
# 2. Redistributions in binary form must reproduce the above copyright
|
|
# notice, this list of conditions and the following disclaimer in the
|
|
# documentation and/or other materials provided with the distribution.
|
|
#
|
|
# THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE
|
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
# SUCH DAMAGE.
|
|
#
|
|
|
|
#
|
|
#****h* imunes/ns2imunes.tcl
|
|
# NAME
|
|
# ns2imunes.tcl -- file used for converting from ns2 scripts to IMUNES conf
|
|
# file
|
|
# FUNCTION
|
|
# This module implements functionality for converting ns2 scripts into
|
|
# IMUNES conf file. Now, only basic ns2 functionalities are implemented, those
|
|
# that can't be written in IMUNES config file or those that are not implemented
|
|
# yet are ignored.
|
|
#****
|
|
|
|
#****f* ns2imunes.tcl/ns2im
|
|
# NAME
|
|
# ns2im -- converts ns2 script into IMUNES and draws topology
|
|
# SYNOPSIS
|
|
# ns2im $ns2script
|
|
# FUNCTION
|
|
# Implements basic logic for converting between formats.
|
|
# INPUTS
|
|
# * srcfile -- ns2 scripy
|
|
#****
|
|
|
|
proc ns2im { srcfile } {
|
|
global node_list
|
|
global link_list
|
|
global canvas_list
|
|
global curcanvas
|
|
global cfg
|
|
set cfg {}
|
|
set node_list {}
|
|
set link_list {}
|
|
set canvas_list {}
|
|
source $srcfile
|
|
foreach node $node_list {
|
|
setNodeCanvas $node $curcanvas
|
|
}
|
|
changeNodeType
|
|
setDefaultRoutes
|
|
arrangeNodes
|
|
dumpCfg string cfg
|
|
loadCfg $cfg
|
|
redrawAll
|
|
if { [file exists out.nam] == 1 } {
|
|
file delete out.nam
|
|
}
|
|
}
|
|
|
|
#****f* ns2imunes.tcl/new
|
|
# NAME
|
|
# new -- basic/main ns2 function, invoked in ns2 script
|
|
# SYNOPSIS
|
|
# set ns [new Simulator]
|
|
# FUNCTION
|
|
# Points to our main function: root-func.
|
|
# INPUTS
|
|
# * object -- can be Simulator, Agent, Application.
|
|
#****
|
|
|
|
proc new {object} {
|
|
set arg [split $object "/"]
|
|
set typepc "TCP UDP RTP RTCP"
|
|
set typehost "TCPSink Null"
|
|
if {$object == "Simulator"} {
|
|
return root-func
|
|
} elseif {[lindex $arg 0] == "Agent"} {
|
|
return nullfunc
|
|
} elseif {[lindex $arg 0] == "Application"} {
|
|
return nullfunc
|
|
} else {
|
|
return nullfunc
|
|
}
|
|
}
|
|
|
|
#****f* ns2imunes.tcl/nullfunc
|
|
# NAME
|
|
# nullfunc -- does nothing; needed for avoiding errors.
|
|
# SYNOPSIS
|
|
# nullfunc args
|
|
# INPUTS
|
|
# * can be any number of inputs
|
|
#****
|
|
proc nullfunc {args} {
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/root-func
|
|
# NAME
|
|
# root-func -- calls other functions
|
|
# SYNOPSIS
|
|
# root-func ns_command $args
|
|
# FUNCTION
|
|
# For input node this procedure enables or disables custom configuration.
|
|
# INPUTS
|
|
# * ns_command -- first arg is always name of the function
|
|
# * args -- argument for function; there can be any number of arguments
|
|
# RESULT
|
|
# Returns result of function $ns_command
|
|
#****
|
|
proc root-func {ns_command args} {
|
|
catch {
|
|
if {$args == ""} {
|
|
set x [$ns_command]
|
|
return $x
|
|
} else {
|
|
set y [$ns_command $args]
|
|
return $y
|
|
}
|
|
} value
|
|
return $value
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/node
|
|
# NAME
|
|
# node -- creates new node, ns_command invoked from root-func
|
|
# SYNOPSIS
|
|
# set node [node]
|
|
# RESULT
|
|
# * node_id -- node id of a new node of type router
|
|
#****
|
|
proc node {} {
|
|
set default "router"
|
|
return [newNode $default]
|
|
}
|
|
|
|
|
|
#not implemented yet in IMUNES
|
|
proc simplex-link { linkdata } {
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/duplex-link
|
|
# NAME
|
|
# duplex-link -- creates new link, ns_command invoked from root-func
|
|
# SYNOPSIS
|
|
# duplex-link $linkdata_list
|
|
# INPUTS
|
|
# * linkdata -- list that describes link
|
|
# RESULT
|
|
# * new_link_id -- new link id.
|
|
#****
|
|
proc duplex-link { linkdata } {
|
|
set node1 [lindex $linkdata 0]
|
|
set node2 [lindex $linkdata 1]
|
|
set bw [lindex $linkdata 2]
|
|
set dly [lindex $linkdata 3]
|
|
set type [lindex $linkdata 4]
|
|
set link [newLink $node1 $node2]
|
|
|
|
set bandwidth [getBandwidth $bw]
|
|
setLinkBandwidth $link $bandwidth
|
|
|
|
set delay [getDelay $dly]
|
|
setLinkDelay $link $delay
|
|
|
|
set queueingDiscipline [getQueingDiscipline $type]
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/changeNodeType
|
|
# NAME
|
|
# changeNodeType -- passes through list node_list and changes type of node.
|
|
# SYNOPSIS
|
|
# changeNodeType
|
|
# FUNCTION
|
|
# Passes through list node_list and calls procedures for changing type of
|
|
# node if node has more than one neighbour.
|
|
#****
|
|
proc changeNodeType {} {
|
|
global node_list
|
|
foreach node $node_list {
|
|
set ifc [ifcList $node]
|
|
set ifcnum [llength $ifc]
|
|
if { $ifcnum == 1 } {
|
|
setNodeModel $node "PC"
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/setDefaultRoutes
|
|
# NAME
|
|
# setDefaultRoutes -- sets default routes for non router nodes
|
|
# SYNOPSIS
|
|
# setDefaultRoutes
|
|
#****
|
|
proc setDefaultRoutes {} {
|
|
global node_list
|
|
foreach node $node_list {
|
|
set type [nodeType $node]
|
|
if { $type == "pc" || $type == "host" } {
|
|
set interfaces [ifcList $node]
|
|
foreach ifc $interfaces {
|
|
autoIPv4defaultroute $node $ifc
|
|
autoIPv6defaultroute $node $ifc
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/getBandwidth
|
|
# NAME
|
|
# getBandwith -- returns bandwidth value in bits
|
|
# SYNOPSIS
|
|
# getBandwith $bandwith
|
|
# FUNCTION
|
|
# Detects input unit, and returns bandwidth value in bits.
|
|
# INPUTS
|
|
# * bw -- bandwidth
|
|
#****
|
|
proc getBandwidth { bw } {
|
|
regexp {[0-9]+} $bw value
|
|
regexp {[A-Za-z]+} $bw unit
|
|
switch $unit {
|
|
"Kb" "return [expr $value*1000]"
|
|
"Mb" "return [expr $value*1000000]"
|
|
"Gb" "return [expr $value*1000000000]"
|
|
}
|
|
}
|
|
|
|
#****f* ns2imunes.tcl/getDelay
|
|
# NAME
|
|
# getDelay -- returns delay value in microseconds
|
|
# SYNOPSIS
|
|
# getDelay $dly
|
|
# FUNCTION
|
|
# Detects input unit, and returns delay value in microseconds.
|
|
# INPUTS
|
|
# * dly -- delay
|
|
#****
|
|
proc getDelay { dly } {
|
|
regexp {[0-9]+} $dly value
|
|
regexp {[a-z]+} $dly unit
|
|
switch $unit {
|
|
"ms" " return [expr $value*1000] "
|
|
"us" " return $value "
|
|
}
|
|
}
|
|
|
|
#****f* ns2imunes.tcl/getQueingDiscipline
|
|
# NAME
|
|
# getQueingDiscipline -- returns queing discipline
|
|
# SYNOPSIS
|
|
# getQueingDiscipline $type
|
|
# INPUTS
|
|
# * type -- type of queing discipline written in ns2 format
|
|
#****
|
|
proc getQueingDiscipline { type } {
|
|
if {[string match "DropTail" $type]} {
|
|
return "droptail"
|
|
} elseif {[string match "CBQ" $type] ||\
|
|
[string match "WFQ" $type]} {
|
|
return "fair-queue"
|
|
} elseif {[string match "DRR" $type]} {
|
|
return "drr-queue"
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/arrangeNodes
|
|
# NAME
|
|
# arrangeNodes -- calculates coordinates for nodes
|
|
# SYNOPSIS
|
|
# arrangeNodes
|
|
# FUNCTION
|
|
# Calculates and writes coordinates for every node in global variable
|
|
# node_list.
|
|
#****
|
|
proc arrangeNodes {} {
|
|
global node_list
|
|
global activetool
|
|
#with next foreach loop we divide nodes on layer3/router
|
|
#nodes and edge (pc, host) nodes
|
|
set routers {}
|
|
set edgeNodes {}
|
|
foreach node $node_list {
|
|
set type [nodeType $node]
|
|
if { $type == "router" } {
|
|
lappend routers $node
|
|
} else {
|
|
lappend edgeNodes $node
|
|
}
|
|
}
|
|
set center {450 310}
|
|
set i 0
|
|
set rnum [llength $routers]
|
|
set pi [expr 2*asin(1.0)]
|
|
#next foreach loop: we arrange nodes that we have denoted as
|
|
#layer3/router nodes; we place them in a elipse circle and their
|
|
#regular peers (pc or host) are placed above them
|
|
foreach rnode $routers {
|
|
set fi [expr $i*(2*$pi)/$rnum]
|
|
set r [expr 200*(1.0-0.4*abs(sin($fi)))]
|
|
set ximage [expr [lindex $center 0] - $r*cos($fi)]
|
|
set yimage [expr [lindex $center 1] - $r*sin($fi)]
|
|
|
|
setNodeCoords $rnode "$ximage $yimage"
|
|
setNodeLabelCoords $rnode "$ximage [expr $yimage + 24]"
|
|
set regularPeers [getRegularPeers $rnode]
|
|
set regpeernum [llength $regularPeers]
|
|
set j 0
|
|
foreach peer $regularPeers {
|
|
if { [hasCoords $peer] >= 0 } {
|
|
continue
|
|
}
|
|
set fi1 [expr ($j-$regpeernum/2)*(2*$pi/3)/$regpeernum]
|
|
set ximage1 [expr $ximage - 200*cos($fi+$fi1)]
|
|
set yimage1 [expr $yimage - 200*sin($fi+$fi1)]
|
|
setNodeCoords $peer "$ximage1 $yimage1"
|
|
set dy 32
|
|
setNodeLabelCoords $peer "$ximage1 [expr $yimage1 + $dy]"
|
|
incr j
|
|
}
|
|
incr i
|
|
}
|
|
if { $routers == "" } {
|
|
set i 0
|
|
foreach node $edgeNodes {
|
|
set fi [expr $i*(2*$pi)/[llength $edgeNodes]]
|
|
set r [expr 200*(1.0-0.5*abs(sin($fi)))]
|
|
set ximage [expr [lindex $center 0] - $r*cos($fi)]
|
|
set yimage [expr [lindex $center 1] - $r*sin($fi)]
|
|
setNodeCoords $node "$ximage $yimage"
|
|
set dy 32
|
|
setNodeLabelCoords $node "$ximage [expr $yimage + $dy]"
|
|
incr i
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/getRegularPeers
|
|
# NAME
|
|
# getRegularPeers -- returns list of pc's and hosts connected with router $node
|
|
# SYNOPSIS
|
|
# getRegularPeers $node_id
|
|
# INPUTS
|
|
# * node -- node_id of router to which we are finding peers
|
|
#****
|
|
proc getRegularPeers { node } {
|
|
set interfaces [ifcList $node]
|
|
set regularpeers ""
|
|
foreach ifc $interfaces {
|
|
set peer [peerByIfc $node $ifc]
|
|
if { [nodeType $peer] == "pc" || [nodeType $peer] == "host"} {
|
|
lappend regularpeers $peer
|
|
}
|
|
}
|
|
return $regularpeers
|
|
}
|
|
|
|
|
|
#****f* ns2imunes.tcl/hasCoords
|
|
# NAME
|
|
# hasCoords -- detects existence of coords
|
|
# SYNOPSIS
|
|
# getRegularPeers $node_id
|
|
# INPUTS
|
|
# * node -- node_id of node.
|
|
# RESULT
|
|
# * >=0 -- coords are assigned to $node
|
|
# * ==1 -- coords are not assigned to $node
|
|
#****
|
|
proc hasCoords {node} {
|
|
global $node
|
|
return [lsearch [set $node] "iconcoords *"]
|
|
}
|