| [4] | 1 | #!/usr/bin/perl
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | use strict;             
 | 
|---|
 | 4 | use warnings;   
 | 
|---|
| [360] | 5 | use CGI::Carp qw(fatalsToBrowser);
 | 
|---|
| [593] | 6 | use CGI::Simple;
 | 
|---|
 | 7 | use HTML::Template;
 | 
|---|
| [360] | 8 | use NetAddr::IP;
 | 
|---|
| [4] | 9 | 
 | 
|---|
 | 10 | #file snCalc.cgi        little subnet calculator app
 | 
|---|
| [507] | 11 | use MyIPDB;
 | 
|---|
| [4] | 12 | 
 | 
|---|
| [593] | 13 | # Set up the CGI object...
 | 
|---|
 | 14 | my $q = new CGI::Simple;
 | 
|---|
 | 15 | # ... and get query-string params as well as POST params if necessary
 | 
|---|
 | 16 | $q->parse_query_string;
 | 
|---|
 | 17 | 
 | 
|---|
 | 18 | # Convenience;  saves changing all references to %webvar
 | 
|---|
 | 19 | ##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
 | 
|---|
 | 20 | my %webvar = $q->Vars;
 | 
|---|
 | 21 | 
 | 
|---|
| [4] | 22 | my $input;
 | 
|---|
 | 23 | 
 | 
|---|
 | 24 | print "Content-Type: text/html\n\n";
 | 
|---|
 | 25 | 
 | 
|---|
| [593] | 26 | ##fixme:  need better method to find templates.
 | 
|---|
 | 27 | $ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME};
 | 
|---|
 | 28 | $ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||;
 | 
|---|
| [4] | 29 | 
 | 
|---|
| [593] | 30 | my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl");
 | 
|---|
 | 31 | 
 | 
|---|
| [360] | 32 | # Clean up input so we don't divide by zero or something equally silly
 | 
|---|
 | 33 | if ($webvar{input} =~ m/(\d+)/) {
 | 
|---|
 | 34 |   $input = 1*$1;
 | 
|---|
 | 35 |   $input = 3 if $input < 3;
 | 
|---|
 | 36 |   $input = 29 if $input > 29;   # Not doing IPv6 yet...
 | 
|---|
 | 37 | } else {
 | 
|---|
 | 38 |   $input = 29;
 | 
|---|
| [4] | 39 | }
 | 
|---|
 | 40 | 
 | 
|---|
| [360] | 41 | my $ltinput = $input - 1;
 | 
|---|
 | 42 | my $gtinput = $input + 1;
 | 
|---|
| [4] | 43 | 
 | 
|---|
| [360] | 44 | my $prenet = new NetAddr::IP "0.0.0.0/$ltinput";
 | 
|---|
 | 45 | my $net = new NetAddr::IP "0.0.0.0/$input";
 | 
|---|
 | 46 | my $postnet = new NetAddr::IP "0.0.0.0/$gtinput";
 | 
|---|
| [4] | 47 | 
 | 
|---|
| [593] | 48 | $page->param(prenet => $ltinput);
 | 
|---|
 | 49 | $page->param(net => $input);
 | 
|---|
 | 50 | $page->param(postnet => $gtinput);
 | 
|---|
 | 51 | $page->param(premask => $prenet->mask);
 | 
|---|
 | 52 | $page->param(mask => $net->mask);
 | 
|---|
 | 53 | $page->param(postmask => $postnet->mask);
 | 
|---|
 | 54 | $page->param(prewildcard => scalar($prenet->wildcard));
 | 
|---|
 | 55 | $page->param(wildcard => scalar($net->wildcard));
 | 
|---|
 | 56 | $page->param(postwildcard => scalar($postnet->wildcard));
 | 
|---|
| [4] | 57 | 
 | 
|---|
| [593] | 58 | my @prenets;
 | 
|---|
 | 59 | foreach (getranges($ltinput)) {
 | 
|---|
 | 60 |   my %row = (netrange => $_);
 | 
|---|
 | 61 |   push (@prenets, \%row);
 | 
|---|
 | 62 | }
 | 
|---|
 | 63 | $page->param(prenets => \@prenets);
 | 
|---|
 | 64 | my @nets;
 | 
|---|
 | 65 | foreach (getranges($input)) {
 | 
|---|
 | 66 |   my %row = (netrange => $_);
 | 
|---|
 | 67 |   push (@nets, \%row);
 | 
|---|
 | 68 | }
 | 
|---|
 | 69 | $page->param(nets => \@nets);
 | 
|---|
 | 70 | my @postnets;
 | 
|---|
 | 71 | foreach (getranges($gtinput)) {
 | 
|---|
 | 72 |   my %row = (netrange => $_);
 | 
|---|
 | 73 |   push @postnets, \%row;
 | 
|---|
 | 74 | }
 | 
|---|
 | 75 | $page->param(postnets => \@postnets);
 | 
|---|
| [4] | 76 | 
 | 
|---|
| [593] | 77 | print $page->output;
 | 
|---|
| [360] | 78 |         
 | 
|---|
 | 79 | # Just In Case
 | 
|---|
 | 80 | exit 0;
 | 
|---|
| [4] | 81 | 
 | 
|---|
| [360] | 82 | # subs
 | 
|---|
 | 83 | sub xrange {
 | 
|---|
 | 84 |   my $block = shift;
 | 
|---|
 | 85 |   my $masklen = shift;
 | 
|---|
 | 86 |   my $data = $block->range;
 | 
|---|
 | 87 |   if ($masklen >= 24) {
 | 
|---|
 | 88 |     $data =~ s/\b0\.0\.0\./x.x.x./g;
 | 
|---|
 | 89 |   } elsif ($masklen >=16) {
 | 
|---|
 | 90 |     $data =~ s/\b0\.0\.(\d+\.\d+)/x.x.$1/g;
 | 
|---|
 | 91 |   } elsif ($masklen >=8) {
 | 
|---|
 | 92 |     $data =~ s/\b0\.(\d+\.\d+\.\d+)/x.$1/g;
 | 
|---|
 | 93 |   }
 | 
|---|
 | 94 |   return $data;
 | 
|---|
 | 95 | } # xrange()
 | 
|---|
| [4] | 96 | 
 | 
|---|
 | 97 | 
 | 
|---|
| [360] | 98 | sub getranges {
 | 
|---|
 | 99 |   my $masklen = shift;
 | 
|---|
| [593] | 100 |   my @ret;
 | 
|---|
| [360] | 101 |   my $super;
 | 
|---|
 | 102 |   if ($masklen < 8) {
 | 
|---|
 | 103 |     $super = new NetAddr::IP "0.0.0.0/0";
 | 
|---|
 | 104 |   } elsif ($masklen < 16) {
 | 
|---|
 | 105 |     $super = new NetAddr::IP "0.0.0.0/8";
 | 
|---|
 | 106 |   } elsif ($masklen < 24) {
 | 
|---|
 | 107 |     $super = new NetAddr::IP "0.0.0.0/16";
 | 
|---|
| [4] | 108 |   } else {
 | 
|---|
| [360] | 109 |     $super = new NetAddr::IP "0.0.0.0/24";
 | 
|---|
| [4] | 110 |   }
 | 
|---|
| [360] | 111 |   foreach my $net ($super->split($masklen)) {
 | 
|---|
| [593] | 112 |     push @ret, xrange($net,$masklen);
 | 
|---|
| [4] | 113 |   }
 | 
|---|
| [593] | 114 |   return @ret;
 | 
|---|
| [360] | 115 | } # getranges()
 | 
|---|