[4] | 1 | #!/usr/bin/perl
|
---|
| 2 | # ipdb/cgi-bin/main.cgi
|
---|
[8] | 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2014-10-08 17:07:05 +0000 (Wed, 08 Oct 2014) $
|
---|
| 6 | # SVN revision $Rev: 624 $
|
---|
| 7 | # Last update by $Author: kdeugau $
|
---|
| 8 | ###
|
---|
[417] | 9 | # Copyright (C) 2004-2010 - 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
|
---|
| 72 | $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
|
---|
[233] | 73 |
|
---|
[517] | 74 | my $header = HTML::Template->new(filename => "header.tmpl");
|
---|
| 75 | my $footer = HTML::Template->new(filename => "footer.tmpl");
|
---|
[233] | 76 |
|
---|
[517] | 77 | $header->param(version => $IPDB::VERSION);
|
---|
| 78 | $header->param(addperm => $IPDBacl{$authuser} =~ /a/);
|
---|
| 79 | $header->param(webpath => $IPDB::webpath);
|
---|
| 80 | print "Content-type: text/html\n\n", $header->output;
|
---|
[4] | 81 |
|
---|
| 82 |
|
---|
| 83 | #main()
|
---|
[517] | 84 | my $aclerr;
|
---|
[4] | 85 |
|
---|
| 86 | if(!defined($webvar{action})) {
|
---|
[517] | 87 | $webvar{action} = "index"; #shuts up the warnings.
|
---|
[4] | 88 | }
|
---|
| 89 |
|
---|
[517] | 90 | my $page;
|
---|
| 91 | if (-e "$ENV{HTML_TEMPLATE_ROOT}/$webvar{action}.tmpl") {
|
---|
[553] | 92 | $page = HTML::Template->new(filename => "$webvar{action}.tmpl", loop_context_vars => 1, global_vars => 1);
|
---|
[517] | 93 | } else {
|
---|
| 94 | $page = HTML::Template->new(filename => "dunno.tmpl");
|
---|
| 95 | }
|
---|
| 96 |
|
---|
[4] | 97 | if($webvar{action} eq 'index') {
|
---|
| 98 | showSummary();
|
---|
[233] | 99 | } elsif ($webvar{action} eq 'addmaster') {
|
---|
| 100 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 101 | $aclerr = 'addmaster';
|
---|
[233] | 102 | }
|
---|
[582] | 103 |
|
---|
| 104 | # Retrieve the list of DNS locations if we've got a place to grab them from
|
---|
| 105 | if ($IPDB::rpc_url) {
|
---|
| 106 |
|
---|
| 107 | my %rpcargs = (
|
---|
| 108 | rpcuser => $authuser,
|
---|
| 109 | group => 1, # bleh
|
---|
| 110 | defloc => '',
|
---|
| 111 | );
|
---|
[623] | 112 | my $result = IPDB::_rpc('getLocDropdown', %rpcargs);
|
---|
[582] | 113 | $page->param(loclist => $result);
|
---|
| 114 | }
|
---|
| 115 |
|
---|
[4] | 116 | } elsif ($webvar{action} eq 'newmaster') {
|
---|
| 117 |
|
---|
[233] | 118 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 119 | $aclerr = 'addmaster';
|
---|
[233] | 120 | } else {
|
---|
| 121 | my $cidr = new NetAddr::IP $webvar{cidr};
|
---|
[517] | 122 | $page->param(cidr => "$cidr");
|
---|
[4] | 123 |
|
---|
[582] | 124 | my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}, (vrf => $webvar{vrf}, rdns => $webvar{rdns},
|
---|
| 125 | rwhois => $webvar{rwhois}, defloc => $webvar{loc}, user => $authuser) );
|
---|
[4] | 126 |
|
---|
[371] | 127 | if ($code eq 'FAIL') {
|
---|
[320] | 128 | syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
|
---|
[517] | 129 | $page->param(err => $msg);
|
---|
[233] | 130 | } else {
|
---|
[624] | 131 | $page->param(parent => $msg);
|
---|
[582] | 132 | if ($code eq 'WARN') {
|
---|
[624] | 133 | $IPDB::errstr =~ s/\n\n/<br>\n/g;
|
---|
| 134 | $IPDB::errstr =~ s/:\n/:<br>\n/g;
|
---|
| 135 | $page->param(warn => $IPDB::errstr);
|
---|
[582] | 136 | }
|
---|
[233] | 137 | syslog "info", "$authuser added master block $webvar{cidr}";
|
---|
| 138 | }
|
---|
[4] | 139 |
|
---|
[233] | 140 | } # ACL check
|
---|
| 141 |
|
---|
[4] | 142 | } # end add new master
|
---|
| 143 |
|
---|
[567] | 144 | elsif ($webvar{action} eq 'showsubs') {
|
---|
| 145 | showSubs();
|
---|
| 146 | }
|
---|
| 147 |
|
---|
[4] | 148 | elsif($webvar{action} eq 'listpool') {
|
---|
[528] | 149 | showPool();
|
---|
[4] | 150 | }
|
---|
| 151 |
|
---|
| 152 | # Not modified or added; just shuffled
|
---|
| 153 | elsif($webvar{action} eq 'assign') {
|
---|
| 154 | assignBlock();
|
---|
| 155 | }
|
---|
| 156 | elsif($webvar{action} eq 'confirm') {
|
---|
| 157 | confirmAssign();
|
---|
| 158 | }
|
---|
| 159 | elsif($webvar{action} eq 'insert') {
|
---|
| 160 | insertAssign();
|
---|
| 161 | }
|
---|
| 162 | elsif($webvar{action} eq 'edit') {
|
---|
| 163 | edit();
|
---|
| 164 | }
|
---|
| 165 | elsif($webvar{action} eq 'update') {
|
---|
| 166 | update();
|
---|
| 167 | }
|
---|
| 168 | elsif($webvar{action} eq 'delete') {
|
---|
| 169 | remove();
|
---|
| 170 | }
|
---|
| 171 | elsif($webvar{action} eq 'finaldelete') {
|
---|
| 172 | finalDelete();
|
---|
| 173 | }
|
---|
[397] | 174 | elsif ($webvar{action} eq 'nodesearch') {
|
---|
[519] | 175 | my $nodelist = getNodeList($ip_dbh);
|
---|
| 176 | $page->param(nodelist => $nodelist);
|
---|
[517] | 177 | }
|
---|
[397] | 178 |
|
---|
[517] | 179 | # DB failure. Can't do much here, really.
|
---|
| 180 | elsif ($webvar{action} eq 'dberr') {
|
---|
| 181 | $page->param(errmsg => $errstr);
|
---|
[397] | 182 | }
|
---|
| 183 |
|
---|
[517] | 184 | # Default is an error. It shouldn't be possible to get here unless you're
|
---|
| 185 | # randomly feeding in values for webvar{action}.
|
---|
[4] | 186 | else {
|
---|
| 187 | my $rnd = rand 500;
|
---|
| 188 | my $boing = sprintf("%.2f", rand 500);
|
---|
[517] | 189 | my @excuses = (
|
---|
| 190 | "Aether cloudy. Ask again later about $webvar{action}.",
|
---|
| 191 | "The gods are unhappy with your sacrificial $webvar{action}.",
|
---|
| 192 | "Because one of $webvar{action}'s legs are both the same",
|
---|
| 193 | "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!",
|
---|
| 194 | "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....",
|
---|
| 195 | "I ain't done $webvar{action}",
|
---|
| 196 | "Oooo, look! A flying $webvar{action}!",
|
---|
| 197 | "$webvar{action} too evil, avoiding.",
|
---|
| 198 | "Rocks fall, $webvar{action} dies.",
|
---|
| 199 | "Bit bucket must be emptied before I can $webvar{action}..."
|
---|
| 200 | );
|
---|
| 201 | $page->param(dunno => $excuses[$rnd/50.0]);
|
---|
[4] | 202 | }
|
---|
[111] | 203 | ## Finally! Done with that NASTY "case" emulation!
|
---|
[4] | 204 |
|
---|
| 205 |
|
---|
[517] | 206 | # Switch to a different template if we've tripped on an ACL error.
|
---|
| 207 | # Note that this should only be exercised in development, when
|
---|
| 208 | # deeplinked, or when being attacked; normal ACL handling should
|
---|
| 209 | # remove the links a user is not allowed to click on.
|
---|
| 210 | if ($aclerr) {
|
---|
| 211 | $page = HTML::Template->new(filename => "aclerror.tmpl");
|
---|
| 212 | $page->param(ipdbfunc => $aclmsg{$aclerr});
|
---|
| 213 | }
|
---|
[4] | 214 |
|
---|
[106] | 215 | # Clean up IPDB globals, DB handle, etc.
|
---|
[111] | 216 | finish($ip_dbh);
|
---|
[199] | 217 |
|
---|
[517] | 218 | ## Do all our printing here so we can generate errors and stick them into the slots in the templates.
|
---|
[199] | 219 |
|
---|
[517] | 220 | # can't do this yet, too many blowups
|
---|
| 221 | #print "Content-type: text/html\n\n", $header->output;
|
---|
| 222 | $page->param(webpath => $IPDB::webpath);
|
---|
| 223 | print $page->output;
|
---|
| 224 |
|
---|
| 225 | # include the admin tools link in the output?
|
---|
| 226 | $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
|
---|
| 227 | $footer->param(webpath => $IPDB::webpath);
|
---|
| 228 | print $footer->output;
|
---|
| 229 |
|
---|
[106] | 230 | # Just in case something waaaayyy down isn't in place
|
---|
| 231 | # properly... we exit explicitly.
|
---|
[517] | 232 | exit 0;
|
---|
[4] | 233 |
|
---|
| 234 |
|
---|
| 235 | # Initial display: Show master blocks with total allocated subnets, total free subnets
|
---|
[118] | 236 | sub showSummary {
|
---|
[523] | 237 | my $masterlist = listSummary($ip_dbh);
|
---|
| 238 | $page->param(masterlist => $masterlist);
|
---|
[106] | 239 |
|
---|
[517] | 240 | $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
|
---|
[4] | 241 | } # showSummary
|
---|
| 242 |
|
---|
| 243 |
|
---|
[566] | 244 | # Display blocks immediately within a given parent
|
---|
| 245 | sub showSubs {
|
---|
| 246 | $page->param(block => $webvar{block});
|
---|
| 247 | $page->param(mayadd => ($IPDBacl{$authuser} =~ /a/));
|
---|
| 248 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/));
|
---|
[4] | 249 |
|
---|
[566] | 250 | my $sublist = listSubs($ip_dbh, block => $webvar{block}, rdepth => $webvar{rdepth});
|
---|
| 251 | $page->param(deldepth => $webvar{rdepth} - 1);
|
---|
| 252 | $page->param(rdepth => $webvar{rdepth});
|
---|
| 253 | $page->param(subdepth => $webvar{rdepth} + 1);
|
---|
| 254 | $page->param(sublist => $sublist);
|
---|
[4] | 255 |
|
---|
[566] | 256 | my $flist = listFree($ip_dbh, master => $webvar{block}, rdepth => $webvar{rdepth});
|
---|
| 257 | $page->param(freelist => $flist);
|
---|
| 258 | } # showSubs
|
---|
[4] | 259 |
|
---|
| 260 |
|
---|
| 261 | # List the IPs used in a pool
|
---|
[528] | 262 | sub showPool {
|
---|
[4] | 263 |
|
---|
| 264 | my $cidr = new NetAddr::IP $webvar{pool};
|
---|
| 265 |
|
---|
[517] | 266 | $page->param(block => $webvar{pool});
|
---|
| 267 | $page->param(netip => $cidr->addr);
|
---|
| 268 | $cidr++;
|
---|
| 269 | $page->param(gate => $cidr->addr);
|
---|
| 270 | $cidr--; $cidr--;
|
---|
| 271 | $page->param(bcast => $cidr->addr);
|
---|
| 272 | $page->param(mask => $cidr->mask);
|
---|
[157] | 273 |
|
---|
[4] | 274 | # Snag pool info for heading
|
---|
[570] | 275 | my $poolinfo = getBlockData($ip_dbh, $webvar{pool}, $webvar{rdepth});
|
---|
[4] | 276 |
|
---|
[528] | 277 | $page->param(disptype => $disp_alloctypes{$poolinfo->{type}});
|
---|
| 278 | $page->param(city => $poolinfo->{city});
|
---|
[517] | 279 |
|
---|
[157] | 280 | # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
|
---|
[528] | 281 | $page->param(realblock => $poolinfo->{type} =~ /^.d$/);
|
---|
[4] | 282 |
|
---|
| 283 | # probably have to add an "edit IP allocation" link here somewhere.
|
---|
| 284 |
|
---|
[528] | 285 | my $plist = listPool($ip_dbh, $webvar{pool});
|
---|
| 286 | # technically slightly more efficient to check the ACL in an if () once outside the foreach
|
---|
| 287 | foreach (@{$plist}) {
|
---|
| 288 | $$_{maydel} = $IPDBacl{$authuser} =~ /d/;
|
---|
[4] | 289 | }
|
---|
[528] | 290 | $page->param(poolips => $plist);
|
---|
| 291 | } # end showPool
|
---|
[4] | 292 |
|
---|
| 293 |
|
---|
[106] | 294 | # Show "Add new allocation" page. Note that the actual page may
|
---|
| 295 | # be one of two templates, and the lists come from the database.
|
---|
[4] | 296 | sub assignBlock {
|
---|
| 297 |
|
---|
[233] | 298 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 299 | $aclerr = 'addblock';
|
---|
[233] | 300 | return;
|
---|
| 301 | }
|
---|
| 302 |
|
---|
[517] | 303 | # hack pthbttt eww
|
---|
| 304 | $webvar{block} = '' if !$webvar{block};
|
---|
[21] | 305 |
|
---|
[517] | 306 | # hmm. TMPL_IF block and TMPL_ELSE block on these instead?
|
---|
| 307 | $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
|
---|
| 308 | $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
|
---|
[575] | 309 | $page->param(allocfrom => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
|
---|
[517] | 310 |
|
---|
[21] | 311 | if ($webvar{block} ne '') {
|
---|
[575] | 312 |
|
---|
| 313 | # Common case, according to reported usage. Block to assign is specified.
|
---|
[21] | 314 | my $block = new NetAddr::IP $webvar{block};
|
---|
[575] | 315 | $page->param(rdepth => $webvar{rdepth});
|
---|
[187] | 316 |
|
---|
[585] | 317 | my $rdns = getBlockRDNS($ip_dbh, $webvar{block}, $webvar{rdepth}, vrf => $webvar{vrf}, user => $authuser);
|
---|
| 318 | $page->param(rdns => $rdns) if $rdns;
|
---|
| 319 |
|
---|
[575] | 320 | $webvar{fbtype} = '' if !$webvar{fbtype};
|
---|
| 321 | if ($webvar{fbtype} eq 'i') {
|
---|
| 322 | my $ipinfo = getBlockData($ip_dbh, $block);
|
---|
| 323 | $page->param(
|
---|
| 324 | fbip => 1,
|
---|
| 325 | block => $block,
|
---|
| 326 | fbdisptype => $list_alloctypes{$ipinfo->{type}},
|
---|
| 327 | type => $ipinfo->{type},
|
---|
| 328 | allocfrom => $ipinfo->{pool},
|
---|
| 329 | );
|
---|
[187] | 330 | } else {
|
---|
[529] | 331 | # get "primary" alloctypes, since these are all that can correctly be assigned if we're in this branch
|
---|
[575] | 332 | my $tlist = getTypeList($ip_dbh, 'n');
|
---|
[529] | 333 | $tlist->[0]->{sel} = 1;
|
---|
[575] | 334 | $page->param(typelist => $tlist, block => $block);
|
---|
[106] | 335 | }
|
---|
[575] | 336 |
|
---|
[21] | 337 | } else {
|
---|
[575] | 338 |
|
---|
| 339 | # Uncommon case, according to reported usage. Block to assign needs to be found based on criteria.
|
---|
[541] | 340 | my $mlist = getMasterList($ip_dbh, 'c');
|
---|
| 341 | $page->param(masterlist => $mlist);
|
---|
[517] | 342 |
|
---|
| 343 | my @pops;
|
---|
[92] | 344 | foreach my $pop (@poplist) {
|
---|
[517] | 345 | my %row = (pop => $pop);
|
---|
| 346 | push (@pops, \%row);
|
---|
[92] | 347 | }
|
---|
[517] | 348 | $page->param(pops => \@pops);
|
---|
| 349 |
|
---|
[529] | 350 | # get all standard alloctypes
|
---|
| 351 | my $tlist = getTypeList($ip_dbh, 'a');
|
---|
| 352 | $tlist->[0]->{sel} = 1;
|
---|
| 353 | $page->param(typelist => $tlist);
|
---|
[21] | 354 | }
|
---|
[517] | 355 |
|
---|
| 356 | my @cities;
|
---|
[92] | 357 | foreach my $city (@citylist) {
|
---|
[517] | 358 | my %row = (city => $city);
|
---|
| 359 | push (@cities, \%row);
|
---|
[92] | 360 | }
|
---|
[517] | 361 | $page->param(citylist => \@cities);
|
---|
[4] | 362 |
|
---|
[397] | 363 | ## node hack
|
---|
[530] | 364 | my $nlist = getNodeList($ip_dbh);
|
---|
| 365 | $page->param(nodelist => $nlist);
|
---|
[397] | 366 | ## end node hack
|
---|
| 367 |
|
---|
[517] | 368 | $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
|
---|
[284] | 369 |
|
---|
[4] | 370 | } # assignBlock
|
---|
| 371 |
|
---|
| 372 |
|
---|
| 373 | # Take info on requested IP assignment and see what we can provide.
|
---|
| 374 | sub confirmAssign {
|
---|
[233] | 375 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 376 | $aclerr = 'addblock';
|
---|
[233] | 377 | return;
|
---|
| 378 | }
|
---|
[4] | 379 |
|
---|
| 380 | my $cidr;
|
---|
| 381 | my $alloc_from;
|
---|
| 382 |
|
---|
| 383 | # Going to manually validate some items.
|
---|
| 384 | # custid and city are automagic.
|
---|
[111] | 385 | return if !validateInput();
|
---|
[4] | 386 |
|
---|
| 387 | # Several different cases here.
|
---|
| 388 | # Static IP vs netblock
|
---|
| 389 | # + Different flavours of static IP
|
---|
| 390 | # + Different flavours of netblock
|
---|
| 391 |
|
---|
[575] | 392 | if ($webvar{alloctype} =~ /^.i$/ && $webvar{fbassign} ne 'y') {
|
---|
[532] | 393 | my $plist = getPoolSelect($ip_dbh, $webvar{alloctype}, $webvar{pop});
|
---|
[517] | 394 | $page->param(staticip => 1);
|
---|
[532] | 395 | $page->param(poollist => $plist) if $plist;
|
---|
[4] | 396 | $cidr = "Single static IP";
|
---|
[517] | 397 | ##fixme: need to handle "no available pools"
|
---|
[4] | 398 |
|
---|
| 399 | } else { # end show pool options
|
---|
[21] | 400 |
|
---|
[533] | 401 | if ($webvar{fbassign} && $webvar{fbassign} eq 'y') {
|
---|
[21] | 402 | $cidr = new NetAddr::IP $webvar{block};
|
---|
[575] | 403 | $alloc_from = new NetAddr::IP $webvar{allocfrom};
|
---|
[21] | 404 | $webvar{maskbits} = $cidr->masklen;
|
---|
| 405 | } else { # done with direct freeblocks assignment
|
---|
| 406 |
|
---|
| 407 | if (!$webvar{maskbits}) {
|
---|
[517] | 408 | $page->param(err => "Please specify a CIDR mask length.");
|
---|
[111] | 409 | return;
|
---|
[21] | 410 | }
|
---|
[533] | 411 |
|
---|
| 412 | ##fixme ick, ew, bleh. gotta handle the failure message generation better. push it into findAllocateFrom()?
|
---|
| 413 | my $failmsg = "No suitable free block found.<br>\n";
|
---|
[187] | 414 | if ($webvar{alloctype} eq 'rm') {
|
---|
[533] | 415 | $failmsg .= "We do not have a free routeable block of that size.<br>\n".
|
---|
| 416 | "You will have to either route a set of smaller netblocks or a single smaller netblock.";
|
---|
[4] | 417 | } else {
|
---|
[214] | 418 | if ($webvar{alloctype} =~ /^.[pc]$/) {
|
---|
[533] | 419 | $failmsg .= "You will have to route another superblock from one of the<br>\n".
|
---|
| 420 | "master blocks or chose a smaller block size for the pool.";
|
---|
[21] | 421 | } else {
|
---|
[517] | 422 | if (!$webvar{pop}) {
|
---|
| 423 | $page->param(err => 'Please select a POP to route the block from/through.');
|
---|
| 424 | return;
|
---|
| 425 | }
|
---|
[533] | 426 | $failmsg .= "You will have to route another superblock to $webvar{pop}<br>\n".
|
---|
| 427 | "from one of the master blocks or chose a smaller blocksize.";
|
---|
[21] | 428 | }
|
---|
[4] | 429 | }
|
---|
[533] | 430 |
|
---|
[575] | 431 | ## fixme: add rdepth?
|
---|
| 432 | ($cidr,$webvar{rdepth}) = findAllocateFrom($ip_dbh, $webvar{maskbits}, $webvar{alloctype}, $webvar{city},
|
---|
| 433 | $webvar{pop}, (master => $webvar{allocfrom}, allowpriv => $webvar{allowpriv}) );
|
---|
[533] | 434 | if (!$cidr) {
|
---|
[517] | 435 | $page->param(err => $failmsg);
|
---|
[111] | 436 | return;
|
---|
[21] | 437 | }
|
---|
[533] | 438 | $cidr = new NetAddr::IP $cidr;
|
---|
[575] | 439 |
|
---|
| 440 | # this chunk now specific to "guided" allocation; freeblock-select can now slice-n-dice on its own.
|
---|
| 441 | $alloc_from = "$cidr";
|
---|
| 442 | # If the block to be allocated is smaller than the one we found,
|
---|
| 443 | # figure out the "real" block to be allocated.
|
---|
| 444 | if ($cidr->masklen() ne $webvar{maskbits}) {
|
---|
| 445 | my $maskbits = $cidr->masklen();
|
---|
| 446 | my @subblocks;
|
---|
| 447 | while ($maskbits++ < $webvar{maskbits}) {
|
---|
| 448 | @subblocks = $cidr->split($maskbits);
|
---|
| 449 | }
|
---|
| 450 | $cidr = $subblocks[0];
|
---|
| 451 | }
|
---|
[21] | 452 | } # check for freeblocks assignment or IPDB-controlled assignment
|
---|
[4] | 453 |
|
---|
[157] | 454 | } # if ($webvar{alloctype} =~ /^.i$/)
|
---|
[4] | 455 |
|
---|
[397] | 456 | ## node hack
|
---|
| 457 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 458 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 459 | $page->param(nodename => $nodename);
|
---|
| 460 | $page->param(nodeid => $webvar{node});
|
---|
[397] | 461 | }
|
---|
| 462 | ## end node hack
|
---|
| 463 |
|
---|
[4] | 464 | # Stick in the allocation data
|
---|
[517] | 465 | $page->param(alloc_type => $webvar{alloctype});
|
---|
| 466 | $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
|
---|
| 467 | $page->param(alloc_from => $alloc_from);
|
---|
[575] | 468 | $page->param(rdepth => $webvar{rdepth});
|
---|
[517] | 469 | $page->param(cidr => $cidr);
|
---|
[585] | 470 | $page->param(rdns => $webvar{rdns});
|
---|
[517] | 471 | $page->param(city => $q->escapeHTML($webvar{city}));
|
---|
| 472 | $page->param(custid => $webvar{custid});
|
---|
| 473 | $page->param(circid => $q->escapeHTML($webvar{circid}));
|
---|
| 474 | $page->param(desc => $q->escapeHTML($webvar{desc}));
|
---|
[4] | 475 |
|
---|
[517] | 476 | ##fixme: find a way to have the displayed copy have <br> substitutions
|
---|
| 477 | # for newlines, and the <input> value have either encoded or bare newlines.
|
---|
| 478 | # Also applies to privdata.
|
---|
| 479 | $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
|
---|
| 480 |
|
---|
[284] | 481 | # Check to see if user is allowed to do anything with sensitive data
|
---|
| 482 | my $privdata = '';
|
---|
[517] | 483 | $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
|
---|
| 484 | if $IPDBacl{$authuser} =~ /s/;
|
---|
| 485 |
|
---|
| 486 | # Yay! This now has it's very own little home.
|
---|
| 487 | $page->param(billinguser => $webvar{userid})
|
---|
[299] | 488 | if $webvar{userid};
|
---|
[284] | 489 |
|
---|
[517] | 490 | ##fixme: this is only needed iff confirm.tmpl and
|
---|
| 491 | # confirmRemove.tmpl are merged (quite possible, just
|
---|
| 492 | # a little tedious)
|
---|
| 493 | $page->param(action => "insert");
|
---|
[284] | 494 |
|
---|
[4] | 495 | } # end confirmAssign
|
---|
| 496 |
|
---|
| 497 |
|
---|
| 498 | # Do the work of actually inserting a block in the database.
|
---|
| 499 | sub insertAssign {
|
---|
[233] | 500 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 501 | $aclerr = 'addblock';
|
---|
[233] | 502 | return;
|
---|
| 503 | }
|
---|
[4] | 504 | # Some things are done more than once.
|
---|
[111] | 505 | return if !validateInput();
|
---|
[4] | 506 |
|
---|
[284] | 507 | if (!defined($webvar{privdata})) {
|
---|
| 508 | $webvar{privdata} = '';
|
---|
| 509 | }
|
---|
[575] | 510 |
|
---|
| 511 | # split up some linked data for static IPs via guided allocation. needed for breadcrumbs lite.
|
---|
[584] | 512 | ($webvar{alloc_from},$webvar{rdepth}) = split /,/, $webvar{alloc_from} if $webvar{alloc_from} =~ /,/;
|
---|
[575] | 513 |
|
---|
[106] | 514 | # $code is "success" vs "failure", $msg contains OK for a
|
---|
| 515 | # successful netblock allocation, the IP allocated for static
|
---|
| 516 | # IP, or the error message if an error occurred.
|
---|
[517] | 517 |
|
---|
[575] | 518 | my ($code,$msg) = allocateBlock($ip_dbh, cidr => $webvar{fullcidr}, alloc_from => $webvar{alloc_from},
|
---|
| 519 | rdepth => $webvar{rdepth}, custid => $webvar{custid}, type => $webvar{alloctype}, city => $webvar{city},
|
---|
| 520 | desc => $webvar{desc}, notes => $webvar{notes}, circid => $webvar{circid},
|
---|
[585] | 521 | privdata => $webvar{privdata}, nodeid => $webvar{node}, rdns => $webvar{rdns}, user => $authuser);
|
---|
[4] | 522 |
|
---|
[111] | 523 | if ($code eq 'OK') {
|
---|
[106] | 524 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
[300] | 525 | $msg =~ s|/32||;
|
---|
[517] | 526 | $page->param(staticip => $msg);
|
---|
| 527 | $page->param(custid => $webvar{custid});
|
---|
[575] | 528 | $page->param(parent => $webvar{alloc_from}, rdepth => $webvar{rdepth}-1);
|
---|
[517] | 529 | $page->param(billinguser => $webvar{billinguser});
|
---|
[416] | 530 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 531 | "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
|
---|
| 532 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[106] | 533 | } else {
|
---|
[301] | 534 | my $netblock = new NetAddr::IP $webvar{fullcidr};
|
---|
[517] | 535 | $page->param(fullcidr => $webvar{fullcidr});
|
---|
| 536 | $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 537 | $page->param(custid => $webvar{custid});
|
---|
[575] | 538 | # breadcrumbs lite! provide at least a link to the parent of the block we just allocated.
|
---|
| 539 | my $binfo = getBlockData($ip_dbh, $webvar{fullcidr}, $webvar{rdepth});
|
---|
| 540 | $page->param(parent => $binfo->{parent}, rdepth => $binfo->{rdepth});
|
---|
[517] | 541 | if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
|
---|
| 542 | $page->param(billinguser => $webvar{billinguser});
|
---|
| 543 | $page->param(custid => $webvar{custid});
|
---|
| 544 | $page->param(netaddr => $netblock->addr);
|
---|
| 545 | $page->param(masklen => $netblock->masklen);
|
---|
| 546 | }
|
---|
[416] | 547 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 548 | "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
|
---|
| 549 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[4] | 550 | }
|
---|
[106] | 551 | syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
[256] | 552 | "'$webvar{alloctype}' ($msg)";
|
---|
[111] | 553 | } else {
|
---|
| 554 | syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
| 555 | "'$webvar{alloctype}' by $authuser failed: '$msg'";
|
---|
[517] | 556 | $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
|
---|
[157] | 557 | " failed:<br>\n$msg\n");
|
---|
[106] | 558 | }
|
---|
[4] | 559 |
|
---|
| 560 | } # end insertAssign()
|
---|
| 561 |
|
---|
| 562 |
|
---|
| 563 | # Does some basic checks on common input data to make sure nothing
|
---|
| 564 | # *really* weird gets in to the database through this script.
|
---|
| 565 | # Does NOT do complete input validation!!!
|
---|
| 566 | sub validateInput {
|
---|
| 567 | if ($webvar{city} eq '-') {
|
---|
[517] | 568 | $page->param(err => 'Please choose a city');
|
---|
[111] | 569 | return;
|
---|
[4] | 570 | }
|
---|
[138] | 571 |
|
---|
| 572 | # Alloctype check.
|
---|
[4] | 573 | chomp $webvar{alloctype};
|
---|
[138] | 574 | if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
|
---|
| 575 | # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
|
---|
| 576 | # managing to call things in such a way as to cause this deserves a cryptic error.
|
---|
[517] | 577 | $page->param(err => 'Invalid alloctype');
|
---|
[138] | 578 | return;
|
---|
| 579 | }
|
---|
| 580 |
|
---|
| 581 | # CustID check
|
---|
[4] | 582 | # We have different handling for customer allocations and "internal" or "our" allocations
|
---|
[214] | 583 | if ($def_custids{$webvar{alloctype}} eq '') {
|
---|
[4] | 584 | if (!$webvar{custid}) {
|
---|
[517] | 585 | $page->param(err => 'Please enter a customer ID.');
|
---|
[111] | 586 | return;
|
---|
[4] | 587 | }
|
---|
[546] | 588 | # Crosscheck with billing.
|
---|
| 589 | my $status = CustIDCK->custid_exist($webvar{custid});
|
---|
| 590 | if ($CustIDCK::Error) {
|
---|
| 591 | $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
|
---|
| 592 | return;
|
---|
[4] | 593 | }
|
---|
[546] | 594 | if (!$status) {
|
---|
| 595 | $page->param(err => "Customer ID not valid. Make sure the Customer ID ".
|
---|
| 596 | "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
|
---|
| 597 | "non-customer assignments.");
|
---|
| 598 | return;
|
---|
| 599 | }
|
---|
[400] | 600 | # print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
|
---|
[138] | 601 | } else {
|
---|
[167] | 602 | # New! Improved! And now Loaded From The Database!!
|
---|
[320] | 603 | if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
|
---|
| 604 | $webvar{custid} = $def_custids{$webvar{alloctype}};
|
---|
| 605 | }
|
---|
[4] | 606 | }
|
---|
[111] | 607 |
|
---|
[571] | 608 | ## hmmm.... is this even useful?
|
---|
| 609 | if (0) {
|
---|
[111] | 610 | # Check POP location
|
---|
| 611 | my $flag;
|
---|
[187] | 612 | if ($webvar{alloctype} eq 'rm') {
|
---|
[111] | 613 | $flag = 'for a routed netblock';
|
---|
| 614 | foreach (@poplist) {
|
---|
| 615 | if (/^$webvar{city}$/) {
|
---|
| 616 | $flag = 'n';
|
---|
| 617 | last;
|
---|
| 618 | }
|
---|
| 619 | }
|
---|
| 620 | } else {
|
---|
| 621 | $flag = 'n';
|
---|
[442] | 622 | ##fixme: hook to force-set POP or city on certain alloctypes
|
---|
| 623 | # if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
|
---|
[536] | 624 | if ($webvar{pop} && $webvar{pop} =~ /^-$/) {
|
---|
[111] | 625 | $flag = 'to route the block from/through';
|
---|
| 626 | }
|
---|
| 627 | }
|
---|
[517] | 628 |
|
---|
| 629 | # if the alloctype has a restricted city/POP list as determined above,
|
---|
| 630 | # and the reqested city/POP does not match that list, complain
|
---|
[111] | 631 | if ($flag ne 'n') {
|
---|
[517] | 632 | $page->param(err => "Please choose a valid POP location $flag. Valid ".
|
---|
[111] | 633 | "POP locations are currently:<br>\n".join (" - ", @poplist));
|
---|
| 634 | return;
|
---|
| 635 | }
|
---|
[571] | 636 | }
|
---|
[111] | 637 |
|
---|
| 638 | return 'OK';
|
---|
[4] | 639 | } # end validateInput
|
---|
| 640 |
|
---|
| 641 |
|
---|
| 642 | # Displays details of a specific allocation in a form
|
---|
| 643 | # Allows update/delete
|
---|
| 644 | # action=edit
|
---|
| 645 | sub edit {
|
---|
| 646 |
|
---|
[534] | 647 | # snag block info from db
|
---|
[576] | 648 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[4] | 649 |
|
---|
[534] | 650 | # Clean up extra whitespace on alloc type. Mainly a legacy-data cleanup.
|
---|
| 651 | $blockinfo->{type} =~ s/\s//;
|
---|
[4] | 652 |
|
---|
[586] | 653 | # Get rDNS info; duplicates a bit of getBlockData but also does the RPC call if possible
|
---|
| 654 | $blockinfo->{rdns} = getBlockRDNS($ip_dbh, $webvar{block}, $webvar{rdepth}, user => $authuser);
|
---|
| 655 |
|
---|
[517] | 656 | $page->param(block => $webvar{block});
|
---|
[586] | 657 | $page->param(rdns => $blockinfo->{rdns});
|
---|
[576] | 658 | $page->param(rdepth => $blockinfo->{rdepth});
|
---|
[4] | 659 |
|
---|
[534] | 660 | $page->param(custid => $blockinfo->{custid});
|
---|
| 661 | $page->param(city => $blockinfo->{city});
|
---|
| 662 | $page->param(circid => $blockinfo->{circuitid});
|
---|
| 663 | $page->param(desc => $blockinfo->{description});
|
---|
| 664 | $page->param(notes => $blockinfo->{notes});
|
---|
[4] | 665 |
|
---|
[187] | 666 | ##fixme The check here should be built from the database
|
---|
[517] | 667 | # Need to expand to support pool types too
|
---|
[534] | 668 | if ($blockinfo->{type} =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
|
---|
[517] | 669 | $page->param(changetype => 1);
|
---|
| 670 | $page->param(alloctype => [
|
---|
[534] | 671 | { selme => ($blockinfo->{type} eq 'me'), type => "me", disptype => "Dialup netblock" },
|
---|
| 672 | { selme => ($blockinfo->{type} eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
|
---|
| 673 | { selme => ($blockinfo->{type} eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
|
---|
| 674 | { selme => ($blockinfo->{type} eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
|
---|
| 675 | { selme => ($blockinfo->{type} eq 'cn'), type => "cn", disptype => "Customer netblock" },
|
---|
| 676 | { selme => ($blockinfo->{type} eq 'en'), type => "en", disptype => "End-use netblock" },
|
---|
| 677 | { selme => ($blockinfo->{type} eq 'in'), type => "in", disptype => "Internal netblock" },
|
---|
[517] | 678 | ]
|
---|
| 679 | );
|
---|
| 680 | } else {
|
---|
[534] | 681 | $page->param(disptype => $disp_alloctypes{$blockinfo->{type}});
|
---|
| 682 | $page->param(type => $blockinfo->{type});
|
---|
[517] | 683 | }
|
---|
| 684 |
|
---|
[397] | 685 | ## node hack
|
---|
[530] | 686 | my ($nodeid,$nodename) = getNodeInfo($ip_dbh, $webvar{block});
|
---|
[517] | 687 | $page->param(havenodeid => $nodeid);
|
---|
| 688 |
|
---|
[534] | 689 | if ($blockinfo->{type} eq 'fr' || $blockinfo->{type} eq 'bi') {
|
---|
[517] | 690 | $page->param(typesupportsnodes => 1);
|
---|
| 691 | $page->param(nodename => $nodename);
|
---|
| 692 |
|
---|
| 693 | ##fixme: this whole hack needs cleanup and generalization for all alloctypes
|
---|
| 694 | ##fixme: arguably a bug that presence of a nodeid implies it can be changed..
|
---|
| 695 | # but except for manual database changes, only the two types fr and bi can
|
---|
| 696 | # (currently) have a nodeid set in the first place.
|
---|
| 697 | if ($IPDBacl{$authuser} =~ /c/) {
|
---|
[530] | 698 | my $nlist = getNodeList($ip_dbh);
|
---|
| 699 | foreach (@{$nlist}) {
|
---|
| 700 | $$_{selme} = ($$_{node_id} == $nodeid);
|
---|
[397] | 701 | }
|
---|
[530] | 702 | $page->param(nodelist => $nlist);
|
---|
[397] | 703 | }
|
---|
| 704 | }
|
---|
| 705 | ## end node hack
|
---|
[517] | 706 |
|
---|
[534] | 707 | my ($lastmod,undef) = split /\s+/, $blockinfo->{lastmod};
|
---|
[517] | 708 | $page->param(lastmod => $lastmod);
|
---|
[33] | 709 |
|
---|
[517] | 710 | # not happy with the upside-down logic, but...
|
---|
[534] | 711 | $page->param(swipable => $blockinfo->{type} !~ /.i/);
|
---|
| 712 | $page->param(swip => $blockinfo->{swip} ne 'n') if $blockinfo->{swip};
|
---|
[320] | 713 |
|
---|
[284] | 714 | # Check to see if we can display sensitive data
|
---|
[517] | 715 | $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
|
---|
[534] | 716 | $page->param(privdata => $blockinfo->{privdata});
|
---|
[284] | 717 |
|
---|
[517] | 718 | # ACL trickery - these two template booleans control the presence of all form/input tags
|
---|
| 719 | $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
|
---|
| 720 | $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
|
---|
[4] | 721 |
|
---|
| 722 | } # edit()
|
---|
| 723 |
|
---|
| 724 |
|
---|
| 725 | # Stuff new info about a block into the db
|
---|
| 726 | # action=update
|
---|
| 727 | sub update {
|
---|
[284] | 728 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
[517] | 729 | $aclerr = 'updateblock';
|
---|
[284] | 730 | return;
|
---|
| 731 | }
|
---|
[4] | 732 |
|
---|
| 733 | # Make sure incoming data is in correct format - custID among other things.
|
---|
[228] | 734 | return if !validateInput;
|
---|
[4] | 735 |
|
---|
[536] | 736 | $webvar{swip} = 'n' if !$webvar{swip};
|
---|
| 737 |
|
---|
[531] | 738 | my %updargs = (
|
---|
| 739 | custid => $webvar{custid},
|
---|
| 740 | city => $webvar{city},
|
---|
| 741 | description => $webvar{desc},
|
---|
| 742 | notes => $webvar{notes},
|
---|
| 743 | circuitid => $webvar{circid},
|
---|
| 744 | block => $webvar{block},
|
---|
| 745 | type => $webvar{alloctype},
|
---|
[536] | 746 | swip => $webvar{swip},
|
---|
[576] | 747 | rdepth => $webvar{rdepth},
|
---|
[588] | 748 | rdns => $webvar{rdns},
|
---|
| 749 | user => $authuser,
|
---|
[531] | 750 | );
|
---|
| 751 |
|
---|
| 752 | # Semioptional values
|
---|
| 753 | $updargs{privdata} = $webvar{privdata} if $IPDBacl{$authuser} =~ /s/;
|
---|
| 754 | $updargs{node} = $webvar{node} if $webvar{node};
|
---|
| 755 |
|
---|
| 756 | my ($code,$msg) = updateBlock($ip_dbh, %updargs);
|
---|
| 757 |
|
---|
| 758 | if ($code eq 'FAIL') {
|
---|
[166] | 759 | syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
|
---|
[517] | 760 | $page->param(err => "Could not update block/IP $webvar{block}: $msg");
|
---|
[111] | 761 | return;
|
---|
[4] | 762 | }
|
---|
| 763 |
|
---|
| 764 | # If we get here, the operation succeeded.
|
---|
| 765 | syslog "notice", "$authuser updated $webvar{block}";
|
---|
[531] | 766 | ##fixme: log details of the change? old way is in the .debug stream anyway.
|
---|
[416] | 767 | ##fixme: need to wedge something in to allow "update:field" notifications
|
---|
| 768 | ## hmm. how to tell what changed? O_o
|
---|
[426] | 769 | mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
|
---|
[416] | 770 | "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
|
---|
[4] | 771 |
|
---|
[517] | 772 | ## node hack
|
---|
| 773 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 774 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 775 | $page->param(nodename => $nodename);
|
---|
| 776 | }
|
---|
| 777 | ## end node hack
|
---|
| 778 |
|
---|
[380] | 779 | # Link back to browse-routed or list-pool page on "Update complete" page.
|
---|
[576] | 780 | my $cblock = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[380] | 781 | if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
|
---|
[517] | 782 | $page->param(backpool => 1);
|
---|
[576] | 783 | $page->param(backblock => $cblock->{pool});
|
---|
[380] | 784 | } else {
|
---|
[576] | 785 | $page->param(backblock => $cblock->{parent});
|
---|
[380] | 786 | }
|
---|
[576] | 787 | $page->param(backdepth => ($webvar{rdepth}));
|
---|
[380] | 788 |
|
---|
[536] | 789 | # Do some HTML fiddling here instead of using ESCAPE=HTML in the template,
|
---|
| 790 | # because otherwise we can't convert \n to <br>. *sigh*
|
---|
| 791 | $webvar{notes} = $q->escapeHTML($webvar{notes}); # escape first...
|
---|
| 792 | $webvar{notes} =~ s/\n/<br>\n/; # ... then convert newlines
|
---|
| 793 | $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " ");
|
---|
| 794 | $webvar{privdata} =~ s/\n/<br>\n/;
|
---|
| 795 |
|
---|
[517] | 796 | $page->param(cidr => $webvar{block});
|
---|
[588] | 797 | $page->param(rdns => $webvar{rdns});
|
---|
[517] | 798 | $page->param(city => $webvar{city});
|
---|
| 799 | $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 800 | $page->param(custid => $webvar{custid});
|
---|
| 801 | $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
|
---|
[536] | 802 | $page->param(circid => $webvar{circid});
|
---|
| 803 | $page->param(desc => $webvar{desc});
|
---|
| 804 | $page->param(notes => $webvar{notes});
|
---|
[517] | 805 | $page->param(privdata => $webvar{privdata})
|
---|
| 806 | if $IPDBacl{$authuser} =~ /s/;
|
---|
[4] | 807 |
|
---|
| 808 | } # update()
|
---|
| 809 |
|
---|
| 810 |
|
---|
| 811 | # Delete an allocation.
|
---|
[106] | 812 | sub remove {
|
---|
[233] | 813 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 814 | $aclerr = 'delblock';
|
---|
[233] | 815 | return;
|
---|
| 816 | }
|
---|
| 817 |
|
---|
[4] | 818 | # Serves'em right for getting here...
|
---|
| 819 | if (!defined($webvar{block})) {
|
---|
[517] | 820 | $page->param(err => "Can't delete a block that doesn't exist");
|
---|
[111] | 821 | return;
|
---|
[4] | 822 | }
|
---|
| 823 |
|
---|
[538] | 824 | my $blockdata;
|
---|
[4] | 825 |
|
---|
[577] | 826 | if ($webvar{rdepth} == 0) { # $webvar{alloctype} eq 'mm'
|
---|
[4] | 827 |
|
---|
[538] | 828 | $blockdata->{block} = $webvar{block};
|
---|
| 829 | $blockdata->{city} = "N/A";
|
---|
| 830 | $blockdata->{custid} = "N/A";
|
---|
[577] | 831 | $blockdata->{type} = 'mm';
|
---|
[538] | 832 | $blockdata->{circuitid} = "N/A";
|
---|
| 833 | $blockdata->{description} = "N/A";
|
---|
| 834 | $blockdata->{notes} = "N/A";
|
---|
| 835 | $blockdata->{privdata} = "N/A";
|
---|
[577] | 836 | $blockdata->{rdepth} = 0;
|
---|
[517] | 837 |
|
---|
[538] | 838 | } else {
|
---|
[4] | 839 |
|
---|
[577] | 840 | $blockdata = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[4] | 841 |
|
---|
| 842 | } # end cases for different alloctypes
|
---|
| 843 |
|
---|
[538] | 844 | $page->param(block => $blockdata->{block});
|
---|
[589] | 845 |
|
---|
| 846 | $page->param(rdns => $blockdata->{rdns});
|
---|
| 847 |
|
---|
| 848 | # maybe need to apply more magic here?
|
---|
| 849 | # most allocations we *do* want to autodelete the forward as well as reverse; for a handful we don't.
|
---|
| 850 | # -> all real blocks (nb: pool IPs need extra handling)
|
---|
| 851 | # -> NOC/private-IP (how to ID?)
|
---|
| 852 | # -> anything with a pattern matching $IPDB::domain?
|
---|
| 853 | if ($blockdata->{type} !~ /^.i$/) {
|
---|
| 854 | $page->param(autodel => 1);
|
---|
| 855 | }
|
---|
| 856 |
|
---|
[577] | 857 | $page->param(rdepth => $blockdata->{rdepth});
|
---|
[538] | 858 | $page->param(disptype => $disp_alloctypes{$blockdata->{type}});
|
---|
[577] | 859 | # $page->param(type => $blockdata->{type});
|
---|
[538] | 860 | $page->param(city => $blockdata->{city});
|
---|
| 861 | $page->param(custid => $blockdata->{custid});
|
---|
| 862 | $page->param(circid => $blockdata->{circuitid});
|
---|
| 863 | $page->param(desc => $blockdata->{description});
|
---|
| 864 | $blockdata->{notes} = $q->escapeHTML($blockdata->{notes});
|
---|
| 865 | $blockdata->{notes} =~ s/\n/<br>\n/;
|
---|
| 866 | $page->param(notes => $blockdata->{notes});
|
---|
| 867 | $blockdata->{privdata} = $q->escapeHTML($blockdata->{privdata});
|
---|
[540] | 868 | $blockdata->{privdata} = ' ' if !$blockdata->{privdata};
|
---|
[538] | 869 | $blockdata->{privdata} =~ s/\n/<br>\n/;
|
---|
| 870 | $page->param(privdata => $blockdata->{privdata}) if $IPDBacl{$authuser} =~ /s/;
|
---|
| 871 | $page->param(delpool => $blockdata->{type} =~ /^.[pd]$/);
|
---|
[4] | 872 |
|
---|
[517] | 873 | } # end remove()
|
---|
[4] | 874 |
|
---|
| 875 |
|
---|
| 876 | # Delete an allocation. Return it to the freeblocks table; munge
|
---|
| 877 | # data as necessary to keep as few records as possible in freeblocks
|
---|
| 878 | # to prevent weirdness when allocating blocks later.
|
---|
| 879 | # Remove IPs from pool listing if necessary
|
---|
| 880 | sub finalDelete {
|
---|
[233] | 881 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 882 | $aclerr = 'delblock';
|
---|
[233] | 883 | return;
|
---|
| 884 | }
|
---|
[4] | 885 |
|
---|
[370] | 886 | # need to retrieve block data before deleting so we can notify on that
|
---|
[577] | 887 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[370] | 888 |
|
---|
[590] | 889 | my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{rdepth}, $webvar{vrf}, $webvar{delforward}, $authuser);
|
---|
[4] | 890 |
|
---|
[517] | 891 | $page->param(block => $webvar{block});
|
---|
[577] | 892 | $page->param(delparent => $blockinfo->{parent}) if $webvar{rdepth};
|
---|
| 893 | $page->param(prdepth => $webvar{rdepth});
|
---|
[591] | 894 | if ($code =~ /^WARN(POOL|MERGE)/) {
|
---|
[577] | 895 | my ($bp,$bd) = split /,/, $msg;
|
---|
| 896 | $page->param(bparent => $bp);
|
---|
| 897 | $page->param(brdepth => $bd);
|
---|
| 898 | $page->param(mergeip => $code eq 'WARNPOOL');
|
---|
| 899 | }
|
---|
[591] | 900 | if ($code eq 'WARN') {
|
---|
| 901 | $msg =~ s/\n/<br>\n/g;
|
---|
| 902 | $page->param(genwarn => $msg);
|
---|
| 903 | }
|
---|
[577] | 904 | if ($code eq 'OK' || $code =~ /^WARN/) {
|
---|
[528] | 905 | syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block} ".
|
---|
| 906 | $blockinfo->{custid}.", ".$blockinfo->{city}.", desc='".$blockinfo->{description}."'";
|
---|
[416] | 907 | mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
|
---|
| 908 | "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
|
---|
[528] | 909 | "CustID: ".$blockinfo->{custid}."\nCity: ".$blockinfo->{city}.
|
---|
| 910 | "\nDescription: ".$blockinfo->{description}."\n");
|
---|
[106] | 911 | } else {
|
---|
[517] | 912 | $page->param(failmsg => $msg);
|
---|
[106] | 913 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
| 914 | syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
|
---|
| 915 | } else {
|
---|
| 916 | syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
|
---|
[517] | 917 | $page->param(netblock => 1);
|
---|
[4] | 918 | }
|
---|
[106] | 919 | }
|
---|
[4] | 920 |
|
---|
| 921 | } # finalDelete
|
---|