Updated 2012-11-04 04:25:49 by RLE

PT 2004-Jun-07 I think it would be useful to have a module in tcllib to do some manipulations of internet addresses. If we can think up a sensible API then we can provide something to help cope with both IPv4 and IPv6 addresses. For instance, how do I check that an address is within a certain range? Is 192.168.0.4 within 192.168.0.0./24 or within 192.16./16 or even within 192.168.0.0./255.255.255.0?

Here are a few helper functions I've used elsewhere. It's likely there are faster/neater implementations :) Assume at some point we have done
 namespace eval ip4 {}

Please feel free to comment and edit. I could especially use some equivalent functions to deal with IPv6 addresses.

There are some similar functions on A Little CIDR Calculator - I shall attempt to collect the fastest versions together here. PT

JJM 2009/02/06: Not sure if this is the right place for this; however, I did not see a better one.

Is an IPv6 address valid (i.e. does it use one of the allowed forms)? Here is my first stab at it and it might not cover all cases. I do not think this can be boiled down to a reasonable regex that still covers all the cases. Please feel free to improve it.
 proc isIpV4Address { string } {
   #
   # NOTE: Stolen from http://wiki.tcl.tk/989, Michael A. Cleverly
   #
   set octet {(?:\d|[1-9]\d|1\d\d|2[0-4]\d|25[0-5])}
   set pattern "^[join [list $octet $octet $octet $octet] {\.}]\$"
   return [regexp -- $pattern $string]
 }

 proc isIpV6Address { string } {
   #
   # NOTE: 2001:0db8:0000:0000:0000:0000:1428:57ab
   #       2001:0db8:0000:0000:0000::1428:57ab
   #       2001:0db8:0:0:0:0:1428:57ab
   #       2001:0db8:0:0::1428:57ab
   #       2001:0db8::1428:57ab
   #       2001:db8::1428:57ab
   #       2001:0db8:0000:0000:0000:0000:<IPv4>
   #       ::1
   #       ::
   #
   if {$string eq "::"} then {
     return true
   }

   if {[string range $string 0 1] == "::"} then {
     set string [string range $string 1 end]
   }

   if {[string range $string end-1 end] == "::"} then {
     set string [string range $string 0 end-1]
   }

   set octets [split $string :]
   set llength [llength $octets]

   if {$llength > 0 && $llength <= 8} then {
     set last [expr {$llength - 1}]

     for {set index 0} {$index < $llength} {incr index} {
       set octet [lindex $octets $index]
       set length [string length $octet]

       if {$length == 0} then {
         if {![info exists null]} then {
           set null $index; continue
         } else {
           return false
         }
       }

       if {$length <= 4 && [string is xdigit -strict $octet]} then {
         continue
       }

       if {$llength <= 7 && $index == $last && [isIpV4Address $octet]} then {
         continue
       }

       return false
     }

     return true
   }

   return false
 }

PT 23-July-2004: I have added an ip package to tcllib now. This can parse and compare IPv4 and IPv6 addresses. At the moment I consider the programming interface incomplete - I'm sure people can come up with ways to improve it.

::ip::version address

Returns the protocol version of the address (4 or 6) or 0 if the address is neither IPv4 or IPv6.

::ip::is class address

Returns true if the address is a member of the given protocol class. The class parameter may be either ipv4 or ipv6 This is effectively a boolean equivalent of the version command. The class argument may be shortened to 4 or 6.

::ip::equal address address

Compare two address specifications for equivalence. The arguments are normalized and the address prefix determined (if a mask is supplied). The normalized addresses are then compared bit-by-bit and the procedure returns true if they match.

::ip::normalize address

Convert an IPv4 or IPv6 address into a fully expanded version. There are various shorthand ways to write internet addresses, missing out redundant parts or digts.. This procedure is the opposite of contract.

::ip::contract address

Convert a normalized internet address into a more compact form suitable for displaying to users.

::ip::prefix address

Returns the address prefix generated by masking the address part with the mask if provided. If there is no mask then it is equivalent to calling normalize

::ip::type address

::ip::mask address

If the address supplied includes a mask then this is returned otherwise returns an empty string.

Examples
 % ip::version ::1
 6
 % ip::version 127.0.0.1
 4

 % ip::normalize 127/8
 127.0.0.0/8
 % ip::contract 192.168.0.0
 192.168

 % ip::normalize fec0::1
 fec0:0000:0000:0000:0000:0000:0000:0001
 % ip::contract fec0:0000:0000:0000:0000:0000:0000:0001
 fec0::1

 % ip::equal 192.168.0.4/16 192.168.0.0/16
 1
 % ip::equal fec0::1/10 fec0::fe01/10
 1

Older stuff ......

ip2x Convert an IPv4 address in dotted quad notation into a hexadecimal representation. This will extend truncated ip4 addresses with zeros. eg: ip2x 192.168.0.4 -> 0xc0a80004 or ip2x 127 -> 0x7f000000 This is a little faster using [binary] than using [format]
 proc ::ip4::ip2x {ip {validate 0}} {
    set octets [split $ip .]
    if {[llength $octets] != 4} {
        set octets [lrange [concat $octets 0 0 0] 0 3]
    }
    if {$validate} {
        foreach oct $octets {
            if {$oct < 0 || $oct > 255} {
                return -code error "invalid ip address"
            }
        }
    }
    binary scan [binary format c4 $octets] H8 x
    return 0x$x
 }

