386 lines
11 KiB
Tcl
Executable file
386 lines
11 KiB
Tcl
Executable file
#
|
|
# Copyright 2005-2013 the Boeing Company.
|
|
# See the LICENSE file included in this distribution.
|
|
#
|
|
|
|
#
|
|
# Copyright 2005-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.
|
|
#
|
|
# This work was supported in part by Croatian Ministry of Science
|
|
# and Technology through the research contract #IP-2003-143.
|
|
#
|
|
|
|
#****h* imunes/ipv4.tcl
|
|
# NAME
|
|
# ipv4.tcl -- file for handeling IPv4
|
|
#****
|
|
|
|
#****f* ipv4.tcl/findFreeIPv4Net
|
|
# NAME
|
|
# findFreeIPv4Net -- find free IPv4 network
|
|
# SYNOPSIS
|
|
# set ipnet [findFreeIPv4Net $mask]
|
|
# FUNCTION
|
|
# Finds a free IPv4 network. Network is concidered to be free
|
|
# if there are no simulated nodes attached to it.
|
|
# INPUTS
|
|
# * mask -- this parameter is left unused for now
|
|
# RESULT
|
|
# * ipnet -- returns the free IPv4 network address in the form 10.a.b
|
|
#****
|
|
|
|
proc findFreeIPv4Net { mask } {
|
|
global g_prefs node_list
|
|
|
|
set ipnets {}
|
|
foreach node $node_list {
|
|
foreach ifc [ifcList $node] {
|
|
set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2]
|
|
if {[lsearch $ipnets $ipnet] == -1} {
|
|
lappend ipnets $ipnet
|
|
}
|
|
}
|
|
}
|
|
# include mobility newlinks in search
|
|
foreach newlink [.c find withtag "newlink"] {
|
|
set ipnet [lrange [split [lindex [.c gettags $newlink] 4] .] 0 2]
|
|
lappend ipnets $ipnet
|
|
}
|
|
if {![info exists g_prefs(gui_ipv4_addr)]} { setDefaultAddrs ipv4 }
|
|
set abc [split $g_prefs(gui_ipv4_addr) .]
|
|
set a [lindex $abc 0]
|
|
set b [lindex $abc 1]
|
|
set c [lindex $abc 2]
|
|
|
|
for { set i $b } { $i <= 255 } { incr i } {
|
|
for { set j $c } { $j <= 255 } { incr j } {
|
|
if {[lsearch $ipnets "$a $i $j"] == -1} {
|
|
set ipnet "$a.$i.$j"
|
|
return $ipnet
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#****f* ipv4.tcl/autoIPv4addr
|
|
# NAME
|
|
# autoIPv4addr -- automaticaly assign an IPv4 address
|
|
# SYNOPSIS
|
|
# autoIPv4addr $node $iface
|
|
# FUNCTION
|
|
# automaticaly assignes an IPv4 address to the interface $iface of
|
|
# of the node $node
|
|
# INPUTS
|
|
# * node -- the node containing the interface to which a new
|
|
# IPv4 address should be assigned
|
|
# * iface -- the interface to witch a new, automatilacy generated, IPv4
|
|
# address will be assigned
|
|
#****
|
|
|
|
proc autoIPv4addr { node iface } {
|
|
set peer_ip4addrs {}
|
|
set netmaskbits 24 ;# default
|
|
|
|
if { [[typemodel $node].layer] != "NETWORK" } {
|
|
#
|
|
# Shouldn't get called at all for link-layer nodes
|
|
#
|
|
puts "autoIPv4 called for a [[typemodel $node].layer] layer node"
|
|
return
|
|
}
|
|
setIfcIPv4addr $node $iface ""
|
|
|
|
set peer_node [logicalPeerByIfc $node $iface]
|
|
# find addresses of NETWORK layer peer nodes
|
|
if { [[typemodel $peer_node].layer] == "LINK" } {
|
|
foreach l2node [listLANnodes $peer_node {}] {
|
|
foreach ifc [ifcList $l2node] {
|
|
set peer [logicalPeerByIfc $l2node $ifc]
|
|
set peer_if [ifcByLogicalPeer $peer $l2node]
|
|
set peer_ip4addr [getIfcIPv4addr $peer $peer_if]
|
|
if { $peer_ip4addr != "" } {
|
|
lappend peer_ip4addrs [lindex [split $peer_ip4addr /] 0]
|
|
set netmaskbits [lindex [split $peer_ip4addr /] 1]
|
|
}
|
|
}
|
|
}
|
|
# point-to-point link with another NETWORK layer peer
|
|
} else {
|
|
set peer_if [ifcByLogicalPeer $peer_node $node]
|
|
set peer_ip4addr [getIfcIPv4addr $peer_node $peer_if]
|
|
set peer_ip4addrs [lindex [split $peer_ip4addr /] 0]
|
|
if { $peer_ip4addr != "" } {
|
|
set netmaskbits [lindex [split $peer_ip4addr /] 1]
|
|
}
|
|
}
|
|
# first node connected to wlan should use wlan prefix
|
|
if { [nodeType $peer_node] == "wlan" &&
|
|
[llength $peer_ip4addrs] == 0 } {
|
|
# use the special "wireless" pseudo-interface
|
|
set peer_ip4addr [getIfcIPv4addr $peer_node wireless]
|
|
set peer_ip4addrs [lindex [split $peer_ip4addr /] 0]
|
|
set netmaskbits [lindex [split $peer_ip4addr /] 1]
|
|
}
|
|
set nodetype [nodeType $node]
|
|
if { $nodetype == "router" } { set nodetype [getNodeModel $node] }
|
|
switch -exact -- $nodetype {
|
|
router {
|
|
set targetbyte 1
|
|
}
|
|
host {
|
|
set targetbyte 10
|
|
}
|
|
PC -
|
|
pc {
|
|
set targetbyte 20
|
|
}
|
|
default {
|
|
set targetbyte 1
|
|
}
|
|
}
|
|
# peer has an IPv4 address, allocate a new address on the same network
|
|
if { $peer_ip4addrs != "" } {
|
|
set ipnums [split [lindex $peer_ip4addrs 0] .]
|
|
set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]"
|
|
set ipaddr $net.$targetbyte
|
|
while { [lsearch $peer_ip4addrs $ipaddr] >= 0 } {
|
|
incr targetbyte
|
|
set ipaddr $net.$targetbyte
|
|
}
|
|
setIfcIPv4addr $node $iface "$ipaddr/$netmaskbits"
|
|
} else {
|
|
set ipnet [findFreeIPv4Net 24]
|
|
setIfcIPv4addr $node $iface "$ipnet.$targetbyte/$netmaskbits"
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ipv4.tcl/autoIPv4defaultroute
|
|
# NAME
|
|
# autoIPvdefaultroute -- automaticaly assign a default route
|
|
# SYNOPSIS
|
|
# autoIPv4defaultroute $node $iface
|
|
# FUNCTION
|
|
# searches the interface of the node for a router, if a router is found
|
|
# then it is a new default gateway.
|
|
# INPUTS
|
|
# * node -- default gateway is provided for this node
|
|
# * iface -- the interface on witch we search for a new default gateway
|
|
#****
|
|
|
|
proc autoIPv4defaultroute { node iface } {
|
|
if { [[typemodel $node].layer] != "NETWORK" } {
|
|
#
|
|
# Shouldn't get called at all for link-layer nodes
|
|
#
|
|
puts "autoIPv4defaultroute called for [[typemodel $node].layer] node"
|
|
return
|
|
}
|
|
|
|
set peer_node [logicalPeerByIfc $node $iface]
|
|
|
|
if { [[typemodel $peer_node].layer] == "LINK" } {
|
|
foreach l2node [listLANnodes $peer_node {}] {
|
|
foreach ifc [ifcList $l2node] {
|
|
set peer [logicalPeerByIfc $l2node $ifc]
|
|
if { [nodeType $peer] != "router" &&
|
|
[nodeType $peer] != "ine" } {
|
|
continue
|
|
}
|
|
set peer_if [ifcByLogicalPeer $peer $l2node]
|
|
set peer_ip4addr [getIfcIPv4addr $peer $peer_if]
|
|
if { $peer_ip4addr != "" } {
|
|
set gw [lindex [split $peer_ip4addr /] 0]
|
|
setStatIPv4routes $node [list "0.0.0.0/0 $gw"]
|
|
return
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
if { [nodeType $peer_node] != "router" &&
|
|
[nodeType $peer_node] != "ine" } {
|
|
return
|
|
}
|
|
set peer_if [ifcByLogicalPeer $peer_node $node]
|
|
set peer_ip4addr [getIfcIPv4addr $peer_node $peer_if]
|
|
if { $peer_ip4addr != "" } {
|
|
set gw [lindex [split $peer_ip4addr /] 0]
|
|
setStatIPv4routes $node [list "0.0.0.0/0 $gw"]
|
|
return
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#****f* ipv4.tcl/checkIPv4Addr
|
|
# NAME
|
|
# checkIPv4Addr -- check the IPv4 address
|
|
# SYNOPSIS
|
|
# set valid [checkIPv4Addr $str]
|
|
# FUNCTION
|
|
# Checks if the provided string is a valid IPv4 address.
|
|
# INPUTS
|
|
# * str -- string to be evaluated. Valid IPv4 address is writen in form
|
|
# a.b.c.d
|
|
# RESULT
|
|
# * valid -- function returns 0 if the input string is not in the form
|
|
# of a valid IP address, 1 otherwise
|
|
#****
|
|
|
|
proc checkIPv4Addr { str } {
|
|
set n 0
|
|
if { $str == "" } {
|
|
return 1
|
|
}
|
|
while { $n < 4 } {
|
|
if { $n < 3 } {
|
|
set i [string first . $str]
|
|
} else {
|
|
set i [string length $str]
|
|
}
|
|
if { $i < 1 } {
|
|
return 0
|
|
}
|
|
set part [string range $str 0 [expr $i - 1]]
|
|
if { [string length [string trim $part]] != $i } {
|
|
return 0
|
|
}
|
|
if { ![string is integer $part] } {
|
|
return 0
|
|
}
|
|
if { $part < 0 || $part > 255 } {
|
|
return 0
|
|
}
|
|
set str [string range $str [expr $i + 1] end]
|
|
incr n
|
|
}
|
|
return 1
|
|
}
|
|
|
|
|
|
#****f* ipv4.tcl/checkIPv4Net
|
|
# NAME
|
|
# checkIPv4Net -- check the IPv4 network
|
|
# SYNOPSIS
|
|
# set valid [checkIPv4Net $str]
|
|
# FUNCTION
|
|
# Checks if the provided string is a valid IPv4 network.
|
|
# INPUTS
|
|
# * str -- string to be evaluated. Valid string is in form a.b.c.d/m
|
|
# RESULT
|
|
# * valid -- function returns 0 if the input string is not in the form
|
|
# of a valid IP address, 1 otherwise
|
|
#****
|
|
|
|
proc checkIPv4Net { str } {
|
|
if { $str == "" } {
|
|
return 1
|
|
}
|
|
if { ![checkIPv4Addr [lindex [split $str /] 0]]} {
|
|
return 0
|
|
}
|
|
set net [string trim [lindex [split $str /] 1]]
|
|
if { [string length $net] == 0 } {
|
|
return 0
|
|
}
|
|
return [checkIntRange $net 0 32]
|
|
}
|
|
|
|
#
|
|
# Boeing
|
|
# ***** ipv4.tcl/ipv4ToString
|
|
# NAME
|
|
# ipv4ToString -- convert 32-bit integer to dotted decimal notation
|
|
# ****
|
|
|
|
proc ipv4ToString { ip } {
|
|
return "[expr ($ip >> 24) & 0xFF].[expr ($ip >> 16) & 0xFF].[expr ($ip >> 8) & 0xFF].[expr $ip & 0xFF]"
|
|
}
|
|
|
|
#
|
|
# Boeing
|
|
# ***** ipv4.tcl/stringToIPv4
|
|
# NAME
|
|
# stringToIPv4 -- convert dotted decimal string to 32-bit integer
|
|
proc stringToIPv4 { ip } {
|
|
set parts [split $ip .]
|
|
set a [lindex $parts 0]; set b [lindex $parts 1];
|
|
set c [lindex $parts 2]; set d [lindex $parts 3];
|
|
return [expr {(($a << 24) + ($b << 16) + ($c << 8) + $d ) & 0xFFFFFFFF}]
|
|
}
|
|
|
|
|
|
proc ipv4ToNet { ip prefixlen } {
|
|
set ipn [stringToIPv4 $ip]
|
|
set ones [string repeat 1 $prefixlen]
|
|
set zeroes [string repeat 0 [expr {32 - $prefixlen}]]
|
|
binary scan [binary format B32 $ones$zeroes] H8 mask
|
|
set netn [expr {$ipn & "0x$mask"}]
|
|
return [ipv4ToString $netn]
|
|
}
|
|
|
|
proc getDefaultIPv4Addrs { } {
|
|
global g_prefs
|
|
return [list "10.0.0.0" "192.168.0.0" "172.16.0.0"]
|
|
}
|
|
|
|
proc isMulticast { str } {
|
|
set i [string first . $str]
|
|
if { $i < 1 } { return false }
|
|
set part [string range $str 0 [expr {$i - 1}]]
|
|
if { ![string is integer $part] } { return false }
|
|
if { $part < 224 || $part > 239 } { return false }
|
|
return true
|
|
}
|
|
|
|
proc ipv4List { node wantmask } {
|
|
set r ""
|
|
foreach ifc [ifcList $node] {
|
|
foreach ip [getIfcIPv4addr $node $ifc] {
|
|
if { $wantmask } {
|
|
lappend r $ip
|
|
} else {
|
|
lappend r [lindex [split $ip /] 0]
|
|
}
|
|
}
|
|
}
|
|
return $r
|
|
}
|
|
|
|
|
|
# this can be called with node_list to get a list of all subnets
|
|
proc ipv4SubnetList { nodes } {
|
|
set r ""
|
|
foreach node $nodes {
|
|
foreach ipnet [ipv4List $node 1] {
|
|
set ip [lindex [split $ipnet /] 0]
|
|
set pl [lindex [split $ipnet /] 1]
|
|
set net "[ipv4ToNet $ip $pl]/$pl"
|
|
if { [lsearch $r $net] < 0 } {
|
|
lappend r $net
|
|
}
|
|
}
|
|
}
|
|
return $r
|
|
}
|