--- /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
+proc list-sys-ifaces {} {
+ set ifaces [list]
+ foreach l [split [exec ip link] \n] {
+ if {[regexp {^\d+: (\w+): } $l _ iface] && $iface != "lo"} {
+ lappend ifaces $iface
+ }
+ }
+ return $ifaces
+}
+
+proc list-addrs {iface} {
+ set addrs [list]
+ catch {exec ip addr list dev $iface} lines
+ foreach l [split $lines \n] {
+ if {[regexp {inet (\S+)} $l _ addr]} {
+ lappend addrs $addr
+ }
+ if {[regexp {inet6 (\S+)} $l _ addr] && [string range $addr 0 4] != "fe80:"} {
+ lappend addrs $addr
+ }
+ }
+ return $addrs
+}
+
+package provide netUtils
--- /dev/null
+package ifneeded ip 1.4 [list source [file join $dir ip.tcl]]
+package ifneeded netUtils 1.4 [list source [file join $dir netUtils.tcl]]
-#!/usr/bin/env tclsh
+#!/usr/bin/env jimsh
# Generate network reconfiguration commands, based on dsc's net/
# configuration and current interfaces state.
# Copyright (C) 2025 Sergey Matveev <stargrave@stargrave.org>
-#!/usr/bin/env tclsh8.6
+#!/usr/bin/env jimsh
set addr [read -nonewline stdin]
package require ip
-#!/usr/bin/env tclsh8.6
+#!/usr/bin/env jimsh
set addr [file tail [file dirname [lindex $argv 0]]]
set maxlen 128
#!/usr/bin/env jimsh
-proc list-addrs {iface} {
- set addrs [list]
- catch {exec ip addr list dev $iface} lines
- foreach l [split $lines \n] {
- if {[regexp {inet (\S+)} $l _ addr]} {
- lappend addrs $addr
- }
- if {[regexp {inet6 (\S+)} $l _ addr] && [string range $addr 0 4] != "fe80:"} {
- lappend addrs $addr
- }
- }
- return $addrs
-}
-
-# TODO: check that interface exists
+package require netUtils
+namespace import netUtils::*
set iface [file tail [lindex $argv 0]]
+set sysIfaces [list-sys-ifaces]
+# If dsc's interface is not present in the system
+if {[lsearch -exact $sysIfaces $iface] == -1} {
+ exit
+}
+
set mtu [exec dsc get net/$iface/mtu]
puts "ip link set $iface mtu $mtu"
puts "ip link set $iface up"
#!/usr/bin/env jimsh
-proc list-addrs {iface} {
- set addrs [list]
- catch {exec ip addr list dev $iface} lines
- foreach l [split $lines \n] {
- if {[regexp {inet (\S+)} $l _ addr]} {
- lappend addrs $addr
- }
- if {[regexp {inet6 (\S+)} $l _ addr] && [string range $addr 0 4] != "fe80:"} {
- lappend addrs $addr
- }
- }
- return $addrs
-}
+package require netUtils
+namespace import netUtils::*
-set sysIfaces [list]
-foreach l [split [exec ip link] \n] {
- if {[regexp {^\d+: (\w+): } $l _ iface] && $iface != "lo"} {
- lappend sysIfaces $iface
- }
-}
+set sysIfaces [list-sys-ifaces]
set dscIfaces [split [exec dsc get net/*] \n]
-#!/usr/bin/env tclsh8.6
+#!/usr/bin/env jimsh
set n [read -nonewline stdin]
if {$n == ""} {