+++ /dev/null
-# Taken from Tcllib 1.21. Stripped comments and hard dependency on Tcl.
-# https://core.tcl-lang.org/tcllib/
-
-namespace eval ip {
- namespace export is version normalize equal type contract mask collapse subtract
- #catch {namespace ensemble create}
-
- variable IPv4Ranges
- if {![info exists IPv4Ranges]} {
- array set IPv4Ranges {
- 0/8 private
- 10/8 private
- 127/8 private
- 172.16/12 private
- 192.168/16 private
- 223/8 reserved
- 224/3 reserved
- }
- }
-
- variable IPv6Ranges
- if {![info exists IPv6Ranges]} {
- # RFC 3513: 2.4
- # RFC 3056: 2
- array set IPv6Ranges {
- 2002::/16 "6to4 unicast"
- fe80::/10 "link local"
- fec0::/10 "site local"
- ff00::/8 "multicast"
- ::/128 "unspecified"
- ::1/128 "localhost"
- }
- }
-}
-
-proc ::ip::is {class ip} {
- foreach {ip mask} [split $ip /] break
- switch -exact -- $class {
- ipv4 - IPv4 - 4 {
- return [IPv4? $ip]
- }
- ipv6 - IPv6 - 6 {
- return [IPv6? $ip]
- }
- default {
- return -code error "bad class \"$class\": must be ipv4 or ipv6"
- }
- }
-}
-
-proc ::ip::version {ip} {
- set version -1
- if {[string equal $ip {}]} { return $version}
- foreach {addr mask} [split $ip /] break
- if {[IPv4? $addr]} {
- set version 4
- } elseif {[IPv6? $addr]} {
- set version 6
- }
- return $version
-}
-
-proc ::ip::equal {lhs rhs} {
- foreach {LHS LM} [SplitIp $lhs] break
- foreach {RHS RM} [SplitIp $rhs] break
- if {[set version [version $LHS]] != [version $RHS]} {
- return -code error "type mismatch:\
- cannot compare different address types"
- }
- if {$version == 4} {set fmt I} else {set fmt I4}
- set LHS [Mask$version [Normalize $LHS $version] $LM]
- set RHS [Mask$version [Normalize $RHS $version] $RM]
- binary scan $LHS $fmt LLL
- binary scan $RHS $fmt RRR
- foreach L $LLL R $RRR {
- if {$L != $R} {return 0}
- }
- return 1
-}
-
-proc ::ip::collapse {prefixlist} {
- #puts **[llength $prefixlist]||$prefixlist
-
- # Force mask parts into length notation for the following merge
- # loop to work.
- foreach ip $prefixlist {
- foreach {addr mask} [SplitIp $ip] break
- set nip $addr/[maskToLength [maskToInt $mask]]
- #puts "prefix $ip = $nip"
- lappend tmp $nip
- }
- set prefixlist $tmp
-
- #puts @@[llength $prefixlist]||$prefixlist
-
- set ret {}
- set can_normalize_more 1
- while {$can_normalize_more} {
- set prefixlist [lsort -dict $prefixlist]
-
- #puts ||[llength $prefixlist]||$prefixlist
-
- set can_normalize_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 ""} {
- lappend ret $item
- continue
- }
-
- set itemmask [mask $item]
- set nextitemmask [mask $nextitem]
-
- set item [prefix $item]
-
- if {$itemmask ne $nextitemmask} {
- lappend ret $item/$itemmask
- continue
- }
-
- set adjacentitem [intToString [nextNet $item $itemmask]]/$itemmask
-
- if {$nextitem ne $adjacentitem} {
- lappend ret $item/$itemmask
- continue
- }
-
- set upmask [expr {$itemmask - 1}]
- set upitem "$item/$upmask"
-
- # Maybe just checking the llength of the result is enough ?
- if {[reduceToAggregates [list $item $nextitem $upitem]] != [list $upitem]} {
- lappend ret $item/$itemmask
- continue
- }
-
- set can_normalize_more 1
-
- incr idx
- lappend ret $upitem
- }
-
- set prefixlist $ret
- set ret {}
- }
-
- return $prefixlist
-}
-
-
-proc ::ip::normalize {ip {Ip4inIp6 0}} {
- foreach {ip mask} [SplitIp $ip] break
- set version [version $ip]
- set s [ToString [Normalize $ip $version] $Ip4inIp6]
- if {($version == 6 && $mask != 128) || ($version == 4 && $mask != 32)} {
- append s /$mask
- }
- return $s
-}
-
-proc ::ip::contract {ip} {
- foreach {ip mask} [SplitIp $ip] break
- set version [version $ip]
- set s [ToString [Normalize $ip $version]]
- if {$version == 6} {
- set r ""
- foreach o [split $s :] {
- append r [format %x: 0x$o]
- }
- set r [string trimright $r :]
- regsub {(?:^|:)0(?::0)+(?::|$)} $r {::} r
- } else {
- set r [string trimright $s .0]
- }
- return $r
-}
-
-proc ::ip::subtract {hosts} {
- set positives {}
- set negatives {}
-
- foreach host $hosts {
- foreach {addr mask} [SplitIp $host] break
- set host $addr/[maskToLength [maskToInt $mask]]
-
- if {[string match "-*" $host]} {
- set host [string trimleft $host "-"]
- lappend negatives $host
- } else {
- lappend positives $host
- }
- }
-
- # Reduce to aggregates if needed
- if {[llength $positives] > 1} {
- set positives [reduceToAggregates $positives]
- }
-
- if {![llength $positives]} {
- return {}
- }
-
- if {[llength $negatives] > 1} {
- set negatives [reduceToAggregates $negatives]
- }
-
- if {![llength $negatives]} {
- return $positives
- }
-
- # Remove positives that are cancelled out entirely
- set new_positives {}
- foreach positive $positives {
- set found 0
- foreach negative $negatives {
- # Do we need the exact check, i.e. ==, or 'eq', or would
- # checking the length of result == 1 be good enough?
- if {[reduceToAggregates [list $positive $negative]] == [list $negative]} {
- set found 1
- break
- }
- }
-
- if {!$found} {
- lappend new_positives $positive
- }
- }
- set positives $new_positives
-
- set retval {}
- foreach positive $positives {
- set negatives_found {}
- foreach negative $negatives {
- if {[isOverlap $positive $negative]} {
- lappend negatives_found $negative
- }
- }
-
- if {![llength $negatives_found]} {
- lappend retval $positive
- continue
- }
-
- # Convert the larger subnet
- ## Determine smallest subnet involved
- set maxmask 0
- foreach subnet [linsert $negatives 0 $positive] {
- set mask [mask $subnet]
- if {$mask > $maxmask} {
- set maxmask $mask
- }
- }
-
- set positive_list [ExpandSubnet $positive $maxmask]
- set negative_list {}
- foreach negative $negatives_found {
- foreach negative_subnet [ExpandSubnet $negative $maxmask] {
- lappend negative_list $negative_subnet
- }
- }
-
- foreach positive_sub $positive_list {
- if {[lsearch -exact $negative_list $positive_sub] < 0} {
- lappend retval $positive_sub
- }
- }
- }
-
- return $retval
-}
-
-proc ::ip::ExpandSubnet {subnet newmask} {
- #set oldmask [maskToLength [maskToInt [mask $subnet]]]
- set oldmask [mask $subnet]
- set subnet [prefix $subnet]
-
- set numsubnets [expr {round(pow(2, ($newmask - $oldmask)))}]
-
- set ret {}
- for {set idx 0} {$idx < $numsubnets} {incr idx} {
- lappend ret "${subnet}/${newmask}"
- set subnet [intToString [nextNet $subnet $newmask]]
- }
-
- return $ret
-}
-
-# Returns an IP address prefix.
-# For instance:
-# prefix 192.168.1.4/16 => 192.168.0.0
-# prefix fec0::4/16 => fec0:0:0:0:0:0:0:0
-# prefix fec0::4/ffff:: => fec0:0:0:0:0:0:0:0
-#
-proc ::ip::prefix {ip} {
- foreach {addr mask} [SplitIp $ip] break
- set version [version $addr]
- set addr [Normalize $addr $version]
- return [ToString [Mask$version $addr $mask]]
-}
-
-# Return the address type. For IPv4 this is one of private, reserved
-# or normal
-# For IPv6 it is one of site local, link local, multicast, unicast,
-# unspecified or loopback.
-proc ::ip::type {ip} {
- set version [version $ip]
- upvar [namespace current]::IPv${version}Ranges types
- set ip [prefix $ip]
- foreach prefix [array names types] {
- set mask [mask $prefix]
- if {[equal $ip/$mask $prefix]} {
- return $types($prefix)
- }
- }
- if {$version == 4} {
- return "normal"
- } else {
- return "unicast"
- }
-}
-
-proc ::ip::mask {ip} {
- foreach {addr mask} [split $ip /] break
- return $mask
-}
-
-# -------------------------------------------------------------------------
-
-# Returns true is the argument can be converted into an IPv4 address.
-#
-proc ::ip::IPv4? {ip} {
- if {[string first : $ip] >= 0} {
- return 0
- }
- if {[catch {Normalize4 $ip}]} {
- return 0
- }
- return 1
-}
-
-proc ::ip::IPv6? {ip} {
- set octets [split $ip :]
- if {[llength $octets] < 3 || [llength $octets] > 8} {
- return 0
- }
- set ndx 0
- foreach octet $octets {
- incr ndx
- if {[string length $octet] < 1} continue
- if {[regexp {^[a-fA-F\d]{1,4}$} $octet]} continue
- if {$ndx >= [llength $octets] && [IPv4? $octet]} continue
- if {$ndx == 2 && [lindex $octets 0] == 2002 && [IPv4? $octet]} continue
- #"Invalid IPv6 address \"$ip\""
- return 0
- }
- if {[regexp {^:[^:]} $ip]} {
- #"Invalid ipv6 address \"$ip\" (starts with :)"
- return 0
- }
- if {[regexp {[^:]:$} $ip]} {
- # "Invalid IPv6 address \"$ip\" (ends with :)"
- return 0
- }
- if {[regsub -all :: $ip "|" junk] > 1} {
- # "Invalid IPv6 address \"$ip\" (more than one :: pattern)"
- return 0
- }
- return 1
-}
-
-proc ::ip::Mask4 {ip {bits {}}} {
- if {[string length $bits] < 1} { set bits 32 }
- binary scan $ip I ipx
- if {[string is integer $bits]} {
- set mask [expr {(0xFFFFFFFF << (32 - $bits)) & 0xFFFFFFFF}]
- } else {
- binary scan [Normalize4 $bits] I mask
- }
- return [binary format I [expr {$ipx & $mask}]]
-}
-
-proc ::ip::Mask6 {ip {bits {}}} {
- if {[string length $bits] < 1} { set bits 128 }
- if {[string is integer $bits]} {
- set mask [binary format B128 [string repeat 1 $bits]]
- } else {
- binary scan [Normalize6 $bits] I4 mask
- }
- binary scan $ip I4 Addr
- binary scan $mask I4 Mask
- foreach A $Addr M $Mask {
- lappend r [expr {$A & $M}]
- }
- return [binary format I4 $r]
-}
-
-
-
-# A network address specification is an IPv4 address with an optional bitmask
-# Split an address specification into a IPv4 address and a network bitmask.
-# This doesn't validate the address portion.
-# If a spec with no mask is provided then the mask will be 32
-# (all bits significant).
-# Masks may be either integer number of significant bits or dotted-quad
-# notation.
-#
-proc ::ip::SplitIp {spec} {
- set slash [string last / $spec]
- if {$slash != -1} {
- incr slash -1
- set ip [string range $spec 0 $slash]
- incr slash 2
- set bits [string range $spec $slash end]
- } else {
- set ip $spec
- if {[string length $ip] > 0 && [version $ip] == 6} {
- set bits 128
- } else {
- set bits 32
- }
- }
- return [list $ip $bits]
-}
-
-# Given an IP string from the user, convert to a normalized internal rep.
-# For IPv4 this is currently a hex string (0xHHHHHHHH).
-# For IPv6 this is a binary string or 16 chars.
-proc ::ip::Normalize {ip {version 0}} {
- if {$version < 0} {
- set version [version $ip]
- if {$version < 0} {
- return -code error "invalid address \"$ip\":\
- value must be a valid IPv4 or IPv6 address"
- }
- }
- return [Normalize$version $ip]
-}
-
-proc ::ip::Normalize4 {ip} {
- set octets [split $ip .]
- if {[llength $octets] > 4} {
- return -code error "invalid ip address \"$ip\""
- } elseif {[llength $octets] < 4} {
- set octets [lrange [concat $octets 0 0 0] 0 3]
- }
- set normalized {}
- foreach oct $octets {
- set oct [scan $oct %d]
- if {$oct < 0 || $oct > 255} {
- return -code error "invalid ip address"
- }
- lappend normalized $oct
- }
- return [binary format c4 $normalized]
-}
-
-proc ::ip::Normalize6 {ip} {
- set octets [split $ip :]
- set ip4embed [string first . $ip]
- set len [llength $octets]
- if {$len < 0 || $len > 8} {
- return -code error "invalid address: this is not an IPv6 address"
- }
- set result ""
- for {set n 0} {$n < $len} {incr n} {
- set octet [lindex $octets $n]
- if {$octet == {}} {
- if {$n == 0 || $n == ($len - 1)} {
- set octet \0\0
- } else {
- set missing [expr {9 - $len}]
- if {$ip4embed != -1} {incr missing -1}
- set octet [string repeat \0\0 $missing]
- }
- } elseif {[string first . $octet] != -1} {
- set octet [Normalize4 $octet]
- } else {
- set m [expr {4 - [string length $octet]}]
- if {$m != 0} {
- set octet [string repeat 0 $m]$octet
- }
- set octet [binary format H4 $octet]
- }
- append result $octet
- }
- if {[string length $result] != 16} {
- return -code error "invalid address: \"$ip\" is not an IPv6 address"
- }
- return $result
-}
-
-
-# This will convert a full ipv4/ipv6 in binary format into a normal
-# expanded string rep.
-proc ::ip::ToString {bin {Ip4inIp6 0}} {
- set len [string length $bin]
- set r ""
- if {$len == 4} {
- binary scan $bin c4 octets
- foreach octet $octets {
- lappend r [expr {$octet & 0xff}]
- }
- return [join $r .]
- } elseif {$len == 16} {
- if {$Ip4inIp6 == 0} {
- binary scan $bin H32 hex
- for {set n 0} {$n < 32} {incr n} {
- append r [string range $hex $n [incr n 3]]:
- }
- return [string trimright $r :]
- } else {
- binary scan $bin H24c4 hex octets
- for {set n 0} {$n < 24} {incr n} {
- append r [string range $hex $n [incr n 3]]:
- }
- foreach octet $octets {
- append r [expr {$octet & 0xff}].
- }
- return [string trimright $r .]
- }
- } else {
- return -code error "invalid binary address:\
- argument is neither an IPv4 nor an IPv6 address"
- }
-}
-
-source [file join [file dirname [info script]] ipMore.tcl]
-
-# -------------------------------------------------------------------------
-
-package provide ip 1.4
+++ /dev/null
-if {![llength [info commands lassign]]} {
- # Either an older tcl version, or tclx not loaded; have to use our
- # internal lassign from http://wiki.tcl.tk/1530 by Schelte Bron
-
- proc ::ip::lassign {values args} {
- uplevel 1 [list foreach $args $values break]
- lrange $values [llength $args] end
- }
-}
-if {![llength [info commands lvarpop]]} {
- # Define an emulation of Tclx's lvarpop if the command
- # is not present already.
-
- proc ::ip::lvarpop {upVar {index 0}} {
- upvar $upVar list;
- set top [lindex $list $index];
- set list [concat [lrange $list 0 [expr $index - 1]] \
- [lrange $list [expr $index +1] end]];
- return $top;
- }
-}
-
-proc ip::prefixToNativeTcl {prefix} {
- set plist {}
- foreach p $prefix {
- set newPrefix [ip::toHex [ip::prefix $p]]
- if {[string equal [set mask [ip::mask $p]] ""]} {
- set newMask 0xffffffff
- } else {
- set newMask [format "0x%08x" [ip::maskToInt $mask]]
- }
- lappend plist [list $newPrefix $newMask]
- }
- if {[llength $plist]==1} {return [lindex $plist 0]}
- return $plist
-}
-
-proc ::ip::nativeToPrefix {nativeList args} {
- set pList 1
- set ipv4 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
-
- # if a single native element is passed eg {0x01010100 0xffffff00}
- # instead of {{0x01010100 0xffffff00} {0x01010100 0xffffff00}...}
- # then return a (non-list) single entry
- if {[llength [lindex $nativeList 0]]==1} {set pList 0; set nativeList [list $nativeList]}
- foreach native $nativeList {
- lassign $native ip mask
- if {[string equal $mask ""]} {set mask 32}
- set pString ""
- append pString [ip::ToString [binary format I [expr {$ip}]]]
- append pString "/"
- append pString [ip::maskToLength $mask]
- lappend rList $pString
- }
- # a multi (listified) entry was given
- # return the listified entry
- if {$pList} { return $rList }
- return $pString
-}
-
-proc ::ip::intToString {int args} {
- set ipv4 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
- return [ip::ToString [binary format I [expr {$int}]]]
-}
-
-
-proc ::ip::toInteger {ip} {
- binary scan [ip::Normalize4 $ip] I out
- return [format %lu [expr {$out & 0xffffffff}]]
-}
-
-proc ::ip::toHex {ip} {
- binary scan [ip::Normalize4 $ip] H8 out
- return "0x$out"
-}
-
-proc ::ip::maskToInt {mask} {
- if {[string is integer -strict $mask]} {
- set maskInt [expr {(0xFFFFFFFF << (32 - $mask))}]
- } else {
- binary scan [Normalize4 $mask] I maskInt
- }
- set maskInt [expr {$maskInt & 0xFFFFFFFF}]
- return [format %u $maskInt]
-}
-
-proc ::ip::broadcastAddress {prefix args} {
- set ipv4 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
- if {[llength $prefix] == 2} {
- lassign $prefix net mask
- } else {
- set net [maskToInt [ip::prefix $prefix]]
- set mask [maskToInt [ip::mask $prefix]]
- }
- set ba [expr {$net | ((~$mask)&0xffffffff)}]
-
- if {[llength $prefix]==2} {
- return [format "0x%08x" $ba]
- }
- return [ToString [binary format I $ba]]
-}
-
-proc ::ip::maskToLength {mask args} {
- set ipv4 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
- #pick the fastest method for either format
- if {[string is integer -strict $mask]} {
- binary scan [binary format I [expr {$mask}]] B32 maskB
- if {[regexp -all {^1+} $maskB ones]} {
- return [string length $ones]
- } else {
- return 0
- }
- } else {
- regexp {\/(.+)} $mask dumb mask
- set prefix 0
- foreach ipByte [split $mask {.}] {
- switch $ipByte {
- 255 {incr prefix 8; continue}
- 254 {incr prefix 7}
- 252 {incr prefix 6}
- 248 {incr prefix 5}
- 240 {incr prefix 4}
- 224 {incr prefix 3}
- 192 {incr prefix 2}
- 128 {incr prefix 1}
- 0 {}
- default {
- return -code error "not an ip mask: $mask"
- }
- }
- break
- }
- return $prefix
- }
-}
-
-
-proc ::ip::lengthToMask {masklen args} {
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
- # the fastest method is just to look
- # thru an array
- return $::ip::maskLenToDotted($masklen)
-}
-
-proc ::ip::nextNet {prefix mask args} {
- set count 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- set count [lindex $args 0]
- set args [lrange $args 1 end]
- }
- }
- }
- if {![string is integer -strict $prefix]} {
- set prefix [toInteger $prefix]
- }
- if {![string is integer -strict $mask] || ($mask < 33 && $mask > 0)} {
- set mask [maskToInt $mask]
- }
- set prefix [expr {$prefix + ((($mask ^ 0xFFffFFff) + 1) * $count) }]
- return [format "0x%08x" $prefix]
-}
-
-
-proc ::ip::isOverlap {ip args} {
- lassign [SplitIp $ip] ip1 mask1
- set ip1int [toInteger $ip1]
- set mask1int [maskToInt $mask1]
-
- set overLap 0
- foreach prefix $args {
- lassign [SplitIp $prefix] ip2 mask2
- set ip2int [toInteger $ip2]
- set mask2int [maskToInt $mask2]
- set mask1mask2 [expr {$mask1int & $mask2int}]
- if {[expr {$ip1int & $mask1mask2}] == [expr {$ip2int & $mask1mask2}]} {
- set overLap 1
- break
- }
- }
- return $overLap
-}
-
-
-proc ::ip::isOverlapNativeTcl {args} {
- set all 0
- set inline 0
- set notOverlap 0
- set ipv4 1
- foreach sw [lrange $args 0 end-3] {
- switch -exact -- $sw {
- -all {
- set all 1
- set allList [list]
- }
- -inline {set inline 1}
- -ipv4 {}
- }
- }
- set args [lassign [lrange $args end-2 end] ip1int mask1int prefixList]
- if {$inline} {
- set overLap [list]
- } else {
- set overLap 0
- }
- set count 0
- foreach prefix $prefixList {
- incr count
- lassign $prefix ip2int mask2int
- set mask1mask2 [expr {$mask1int & $mask2int}]
- if {[expr {$ip1int & $mask1mask2}] == [expr {$ip2int & $mask1mask2}]} {
- if {$inline} {
- set overLap [list $prefix]
- } else {
- set overLap $count
- }
- if {$all} {
- if {$inline} {
- lappend allList $prefix
- } else {
- lappend allList $count
- }
- } else {
- break
- }
- }
- }
- if {$all} {return $allList}
- return $overLap
-}
-
-proc ::ip::ipToLayer2Multicast { ipaddr } {
- regexp "\[0-9\]+\.(\[0-9\]+)\.(\[0-9\]+)\.(\[0-9\]+)" $ipaddr junk ip2 ip3 ip4
- #remove MSB of 2nd octet of IP address for mcast L2 addr
- set mac2 [expr {$ip2 & 127}]
- return [format "01.00.5e.%02x.%02x.%02x" $mac2 $ip3 $ip4]
-}
-
-
-proc ::ip::ipHostFromPrefix { prefix args } {
- set mask [mask $prefix]
- set ipaddr [prefix $prefix]
- if {[llength $args]} {
- array set opts $args
- } else {
- if {$mask==32} {
- return $ipaddr
- } else {
- return [intToString [expr {[toHex $ipaddr] + 1} ]]
- }
- }
- set format {-ipv4}
- # if we got here, then options were set
- if {[info exists opts(-exclude)]} {
- #basic algo is:
- # 1. throw away prefixes that are less specific that $prefix
- # 2. of remaining pfx, throw away prefixes that do not overlap
- # 3. run reducetoAggregates on specific nets
- # 4.
-
- # 1. convert to hex format
- set currHex [prefixToNative $prefix ]
- set exclHex [prefixToNative $opts(-exclude) ]
- # sort the prefixes by their mask, include the $prefix as a marker
- # so we know from where to throw away prefixes
- set sortedPfx [lsort -integer -index 1 [concat [list $currHex] $exclHex]]
- # throw away prefixes that are less specific than $prefix
- set specPfx [lrange $sortedPfx [expr {[lsearch -exact $sortedPfx $currHex] +1} ] end]
-
- #2. throw away non-overlapping prefixes
- set specPfx [isOverlapNative -all -inline \
- [lindex $currHex 0 ] \
- [lindex $currHex 1 ] \
- $specPfx ]
- #3. run reduce aggregates
- set specPfx [reduceToAggregates $specPfx]
-
- #4 now have to pick an address that overlaps with $currHex but not with
- # $specPfx
- # 4.1 find the largest prefix w/ most specific mask and go to the next net
-
-
- # current ats tcl does not allow this in one command, so
- # for now just going to grab the last prefix (list is already sorted)
- set sPfx [lindex $specPfx end]
- set startPfx $sPfx
- # add currHex to specPfx
- set oChkPfx [concat $specPfx [list $currHex]]
-
-
- set notcomplete 1
- set overflow 0
- while {$notcomplete} {
- #::ipMore::log::debug "doing nextnet on $sPfx"
- set nextNet [nextNet [lindex $sPfx 0] [lindex $sPfx 1]]
- #::ipMore::log::debug "trying $nextNet"
- if {$overflow && ($nextNet > $startPfx)} {
- #we've gone thru the entire net and didn't find anything.
- return -code error "ip host could not be found in $prefix"
- break
- }
- set oPfx [isOverlapNative -all -inline \
- $nextNet -1 \
- $oChkPfx
- ]
- switch -exact [llength $oPfx] {
- 0 {
- # no overlap at all. meaning we have gone beyond the bounds of
- # $currHex. need to overlap and try again
- #::ipMore::log::debug {ipHostFromPrefix: overlap done}
- set overflow 1
- }
- 1 {
- #we've found what we're looking for. pick this address and exit
- return [intToString $nextNet]
- }
- default {
- # 2 or more overlaps, need to increment again
- set sPfx [lindex $oPfx 0]
- }
- }
- }
- }
-}
-
-
-proc ::ip::reduceToAggregates { prefixList } {
- #find out format of $prefixeList
- set dotConv 0
- if {[llength [lindex $prefixList 0]]==1} {
- #format is dotted form convert all prefixes to native form
- set prefixList [ip::prefixToNative $prefixList]
- set dotConv 1
- }
-
- set nonOverLapping $prefixList
- while {1==1} {
- set overlapFound 0
- set remaining $nonOverLapping
- set nonOverLapping {}
- while {[llength $remaining]} {
- set current [lvarpop remaining]
- set overLap [ip::isOverlapNative [lindex $current 0] [lindex $current 1] $remaining]
- if {$overLap} {
- #there was a overlap find out which prefix has a the smaller mask, and keep that one
- if {[lindex $current 1] > [lindex [lindex $remaining [expr {$overLap -1}]] 1]} {
- #current has more restrictive mask, throw that prefix away
- # keep other prefix
- lappend nonOverLapping [lindex $remaining [expr {$overLap -1}]]
- } else {
- lappend nonOverLapping $current
- }
- lvarpop remaining [expr {$overLap -1}]
- set overlapFound 1
- } else {
- #no overlap, keep all prefixes, don't touch the stuff in
- # remaining, it is needed for other overlap checking
- lappend nonOverLapping $current
- }
- }
- if {$overlapFound==0} {break}
- }
- if {$dotConv} {return [nativeToPrefix $nonOverLapping]}
- return $nonOverLapping
-}
-
-proc ::ip::longestPrefixMatch { ipaddr prefixList args} {
- set ipv4 1
- while {[llength $args]} {
- switch -- [lindex $args 0] {
- -ipv4 {set args [lrange $args 1 end]}
- default {
- return -code error "option [lindex $args 0] not supported"
- }
- }
- }
- #find out format of prefixes
- set dotConv 0
- if {[llength [lindex $prefixList 0]]==1} {
- #format is dotted form convert all prefixes to native form
- set prefixList [ip::prefixToNative $prefixList]
- set dotConv 1
- }
- #sort so that most specific prefix is in the front
- if {[llength [lindex [lindex $prefixList 0] 1]]} {
- set prefixList [lsort -decreasing -integer -index 1 $prefixList]
- } else {
- set prefixList [list $prefixList]
- }
- if {![string is integer -strict $ipaddr]} {
- set ipaddr [prefixToNative $ipaddr]
- }
- set best [ip::isOverlapNative -inline \
- [lindex $ipaddr 0] [lindex $ipaddr 1] $prefixList]
- if {$dotConv && [llength $best]} {
- return [nativeToPrefix $best]
- }
- return $best
-}
-
-proc ip::cmpDotIP {ipaddr1 ipaddr2} {
- # convert dotted to decimal
- set ipInt1 [::ip::toHex $ipaddr1]
- set ipInt2 [::ip::toHex $ipaddr2]
- #ipMore::log::debug "$ipInt1 $ipInt2"
- if { $ipInt1 < $ipInt2} {
- return -1
- } elseif {$ipInt1 >$ipInt2 } {
- return 1
- } else {
- return 0
- }
-}
-
-namespace eval ::ip {
- variable maskLenToDotted
- variable x
-
- for {set x 0} {$x <33} {incr x} {
- set maskLenToDotted($x) [intToString [maskToInt $x]]
- }
- unset x
-}
-
-proc ::ip::distance {ip1 ip2} {
- # use package ip for normalization
- # XXX does not support ipv6
- expr {[toInteger $ip2]-[toInteger $ip1]}
-}
-
-proc ::ip::nextIp {ip {offset 1}} {
- set int [toInteger $ip]
- incr int $offset
- set prot {}
- # TODO if ipv4 then set prot -ipv4, but
- # XXX intToString has -ipv4, but never returns ipv6
- intToString $int ;# 8.5-ism, avoid: {*}$prot
-}
--- /dev/null
+# Copyright (C) 2017 David Nishnianidze d_nishnianidze@yahoo.com. All Rights Reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# a. Redistributions of source code must retain the above copyright notice,
+# this list of conditions and the following disclaimer.
+# b. 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 THE COPYRIGHT HOLDERS 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 THE REGENTS 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.
+
+
+
+
+
+# ################ #
+# FUNCTIONS #
+# ################ #
+#
+# isIpv6
+# normalize
+# suppress
+# contract
+# mask
+# equal
+# prefix
+# nextIP
+# nextNet
+# isOverlap
+# reduceToAggregates
+# collapse
+# subtract
+# expandSubnet
+# ipv6ToEthMulticast
+
+
+
+
+package provide ipv6 1.0
+
+namespace eval ipv6 {
+ #
+ namespace export isIpv6 normalize suppress contract mask equal prefix Prefix nextIP NextIP nextNet NextNet isOverlap reduceToAggregates ReduceToAggregates collapse Collapse subtract Subtract expandSubnet ExpandSubnet ipv6ToEthMulticast
+ #
+ variable QUARTET_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_QUARTET_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]
+ #
+ variable EXPAND_SUBNET_OPT_DEF [dict create -offset 0 -skip 0 -lastNet {}]
+ #
+ proc UpdateDefOpt {DefaultOptDict NewOptVal} {
+ dict for {Opt Val} $NewOptVal {
+ if [dict exists $DefaultOptDict $Opt] {
+ dict set DefaultOptDict $Opt $Val
+ }
+ }
+ return $DefaultOptDict
+ }
+
+
+ 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 QUARTET_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 + $QUARTET_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_QUARTET_LENGTH
+ #
+ set ErrorStatus 0
+ set Addr [split $IpAddr :]
+ set AddrLength [llength $Addr]
+ #check ipv6 quartet sum
+ if {!$ErrorStatus && $AddrLength > $IP_ADDR_QUARTET_LENGTH} {
+ set ErrorStatus 1
+ }
+ #check if ipv6 address quartet sum < 8 and it does not have double colon
+ if {!$ErrorStatus && $AddrLength != $IP_ADDR_QUARTET_LENGTH && $DoubleColon != 1} {
+ set ErrorStatus 1
+ }
+ #check ip address quartet length (should not be more than 4)
+ if {!$ErrorStatus} {
+ foreach Quartet $Addr {
+ set QuartetCharLength [string length $Quartet]
+ if {$QuartetCharLength > 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 [list]
+ #
+ 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
+ }
+ }
+ return
+ }
+
+ # 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_QUARTET_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 quartets should be suppressed
+ set QuartetLength(Prefix) [llength [split $Prefix :]]
+ set QuartetLength(Sufix) [llength [split $Sufix :]]
+ set QuartetSum [expr {$QuartetLength(Prefix) + $QuartetLength(Sufix)}]
+ set QuartetDiff [expr {$IP_ADDR_QUARTET_LENGTH - $QuartetSum}]
+ #append suppressed quartets with 0-s
+ set IpAddr_tmp [join [list $Prefix {*}[lrepeat $QuartetDiff 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 QUARTET_CHAR_LENGTH
+ #
+ lassign [SplitIPMask $IpAddr] Addr Mask
+ #
+ set IpAddrExp [Expand $Addr]
+ #
+ set IpAddr_tmp {}
+ #
+ foreach Quartet [split $IpAddrExp :] {
+ set QuartetCharLength [string length $Quartet]
+ #append quartet leading zeros
+ set Quartet [join [concat [string repeat 0 [expr {$QUARTET_CHAR_LENGTH - $QuartetCharLength}]] $Quartet] {}]
+ set IpAddr_tmp [join [concat $IpAddr_tmp $Quartet] :]
+ }
+ #
+ 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_QUARTET_LENGTH
+ variable QUARTET_CHAR_LENGTH
+ #
+ CheckAndPrepareIP IpAddr
+ #
+ lassign [SplitIPMask $IpAddr] Addr Mask
+ #
+ set IpAddr_tmp {}
+ #
+ foreach Quartet [split $Addr :] {
+ if {$Quartet ne "0000"} {
+ set Quartet [string trimleft $Quartet 0]
+ } else {
+ set Quartet 0
+ }
+ #
+ set IpAddr_tmp [join [concat $IpAddr_tmp $Quartet] :]
+ }
+ #
+ 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 - compact form of ipv6 address
+ proc contract {IpAddr} {
+ #
+ CheckAndPrepareIP IpAddr
+ #
+ lassign [SplitIPMask $IpAddr] Addr Mask
+ #
+ set IpSupAddr [suppress $Addr]
+ set SplitIP [split $IpSupAddr :]
+ #
+ set IpAddr_tmp $IpSupAddr
+ set StartZeroIndx 0
+ set QuartetPosition 0
+ set NewSeq 1
+ #
+ foreach Quartet $SplitIP {
+ if {$Quartet eq "0" && $NewSeq == 1} {
+ incr ZeroLength($QuartetPosition)
+ set StartZeroIndx $QuartetPosition
+ set NewSeq 0
+ } elseif {$Quartet eq "0" && $NewSeq == 0} {
+ incr ZeroLength($StartZeroIndx)
+ } else {
+ set NewSeq 1
+ }
+ #
+ incr QuartetPosition
+ }
+ #
+ 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 [contract [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 [contract [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 [contract [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 [contract $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 [contract $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 [contract $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
+ # Optional Args:
+ # -Offset - number of subnets which should be returned (default 0: all subnets)
+ # -lastNet - calculates new subnets after given ipv6 network (default IPPrefix)
+ # -skip - start calculating subnets after given offset
+ # return - IPv6 prefix list of new subnetworks
+ proc ExpandSubnet {IPPrefix NewMask args} {
+ variable EXPAND_SUBNET_OPT_DEF
+ #
+ set Opt [UpdateDefOpt $EXPAND_SUBNET_OPT_DEF $args]
+ #
+ CheckAndPrepareIP IPPrefix
+ #
+ set LastNet [dict get $Opt -lastNet]
+ if ![catch {IsIpv6 $LastNet}] {
+ set LastNet [Normalize $LastNet]
+ set Prefix [Prefix [NextNet [Prefix $LastNet]/$NewMask]]
+ } else {
+ set Prefix [Prefix $IPPrefix]
+ }
+ set Prefix [Prefix [NextNet $Prefix/$NewMask [dict get $Opt -skip]]]
+ #
+ set OldMask [mask $IPPrefix]
+ set NumSubnets [expr {round(pow(2, ($NewMask - $OldMask)))}]
+ #
+ set Offset [dict get $Opt -offset]
+ if {$Offset <= $NumSubnets && $Offset != 0} {
+ set NumSubnets $Offset
+ }
+ #
+ set PrefixList_tmp [list]
+ for {set SubnetId 0} {$SubnetId < $NumSubnets} {incr SubnetId} {
+ if ![ipv6::isOverlap $IPPrefix $Prefix] {
+ break
+ }
+ lappend PrefixList_tmp [join [list $Prefix $NewMask] /]
+ set Prefix [Prefix [NextNet $Prefix/$NewMask]]
+ }
+ return $PrefixList_tmp
+ }
+
+ # Same as ExpandSubnet but returns ipv6 prefixes in compact format
+ proc expandSubnet {IPPrefix NewMask args} {
+ CheckAndPrepareIP IPPrefix
+ #
+ set PrefixList_tmp [list]
+ foreach Prefix [ExpandSubnet $IPPrefix $NewMask {*}$args] {
+ lappend PrefixList_tmp [contract $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
+ }
+ }
+}
#!/usr/bin/env jimsh
set addr [read -nonewline stdin]
-package require ip
-set version [::ip::version $addr]
-if {$version == -1} {
- puts "invalid format"
+if {[string first / $addr] != -1} {
+ puts stderr "prefixlen must be empty"
exit 1
}
-if {[::ip::mask $addr] != ""} {
- puts "prefixlen must be empty"
- exit 1
+if {[string first : $addr] == -1} {
+ set octets [split $addr .]
+ if {[llength $octets] != 4} {
+ puts stderr "invalid format"
+ exit 1
+ }
+ set rv [list]
+ foreach octet $octets {
+ if {[string is integer $octet] == 0} {
+ puts stderr "non integer IPv4 octet"
+ exit 1
+ }
+ if {($octet < 0) || ($octet > 255)} {
+ puts stderr "out of range IPv4 octet"
+ exit 1
+ }
+ lappend rv [expr {0 + $octet}]
+ }
+ puts [join $rv .]
+ exit 0
}
-if {$version == 4} {
- set addr [::ip::normalize $addr]
-} else {
- set addr [::ip::contract $addr]
+package require ipv6
+if {[ipv6::isIpv6 $addr] != 1} {
+ puts stderr "invalid IPv6 format"
+ exit 1
}
-puts $addr
+puts [ipv6::contract $addr]
set addr [file tail [file dirname [lindex $argv 0]]]
set maxlen 128
set deflen 64
-package require ip
-if {[::ip::version $addr] == 4} {
+if {[string first : $addr] == -1} {
set maxlen 32
set deflen 24
}
--- /dev/null
+#!/bin/sh
+
+test_description="$(basename $0)"
+. $SHARNESS_TEST_SRCDIR/sharness.sh
+
+echo >in
+test_expect_success "fails" \
+ "! $DSC_SCHEMA/net/*/addr/*/check whatever <in >out 2>&1"
+read msg <out
+test_expect_success "msg" '[ "$msg" = "invalid format" ]'
+
+test_done
--- /dev/null
+#!/bin/sh
+
+test_description="$(basename $0)"
+. $SHARNESS_TEST_SRCDIR/sharness.sh
+
+while read addr expected ; do
+ echo $addr >in
+ test_expect_success "$addr: fails" \
+ "! $DSC_SCHEMA/net/*/addr/*/check whatever <in >out 2>&1"
+ read msg <out
+ test_expect_success "$addr: msg" '[ "$msg" = "$expected" ]'
+done <<EOF
+1234 invalid format
+256.1.1.1 out of range IPv4 octet
+a.1.1.1 non integer IPv4 octet
+1.2.3.4/16 prefixlen must be empty
+EOF
+
+test_done
--- /dev/null
+#!/bin/sh
+
+test_description="$(basename $0)"
+. $SHARNESS_TEST_SRCDIR/sharness.sh
+
+while read addr expected ; do
+ echo $addr >in
+ test_expect_success "$addr: succeeds" \
+ "$DSC_SCHEMA/net/*/addr/*/check whatever <in >out 2>&1"
+ read msg <out
+ test_expect_success "$addr: out" '[ "$msg" = "$expected" ]'
+done <<EOF
+0.0.0.0 0.0.0.0
+255.1.1.0 255.1.1.0
+001.002.003.04 1.2.3.4
+EOF
+
+test_done
--- /dev/null
+#!/bin/sh
+
+test_description="$(basename $0)"
+. $SHARNESS_TEST_SRCDIR/sharness.sh
+
+while read addr expected ; do
+ echo $addr >in
+ test_expect_success "$addr: fails" \
+ "! $DSC_SCHEMA/net/*/addr/*/check whatever <in >out 2>&1"
+ read msg <out
+ test_expect_success "$addr: msg" '[ "$msg" = "$expected" ]'
+done <<EOF
+::1/128 prefixlen must be empty
+::12345 invalid IPv6 format
+12::34::56 invalid IPv6 format
+12:34: invalid IPv6 format
+12::HE invalid IPv6 format
+EOF
+
+test_done
--- /dev/null
+#!/bin/sh
+
+test_description="$(basename $0)"
+. $SHARNESS_TEST_SRCDIR/sharness.sh
+
+while read addr expected ; do
+ echo $addr >in
+ test_expect_success "$addr: succeeds" \
+ "$DSC_SCHEMA/net/*/addr/*/check whatever <in >out 2>&1"
+ read msg <out
+ test_expect_success "$addr: out" '[ "$msg" = "$expected" ]'
+done <<EOF
+:: ::
+::1 ::1
+0000:0000:0000:0000:0000:0000:0000:0000 ::
+0012:0000:0000:0000:0000:0000:0000:0034 12::34
+DEAD:0::BEEF DEAD::BEEF
+2a03:2880:f113:81:face:b00c:0000:25de 2A03:2880:F113:81:FACE:B00C::25DE
+EOF
+
+test_done