[4] | 1 | #!/usr/bin/perl
|
---|
| 2 | # ipdb/cgi-bin/main.cgi
|
---|
[8] | 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2016-11-02 00:54:09 +0000 (Wed, 02 Nov 2016) $
|
---|
| 6 | # SVN revision $Rev: 893 $
|
---|
| 7 | # Last update by $Author: kdeugau $
|
---|
| 8 | ###
|
---|
[893] | 9 | # Copyright (C) 2004-2016 - Kris Deugau
|
---|
[4] | 10 |
|
---|
| 11 | use strict;
|
---|
| 12 | use warnings;
|
---|
| 13 | use CGI::Carp qw(fatalsToBrowser);
|
---|
[517] | 14 | use CGI::Simple;
|
---|
| 15 | use HTML::Template;
|
---|
[4] | 16 | use DBI;
|
---|
| 17 | use POSIX qw(ceil);
|
---|
| 18 | use NetAddr::IP;
|
---|
[582] | 19 | use Frontier::Client;
|
---|
[4] | 20 |
|
---|
| 21 | use Sys::Syslog;
|
---|
| 22 |
|
---|
[417] | 23 | # don't remove! required for GNU/FHS-ish install from tarball
|
---|
| 24 | ##uselib##
|
---|
| 25 |
|
---|
[515] | 26 | use CustIDCK;
|
---|
[417] | 27 | use MyIPDB;
|
---|
| 28 |
|
---|
[431] | 29 | openlog "IPDB","pid","$IPDB::syslog_facility";
|
---|
[4] | 30 |
|
---|
[517] | 31 | ## Environment. Collect some things, process some things, set some things...
|
---|
| 32 |
|
---|
[233] | 33 | # Collect the username from HTTP auth. If undefined, we're in
|
---|
| 34 | # a test environment, or called without a username.
|
---|
[4] | 35 | my $authuser;
|
---|
| 36 | if (!defined($ENV{'REMOTE_USER'})) {
|
---|
| 37 | $authuser = '__temptest';
|
---|
| 38 | } else {
|
---|
| 39 | $authuser = $ENV{'REMOTE_USER'};
|
---|
| 40 | }
|
---|
| 41 |
|
---|
[517] | 42 | # anyone got a better name? :P
|
---|
| 43 | my $thingroot = $ENV{SCRIPT_FILENAME};
|
---|
| 44 | $thingroot =~ s|cgi-bin/main.cgi||;
|
---|
| 45 |
|
---|
[402] | 46 | syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
|
---|
[4] | 47 |
|
---|
[517] | 48 | ##fixme there *must* be a better order to do things in so this can go back where it was
|
---|
| 49 | # CGI fiddling done here so we can declare %webvar so we can alter $webvar{action}
|
---|
| 50 | # to show the right page on DB errors.
|
---|
| 51 | # Set up the CGI object...
|
---|
| 52 | my $q = new CGI::Simple;
|
---|
| 53 | # ... and get query-string params as well as POST params if necessary
|
---|
| 54 | $q->parse_query_string;
|
---|
| 55 |
|
---|
| 56 | # Convenience; saves changing all references to %webvar
|
---|
| 57 | ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection)
|
---|
| 58 | my %webvar = $q->Vars;
|
---|
| 59 |
|
---|
[106] | 60 | # Why not a global DB handle? (And a global statement handle, as well...)
|
---|
| 61 | # Use the connectDB function, otherwise we end up confusing ourselves
|
---|
| 62 | my $ip_dbh;
|
---|
| 63 | my $errstr;
|
---|
[142] | 64 | ($ip_dbh,$errstr) = connectDB_My;
|
---|
[106] | 65 | if (!$ip_dbh) {
|
---|
[517] | 66 | $webvar{action} = "dberr";
|
---|
| 67 | } else {
|
---|
| 68 | initIPDBGlobals($ip_dbh);
|
---|
[106] | 69 | }
|
---|
[4] | 70 |
|
---|
[517] | 71 | # Set up some globals
|
---|
[793] | 72 | $ENV{HTML_TEMPLATE_ROOT} = $thingroot;
|
---|
| 73 | my @templatepath = [ "localtemplates", "templates" ];
|
---|
[233] | 74 |
|
---|
[793] | 75 | my $header = HTML::Template->new(filename => "header.tmpl", path => @templatepath);
|
---|
| 76 | my $footer = HTML::Template->new(filename => "footer.tmpl", path => @templatepath);
|
---|
| 77 | my $utilbar = HTML::Template->new(filename => "utilbar.tmpl", loop_context_vars => 1, global_vars => 1,
|
---|
| 78 | path => @templatepath);
|
---|
[233] | 79 |
|
---|
[697] | 80 | print "Content-type: text/html\n\n";
|
---|
| 81 |
|
---|
[517] | 82 | $header->param(version => $IPDB::VERSION);
|
---|
| 83 | $header->param(addperm => $IPDBacl{$authuser} =~ /a/);
|
---|
| 84 | $header->param(webpath => $IPDB::webpath);
|
---|
[4] | 85 |
|
---|
[697] | 86 | $utilbar->param(webpath => $IPDB::webpath);
|
---|
[4] | 87 |
|
---|
[697] | 88 | print $header->output;
|
---|
| 89 |
|
---|
[760] | 90 | ##fixme: whine and complain when the user is not present in the ACL hash above
|
---|
[697] | 91 |
|
---|
[4] | 92 | #main()
|
---|
[517] | 93 | my $aclerr;
|
---|
[4] | 94 |
|
---|
| 95 | if(!defined($webvar{action})) {
|
---|
[517] | 96 | $webvar{action} = "index"; #shuts up the warnings.
|
---|
[4] | 97 | }
|
---|
| 98 |
|
---|
[517] | 99 | my $page;
|
---|
[793] | 100 | if (-e "$ENV{HTML_TEMPLATE_ROOT}/templates/$webvar{action}.tmpl") {
|
---|
| 101 | $page = HTML::Template->new(filename => "$webvar{action}.tmpl", loop_context_vars => 1, global_vars => 1,
|
---|
| 102 | path => @templatepath);
|
---|
[517] | 103 | } else {
|
---|
[793] | 104 | $page = HTML::Template->new(filename => "dunno.tmpl", die_on_bad_params => 0,
|
---|
| 105 | path => @templatepath);
|
---|
[517] | 106 | }
|
---|
| 107 |
|
---|
[4] | 108 | if($webvar{action} eq 'index') {
|
---|
| 109 | showSummary();
|
---|
[808] | 110 | } elsif ($webvar{action} eq 'showvrf') {
|
---|
| 111 | showVRF();
|
---|
[810] | 112 |
|
---|
| 113 | } elsif ($webvar{action} eq 'addvrf') {
|
---|
| 114 | if ($IPDBacl{$authuser} !~ /s/) {
|
---|
| 115 | $aclerr = 'addvrf';
|
---|
| 116 | }
|
---|
| 117 |
|
---|
| 118 | # Retrieve the list of DNS locations if we've got a place to grab them from
|
---|
| 119 | if ($IPDB::rpc_url) {
|
---|
| 120 | my %rpcargs = (
|
---|
| 121 | rpcuser => $authuser,
|
---|
| 122 | group => 1, # bleh
|
---|
| 123 | defloc => '',
|
---|
| 124 | );
|
---|
| 125 | my $result = IPDB::_rpc('getLocDropdown', %rpcargs);
|
---|
| 126 | $page->param(loclist => $result);
|
---|
| 127 | }
|
---|
| 128 |
|
---|
[811] | 129 | } elsif ($webvar{action} eq 'newvrf') {
|
---|
| 130 | if ($IPDBacl{$authuser} !~ /s/) {
|
---|
| 131 | $aclerr = 'addvrf';
|
---|
| 132 | } else {
|
---|
| 133 | my ($code,$msg) = addVRF($ip_dbh, $webvar{vrf}, comment => $webvar{comment}, location => $webvar{loc});
|
---|
| 134 |
|
---|
| 135 | if ($code eq 'FAIL') {
|
---|
| 136 | syslog "err", "Could not add VRF '$webvar{vrf}' to database: '$msg'";
|
---|
| 137 | $page->param(err => $msg);
|
---|
| 138 | $page->param(vrf => $webvar{vrf});
|
---|
| 139 | } else {
|
---|
| 140 | $page->param(vrf => $msg);
|
---|
| 141 | if ($code eq 'WARN') {
|
---|
| 142 | $IPDB::errstr =~ s/\n\n/<br>\n/g;
|
---|
| 143 | $IPDB::errstr =~ s/:\n/:<br>\n/g;
|
---|
| 144 | $page->param(warn => $IPDB::errstr);
|
---|
| 145 | }
|
---|
| 146 | syslog "info", "$authuser added VRF $webvar{vrf}";
|
---|
| 147 | }
|
---|
| 148 |
|
---|
| 149 | } # ACL check
|
---|
| 150 |
|
---|
[820] | 151 | } elsif ($webvar{action} eq 'delvrf') {
|
---|
| 152 | if ($IPDBacl{$authuser} !~ /s/) {
|
---|
| 153 | $aclerr = 'delvrf';
|
---|
| 154 | }
|
---|
| 155 |
|
---|
| 156 | my $vrf = getVRF($ip_dbh, $webvar{vrf});
|
---|
| 157 |
|
---|
| 158 | $page->param(vrf => $webvar{vrf});
|
---|
| 159 | $page->param(vrfcomment => $vrf->{comment});
|
---|
| 160 |
|
---|
| 161 | } elsif ($webvar{action} eq 'finaldelvrf') {
|
---|
| 162 | if ($IPDBacl{$authuser} !~ /s/) {
|
---|
| 163 | $aclerr = 'finaldelvrf';
|
---|
| 164 | }
|
---|
| 165 |
|
---|
| 166 | my $vrf = getVRF($ip_dbh, $webvar{vrf});
|
---|
| 167 | $page->param(vrf => $webvar{vrf});
|
---|
| 168 | $page->param(vrfcomment => $vrf->{comment});
|
---|
| 169 |
|
---|
| 170 | my ($code,$msg) = deleteVRF($ip_dbh, $webvar{vrf}, $authuser);
|
---|
| 171 |
|
---|
| 172 | if ($code eq 'FAIL') {
|
---|
| 173 | $page->param(failmsg => $msg);
|
---|
| 174 | }
|
---|
| 175 |
|
---|
[233] | 176 | } elsif ($webvar{action} eq 'addmaster') {
|
---|
| 177 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 178 | $aclerr = 'addmaster';
|
---|
[233] | 179 | }
|
---|
[582] | 180 |
|
---|
[816] | 181 | my $vrf = getVRF($ip_dbh, $webvar{vrf});
|
---|
| 182 |
|
---|
[582] | 183 | # Retrieve the list of DNS locations if we've got a place to grab them from
|
---|
| 184 | if ($IPDB::rpc_url) {
|
---|
| 185 | my %rpcargs = (
|
---|
| 186 | rpcuser => $authuser,
|
---|
| 187 | group => 1, # bleh
|
---|
[816] | 188 | defloc => $vrf->{location},
|
---|
[582] | 189 | );
|
---|
[623] | 190 | my $result = IPDB::_rpc('getLocDropdown', %rpcargs);
|
---|
[582] | 191 | $page->param(loclist => $result);
|
---|
| 192 | }
|
---|
| 193 |
|
---|
[815] | 194 | # we don't have a netblock; pass 0 for the block ID
|
---|
| 195 | # Tree navigation
|
---|
| 196 | my $crumbs = getBreadCrumbs($ip_dbh, 0, $webvar{vrf});
|
---|
| 197 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 198 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 199 |
|
---|
| 200 | $page->param(vrf => $webvar{vrf});
|
---|
| 201 |
|
---|
[4] | 202 | } elsif ($webvar{action} eq 'newmaster') {
|
---|
| 203 |
|
---|
[233] | 204 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 205 | $aclerr = 'addmaster';
|
---|
[233] | 206 | } else {
|
---|
| 207 | my $cidr = new NetAddr::IP $webvar{cidr};
|
---|
[517] | 208 | $page->param(cidr => "$cidr");
|
---|
[4] | 209 |
|
---|
[582] | 210 | my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}, (vrf => $webvar{vrf}, rdns => $webvar{rdns},
|
---|
| 211 | rwhois => $webvar{rwhois}, defloc => $webvar{loc}, user => $authuser) );
|
---|
[4] | 212 |
|
---|
[371] | 213 | if ($code eq 'FAIL') {
|
---|
[320] | 214 | syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
|
---|
[517] | 215 | $page->param(err => $msg);
|
---|
[233] | 216 | } else {
|
---|
[624] | 217 | $page->param(parent => $msg);
|
---|
[582] | 218 | if ($code eq 'WARN') {
|
---|
[624] | 219 | $IPDB::errstr =~ s/\n\n/<br>\n/g;
|
---|
| 220 | $IPDB::errstr =~ s/:\n/:<br>\n/g;
|
---|
| 221 | $page->param(warn => $IPDB::errstr);
|
---|
[582] | 222 | }
|
---|
[233] | 223 | syslog "info", "$authuser added master block $webvar{cidr}";
|
---|
| 224 | }
|
---|
[4] | 225 |
|
---|
[815] | 226 | # we don't have a netblock; pass 0 for the block ID
|
---|
| 227 | # Tree navigation
|
---|
| 228 | my $crumbs = getBreadCrumbs($ip_dbh, 0, $webvar{vrf});
|
---|
| 229 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 230 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 231 |
|
---|
[233] | 232 | } # ACL check
|
---|
| 233 |
|
---|
[4] | 234 | } # end add new master
|
---|
| 235 |
|
---|
[567] | 236 | elsif ($webvar{action} eq 'showsubs') {
|
---|
| 237 | showSubs();
|
---|
| 238 | }
|
---|
| 239 |
|
---|
[4] | 240 | elsif($webvar{action} eq 'listpool') {
|
---|
[528] | 241 | showPool();
|
---|
[4] | 242 | }
|
---|
| 243 |
|
---|
| 244 | # Not modified or added; just shuffled
|
---|
| 245 | elsif($webvar{action} eq 'assign') {
|
---|
| 246 | assignBlock();
|
---|
| 247 | }
|
---|
| 248 | elsif($webvar{action} eq 'confirm') {
|
---|
| 249 | confirmAssign();
|
---|
| 250 | }
|
---|
| 251 | elsif($webvar{action} eq 'insert') {
|
---|
| 252 | insertAssign();
|
---|
| 253 | }
|
---|
| 254 | elsif($webvar{action} eq 'edit') {
|
---|
| 255 | edit();
|
---|
| 256 | }
|
---|
| 257 | elsif($webvar{action} eq 'update') {
|
---|
| 258 | update();
|
---|
| 259 | }
|
---|
[702] | 260 | elsif($webvar{action} eq 'split') {
|
---|
| 261 | prepSplit();
|
---|
| 262 | }
|
---|
| 263 | elsif($webvar{action} eq 'dosplit') {
|
---|
| 264 | doSplit();
|
---|
| 265 | }
|
---|
[717] | 266 | elsif($webvar{action} eq 'merge') {
|
---|
| 267 | prepMerge();
|
---|
| 268 | }
|
---|
[720] | 269 | elsif($webvar{action} eq 'confmerge') {
|
---|
| 270 | confMerge();
|
---|
| 271 | }
|
---|
[751] | 272 | elsif($webvar{action} eq 'domerge') {
|
---|
| 273 | doMerge();
|
---|
| 274 | }
|
---|
[4] | 275 | elsif($webvar{action} eq 'delete') {
|
---|
| 276 | remove();
|
---|
| 277 | }
|
---|
| 278 | elsif($webvar{action} eq 'finaldelete') {
|
---|
| 279 | finalDelete();
|
---|
| 280 | }
|
---|
[397] | 281 | elsif ($webvar{action} eq 'nodesearch') {
|
---|
[519] | 282 | my $nodelist = getNodeList($ip_dbh);
|
---|
| 283 | $page->param(nodelist => $nodelist);
|
---|
[517] | 284 | }
|
---|
[397] | 285 |
|
---|
[517] | 286 | # DB failure. Can't do much here, really.
|
---|
| 287 | elsif ($webvar{action} eq 'dberr') {
|
---|
| 288 | $page->param(errmsg => $errstr);
|
---|
[397] | 289 | }
|
---|
| 290 |
|
---|
[517] | 291 | # Default is an error. It shouldn't be possible to get here unless you're
|
---|
| 292 | # randomly feeding in values for webvar{action}.
|
---|
[4] | 293 | else {
|
---|
| 294 | my $rnd = rand 500;
|
---|
| 295 | my $boing = sprintf("%.2f", rand 500);
|
---|
[517] | 296 | my @excuses = (
|
---|
| 297 | "Aether cloudy. Ask again later about $webvar{action}.",
|
---|
| 298 | "The gods are unhappy with your sacrificial $webvar{action}.",
|
---|
| 299 | "Because one of $webvar{action}'s legs are both the same",
|
---|
| 300 | "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!",
|
---|
| 301 | "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....",
|
---|
| 302 | "I ain't done $webvar{action}",
|
---|
| 303 | "Oooo, look! A flying $webvar{action}!",
|
---|
| 304 | "$webvar{action} too evil, avoiding.",
|
---|
| 305 | "Rocks fall, $webvar{action} dies.",
|
---|
| 306 | "Bit bucket must be emptied before I can $webvar{action}..."
|
---|
| 307 | );
|
---|
| 308 | $page->param(dunno => $excuses[$rnd/50.0]);
|
---|
[4] | 309 | }
|
---|
[111] | 310 | ## Finally! Done with that NASTY "case" emulation!
|
---|
[4] | 311 |
|
---|
| 312 |
|
---|
[517] | 313 | # Switch to a different template if we've tripped on an ACL error.
|
---|
| 314 | # Note that this should only be exercised in development, when
|
---|
| 315 | # deeplinked, or when being attacked; normal ACL handling should
|
---|
| 316 | # remove the links a user is not allowed to click on.
|
---|
| 317 | if ($aclerr) {
|
---|
[793] | 318 | $page = HTML::Template->new(filename => "aclerror.tmpl", path => @templatepath);
|
---|
[517] | 319 | $page->param(ipdbfunc => $aclmsg{$aclerr});
|
---|
| 320 | }
|
---|
[4] | 321 |
|
---|
[106] | 322 | # Clean up IPDB globals, DB handle, etc.
|
---|
[111] | 323 | finish($ip_dbh);
|
---|
[199] | 324 |
|
---|
[517] | 325 | ## Do all our printing here so we can generate errors and stick them into the slots in the templates.
|
---|
[199] | 326 |
|
---|
[517] | 327 | # can't do this yet, too many blowups
|
---|
| 328 | #print "Content-type: text/html\n\n", $header->output;
|
---|
| 329 | $page->param(webpath => $IPDB::webpath);
|
---|
[697] | 330 | print $utilbar->output;
|
---|
[517] | 331 | print $page->output;
|
---|
| 332 |
|
---|
| 333 | # include the admin tools link in the output?
|
---|
| 334 | $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
|
---|
| 335 | $footer->param(webpath => $IPDB::webpath);
|
---|
| 336 | print $footer->output;
|
---|
| 337 |
|
---|
[106] | 338 | # Just in case something waaaayyy down isn't in place
|
---|
| 339 | # properly... we exit explicitly.
|
---|
[517] | 340 | exit 0;
|
---|
[4] | 341 |
|
---|
| 342 |
|
---|
[806] | 343 | # Initial display: Show list of VRFs
|
---|
[118] | 344 | sub showSummary {
|
---|
[806] | 345 | my $vrflist = listVRF($ip_dbh);
|
---|
[818] | 346 |
|
---|
| 347 | if ($IPDB::masterswithvrfs == 2) {
|
---|
| 348 | $page = HTML::Template->new(filename => "index2.tmpl", loop_context_vars => 1, global_vars => 1,
|
---|
| 349 | path => @templatepath);
|
---|
| 350 | # alternate layout; put master blocks on the front summary page instead of "out"/"down" a
|
---|
[821] | 351 | # layer in the browse tree. Leaving the manual include of showvrf.tmpl for reference; not
|
---|
| 352 | # sure why setting webpath here didn't seem to make it to the output.
|
---|
| 353 | # my $vrfinfo = HTML::Template->new(filename => "showvrf.tmpl", path => @templatepath);
|
---|
[818] | 354 | foreach my $vrf (@$vrflist) {
|
---|
| 355 | my $masterlist = listSummary($ip_dbh, $vrf->{vrf});
|
---|
[821] | 356 | $vrf->{masterlist} = $masterlist;
|
---|
| 357 | $vrf->{addmaster} = ($IPDBacl{$authuser} =~ /s/);
|
---|
| 358 | $vrf->{maydel} = ($IPDBacl{$authuser} =~ /s/);
|
---|
| 359 | $vrf->{sub} = 1;
|
---|
| 360 | # $vrfinfo->param(vrf => $vrf->{vrf});
|
---|
| 361 | # $vrfinfo->param(masterlist => $masterlist);
|
---|
| 362 | # $vrfinfo->param(addmaster => ($IPDBacl{$authuser} =~ /s/) );
|
---|
| 363 | # $vrfinfo->param(maydel => ($IPDBacl{$authuser} =~ /s/) );
|
---|
| 364 | # $vrfinfo->param(sub => 1);
|
---|
| 365 | # $vrfinfo->param(webpath => $IPDB::webpath);
|
---|
| 366 | # $vrf->{vrfinfo} = $vrfinfo->output;
|
---|
[818] | 367 | }
|
---|
| 368 | }
|
---|
| 369 |
|
---|
[806] | 370 | $page->param(vrflist => $vrflist);
|
---|
[106] | 371 |
|
---|
[806] | 372 | # Only systems/network should be allowed to add VRFs - or maybe higher?
|
---|
| 373 | $page->param(addvrf => ($IPDBacl{$authuser} =~ /s/) );
|
---|
[818] | 374 |
|
---|
[4] | 375 | } # showSummary
|
---|
| 376 |
|
---|
| 377 |
|
---|
[808] | 378 | # Show IP blocks in a VRF
|
---|
| 379 | sub showVRF {
|
---|
| 380 | my $masterlist = listSummary($ip_dbh, $webvar{vrf});
|
---|
| 381 | $page->param(vrf => $webvar{vrf});
|
---|
| 382 | $page->param(masterlist => $masterlist);
|
---|
| 383 |
|
---|
| 384 | # we don't have a netblock; pass 0 for the block ID
|
---|
| 385 | # Tree navigation
|
---|
| 386 | my $crumbs = getBreadCrumbs($ip_dbh, 0, $webvar{vrf});
|
---|
| 387 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 388 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 389 |
|
---|
[818] | 390 | $page->param(maydel => ($IPDBacl{$authuser} =~ /s/) );
|
---|
[808] | 391 | $page->param(addmaster => ($IPDBacl{$authuser} =~ /s/) );
|
---|
| 392 | } # showVRF
|
---|
| 393 |
|
---|
| 394 |
|
---|
[566] | 395 | # Display blocks immediately within a given parent
|
---|
| 396 | sub showSubs {
|
---|
[682] | 397 | # Which layout?
|
---|
| 398 | if ($IPDB::sublistlayout == 2) {
|
---|
| 399 |
|
---|
| 400 | # 2-part layout; mixed containers and end-use allocations and free blocks.
|
---|
| 401 | # Containers have a second line for the subblock metadata.
|
---|
| 402 | # We need to load an alternate template for this case.
|
---|
[793] | 403 | $page = HTML::Template->new(filename => "showsubs2.tmpl", loop_context_vars => 1, global_vars => 1,
|
---|
| 404 | path => @templatepath);
|
---|
[682] | 405 |
|
---|
| 406 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/));
|
---|
| 407 |
|
---|
| 408 | my $sublist = listSubs($ip_dbh, parent => $webvar{parent});
|
---|
| 409 | $page->param(sublist => $sublist);
|
---|
| 410 |
|
---|
| 411 | } else {
|
---|
| 412 |
|
---|
[685] | 413 | # 3-part layout; containers, end-use allocations, and free blocks
|
---|
[682] | 414 |
|
---|
| 415 | my $contlist = listContainers($ip_dbh, parent => $webvar{parent});
|
---|
| 416 | $page->param(contlist => $contlist);
|
---|
| 417 |
|
---|
| 418 | my $alloclist = listAllocations($ip_dbh, parent => $webvar{parent});
|
---|
| 419 | $page->param(alloclist => $alloclist);
|
---|
| 420 |
|
---|
| 421 | # only show "delete" button if we have no container or usage allocations
|
---|
| 422 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/) && !(@$contlist || @$alloclist));
|
---|
| 423 |
|
---|
| 424 | }
|
---|
| 425 |
|
---|
| 426 | # Common elements
|
---|
[627] | 427 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 428 |
|
---|
[685] | 429 | ##fixme: do we add a wrapper to not show the edit link for master blocks?
|
---|
| 430 | #$page->param(editme => 1) unless $pinfo->{type} ne 'mm';
|
---|
| 431 |
|
---|
[808] | 432 | my $crumbs = getBreadCrumbs($ip_dbh, $pinfo->{parent_id}, $pinfo->{vrf});
|
---|
[697] | 433 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 434 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 435 |
|
---|
[685] | 436 | $page->param(self_id => $webvar{parent});
|
---|
[627] | 437 | $page->param(block => $pinfo->{block});
|
---|
[566] | 438 | $page->param(mayadd => ($IPDBacl{$authuser} =~ /a/));
|
---|
[4] | 439 |
|
---|
[627] | 440 | my $flist = listFree($ip_dbh, parent => $webvar{parent});
|
---|
[566] | 441 | $page->param(freelist => $flist);
|
---|
| 442 | } # showSubs
|
---|
[4] | 443 |
|
---|
| 444 |
|
---|
| 445 | # List the IPs used in a pool
|
---|
[528] | 446 | sub showPool {
|
---|
[4] | 447 |
|
---|
[631] | 448 | my $poolinfo = getBlockData($ip_dbh, $webvar{pool});
|
---|
| 449 | my $cidr = new NetAddr::IP $poolinfo->{block};
|
---|
[771] | 450 | $page->param(vlan => $poolinfo->{vlan});
|
---|
[4] | 451 |
|
---|
[697] | 452 | # Tree navigation
|
---|
| 453 | my $crumbs = getBreadCrumbs($ip_dbh, $poolinfo->{parent_id});
|
---|
| 454 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 455 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 456 |
|
---|
[631] | 457 | $page->param(block => $cidr);
|
---|
[517] | 458 | $page->param(netip => $cidr->addr);
|
---|
| 459 | $cidr++;
|
---|
| 460 | $page->param(gate => $cidr->addr);
|
---|
| 461 | $cidr--; $cidr--;
|
---|
| 462 | $page->param(bcast => $cidr->addr);
|
---|
| 463 | $page->param(mask => $cidr->mask);
|
---|
[157] | 464 |
|
---|
[528] | 465 | $page->param(disptype => $disp_alloctypes{$poolinfo->{type}});
|
---|
| 466 | $page->param(city => $poolinfo->{city});
|
---|
[517] | 467 |
|
---|
[157] | 468 | # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
|
---|
[528] | 469 | $page->param(realblock => $poolinfo->{type} =~ /^.d$/);
|
---|
[4] | 470 |
|
---|
| 471 | # probably have to add an "edit IP allocation" link here somewhere.
|
---|
| 472 |
|
---|
[855] | 473 | # this will cascade into the IP list below
|
---|
| 474 | $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
|
---|
| 475 |
|
---|
[866] | 476 | my $plist = listPool($ip_dbh, $webvar{pool}, 1);
|
---|
[528] | 477 | $page->param(poolips => $plist);
|
---|
| 478 | } # end showPool
|
---|
[4] | 479 |
|
---|
| 480 |
|
---|
[106] | 481 | # Show "Add new allocation" page. Note that the actual page may
|
---|
| 482 | # be one of two templates, and the lists come from the database.
|
---|
[4] | 483 | sub assignBlock {
|
---|
| 484 |
|
---|
[233] | 485 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 486 | $aclerr = 'addblock';
|
---|
[233] | 487 | return;
|
---|
| 488 | }
|
---|
| 489 |
|
---|
[517] | 490 | # hack pthbttt eww
|
---|
[633] | 491 | $webvar{parent} = 0 if !$webvar{parent};
|
---|
[517] | 492 | $webvar{block} = '' if !$webvar{block};
|
---|
[21] | 493 |
|
---|
[575] | 494 | $page->param(allocfrom => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
|
---|
[517] | 495 |
|
---|
[633] | 496 | if ($webvar{fbid} || $webvar{fbtype}) {
|
---|
[575] | 497 |
|
---|
| 498 | # Common case, according to reported usage. Block to assign is specified.
|
---|
[21] | 499 | my $block = new NetAddr::IP $webvar{block};
|
---|
[187] | 500 |
|
---|
[675] | 501 | my ($rdns,$cached) = getBlockRDNS($ip_dbh, id => $webvar{parent}, type => $webvar{fbtype}, user => $authuser);
|
---|
[585] | 502 | $page->param(rdns => $rdns) if $rdns;
|
---|
[633] | 503 | $page->param(parent => $webvar{parent});
|
---|
| 504 | $page->param(fbid => $webvar{fbid});
|
---|
[675] | 505 | # visual flag that we're working IPDB-local, not off more authoritative data in dnsadmin
|
---|
| 506 | $page->param(cached => $cached);
|
---|
[585] | 507 |
|
---|
[691] | 508 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 509 |
|
---|
[892] | 510 | my @cities;
|
---|
| 511 | foreach my $city (@citylist) {
|
---|
| 512 | my %row = (city => $city, sel => ($pinfo->{city} eq $city) );
|
---|
| 513 | push (@cities, \%row);
|
---|
| 514 | }
|
---|
| 515 | $page->param(preselected => 1);
|
---|
| 516 | $page->param(citylist => \@cities);
|
---|
| 517 |
|
---|
[697] | 518 | # Tree navigation
|
---|
| 519 | my $crumbs = getBreadCrumbs($ip_dbh, $webvar{parent});
|
---|
| 520 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 521 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 522 |
|
---|
[575] | 523 | $webvar{fbtype} = '' if !$webvar{fbtype};
|
---|
| 524 | if ($webvar{fbtype} eq 'i') {
|
---|
[633] | 525 | my $ipinfo = getBlockData($ip_dbh, $webvar{block}, 'i');
|
---|
[575] | 526 | $page->param(
|
---|
| 527 | fbip => 1,
|
---|
[633] | 528 | block => $ipinfo->{block},
|
---|
[575] | 529 | fbdisptype => $list_alloctypes{$ipinfo->{type}},
|
---|
| 530 | type => $ipinfo->{type},
|
---|
[633] | 531 | allocfrom => $pinfo->{block},
|
---|
[575] | 532 | );
|
---|
[187] | 533 | } else {
|
---|
[529] | 534 | # get "primary" alloctypes, since these are all that can correctly be assigned if we're in this branch
|
---|
[575] | 535 | my $tlist = getTypeList($ip_dbh, 'n');
|
---|
[529] | 536 | $tlist->[0]->{sel} = 1;
|
---|
[575] | 537 | $page->param(typelist => $tlist, block => $block);
|
---|
[106] | 538 | }
|
---|
[575] | 539 |
|
---|
[21] | 540 | } else {
|
---|
[575] | 541 |
|
---|
| 542 | # Uncommon case, according to reported usage. Block to assign needs to be found based on criteria.
|
---|
[541] | 543 | my $mlist = getMasterList($ip_dbh, 'c');
|
---|
| 544 | $page->param(masterlist => $mlist);
|
---|
[517] | 545 |
|
---|
| 546 | my @pops;
|
---|
[633] | 547 | foreach my $pop (@citylist) {
|
---|
[517] | 548 | my %row = (pop => $pop);
|
---|
| 549 | push (@pops, \%row);
|
---|
[92] | 550 | }
|
---|
[517] | 551 | $page->param(pops => \@pops);
|
---|
| 552 |
|
---|
[892] | 553 | my @cities;
|
---|
| 554 | foreach my $city (@citylist) {
|
---|
| 555 | my %row = (city => $city);
|
---|
| 556 | push (@cities, \%row);
|
---|
| 557 | }
|
---|
| 558 | $page->param(citylist => \@cities);
|
---|
| 559 |
|
---|
[529] | 560 | # get all standard alloctypes
|
---|
| 561 | my $tlist = getTypeList($ip_dbh, 'a');
|
---|
| 562 | $tlist->[0]->{sel} = 1;
|
---|
| 563 | $page->param(typelist => $tlist);
|
---|
[21] | 564 | }
|
---|
[517] | 565 |
|
---|
[397] | 566 | ## node hack
|
---|
[530] | 567 | my $nlist = getNodeList($ip_dbh);
|
---|
| 568 | $page->param(nodelist => $nlist);
|
---|
[397] | 569 | ## end node hack
|
---|
| 570 |
|
---|
[782] | 571 | $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
|
---|
[284] | 572 |
|
---|
[4] | 573 | } # assignBlock
|
---|
| 574 |
|
---|
| 575 |
|
---|
| 576 | # Take info on requested IP assignment and see what we can provide.
|
---|
| 577 | sub confirmAssign {
|
---|
[233] | 578 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 579 | $aclerr = 'addblock';
|
---|
[233] | 580 | return;
|
---|
| 581 | }
|
---|
[4] | 582 |
|
---|
| 583 | my $cidr;
|
---|
[692] | 584 | my $resv; # Reserved for expansion.
|
---|
[4] | 585 | my $alloc_from;
|
---|
[633] | 586 | my $fbid = $webvar{fbid};
|
---|
| 587 | my $p_id = $webvar{parent};
|
---|
[4] | 588 |
|
---|
| 589 | # Going to manually validate some items.
|
---|
| 590 | # custid and city are automagic.
|
---|
[111] | 591 | return if !validateInput();
|
---|
[4] | 592 |
|
---|
[665] | 593 | # make sure this is defined
|
---|
| 594 | $webvar{fbassign} = 'n' if !$webvar{fbassign};
|
---|
| 595 |
|
---|
[4] | 596 | # Several different cases here.
|
---|
| 597 | # Static IP vs netblock
|
---|
| 598 | # + Different flavours of static IP
|
---|
| 599 | # + Different flavours of netblock
|
---|
| 600 |
|
---|
[575] | 601 | if ($webvar{alloctype} =~ /^.i$/ && $webvar{fbassign} ne 'y') {
|
---|
[665] | 602 | if (!$webvar{pop}) {
|
---|
| 603 | $page->param(err => "Please select a location/POP site to allocate from.");
|
---|
| 604 | return;
|
---|
| 605 | }
|
---|
[532] | 606 | my $plist = getPoolSelect($ip_dbh, $webvar{alloctype}, $webvar{pop});
|
---|
[517] | 607 | $page->param(staticip => 1);
|
---|
[532] | 608 | $page->param(poollist => $plist) if $plist;
|
---|
[4] | 609 | $cidr = "Single static IP";
|
---|
[517] | 610 | ##fixme: need to handle "no available pools"
|
---|
[4] | 611 |
|
---|
| 612 | } else { # end show pool options
|
---|
[21] | 613 |
|
---|
[533] | 614 | if ($webvar{fbassign} && $webvar{fbassign} eq 'y') {
|
---|
[697] | 615 |
|
---|
| 616 | # Tree navigation
|
---|
| 617 | my $crumbs = getBreadCrumbs($ip_dbh, $webvar{parent});
|
---|
| 618 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 619 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 620 |
|
---|
[21] | 621 | $cidr = new NetAddr::IP $webvar{block};
|
---|
[575] | 622 | $alloc_from = new NetAddr::IP $webvar{allocfrom};
|
---|
[21] | 623 | $webvar{maskbits} = $cidr->masklen;
|
---|
[692] | 624 | # Some additional checks are needed for reserving free space
|
---|
| 625 | if ($webvar{reserve}) {
|
---|
| 626 | if ($cidr == $alloc_from) {
|
---|
| 627 | # We could still squirm and fiddle to try to find a way to reserve space, but the storage model for
|
---|
| 628 | # IPDB means that all continguous free space is kept in the smallest number of strict CIDR netblocks
|
---|
| 629 | # possible. (In theory.) If the request and the freeblock are the same, it is theoretically impossible
|
---|
| 630 | # to reserve an equivalent-sized block either ahead or behind the requested one, because the pair
|
---|
| 631 | # together would never be a strict CIDR block.
|
---|
| 632 | $page->param(warning => "Can't reserve space for expansion; free block and requested allocation are the same.");
|
---|
| 633 | delete $webvar{reserve};
|
---|
| 634 | } else {
|
---|
| 635 | # Find which new free block will match the reqested block.
|
---|
| 636 | # Take the requested mask, shift by one
|
---|
| 637 | my $tmpmask = $webvar{maskbits};
|
---|
| 638 | $tmpmask--;
|
---|
| 639 | # find the subnets with that mask in the selected free block
|
---|
| 640 | my @pieces = $alloc_from->split($tmpmask);
|
---|
| 641 | foreach my $slice (@pieces) {
|
---|
| 642 | if ($slice->contains($cidr)) {
|
---|
| 643 | # For the subnet that contains the requested block, split that in two,
|
---|
| 644 | # and flag/cache the one that's not the requested block.
|
---|
| 645 | my @bits = $slice->split($webvar{maskbits});
|
---|
| 646 | if ($bits[0] == $cidr) {
|
---|
| 647 | $resv = $bits[1];
|
---|
| 648 | } else {
|
---|
| 649 | $resv = $bits[0];
|
---|
| 650 | }
|
---|
| 651 | }
|
---|
| 652 | }
|
---|
| 653 | }
|
---|
| 654 | } # reserve block check
|
---|
| 655 |
|
---|
[21] | 656 | } else { # done with direct freeblocks assignment
|
---|
| 657 |
|
---|
| 658 | if (!$webvar{maskbits}) {
|
---|
[517] | 659 | $page->param(err => "Please specify a CIDR mask length.");
|
---|
[111] | 660 | return;
|
---|
[21] | 661 | }
|
---|
[533] | 662 |
|
---|
| 663 | ##fixme ick, ew, bleh. gotta handle the failure message generation better. push it into findAllocateFrom()?
|
---|
| 664 | my $failmsg = "No suitable free block found.<br>\n";
|
---|
[187] | 665 | if ($webvar{alloctype} eq 'rm') {
|
---|
[533] | 666 | $failmsg .= "We do not have a free routeable block of that size.<br>\n".
|
---|
| 667 | "You will have to either route a set of smaller netblocks or a single smaller netblock.";
|
---|
[4] | 668 | } else {
|
---|
[214] | 669 | if ($webvar{alloctype} =~ /^.[pc]$/) {
|
---|
[533] | 670 | $failmsg .= "You will have to route another superblock from one of the<br>\n".
|
---|
| 671 | "master blocks or chose a smaller block size for the pool.";
|
---|
[21] | 672 | } else {
|
---|
[517] | 673 | if (!$webvar{pop}) {
|
---|
| 674 | $page->param(err => 'Please select a POP to route the block from/through.');
|
---|
| 675 | return;
|
---|
| 676 | }
|
---|
[533] | 677 | $failmsg .= "You will have to route another superblock to $webvar{pop}<br>\n".
|
---|
[692] | 678 | "from one of the master blocks";
|
---|
| 679 | if ($webvar{reserve}) {
|
---|
| 680 | $failmsg .= ', choose a smaller blocksize, or uncheck "Reserve space for expansion".';
|
---|
| 681 | } else {
|
---|
| 682 | $failmsg .= " or chose a smaller blocksize.";
|
---|
| 683 | }
|
---|
[21] | 684 | }
|
---|
[4] | 685 | }
|
---|
[533] | 686 |
|
---|
[692] | 687 | # if requesting extra space "reserved for expansion", we need to find a free
|
---|
| 688 | # block at least double the size of the request.
|
---|
| 689 | if ($webvar{reserve}) {
|
---|
| 690 | $webvar{maskbits}--;
|
---|
| 691 | }
|
---|
| 692 |
|
---|
[633] | 693 | ($fbid,$cidr,$p_id) = findAllocateFrom($ip_dbh, $webvar{maskbits}, $webvar{alloctype},
|
---|
| 694 | $webvar{city}, $webvar{pop}, (master => $webvar{allocfrom}, allowpriv => $webvar{allowpriv}) );
|
---|
[533] | 695 | if (!$cidr) {
|
---|
[517] | 696 | $page->param(err => $failmsg);
|
---|
[111] | 697 | return;
|
---|
[21] | 698 | }
|
---|
[533] | 699 | $cidr = new NetAddr::IP $cidr;
|
---|
[575] | 700 |
|
---|
| 701 | $alloc_from = "$cidr";
|
---|
[692] | 702 |
|
---|
| 703 | # when autofinding a block to allocate from, use the first piece of the found
|
---|
| 704 | # block for the allocation, and the next piece for the "reserved for expansion".
|
---|
| 705 | if ($webvar{reserve}) {
|
---|
| 706 | # reset the mask to the real requested one, now that we've got a
|
---|
| 707 | # block large enough for the request plus reserve
|
---|
| 708 | $webvar{maskbits}++;
|
---|
| 709 | ($cidr,$resv) = $cidr->split($webvar{maskbits});
|
---|
| 710 | }
|
---|
| 711 |
|
---|
[575] | 712 | # If the block to be allocated is smaller than the one we found,
|
---|
| 713 | # figure out the "real" block to be allocated.
|
---|
| 714 | if ($cidr->masklen() ne $webvar{maskbits}) {
|
---|
| 715 | my $maskbits = $cidr->masklen();
|
---|
[889] | 716 | # we reset $cidr each time around the loop to better allow for the huge
|
---|
| 717 | # address space of IPv6; many allocation schemes in v6 will break NetAddr::IP's
|
---|
| 718 | # hard limit of 65536 subnets from a split()
|
---|
[575] | 719 | while ($maskbits++ < $webvar{maskbits}) {
|
---|
[889] | 720 | $cidr = ($cidr->split($maskbits))[0];
|
---|
[575] | 721 | }
|
---|
| 722 | }
|
---|
[21] | 723 | } # check for freeblocks assignment or IPDB-controlled assignment
|
---|
[4] | 724 |
|
---|
[674] | 725 | # Generate the IP list for the new allocation in case someone wants to set per-IP rDNS right away.
|
---|
| 726 | # We don't do this on the previous page because we don't know how big a block or even what IP range
|
---|
| 727 | # it's for (if following the "normal" allocation process)
|
---|
| 728 | if ($IPDBacl{$authuser} =~ /c/
|
---|
| 729 | && $cidr->masklen != $cidr->bits
|
---|
[780] | 730 | && ($cidr->bits - $cidr->masklen) <= $IPDB::maxrevlist
|
---|
| 731 | # config flag for "all block types" OR "not-a-pool-or-IP type"
|
---|
| 732 | && ($IPDB::revlistalltypes || $webvar{alloctype} !~ /^.[dpi]/)
|
---|
| 733 | # safety against trying to retrieve and display more than 1k (10 bits, /22 v4) worth of individual IPs
|
---|
| 734 | # ever. If you really need to manage a long list of IPs like that all in one place, you can use the DNS
|
---|
| 735 | # management tool. Even a /26 is a bit much, really.
|
---|
| 736 | && ($cidr->bits - $cidr->masklen) <= 10
|
---|
[674] | 737 | # do we want to allow v6 at all?
|
---|
| 738 | #&& ! $cidr->{isv6}
|
---|
| 739 | ) {
|
---|
| 740 | my @list;
|
---|
| 741 | foreach my $ip (@{$cidr->splitref()}) {
|
---|
| 742 | my %row;
|
---|
| 743 | $row{r_ip} = $ip->addr;
|
---|
| 744 | $row{iphost} = '';
|
---|
| 745 | push @list, \%row;
|
---|
| 746 | }
|
---|
| 747 | $page->param(r_iplist => \@list);
|
---|
| 748 | # We don't use this here, because these IPs should already be bare.
|
---|
| 749 | # ... or should we be paranoid? Make it a config option?
|
---|
| 750 | #getRDNSbyIP($ip_dbh, type => $webvar{alloctype}, range => "$cidr", user => $authuser) );
|
---|
| 751 | }
|
---|
[157] | 752 | } # if ($webvar{alloctype} =~ /^.i$/)
|
---|
[4] | 753 |
|
---|
[397] | 754 | ## node hack
|
---|
| 755 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 756 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 757 | $page->param(nodename => $nodename);
|
---|
| 758 | $page->param(nodeid => $webvar{node});
|
---|
[397] | 759 | }
|
---|
| 760 | ## end node hack
|
---|
| 761 |
|
---|
[760] | 762 | # flag DNS info if we can't publish the entry remotely
|
---|
| 763 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 764 | $page->param(dnslocal => 1) unless ($pinfo->{revpartial} || $pinfo->{revavail});
|
---|
| 765 |
|
---|
[692] | 766 | # reserve for expansion
|
---|
| 767 | $page->param(reserve => $webvar{reserve});
|
---|
| 768 | # probably just preventing a little log noise doing this; could just set the param
|
---|
| 769 | # all the time since it won't be shown if the reserve param above isn't set.
|
---|
| 770 | # if ($webvar{reserve}) {
|
---|
| 771 | $page->param(resvblock => $resv);
|
---|
| 772 | # }
|
---|
| 773 |
|
---|
[4] | 774 | # Stick in the allocation data
|
---|
[517] | 775 | $page->param(alloc_type => $webvar{alloctype});
|
---|
| 776 | $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
|
---|
| 777 | $page->param(alloc_from => $alloc_from);
|
---|
[633] | 778 | $page->param(parent => $p_id);
|
---|
| 779 | $page->param(fbid => $fbid);
|
---|
[517] | 780 | $page->param(cidr => $cidr);
|
---|
[585] | 781 | $page->param(rdns => $webvar{rdns});
|
---|
[691] | 782 | $page->param(vrf => $webvar{vrf});
|
---|
| 783 | $page->param(vlan => $webvar{vlan});
|
---|
[517] | 784 | $page->param(city => $q->escapeHTML($webvar{city}));
|
---|
| 785 | $page->param(custid => $webvar{custid});
|
---|
| 786 | $page->param(circid => $q->escapeHTML($webvar{circid}));
|
---|
| 787 | $page->param(desc => $q->escapeHTML($webvar{desc}));
|
---|
[4] | 788 |
|
---|
[517] | 789 | ##fixme: find a way to have the displayed copy have <br> substitutions
|
---|
| 790 | # for newlines, and the <input> value have either encoded or bare newlines.
|
---|
| 791 | # Also applies to privdata.
|
---|
| 792 | $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
|
---|
| 793 |
|
---|
[284] | 794 | # Check to see if user is allowed to do anything with sensitive data
|
---|
[800] | 795 | if ($IPDBacl{$authuser} =~ /s/) {
|
---|
[782] | 796 | $page->param(nocling => 1);
|
---|
| 797 | $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'));
|
---|
[517] | 798 |
|
---|
[782] | 799 | $page->param(backupfields => $webvar{backupfields});
|
---|
| 800 | $page->param(bkbrand => $webvar{bkbrand});
|
---|
| 801 | $page->param(bkmodel => $webvar{bkmodel});
|
---|
| 802 | $page->param(bktype => $webvar{bktype});
|
---|
| 803 | $page->param(bksrc => $webvar{bksrc});
|
---|
| 804 | $page->param(bkuser => $webvar{bkuser});
|
---|
| 805 | # these two could use virtually any character
|
---|
| 806 | $page->param(bkvpass => $q->escapeHTML($webvar{bkvpass}));
|
---|
| 807 | $page->param(bkepass => $q->escapeHTML($webvar{bkepass}));
|
---|
| 808 | $page->param(bkport => $webvar{bkport});
|
---|
[798] | 809 | $page->param(bkip => $webvar{bkip});
|
---|
[782] | 810 | }
|
---|
| 811 |
|
---|
[517] | 812 | # Yay! This now has it's very own little home.
|
---|
| 813 | $page->param(billinguser => $webvar{userid})
|
---|
[299] | 814 | if $webvar{userid};
|
---|
[284] | 815 |
|
---|
[835] | 816 | syslog "debug", "billinguser used ($authuser): alloc_from $alloc_from, type $webvar{alloctype}" if $webvar{userid};
|
---|
| 817 |
|
---|
[517] | 818 | ##fixme: this is only needed iff confirm.tmpl and
|
---|
| 819 | # confirmRemove.tmpl are merged (quite possible, just
|
---|
| 820 | # a little tedious)
|
---|
| 821 | $page->param(action => "insert");
|
---|
[284] | 822 |
|
---|
[4] | 823 | } # end confirmAssign
|
---|
| 824 |
|
---|
| 825 |
|
---|
| 826 | # Do the work of actually inserting a block in the database.
|
---|
| 827 | sub insertAssign {
|
---|
[233] | 828 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 829 | $aclerr = 'addblock';
|
---|
[233] | 830 | return;
|
---|
| 831 | }
|
---|
[4] | 832 | # Some things are done more than once.
|
---|
[111] | 833 | return if !validateInput();
|
---|
[4] | 834 |
|
---|
[782] | 835 | ##fixme: permission check
|
---|
[284] | 836 | if (!defined($webvar{privdata})) {
|
---|
| 837 | $webvar{privdata} = '';
|
---|
| 838 | }
|
---|
[575] | 839 |
|
---|
[106] | 840 | # $code is "success" vs "failure", $msg contains OK for a
|
---|
| 841 | # successful netblock allocation, the IP allocated for static
|
---|
| 842 | # IP, or the error message if an error occurred.
|
---|
[517] | 843 |
|
---|
[677] | 844 | ##fixme: consider just passing \%webvar to allocateBlock()?
|
---|
| 845 | # collect per-IP rDNS fields. only copy over the ones that actually have something in them.
|
---|
| 846 | my %iprev;
|
---|
| 847 | foreach (keys %webvar) {
|
---|
| 848 | $iprev{$_} = $webvar{$_} if /host_[\d.a-fA-F:]+/ && $webvar{$_};
|
---|
| 849 | }
|
---|
| 850 |
|
---|
[691] | 851 | # Easier to see and cosmetically fiddle the list like this
|
---|
| 852 | my %insert_args = (
|
---|
| 853 | cidr => $webvar{fullcidr},
|
---|
| 854 | fbid => $webvar{fbid},
|
---|
[692] | 855 | reserve => $webvar{reserve},
|
---|
[691] | 856 | parent => $webvar{parent},
|
---|
| 857 | custid => $webvar{custid},
|
---|
| 858 | type => $webvar{alloctype},
|
---|
| 859 | city => $webvar{city},
|
---|
| 860 | desc => $webvar{desc},
|
---|
| 861 | notes => $webvar{notes},
|
---|
| 862 | circid => $webvar{circid},
|
---|
| 863 | privdata => $webvar{privdata},
|
---|
| 864 | nodeid => $webvar{node},
|
---|
| 865 | rdns => $webvar{rdns},
|
---|
| 866 | vrf => $webvar{vrf},
|
---|
| 867 | vlan => $webvar{vlan},
|
---|
| 868 | user => $authuser,
|
---|
| 869 | );
|
---|
[4] | 870 |
|
---|
[782] | 871 | ##fixme: permission check
|
---|
| 872 | # fill in backup data, if present/allowed
|
---|
| 873 | if ($webvar{backupfields}) {
|
---|
| 874 | $insert_args{backup} = 1;
|
---|
[798] | 875 | for my $bkfield (@IPDB::backupfields) {
|
---|
[782] | 876 | $insert_args{"bk$bkfield"} = ($webvar{"bk$bkfield"} ? $webvar{"bk$bkfield"} : '');
|
---|
| 877 | }
|
---|
| 878 | }
|
---|
| 879 |
|
---|
[766] | 880 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 881 |
|
---|
| 882 | # clean up a minor mess with guided allocation of static IPs
|
---|
| 883 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
| 884 | $insert_args{alloc_from} = $pinfo->{block};
|
---|
| 885 | }
|
---|
| 886 |
|
---|
[691] | 887 | my ($code,$msg) = allocateBlock($ip_dbh, %insert_args, iprev => \%iprev);
|
---|
| 888 |
|
---|
[111] | 889 | if ($code eq 'OK') {
|
---|
[766] | 890 | # breadcrumbs lite! provide at least a link to the parent of the block we just allocated.
|
---|
| 891 | $page->param(parentid => $webvar{parent});
|
---|
| 892 | $page->param(parentblock => $pinfo->{block});
|
---|
| 893 |
|
---|
[106] | 894 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
[300] | 895 | $msg =~ s|/32||;
|
---|
[517] | 896 | $page->param(staticip => $msg);
|
---|
| 897 | $page->param(custid => $webvar{custid});
|
---|
| 898 | $page->param(billinguser => $webvar{billinguser});
|
---|
[839] | 899 | $page->param(billinglink => $IPDB::billinglink);
|
---|
[416] | 900 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 901 | "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
|
---|
[881] | 902 | "Description: $webvar{desc}\n".
|
---|
| 903 | ($webvar{rdns} ? "DNS name: $webvar{rdns}\n" : '').
|
---|
| 904 | "\nAllocated by: $authuser\n");
|
---|
[106] | 905 | } else {
|
---|
[301] | 906 | my $netblock = new NetAddr::IP $webvar{fullcidr};
|
---|
[517] | 907 | $page->param(fullcidr => $webvar{fullcidr});
|
---|
| 908 | $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 909 | $page->param(custid => $webvar{custid});
|
---|
[697] | 910 |
|
---|
| 911 | # Full breadcrumbs
|
---|
| 912 | my $crumbs = getBreadCrumbs($ip_dbh, $webvar{parent});
|
---|
| 913 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 914 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 915 |
|
---|
[517] | 916 | if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
|
---|
| 917 | $page->param(billinguser => $webvar{billinguser});
|
---|
[839] | 918 | $page->param(billinglink => $IPDB::billinglink);
|
---|
[517] | 919 | $page->param(custid => $webvar{custid});
|
---|
| 920 | $page->param(netaddr => $netblock->addr);
|
---|
| 921 | $page->param(masklen => $netblock->masklen);
|
---|
| 922 | }
|
---|
[835] | 923 | syslog "debug", "billinguser used ($authuser): allocated $netblock, type $webvar{alloctype}" if $webvar{billinguser};
|
---|
[416] | 924 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 925 | "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
|
---|
[881] | 926 | "Description: $webvar{desc}\n".
|
---|
| 927 | ($webvar{rdns} ? "DNS name/pattern: $webvar{rdns}\n" : '').
|
---|
| 928 | "\nAllocated by: $authuser\n");
|
---|
[4] | 929 | }
|
---|
[106] | 930 | syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
[256] | 931 | "'$webvar{alloctype}' ($msg)";
|
---|
[111] | 932 | } else {
|
---|
| 933 | syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
| 934 | "'$webvar{alloctype}' by $authuser failed: '$msg'";
|
---|
[766] | 935 | $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}' failed:");
|
---|
| 936 | $page->param(errmsg => $msg);
|
---|
[106] | 937 | }
|
---|
[4] | 938 |
|
---|
| 939 | } # end insertAssign()
|
---|
| 940 |
|
---|
| 941 |
|
---|
| 942 | # Does some basic checks on common input data to make sure nothing
|
---|
| 943 | # *really* weird gets in to the database through this script.
|
---|
| 944 | # Does NOT do complete input validation!!!
|
---|
| 945 | sub validateInput {
|
---|
| 946 | if ($webvar{city} eq '-') {
|
---|
[517] | 947 | $page->param(err => 'Please choose a city');
|
---|
[111] | 948 | return;
|
---|
[4] | 949 | }
|
---|
[138] | 950 |
|
---|
| 951 | # Alloctype check.
|
---|
[4] | 952 | chomp $webvar{alloctype};
|
---|
[138] | 953 | if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
|
---|
| 954 | # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
|
---|
| 955 | # managing to call things in such a way as to cause this deserves a cryptic error.
|
---|
[517] | 956 | $page->param(err => 'Invalid alloctype');
|
---|
[138] | 957 | return;
|
---|
| 958 | }
|
---|
| 959 |
|
---|
| 960 | # CustID check
|
---|
[4] | 961 | # We have different handling for customer allocations and "internal" or "our" allocations
|
---|
[214] | 962 | if ($def_custids{$webvar{alloctype}} eq '') {
|
---|
[4] | 963 | if (!$webvar{custid}) {
|
---|
[517] | 964 | $page->param(err => 'Please enter a customer ID.');
|
---|
[111] | 965 | return;
|
---|
[4] | 966 | }
|
---|
[546] | 967 | # Crosscheck with billing.
|
---|
| 968 | my $status = CustIDCK->custid_exist($webvar{custid});
|
---|
| 969 | if ($CustIDCK::Error) {
|
---|
| 970 | $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
|
---|
| 971 | return;
|
---|
[4] | 972 | }
|
---|
[546] | 973 | if (!$status) {
|
---|
| 974 | $page->param(err => "Customer ID not valid. Make sure the Customer ID ".
|
---|
| 975 | "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
|
---|
| 976 | "non-customer assignments.");
|
---|
| 977 | return;
|
---|
| 978 | }
|
---|
[400] | 979 | # print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
|
---|
[138] | 980 | } else {
|
---|
[167] | 981 | # New! Improved! And now Loaded From The Database!!
|
---|
[320] | 982 | if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
|
---|
| 983 | $webvar{custid} = $def_custids{$webvar{alloctype}};
|
---|
| 984 | }
|
---|
[4] | 985 | }
|
---|
[111] | 986 |
|
---|
[571] | 987 | ## hmmm.... is this even useful?
|
---|
| 988 | if (0) {
|
---|
[111] | 989 | # Check POP location
|
---|
| 990 | my $flag;
|
---|
[187] | 991 | if ($webvar{alloctype} eq 'rm') {
|
---|
[111] | 992 | $flag = 'for a routed netblock';
|
---|
| 993 | foreach (@poplist) {
|
---|
| 994 | if (/^$webvar{city}$/) {
|
---|
| 995 | $flag = 'n';
|
---|
| 996 | last;
|
---|
| 997 | }
|
---|
| 998 | }
|
---|
| 999 | } else {
|
---|
| 1000 | $flag = 'n';
|
---|
[442] | 1001 | ##fixme: hook to force-set POP or city on certain alloctypes
|
---|
| 1002 | # if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
|
---|
[536] | 1003 | if ($webvar{pop} && $webvar{pop} =~ /^-$/) {
|
---|
[111] | 1004 | $flag = 'to route the block from/through';
|
---|
| 1005 | }
|
---|
| 1006 | }
|
---|
[517] | 1007 |
|
---|
| 1008 | # if the alloctype has a restricted city/POP list as determined above,
|
---|
| 1009 | # and the reqested city/POP does not match that list, complain
|
---|
[111] | 1010 | if ($flag ne 'n') {
|
---|
[517] | 1011 | $page->param(err => "Please choose a valid POP location $flag. Valid ".
|
---|
[111] | 1012 | "POP locations are currently:<br>\n".join (" - ", @poplist));
|
---|
| 1013 | return;
|
---|
| 1014 | }
|
---|
[571] | 1015 | }
|
---|
[111] | 1016 |
|
---|
[691] | 1017 | # VRF. Not a full validity check, just a basic sanity check.
|
---|
| 1018 | if ($webvar{vrf}) {
|
---|
| 1019 | # Trim leading and trailing whitespace first
|
---|
| 1020 | $webvar{vrf} =~ s/^\s+//;
|
---|
| 1021 | $webvar{vrf} =~ s/\s+$//;
|
---|
| 1022 | if ($webvar{vrf} !~ /^[\w\d_.-]{1,32}$/) {
|
---|
| 1023 | $page->param(err => "VRF values may only contain alphanumerics, and may not be more than 32 characters");
|
---|
| 1024 | return;
|
---|
| 1025 | }
|
---|
| 1026 | }
|
---|
| 1027 |
|
---|
| 1028 | # VLAN. Should we allow/use VLAN names, or just the numeric ID?
|
---|
| 1029 | if ($webvar{vlan}) {
|
---|
| 1030 | # Trim leading and trailing whitespace first
|
---|
| 1031 | $webvar{vlan} =~ s/^\s+//;
|
---|
| 1032 | $webvar{vlan} =~ s/\s+$//;
|
---|
[884] | 1033 | # Then any surrounding a comma
|
---|
| 1034 | $webvar{vlan} =~ s/\s*,\s*/,/g;
|
---|
[691] | 1035 | # ... ve make it ze configurable thingy!
|
---|
| 1036 | if ($IPDB::numeric_vlan) {
|
---|
[884] | 1037 | if ($webvar{vlan} !~ /^[\d,-]+$/) {
|
---|
[691] | 1038 | $page->param(err => "VLANs must be numeric");
|
---|
| 1039 | return;
|
---|
| 1040 | }
|
---|
| 1041 | } else {
|
---|
[884] | 1042 | if ($webvar{vlan} !~ /^[\w\d_.,-]+$/) {
|
---|
[691] | 1043 | $page->param(err => "VLANs must be alphanumeric");
|
---|
| 1044 | return;
|
---|
| 1045 | }
|
---|
| 1046 | }
|
---|
| 1047 | }
|
---|
| 1048 |
|
---|
[782] | 1049 | # Backup fields. Minimal sanity checks.
|
---|
[813] | 1050 | # Bypass if the user isn't authorized for backup data, or if the checkbox is unchecked
|
---|
| 1051 | if ($IPDBacl{$authuser} =~ /s/ && defined($webvar{backupfields})) {
|
---|
| 1052 | for my $bkfield (qw(brand model)) {
|
---|
| 1053 | if (!$webvar{"bk$bkfield"}) {
|
---|
| 1054 | $page->param(err => "Backup $bkfield must be filled in if IP/netblock is flagged for backup");
|
---|
| 1055 | return;
|
---|
| 1056 | }
|
---|
| 1057 | if ($webvar{"bk$bkfield"} !~ /^[a-zA-Z0-9\s_.-]+$/) {
|
---|
| 1058 | $page->param(err => "Invalid characters in backup $bkfield");
|
---|
| 1059 | return;
|
---|
| 1060 | }
|
---|
[798] | 1061 | }
|
---|
[813] | 1062 | for my $bkfield (qw(type src user)) { # no spaces in these!
|
---|
| 1063 | if ($webvar{"bk$bkfield"} && $webvar{"bk$bkfield"} !~ /^[a-zA-Z0-9_.-]+$/) {
|
---|
| 1064 | $page->param(err => "Invalid characters in backup $bkfield");
|
---|
| 1065 | return;
|
---|
| 1066 | }
|
---|
[782] | 1067 | }
|
---|
[813] | 1068 | if ($webvar{bkport}) {
|
---|
| 1069 | $webvar{bkport} =~ s/^\s+//g;
|
---|
| 1070 | $webvar{bkport} =~ s/\s+$//g;
|
---|
| 1071 | if ($webvar{bkport} !~ /^\d+$/) {
|
---|
| 1072 | $page->param(err => "Backup port must be numeric");
|
---|
| 1073 | return;
|
---|
| 1074 | }
|
---|
[782] | 1075 | }
|
---|
[798] | 1076 | ##fixme: code review: should normalize $webvar{cidr} variants so we can
|
---|
| 1077 | # check for non-/32 allocations having the backup IP field filled in here,
|
---|
| 1078 | # instead of failing on the allocation or update attempt
|
---|
[813] | 1079 | if ($webvar{bkip}) {
|
---|
| 1080 | $webvar{bkip} =~ s/^\s+//g;
|
---|
| 1081 | $webvar{bkip} =~ s/\s+$//g;
|
---|
| 1082 | if ($webvar{bkip} !~ /^[\da-fA-F:.]+$/) {
|
---|
| 1083 | $page->param(err => "Backup IP must be an IP");
|
---|
| 1084 | return;
|
---|
| 1085 | }
|
---|
[798] | 1086 | }
|
---|
[813] | 1087 | } # backup
|
---|
[782] | 1088 |
|
---|
[111] | 1089 | return 'OK';
|
---|
[4] | 1090 | } # end validateInput
|
---|
| 1091 |
|
---|
| 1092 |
|
---|
| 1093 | # Displays details of a specific allocation in a form
|
---|
| 1094 | # Allows update/delete
|
---|
| 1095 | # action=edit
|
---|
| 1096 | sub edit {
|
---|
| 1097 |
|
---|
[534] | 1098 | # snag block info from db
|
---|
[634] | 1099 | my $blockinfo = getBlockData($ip_dbh, $webvar{id}, $webvar{basetype});
|
---|
[750] | 1100 | my $cidr = new NetAddr::IP $blockinfo->{block};
|
---|
[691] | 1101 | $page->param(id => $webvar{id});
|
---|
[634] | 1102 | $page->param(basetype => $webvar{basetype});
|
---|
[4] | 1103 |
|
---|
[697] | 1104 | # Tree navigation
|
---|
| 1105 | my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
|
---|
| 1106 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1107 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1108 |
|
---|
[705] | 1109 | # Show link to IP list for pools
|
---|
| 1110 | $page->param(ispool => 1) if $blockinfo->{type} =~ /^.[dp]$/;
|
---|
| 1111 |
|
---|
[534] | 1112 | # Clean up extra whitespace on alloc type. Mainly a legacy-data cleanup.
|
---|
| 1113 | $blockinfo->{type} =~ s/\s//;
|
---|
[4] | 1114 |
|
---|
[760] | 1115 | ##fixme: The case of "allocation larger than a /24" (or any similar case
|
---|
| 1116 | # where the allocation is larger than the zone(s) in DNS) doesn't work well.
|
---|
| 1117 | # Best solution may just be to add a warning that the entry shown may not be
|
---|
| 1118 | # correct/complete.
|
---|
| 1119 | if ($blockinfo->{revavail} || $blockinfo->{revpartial}) {
|
---|
| 1120 | $page->param(showrev => ($blockinfo->{revavail} || $blockinfo->{revpartial}) );
|
---|
[830] | 1121 | $page->param(v6 => $cidr->{isv6});
|
---|
| 1122 | $page->param(dnslink => $IPDB::dnsadmin_url);
|
---|
| 1123 |
|
---|
| 1124 | # get the DNSAdmin zone ID(s) for this allocation.
|
---|
| 1125 | # Multiple zones should be rare, but are NOT impossible!
|
---|
| 1126 | my $revlist = getRevID($ip_dbh, user => $authuser, cidr => $blockinfo->{block},
|
---|
| 1127 | location => $blockinfo->{location});
|
---|
[866] | 1128 | $page->param(revlist => $revlist) if $revlist;
|
---|
[830] | 1129 |
|
---|
[750] | 1130 | my $cached;
|
---|
| 1131 | # Get rDNS info; duplicates a bit of getBlockData but also does the RPC call if possible
|
---|
| 1132 | ($blockinfo->{rdns},$cached) = getBlockRDNS($ip_dbh, id => $webvar{id}, type => $blockinfo->{type}, user => $authuser);
|
---|
[760] | 1133 | $page->param(rdns => $blockinfo->{rdns});
|
---|
[750] | 1134 | # visual flag that we're working IPDB-local, not off more authoritative data in dnsadmin
|
---|
| 1135 | $page->param(cached => $cached);
|
---|
[586] | 1136 |
|
---|
[750] | 1137 | # Limit the per-IP rDNS list based on CIDR length; larger ones just take up too much space.
|
---|
| 1138 | # Also, don't show on IP pools; the individual IPs will have a space for rDNS
|
---|
| 1139 | # Don't show on single IPs; these use the "pattern" field
|
---|
| 1140 | if ($IPDBacl{$authuser} =~ /c/
|
---|
| 1141 | && $cidr->masklen != $cidr->bits
|
---|
| 1142 | && ($cidr->bits - $cidr->masklen) <= $IPDB::maxrevlist
|
---|
[780] | 1143 | # config flag for "all block types" OR "not-a-pool-or-IP type"
|
---|
| 1144 | && ($IPDB::revlistalltypes || $blockinfo->{type} !~ /^.[dpi]/)
|
---|
| 1145 | # safety against trying to retrieve and display more than 1k (10 bits, /22 v4) worth of individual IPs
|
---|
| 1146 | # ever. If you really need to manage a long list of IPs like that all in one place, you can use the DNS
|
---|
| 1147 | # management tool. Even a /26 is a bit much, really.
|
---|
| 1148 | && ($cidr->bits - $cidr->masklen) <= 10
|
---|
[750] | 1149 | # do we want to allow v6 at all?
|
---|
| 1150 | #&& ! $cidr->{isv6}
|
---|
| 1151 | ) {
|
---|
| 1152 | $page->param(r_iplist => getRDNSbyIP($ip_dbh, id => $webvar{id}, type => $blockinfo->{type},
|
---|
| 1153 | range => $blockinfo->{block}, user => $authuser) );
|
---|
| 1154 | }
|
---|
| 1155 | } # rDNS availability check
|
---|
[675] | 1156 |
|
---|
[786] | 1157 | # backup data
|
---|
| 1158 | if ($blockinfo->{hasbk}) {
|
---|
| 1159 | $page->param(hasbackup => $blockinfo->{hasbk});
|
---|
[798] | 1160 | for my $bkfield (@IPDB::backupfields) {
|
---|
[786] | 1161 | $page->param("bk$bkfield" => $blockinfo->{"bk$bkfield"});
|
---|
| 1162 | }
|
---|
| 1163 | $page->param(bktelnet => 1) if $blockinfo->{bktype} eq 'telnet';
|
---|
| 1164 | $page->param(bkssh => 1) if $blockinfo->{bktype} eq 'SSH';
|
---|
| 1165 | }
|
---|
| 1166 |
|
---|
[691] | 1167 | # consider extending this to show time as well as date
|
---|
| 1168 | my ($lastmod,undef) = split /\s+/, $blockinfo->{lastmod};
|
---|
| 1169 | $page->param(lastmod => $lastmod);
|
---|
[4] | 1170 |
|
---|
[691] | 1171 | $page->param(block => $blockinfo->{block});
|
---|
| 1172 | $page->param(city => $blockinfo->{city});
|
---|
| 1173 | $page->param(custid => $blockinfo->{custid});
|
---|
[4] | 1174 |
|
---|
[187] | 1175 | ##fixme The check here should be built from the database
|
---|
[517] | 1176 | # Need to expand to support pool types too
|
---|
[534] | 1177 | if ($blockinfo->{type} =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
|
---|
[517] | 1178 | $page->param(changetype => 1);
|
---|
| 1179 | $page->param(alloctype => [
|
---|
[534] | 1180 | { selme => ($blockinfo->{type} eq 'me'), type => "me", disptype => "Dialup netblock" },
|
---|
| 1181 | { selme => ($blockinfo->{type} eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
|
---|
| 1182 | { selme => ($blockinfo->{type} eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
|
---|
| 1183 | { selme => ($blockinfo->{type} eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
|
---|
| 1184 | { selme => ($blockinfo->{type} eq 'cn'), type => "cn", disptype => "Customer netblock" },
|
---|
| 1185 | { selme => ($blockinfo->{type} eq 'en'), type => "en", disptype => "End-use netblock" },
|
---|
| 1186 | { selme => ($blockinfo->{type} eq 'in'), type => "in", disptype => "Internal netblock" },
|
---|
[517] | 1187 | ]
|
---|
| 1188 | );
|
---|
| 1189 | } else {
|
---|
[534] | 1190 | $page->param(disptype => $disp_alloctypes{$blockinfo->{type}});
|
---|
| 1191 | $page->param(type => $blockinfo->{type});
|
---|
[517] | 1192 | }
|
---|
| 1193 |
|
---|
[397] | 1194 | ## node hack
|
---|
[634] | 1195 | my ($nodeid,$nodename) = getNodeInfo($ip_dbh, $blockinfo->{block});
|
---|
| 1196 | # $page->param(havenodeid => $nodeid);
|
---|
| 1197 | $page->param(nodename => $nodename);
|
---|
[517] | 1198 |
|
---|
| 1199 | ##fixme: this whole hack needs cleanup and generalization for all alloctypes
|
---|
| 1200 | ##fixme: arguably a bug that presence of a nodeid implies it can be changed..
|
---|
[634] | 1201 | if ($IPDBacl{$authuser} =~ /c/) {
|
---|
| 1202 | my $nlist = getNodeList($ip_dbh);
|
---|
| 1203 | if ($nodeid) {
|
---|
[530] | 1204 | foreach (@{$nlist}) {
|
---|
[634] | 1205 | $$_{selme} = ($$_{node_id} == $nodeid);
|
---|
[397] | 1206 | }
|
---|
| 1207 | }
|
---|
[634] | 1208 | $page->param(nodelist => $nlist);
|
---|
[397] | 1209 | }
|
---|
| 1210 | ## end node hack
|
---|
[517] | 1211 |
|
---|
[834] | 1212 | # $page->param(vrf => $blockinfo->{vrf});
|
---|
[691] | 1213 | $page->param(vlan => $blockinfo->{vlan});
|
---|
[33] | 1214 |
|
---|
[695] | 1215 | # Reserved-for-expansion
|
---|
| 1216 | $page->param(reserve => $blockinfo->{reserve});
|
---|
| 1217 | $page->param(reserve_id => $blockinfo->{reserve_id});
|
---|
| 1218 | my $newblock = NetAddr::IP->new($cidr->addr, $cidr->masklen - 1)->network;
|
---|
| 1219 | $page->param(newblock => $newblock);
|
---|
| 1220 |
|
---|
[517] | 1221 | # not happy with the upside-down logic, but...
|
---|
[534] | 1222 | $page->param(swipable => $blockinfo->{type} !~ /.i/);
|
---|
[691] | 1223 | $page->param(swip => $blockinfo->{swip} ne 'n') if $blockinfo->{swip};
|
---|
[320] | 1224 |
|
---|
[691] | 1225 | $page->param(circid => $blockinfo->{circuitid});
|
---|
| 1226 | $page->param(desc => $blockinfo->{description});
|
---|
| 1227 | $page->param(notes => $blockinfo->{notes});
|
---|
| 1228 |
|
---|
[284] | 1229 | # Check to see if we can display sensitive data
|
---|
[691] | 1230 | $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
|
---|
[534] | 1231 | $page->param(privdata => $blockinfo->{privdata});
|
---|
[284] | 1232 |
|
---|
[517] | 1233 | # ACL trickery - these two template booleans control the presence of all form/input tags
|
---|
| 1234 | $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
|
---|
| 1235 | $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
|
---|
[4] | 1236 |
|
---|
[702] | 1237 | # Need to find internal knobs to twist to actually vary these. (Ab)use "change" flag for now
|
---|
[789] | 1238 | $page->param(maymerge => ($IPDBacl{$authuser} =~ /m/ && $blockinfo->{type} !~ /^.i$/));
|
---|
| 1239 |
|
---|
[702] | 1240 | if ($IPDBacl{$authuser} =~ /c/ && $blockinfo->{type} !~ /^.i$/) {
|
---|
| 1241 | if ($blockinfo->{type} =~ /^.p$/) {
|
---|
| 1242 | # PPP pools
|
---|
| 1243 | $page->param(maysplit => 1) if $cidr->masklen+1 < $cidr->bits;
|
---|
| 1244 | } elsif ($blockinfo->{type} =~ /.d/) {
|
---|
| 1245 | # Non-PPP pools
|
---|
| 1246 | $page->param(maysplit => 1) if $cidr->masklen+2 < $cidr->bits;
|
---|
| 1247 | } else {
|
---|
| 1248 | # Standard netblocks. Arguably allowing splitting these down to single IPs
|
---|
| 1249 | # doesn't make much sense, but forcing users to apply allocation types
|
---|
| 1250 | # "properly" is worse than herding cats.
|
---|
| 1251 | $page->param(maysplit => 1) if $cidr->masklen < $cidr->bits;
|
---|
| 1252 | }
|
---|
| 1253 | }
|
---|
| 1254 |
|
---|
[4] | 1255 | } # edit()
|
---|
| 1256 |
|
---|
| 1257 |
|
---|
| 1258 | # Stuff new info about a block into the db
|
---|
| 1259 | # action=update
|
---|
| 1260 | sub update {
|
---|
[284] | 1261 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
[517] | 1262 | $aclerr = 'updateblock';
|
---|
[284] | 1263 | return;
|
---|
| 1264 | }
|
---|
[4] | 1265 |
|
---|
[706] | 1266 | # Collect existing block info here, since we need it for the breadcrumb nav
|
---|
| 1267 | my $binfo = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
| 1268 | my $crumbs = getBreadCrumbs($ip_dbh, $binfo->{parent_id});
|
---|
| 1269 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1270 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1271 |
|
---|
[4] | 1272 | # Make sure incoming data is in correct format - custID among other things.
|
---|
[228] | 1273 | return if !validateInput;
|
---|
[4] | 1274 |
|
---|
[536] | 1275 | $webvar{swip} = 'n' if !$webvar{swip};
|
---|
| 1276 |
|
---|
[531] | 1277 | my %updargs = (
|
---|
| 1278 | custid => $webvar{custid},
|
---|
| 1279 | city => $webvar{city},
|
---|
| 1280 | description => $webvar{desc},
|
---|
| 1281 | notes => $webvar{notes},
|
---|
| 1282 | circuitid => $webvar{circid},
|
---|
| 1283 | block => $webvar{block},
|
---|
| 1284 | type => $webvar{alloctype},
|
---|
[536] | 1285 | swip => $webvar{swip},
|
---|
[588] | 1286 | rdns => $webvar{rdns},
|
---|
[691] | 1287 | vrf => $webvar{vrf},
|
---|
| 1288 | vlan => $webvar{vlan},
|
---|
[588] | 1289 | user => $authuser,
|
---|
[531] | 1290 | );
|
---|
| 1291 |
|
---|
[788] | 1292 | # Check to see if user is allowed to do anything with sensitive data
|
---|
| 1293 | if ($IPDBacl{$authuser} =~ /s/) {
|
---|
| 1294 | $updargs{privdata} = $webvar{privdata};
|
---|
[798] | 1295 | for my $bkfield (@IPDB::backupfields) {
|
---|
[788] | 1296 | $updargs{"bk$bkfield"} = $webvar{"bk$bkfield"};
|
---|
| 1297 | }
|
---|
[798] | 1298 | $updargs{backup} = $webvar{backupfields};
|
---|
[788] | 1299 | } else {
|
---|
| 1300 | # If the user doesn't have permissions to monkey with NOC-things, pass
|
---|
| 1301 | # a flag so we don't treat it as "backup data removed"
|
---|
| 1302 | $updargs{ignorebk} = 1;
|
---|
| 1303 | }
|
---|
| 1304 |
|
---|
[531] | 1305 | # Semioptional values
|
---|
| 1306 | $updargs{node} = $webvar{node} if $webvar{node};
|
---|
| 1307 |
|
---|
[677] | 1308 | # collect per-IP rDNS fields. only copy over the ones that actually have something in them.
|
---|
| 1309 | my %iprev;
|
---|
| 1310 | foreach (keys %webvar) {
|
---|
| 1311 | $iprev{$_} = $webvar{$_} if /host_[\d.a-fA-F:]+/ && $webvar{$_};
|
---|
| 1312 | }
|
---|
[531] | 1313 |
|
---|
[830] | 1314 | # and now IPv6
|
---|
| 1315 | ##fixme: how to remove an entry? maybe treat empty host as "delete meeeee!"?
|
---|
| 1316 | if ($webvar{v6list}) {
|
---|
| 1317 | my @v6lines = split /\n/, $webvar{v6list};
|
---|
| 1318 | foreach (@v6lines) {
|
---|
| 1319 | s/^\s+//;
|
---|
| 1320 | s/\s+$//;
|
---|
| 1321 | next if /^$/;
|
---|
| 1322 | my ($ip,$name) = split /,/;
|
---|
| 1323 | $iprev{"host_$ip"} = $name;
|
---|
| 1324 | }
|
---|
| 1325 | }
|
---|
| 1326 |
|
---|
[695] | 1327 | # Merge with reserved freeblock
|
---|
| 1328 | $updargs{fbmerge} = $webvar{expandme} if $webvar{expandme};
|
---|
| 1329 |
|
---|
[677] | 1330 | my ($code,$msg) = updateBlock($ip_dbh, %updargs, iprev => \%iprev);
|
---|
| 1331 |
|
---|
[531] | 1332 | if ($code eq 'FAIL') {
|
---|
[851] | 1333 | syslog "err", "$authuser could not update block/IP $webvar{block} ($binfo->{block}): '$msg'";
|
---|
[787] | 1334 | $page->param(err => "Could not update block/IP $binfo->{block}: $msg");
|
---|
[111] | 1335 | return;
|
---|
[4] | 1336 | }
|
---|
| 1337 |
|
---|
| 1338 | # If we get here, the operation succeeded.
|
---|
[851] | 1339 | syslog "notice", "$authuser updated $webvar{block} ($binfo->{block})";
|
---|
[531] | 1340 | ##fixme: log details of the change? old way is in the .debug stream anyway.
|
---|
[416] | 1341 | ##fixme: need to wedge something in to allow "update:field" notifications
|
---|
| 1342 | ## hmm. how to tell what changed? O_o
|
---|
[787] | 1343 | mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $binfo->{block}",
|
---|
| 1344 | "$binfo->{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
|
---|
[4] | 1345 |
|
---|
[517] | 1346 | ## node hack
|
---|
| 1347 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 1348 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 1349 | $page->param(nodename => $nodename);
|
---|
| 1350 | }
|
---|
| 1351 | ## end node hack
|
---|
| 1352 |
|
---|
[380] | 1353 | # Link back to browse-routed or list-pool page on "Update complete" page.
|
---|
[634] | 1354 | my $pblock = getBlockData($ip_dbh, $binfo->{parent_id});
|
---|
| 1355 | $page->param(backid => $binfo->{parent_id});
|
---|
| 1356 | $page->param(backblock => $pblock->{block});
|
---|
| 1357 | $page->param(backpool => ($webvar{basetype} eq 'i'));
|
---|
[380] | 1358 |
|
---|
[536] | 1359 | # Do some HTML fiddling here instead of using ESCAPE=HTML in the template,
|
---|
| 1360 | # because otherwise we can't convert \n to <br>. *sigh*
|
---|
| 1361 | $webvar{notes} = $q->escapeHTML($webvar{notes}); # escape first...
|
---|
| 1362 | $webvar{notes} =~ s/\n/<br>\n/; # ... then convert newlines
|
---|
| 1363 | $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " ");
|
---|
| 1364 | $webvar{privdata} =~ s/\n/<br>\n/;
|
---|
| 1365 |
|
---|
[765] | 1366 | if ($webvar{expandme}) {
|
---|
| 1367 | # this is fugly but still faster than hitting the DB again with getBlockData()
|
---|
| 1368 | my $tmp = new NetAddr::IP $binfo->{block};
|
---|
| 1369 | my $fb = new NetAddr::IP $binfo->{reserve};
|
---|
| 1370 | my @newblock = $tmp->compact($fb);
|
---|
| 1371 | $page->param(cidr => $newblock[0]);
|
---|
| 1372 | } else {
|
---|
| 1373 | $page->param(cidr => $binfo->{block});
|
---|
| 1374 | }
|
---|
[588] | 1375 | $page->param(rdns => $webvar{rdns});
|
---|
[517] | 1376 | $page->param(city => $webvar{city});
|
---|
| 1377 | $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 1378 | $page->param(custid => $webvar{custid});
|
---|
| 1379 | $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
|
---|
[536] | 1380 | $page->param(circid => $webvar{circid});
|
---|
| 1381 | $page->param(desc => $webvar{desc});
|
---|
| 1382 | $page->param(notes => $webvar{notes});
|
---|
[788] | 1383 | if ($IPDBacl{$authuser} =~ /s/) {
|
---|
| 1384 | $page->param(nocling => 1);
|
---|
| 1385 | $page->param(privdata => $webvar{privdata});
|
---|
[798] | 1386 | if ($webvar{backupfields} && $webvar{backupfields} eq 'on') {
|
---|
| 1387 | $page->param(hasbackup => 1);
|
---|
[800] | 1388 | for my $bkfield (@IPDB::backupfields) {
|
---|
[798] | 1389 | $page->param("bk$bkfield" => $webvar{"bk$bkfield"});
|
---|
[788] | 1390 | }
|
---|
| 1391 | }
|
---|
| 1392 | }
|
---|
[4] | 1393 |
|
---|
| 1394 | } # update()
|
---|
| 1395 |
|
---|
| 1396 |
|
---|
[702] | 1397 | sub prepSplit {
|
---|
| 1398 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
| 1399 | $aclerr = 'splitblock';
|
---|
| 1400 | return;
|
---|
| 1401 | }
|
---|
| 1402 |
|
---|
| 1403 | my $blockinfo = getBlockData($ip_dbh, $webvar{block});
|
---|
| 1404 |
|
---|
[705] | 1405 | # Tree navigation
|
---|
| 1406 | my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
|
---|
| 1407 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1408 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1409 |
|
---|
[702] | 1410 | if ($blockinfo->{type} =~ /^.i$/) {
|
---|
| 1411 | $page->param(err => "Can't split a single IP allocation");
|
---|
| 1412 | return;
|
---|
| 1413 | }
|
---|
| 1414 |
|
---|
| 1415 | # Info about current allocation
|
---|
| 1416 | $page->param(oldblock => $blockinfo->{block});
|
---|
| 1417 | $page->param(block => $webvar{block});
|
---|
| 1418 |
|
---|
| 1419 | # Note that there are probably different rules that should be followed to restrict splitting IPv6 blocks;
|
---|
| 1420 | # strictly speaking it will be exceptionally rare to see smaller than a /64 assigned to a customer, since that
|
---|
| 1421 | # breaks auto-addressing schemes.
|
---|
| 1422 |
|
---|
| 1423 | # Generate possible splits
|
---|
| 1424 | my $block = new NetAddr::IP $blockinfo->{block};
|
---|
| 1425 | my $oldmask = $block->masklen;
|
---|
| 1426 | if ($blockinfo->{type} =~ /^.d$/) {
|
---|
| 1427 | # Non-PPP pools
|
---|
[705] | 1428 | $page->param(ispool => 1);
|
---|
[702] | 1429 | if ($oldmask+2 >= $block->bits) {
|
---|
| 1430 | $page->param(err => "Can't split a standard netblock pool any further");
|
---|
| 1431 | return;
|
---|
| 1432 | }
|
---|
| 1433 | # Allow splitting down to v4 /30 (which results in one usable IP; dubiously useful)
|
---|
| 1434 | $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-2;
|
---|
| 1435 | } elsif ($blockinfo->{type} =~ /.p/) {
|
---|
[705] | 1436 | $page->param(ispool => 1);
|
---|
[702] | 1437 | # Allow splitting PPP pools down to v4 /31
|
---|
| 1438 | $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-1;
|
---|
| 1439 | } else {
|
---|
| 1440 | # Allow splitting all other non-pool netblocks down to single IPs, which...
|
---|
| 1441 | # arguably should be *aggregated* in a pool. Except where they shouldn't.
|
---|
| 1442 | $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits;
|
---|
| 1443 | }
|
---|
| 1444 | # set the split-in-half mask
|
---|
| 1445 | $page->param(sp2mask => $oldmask+1);
|
---|
| 1446 |
|
---|
| 1447 | # Generate possible shrink targets
|
---|
| 1448 | my @keepers = $block->split($block->masklen+1);
|
---|
| 1449 | $page->param(newblockA => $keepers[0]);
|
---|
| 1450 | $page->param(newblockB => $keepers[1]);
|
---|
| 1451 | } # prepSplit()
|
---|
| 1452 |
|
---|
| 1453 |
|
---|
| 1454 | sub doSplit {
|
---|
| 1455 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
| 1456 | $aclerr = 'splitblock';
|
---|
| 1457 | return;
|
---|
| 1458 | }
|
---|
| 1459 |
|
---|
| 1460 | ##fixme: need consistent way to identify "this thing that is this thing" with only the ID
|
---|
| 1461 | # also applies to other locations
|
---|
| 1462 | my $blockinfo = getBlockData($ip_dbh, $webvar{block});
|
---|
| 1463 |
|
---|
[705] | 1464 | # Tree navigation
|
---|
| 1465 | my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
|
---|
| 1466 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1467 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1468 |
|
---|
[702] | 1469 | if ($blockinfo->{type} =~ /^.i$/) {
|
---|
| 1470 | $page->param(err => "Can't split a single IP allocation");
|
---|
| 1471 | return;
|
---|
| 1472 | }
|
---|
| 1473 |
|
---|
| 1474 | if ($webvar{subact} eq 'split') {
|
---|
| 1475 | $page->param(issplit => 1);
|
---|
[705] | 1476 | my $block = new NetAddr::IP $blockinfo->{block};
|
---|
[707] | 1477 | my $newblocks = splitBlock($ip_dbh, id => $webvar{block}, basetype => 'b', newmask => $webvar{split},
|
---|
| 1478 | user => $authuser);
|
---|
[702] | 1479 | if ($newblocks) {
|
---|
| 1480 | $page->param(newblocks => $newblocks);
|
---|
| 1481 | } else {
|
---|
| 1482 | $page->param(err => $IPDB::errstr);
|
---|
| 1483 | }
|
---|
| 1484 |
|
---|
[705] | 1485 | } elsif ($webvar{subact} eq 'shrink') {
|
---|
| 1486 | $page->param(nid => $webvar{block});
|
---|
| 1487 | $page->param(newblock => $webvar{shrink});
|
---|
| 1488 | my $newfree = shrinkBlock($ip_dbh, $webvar{block}, $webvar{shrink});
|
---|
| 1489 | if ($newfree) {
|
---|
| 1490 | $page->param(newfb => $newfree);
|
---|
| 1491 | } else {
|
---|
| 1492 | $page->param(err => $IPDB::errstr);
|
---|
| 1493 | }
|
---|
| 1494 |
|
---|
[702] | 1495 | } else {
|
---|
[705] | 1496 | # Your llama is on fire.
|
---|
| 1497 | $page->param(err => "Missing form field that shouldn't be missing.");
|
---|
| 1498 | return;
|
---|
[702] | 1499 | }
|
---|
[705] | 1500 |
|
---|
| 1501 | # common bits
|
---|
| 1502 | $page->param(cidr => $blockinfo->{block});
|
---|
| 1503 | # and the backlink to the parent container
|
---|
| 1504 | my $pinfo = getBlockData($ip_dbh, $blockinfo->{parent_id});
|
---|
| 1505 | $page->param(backid => $blockinfo->{parent_id});
|
---|
| 1506 | $page->param(backblock => $pinfo->{block});
|
---|
[702] | 1507 | } # doSplit()
|
---|
| 1508 |
|
---|
| 1509 |
|
---|
[717] | 1510 | # Set up for merge
|
---|
| 1511 | sub prepMerge {
|
---|
[789] | 1512 | if ($IPDBacl{$authuser} !~ /m/) {
|
---|
| 1513 | $aclerr = 'mergeblock';
|
---|
| 1514 | return;
|
---|
| 1515 | }
|
---|
| 1516 |
|
---|
[717] | 1517 | my $binfo = getBlockData($ip_dbh, $webvar{block});
|
---|
[760] | 1518 |
|
---|
| 1519 | # Tree navigation
|
---|
| 1520 | my $crumbs = getBreadCrumbs($ip_dbh, $binfo->{parent_id});
|
---|
| 1521 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1522 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1523 |
|
---|
[717] | 1524 | $page->param(block => $webvar{block});
|
---|
| 1525 | $page->param(ispool => $binfo->{type} =~ /.[dp]/);
|
---|
| 1526 | $page->param(ismaster => $binfo->{type} eq 'mm');
|
---|
| 1527 | $page->param(oldblock => $binfo->{block});
|
---|
| 1528 | $page->param(oldtype => $disp_alloctypes{$binfo->{type}});
|
---|
| 1529 | $page->param(typelist => getTypeList($ip_dbh, 'n', $binfo->{type})); # down the rabbit hole we go...
|
---|
| 1530 |
|
---|
[733] | 1531 | # Strings for scope; do this way so we don't have to edit them many places
|
---|
| 1532 | $page->param(vis_keepall => $merge_display{keepall});
|
---|
| 1533 | $page->param(vis_mergepeer => $merge_display{mergepeer});
|
---|
| 1534 | $page->param(vis_clearpeer => $merge_display{clearpeer});
|
---|
| 1535 | $page->param(vis_clearall => $merge_display{clearall});
|
---|
| 1536 |
|
---|
[717] | 1537 | } # prepMerge()
|
---|
| 1538 |
|
---|
| 1539 |
|
---|
[720] | 1540 | # Show what will be merged, present warnings about data loss
|
---|
| 1541 | sub confMerge {
|
---|
[789] | 1542 | if ($IPDBacl{$authuser} !~ /m/) {
|
---|
| 1543 | $aclerr = 'mergeblock';
|
---|
| 1544 | return;
|
---|
| 1545 | }
|
---|
| 1546 |
|
---|
[720] | 1547 | if (!$webvar{newmask} || $webvar{newmask} !~ /^\d+$/) {
|
---|
| 1548 | $page->param(err => 'New netmask required');
|
---|
| 1549 | return;
|
---|
| 1550 | }
|
---|
| 1551 |
|
---|
| 1552 | $page->param(block => $webvar{block});
|
---|
| 1553 | my $binfo = getBlockData($ip_dbh, $webvar{block});
|
---|
| 1554 | my $pinfo = getBlockData($ip_dbh, $binfo->{parent_id});
|
---|
| 1555 | my $minfo = getBlockData($ip_dbh, $binfo->{master_id});
|
---|
| 1556 | my $block = new NetAddr::IP $binfo->{block};
|
---|
| 1557 |
|
---|
| 1558 | # Tree navigation
|
---|
| 1559 | my $crumbs = getBreadCrumbs($ip_dbh, $binfo->{parent_id});
|
---|
| 1560 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1561 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1562 |
|
---|
| 1563 | $page->param(oldblock => $binfo->{block});
|
---|
| 1564 | $page->param(oldtype => $disp_alloctypes{$binfo->{type}});
|
---|
| 1565 | $page->param(ismaster => $binfo->{type} eq 'mm');
|
---|
| 1566 | $page->param(ispool => $webvar{alloctype} =~ /.[dp]/);
|
---|
| 1567 | $page->param(isleaf => $webvar{alloctype} =~ /.[enr]/);
|
---|
| 1568 | $page->param(newtype => $webvar{alloctype});
|
---|
| 1569 | $page->param(newdisptype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 1570 | my $newblock = new NetAddr::IP $block->addr."/$webvar{newmask}";
|
---|
| 1571 | $newblock = $newblock->network;
|
---|
| 1572 | $page->param(newmask => $webvar{newmask});
|
---|
| 1573 | $page->param(newblock => "$newblock");
|
---|
| 1574 |
|
---|
| 1575 | # get list of allocations and freeblocks to be merged
|
---|
| 1576 | my $malloc_list = listForMerge($ip_dbh, $binfo->{parent_id}, $newblock, 'a');
|
---|
| 1577 | $page->param(mergealloc => $malloc_list);
|
---|
| 1578 |
|
---|
[733] | 1579 | $page->param(vis_scope => $merge_display{$webvar{scope}});
|
---|
[727] | 1580 | $page->param(scope => $webvar{scope});
|
---|
[720] | 1581 | } # confMerge()
|
---|
| 1582 |
|
---|
| 1583 |
|
---|
[751] | 1584 | # Make it so
|
---|
| 1585 | sub doMerge {
|
---|
[789] | 1586 | if ($IPDBacl{$authuser} !~ /m/) {
|
---|
| 1587 | $aclerr = 'mergeblock';
|
---|
| 1588 | return;
|
---|
| 1589 | }
|
---|
| 1590 |
|
---|
[751] | 1591 | if (!$webvar{newmask} || $webvar{newmask} !~ /^\d+$/) {
|
---|
| 1592 | $page->param(err => 'New netmask required');
|
---|
| 1593 | return;
|
---|
| 1594 | }
|
---|
| 1595 |
|
---|
| 1596 | $page->param(block => $webvar{block});
|
---|
| 1597 | my $binfo = getBlockData($ip_dbh, $webvar{block});
|
---|
| 1598 | my $pinfo = getBlockData($ip_dbh, $binfo->{parent_id});
|
---|
| 1599 | my $block = new NetAddr::IP $binfo->{block};
|
---|
| 1600 |
|
---|
| 1601 | # Tree navigation
|
---|
| 1602 | my $crumbs = getBreadCrumbs($ip_dbh, $binfo->{parent_id});
|
---|
| 1603 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1604 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1605 |
|
---|
| 1606 | $page->param(oldblock => $binfo->{block});
|
---|
| 1607 | $page->param(oldtype => $disp_alloctypes{$binfo->{type}});
|
---|
| 1608 | $page->param(newdisptype => $disp_alloctypes{$webvar{newtype}});
|
---|
| 1609 | my $newblock = new NetAddr::IP $block->addr."/$webvar{newmask}";
|
---|
| 1610 | $newblock = $newblock->network;
|
---|
| 1611 | $page->param(newblock => $newblock);
|
---|
| 1612 | $page->param(vis_scope => $merge_display{$webvar{scope}});
|
---|
| 1613 |
|
---|
| 1614 | my $mlist = mergeBlocks($ip_dbh, $webvar{block}, %webvar, user => $authuser);
|
---|
| 1615 |
|
---|
| 1616 | if ($mlist) {
|
---|
| 1617 | #(newtype => $webvar{newtype}, newmask => $webvar{newmask}));
|
---|
| 1618 | # Slice off first entry (the new parent - note this may be a new allocation,
|
---|
| 1619 | # not the same ID that was "merged"!
|
---|
| 1620 | my $parent = shift @$mlist;
|
---|
| 1621 | $page->param(backpool => $webvar{newtype} =~ /.[dp]/);
|
---|
| 1622 | if ($webvar{newtype} =~ /.[enr]/) {
|
---|
| 1623 | $page->param(backleaf => 1);
|
---|
| 1624 | $page->param(backid => $binfo->{parent_id});
|
---|
| 1625 | $page->param(backblock => $pinfo->{block});
|
---|
| 1626 | } else {
|
---|
| 1627 | $page->param(backid => $parent->{id});
|
---|
| 1628 | $page->param(backblock => $parent->{block});
|
---|
| 1629 | }
|
---|
| 1630 | $page->param(mergelist => $mlist);
|
---|
| 1631 | } else {
|
---|
| 1632 | $page->param(err => "Merge failed: $IPDB::errstr");
|
---|
| 1633 | }
|
---|
| 1634 | } # doMerge()
|
---|
| 1635 |
|
---|
| 1636 |
|
---|
[4] | 1637 | # Delete an allocation.
|
---|
[106] | 1638 | sub remove {
|
---|
[233] | 1639 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 1640 | $aclerr = 'delblock';
|
---|
[233] | 1641 | return;
|
---|
| 1642 | }
|
---|
| 1643 |
|
---|
[4] | 1644 | # Serves'em right for getting here...
|
---|
| 1645 | if (!defined($webvar{block})) {
|
---|
[517] | 1646 | $page->param(err => "Can't delete a block that doesn't exist");
|
---|
[111] | 1647 | return;
|
---|
[4] | 1648 | }
|
---|
| 1649 |
|
---|
[538] | 1650 | my $blockdata;
|
---|
[638] | 1651 | $blockdata = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
[4] | 1652 |
|
---|
[765] | 1653 | # Tree navigation
|
---|
| 1654 | my $crumbs = getBreadCrumbs($ip_dbh, $blockdata->{parent_id});
|
---|
| 1655 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1656 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1657 |
|
---|
[638] | 1658 | if ($blockdata->{parent_id} == 0) { # $webvar{alloctype} eq 'mm'
|
---|
[538] | 1659 | $blockdata->{city} = "N/A";
|
---|
| 1660 | $blockdata->{custid} = "N/A";
|
---|
| 1661 | $blockdata->{circuitid} = "N/A";
|
---|
| 1662 | $blockdata->{description} = "N/A";
|
---|
| 1663 | $blockdata->{notes} = "N/A";
|
---|
| 1664 | $blockdata->{privdata} = "N/A";
|
---|
[638] | 1665 | } # end cases for different alloctypes
|
---|
[517] | 1666 |
|
---|
[638] | 1667 | $page->param(blockid => $webvar{block});
|
---|
| 1668 | $page->param(basetype => $webvar{basetype});
|
---|
[4] | 1669 |
|
---|
[538] | 1670 | $page->param(block => $blockdata->{block});
|
---|
[589] | 1671 | $page->param(rdns => $blockdata->{rdns});
|
---|
| 1672 |
|
---|
| 1673 | # maybe need to apply more magic here?
|
---|
| 1674 | # most allocations we *do* want to autodelete the forward as well as reverse; for a handful we don't.
|
---|
| 1675 | # -> all real blocks (nb: pool IPs need extra handling)
|
---|
| 1676 | # -> NOC/private-IP (how to ID?)
|
---|
| 1677 | # -> anything with a pattern matching $IPDB::domain?
|
---|
| 1678 | if ($blockdata->{type} !~ /^.i$/) {
|
---|
| 1679 | $page->param(autodel => 1);
|
---|
| 1680 | }
|
---|
| 1681 |
|
---|
[538] | 1682 | $page->param(disptype => $disp_alloctypes{$blockdata->{type}});
|
---|
| 1683 | $page->param(city => $blockdata->{city});
|
---|
| 1684 | $page->param(custid => $blockdata->{custid});
|
---|
| 1685 | $page->param(circid => $blockdata->{circuitid});
|
---|
| 1686 | $page->param(desc => $blockdata->{description});
|
---|
| 1687 | $blockdata->{notes} = $q->escapeHTML($blockdata->{notes});
|
---|
| 1688 | $blockdata->{notes} =~ s/\n/<br>\n/;
|
---|
| 1689 | $page->param(notes => $blockdata->{notes});
|
---|
| 1690 | $blockdata->{privdata} = $q->escapeHTML($blockdata->{privdata});
|
---|
[540] | 1691 | $blockdata->{privdata} = ' ' if !$blockdata->{privdata};
|
---|
[538] | 1692 | $blockdata->{privdata} =~ s/\n/<br>\n/;
|
---|
| 1693 | $page->param(privdata => $blockdata->{privdata}) if $IPDBacl{$authuser} =~ /s/;
|
---|
| 1694 | $page->param(delpool => $blockdata->{type} =~ /^.[pd]$/);
|
---|
[4] | 1695 |
|
---|
[517] | 1696 | } # end remove()
|
---|
[4] | 1697 |
|
---|
| 1698 |
|
---|
| 1699 | # Delete an allocation. Return it to the freeblocks table; munge
|
---|
| 1700 | # data as necessary to keep as few records as possible in freeblocks
|
---|
| 1701 | # to prevent weirdness when allocating blocks later.
|
---|
| 1702 | # Remove IPs from pool listing if necessary
|
---|
| 1703 | sub finalDelete {
|
---|
[233] | 1704 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 1705 | $aclerr = 'delblock';
|
---|
[233] | 1706 | return;
|
---|
| 1707 | }
|
---|
[4] | 1708 |
|
---|
[370] | 1709 | # need to retrieve block data before deleting so we can notify on that
|
---|
[638] | 1710 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
| 1711 | my $pinfo = getBlockData($ip_dbh, $blockinfo->{parent_id}, 'b');
|
---|
[370] | 1712 |
|
---|
[765] | 1713 | # Tree navigation
|
---|
| 1714 | my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
|
---|
| 1715 | my @rcrumbs = reverse (@$crumbs);
|
---|
| 1716 | $utilbar->param(breadcrumb => \@rcrumbs);
|
---|
| 1717 |
|
---|
[638] | 1718 | my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{basetype}, $webvar{delforward}, $authuser);
|
---|
[4] | 1719 |
|
---|
[638] | 1720 | $page->param(block => $blockinfo->{block});
|
---|
[651] | 1721 | $page->param(bdisp => $q->escapeHTML($disp_alloctypes{$blockinfo->{type}}));
|
---|
[766] | 1722 | $page->param(delparent_id => $blockinfo->{parent_id});
|
---|
[651] | 1723 | if ($pinfo) {
|
---|
| 1724 | $page->param(delparent => $pinfo->{block});
|
---|
| 1725 | $page->param(pdisp => $q->escapeHTML($disp_alloctypes{$pinfo->{type}}));
|
---|
| 1726 | }
|
---|
[638] | 1727 | $page->param(returnpool => ($webvar{basetype} eq 'i') );
|
---|
[591] | 1728 | if ($code =~ /^WARN(POOL|MERGE)/) {
|
---|
[638] | 1729 | my ($pid,$pcidr) = split /,/, $msg;
|
---|
[654] | 1730 | my $real_pinfo = getBlockData($ip_dbh, $pid, 'b');
|
---|
[638] | 1731 | $page->param(parent_id => $pid);
|
---|
| 1732 | $page->param(parent => $pcidr);
|
---|
[654] | 1733 | $page->param(real_disp => $q->escapeHTML($disp_alloctypes{$real_pinfo->{type}}));
|
---|
[577] | 1734 | $page->param(mergeip => $code eq 'WARNPOOL');
|
---|
| 1735 | }
|
---|
[591] | 1736 | if ($code eq 'WARN') {
|
---|
| 1737 | $msg =~ s/\n/<br>\n/g;
|
---|
| 1738 | $page->param(genwarn => $msg);
|
---|
| 1739 | }
|
---|
[577] | 1740 | if ($code eq 'OK' || $code =~ /^WARN/) {
|
---|
[851] | 1741 | syslog "notice", "$authuser deallocated '".$blockinfo->{type}."'-type netblock ID $webvar{block} ".
|
---|
| 1742 | "($blockinfo->{block}), $blockinfo->{custid}, $blockinfo->{city}, desc='$blockinfo->{description}'";
|
---|
| 1743 | mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$blockinfo->{type}} $blockinfo->{block}",
|
---|
| 1744 | # $webvar{block} useful? do we care about the block ID here?
|
---|
| 1745 | "$disp_alloctypes{$blockinfo->{type}} $blockinfo->{block} deallocated by $authuser\n".
|
---|
| 1746 | "CustID: $blockinfo->{custid}\nCity: $blockinfo->{city}\n".
|
---|
| 1747 | "Description: $blockinfo->{description}\n");
|
---|
[106] | 1748 | } else {
|
---|
[517] | 1749 | $page->param(failmsg => $msg);
|
---|
[106] | 1750 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
[851] | 1751 | syslog "err", "$authuser could not deallocate static IP $webvar{block} ($blockinfo->{block}): '$msg'";
|
---|
[106] | 1752 | } else {
|
---|
[851] | 1753 | syslog "err", "$authuser could not deallocate netblock $webvar{block} ($blockinfo->{block}): '$msg'";
|
---|
[517] | 1754 | $page->param(netblock => 1);
|
---|
[4] | 1755 | }
|
---|
[106] | 1756 | }
|
---|
[4] | 1757 |
|
---|
| 1758 | } # finalDelete
|
---|