[4] | 1 | #!/usr/bin/perl
|
---|
| 2 | # ipdb/cgi-bin/main.cgi
|
---|
[8] | 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2013-01-11 21:15:37 +0000 (Fri, 11 Jan 2013) $
|
---|
| 6 | # SVN revision $Rev: 584 $
|
---|
| 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 | # Make an object to represent the XML-RPC server.
|
---|
| 107 | my $server = Frontier::Client->new(url => $IPDB::rpc_url, debug => 0);
|
---|
| 108 | my $result;
|
---|
| 109 |
|
---|
| 110 | my %rpcargs = (
|
---|
| 111 | rpcuser => $authuser,
|
---|
| 112 | rpcsystem => 'ipdb',
|
---|
| 113 | group => 1, # bleh
|
---|
| 114 | defloc => '',
|
---|
| 115 | );
|
---|
| 116 | $result = $server->call('dnsdb.getLocDropdown', %rpcargs);
|
---|
| 117 | $page->param(loclist => $result);
|
---|
| 118 | }
|
---|
| 119 |
|
---|
[4] | 120 | } elsif ($webvar{action} eq 'newmaster') {
|
---|
| 121 |
|
---|
[233] | 122 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 123 | $aclerr = 'addmaster';
|
---|
[233] | 124 | } else {
|
---|
| 125 | my $cidr = new NetAddr::IP $webvar{cidr};
|
---|
[517] | 126 | $page->param(cidr => "$cidr");
|
---|
[4] | 127 |
|
---|
[582] | 128 | my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}, (vrf => $webvar{vrf}, rdns => $webvar{rdns},
|
---|
| 129 | rwhois => $webvar{rwhois}, defloc => $webvar{loc}, user => $authuser) );
|
---|
[4] | 130 |
|
---|
[371] | 131 | if ($code eq 'FAIL') {
|
---|
[320] | 132 | syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
|
---|
[517] | 133 | $page->param(err => $msg);
|
---|
[233] | 134 | } else {
|
---|
[582] | 135 | if ($code eq 'WARN') {
|
---|
| 136 | $msg =~ s/\n\n/<br>\n/g;
|
---|
| 137 | $msg =~ s/:\n/:<br>\n/g;
|
---|
| 138 | $page->param(warn => $msg);
|
---|
| 139 | }
|
---|
[233] | 140 | syslog "info", "$authuser added master block $webvar{cidr}";
|
---|
| 141 | }
|
---|
[4] | 142 |
|
---|
[233] | 143 | } # ACL check
|
---|
| 144 |
|
---|
[4] | 145 | } # end add new master
|
---|
| 146 |
|
---|
[567] | 147 | elsif ($webvar{action} eq 'showsubs') {
|
---|
| 148 | showSubs();
|
---|
| 149 | }
|
---|
| 150 |
|
---|
[4] | 151 | elsif($webvar{action} eq 'listpool') {
|
---|
[528] | 152 | showPool();
|
---|
[4] | 153 | }
|
---|
| 154 |
|
---|
| 155 | # Not modified or added; just shuffled
|
---|
| 156 | elsif($webvar{action} eq 'assign') {
|
---|
| 157 | assignBlock();
|
---|
| 158 | }
|
---|
| 159 | elsif($webvar{action} eq 'confirm') {
|
---|
| 160 | confirmAssign();
|
---|
| 161 | }
|
---|
| 162 | elsif($webvar{action} eq 'insert') {
|
---|
| 163 | insertAssign();
|
---|
| 164 | }
|
---|
| 165 | elsif($webvar{action} eq 'edit') {
|
---|
| 166 | edit();
|
---|
| 167 | }
|
---|
| 168 | elsif($webvar{action} eq 'update') {
|
---|
| 169 | update();
|
---|
| 170 | }
|
---|
| 171 | elsif($webvar{action} eq 'delete') {
|
---|
| 172 | remove();
|
---|
| 173 | }
|
---|
| 174 | elsif($webvar{action} eq 'finaldelete') {
|
---|
| 175 | finalDelete();
|
---|
| 176 | }
|
---|
[397] | 177 | elsif ($webvar{action} eq 'nodesearch') {
|
---|
[519] | 178 | my $nodelist = getNodeList($ip_dbh);
|
---|
| 179 | $page->param(nodelist => $nodelist);
|
---|
[517] | 180 | }
|
---|
[397] | 181 |
|
---|
[517] | 182 | # DB failure. Can't do much here, really.
|
---|
| 183 | elsif ($webvar{action} eq 'dberr') {
|
---|
| 184 | $page->param(errmsg => $errstr);
|
---|
[397] | 185 | }
|
---|
| 186 |
|
---|
[517] | 187 | # Default is an error. It shouldn't be possible to get here unless you're
|
---|
| 188 | # randomly feeding in values for webvar{action}.
|
---|
[4] | 189 | else {
|
---|
| 190 | my $rnd = rand 500;
|
---|
| 191 | my $boing = sprintf("%.2f", rand 500);
|
---|
[517] | 192 | my @excuses = (
|
---|
| 193 | "Aether cloudy. Ask again later about $webvar{action}.",
|
---|
| 194 | "The gods are unhappy with your sacrificial $webvar{action}.",
|
---|
| 195 | "Because one of $webvar{action}'s legs are both the same",
|
---|
| 196 | "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!",
|
---|
| 197 | "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....",
|
---|
| 198 | "I ain't done $webvar{action}",
|
---|
| 199 | "Oooo, look! A flying $webvar{action}!",
|
---|
| 200 | "$webvar{action} too evil, avoiding.",
|
---|
| 201 | "Rocks fall, $webvar{action} dies.",
|
---|
| 202 | "Bit bucket must be emptied before I can $webvar{action}..."
|
---|
| 203 | );
|
---|
| 204 | $page->param(dunno => $excuses[$rnd/50.0]);
|
---|
[4] | 205 | }
|
---|
[111] | 206 | ## Finally! Done with that NASTY "case" emulation!
|
---|
[4] | 207 |
|
---|
| 208 |
|
---|
[517] | 209 | # Switch to a different template if we've tripped on an ACL error.
|
---|
| 210 | # Note that this should only be exercised in development, when
|
---|
| 211 | # deeplinked, or when being attacked; normal ACL handling should
|
---|
| 212 | # remove the links a user is not allowed to click on.
|
---|
| 213 | if ($aclerr) {
|
---|
| 214 | $page = HTML::Template->new(filename => "aclerror.tmpl");
|
---|
| 215 | $page->param(ipdbfunc => $aclmsg{$aclerr});
|
---|
| 216 | }
|
---|
[4] | 217 |
|
---|
[106] | 218 | # Clean up IPDB globals, DB handle, etc.
|
---|
[111] | 219 | finish($ip_dbh);
|
---|
[199] | 220 |
|
---|
[517] | 221 | ## Do all our printing here so we can generate errors and stick them into the slots in the templates.
|
---|
[199] | 222 |
|
---|
[517] | 223 | # can't do this yet, too many blowups
|
---|
| 224 | #print "Content-type: text/html\n\n", $header->output;
|
---|
| 225 | $page->param(webpath => $IPDB::webpath);
|
---|
| 226 | print $page->output;
|
---|
| 227 |
|
---|
| 228 | # include the admin tools link in the output?
|
---|
| 229 | $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
|
---|
| 230 | $footer->param(webpath => $IPDB::webpath);
|
---|
| 231 | print $footer->output;
|
---|
| 232 |
|
---|
[106] | 233 | # Just in case something waaaayyy down isn't in place
|
---|
| 234 | # properly... we exit explicitly.
|
---|
[517] | 235 | exit 0;
|
---|
[4] | 236 |
|
---|
| 237 |
|
---|
| 238 | # Initial display: Show master blocks with total allocated subnets, total free subnets
|
---|
[118] | 239 | sub showSummary {
|
---|
[523] | 240 | my $masterlist = listSummary($ip_dbh);
|
---|
| 241 | $page->param(masterlist => $masterlist);
|
---|
[106] | 242 |
|
---|
[517] | 243 | $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
|
---|
[4] | 244 | } # showSummary
|
---|
| 245 |
|
---|
| 246 |
|
---|
[566] | 247 | # Display blocks immediately within a given parent
|
---|
| 248 | sub showSubs {
|
---|
| 249 | $page->param(block => $webvar{block});
|
---|
| 250 | $page->param(mayadd => ($IPDBacl{$authuser} =~ /a/));
|
---|
| 251 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/));
|
---|
[4] | 252 |
|
---|
[566] | 253 | my $sublist = listSubs($ip_dbh, block => $webvar{block}, rdepth => $webvar{rdepth});
|
---|
| 254 | $page->param(deldepth => $webvar{rdepth} - 1);
|
---|
| 255 | $page->param(rdepth => $webvar{rdepth});
|
---|
| 256 | $page->param(subdepth => $webvar{rdepth} + 1);
|
---|
| 257 | $page->param(sublist => $sublist);
|
---|
[4] | 258 |
|
---|
[566] | 259 | my $flist = listFree($ip_dbh, master => $webvar{block}, rdepth => $webvar{rdepth});
|
---|
| 260 | $page->param(freelist => $flist);
|
---|
| 261 | } # showSubs
|
---|
[4] | 262 |
|
---|
| 263 |
|
---|
| 264 | # List the IPs used in a pool
|
---|
[528] | 265 | sub showPool {
|
---|
[4] | 266 |
|
---|
| 267 | my $cidr = new NetAddr::IP $webvar{pool};
|
---|
| 268 |
|
---|
[517] | 269 | $page->param(block => $webvar{pool});
|
---|
| 270 | $page->param(netip => $cidr->addr);
|
---|
| 271 | $cidr++;
|
---|
| 272 | $page->param(gate => $cidr->addr);
|
---|
| 273 | $cidr--; $cidr--;
|
---|
| 274 | $page->param(bcast => $cidr->addr);
|
---|
| 275 | $page->param(mask => $cidr->mask);
|
---|
[157] | 276 |
|
---|
[4] | 277 | # Snag pool info for heading
|
---|
[570] | 278 | my $poolinfo = getBlockData($ip_dbh, $webvar{pool}, $webvar{rdepth});
|
---|
[4] | 279 |
|
---|
[528] | 280 | $page->param(disptype => $disp_alloctypes{$poolinfo->{type}});
|
---|
| 281 | $page->param(city => $poolinfo->{city});
|
---|
[517] | 282 |
|
---|
[157] | 283 | # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
|
---|
[528] | 284 | $page->param(realblock => $poolinfo->{type} =~ /^.d$/);
|
---|
[4] | 285 |
|
---|
| 286 | # probably have to add an "edit IP allocation" link here somewhere.
|
---|
| 287 |
|
---|
[528] | 288 | my $plist = listPool($ip_dbh, $webvar{pool});
|
---|
| 289 | # technically slightly more efficient to check the ACL in an if () once outside the foreach
|
---|
| 290 | foreach (@{$plist}) {
|
---|
| 291 | $$_{maydel} = $IPDBacl{$authuser} =~ /d/;
|
---|
[4] | 292 | }
|
---|
[528] | 293 | $page->param(poolips => $plist);
|
---|
| 294 | } # end showPool
|
---|
[4] | 295 |
|
---|
| 296 |
|
---|
[106] | 297 | # Show "Add new allocation" page. Note that the actual page may
|
---|
| 298 | # be one of two templates, and the lists come from the database.
|
---|
[4] | 299 | sub assignBlock {
|
---|
| 300 |
|
---|
[233] | 301 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 302 | $aclerr = 'addblock';
|
---|
[233] | 303 | return;
|
---|
| 304 | }
|
---|
| 305 |
|
---|
[517] | 306 | # hack pthbttt eww
|
---|
| 307 | $webvar{block} = '' if !$webvar{block};
|
---|
[21] | 308 |
|
---|
[517] | 309 | # hmm. TMPL_IF block and TMPL_ELSE block on these instead?
|
---|
| 310 | $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
|
---|
| 311 | $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
|
---|
[575] | 312 | $page->param(allocfrom => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
|
---|
[517] | 313 |
|
---|
[21] | 314 | if ($webvar{block} ne '') {
|
---|
[575] | 315 |
|
---|
| 316 | # Common case, according to reported usage. Block to assign is specified.
|
---|
[21] | 317 | my $block = new NetAddr::IP $webvar{block};
|
---|
[575] | 318 | $page->param(rdepth => $webvar{rdepth});
|
---|
[187] | 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);
|
---|
| 470 | $page->param(city => $q->escapeHTML($webvar{city}));
|
---|
| 471 | $page->param(custid => $webvar{custid});
|
---|
| 472 | $page->param(circid => $q->escapeHTML($webvar{circid}));
|
---|
| 473 | $page->param(desc => $q->escapeHTML($webvar{desc}));
|
---|
[4] | 474 |
|
---|
[517] | 475 | ##fixme: find a way to have the displayed copy have <br> substitutions
|
---|
| 476 | # for newlines, and the <input> value have either encoded or bare newlines.
|
---|
| 477 | # Also applies to privdata.
|
---|
| 478 | $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
|
---|
| 479 |
|
---|
[284] | 480 | # Check to see if user is allowed to do anything with sensitive data
|
---|
| 481 | my $privdata = '';
|
---|
[517] | 482 | $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
|
---|
| 483 | if $IPDBacl{$authuser} =~ /s/;
|
---|
| 484 |
|
---|
| 485 | # Yay! This now has it's very own little home.
|
---|
| 486 | $page->param(billinguser => $webvar{userid})
|
---|
[299] | 487 | if $webvar{userid};
|
---|
[284] | 488 |
|
---|
[517] | 489 | ##fixme: this is only needed iff confirm.tmpl and
|
---|
| 490 | # confirmRemove.tmpl are merged (quite possible, just
|
---|
| 491 | # a little tedious)
|
---|
| 492 | $page->param(action => "insert");
|
---|
[284] | 493 |
|
---|
[4] | 494 | } # end confirmAssign
|
---|
| 495 |
|
---|
| 496 |
|
---|
| 497 | # Do the work of actually inserting a block in the database.
|
---|
| 498 | sub insertAssign {
|
---|
[233] | 499 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 500 | $aclerr = 'addblock';
|
---|
[233] | 501 | return;
|
---|
| 502 | }
|
---|
[4] | 503 | # Some things are done more than once.
|
---|
[111] | 504 | return if !validateInput();
|
---|
[4] | 505 |
|
---|
[284] | 506 | if (!defined($webvar{privdata})) {
|
---|
| 507 | $webvar{privdata} = '';
|
---|
| 508 | }
|
---|
[575] | 509 |
|
---|
| 510 | # split up some linked data for static IPs via guided allocation. needed for breadcrumbs lite.
|
---|
[584] | 511 | ($webvar{alloc_from},$webvar{rdepth}) = split /,/, $webvar{alloc_from} if $webvar{alloc_from} =~ /,/;
|
---|
[575] | 512 |
|
---|
[106] | 513 | # $code is "success" vs "failure", $msg contains OK for a
|
---|
| 514 | # successful netblock allocation, the IP allocated for static
|
---|
| 515 | # IP, or the error message if an error occurred.
|
---|
[517] | 516 |
|
---|
[575] | 517 | my ($code,$msg) = allocateBlock($ip_dbh, cidr => $webvar{fullcidr}, alloc_from => $webvar{alloc_from},
|
---|
| 518 | rdepth => $webvar{rdepth}, custid => $webvar{custid}, type => $webvar{alloctype}, city => $webvar{city},
|
---|
| 519 | desc => $webvar{desc}, notes => $webvar{notes}, circid => $webvar{circid},
|
---|
| 520 | privdata => $webvar{privdata}, nodeid => $webvar{node});
|
---|
[4] | 521 |
|
---|
[111] | 522 | if ($code eq 'OK') {
|
---|
[106] | 523 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
[300] | 524 | $msg =~ s|/32||;
|
---|
[517] | 525 | $page->param(staticip => $msg);
|
---|
| 526 | $page->param(custid => $webvar{custid});
|
---|
[575] | 527 | $page->param(parent => $webvar{alloc_from}, rdepth => $webvar{rdepth}-1);
|
---|
[517] | 528 | $page->param(billinguser => $webvar{billinguser});
|
---|
[416] | 529 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 530 | "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
|
---|
| 531 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[106] | 532 | } else {
|
---|
[301] | 533 | my $netblock = new NetAddr::IP $webvar{fullcidr};
|
---|
[517] | 534 | $page->param(fullcidr => $webvar{fullcidr});
|
---|
| 535 | $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 536 | $page->param(custid => $webvar{custid});
|
---|
[575] | 537 | # breadcrumbs lite! provide at least a link to the parent of the block we just allocated.
|
---|
| 538 | my $binfo = getBlockData($ip_dbh, $webvar{fullcidr}, $webvar{rdepth});
|
---|
| 539 | $page->param(parent => $binfo->{parent}, rdepth => $binfo->{rdepth});
|
---|
[517] | 540 | if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
|
---|
| 541 | $page->param(billinguser => $webvar{billinguser});
|
---|
| 542 | $page->param(custid => $webvar{custid});
|
---|
| 543 | $page->param(netaddr => $netblock->addr);
|
---|
| 544 | $page->param(masklen => $netblock->masklen);
|
---|
| 545 | }
|
---|
[416] | 546 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 547 | "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
|
---|
| 548 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[4] | 549 | }
|
---|
[106] | 550 | syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
[256] | 551 | "'$webvar{alloctype}' ($msg)";
|
---|
[111] | 552 | } else {
|
---|
| 553 | syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
| 554 | "'$webvar{alloctype}' by $authuser failed: '$msg'";
|
---|
[517] | 555 | $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
|
---|
[157] | 556 | " failed:<br>\n$msg\n");
|
---|
[106] | 557 | }
|
---|
[4] | 558 |
|
---|
| 559 | } # end insertAssign()
|
---|
| 560 |
|
---|
| 561 |
|
---|
| 562 | # Does some basic checks on common input data to make sure nothing
|
---|
| 563 | # *really* weird gets in to the database through this script.
|
---|
| 564 | # Does NOT do complete input validation!!!
|
---|
| 565 | sub validateInput {
|
---|
| 566 | if ($webvar{city} eq '-') {
|
---|
[517] | 567 | $page->param(err => 'Please choose a city');
|
---|
[111] | 568 | return;
|
---|
[4] | 569 | }
|
---|
[138] | 570 |
|
---|
| 571 | # Alloctype check.
|
---|
[4] | 572 | chomp $webvar{alloctype};
|
---|
[138] | 573 | if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
|
---|
| 574 | # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
|
---|
| 575 | # managing to call things in such a way as to cause this deserves a cryptic error.
|
---|
[517] | 576 | $page->param(err => 'Invalid alloctype');
|
---|
[138] | 577 | return;
|
---|
| 578 | }
|
---|
| 579 |
|
---|
| 580 | # CustID check
|
---|
[4] | 581 | # We have different handling for customer allocations and "internal" or "our" allocations
|
---|
[214] | 582 | if ($def_custids{$webvar{alloctype}} eq '') {
|
---|
[4] | 583 | if (!$webvar{custid}) {
|
---|
[517] | 584 | $page->param(err => 'Please enter a customer ID.');
|
---|
[111] | 585 | return;
|
---|
[4] | 586 | }
|
---|
[546] | 587 | # Crosscheck with billing.
|
---|
| 588 | my $status = CustIDCK->custid_exist($webvar{custid});
|
---|
| 589 | if ($CustIDCK::Error) {
|
---|
| 590 | $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
|
---|
| 591 | return;
|
---|
[4] | 592 | }
|
---|
[546] | 593 | if (!$status) {
|
---|
| 594 | $page->param(err => "Customer ID not valid. Make sure the Customer ID ".
|
---|
| 595 | "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
|
---|
| 596 | "non-customer assignments.");
|
---|
| 597 | return;
|
---|
| 598 | }
|
---|
[400] | 599 | # print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
|
---|
[138] | 600 | } else {
|
---|
[167] | 601 | # New! Improved! And now Loaded From The Database!!
|
---|
[320] | 602 | if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
|
---|
| 603 | $webvar{custid} = $def_custids{$webvar{alloctype}};
|
---|
| 604 | }
|
---|
[4] | 605 | }
|
---|
[111] | 606 |
|
---|
[571] | 607 | ## hmmm.... is this even useful?
|
---|
| 608 | if (0) {
|
---|
[111] | 609 | # Check POP location
|
---|
| 610 | my $flag;
|
---|
[187] | 611 | if ($webvar{alloctype} eq 'rm') {
|
---|
[111] | 612 | $flag = 'for a routed netblock';
|
---|
| 613 | foreach (@poplist) {
|
---|
| 614 | if (/^$webvar{city}$/) {
|
---|
| 615 | $flag = 'n';
|
---|
| 616 | last;
|
---|
| 617 | }
|
---|
| 618 | }
|
---|
| 619 | } else {
|
---|
| 620 | $flag = 'n';
|
---|
[442] | 621 | ##fixme: hook to force-set POP or city on certain alloctypes
|
---|
| 622 | # if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
|
---|
[536] | 623 | if ($webvar{pop} && $webvar{pop} =~ /^-$/) {
|
---|
[111] | 624 | $flag = 'to route the block from/through';
|
---|
| 625 | }
|
---|
| 626 | }
|
---|
[517] | 627 |
|
---|
| 628 | # if the alloctype has a restricted city/POP list as determined above,
|
---|
| 629 | # and the reqested city/POP does not match that list, complain
|
---|
[111] | 630 | if ($flag ne 'n') {
|
---|
[517] | 631 | $page->param(err => "Please choose a valid POP location $flag. Valid ".
|
---|
[111] | 632 | "POP locations are currently:<br>\n".join (" - ", @poplist));
|
---|
| 633 | return;
|
---|
| 634 | }
|
---|
[571] | 635 | }
|
---|
[111] | 636 |
|
---|
| 637 | return 'OK';
|
---|
[4] | 638 | } # end validateInput
|
---|
| 639 |
|
---|
| 640 |
|
---|
| 641 | # Displays details of a specific allocation in a form
|
---|
| 642 | # Allows update/delete
|
---|
| 643 | # action=edit
|
---|
| 644 | sub edit {
|
---|
| 645 |
|
---|
[534] | 646 | # snag block info from db
|
---|
[576] | 647 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[4] | 648 |
|
---|
[534] | 649 | # Clean up extra whitespace on alloc type. Mainly a legacy-data cleanup.
|
---|
| 650 | $blockinfo->{type} =~ s/\s//;
|
---|
[4] | 651 |
|
---|
[517] | 652 | $page->param(block => $webvar{block});
|
---|
[576] | 653 | $page->param(rdepth => $blockinfo->{rdepth});
|
---|
[4] | 654 |
|
---|
[534] | 655 | $page->param(custid => $blockinfo->{custid});
|
---|
| 656 | $page->param(city => $blockinfo->{city});
|
---|
| 657 | $page->param(circid => $blockinfo->{circuitid});
|
---|
| 658 | $page->param(desc => $blockinfo->{description});
|
---|
| 659 | $page->param(notes => $blockinfo->{notes});
|
---|
[4] | 660 |
|
---|
[187] | 661 | ##fixme The check here should be built from the database
|
---|
[517] | 662 | # Need to expand to support pool types too
|
---|
[534] | 663 | if ($blockinfo->{type} =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
|
---|
[517] | 664 | $page->param(changetype => 1);
|
---|
| 665 | $page->param(alloctype => [
|
---|
[534] | 666 | { selme => ($blockinfo->{type} eq 'me'), type => "me", disptype => "Dialup netblock" },
|
---|
| 667 | { selme => ($blockinfo->{type} eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
|
---|
| 668 | { selme => ($blockinfo->{type} eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
|
---|
| 669 | { selme => ($blockinfo->{type} eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
|
---|
| 670 | { selme => ($blockinfo->{type} eq 'cn'), type => "cn", disptype => "Customer netblock" },
|
---|
| 671 | { selme => ($blockinfo->{type} eq 'en'), type => "en", disptype => "End-use netblock" },
|
---|
| 672 | { selme => ($blockinfo->{type} eq 'in'), type => "in", disptype => "Internal netblock" },
|
---|
[517] | 673 | ]
|
---|
| 674 | );
|
---|
| 675 | } else {
|
---|
[534] | 676 | $page->param(disptype => $disp_alloctypes{$blockinfo->{type}});
|
---|
| 677 | $page->param(type => $blockinfo->{type});
|
---|
[517] | 678 | }
|
---|
| 679 |
|
---|
[397] | 680 | ## node hack
|
---|
[530] | 681 | my ($nodeid,$nodename) = getNodeInfo($ip_dbh, $webvar{block});
|
---|
[517] | 682 | $page->param(havenodeid => $nodeid);
|
---|
| 683 |
|
---|
[534] | 684 | if ($blockinfo->{type} eq 'fr' || $blockinfo->{type} eq 'bi') {
|
---|
[517] | 685 | $page->param(typesupportsnodes => 1);
|
---|
| 686 | $page->param(nodename => $nodename);
|
---|
| 687 |
|
---|
| 688 | ##fixme: this whole hack needs cleanup and generalization for all alloctypes
|
---|
| 689 | ##fixme: arguably a bug that presence of a nodeid implies it can be changed..
|
---|
| 690 | # but except for manual database changes, only the two types fr and bi can
|
---|
| 691 | # (currently) have a nodeid set in the first place.
|
---|
| 692 | if ($IPDBacl{$authuser} =~ /c/) {
|
---|
[530] | 693 | my $nlist = getNodeList($ip_dbh);
|
---|
| 694 | foreach (@{$nlist}) {
|
---|
| 695 | $$_{selme} = ($$_{node_id} == $nodeid);
|
---|
[397] | 696 | }
|
---|
[530] | 697 | $page->param(nodelist => $nlist);
|
---|
[397] | 698 | }
|
---|
| 699 | }
|
---|
| 700 | ## end node hack
|
---|
[517] | 701 |
|
---|
[534] | 702 | my ($lastmod,undef) = split /\s+/, $blockinfo->{lastmod};
|
---|
[517] | 703 | $page->param(lastmod => $lastmod);
|
---|
[33] | 704 |
|
---|
[517] | 705 | # not happy with the upside-down logic, but...
|
---|
[534] | 706 | $page->param(swipable => $blockinfo->{type} !~ /.i/);
|
---|
| 707 | $page->param(swip => $blockinfo->{swip} ne 'n') if $blockinfo->{swip};
|
---|
[320] | 708 |
|
---|
[284] | 709 | # Check to see if we can display sensitive data
|
---|
[517] | 710 | $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
|
---|
[534] | 711 | $page->param(privdata => $blockinfo->{privdata});
|
---|
[284] | 712 |
|
---|
[517] | 713 | # ACL trickery - these two template booleans control the presence of all form/input tags
|
---|
| 714 | $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
|
---|
| 715 | $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
|
---|
[4] | 716 |
|
---|
| 717 | } # edit()
|
---|
| 718 |
|
---|
| 719 |
|
---|
| 720 | # Stuff new info about a block into the db
|
---|
| 721 | # action=update
|
---|
| 722 | sub update {
|
---|
[284] | 723 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
[517] | 724 | $aclerr = 'updateblock';
|
---|
[284] | 725 | return;
|
---|
| 726 | }
|
---|
[4] | 727 |
|
---|
| 728 | # Make sure incoming data is in correct format - custID among other things.
|
---|
[228] | 729 | return if !validateInput;
|
---|
[4] | 730 |
|
---|
[536] | 731 | $webvar{swip} = 'n' if !$webvar{swip};
|
---|
| 732 |
|
---|
[531] | 733 | my %updargs = (
|
---|
| 734 | custid => $webvar{custid},
|
---|
| 735 | city => $webvar{city},
|
---|
| 736 | description => $webvar{desc},
|
---|
| 737 | notes => $webvar{notes},
|
---|
| 738 | circuitid => $webvar{circid},
|
---|
| 739 | block => $webvar{block},
|
---|
| 740 | type => $webvar{alloctype},
|
---|
[536] | 741 | swip => $webvar{swip},
|
---|
[576] | 742 | rdepth => $webvar{rdepth},
|
---|
[531] | 743 | );
|
---|
| 744 |
|
---|
| 745 | # Semioptional values
|
---|
| 746 | $updargs{privdata} = $webvar{privdata} if $IPDBacl{$authuser} =~ /s/;
|
---|
| 747 | $updargs{node} = $webvar{node} if $webvar{node};
|
---|
| 748 |
|
---|
| 749 | my ($code,$msg) = updateBlock($ip_dbh, %updargs);
|
---|
| 750 |
|
---|
| 751 | if ($code eq 'FAIL') {
|
---|
[166] | 752 | syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
|
---|
[517] | 753 | $page->param(err => "Could not update block/IP $webvar{block}: $msg");
|
---|
[111] | 754 | return;
|
---|
[4] | 755 | }
|
---|
| 756 |
|
---|
| 757 | # If we get here, the operation succeeded.
|
---|
| 758 | syslog "notice", "$authuser updated $webvar{block}";
|
---|
[531] | 759 | ##fixme: log details of the change? old way is in the .debug stream anyway.
|
---|
[416] | 760 | ##fixme: need to wedge something in to allow "update:field" notifications
|
---|
| 761 | ## hmm. how to tell what changed? O_o
|
---|
[426] | 762 | mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
|
---|
[416] | 763 | "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
|
---|
[4] | 764 |
|
---|
[517] | 765 | ## node hack
|
---|
| 766 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 767 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 768 | $page->param(nodename => $nodename);
|
---|
| 769 | }
|
---|
| 770 | ## end node hack
|
---|
| 771 |
|
---|
[380] | 772 | # Link back to browse-routed or list-pool page on "Update complete" page.
|
---|
[576] | 773 | my $cblock = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[380] | 774 | if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
|
---|
[517] | 775 | $page->param(backpool => 1);
|
---|
[576] | 776 | $page->param(backblock => $cblock->{pool});
|
---|
[380] | 777 | } else {
|
---|
[576] | 778 | $page->param(backblock => $cblock->{parent});
|
---|
[380] | 779 | }
|
---|
[576] | 780 | $page->param(backdepth => ($webvar{rdepth}));
|
---|
[380] | 781 |
|
---|
[536] | 782 | # Do some HTML fiddling here instead of using ESCAPE=HTML in the template,
|
---|
| 783 | # because otherwise we can't convert \n to <br>. *sigh*
|
---|
| 784 | $webvar{notes} = $q->escapeHTML($webvar{notes}); # escape first...
|
---|
| 785 | $webvar{notes} =~ s/\n/<br>\n/; # ... then convert newlines
|
---|
| 786 | $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " ");
|
---|
| 787 | $webvar{privdata} =~ s/\n/<br>\n/;
|
---|
| 788 |
|
---|
[517] | 789 | $page->param(cidr => $webvar{block});
|
---|
| 790 | $page->param(city => $webvar{city});
|
---|
| 791 | $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 792 | $page->param(custid => $webvar{custid});
|
---|
| 793 | $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
|
---|
[536] | 794 | $page->param(circid => $webvar{circid});
|
---|
| 795 | $page->param(desc => $webvar{desc});
|
---|
| 796 | $page->param(notes => $webvar{notes});
|
---|
[517] | 797 | $page->param(privdata => $webvar{privdata})
|
---|
| 798 | if $IPDBacl{$authuser} =~ /s/;
|
---|
[4] | 799 |
|
---|
| 800 | } # update()
|
---|
| 801 |
|
---|
| 802 |
|
---|
| 803 | # Delete an allocation.
|
---|
[106] | 804 | sub remove {
|
---|
[233] | 805 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 806 | $aclerr = 'delblock';
|
---|
[233] | 807 | return;
|
---|
| 808 | }
|
---|
| 809 |
|
---|
[4] | 810 | # Serves'em right for getting here...
|
---|
| 811 | if (!defined($webvar{block})) {
|
---|
[517] | 812 | $page->param(err => "Can't delete a block that doesn't exist");
|
---|
[111] | 813 | return;
|
---|
[4] | 814 | }
|
---|
| 815 |
|
---|
[538] | 816 | my $blockdata;
|
---|
[4] | 817 |
|
---|
[577] | 818 | if ($webvar{rdepth} == 0) { # $webvar{alloctype} eq 'mm'
|
---|
[4] | 819 |
|
---|
[538] | 820 | $blockdata->{block} = $webvar{block};
|
---|
| 821 | $blockdata->{city} = "N/A";
|
---|
| 822 | $blockdata->{custid} = "N/A";
|
---|
[577] | 823 | $blockdata->{type} = 'mm';
|
---|
[538] | 824 | $blockdata->{circuitid} = "N/A";
|
---|
| 825 | $blockdata->{description} = "N/A";
|
---|
| 826 | $blockdata->{notes} = "N/A";
|
---|
| 827 | $blockdata->{privdata} = "N/A";
|
---|
[577] | 828 | $blockdata->{rdepth} = 0;
|
---|
[517] | 829 |
|
---|
[538] | 830 | } else {
|
---|
[4] | 831 |
|
---|
[577] | 832 | $blockdata = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[4] | 833 |
|
---|
| 834 | } # end cases for different alloctypes
|
---|
| 835 |
|
---|
[538] | 836 | $page->param(block => $blockdata->{block});
|
---|
[577] | 837 | $page->param(rdepth => $blockdata->{rdepth});
|
---|
[538] | 838 | $page->param(disptype => $disp_alloctypes{$blockdata->{type}});
|
---|
[577] | 839 | # $page->param(type => $blockdata->{type});
|
---|
[538] | 840 | $page->param(city => $blockdata->{city});
|
---|
| 841 | $page->param(custid => $blockdata->{custid});
|
---|
| 842 | $page->param(circid => $blockdata->{circuitid});
|
---|
| 843 | $page->param(desc => $blockdata->{description});
|
---|
| 844 | $blockdata->{notes} = $q->escapeHTML($blockdata->{notes});
|
---|
| 845 | $blockdata->{notes} =~ s/\n/<br>\n/;
|
---|
| 846 | $page->param(notes => $blockdata->{notes});
|
---|
| 847 | $blockdata->{privdata} = $q->escapeHTML($blockdata->{privdata});
|
---|
[540] | 848 | $blockdata->{privdata} = ' ' if !$blockdata->{privdata};
|
---|
[538] | 849 | $blockdata->{privdata} =~ s/\n/<br>\n/;
|
---|
| 850 | $page->param(privdata => $blockdata->{privdata}) if $IPDBacl{$authuser} =~ /s/;
|
---|
| 851 | $page->param(delpool => $blockdata->{type} =~ /^.[pd]$/);
|
---|
[4] | 852 |
|
---|
[517] | 853 | } # end remove()
|
---|
[4] | 854 |
|
---|
| 855 |
|
---|
| 856 | # Delete an allocation. Return it to the freeblocks table; munge
|
---|
| 857 | # data as necessary to keep as few records as possible in freeblocks
|
---|
| 858 | # to prevent weirdness when allocating blocks later.
|
---|
| 859 | # Remove IPs from pool listing if necessary
|
---|
| 860 | sub finalDelete {
|
---|
[233] | 861 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 862 | $aclerr = 'delblock';
|
---|
[233] | 863 | return;
|
---|
| 864 | }
|
---|
[4] | 865 |
|
---|
[370] | 866 | # need to retrieve block data before deleting so we can notify on that
|
---|
[577] | 867 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{rdepth});
|
---|
[370] | 868 |
|
---|
[577] | 869 | my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{rdepth}, $webvar{vrf});
|
---|
[4] | 870 |
|
---|
[517] | 871 | $page->param(block => $webvar{block});
|
---|
[577] | 872 | $page->param(delparent => $blockinfo->{parent}) if $webvar{rdepth};
|
---|
| 873 | $page->param(prdepth => $webvar{rdepth});
|
---|
| 874 | if ($code =~ /^WARN/) {
|
---|
| 875 | my ($bp,$bd) = split /,/, $msg;
|
---|
| 876 | $page->param(bparent => $bp);
|
---|
| 877 | $page->param(brdepth => $bd);
|
---|
| 878 | $page->param(mergeip => $code eq 'WARNPOOL');
|
---|
| 879 | }
|
---|
| 880 |
|
---|
| 881 | if ($code eq 'OK' || $code =~ /^WARN/) {
|
---|
[528] | 882 | syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block} ".
|
---|
| 883 | $blockinfo->{custid}.", ".$blockinfo->{city}.", desc='".$blockinfo->{description}."'";
|
---|
[416] | 884 | mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
|
---|
| 885 | "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
|
---|
[528] | 886 | "CustID: ".$blockinfo->{custid}."\nCity: ".$blockinfo->{city}.
|
---|
| 887 | "\nDescription: ".$blockinfo->{description}."\n");
|
---|
[106] | 888 | } else {
|
---|
[517] | 889 | $page->param(failmsg => $msg);
|
---|
[106] | 890 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
| 891 | syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
|
---|
| 892 | } else {
|
---|
| 893 | syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
|
---|
[517] | 894 | $page->param(netblock => 1);
|
---|
[4] | 895 | }
|
---|
[106] | 896 | }
|
---|
[4] | 897 |
|
---|
| 898 | } # finalDelete
|
---|