[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;
|
---|
| 9 | use CommonWeb qw(:ALL);;
|
---|
[4] | 10 |
|
---|
| 11 | #file snCalc.cgi little subnet calculator app
|
---|
| 12 |
|
---|
[447] | 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 |
|
---|
[499] | 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 |
|
---|
[499] | 30 | my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl");
|
---|
| 31 |
|
---|
[371] | 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 |
|
---|
[371] | 41 | my $ltinput = $input - 1;
|
---|
| 42 | my $gtinput = $input + 1;
|
---|
[4] | 43 |
|
---|
[371] | 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 |
|
---|
[499] | 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 |
|
---|
[499] | 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 |
|
---|
[499] | 77 | print $page->output;
|
---|
[371] | 78 |
|
---|
| 79 | # Just In Case
|
---|
| 80 | exit 0;
|
---|
[4] | 81 |
|
---|
[371] | 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 |
|
---|
[371] | 98 | sub getranges {
|
---|
| 99 | my $masklen = shift;
|
---|
[499] | 100 | my @ret;
|
---|
[371] | 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 {
|
---|
[371] | 109 | $super = new NetAddr::IP "0.0.0.0/24";
|
---|
[4] | 110 | }
|
---|
[371] | 111 | foreach my $net ($super->split($masklen)) {
|
---|
[499] | 112 | push @ret, xrange($net,$masklen);
|
---|
[4] | 113 | }
|
---|
[499] | 114 | return @ret;
|
---|
[371] | 115 | } # getranges()
|
---|