| [4] | 1 | #!/usr/bin/perl | 
|---|
|  | 2 |  | 
|---|
|  | 3 | use strict; | 
|---|
|  | 4 | use warnings; | 
|---|
| [371] | 5 | use CGI::Carp qw(fatalsToBrowser); | 
|---|
| [447] | 6 | use CGI::Simple; | 
|---|
| [499] | 7 | use HTML::Template; | 
|---|
| [371] | 8 | use NetAddr::IP; | 
|---|
| [4] | 9 |  | 
|---|
|  | 10 | #file snCalc.cgi        little subnet calculator app | 
|---|
|  | 11 |  | 
|---|
| [447] | 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 |  | 
|---|
| [499] | 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 |  | 
|---|
| [499] | 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 |  | 
|---|
| [499] | 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 |  | 
|---|
| [499] | 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 |  | 
|---|
| [499] | 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; | 
|---|
| [499] | 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)) { | 
|---|
| [499] | 111 | push @ret, xrange($net,$masklen); | 
|---|
| [4] | 112 | } | 
|---|
| [499] | 113 | return @ret; | 
|---|
| [371] | 114 | } # getranges() | 
|---|