- IPv6 Addresses - a tiny module for parsing and formatting
- A Little 6to4 Calculator
Stu 2009-06-17 I noticed that Ceptcl wasn't mentioned in that thread, I wonder why. I'd post this to the thread itself but my 'net conn's sporadic lately.
Che2n 2018-1-17 Hello, I'm a network engineer and at my spare time i'm working on network discovery/visualisation/monitoring application in Tcl/TK. At some point I had need for parsing and calculating IPv6 addresses, but I haven't found any sufficient extension, so I wrote a package for ipv6 parsing and manipulation based on tcllib_ip package. I haven't tested it throughout nor used in production. It would be great if someone with more experience test it. Any advice or suggestions will be appreciated.Here is the link to files https://github.com/ch32n/TclIPv6Commands and examples https://github.com/ch32n/TclIPv6/wiki Commands
ipv6::isIpv6 IpAddripv6::normalize IpAddripv6::suppress IpAddripv6::compress IpAddripv6::mask IpAddripv6::equal IpAddr1 IpAddr2ipv6::prefix IpAddripv6::nextIP IpAddr ?Offset?ipv6::nextNet IPPrefix ?Offset?ipv6::isOverlap IPPrefix1 IPPrefix2ipv6::reduceToAggregates PrefixListipv6::collapse PrefixListipv6::subtract PosPrefixList NegPrefixListipv6::expandSubnet IPPrefix NewMask ?Offset?ipv6::ipv6ToEthMulticast IpAddrListThere are commands which start with uppercase letter (ipv6::Prefix ipv6::NextIP ipv6::NextNet ipv6::ReduceToAggregates ipv6::Collapse ipv6::Subtract ipv6::ExpandSubnet), they return ipv6 addresses in fully expanded format.
Examplespackage require ipv6Check if given string is IPv6 address
% ipv6::isIpv6 :: 1 % ipv6::isIpv6 ::g 0 % ipv6::isIpv6 2001::2001:: 0 % ipv6::isIpv6 2001::1/64 1Normalize(return in fully expanded format) IPv6 address
% ipv6::normalize :: 0000:0000:0000:0000:0000:0000:0000:0000 % ipv6::normalize 2001:0:1:2::1 2001:0000:0001:0002:0000:0000:0000:0001Suppress leading zeros in IPv6 address
% ipv6::suppress 0000:0000:0000:0000:0000:0000:0000:0000 0:0:0:0:0:0:0:0 % ipv6::suppress 2001:0001:0020:0300::0001 2001:1:20:300:0:0:0:1Suppress leading zeros and replace contiguous nibbles which contains zeros to double colon
% ipv6::compress 0000:0000:0000:0000:0000:0000:0000:0000 :: % ipv6::compress 2002:00:000:2001:00:0000:0:1 2002:0:0:2001::1 %Get mask(prefix length) from the prefix
% ipv6::mask 2001::1 128 % ipv6::mask 2001::1/64 64Check if IPv6 addresses are equal
% ipv6::equal 2001::1 2001::1 1 % ipv6::equal 2001:2001:2002::1/32 2001:2001:2004::5/32 1 % ipv6::equal 2001:2001:2002::1/64 2001:2001:2004::5/64 0Get IPv6 network from prefix
% ipv6::prefix 2002:2001:abcd::1/32 2002:2001:: % ipv6::Prefix 2002:2001:abcd::1/32 2002:2001:0000:0000:0000:0000:0000:0000Calculate next IPv6 address
% ipv6::nextIP ::1 ::2 % ipv6::NextIP ::1 0000:0000:0000:0000:0000:0000:0000:0002 % ipv6::nextIP ::1 9 ::ACheck if IPv6 networks overlap. Second prefix is checked against the firs one
% ipv6::isOverlap 2001:2002:2004::/32 2001:2002:2003:2004::/48 1 % ipv6::isOverlap 2001:2002:2004::/48 2001:2002:2003:2004::/48 0 % ipv6::isOverlap 2001:2002:2003:2004::/48 2001:2002:2004::/32 0Check if prefixes overlap and return prefixes with the lowest prefix length
% ipv6::reduceToAggregates {2002:2222::/32 2002::/16 5000::/4 4000::/2} 2002::/16 4000::/2 % ipv6::ReduceToAggregates {2002:2222::/32 2002::/16 5000::/4 4000::/2} 2002:0000:0000:0000:0000:0000:0000:0000/16 4000:0000:0000:0000:0000:0000:0000:0000/2Summarize IPv6 contiguous subnets
% ipv6::collapse {2002:2002::/31 2002:2001::/32 2002:2000::/32 2002:2004::/32 2002:2005::/32} 2002:2000::/30 2002:2004::/31 % ipv6::Collapse {2002:2000::/32 2002:2001::/32} 2002:2000:0000:0000:0000:0000:0000:0000/31Subtract IPv6 prefix from another one
% ipv6::subtract 2002:2000::/30 2002:2000::/32 2002:2002::/31 2002:2001::/32 % ipv6::subtract 2002:2000::/30 {2002:2000::/32 2002:2001::/32} 2002:2002::/31 % ipv6::subtract {2002:2000::/30 2003:2000::/30} {2002:2000::/32 2002:2001::/322003:2000::/31} 2003:2002::/31 2002:2002::/31 % ipv6::Subtract 2002:2000::/30 2002:2000::/32 2002:2002:0000:0000:0000:0000:0000:0000/31 2002:2001:0000:0000:0000:0000:0000:0000/32Calculate new IPv6 subnets
% ipv6::expandSubnet 2001:2:a::/48 64 2 2001:2:A::/64 2001:2:A:1::/64 % ipv6::expandSubnet 2001::/30 32 2001::/32 2001:1::/32 2001:2::/32 2001:3::/32 % ipv6::ExpandSubnet 2001:2:a::/48 64 2 2001:0002:000A:0000:0000:0000:0000:0000/64 2001:0002:000A:0001:0000:0000:0000:0000/64Map IPv6 multicast address to ethernet hardware address
% ipv6::ipv6ToEthMulticast {ff01::1 ff05::abcd:1234} 333300000001 3333abcd1234
package provide ipv6 1.0 namespace eval ipv6 { # namespace export isIpv6 normalize suppress compress mask equal prefix Prefix nextIP NextIP nextNet NextNet isOverlap reduceToAggregates ReduceToAggregates collapse Collapse subtract Subtract expandSubnet ExpandSubnet ipv6ToEthMulticast # variable NBBL_CHAR_LENGTH 4 variable HEX_BIT_LENGTH 4 variable PREFIX_LENGTH_MIN 0 variable PREFIX_LENGTH_MAX 128 variable IP_ADDR_CHAR_LENGTH 32 variable IP_ADDR_NBBL_LENGTH 8 variable IP_ADDR_BIT_LENGTH 128 # variable IPV6_MULTICAST_PREFIX FF00:: variable EHT_IPV6_MUL_FIRST_4_HEX_CHAR 3333 # variable OUR_NAMESPACE [namespace current] proc GetMask {Mask} { variable IP_ADDR_BIT_LENGTH # if {$Mask eq {}} { return 0 } else { return [expr {$IP_ADDR_BIT_LENGTH - $Mask}] } } #add to hex string proc AddToHex {Hex Offset} { # set IPv6Dec [expr {[join "0x $Hex" {}] + $Offset}] # if {$IPv6Dec < 0} { return -code error [concat IPv6 address can't be less than 0] } # return $IPv6Dec } # check syntax of ipv6 addres (length, characters) # # Input - ipv6 addres prefix with mask (::/64) # # Return - list IPv6 addres in hex string and mask (0-128) proc IPtoHexAndGetMask {IPPrefix} { lassign [SplitIPMask $IPPrefix] IpAddr_tmp Mask # set Mask [GetMask $Mask] # try { set IpAddr_tmp [IPtoHexString $IpAddr_tmp] } on error {result options} { return -code error $result } # return [list $IpAddr_tmp $Mask] } #convert decimal value to hex proc DecToHex {DecValue} { return [format %llx $DecValue] } # convert hex string to ipv6 address format # # Input - Hex string (32 chars) # # Return - IPv6 addres in expanded format proc HexStringToIP {HexString} { variable NBBL_CHAR_LENGTH variable IP_ADDR_CHAR_LENGTH # set IpAddr_tmp {} # for {set i 0} {$i < $IP_ADDR_CHAR_LENGTH} {incr i 4} { set IpAddr_tmp [join [concat $IpAddr_tmp [string range $HexString $i [expr {$i + $NBBL_CHAR_LENGTH - 1}]]] :] } # return [string toupper $IpAddr_tmp] } #converts decimal value to ipv6 address format proc DecToIP {DecValue} { #convert decimal value to hex string and fills with zeros if needed set IpAddr_tmp [FillZeros [DecToHex $DecValue]] # return [HexStringToIP $IpAddr_tmp] } # fill hex string with leading 0s # # Input - Hex string (chars 0-32) # # Return - IPv6 hex string (32 chars) proc FillZeros {HexString} { variable IP_ADDR_CHAR_LENGTH # set HexString_tmp $HexString # if {[string length $HexString] < $IP_ADDR_CHAR_LENGTH} { set CharDiff [expr {$IP_ADDR_CHAR_LENGTH - [string length $HexString]}] set HexString_tmp [join [concat [string repeat 0 $CharDiff] $HexString] {}] } # return $HexString_tmp } # proc NormTo4BitBound {IPHexString {Mask 0}} { variable HEX_BIT_LENGTH # set Mod [expr {$Mask % $HEX_BIT_LENGTH}] # set Dec [expr {[join "0x $IPHexString" {}] << $Mod}] # return [DecToHex $Dec] } # proc ShiftBitsRight {IPHexString {Mask 0}} { set Dec [expr {[join "0x $IPHexString" {}] >> $Mask}] # return $Dec } # proc ShiftBitsLeft {IPHexString {Mask 0}} { set Dec [expr {[join "0x $IPHexString" {}] << $Mask}] # return $Dec } # Check input prefixes and expand if needed # # Input - List of ipv6 prefixes with or without prefix length (aa::a/64 bb:: :: ...) # # Return - List of expanded ipv6 prefixes with mask proc CheckAndNormilize {PrefixList} { try { foreach Prefix $PrefixList { lappend Tmp [Prefix $Prefix]/[mask $Prefix] } # return $Tmp } on error {result options} { return -code error $result } } #Remove item from list proc Lpop {List Item} { set ItemId [lsearch $List $Item] # return [lreplace $List $ItemId $ItemId] } # Compare prefix length of prefixes, used in lsort -command # # Input - ipv6 prefixes with or without prefix length (aa::a/64 bb:: :: ...) # # Return - compare result proc SortLargeToSmallMask {Prefix1 Prefix2} { return [expr {([string compare [mask $Prefix1] [mask $Prefix2]])}] } # converts ipv6 hex string to network portion hex string # # Input - ipv6 hex string (32 chars), network prefix length # # Return - network portion hex string proc HexStringToNetBits {IPHexString {Mask 0}} { set IpAddr_tmp [ShiftBitsRight $IPHexString $Mask] # return [DecToHex $IpAddr_tmp] } # IPHexString - ipv6 hex string without colons # Mask - prefix length (0 - 128) # # Return - ipv6 network string without colons proc PrefixToNet {IPHexString {Mask 0}} { set IpAddr_tmp [DecToHex [ShiftBitsRight $IPHexString $Mask]] # return [DecToHex [ShiftBitsLeft $IpAddr_tmp $Mask]] } # proc WithMask {IpAddr {Mask {}}} { set IpAddr_tmp $IpAddr # if {$Mask ne ""} { set IpAddr_tmp [join [list $IpAddr $Mask] /] } # return $IpAddr_tmp } # Return - ipv6 address string without colons # # IpAddr - ipv6 address proc IPtoHexString {IpAddr} { return [join [split $IpAddr :] {}] } # Check prefix length range # # IPPrefix - ipv6 address and mask(if specified) (::/64) # # Return - ipv6 address and prefix length (0-128) proc SplitIPMask {IPPrefix} { return [split $IPPrefix /] } # proc CheckMask {IPPrefix} { variable PREFIX_LENGTH_MIN variable PREFIX_LENGTH_MAX # set IpAddr_tmp [split $IPPrefix /] # if {[llength $IpAddr_tmp] == 2} { set Mask [lindex $IpAddr_tmp 1] #check mask if [string is int $Mask] { #check mask range if {$Mask >= $PREFIX_LENGTH_MIN && $Mask <= $PREFIX_LENGTH_MAX} { return 0 } } # return -code error [list Invalid Prefix Length] } # return 0 } # Return - list of ipv6 address string before and after double colon # # IpAddr - ipv6 address proc SplitIPColon {IpAddr} { #match double colon in ipv6 address regexp {(.*)::(.*)} $IpAddr -> Prefix Sufix # if {$Prefix eq ""} {set Prefix 0} if {$Sufix eq ""} {set Sufix 0} # return [list $Prefix $Sufix] } # Return - number of double colons in ipv6 address # # IpAddr - ipv6 address proc CheckDoubleColon {IpAddr} { return [llength [regexp -inline -all {::} $IpAddr]] } # check syntax of ipv6 addres (char length) # # IpAddr - ipv6 address # DoubleColon - is double colon in ipv6 address # # Return - 0 Valid or 1 Invalid proc CheckLength {IpAddr DoubleColon} { variable IP_ADDR_NBBL_LENGTH # set ErrorStatus 0 set Addr [split $IpAddr :] set AddrLength [llength $Addr] #check ip nibble sum if {!$ErrorStatus && $AddrLength > $IP_ADDR_NBBL_LENGTH} { set ErrorStatus 1 } #check if ip address nibble sum < 8 and it does not have double colon if {!$ErrorStatus && $AddrLength != $IP_ADDR_NBBL_LENGTH && $DoubleColon != 1} { set ErrorStatus 1 } #check ip address nibble length (should not be more than 4) if {!$ErrorStatus} { foreach Nibble $Addr { set NibbleCharLength [string length $Nibble] if {$NibbleCharLength > 4} { set ErrorStatus 1 break } } } # return $ErrorStatus } # Check ipv6 address syntax # # IpAddr - ipv6 address with or without mask # # Return - 1 Valid or error proc IsIpv6 {IpAddr} { set ErrorStatus 0 set DoubleColon 0 set Result 1 #check mask if specified CheckMask $IpAddr lassign [SplitIPMask $IpAddr] Addr Mask #check if ipaddress starts or ends with one colon if {!$ErrorStatus && [regexp {(^:[^:]|[^:]:$)} $Addr]} { set ErrorStatus 1 set Result "Unbalanced colon $Addr" } #match every char in ipv6 except legits (a-f A-F : digit) if {!$ErrorStatus && [regexp -nocase {[^\da-f:]} $Addr]} { set ErrorStatus 1 set Result "Illegal syntax $Addr" } #check if ip address contains less than 2 double colons if {!$ErrorStatus} { set DoubleColon [CheckDoubleColon $Addr] # switch -- $DoubleColon { 0 {} 1 {set Addr [join [SplitIPColon $Addr] :]} default { set ErrorStatus 1 set Result "Unbalanced colon $Addr" } } } #check ipv6 address length if {!$ErrorStatus} { set ErrorStatus [CheckLength $Addr $DoubleColon] # if $ErrorStatus { set Result "Invalid length $Addr" } } # return -code $ErrorStatus $Result } # proc CheckAndPrepareIP {ipAddrListVar} { variable OUR_NAMESPACE # set IpAddr_tmp {} # upvar $ipAddrListVar IpAddrList_tmp # set CallerNameSpace [uplevel 2 {namespace current}] # if {$CallerNameSpace ne $OUR_NAMESPACE} { try { foreach IpAddr $IpAddrList_tmp { if [IsIpv6 $IpAddr] { lappend IpAddr_tmp [Normalize $IpAddr] } } # set IpAddrList_tmp $IpAddr_tmp } on error {result options} { return -code error $result } } } # Check ipv6 address syntax # # IpAddr - ipv6 address with or without mask # # Return - 1 Valid or 0 Invalid proc isIpv6 {IpAddr} { if [catch {IsIpv6 $IpAddr}] { return 0 } return 1 } # expand ipv6 address syntax without leading zeros (aa:: -> AA:0:0:0:0:0:0:0) # # IpAddr - ipv6 address without mask # # Return - full ipv6 address proc Expand {IpAddr} { variable IP_ADDR_NBBL_LENGTH # set IpAddr_tmp $IpAddr #check if address has double colon set DoubleColon [CheckDoubleColon $IpAddr] #expand ip address if {$DoubleColon == 1} { lassign [SplitIPColon $IpAddr] Prefix Sufix #calculate how many nibbles are suppressed set NibbleLength(Prefix) [llength [split $Prefix :]] set NibbleLength(Sufix) [llength [split $Sufix :]] set NibbleSum [expr {$NibbleLength(Prefix) + $NibbleLength(Sufix)}] set NibbleDiff [expr {$IP_ADDR_NBBL_LENGTH - $NibbleSum}] #append suppressed nibbles with 0-s set IpAddr_tmp [join [list $Prefix {*}[lrepeat $NibbleDiff 0] $Sufix] :] } return [string toupper $IpAddr_tmp] } # Expand ipv6 address to it's full syntax (aa:: -> 00AA:0000:0000:0000:0000:0000:0000:0000) # # IpAddr - ipv6 address with or without mask # #Return - full ipv6 address with leading 0 proc Normalize {IpAddr} { variable NBBL_CHAR_LENGTH # lassign [SplitIPMask $IpAddr] Addr Mask # set IpAddrExp [Expand $Addr] # set IpAddr_tmp {} # foreach Nibble [split $IpAddrExp :] { set NibbleCharLength [string length $Nibble] #append nibble leading zeros set Nibble [join [concat [string repeat 0 [expr {$NBBL_CHAR_LENGTH - $NibbleCharLength}]] $Nibble] {}] set IpAddr_tmp [join [concat $IpAddr_tmp $Nibble] :] } # return [WithMask $IpAddr_tmp $Mask] } proc normalize {IpAddr} { CheckAndPrepareIP IpAddr # return $IpAddr } # Remove leading zeros (00AA:0000:0000:0000:0000:0000:0000:0000 -> AA:0:0:0:0:0:0:0) # # IpAddr - ipv6 address with or without mask # # Return - suppressed ipv6 address proc suppress {IpAddr} { variable IP_ADDR_NBBL_LENGTH variable NBBL_CHAR_LENGTH # CheckAndPrepareIP IpAddr # lassign [SplitIPMask $IpAddr] Addr Mask # set IpAddr_tmp {} # foreach Nibble [split $Addr :] { if {$Nibble ne "0000"} { set Nibble [string trimleft $Nibble 0] } else { set Nibble 0 } # set IpAddr_tmp [join [concat $IpAddr_tmp $Nibble] :] } # return [WithMask $IpAddr_tmp $Mask] } # Remove contiguous zeros and add double colon if posible (0AA0:0000:0000:0000:0000:0000:0000:0000/64 -> AA0::/64) # # IpAddr - ipv6 address with or without mask # # Return - compressed ipv6 address proc compress {IpAddr} { # CheckAndPrepareIP IpAddr # lassign [SplitIPMask $IpAddr] Addr Mask # set IpSupAddr [suppress $Addr] set SplitIP [split $IpSupAddr :] # set IpAddr_tmp $IpSupAddr set StartZeroIndx 0 set NibblePosition 0 set NewSeq 1 # foreach Nibble $SplitIP { if {$Nibble eq "0" && $NewSeq == 1} { incr ZeroLength($NibblePosition) set StartZeroIndx $NibblePosition set NewSeq 0 } elseif {$Nibble eq "0" && $NewSeq == 0} { incr ZeroLength($StartZeroIndx) } else { set NewSeq 1 } # incr NibblePosition } # if [info exists ZeroLength] { if {[llength [array names ZeroLength]] > 1} { foreach Indx [lsort [array names ZeroLength]] { if ![info exists LargestIndx] { set LargestIndx $Indx } else { set OldValue $ZeroLength($LargestIndx) set NewValue $ZeroLength($Indx) # if {$NewValue > $OldValue} { set LargestIndx $Indx } } } } else { set LargestIndx [array names ZeroLength] } # set Prefix [join [concat [lrange $SplitIP 0 [expr {$LargestIndx - 1}]]] :] set Sufix [join [concat [lrange $SplitIP [expr {$LargestIndx + $ZeroLength($LargestIndx)}] end]] :] set IpAddr_tmp [join [list $Prefix $Sufix] ::] } # return [WithMask $IpAddr_tmp $Mask] } # Return prefix length from provided IPv6 address proc mask {IpAddr} { CheckAndPrepareIP IpAddr # lassign [SplitIPMask $IpAddr] IpAddr_tmp Mask # if {$Mask eq ""} {set Mask 128} # return $Mask } # Compares IPv6 prefixes to each other # # IpAddr1 - ipv6 address with or without mask # IpAddr2 - ipv6 address with or without mask # # Return - 1 if equal else 0 proc equal {IpAddr1 IpAddr2} { CheckAndPrepareIP IpAddr1 CheckAndPrepareIP IpAddr2 # try { lassign [IPtoHexAndGetMask $IpAddr1] IpAddr_tmp(ip1) IpAddr_tmp(mask1) lassign [IPtoHexAndGetMask $IpAddr2] IpAddr_tmp(ip2) IpAddr_tmp(mask2) } on error {result options} { return -code error $result } # set IpAddr_tmp(ip1) [PrefixToNet $IpAddr_tmp(ip1) $IpAddr_tmp(mask1)] set IpAddr_tmp(ip2) [PrefixToNet $IpAddr_tmp(ip2) $IpAddr_tmp(mask2)] # if {$IpAddr_tmp(ip1) eq $IpAddr_tmp(ip2)} { return 1 } else { return 0 } } # proc Prefix {IpAddr} { CheckAndPrepareIP IpAddr # try { lassign [IPtoHexAndGetMask $IpAddr] IpAddr_tmp Mask # set IpAddr_tmp [HexStringToIP [FillZeros [PrefixToNet $IpAddr_tmp $Mask]]] } on error {result options} { return -code error $result } return $IpAddr_tmp } # proc prefix {IpAddr} { CheckAndPrepareIP IpAddr # try { set Prefix [compress [Prefix $IpAddr]] } on error {result options} { return -code error $result } # return $Prefix } # Calculate new ipv6 addres by given ipv6 address and offset # # IpAddr - ipv6 address without mask # Offset - Integer to add to provided ipv6 address (can be negative number) # # Return - IPv6 address in expanded format proc NextIP {IpAddr {Offset 1}} { CheckAndPrepareIP IpAddr # lassign [SplitIPMask $IpAddr] Addr Mask # if ![string is int $Offset] {return -code error [concat Error Offset should be integer]} # try { #convert ipv6 addres to hex string set IpAddr_tmp [IPtoHexString $Addr] #add offset to ip address set IpAddr_tmp [AddToHex $IpAddr_tmp $Offset] #convert decimal value to ipv6 syntax return [DecToIP $IpAddr_tmp] } on error {result options} { return -code error $result } } # Calculate new ipv6 addres by given ipv6 address and offset # # IpAddr - ipv6 address without mask # Offset - Integer to add to provided ipv6 address (can be negative number) # # Return - IPv6 address in compact format proc nextIP {IpAddr {Offset 1}} { CheckAndPrepareIP IpAddr # try { set IpAddr_tmp [compress [NextIP $IpAddr $Offset]] } on error {result options} { return -code error $result } # return $IpAddr_tmp } # Calculate new ipv6 prefix by given ipv6 address mask(optional) and offset # # IPPrefix - ipv6 address with or without mask # Offset - Integer to add to provided ipv6 address (can be negative number) # # Return - IPv6 address in expanded format without mask proc NextNet {IPPrefix {Offset 1}} { CheckAndPrepareIP IPPrefix # try { lassign [IPtoHexAndGetMask $IPPrefix] IpAddr_tmp mask # set IpAddr_tmp [HexStringToNetBits $IpAddr_tmp $mask] #add offset to ip address set IpAddr_tmp [DecToHex [AddToHex $IpAddr_tmp $Offset]] #convert decimal value to ip syntax set IpAddr_tmp [DecToIP [ShiftBitsLeft $IpAddr_tmp $mask]] # return $IpAddr_tmp } on error {result options} { return -code error $result } } # Calculate new ipv6 prefix by given ipv6 address mask(optional) and offset # # IPPrefix - ipv6 address with or without mask # Offset - Integer to add to provided ipv6 address (can be negative number) # # Return - IPv6 address in compact format without mask proc nextNet {IPPrefix {Offset 1}} { CheckAndPrepareIP IPPrefix # try { set IpAddr_tmp [compress [NextNet $IPPrefix $Offset]] } on error {result options} { return -code error $result } # return $IpAddr_tmp } # Checks if second prefix overlaps with the first one # # IPPrefix1 - ipv6 address with or without mask # IPPrefix2 - ipv6 address with or without mask # # Return - 1 if second prefix overlaps with first, 0 if not proc isOverlap {IPPrefix1 IPPrefix2} { CheckAndPrepareIP IPPrefix1 CheckAndPrepareIP IPPrefix2 # try { lassign [IPtoHexAndGetMask $IPPrefix1] IpAddr_tmp(ip1) IpAddr_tmp(mask1) lassign [IPtoHexAndGetMask $IPPrefix2] IpAddr_tmp(ip2) IpAddr_tmp(mask2) # if {$IpAddr_tmp(mask1) < $IpAddr_tmp(mask2)} { return 0 } # set IpAddr_tmp(ip1) [NormTo4BitBound [HexStringToNetBits $IpAddr_tmp(ip1) $IpAddr_tmp(mask1)] $IpAddr_tmp(mask1)] set IpAddr_tmp(ip2) [NormTo4BitBound [HexStringToNetBits $IpAddr_tmp(ip2) $IpAddr_tmp(mask1)] $IpAddr_tmp(mask1)] # return [expr {$IpAddr_tmp(ip1) eq $IpAddr_tmp(ip2) ? 1:0}] } on error {result options} { return -code error $result } } # Given list of ipv6 prefixes this commands checks if addresses overlap and returns addresses with lower prefix length # # PrefixList - list of ipv6 prefixes with or without mask # # Return - list of ipv6 aggregate addreses proc ReduceToAggregates {PrefixList} { # CheckAndPrepareIP PrefixList # set ListSize [llength $PrefixList] # if !$ListSize {return} # set BREAK 0 set AggRes {} array set Skip {} array set Matched {} array set Unmatched {} set StartIndx 1 set MatchedItemIndex NULL set SkipItemIndex NULL # for {set ListItemIndex 0} {$ListItemIndex < $ListSize} {incr ListItemIndex} { # if [info exists Skip($ListItemIndex)] {continue} # set Item1 [lindex $PrefixList $ListItemIndex] # set MatchedItemIndex NULL # for {set CompItemIndx $StartIndx} {$CompItemIndx < $ListSize} {incr CompItemIndx} { set SkipItemIndex NULL set BREAK 0 set Item2 [lindex $PrefixList $CompItemIndx] # if [isOverlap $Item1 $Item2] { set MatchedItemIndex $ListItemIndex set SkipItemIndex $CompItemIndx } elseif [isOverlap $Item2 $Item1] { set MatchedItemIndex $CompItemIndx set SkipItemIndex $ListItemIndex set BREAK 1 } # if {$SkipItemIndex ne "NULL" && ![info exists Skip($SkipItemIndex)]} { set Skip($SkipItemIndex) 1 } # if $BREAK {break} } # if {$MatchedItemIndex ne "NULL" && ![info exists Matched($MatchedItemIndex)]} { set Item [lindex $PrefixList $MatchedItemIndex] # lappend AggRes [list [Prefix $Item]/[mask $Item]] set Matched($MatchedItemIndex) 1 } # if {![info exists Matched($ListItemIndex)] && ![info exists Skip($SkipItemIndex)]} { set Unmatched($ListItemIndex) 1 } # incr StartIndx } # foreach ListItemIndex [array names Unmatched] { set Item [lindex $PrefixList $ListItemIndex] lappend AggRes [list [Prefix $Item]/[mask $Item]] } # return $AggRes } # same as ReduceToAggregates but returns ipv6 prefixes in compact format proc reduceToAggregates {PrefixList} { CheckAndPrepareIP PrefixList # foreach Prefix [ReduceToAggregates $PrefixList] { lappend PrefixList_tmp [compress $Prefix] } # return $PrefixList_tmp } # Given list of ipv6 prefixes this command if possible summarizes contiguous IPv6 prefixes to an aggregate network. # # PrefixList - list of ipv6 prefixes with or without mask # # Return - aggregated ipv6 prefix list proc Collapse {PrefixList} { CheckAndPrepareIP PrefixList # set PrefixList [CheckAndNormilize $PrefixList] # set CAN_NORMILIZE_MORE 1 set NO_ITEM "" while {$CAN_NORMILIZE_MORE} { set Ret {} # set PrefixList [lsort -incr $PrefixList] # set CAN_NORMILIZE_MORE 0 # for {set idx 0} {$idx < [llength $PrefixList]} {incr idx} { set nextidx [expr {$idx + 1}] set item [lindex $PrefixList $idx] set nextitem [lindex $PrefixList $nextidx] if {$nextitem eq $NO_ITEM} { lappend Ret $item continue } # set itemmask [mask $item] set nextitemmask [mask $nextitem] # if {$itemmask ne $nextitemmask} { lappend Ret $item continue } set adjacentitem [NextNet $item] if {[Prefix $nextitem] ne $adjacentitem} { lappend Ret $item continue } set upmask [expr {$itemmask - 1}] set upitem [join [list [Prefix $item] $upmask] /] # Maybe just checking the llength of the result is enough ? if {[ReduceToAggregates [list $item $nextitem $upitem]] != [list $upitem]} { lappend Ret $item continue } set CAN_NORMILIZE_MORE 1 incr idx lappend Ret $upitem } set PrefixList $Ret } return $PrefixList } # Same as Collapse but returns ipv6 prefixes in compact format proc collapse {PrefixList} { CheckAndPrepareIP PrefixList # foreach Prefix [Collapse $PrefixList] { lappend PrefixList_tmp [compress $Prefix] } # return $PrefixList_tmp } # Given lists of ipv6 prefixes this command subtracts second list of prefixs from the first one and returns new list of ipv6 prefixes # # PosPrefixList - list of ipv6 prefixes from which subtraction should be done # NegPrefixList - list of ipv6 prefixes which should be subtracted # # Return - list of calculated ipv6 prefixes proc Subtract {PosPrefixList NegPrefixList} { CheckAndPrepareIP PosPrefixList CheckAndPrepareIP NegPrefixList # set PosPrefixList [CheckAndNormilize $PosPrefixList] set PosPrefixList [lsort -command SortLargeToSmallMask [ReduceToAggregates $PosPrefixList]] # if {$NegPrefixList eq ""} {return $PosPrefixList} # #Reduce to aggregate negative prefixes and sort from largest to smallest set NegPrefixList [CheckAndNormilize $NegPrefixList] set NegPrefixList [lsort -command SortLargeToSmallMask [ReduceToAggregates $NegPrefixList]] #Check if we have negative prefixes foreach NegPrefix $NegPrefixList { #Get negative prefix mask set NegPrefMask [mask $NegPrefix] # foreach PosPrefix $PosPrefixList { #Check if negative subnet is overlaping with positive if [isOverlap $PosPrefix $NegPrefix] { #Check if negative prefix is already in positive prefix list if {$NegPrefix in $PosPrefix} { set PosPrefixList [Lpop $PosPrefixList $NegPrefix] } else { set PosPrefixList [concat [Lpop $PosPrefixList $PosPrefix] [RecSubtract $PosPrefix [mask $PosPrefix] $NegPrefix $NegPrefMask]] } # break } } } # return $PosPrefixList } proc RecSubtract {PosPrefixList PosMask NegPrefix NegPrefMask} { set Mask [expr {$PosMask + 1}] # set PosPrefixExpanded [ExpandSubnet $PosPrefixList $Mask] # foreach PosPrefix $PosPrefixExpanded { #Check if negative subnet is overlaping with positive if [isOverlap $PosPrefix $NegPrefix] { set NextPosPrefix $PosPrefix set PosPrefixList [Lpop $PosPrefixExpanded $NextPosPrefix] break } } # if {$Mask != $NegPrefMask} { append PosPrefixList " [RecSubtract $NextPosPrefix $Mask $NegPrefix $NegPrefMask]" } # return "$PosPrefixList " } # Same as Subtract but returns ipv6 prefixes in compact format proc subtract {PosPrefixList NegPrefixList} { CheckAndPrepareIP PosPrefixList CheckAndPrepareIP NegPrefixList # set PrefixList_tmp {} # foreach Prefix [Subtract $PosPrefixList $NegPrefixList] { lappend PrefixList_tmp [compress $Prefix] } # return $PrefixList_tmp } # Calculate new subnets by providing IPv6 prefix, desired new prefix length and offset # # IPPrefix - ipv6 address with or without mask # NewMask - prefix length of desired new subnetworks # Offset - number of subnetwork which should be returnd (default 0: all subnets) # # return - IPv6 prefix list of new subnetworks proc ExpandSubnet {IPPrefix NewMask {Offset 0}} { CheckAndPrepareIP IPPrefix # set OldMask [mask $IPPrefix] set Prefix [Prefix $IPPrefix] # set NumSubnets [expr {round(pow(2, ($NewMask - $OldMask)))}] # if {$Offset <= $NumSubnets && $Offset != 0} { set NumSubnets $Offset } # set ret {} for {set idx 0} {$idx < $NumSubnets} {incr idx} { lappend ret "${Prefix}/${NewMask}" set Prefix [Prefix [NextNet $Prefix/$NewMask]] } return $ret } # Same as ExpandSubnet but returns ipv6 prefixes in compact format proc expandSubnet {IPPrefix NewMask {Offset 0}} { CheckAndPrepareIP IPPrefix # set PrefixList_tmp {} # foreach Prefix [ExpandSubnet $IPPrefix $NewMask $Offset] { lappend PrefixList_tmp [compress $Prefix] } # return $PrefixList_tmp } # Given list of ipv6 addreses calculates mapping to ethernet multicast mac address # # IpAddrList - list of ipv6 addresses # # return - list of ethernet addresses mapped to ipv6 multicast address last 32 bits proc ipv6ToEthMulticast {IpAddrList} { variable IPV6_MULTICAST_PREFIX variable EHT_IPV6_MUL_FIRST_4_HEX_CHAR # CheckAndPrepareIP IpAddrList # set EthMulAddrList {} # try { foreach IPv6Addr $IpAddrList { if {[prefix $IPv6Addr/8] eq $IPV6_MULTICAST_PREFIX} { lassign [IPtoHexAndGetMask $IPv6Addr] IpAddr_tmp Mask set IPv6AddrLast8HexChar [string range $IpAddr_tmp end-7 end] lappend EthMulAddrList [string tolower [join [concat $EHT_IPV6_MUL_FIRST_4_HEX_CHAR $IPv6AddrLast8HexChar] {}]] } } # return $EthMulAddrList } on error {result options} { return -code error $result } } }
KPV There's a stackoverlow page which has regex to validate IPV6 addresses. It's quite horrendous.