x2ip Turn the hex representation of an IPv4 address into dotted quad notation.
 proc ::ip4::x2ip {hex} {
    set r {}
    set bin [binary format I [expr {$hex}]]
    binary scan $bin c4 octets
    foreach octet $octets {
        lappend r [expr {$octet & 0xFF}]
    }
    return [join $r .]
 }

ipmask Returns an IPv4 address masked with subnet bits as a hexadecimal representation. For instance: [ipmask 192.168.0.4 24] -> 0xc0a80000 This makes it easy to compare addresses as described in the introduction. Is 192.168.0.4 within 192.168/16? [expr {[ipmask 192.168.0.4 16] == [ipmask 192.168 16]}]
 proc ::ip4::ipmask {ip {bits {}}} {
    if {[string length $bits] < 1} { set bits 32 }
    set ipx [ip2x $ip]
    if {[string is integer $bits]} {
        set mask [expr {(0xFFFFFFFF << (32 - $bits)) & 0xFFFFFFFF}]
    } else {
        set mask [ip2x $bits]
    }
    return [format 0x%08x [expr {$ipx & $mask}]]
 }

is_ip4_addr Use the ip4x conversion proc to check that the given address is really an IPv4 address.
 proc ::ip4::is_ip4_addr {ip} {
    if {[catch {ip2x $ip true}]} {
        return 0
    }
    return 1
 }

splitspec Split an address specification into a ipadd and mask part. This doesn't validate the address portion. If a spec with no mask is provided then the mask will be 32 (all bits significant).
 proc ::ip4::splitspec {spec} {
    set bits 32
    set domain $spec
    set slash [string last / $spec]
    if {$slash != -1} {
        incr slash -1
        set domain [string range $spec 0 $slash]
        incr slash 2
        set bits [string range $spec $slash end]
    }
    return [list $domain $bits]
 }

Examples
 proc IpaddrInDomain {addr domainspec} {
    foreach {network bits} [ip4::splitspec $domainspec] {}
    set net [ip4::ipmask $network $bits]
    set ipx [ip4::ipmask $addr $bits]
    if {$ipx == $net} {
        return 1
    }
    return 0
 }

escargo 7 Jun 2004 - From my networking experience, I can think of some functions that would be useful in handling IP addresses.

  • Is an address a host address?
  • Is an address a broadcast address?
  • Are a host address and a netmask consistent?

These would all be appropriate predicates to provide in such a library.

For a widget that allows validation of dotted decimal IP addresses take a look at mentry.

SMJ 17 Nov 2005 - Some tidbits I had to make and wanted to share, I'm sure someone can make them better.. :)

Returns Cisco wildcard mask from netmask
 proc getwc {netmask} {
   return [string map {255 0 254 1 252 3 248 7 240 15 224 31 192 63 128 127 0 255} $netmask]
 }

Returns the subnet from IP and netmask
 proc getsn {ip netmask} {
  set ipsplit [split $ip .]
  set nmsplit [split $netmask .]
  for {set x 0} {$x<4} {incr x} {
    lappend subnet [expr [lindex $ipsplit $x] & [lindex $nmsplit $x]]
  }
  return [join $subnet .]
 }

Returns Cisco wildcard mask from bits in a 192.0.2.0/24 notation
 proc getwc_from_route {route_with_bit} {
  set ipsplit [split $route_with_bit /]
  set bits [expr 32 - [lindex $ipsplit 1] ]
  set wc [expr (1<<$bits) - 1]
  set wc [expr ($wc & 0xffffffff)]
  set first_octet [expr (($wc & 0xff000000)>>24)]
  set second_octet [expr (($wc & 0xff0000)>>16)]
  set third_octet [expr (($wc & 0xff00)>>8)]
  set fourth_octet [expr $wc & 0xff]
  set retval ""
  append retval $first_octet "." $second_octet "." $third_octet "." $fourth_octet
  return $retval
 }

Returns number of bits the octet needs to fit into a bitboundary
 128 would return 1
 64,192 would return 2
 32,96,160 etc.  would return 3
 16,48,80 etc. would return 4
 and so on

And here's the code
 proc getbits {octet} {
   set retval 0
   set bits 0
   set val 0
   while { $retval != $octet } {
     set val [expr $val + (128>>$bits)]
     set retval [ expr $octet & $val ]
     incr bits
   }
   return $bits
 }

Returns the input with an added bitmask according to the shortest but longest matching subnetmask while adhering to the bitboundaries :)
  192.168.123.0 would return 192.168.123.0/24
  172.16.12.0 would return 172.16.12.0/22 (because of the .12. octet)
  10.10.12.12 would return 10.10.12.12/30

And here's the code (uses the getbits procedure above)
 proc getclass {ip} {
   set ipsplit [split $ip .]
   set retval $ip
   #In which octet is the least significant bit located?
   if { [lindex $ipsplit 3] > 0 } {
     #it's located in the fourth octet
     set bits 24
   } elseif { [lindex $ipsplit 2] > 0 } {
     #it's located in the third octet
     set bits 16
   } elseif { [lindex $ipsplit 1] > 0 } {
     #it's located in the second octet
     set bits 8
   } else  {
     #it's located in the first octet
     set bits 0
   }
   #now add the additional bits
   switch $bits {
     24  { set bits [expr [getbits [lindex $ipsplit 3]] + $bits] }
     16  { set bits [expr [getbits [lindex $ipsplit 2]] + $bits] }
      8  { set bits [expr [getbits [lindex $ipsplit 1]] + $bits] }
      0  { set bits getbits [lindex $ipsplit 0] }
   }
   append retval "/" $bits
   return $retval
 }