#!/usr/bin/perl # # IP Address Abacus # http://www.anderbergfamily.net/ant/ipabacus/ # # My humble attempt at a GUI IP Subnet calculation tool. # by Anthony Anderberg # ant@anderbergfamily.net # # History: # # version 0.1 - 0.8 # 4/9/2007 - Initial prototype Versions # # version 0.9 # 7/15/2007 - Fiddled with TK widget packing # # version 1.0 # 7/17/2007 - Finished major features # # version 1.1 - 1.2 # 7/24/2007 - bug fixes, cleanup, and general beautification # # version 1.3 # 7/26/2007 - first public release # $version = "1.3"; #use strict; # Ha! I'm way too messy for this. ########################### # # Lots of the hard work here is being done by other people's code # # The GUI magic is provided by these modules. use Tk; use Tk::DialogBox; # Setup a table with our netmask representations. $netmask[0] = '0.0.0.0,0.0.0.0,255.255.255.255'; $netmask[1] = '128.0.0.0,80.0.0.0,127.255.255.255'; $netmask[2] = '192.0.0.0,C0.0.0.0,63.255.255.255'; $netmask[3] = '224.0.0.0,E0.0.0.0,31.255.255.255'; $netmask[4] = '240.0.0.0,F8.0.0.0,15.255.255.255'; $netmask[5] = '248.0.0.0,FC.0.0.0,7.255.255.255'; $netmask[6] = '252.0.0.0,FE.0.0.0,3.255.255.255'; $netmask[7] = '254.0.0.0,FF.0.0.0,1.255.255.255'; $netmask[8] = '255.0.0.0,FF.0.0.0,0.255.255.255'; $netmask[9] = '255.128.0.0,FF.80.0.0,0.127.255.255'; $netmask[10] = '255.192.0.0,FF.C0.0.0,0.63.255.255'; $netmask[11] = '255.224.0.0,FF.E0.0.0,0.31.255.255'; $netmask[12] = '255.240.0.0,FF.F0.0.0,0.15.255.255'; $netmask[13] = '255.248.0.0,FF.F8.0.0,0.7.255.255'; $netmask[14] = '255.252.0.0,FF.FC.0.0,0.3.255.255'; $netmask[15] = '255.254.0.0,FF.FE.0.0,0.1.255.255'; $netmask[16] = '255.255.0.0,FF.FF.0.0,0.0.255.255'; $netmask[17] = '255.255.128.0,FF.FF.80.0,0.0.127.255'; $netmask[18] = '255.255.192.0,FF.FF.C0.0,0.0.63.255'; $netmask[19] = '255.255.224.0,FF.FF.E0.0,0.0.31.255'; $netmask[20] = '255.255.240.0,FF.FF.F0.0,0.0.15.255'; $netmask[21] = '255.255.248.0,FF.FF.F8.0,0.0.7.255'; $netmask[22] = '255.255.252.0,FF.FF.FC.0,0.0.3.255'; $netmask[23] = '255.255.254.0,FF.FF.FE.0,0.0.1.255'; $netmask[24] = '255.255.255.0,FF.FF.FF.0,0.0.0.255'; $netmask[25] = '255.255.255.128,FF.FF.FF.C0,0.0.0.127'; $netmask[26] = '255.255.255.192,FF.FF.FF.C0,0.0.0.63'; $netmask[27] = '255.255.255.224,FF.FF.FF.E0,0.0.0.31'; $netmask[28] = '255.255.255.240,FF.FF.FF.F0,0.0.0.15'; $netmask[29] = '255.255.255.248,FF.FF.FF.F8,0.0.0.7'; $netmask[30] = '255.255.255.252,FF.FF.FF.FC,0.0.0.3'; $netmask[31] = '255.255.255.254,FF.FF.FF.FE,0.0.0.1'; $netmask[32] = '255.255.255.255,FF.FF.FF.FF,0.0.0.0'; ####################### # # Various global variables and their initial values # $current_class = "B"; $class_bits = 16; $txt_octet1 = 172; $txt_octet2 = 16; $txt_octet3 = 0; $txt_octet4 = 0; $scale_cidrbits = $class_bits; $cb_allsubnets = 1; $cb_supernetting = 0; ####################### # # Setup our main Window and its widgets # $mw = MainWindow->new; $mw->title("IP Address Abacus"); $topframe = $mw->Frame()->pack(-side=>'top', -expand=>1); $buttonframe = $mw->Frame()->pack(-side=>'bottom'); $sliderframe = $mw->Frame()->pack(-side=>'bottom', -expand=>1, -fill=>'both'); $leftframe = $mw->Frame()->pack(-side=>'left', -expand=>1, -fill=>'both'); $rightframe = $mw->Frame()->pack(-side=>'right', -expand=>1, -fill=>'both'); $topframe->Label(-text=>"Address and CIDR:")->pack(-side=>"left", -pady=>10, -padx=>10); $entry1 = $topframe->Entry(-textvariable=>\$txt_octet1, -width=>3)->pack(-ipadx=>5, -side=>"left", -pady=>10); $entry2 = $topframe->Entry(-textvariable=>\$txt_octet2, -width=>3)->pack(-ipadx=>5, -side=>"left", -pady=>10); $entry3 = $topframe->Entry(-textvariable=>\$txt_octet3, -width=>3)->pack(-ipadx=>5, -side=>"left", -pady=>10); $entry4 = $topframe->Entry(-textvariable=>\$txt_octet4, -width=>3)->pack(-ipadx=>5, -side=>"left", -pady=>10); $topframe->Label(-textvariable=>\$txt_cidr)->pack(-side=>"left", -pady=>10); $rb_classa = $leftframe->Radiobutton(-text=>"Class A (1.0.0.0 - 126.0.0.0)", -variable=>\$current_class, -value=>"A", -command=>\&SetClass)->pack(-anchor=>"w", -padx=>5); $rb_classb = $leftframe->Radiobutton(-text=>"Class B (128.0.0.0 - 191.255.0.0)", -variable=>\$current_class, -value=>"B", -command=>\&SetClass)->pack(-anchor=>"w", -padx=>5); $rb_classc = $leftframe->Radiobutton(-text=>"Class C (192.0.1.0 - 223.255.255.0)", -variable=>\$current_class, -value=>"C", -command=>\&SetClass)->pack(-anchor=>"w", -padx=>5); $leftframe->Label(-text=>" ")->pack(-anchor=>"w", -pady=>0); $leftframe->Checkbutton(-text=>"Use first and last subnets", -variable=>\$cb_allsubnets, -command=>\&SyncDisplay)->pack(-anchor=>"w", -padx=>5); $leftframe->Checkbutton(-text=>"Allow Supernetting", -variable=>\$cb_supernetting, -command=>\&SyncDisplay)->pack(-anchor=>"w", -padx=>5); $leftframe->Label(-textvariable=>\$txt_subnets)->pack(-side=>"bottom", -anchor=>'sw', -padx=>5); $rightframe->Label(-textvariable=>\$txt_currentnet)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_currentfirst)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_currentlast)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_currentbcast)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-text=>" ")->pack(-anchor=>"w", -pady=>0); $rightframe->Label(-textvariable=>\$txt_decmask)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_hexmask)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_aclmask)->pack(-anchor=>"w", -padx=>5); $rightframe->Label(-textvariable=>\$txt_hosts)->pack(-side=>"bottom", -anchor=>'se', -padx=>5); $scale = $sliderframe->Scale(-from=>0, -to=>30, -variable=>\$scale_cidrbits, -orient=>'horizontal', -command=>\&SyncDisplay)->pack(-fill=>'x'); $sliderframe->Label(-textvariable=>\$txt_addressmap)->pack(); $sliderframe->Label(-textvariable=>\$txt_bitlist)->pack(); $buttonframe->Button(-text=>"About", -command=>\&AboutDisplay)->pack(-ipadx=>20, -side=>"left", -pady=>10, -padx=>10); $detailsbutton = $buttonframe->Button(-text=>"Subnet Details", -command=>\&Details)->pack(-ipadx=>20, -side=>"left", -pady=>10, -padx=>10); $buttonframe->Button(-text=>"Exit", -command=>sub { exit })->pack(-ipadx=>20, -side=>"left", -pady=>10, -padx=>10); # # A few bindings help us have a more polished user experiance. # $entry1->bind("", [ \&UpdatedOctetEntry ]); $entry1->bind("", [ \&CheckEntry, Ev('K') ]); $entry2->bind("", [ \&UpdatedOctetEntry ]); $entry2->bind("", [ \&CheckEntry, Ev('K') ]); $entry3->bind("", [ \&UpdatedOctetEntry ]); $entry3->bind("", [ \&CheckEntry, Ev('K') ]); $entry4->bind("", [ \&UpdatedOctetEntry ]); $entry4->bind("", [ \&CheckEntry, Ev('K') ]); ####################### # # Here we go! # MainLoop; ####################### # # Routine to convert a binary number to decimal # doted octet form like we expect to see. # sub bin2dotoct { my ($foo, $one, $two, $three, $four) = 0; $foo = shift; # After trying for a half hour to show off with # a regular expression, I use the unglorious substr. $one = substr ($foo, 0, 8); $two = substr ($foo, 8, 8); $three = substr ($foo, 16, 8); $four = substr ($foo, 24, 8); $one = bin2dec($one); $two = bin2dec($two); $three = bin2dec($three); $four = bin2dec($four); return "$one.$two.$three.$four"; } ####################### # # Items from the Perl Cookbook by Tom Christiansen and Nathan Torkington. # sub dec2bin { # Decmal to Binary conversion my $str = unpack("B32", pack("N", shift)); return $str; } sub bin2dec { # Binary to Decmal conversion # Pad with leading zeros if needed. my $temp = substr("0" x32 . shift, -32); my $str = unpack("N", pack("B32", $temp)); return $str; } sub commify { # Put commas in numbers for readability my $text = reverse $_[0]; $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return scalar reverse $text; } ####################### # # Routine to convert decimal numbers to doted octet like we expect to see. # We'll use this later to make address range figuring easier. sub dec2dotoct { my $in = shift; my $b = dec2bin($in); return bin2dotoct($b); } ####################### # # This routine makes sure our octet boxes are sync'ed with our radio buttons. # sub UpdatedOctetEntry { # Just in case any non-digits got through $txt_octet1 =~ s/\D//g; $txt_octet2 =~ s/\D//g; $txt_octet3 =~ s/\D//g; $txt_octet4 =~ s/\D//g; # Only accept values within the correct ranges. if ($txt_octet1 < 1 ) { $txt_octet1 = 1; } if ($txt_octet1 > 233) { $txt_octet1 = 233; } if ($txt_octet2 eq '') { $txt_octet2 = 0; } if ($txt_octet3 eq '') { $txt_octet3 = 0; } if ($txt_octet4 eq '') { $txt_octet4 = 0; } # Now based on those values set the radio buttons if ($txt_octet1 < 127) { $rb_classa->select; } elsif (($txt_octet1 >= 128)&&($txt_octet1 <= 191)) { $rb_classb->select; } elsif (($txt_octet1 >= 192)&&($txt_octet1 <= 223)) { $rb_classc->select; } &SetClass; } ####################### # # Only accept numbers into the text entry boxes. # sub CheckEntry { my $key = $_[1]; my $currententry = $mw->focusCurrent; my $currentvalue = $currententry->get(); if (($key ne 'Control_L')&&($key ne 'Control_R')&&($key ne 'Alt_L')&&($key ne 'Alt_R')&&($key ne 'Shift_L')&& ($key ne 'Shift_R')&&($key ne 'Return')&&($key ne 'BackSpace')&&($key ne 'Tab')&&($key ne 'Caps_Lock')&& ($key ne 'Insert')&&($key ne 'Delete')&&($key ne 'Home')&&($key ne 'End')&&($key ne 'Prior')&&($key ne 'period')&& ($key ne 'Next')&&($key ne 'Left')&&($key ne 'Up')&&($key ne 'Right')&&($key ne 'Down')&&($key ne 'Num_Lock') ) { if (($key =~ /\D/)||($currentvalue > 255)) { my $length = length($currentvalue); $currententry->delete($length-1, $length); # This assumes we're positioned at the end... } } # If the user presses the period handle it the same way but move the focus to the next octet. if ($key eq 'period') { my $length = length($currentvalue); $currententry->delete($length-1, $length); # This assumes we're positioned at the end... $currententry->focusNext(); } } ####################### # # Routine that is triggered when we change IP class # sub SetClass { if ($current_class eq "A") { $class_bits = 8; if ($txt_octet1 > 127) { $txt_octet1 = "1"; } } elsif ($current_class eq "B") { $class_bits = 16; if (($txt_octet1 < 128)||($txt_octet1 > 191)) { $txt_octet1 = "128"; } } elsif ($current_class eq "C") { $class_bits = 24; if (($txt_octet1 < 192)||($txt_octet1 > 223)) { $txt_octet1 = "192"; } } # If we're not doing super netting don't allow the user to do that if (($cb_supernetting == 0)&&($scale_cidrbits < $class_bits)) { $scale_cidrbits = $class_bits; } # Make sure everything is still in sync &SyncDisplay; } ####################### # # This routine makes sure all of our values are calculated # and our dispalys are updated when ever we change a value. # sub SyncDisplay { # We don't currently support using the Details button when # the user is looking at supernets so we should disable it here. # We'll also disable the class buttons since they don't # really apply either. if ($cb_supernetting) { $detailsbutton->configure(-state=>'disabled'); $rb_classa->configure(-state=>'disabled'); $rb_classb->configure(-state=>'disabled'); $rb_classc->configure(-state=>'disabled'); } else { $detailsbutton->configure(-state=>'normal'); $rb_classa->configure(-state=>'normal'); $rb_classb->configure(-state=>'normal'); $rb_classc->configure(-state=>'normal'); } # If we're not allowed to use the first and last subnets # then it is not proper to have one-bit subnet masks because # there would only be a first and last subnet. if ($cb_allsubnets == 0) { if ($scale_cidrbits == 1) { $scale_cidrbits = 2; } elsif ($scale_cidrbits == 9) { $scale_cidrbits = 10; } elsif ($scale_cidrbits == 17) { $scale_cidrbits = 18; } elsif ($scale_cidrbits == 25) { $scale_cidrbits = 26; } } # If we're not doing super netting don't allow the user to do that if (($cb_supernetting == 0)&&($scale_cidrbits < $class_bits)) { $scale_cidrbits = $class_bits; } # Display the netmask in its various forms ($foo, $bar, $baz) = split(/,/, $netmask[$scale_cidrbits], 3); $txt_decmask = 'Decimal Netmask: '.$foo; $txt_hexmask = 'Hex Netmask: '.$bar; $txt_aclmask = 'ACL Netmask: '.$baz; # Calculate how many bits are in each portion of the address $host_bits = 32-$scale_cidrbits; if ($cb_supernetting == 0) { $network_bits = $class_bits; $subnet_bits = $scale_cidrbits-$network_bits; } else { $network_bits = 0; $subnet_bits = $scale_cidrbits-$network_bits; } $txt_bitlist = "Network bits:$network_bits Subnet bits: $subnet_bits Host bits: $host_bits"; # Display the CIDR Representation $txt_cidr = "/$scale_cidrbits"; # Calculate the number of subnets and hosts in each of them $num_hosts = (2**$host_bits)-2; $txt_hosts = "Hosts: ".commify($num_hosts); $num_subnets = 2**$subnet_bits; if (($cb_allsubnets == 0)&&($num_subnets > 2)) { $num_subnets = $num_subnets - 2; } $txt_subnets = "Subnets: ".commify($num_subnets); # Display a graphical representation of the address if ($cb_supernetting == 1) { $startbits = '' } elsif ($current_class eq "A") { $startbits = '0' } elsif ($current_class eq "B") { $startbits = '10' } elsif ($current_class eq "C") { $startbits = '110' } $txt_addressmap = 'Bitmap: '.$startbits."N"x($network_bits-length($startbits))."S"x$subnet_bits."H"x$host_bits; # # Sometimes its not useful to see a list of 64K subnets if we just # want to see the currect subnet in a large network, ie: 10.1.1.0/27 # # Current address in binary $foo1 = substr (dec2bin($txt_octet1), -8, 8); $foo2 = substr (dec2bin($txt_octet2), -8, 8); $foo3 = substr (dec2bin($txt_octet3), -8, 8); $foo4 = substr (dec2bin($txt_octet4), -8, 8); $bin_address = "$foo1$foo2$foo3$foo4"; # Current netmask in binary $bin_mask = "1"x($network_bits+$subnet_bits)."0"x$host_bits; # Find out the current network $bin_currentnet = $bin_address & $bin_mask; # Bitwise AND # Print everything based on the current network and number of hosts in it... $txt_currentnet = 'Current Network: '.bin2dotoct($bin_currentnet); $txt_currentfirst = 'First Address: '.dec2dotoct(bin2dec($bin_currentnet)+1); $txt_currentlast = 'Last Address: '.dec2dotoct(bin2dec($bin_currentnet)+$num_hosts); $txt_currentbcast = 'Broadcast: '.dec2dotoct(bin2dec($bin_currentnet)+$num_hosts+1); } ####################### # # Creates another window and displays the subnet ranges # sub Details { # Make sure the user really wants to see a really long list... if ($num_subnets > 8000) { $dialog = $mw->DialogBox( -title=>"Large List Warning", -buttons=>["OK", "Cancel"]); $dialog->add("Label", -text=>" ")->pack(); $dialog->add("Label", -text=>"You've requested printing a large number of subnets, ")->pack(); $dialog->add("Label", -text=>"which may take a lot of time and resources.")->pack(); $confirmbutton = $dialog->Show(); if ($confirmbutton eq "OK") { # We'll continue } else { # This is the default. return; } } # Create the window and put in a text box $dw = MainWindow->new; $dw->title("Subnet Details"); $detailtext = $dw->Scrolled("Text", -scrollbars=>'osoe')->pack(-ipadx=>20); # For ease of reading we print the subnets in different colors. $detailtext->tagConfigure("red", -foreground=>"red"); $detailtext->tagConfigure("blue", -foreground=>"blue"); $detailtext->tagConfigure("black", -foreground=>"black"); $textcolor = 'blue'; # Find our larger classful network if ($current_class eq "A") { $ipnetwork = "$txt_octet1\.0\.0\.0"; } elsif ($current_class eq "B") { $ipnetwork = "$txt_octet1\.$txt_octet2\.0\.0"; } elsif ($current_class eq "C") { $ipnetwork = "$txt_octet1\.$txt_octet2\.$txt_octet3\.0"; } # We do the actual math in binary, so now's a good time to convert to that. ($ip1, $ip2, $ip3, $ip4) = split(/\./,$ipnetwork); $foo1 = substr (dec2bin($ip1), -8, 8); $foo2 = substr (dec2bin($ip2), -8, 8); $foo3 = substr (dec2bin($ip3), -8, 8); $foo4 = substr (dec2bin($ip4), -8, 8); $binipnetwork = "$foo1$foo2$foo3$foo4"; # Print details for this list $detailtext->insert('end', "\nAddress and CIDR: $txt_octet1\.$txt_octet2\.$txt_octet3\.$txt_octet4$txt_cidr\n", 'black'); $detailtext->insert('end', "Number of subnets: $txt_subnets\n", 'black'); $detailtext->insert('end', "Number of hosts per subnet: $txt_hosts\n", 'black'); $detailtext->insert('end', "Netmask in Decimal: $txt_decmask\n", 'black'); $detailtext->insert('end', "Netmask in Hexdecimal: $txt_hexmask\n", 'black'); $detailtext->insert('end', "Inverse (ACL) Netmask: $txt_aclmask\n", 'black'); $detailtext->insert('end', "Bit Address Map: $txt_addressmap\n", 'black'); $detailtext->insert('end', "Bit Breakout: $txt_bitlist\n", 'black'); # Print a header $detailtext->insert('end', "\nSubnet Details for $ipnetwork/$scale_cidrbits\n", 'black'); $detailtext->insert('end', " Subnet Network\t Address Range\t\t Broadcast\n", 'black'); # Seed our loop $foo = bin2dec($binipnetwork); $count = 1; # Skip the first subnet if we're avoiding it, we'll run through the # right number of subnets because $num_subnets is already correct. if ($cb_allsubnets == 0) { $foo = $foo + ($num_hosts + 2); } while ($count <= $num_subnets) { # What we'll do is convert the Network address # to a decimal number, add the number of hosts # to that, and then convert it back to 4 octets # of decimal numbers. $printnet = dec2dotoct($foo); $foo++; $printfirst = dec2dotoct($foo); $foo = $foo + ($num_hosts - 1); # 1st host is already printed. $printlast = dec2dotoct($foo); $foo++; $printbcast = dec2dotoct($foo); # Look to see if the address the user put in is in this subnet. # If so highlight in red, although its silly if we're only printing one subnet. if ($num_subnets > 1) { ($ip1, $ip2, $ip3, $ip4) = split(/\./,$printnet); if (($txt_octet1 >= $ip1)&&($txt_octet2 >= $ip2)&&($txt_octet3 >= $ip3)&&($txt_octet4 >= $ip4)) { # Could be... ($ip1, $ip2, $ip3, $ip4) = split(/\./,$printbcast); if (($txt_octet1 <= $ip1)&&($txt_octet2 <= $ip2)&&($txt_octet3 <= $ip3)&&($txt_octet4 <= $ip4)) { # It is! $textcolor = 'red'; } } } # Print the results $detailtext->insert('end', " $count\t $printnet\t$printfirst - $printlast\t$printbcast\n", $textcolor); # Incrument counters and alternate colors for each subnet $foo++; $count++; if ($textcolor eq 'black') { $textcolor = 'blue'; } else { $textcolor = 'black'; } } } ####################### # # Creates another window and displays the about box # sub AboutDisplay { $aw = MainWindow->new; $aw->title("About IP Address Abacus"); $aw->Label(-text=>"IP Address Abacus")->pack(-pady=>10, -padx=>10); $aw->Label(-text=>"Version: $version")->pack(-pady=>5, -padx=>10); $aw->Label(-text=>"by Anthony Anderberg")->pack(-pady=>5, -padx=>10); $aw->Label(-text=>"http://www.anderbergfamily.net/ant/ipabacus/")->pack(-pady=>10, -padx=>10); }