467 lines
13 KiB
Tcl
467 lines
13 KiB
Tcl
|
#
|
||
|
|
# 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/ipv6.tcl
|
||
|
|
# NAME
|
||
|
|
# ipv6.tcl -- file for handeling IPv6
|
||
|
|
#****
|
||
|
|
|
||
|
|
#****f* ipv6.tcl/findFreeIPv6Net
|
||
|
|
# NAME
|
||
|
|
# findFreeIPv6Net -- find free IPv6 network
|
||
|
|
# SYNOPSIS
|
||
|
|
# set ipnet [findFreeIPv4Net $mask]
|
||
|
|
# FUNCTION
|
||
|
|
# Finds a free IPv6 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 IPv6 network address in the form "a $i".
|
||
|
|
#****
|
||
|
|
|
||
|
|
proc findFreeIPv6Net { mask } {
|
||
|
|
global g_prefs node_list
|
||
|
|
|
||
|
|
set ipnets {}
|
||
|
|
foreach node $node_list {
|
||
|
|
foreach ifc [ifcList $node] {
|
||
|
|
set ipparts [split [getIfcIPv6addr $node $ifc] :]
|
||
|
|
set endidx [expr {[lsearch $ipparts {}] - 1}]
|
||
|
|
if {$endidx < 0 } { set endidx end }
|
||
|
|
set ipnet [lrange $ipparts 0 $endidx]
|
||
|
|
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] 5] :] 0 3]
|
||
|
|
lappend ipnets $ipnet
|
||
|
|
}
|
||
|
|
if {![info exists g_prefs(gui_ipv6_addr)]} { setDefaultAddrs ipv6 }
|
||
|
|
set newnet [split $g_prefs(gui_ipv6_addr) :]
|
||
|
|
set endidx [expr {[lsearch $newnet {}] - 1}]
|
||
|
|
if {$endidx < 0 } { set endidx end }
|
||
|
|
set newnet [lrange $newnet 0 $endidx]
|
||
|
|
|
||
|
|
for { set i 0 } { $i <= 9999 } { incr i } {
|
||
|
|
if {[lsearch $ipnets "$newnet $i"] == -1} {
|
||
|
|
set newnetcolon [join $newnet :]
|
||
|
|
set ipnet "$newnetcolon:$i"
|
||
|
|
return $ipnet
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#****f* ipv6.tcl/autoIPv6addr
|
||
|
|
# NAME
|
||
|
|
# autoIPv6addr -- automaticaly assign an IPv6 address
|
||
|
|
# SYNOPSIS
|
||
|
|
# autoIPv6addr $node_id $iface
|
||
|
|
# FUNCTION
|
||
|
|
# automaticaly assignes an IPv6 address to the interface $iface of
|
||
|
|
# of the node $node.
|
||
|
|
# INPUTS
|
||
|
|
# * node_id -- the node containing the interface to witch a new
|
||
|
|
# IPv6 address should be assigned
|
||
|
|
# * iface -- the interface to witch a new, automatilacy generated, IPv6
|
||
|
|
# address will be assigned
|
||
|
|
#****
|
||
|
|
|
||
|
|
proc autoIPv6addr { node iface } {
|
||
|
|
set peer_ip6addrs {}
|
||
|
|
set netmaskbits 64 ;# default
|
||
|
|
setIfcIPv6addr $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_ip6addr [getIfcIPv6addr $peer $peer_if]
|
||
|
|
if { $peer_ip6addr != "" } {
|
||
|
|
lappend peer_ip6addrs [lindex [split $peer_ip6addr /] 0]
|
||
|
|
set netmaskbits [lindex [split $peer_ip6addr /] 1]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# point-to-point link with another NETWORK layer peer
|
||
|
|
} else {
|
||
|
|
set peer_if [ifcByLogicalPeer $peer_node $node]
|
||
|
|
set peer_ip6addr [getIfcIPv6addr $peer_node $peer_if]
|
||
|
|
set peer_ip6addrs [lindex [split $peer_ip6addr /] 0]
|
||
|
|
if { $peer_ip6addr != "" } {
|
||
|
|
set netmaskbits [lindex [split $peer_ip6addr /] 1]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Boeing: first node connected to wlan should use wlan prefix
|
||
|
|
if { [nodeType $peer_node] == "wlan" &&
|
||
|
|
[llength $peer_ip6addrs] == 0 } {
|
||
|
|
# use the special "wireless" pseudo-interface
|
||
|
|
set peer_ip6addr [getIfcIPv6addr $peer_node wireless]
|
||
|
|
set peer_ip6addrs [lindex [split $peer_ip6addr /] 0]
|
||
|
|
set netmaskbits [lindex [split $peer_ip6addr /] 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 IPv6 address, allocate a new address on the same network
|
||
|
|
if { $peer_ip6addrs != "" } {
|
||
|
|
set net [ipv6ToNet [lindex $peer_ip6addrs 0] 64]
|
||
|
|
set ipaddr $net\::$targetbyte
|
||
|
|
while { [lsearch $peer_ip6addrs $ipaddr] >= 0 } {
|
||
|
|
incr targetbyte
|
||
|
|
set ipaddr $net\::$targetbyte
|
||
|
|
}
|
||
|
|
setIfcIPv6addr $node $iface "$ipaddr/$netmaskbits"
|
||
|
|
} else {
|
||
|
|
set ipnet [findFreeIPv6Net 64]
|
||
|
|
setIfcIPv6addr $node $iface "${ipnet}::$targetbyte/$netmaskbits"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#****f* ipv6.tcl/autoIPv6defaultroute
|
||
|
|
# NAME
|
||
|
|
# autoIPv6defaultroute -- automaticaly assign a default route
|
||
|
|
# SYNOPSIS
|
||
|
|
# autoIPv6defaultroute $node_id $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_id -- default gateway is provided for this node
|
||
|
|
# * iface -- the interface on witch we search for a new default gateway
|
||
|
|
#****
|
||
|
|
|
||
|
|
proc autoIPv6defaultroute { node iface } {
|
||
|
|
if { [[typemodel $node].layer] != "NETWORK" } {
|
||
|
|
#
|
||
|
|
# Shouldn't get called at all for link-layer nodes
|
||
|
|
#
|
||
|
|
puts "autoIPv6defaultroute 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_ip6addr [getIfcIPv6addr $peer $peer_if]
|
||
|
|
if { $peer_ip6addr != "" } {
|
||
|
|
set gw [lindex [split $peer_ip6addr /] 0]
|
||
|
|
setStatIPv6routes $node [list "::/0 $gw"]
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if { [nodeType $peer_node] != "router" &&
|
||
|
|
[nodeType $peer_node] != "ine" } {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
set peer_if [ifcByLogicalPeer $peer_node $node]
|
||
|
|
set peer_ip6addr [getIfcIPv6addr $peer_node $peer_if]
|
||
|
|
if { $peer_ip6addr != "" } {
|
||
|
|
set gw [lindex [split $peer_ip6addr /] 0]
|
||
|
|
setStatIPv6routes $node [list "::/0 $gw"]
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#****f* ipv6.tcl/checkIPv6Addr
|
||
|
|
# NAME
|
||
|
|
# checkIPv6Addr -- check the IPv6 address
|
||
|
|
# SYNOPSIS
|
||
|
|
# set valid [checkIPv6Addr $str]
|
||
|
|
# FUNCTION
|
||
|
|
# Checks if the provided string is a valid IPv6 address.
|
||
|
|
# INPUTS
|
||
|
|
# * str -- string to be evaluated.
|
||
|
|
# RESULT
|
||
|
|
# * valid -- function returns 0 if the input string is not in the form
|
||
|
|
# of a valid IP address, 1 otherwise
|
||
|
|
#****
|
||
|
|
|
||
|
|
proc checkIPv6Addr { str } {
|
||
|
|
set doublec false
|
||
|
|
set wordlist [split $str :]
|
||
|
|
set wordcnt [expr [llength $wordlist] - 1]
|
||
|
|
if { $wordcnt < 2 || $wordcnt > 7 } {
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
if { [lindex $wordlist 0] == "" } {
|
||
|
|
set wordlist [lreplace $wordlist 0 0 0]
|
||
|
|
}
|
||
|
|
if { [lindex $wordlist $wordcnt] == "" } {
|
||
|
|
set wordlist [lreplace $wordlist $wordcnt $wordcnt 0]
|
||
|
|
}
|
||
|
|
for { set i 0 } { $i <= $wordcnt } { incr i } {
|
||
|
|
set word [lindex $wordlist $i]
|
||
|
|
if { $word == "" } {
|
||
|
|
if { $doublec == "true" } {
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
set doublec true
|
||
|
|
}
|
||
|
|
if { [string length $word] > 4 } {
|
||
|
|
if { $i == $wordcnt } {
|
||
|
|
return [checkIPv4Addr $word]
|
||
|
|
} else {
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if { [string is xdigit $word] == 0 } {
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
|
||
|
|
#****f* ipv6.tcl/checkIPv6Net
|
||
|
|
# NAME
|
||
|
|
# checkIPv6Net -- check the IPv6 network
|
||
|
|
# SYNOPSIS
|
||
|
|
# set valid [checkIPv6Net $str]
|
||
|
|
# FUNCTION
|
||
|
|
# Checks if the provided string is a valid IPv6 network.
|
||
|
|
# INPUTS
|
||
|
|
# * str -- string to be evaluated. Valid string is in form ipv6addr/m
|
||
|
|
# RESULT
|
||
|
|
# * valid -- function returns 0 if the input string is not in the form
|
||
|
|
# of a valid IP address, 1 otherwise.
|
||
|
|
#****
|
||
|
|
|
||
|
|
proc checkIPv6Net { str } {
|
||
|
|
if { $str == "" } {
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
if { ![checkIPv6Addr [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 128]
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# Boeing
|
||
|
|
# ***** ipv6.tcl/ipv6ToString
|
||
|
|
# NAME
|
||
|
|
# ipv6ToString -- convert 128-bit number to colon notation
|
||
|
|
# ****
|
||
|
|
|
||
|
|
proc ipv6ToString { ip } {
|
||
|
|
set ipv6nums {}
|
||
|
|
#binary format c16 H16
|
||
|
|
set prevbyte ""
|
||
|
|
set prevword ""
|
||
|
|
set have_double_colon 0
|
||
|
|
foreach byte $ip {
|
||
|
|
# group bytes into two-byte hex words
|
||
|
|
set hexbyte [format "%x" [expr $byte & 0xFF]]
|
||
|
|
if { $prevbyte == "" } {
|
||
|
|
set prevbyte $hexbyte
|
||
|
|
} else {
|
||
|
|
if { $prevbyte == 0 } { ;# compress zeroes
|
||
|
|
set prevbyte ""
|
||
|
|
set hexbyte [format "%x" 0x$hexbyte]
|
||
|
|
} else {
|
||
|
|
set hexbyte [format "%02x" 0x$hexbyte]
|
||
|
|
}
|
||
|
|
set twobytes "$prevbyte$hexbyte"
|
||
|
|
set prevbyte ""
|
||
|
|
|
||
|
|
# compress subsequent zeroes into ::, but only once
|
||
|
|
if { $twobytes == 0 } {
|
||
|
|
if { !$have_double_colon && $prevword == 0} {
|
||
|
|
# replace last 0 with :
|
||
|
|
set ipv6nums [lreplace $ipv6nums end end ""]
|
||
|
|
set have_double_colon 1
|
||
|
|
set prevword ":"
|
||
|
|
continue ;# don't add current 0 word to list
|
||
|
|
} elseif { $prevword == ":" } {
|
||
|
|
continue ;# another zero word, skip it
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set prevword $twobytes
|
||
|
|
lappend ipv6nums $twobytes
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return [join $ipv6nums :]
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Boeing
|
||
|
|
# ***** ipv6.tcl/stringToIPv6
|
||
|
|
# NAME
|
||
|
|
# stringToIPv6 -- convert colon notation to 128-bits of binary data
|
||
|
|
# ****
|
||
|
|
|
||
|
|
proc stringToIPv6 { ip } {
|
||
|
|
set ip [expandIPv6 $ip]; # remove any double-colon notation
|
||
|
|
set parts [split $ip :]
|
||
|
|
|
||
|
|
if { [llength $parts] != 8 } { return "" }; # sanity check
|
||
|
|
set bin ""
|
||
|
|
|
||
|
|
foreach part $parts {
|
||
|
|
scan $part "%x" num; # convert hex to number
|
||
|
|
set binpart [binary format i $num]
|
||
|
|
set bin ${bin}${binpart}
|
||
|
|
}
|
||
|
|
|
||
|
|
return $bin
|
||
|
|
}
|
||
|
|
|
||
|
|
# expand from double-colon shorthand notation to include all zeros
|
||
|
|
proc expandIPv6 { ip } {
|
||
|
|
set parts [split $ip :]
|
||
|
|
set partnum 0
|
||
|
|
set expand {}
|
||
|
|
set num_zeros 0
|
||
|
|
while { [llength $parts] > 0 } {
|
||
|
|
set part [lindex $parts 0]; # pop off first element
|
||
|
|
set parts [lreplace $parts 0 0]
|
||
|
|
|
||
|
|
if {$part == ""} { ; # this is the :: part of the address
|
||
|
|
set num_parts_remain [llength $parts]
|
||
|
|
if { $num_zeros > 0 } { ; # another empty element, another zero
|
||
|
|
lappend expand 0
|
||
|
|
continue
|
||
|
|
}
|
||
|
|
set num_zeros [expr { 8 - ($partnum + $num_parts_remain) }]
|
||
|
|
for { set i 0 } { $i < $num_zeros } { incr i } {
|
||
|
|
lappend expand 0
|
||
|
|
}
|
||
|
|
continue;
|
||
|
|
}
|
||
|
|
lappend expand $part
|
||
|
|
incr partnum
|
||
|
|
}
|
||
|
|
return [join $expand :]
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Boeing
|
||
|
|
# ***** ipv6.tcl/ipv6ToNet
|
||
|
|
# NAME
|
||
|
|
# ipv6ToNet -- convert IPv6 address a.b.c.d to a.b.c
|
||
|
|
# ****
|
||
|
|
|
||
|
|
proc ipv6ToNet { ip mask } {
|
||
|
|
set ipv6nums [split $ip :]
|
||
|
|
# last remove last to nums of :: num
|
||
|
|
set ipv6parts [lrange $ipv6nums 0 [expr [llength $ipv6nums] - 3]]
|
||
|
|
return [join $ipv6parts :]
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Boeing
|
||
|
|
# ***** ipv6.tcl/autoIPv6wlanaddr
|
||
|
|
# NAME
|
||
|
|
# autoIPv6wlanaddr -- part of autoIPv6addr to determine
|
||
|
|
# address for node connected to the wlan
|
||
|
|
# ****
|
||
|
|
proc autoIPv6wlanaddr { node } {
|
||
|
|
|
||
|
|
# search wlan node for peers, collect IP address into list
|
||
|
|
set peer_ip6addrs ""
|
||
|
|
foreach ifc [ifcList $node] {
|
||
|
|
set peer [logicalPeerByIfc $node $ifc]
|
||
|
|
set peer_if [ifcByLogicalPeer $peer $node]
|
||
|
|
set peer_ip6addr [getIfcIPv6addr $peer $peer_if]
|
||
|
|
if { $peer_ip6addr != "" } {
|
||
|
|
lappend peer_ip6addrs [lindex [split $peer_ip6addr /] 0]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if { $peer_ip6addrs != "" } {
|
||
|
|
set ipnums [split [lindex $peer_ip6addrs 0] :]
|
||
|
|
set net "[lindex $ipnums 0]:[lindex $ipnums 1]"
|
||
|
|
set targetbyte 1
|
||
|
|
set ipaddr $net\::$targetbyte
|
||
|
|
while { [lsearch $peer_ip6addrs $ipaddr] >= 0 } {
|
||
|
|
incr targetbyte
|
||
|
|
set ipaddr $net\::$targetbyte
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
set ipnums [split [getIfcIPv6addr $node wireless] :]
|
||
|
|
set net "[lindex $ipnums 0]:[lindex $ipnums 1]"
|
||
|
|
set ipaddr $net\::1
|
||
|
|
}
|
||
|
|
return "$ipaddr/64"
|
||
|
|
}
|
||
|
|
|
||
|
|
proc getDefaultIPv6Addrs { } {
|
||
|
|
global g_prefs
|
||
|
|
return [list "2001::" "2002::" "a::"]
|
||
|
|
}
|
||
|
|
|
||
|
|
proc ipv6List { node wantmask } {
|
||
|
|
set r ""
|
||
|
|
foreach ifc [ifcList $node] {
|
||
|
|
foreach ip [getIfcIPv6addr $node $ifc] {
|
||
|
|
if { $wantmask } {
|
||
|
|
lappend r $ip
|
||
|
|
} else {
|
||
|
|
lappend r [lindex [split $ip /] 0]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $r
|
||
|
|
}
|
||
|
|
|