#!/bin/sh
 # Emacs: please open this file in -*-Tcl-*- mode
 #
 # Author: Mark Oakden https://wiki.tcl-lang.org/MNO
 # Version: 1.1
 #
 # Note: this is almost certainly riddled with byte order
 # and 32-bit assumptions.
 #
 # Changes since 1.0:-
 #  changed usage of regsub to accomodate earlier tcl/tk versions than 8.4.1
 #  changed layout to accomodate PocketPC better
 #
 # the next but one line restarts with tclsh...
 # DO NOT REMOVE THIS BACKSLASH -> \
     exec tclsh "$0" ${1+"$@"}
 #
 package require Tk
 #
 # a couple of defaults
 #
 set IP 192.168.100.1
 set CIDR 24
 # IPtoHex assumes IP has already been validated
 proc IPtoHex { IP } {
     binary scan [binary format c4 [split $IP .]] H8 Hex
     return $Hex
 }
 proc hexToIP { Hex } {
     binary scan [binary format H8 $Hex] c4 IPtmp
     foreach num $IPtmp {
         # binary scan "c" format gives signed int - the following
         # [expr]-ology converts to unsigned (from [binary] manpage)
         lappend IP [expr ($num + 0x100) % 0x100]
     }
     set IP [join $IP .]
     return $IP
 }
 proc CIDRtoHexNetmask { CIDR } {
     set zeros [expr 32 - $CIDR]
     set ones $CIDR
     set binaryCIDR [string repeat 1 $ones]
     append binaryCIDR [string repeat 0 $zeros]
     binary scan [binary format B32 $binaryCIDR] H8 HexNetmask
     return $HexNetmask
 }
 proc IPisValid { IP } {
     # must contain only dots and digits
     # this originally read:-
     #if { [regsub -all {[.0-9]} $IP {}] != "" } {
     #        return 0
     #}
     regsub -all {[.0-9]} $IP {} tmpStr
     if { $tmpStr != "" } {
         return 0
     }
     # however this appears to be a 8.4.1-ism which doesn't work with 
     # earlier versions (e.g. the 8.4a2 version that the PocketPC tcltk
     # version is based on.
     #
     # exactly three dots
     regsub -all {[0-9]} $IP {} tmpStr
     if { $tmpStr != "..." } {
         return 0
     }
     # each numerical component is between 0 and 255
     foreach b [split $IP .] {
         if { [string length $b] == 0 } {
             return 0
         }
         set ob $b
         scan $b %d b ;# allow for leading zeros which tcl thinks are octal
         if { $b < 0 | $b > 255 } {
             return 0
         }
     }
     return 1
 }

 proc CIDRisValid { CIDR } {
     if { [string length $CIDR] == 0 } {
         return 0
     }
     regsub -all {[0-9]} $CIDR {} tmpStr
     if { [string length $tmpStr] != 0 } {
         return 0
     }
     scan $CIDR %d CIDR
     # 4 is arbitrary restriction on my part, but no-one uses CIDR to
     # amalgamate multiple class A addresses! CIDR of 31 and 32 are
     # non-useful also (/31 would leave just two IP addresses in the
     # subnet, one of which would be the network address, the other
     # the broadcast address - i.e. no usable IPs)
     if { $CIDR < 4 | $CIDR > 30 } {
          return 0
     }
     return 1
 }
 
 # IP and netmask in Hex, returns hex
 proc networkAddress { hexIP hexNetmask } {
     set compNetmask [expr 0x$hexNetmask ^ 0xffffffff]
     set tmpNetAddr [expr ( 0x$hexIP | $compNetmask ) ^ $compNetmask]
     binary scan [binary format I $tmpNetAddr] H8 networkAddress
     return $networkAddress
 }

 # IP and netmask in Hex, returns hex
 proc broadcastAddress { hexIP hexNetmask } {
     set tmpBrdAddr [expr 0x$hexIP | ( 0x$hexNetmask ^ 0xffffffff )]
     binary scan [binary format I $tmpBrdAddr] H8 broadcastAddress
     return $broadcastAddress
 }

 #
 proc buildGUI {} {
     pack [frame .f] -expand 1 -fill x
     label .f.l1 -text "IP Address/CIDR:"
     label .f.l2 -text "/"
     entry .f.ip -textvariable ::IP -width 15
     entry .f.cidr -textvariable ::CIDR -width 2
     bind .f.ip <Return> {calculate $::IP $::CIDR}
     bind .f.cidr <Return> {calculate $::IP $::CIDR}
     button .f.go -text "Go" -command {calculate $::IP $::CIDR} -underline 0
     pack .f.l1 .f.ip .f.l2 .f.cidr -side left
     pack .f.go -side left -fill x -expand true
     pack [frame .g] -expand 1 -fill x
     text .g.t -width 32 -height 7 -font {Courier 8}
     pack .g.t -expand 1 -fill x
     bind . <Alt-g> {.f.go invoke}
 }
 
 proc calculate { IP CIDR } {
     if { ! [IPisValid $IP] } {
          error "IP is not valid"
     }
     if { ! [CIDRisValid $CIDR] } {
          error "CIDR is not valid"
     }
     set hexIP [IPtoHex $IP]
     set hexNetmask [CIDRtoHexNetmask $CIDR]
     set netmask [hexToIP $hexNetmask]
     set hexNetworkAddress [networkAddress $hexIP $hexNetmask]
     set networkAddress [hexToIP $hexNetworkAddress]
     set hexBroadcastAddress [broadcastAddress $hexIP $hexNetmask]
     set broadcastAddress [hexToIP $hexBroadcastAddress]
     set numIPs [expr 0x$hexBroadcastAddress - 0x$hexNetworkAddress - 1]
     binary scan [binary format I [expr 0x$hexNetworkAddress + 1]] \
          H8 firstIP
     set firstIP [hexToIP $firstIP]
     binary scan [binary format I [expr 0x$hexBroadcastAddress - 1]]\
          H8 lastIP
     set lastIP [hexToIP $lastIP]
     .g.t delete 1.0 end
     .g.t insert end "netmask: $netmask\n"
     .g.t insert end "  (hex): (0x$hexNetmask)\n"
     .g.t insert end "network: $networkAddress\n"
     .g.t insert end " b'cast: $broadcastAddress\n"
     .g.t insert end "  # IPs: $numIPs\n"
     .g.t insert end " 1st IP: $firstIP\nlast IP: $lastIP\n"
 }
 
 buildGUI
 # That's all, folks.

 proc ip2int ip {
     set res 0
     foreach i [split $ip .] {set res [expr {wide($res<<8 | $i)}]}
     set res
 }
 proc bits n {
     set res 0
     foreach i [split [string repeat 1 $n][string repeat 0 [expr {32-$n}]] ""] {
        set res [expr {$res<<1 | $i}]
     }
     set res
 }
 proc maskmatch {ip1 width ip2} {
     expr {([ip2int $ip1] & [bits $width]) == ([ip2int $ip2] & [bits $width])}
 }
 proc maskmatch2 {mask ip} {
     foreach {ip0 width} [split $mask /] break
     if {$width eq ""} {return [string equal $mask $ip]}
     maskmatch $ip0 $width $ip
 }
 if {0} { # Examples:
     maskmatch2 10.10.1.32/27  10.10.1.44
     # Expected result: 1
     maskmatch2 10.10.1.32/27  10.10.1.90
     # Expected result: 0
 }

 proc onNet {cidrAddr addr} {
    scan $cidrAddr {%d.%d.%d.%d/%d} a b c d bits
    set addr2 [format {%d.%d.%d.%d} $a $b $c $d]
    set mask [expr {0xffffffff & (0xffffffff << (32-$bits))}]
    expr {($mask & [ip2int $addr]) == ($mask & [ip2int $addr2])}
 }

 proc onNet {net ip} {
   set mask [ip::mask $net]
   if {$mask != ""} {
     set pfx [ip::prefix $ip/$mask]
   } else {
     set pfx $ip
   }
   string equal [ip::prefix $net] $pfx
 }