From ce6ace95a83562ed6019401569eb2113e664b98174152c75fc5c3277c23d08da Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Mon, 22 Dec 2025 14:58:00 +0300 Subject: [PATCH] Revised IP address validation --- jimlib/ip.tcl | 536 ------------- jimlib/ipMore.tcl | 479 ------------ jimlib/ipv6.tcl | 1118 +++++++++++++++++++++++++++ schema/net/*/addr/*/check | 39 +- schema/net/*/addr/*/prefixlen/check | 3 +- t/check-ip-empty.t | 12 + t/check-ipv4-invalid.t | 19 + t/check-ipv4-valid.t | 18 + t/check-ipv6-invalid.t | 20 + t/check-ipv6-valid.t | 21 + 10 files changed, 1236 insertions(+), 1029 deletions(-) delete mode 100644 jimlib/ip.tcl delete mode 100644 jimlib/ipMore.tcl create mode 100644 jimlib/ipv6.tcl create mode 100755 t/check-ip-empty.t create mode 100755 t/check-ipv4-invalid.t create mode 100755 t/check-ipv4-valid.t create mode 100755 t/check-ipv6-invalid.t create mode 100755 t/check-ipv6-valid.t diff --git a/jimlib/ip.tcl b/jimlib/ip.tcl deleted file mode 100644 index cf765aa..0000000 --- a/jimlib/ip.tcl +++ /dev/null @@ -1,536 +0,0 @@ -# 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 diff --git a/jimlib/ipMore.tcl b/jimlib/ipMore.tcl deleted file mode 100644 index e3159e4..0000000 --- a/jimlib/ipMore.tcl +++ /dev/null @@ -1,479 +0,0 @@ -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 -} diff --git a/jimlib/ipv6.tcl b/jimlib/ipv6.tcl new file mode 100644 index 0000000..c536597 --- /dev/null +++ b/jimlib/ipv6.tcl @@ -0,0 +1,1118 @@ +# 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 + } + } +} diff --git a/schema/net/*/addr/*/check b/schema/net/*/addr/*/check index b4a9e9d..82f0f8e 100755 --- a/schema/net/*/addr/*/check +++ b/schema/net/*/addr/*/check @@ -1,19 +1,34 @@ #!/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] diff --git a/schema/net/*/addr/*/prefixlen/check b/schema/net/*/addr/*/prefixlen/check index c45a349..53a738a 100755 --- a/schema/net/*/addr/*/prefixlen/check +++ b/schema/net/*/addr/*/prefixlen/check @@ -3,8 +3,7 @@ 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 } diff --git a/t/check-ip-empty.t b/t/check-ip-empty.t new file mode 100755 index 0000000..6f4b6c5 --- /dev/null +++ b/t/check-ip-empty.t @@ -0,0 +1,12 @@ +#!/bin/sh + +test_description="$(basename $0)" +. $SHARNESS_TEST_SRCDIR/sharness.sh + +echo >in +test_expect_success "fails" \ + "! $DSC_SCHEMA/net/*/addr/*/check whatever out 2>&1" +read msg in + test_expect_success "$addr: fails" \ + "! $DSC_SCHEMA/net/*/addr/*/check whatever out 2>&1" + read msg in + test_expect_success "$addr: succeeds" \ + "$DSC_SCHEMA/net/*/addr/*/check whatever out 2>&1" + read msg in + test_expect_success "$addr: fails" \ + "! $DSC_SCHEMA/net/*/addr/*/check whatever out 2>&1" + read msg in + test_expect_success "$addr: succeeds" \ + "$DSC_SCHEMA/net/*/addr/*/check whatever out 2>&1" + read msg