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