[4] | 1 | #!/usr/bin/perl
|
---|
| 2 | # ipdb/cgi-bin/main.cgi
|
---|
[8] | 3 | ###
|
---|
| 4 | # SVN revision info
|
---|
| 5 | # $Date: 2015-01-21 23:05:46 +0000 (Wed, 21 Jan 2015) $
|
---|
| 6 | # SVN revision $Rev: 683 $
|
---|
| 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 |
|
---|
[682] | 90 | # collect variations in layout by way of $IPDB::sublistlayout
|
---|
| 91 | $webvar{action} = 'showsubs' if $webvar{action} =~ /^showsubs/;
|
---|
| 92 |
|
---|
[517] | 93 | my $page;
|
---|
| 94 | if (-e "$ENV{HTML_TEMPLATE_ROOT}/$webvar{action}.tmpl") {
|
---|
[553] | 95 | $page = HTML::Template->new(filename => "$webvar{action}.tmpl", loop_context_vars => 1, global_vars => 1);
|
---|
[517] | 96 | } else {
|
---|
| 97 | $page = HTML::Template->new(filename => "dunno.tmpl");
|
---|
| 98 | }
|
---|
| 99 |
|
---|
[4] | 100 | if($webvar{action} eq 'index') {
|
---|
| 101 | showSummary();
|
---|
[233] | 102 | } elsif ($webvar{action} eq 'addmaster') {
|
---|
| 103 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 104 | $aclerr = 'addmaster';
|
---|
[233] | 105 | }
|
---|
[582] | 106 |
|
---|
| 107 | # Retrieve the list of DNS locations if we've got a place to grab them from
|
---|
| 108 | if ($IPDB::rpc_url) {
|
---|
| 109 |
|
---|
| 110 | my %rpcargs = (
|
---|
| 111 | rpcuser => $authuser,
|
---|
| 112 | group => 1, # bleh
|
---|
| 113 | defloc => '',
|
---|
| 114 | );
|
---|
[623] | 115 | my $result = IPDB::_rpc('getLocDropdown', %rpcargs);
|
---|
[582] | 116 | $page->param(loclist => $result);
|
---|
| 117 | }
|
---|
| 118 |
|
---|
[4] | 119 | } elsif ($webvar{action} eq 'newmaster') {
|
---|
| 120 |
|
---|
[233] | 121 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 122 | $aclerr = 'addmaster';
|
---|
[233] | 123 | } else {
|
---|
| 124 | my $cidr = new NetAddr::IP $webvar{cidr};
|
---|
[517] | 125 | $page->param(cidr => "$cidr");
|
---|
[4] | 126 |
|
---|
[582] | 127 | my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}, (vrf => $webvar{vrf}, rdns => $webvar{rdns},
|
---|
| 128 | rwhois => $webvar{rwhois}, defloc => $webvar{loc}, user => $authuser) );
|
---|
[4] | 129 |
|
---|
[371] | 130 | if ($code eq 'FAIL') {
|
---|
[320] | 131 | syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
|
---|
[517] | 132 | $page->param(err => $msg);
|
---|
[233] | 133 | } else {
|
---|
[624] | 134 | $page->param(parent => $msg);
|
---|
[582] | 135 | if ($code eq 'WARN') {
|
---|
[624] | 136 | $IPDB::errstr =~ s/\n\n/<br>\n/g;
|
---|
| 137 | $IPDB::errstr =~ s/:\n/:<br>\n/g;
|
---|
| 138 | $page->param(warn => $IPDB::errstr);
|
---|
[582] | 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 {
|
---|
[682] | 249 | # Which layout?
|
---|
| 250 | if ($IPDB::sublistlayout == 2) {
|
---|
| 251 |
|
---|
| 252 | # 2-part layout; mixed containers and end-use allocations and free blocks.
|
---|
| 253 | # Containers have a second line for the subblock metadata.
|
---|
| 254 | # We need to load an alternate template for this case.
|
---|
| 255 | $page = HTML::Template->new(filename => "showsubs2.tmpl", loop_context_vars => 1, global_vars => 1);
|
---|
| 256 |
|
---|
| 257 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/));
|
---|
| 258 |
|
---|
| 259 | my $sublist = listSubs($ip_dbh, parent => $webvar{parent});
|
---|
| 260 | $page->param(sublist => $sublist);
|
---|
| 261 |
|
---|
| 262 | } else {
|
---|
| 263 |
|
---|
| 264 | # Default 3-part layout; containers, end-use allocations, and free blocks
|
---|
| 265 |
|
---|
| 266 | my $contlist = listContainers($ip_dbh, parent => $webvar{parent});
|
---|
| 267 | $page->param(contlist => $contlist);
|
---|
| 268 |
|
---|
| 269 | my $alloclist = listAllocations($ip_dbh, parent => $webvar{parent});
|
---|
| 270 | $page->param(alloclist => $alloclist);
|
---|
| 271 |
|
---|
| 272 | # only show "delete" button if we have no container or usage allocations
|
---|
| 273 | $page->param(maydel => ($IPDBacl{$authuser} =~ /d/) && !(@$contlist || @$alloclist));
|
---|
| 274 |
|
---|
| 275 | }
|
---|
| 276 |
|
---|
| 277 | # Common elements
|
---|
[627] | 278 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 279 |
|
---|
| 280 | $page->param(del_id => $webvar{parent});
|
---|
| 281 | $page->param(block => $pinfo->{block});
|
---|
[566] | 282 | $page->param(mayadd => ($IPDBacl{$authuser} =~ /a/));
|
---|
[4] | 283 |
|
---|
[627] | 284 | my $flist = listFree($ip_dbh, parent => $webvar{parent});
|
---|
[566] | 285 | $page->param(freelist => $flist);
|
---|
| 286 | } # showSubs
|
---|
[4] | 287 |
|
---|
| 288 |
|
---|
| 289 | # List the IPs used in a pool
|
---|
[528] | 290 | sub showPool {
|
---|
[4] | 291 |
|
---|
[631] | 292 | my $poolinfo = getBlockData($ip_dbh, $webvar{pool});
|
---|
| 293 | my $cidr = new NetAddr::IP $poolinfo->{block};
|
---|
[4] | 294 |
|
---|
[631] | 295 | $page->param(block => $cidr);
|
---|
[517] | 296 | $page->param(netip => $cidr->addr);
|
---|
| 297 | $cidr++;
|
---|
| 298 | $page->param(gate => $cidr->addr);
|
---|
| 299 | $cidr--; $cidr--;
|
---|
| 300 | $page->param(bcast => $cidr->addr);
|
---|
| 301 | $page->param(mask => $cidr->mask);
|
---|
[157] | 302 |
|
---|
[528] | 303 | $page->param(disptype => $disp_alloctypes{$poolinfo->{type}});
|
---|
| 304 | $page->param(city => $poolinfo->{city});
|
---|
[517] | 305 |
|
---|
[157] | 306 | # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
|
---|
[528] | 307 | $page->param(realblock => $poolinfo->{type} =~ /^.d$/);
|
---|
[4] | 308 |
|
---|
| 309 | # probably have to add an "edit IP allocation" link here somewhere.
|
---|
| 310 |
|
---|
[528] | 311 | my $plist = listPool($ip_dbh, $webvar{pool});
|
---|
| 312 | # technically slightly more efficient to check the ACL in an if () once outside the foreach
|
---|
| 313 | foreach (@{$plist}) {
|
---|
| 314 | $$_{maydel} = $IPDBacl{$authuser} =~ /d/;
|
---|
[4] | 315 | }
|
---|
[528] | 316 | $page->param(poolips => $plist);
|
---|
| 317 | } # end showPool
|
---|
[4] | 318 |
|
---|
| 319 |
|
---|
[106] | 320 | # Show "Add new allocation" page. Note that the actual page may
|
---|
| 321 | # be one of two templates, and the lists come from the database.
|
---|
[4] | 322 | sub assignBlock {
|
---|
| 323 |
|
---|
[233] | 324 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 325 | $aclerr = 'addblock';
|
---|
[233] | 326 | return;
|
---|
| 327 | }
|
---|
| 328 |
|
---|
[517] | 329 | # hack pthbttt eww
|
---|
[633] | 330 | $webvar{parent} = 0 if !$webvar{parent};
|
---|
[517] | 331 | $webvar{block} = '' if !$webvar{block};
|
---|
[21] | 332 |
|
---|
[517] | 333 | # hmm. TMPL_IF block and TMPL_ELSE block on these instead?
|
---|
| 334 | $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
|
---|
| 335 | $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
|
---|
[575] | 336 | $page->param(allocfrom => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
|
---|
[517] | 337 |
|
---|
[633] | 338 | if ($webvar{fbid} || $webvar{fbtype}) {
|
---|
[575] | 339 |
|
---|
| 340 | # Common case, according to reported usage. Block to assign is specified.
|
---|
[21] | 341 | my $block = new NetAddr::IP $webvar{block};
|
---|
[187] | 342 |
|
---|
[675] | 343 | my ($rdns,$cached) = getBlockRDNS($ip_dbh, id => $webvar{parent}, type => $webvar{fbtype}, user => $authuser);
|
---|
[585] | 344 | $page->param(rdns => $rdns) if $rdns;
|
---|
[633] | 345 | $page->param(parent => $webvar{parent});
|
---|
| 346 | $page->param(fbid => $webvar{fbid});
|
---|
[675] | 347 | # visual flag that we're working IPDB-local, not off more authoritative data in dnsadmin
|
---|
| 348 | $page->param(cached => $cached);
|
---|
[585] | 349 |
|
---|
[575] | 350 | $webvar{fbtype} = '' if !$webvar{fbtype};
|
---|
| 351 | if ($webvar{fbtype} eq 'i') {
|
---|
[633] | 352 | my $ipinfo = getBlockData($ip_dbh, $webvar{block}, 'i');
|
---|
| 353 | my $pinfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
[575] | 354 | $page->param(
|
---|
| 355 | fbip => 1,
|
---|
[633] | 356 | block => $ipinfo->{block},
|
---|
[575] | 357 | fbdisptype => $list_alloctypes{$ipinfo->{type}},
|
---|
| 358 | type => $ipinfo->{type},
|
---|
[633] | 359 | allocfrom => $pinfo->{block},
|
---|
[575] | 360 | );
|
---|
[187] | 361 | } else {
|
---|
[529] | 362 | # get "primary" alloctypes, since these are all that can correctly be assigned if we're in this branch
|
---|
[575] | 363 | my $tlist = getTypeList($ip_dbh, 'n');
|
---|
[529] | 364 | $tlist->[0]->{sel} = 1;
|
---|
[575] | 365 | $page->param(typelist => $tlist, block => $block);
|
---|
[106] | 366 | }
|
---|
[575] | 367 |
|
---|
[21] | 368 | } else {
|
---|
[575] | 369 |
|
---|
| 370 | # Uncommon case, according to reported usage. Block to assign needs to be found based on criteria.
|
---|
[541] | 371 | my $mlist = getMasterList($ip_dbh, 'c');
|
---|
| 372 | $page->param(masterlist => $mlist);
|
---|
[517] | 373 |
|
---|
| 374 | my @pops;
|
---|
[633] | 375 | foreach my $pop (@citylist) {
|
---|
[517] | 376 | my %row = (pop => $pop);
|
---|
| 377 | push (@pops, \%row);
|
---|
[92] | 378 | }
|
---|
[517] | 379 | $page->param(pops => \@pops);
|
---|
| 380 |
|
---|
[529] | 381 | # get all standard alloctypes
|
---|
| 382 | my $tlist = getTypeList($ip_dbh, 'a');
|
---|
| 383 | $tlist->[0]->{sel} = 1;
|
---|
| 384 | $page->param(typelist => $tlist);
|
---|
[21] | 385 | }
|
---|
[517] | 386 |
|
---|
| 387 | my @cities;
|
---|
[92] | 388 | foreach my $city (@citylist) {
|
---|
[517] | 389 | my %row = (city => $city);
|
---|
| 390 | push (@cities, \%row);
|
---|
[92] | 391 | }
|
---|
[517] | 392 | $page->param(citylist => \@cities);
|
---|
[4] | 393 |
|
---|
[397] | 394 | ## node hack
|
---|
[530] | 395 | my $nlist = getNodeList($ip_dbh);
|
---|
| 396 | $page->param(nodelist => $nlist);
|
---|
[397] | 397 | ## end node hack
|
---|
| 398 |
|
---|
[517] | 399 | $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
|
---|
[284] | 400 |
|
---|
[4] | 401 | } # assignBlock
|
---|
| 402 |
|
---|
| 403 |
|
---|
| 404 | # Take info on requested IP assignment and see what we can provide.
|
---|
| 405 | sub confirmAssign {
|
---|
[233] | 406 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 407 | $aclerr = 'addblock';
|
---|
[233] | 408 | return;
|
---|
| 409 | }
|
---|
[4] | 410 |
|
---|
| 411 | my $cidr;
|
---|
| 412 | my $alloc_from;
|
---|
[633] | 413 | my $fbid = $webvar{fbid};
|
---|
| 414 | my $p_id = $webvar{parent};
|
---|
[4] | 415 |
|
---|
| 416 | # Going to manually validate some items.
|
---|
| 417 | # custid and city are automagic.
|
---|
[111] | 418 | return if !validateInput();
|
---|
[4] | 419 |
|
---|
[665] | 420 | # make sure this is defined
|
---|
| 421 | $webvar{fbassign} = 'n' if !$webvar{fbassign};
|
---|
| 422 |
|
---|
[4] | 423 | # Several different cases here.
|
---|
| 424 | # Static IP vs netblock
|
---|
| 425 | # + Different flavours of static IP
|
---|
| 426 | # + Different flavours of netblock
|
---|
| 427 |
|
---|
[575] | 428 | if ($webvar{alloctype} =~ /^.i$/ && $webvar{fbassign} ne 'y') {
|
---|
[665] | 429 | if (!$webvar{pop}) {
|
---|
| 430 | $page->param(err => "Please select a location/POP site to allocate from.");
|
---|
| 431 | return;
|
---|
| 432 | }
|
---|
[532] | 433 | my $plist = getPoolSelect($ip_dbh, $webvar{alloctype}, $webvar{pop});
|
---|
[517] | 434 | $page->param(staticip => 1);
|
---|
[532] | 435 | $page->param(poollist => $plist) if $plist;
|
---|
[4] | 436 | $cidr = "Single static IP";
|
---|
[517] | 437 | ##fixme: need to handle "no available pools"
|
---|
[4] | 438 |
|
---|
| 439 | } else { # end show pool options
|
---|
[21] | 440 |
|
---|
[533] | 441 | if ($webvar{fbassign} && $webvar{fbassign} eq 'y') {
|
---|
[21] | 442 | $cidr = new NetAddr::IP $webvar{block};
|
---|
[575] | 443 | $alloc_from = new NetAddr::IP $webvar{allocfrom};
|
---|
[21] | 444 | $webvar{maskbits} = $cidr->masklen;
|
---|
| 445 | } else { # done with direct freeblocks assignment
|
---|
| 446 |
|
---|
| 447 | if (!$webvar{maskbits}) {
|
---|
[517] | 448 | $page->param(err => "Please specify a CIDR mask length.");
|
---|
[111] | 449 | return;
|
---|
[21] | 450 | }
|
---|
[533] | 451 |
|
---|
| 452 | ##fixme ick, ew, bleh. gotta handle the failure message generation better. push it into findAllocateFrom()?
|
---|
| 453 | my $failmsg = "No suitable free block found.<br>\n";
|
---|
[187] | 454 | if ($webvar{alloctype} eq 'rm') {
|
---|
[533] | 455 | $failmsg .= "We do not have a free routeable block of that size.<br>\n".
|
---|
| 456 | "You will have to either route a set of smaller netblocks or a single smaller netblock.";
|
---|
[4] | 457 | } else {
|
---|
[214] | 458 | if ($webvar{alloctype} =~ /^.[pc]$/) {
|
---|
[533] | 459 | $failmsg .= "You will have to route another superblock from one of the<br>\n".
|
---|
| 460 | "master blocks or chose a smaller block size for the pool.";
|
---|
[21] | 461 | } else {
|
---|
[517] | 462 | if (!$webvar{pop}) {
|
---|
| 463 | $page->param(err => 'Please select a POP to route the block from/through.');
|
---|
| 464 | return;
|
---|
| 465 | }
|
---|
[533] | 466 | $failmsg .= "You will have to route another superblock to $webvar{pop}<br>\n".
|
---|
| 467 | "from one of the master blocks or chose a smaller blocksize.";
|
---|
[21] | 468 | }
|
---|
[4] | 469 | }
|
---|
[533] | 470 |
|
---|
[575] | 471 | ## fixme: add rdepth?
|
---|
[633] | 472 | ($fbid,$cidr,$p_id) = findAllocateFrom($ip_dbh, $webvar{maskbits}, $webvar{alloctype},
|
---|
| 473 | $webvar{city}, $webvar{pop}, (master => $webvar{allocfrom}, allowpriv => $webvar{allowpriv}) );
|
---|
[533] | 474 | if (!$cidr) {
|
---|
[517] | 475 | $page->param(err => $failmsg);
|
---|
[111] | 476 | return;
|
---|
[21] | 477 | }
|
---|
[533] | 478 | $cidr = new NetAddr::IP $cidr;
|
---|
[575] | 479 |
|
---|
| 480 | # this chunk now specific to "guided" allocation; freeblock-select can now slice-n-dice on its own.
|
---|
| 481 | $alloc_from = "$cidr";
|
---|
| 482 | # If the block to be allocated is smaller than the one we found,
|
---|
| 483 | # figure out the "real" block to be allocated.
|
---|
| 484 | if ($cidr->masklen() ne $webvar{maskbits}) {
|
---|
| 485 | my $maskbits = $cidr->masklen();
|
---|
| 486 | my @subblocks;
|
---|
| 487 | while ($maskbits++ < $webvar{maskbits}) {
|
---|
| 488 | @subblocks = $cidr->split($maskbits);
|
---|
| 489 | }
|
---|
| 490 | $cidr = $subblocks[0];
|
---|
| 491 | }
|
---|
[21] | 492 | } # check for freeblocks assignment or IPDB-controlled assignment
|
---|
[4] | 493 |
|
---|
[674] | 494 | # Generate the IP list for the new allocation in case someone wants to set per-IP rDNS right away.
|
---|
| 495 | # We don't do this on the previous page because we don't know how big a block or even what IP range
|
---|
| 496 | # it's for (if following the "normal" allocation process)
|
---|
| 497 | if ($IPDBacl{$authuser} =~ /c/
|
---|
| 498 | && $cidr->masklen != $cidr->bits
|
---|
| 499 | && ($cidr->bits - $cidr->masklen) <= $IPDB::maxrevlist
|
---|
| 500 | && $webvar{alloctype} !~ /^.[dpi]/
|
---|
| 501 | # do we want to allow v6 at all?
|
---|
| 502 | #&& ! $cidr->{isv6}
|
---|
| 503 | ) {
|
---|
| 504 | my @list;
|
---|
| 505 | foreach my $ip (@{$cidr->splitref()}) {
|
---|
| 506 | my %row;
|
---|
| 507 | $row{r_ip} = $ip->addr;
|
---|
| 508 | $row{iphost} = '';
|
---|
| 509 | push @list, \%row;
|
---|
| 510 | }
|
---|
| 511 | $page->param(r_iplist => \@list);
|
---|
| 512 | # We don't use this here, because these IPs should already be bare.
|
---|
| 513 | # ... or should we be paranoid? Make it a config option?
|
---|
| 514 | #getRDNSbyIP($ip_dbh, type => $webvar{alloctype}, range => "$cidr", user => $authuser) );
|
---|
| 515 | }
|
---|
[157] | 516 | } # if ($webvar{alloctype} =~ /^.i$/)
|
---|
[4] | 517 |
|
---|
[397] | 518 | ## node hack
|
---|
| 519 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 520 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 521 | $page->param(nodename => $nodename);
|
---|
| 522 | $page->param(nodeid => $webvar{node});
|
---|
[397] | 523 | }
|
---|
| 524 | ## end node hack
|
---|
| 525 |
|
---|
[4] | 526 | # Stick in the allocation data
|
---|
[517] | 527 | $page->param(alloc_type => $webvar{alloctype});
|
---|
| 528 | $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
|
---|
| 529 | $page->param(alloc_from => $alloc_from);
|
---|
[633] | 530 | $page->param(parent => $p_id);
|
---|
| 531 | $page->param(fbid => $fbid);
|
---|
[517] | 532 | $page->param(cidr => $cidr);
|
---|
[585] | 533 | $page->param(rdns => $webvar{rdns});
|
---|
[517] | 534 | $page->param(city => $q->escapeHTML($webvar{city}));
|
---|
| 535 | $page->param(custid => $webvar{custid});
|
---|
| 536 | $page->param(circid => $q->escapeHTML($webvar{circid}));
|
---|
| 537 | $page->param(desc => $q->escapeHTML($webvar{desc}));
|
---|
[4] | 538 |
|
---|
[517] | 539 | ##fixme: find a way to have the displayed copy have <br> substitutions
|
---|
| 540 | # for newlines, and the <input> value have either encoded or bare newlines.
|
---|
| 541 | # Also applies to privdata.
|
---|
| 542 | $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
|
---|
| 543 |
|
---|
[284] | 544 | # Check to see if user is allowed to do anything with sensitive data
|
---|
| 545 | my $privdata = '';
|
---|
[517] | 546 | $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
|
---|
| 547 | if $IPDBacl{$authuser} =~ /s/;
|
---|
| 548 |
|
---|
| 549 | # Yay! This now has it's very own little home.
|
---|
| 550 | $page->param(billinguser => $webvar{userid})
|
---|
[299] | 551 | if $webvar{userid};
|
---|
[284] | 552 |
|
---|
[517] | 553 | ##fixme: this is only needed iff confirm.tmpl and
|
---|
| 554 | # confirmRemove.tmpl are merged (quite possible, just
|
---|
| 555 | # a little tedious)
|
---|
| 556 | $page->param(action => "insert");
|
---|
[284] | 557 |
|
---|
[4] | 558 | } # end confirmAssign
|
---|
| 559 |
|
---|
| 560 |
|
---|
| 561 | # Do the work of actually inserting a block in the database.
|
---|
| 562 | sub insertAssign {
|
---|
[233] | 563 | if ($IPDBacl{$authuser} !~ /a/) {
|
---|
[517] | 564 | $aclerr = 'addblock';
|
---|
[233] | 565 | return;
|
---|
| 566 | }
|
---|
[4] | 567 | # Some things are done more than once.
|
---|
[111] | 568 | return if !validateInput();
|
---|
[4] | 569 |
|
---|
[284] | 570 | if (!defined($webvar{privdata})) {
|
---|
| 571 | $webvar{privdata} = '';
|
---|
| 572 | }
|
---|
[575] | 573 |
|
---|
| 574 | # split up some linked data for static IPs via guided allocation. needed for breadcrumbs lite.
|
---|
[584] | 575 | ($webvar{alloc_from},$webvar{rdepth}) = split /,/, $webvar{alloc_from} if $webvar{alloc_from} =~ /,/;
|
---|
[575] | 576 |
|
---|
[106] | 577 | # $code is "success" vs "failure", $msg contains OK for a
|
---|
| 578 | # successful netblock allocation, the IP allocated for static
|
---|
| 579 | # IP, or the error message if an error occurred.
|
---|
[517] | 580 |
|
---|
[677] | 581 | ##fixme: consider just passing \%webvar to allocateBlock()?
|
---|
| 582 | # collect per-IP rDNS fields. only copy over the ones that actually have something in them.
|
---|
| 583 | my %iprev;
|
---|
| 584 | foreach (keys %webvar) {
|
---|
| 585 | $iprev{$_} = $webvar{$_} if /host_[\d.a-fA-F:]+/ && $webvar{$_};
|
---|
| 586 | }
|
---|
| 587 |
|
---|
[633] | 588 | my ($code,$msg) = allocateBlock($ip_dbh, cidr => $webvar{fullcidr}, fbid => $webvar{fbid},
|
---|
| 589 | parent => $webvar{parent}, custid => $webvar{custid}, type => $webvar{alloctype}, city => $webvar{city},
|
---|
[575] | 590 | desc => $webvar{desc}, notes => $webvar{notes}, circid => $webvar{circid},
|
---|
[677] | 591 | privdata => $webvar{privdata}, nodeid => $webvar{node}, rdns => $webvar{rdns}, user => $authuser,
|
---|
| 592 | iprev => \%iprev);
|
---|
[4] | 593 |
|
---|
[111] | 594 | if ($code eq 'OK') {
|
---|
[106] | 595 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
[300] | 596 | $msg =~ s|/32||;
|
---|
[517] | 597 | $page->param(staticip => $msg);
|
---|
| 598 | $page->param(custid => $webvar{custid});
|
---|
[633] | 599 | $page->param(parent => $webvar{parent}, pool => $webvar{alloc_from});
|
---|
[517] | 600 | $page->param(billinguser => $webvar{billinguser});
|
---|
[416] | 601 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 602 | "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
|
---|
| 603 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[106] | 604 | } else {
|
---|
[301] | 605 | my $netblock = new NetAddr::IP $webvar{fullcidr};
|
---|
[517] | 606 | $page->param(fullcidr => $webvar{fullcidr});
|
---|
| 607 | $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 608 | $page->param(custid => $webvar{custid});
|
---|
[575] | 609 | # breadcrumbs lite! provide at least a link to the parent of the block we just allocated.
|
---|
[633] | 610 | my $binfo = getBlockData($ip_dbh, $webvar{parent});
|
---|
| 611 | $page->param(parentid => $webvar{parent});
|
---|
| 612 | $page->param(parentblock => $binfo->{block});
|
---|
[517] | 613 | if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
|
---|
| 614 | $page->param(billinguser => $webvar{billinguser});
|
---|
| 615 | $page->param(custid => $webvar{custid});
|
---|
| 616 | $page->param(netaddr => $netblock->addr);
|
---|
| 617 | $page->param(masklen => $netblock->masklen);
|
---|
| 618 | }
|
---|
[416] | 619 | mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
|
---|
| 620 | "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
|
---|
| 621 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
|
---|
[4] | 622 | }
|
---|
[106] | 623 | syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
[256] | 624 | "'$webvar{alloctype}' ($msg)";
|
---|
[111] | 625 | } else {
|
---|
| 626 | syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
|
---|
| 627 | "'$webvar{alloctype}' by $authuser failed: '$msg'";
|
---|
[517] | 628 | $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
|
---|
[157] | 629 | " failed:<br>\n$msg\n");
|
---|
[106] | 630 | }
|
---|
[4] | 631 |
|
---|
| 632 | } # end insertAssign()
|
---|
| 633 |
|
---|
| 634 |
|
---|
| 635 | # Does some basic checks on common input data to make sure nothing
|
---|
| 636 | # *really* weird gets in to the database through this script.
|
---|
| 637 | # Does NOT do complete input validation!!!
|
---|
| 638 | sub validateInput {
|
---|
| 639 | if ($webvar{city} eq '-') {
|
---|
[517] | 640 | $page->param(err => 'Please choose a city');
|
---|
[111] | 641 | return;
|
---|
[4] | 642 | }
|
---|
[138] | 643 |
|
---|
| 644 | # Alloctype check.
|
---|
[4] | 645 | chomp $webvar{alloctype};
|
---|
[138] | 646 | if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
|
---|
| 647 | # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
|
---|
| 648 | # managing to call things in such a way as to cause this deserves a cryptic error.
|
---|
[517] | 649 | $page->param(err => 'Invalid alloctype');
|
---|
[138] | 650 | return;
|
---|
| 651 | }
|
---|
| 652 |
|
---|
| 653 | # CustID check
|
---|
[4] | 654 | # We have different handling for customer allocations and "internal" or "our" allocations
|
---|
[214] | 655 | if ($def_custids{$webvar{alloctype}} eq '') {
|
---|
[4] | 656 | if (!$webvar{custid}) {
|
---|
[517] | 657 | $page->param(err => 'Please enter a customer ID.');
|
---|
[111] | 658 | return;
|
---|
[4] | 659 | }
|
---|
[546] | 660 | # Crosscheck with billing.
|
---|
| 661 | my $status = CustIDCK->custid_exist($webvar{custid});
|
---|
| 662 | if ($CustIDCK::Error) {
|
---|
| 663 | $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
|
---|
| 664 | return;
|
---|
[4] | 665 | }
|
---|
[546] | 666 | if (!$status) {
|
---|
| 667 | $page->param(err => "Customer ID not valid. Make sure the Customer ID ".
|
---|
| 668 | "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
|
---|
| 669 | "non-customer assignments.");
|
---|
| 670 | return;
|
---|
| 671 | }
|
---|
[400] | 672 | # print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
|
---|
[138] | 673 | } else {
|
---|
[167] | 674 | # New! Improved! And now Loaded From The Database!!
|
---|
[320] | 675 | if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
|
---|
| 676 | $webvar{custid} = $def_custids{$webvar{alloctype}};
|
---|
| 677 | }
|
---|
[4] | 678 | }
|
---|
[111] | 679 |
|
---|
[571] | 680 | ## hmmm.... is this even useful?
|
---|
| 681 | if (0) {
|
---|
[111] | 682 | # Check POP location
|
---|
| 683 | my $flag;
|
---|
[187] | 684 | if ($webvar{alloctype} eq 'rm') {
|
---|
[111] | 685 | $flag = 'for a routed netblock';
|
---|
| 686 | foreach (@poplist) {
|
---|
| 687 | if (/^$webvar{city}$/) {
|
---|
| 688 | $flag = 'n';
|
---|
| 689 | last;
|
---|
| 690 | }
|
---|
| 691 | }
|
---|
| 692 | } else {
|
---|
| 693 | $flag = 'n';
|
---|
[442] | 694 | ##fixme: hook to force-set POP or city on certain alloctypes
|
---|
| 695 | # if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
|
---|
[536] | 696 | if ($webvar{pop} && $webvar{pop} =~ /^-$/) {
|
---|
[111] | 697 | $flag = 'to route the block from/through';
|
---|
| 698 | }
|
---|
| 699 | }
|
---|
[517] | 700 |
|
---|
| 701 | # if the alloctype has a restricted city/POP list as determined above,
|
---|
| 702 | # and the reqested city/POP does not match that list, complain
|
---|
[111] | 703 | if ($flag ne 'n') {
|
---|
[517] | 704 | $page->param(err => "Please choose a valid POP location $flag. Valid ".
|
---|
[111] | 705 | "POP locations are currently:<br>\n".join (" - ", @poplist));
|
---|
| 706 | return;
|
---|
| 707 | }
|
---|
[571] | 708 | }
|
---|
[111] | 709 |
|
---|
| 710 | return 'OK';
|
---|
[4] | 711 | } # end validateInput
|
---|
| 712 |
|
---|
| 713 |
|
---|
| 714 | # Displays details of a specific allocation in a form
|
---|
| 715 | # Allows update/delete
|
---|
| 716 | # action=edit
|
---|
| 717 | sub edit {
|
---|
| 718 |
|
---|
[534] | 719 | # snag block info from db
|
---|
[634] | 720 | my $blockinfo = getBlockData($ip_dbh, $webvar{id}, $webvar{basetype});
|
---|
| 721 | $page->param(id => $webvar{id});
|
---|
| 722 | $page->param(basetype => $webvar{basetype});
|
---|
[4] | 723 |
|
---|
[534] | 724 | # Clean up extra whitespace on alloc type. Mainly a legacy-data cleanup.
|
---|
| 725 | $blockinfo->{type} =~ s/\s//;
|
---|
[4] | 726 |
|
---|
[675] | 727 | my $cached;
|
---|
[586] | 728 | # Get rDNS info; duplicates a bit of getBlockData but also does the RPC call if possible
|
---|
[675] | 729 | ($blockinfo->{rdns},$cached) = getBlockRDNS($ip_dbh, id => $webvar{id}, type => $blockinfo->{type}, user => $authuser);
|
---|
| 730 | # visual flag that we're working IPDB-local, not off more authoritative data in dnsadmin
|
---|
| 731 | $page->param(cached => $cached);
|
---|
[586] | 732 |
|
---|
[675] | 733 | my $cidr = new NetAddr::IP $blockinfo->{block};
|
---|
| 734 | # Limit the per-IP rDNS list based on CIDR length; larger ones just take up too much space.
|
---|
| 735 | # Also, don't show on IP pools; the individual IPs will have a space for rDNS
|
---|
| 736 | # Don't show on single IPs; these use the "pattern" field
|
---|
| 737 | if ($IPDBacl{$authuser} =~ /c/
|
---|
| 738 | && $cidr->masklen != $cidr->bits
|
---|
| 739 | && ($cidr->bits - $cidr->masklen) <= $IPDB::maxrevlist
|
---|
[683] | 740 | && $blockinfo->{type} !~ /^.[dpi]/
|
---|
[675] | 741 | # do we want to allow v6 at all?
|
---|
| 742 | #&& ! $cidr->{isv6}
|
---|
| 743 | ) {
|
---|
| 744 | $page->param(r_iplist => getRDNSbyIP($ip_dbh, id => $webvar{id}, type => $blockinfo->{type},
|
---|
| 745 | range => $blockinfo->{block}, user => $authuser) );
|
---|
| 746 | }
|
---|
| 747 |
|
---|
[634] | 748 | $page->param(block => $blockinfo->{block});
|
---|
[586] | 749 | $page->param(rdns => $blockinfo->{rdns});
|
---|
[4] | 750 |
|
---|
[534] | 751 | $page->param(custid => $blockinfo->{custid});
|
---|
| 752 | $page->param(city => $blockinfo->{city});
|
---|
| 753 | $page->param(circid => $blockinfo->{circuitid});
|
---|
| 754 | $page->param(desc => $blockinfo->{description});
|
---|
| 755 | $page->param(notes => $blockinfo->{notes});
|
---|
[4] | 756 |
|
---|
[187] | 757 | ##fixme The check here should be built from the database
|
---|
[517] | 758 | # Need to expand to support pool types too
|
---|
[534] | 759 | if ($blockinfo->{type} =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
|
---|
[517] | 760 | $page->param(changetype => 1);
|
---|
| 761 | $page->param(alloctype => [
|
---|
[534] | 762 | { selme => ($blockinfo->{type} eq 'me'), type => "me", disptype => "Dialup netblock" },
|
---|
| 763 | { selme => ($blockinfo->{type} eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
|
---|
| 764 | { selme => ($blockinfo->{type} eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
|
---|
| 765 | { selme => ($blockinfo->{type} eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
|
---|
| 766 | { selme => ($blockinfo->{type} eq 'cn'), type => "cn", disptype => "Customer netblock" },
|
---|
| 767 | { selme => ($blockinfo->{type} eq 'en'), type => "en", disptype => "End-use netblock" },
|
---|
| 768 | { selme => ($blockinfo->{type} eq 'in'), type => "in", disptype => "Internal netblock" },
|
---|
[517] | 769 | ]
|
---|
| 770 | );
|
---|
| 771 | } else {
|
---|
[534] | 772 | $page->param(disptype => $disp_alloctypes{$blockinfo->{type}});
|
---|
| 773 | $page->param(type => $blockinfo->{type});
|
---|
[517] | 774 | }
|
---|
| 775 |
|
---|
[397] | 776 | ## node hack
|
---|
[634] | 777 | my ($nodeid,$nodename) = getNodeInfo($ip_dbh, $blockinfo->{block});
|
---|
| 778 | # $page->param(havenodeid => $nodeid);
|
---|
| 779 | $page->param(nodename => $nodename);
|
---|
[517] | 780 |
|
---|
| 781 | ##fixme: this whole hack needs cleanup and generalization for all alloctypes
|
---|
| 782 | ##fixme: arguably a bug that presence of a nodeid implies it can be changed..
|
---|
[634] | 783 | if ($IPDBacl{$authuser} =~ /c/) {
|
---|
| 784 | my $nlist = getNodeList($ip_dbh);
|
---|
| 785 | if ($nodeid) {
|
---|
[530] | 786 | foreach (@{$nlist}) {
|
---|
[634] | 787 | $$_{selme} = ($$_{node_id} == $nodeid);
|
---|
[397] | 788 | }
|
---|
| 789 | }
|
---|
[634] | 790 | $page->param(nodelist => $nlist);
|
---|
[397] | 791 | }
|
---|
| 792 | ## end node hack
|
---|
[517] | 793 |
|
---|
[534] | 794 | my ($lastmod,undef) = split /\s+/, $blockinfo->{lastmod};
|
---|
[517] | 795 | $page->param(lastmod => $lastmod);
|
---|
[33] | 796 |
|
---|
[517] | 797 | # not happy with the upside-down logic, but...
|
---|
[534] | 798 | $page->param(swipable => $blockinfo->{type} !~ /.i/);
|
---|
| 799 | $page->param(swip => $blockinfo->{swip} ne 'n') if $blockinfo->{swip};
|
---|
[320] | 800 |
|
---|
[284] | 801 | # Check to see if we can display sensitive data
|
---|
[517] | 802 | $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
|
---|
[534] | 803 | $page->param(privdata => $blockinfo->{privdata});
|
---|
[284] | 804 |
|
---|
[517] | 805 | # ACL trickery - these two template booleans control the presence of all form/input tags
|
---|
| 806 | $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
|
---|
| 807 | $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
|
---|
[4] | 808 |
|
---|
| 809 | } # edit()
|
---|
| 810 |
|
---|
| 811 |
|
---|
| 812 | # Stuff new info about a block into the db
|
---|
| 813 | # action=update
|
---|
| 814 | sub update {
|
---|
[284] | 815 | if ($IPDBacl{$authuser} !~ /c/) {
|
---|
[517] | 816 | $aclerr = 'updateblock';
|
---|
[284] | 817 | return;
|
---|
| 818 | }
|
---|
[4] | 819 |
|
---|
| 820 | # Make sure incoming data is in correct format - custID among other things.
|
---|
[228] | 821 | return if !validateInput;
|
---|
[4] | 822 |
|
---|
[536] | 823 | $webvar{swip} = 'n' if !$webvar{swip};
|
---|
| 824 |
|
---|
[531] | 825 | my %updargs = (
|
---|
| 826 | custid => $webvar{custid},
|
---|
| 827 | city => $webvar{city},
|
---|
| 828 | description => $webvar{desc},
|
---|
| 829 | notes => $webvar{notes},
|
---|
| 830 | circuitid => $webvar{circid},
|
---|
| 831 | block => $webvar{block},
|
---|
| 832 | type => $webvar{alloctype},
|
---|
[536] | 833 | swip => $webvar{swip},
|
---|
[588] | 834 | rdns => $webvar{rdns},
|
---|
| 835 | user => $authuser,
|
---|
[531] | 836 | );
|
---|
| 837 |
|
---|
| 838 | # Semioptional values
|
---|
| 839 | $updargs{privdata} = $webvar{privdata} if $IPDBacl{$authuser} =~ /s/;
|
---|
| 840 | $updargs{node} = $webvar{node} if $webvar{node};
|
---|
| 841 |
|
---|
[677] | 842 | # collect per-IP rDNS fields. only copy over the ones that actually have something in them.
|
---|
| 843 | my %iprev;
|
---|
| 844 | foreach (keys %webvar) {
|
---|
| 845 | $iprev{$_} = $webvar{$_} if /host_[\d.a-fA-F:]+/ && $webvar{$_};
|
---|
| 846 | }
|
---|
[531] | 847 |
|
---|
[677] | 848 | my ($code,$msg) = updateBlock($ip_dbh, %updargs, iprev => \%iprev);
|
---|
| 849 |
|
---|
[531] | 850 | if ($code eq 'FAIL') {
|
---|
[166] | 851 | syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
|
---|
[517] | 852 | $page->param(err => "Could not update block/IP $webvar{block}: $msg");
|
---|
[111] | 853 | return;
|
---|
[4] | 854 | }
|
---|
| 855 |
|
---|
| 856 | # If we get here, the operation succeeded.
|
---|
| 857 | syslog "notice", "$authuser updated $webvar{block}";
|
---|
[531] | 858 | ##fixme: log details of the change? old way is in the .debug stream anyway.
|
---|
[416] | 859 | ##fixme: need to wedge something in to allow "update:field" notifications
|
---|
| 860 | ## hmm. how to tell what changed? O_o
|
---|
[426] | 861 | mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
|
---|
[416] | 862 | "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
|
---|
[4] | 863 |
|
---|
[517] | 864 | ## node hack
|
---|
| 865 | if ($webvar{node} && $webvar{node} ne '-') {
|
---|
[530] | 866 | my $nodename = getNodeName($ip_dbh, $webvar{node});
|
---|
[517] | 867 | $page->param(nodename => $nodename);
|
---|
| 868 | }
|
---|
| 869 | ## end node hack
|
---|
| 870 |
|
---|
[380] | 871 | # Link back to browse-routed or list-pool page on "Update complete" page.
|
---|
[634] | 872 | my $binfo = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
| 873 | my $pblock = getBlockData($ip_dbh, $binfo->{parent_id});
|
---|
| 874 | $page->param(backid => $binfo->{parent_id});
|
---|
| 875 | $page->param(backblock => $pblock->{block});
|
---|
| 876 | $page->param(backpool => ($webvar{basetype} eq 'i'));
|
---|
[380] | 877 |
|
---|
[536] | 878 | # Do some HTML fiddling here instead of using ESCAPE=HTML in the template,
|
---|
| 879 | # because otherwise we can't convert \n to <br>. *sigh*
|
---|
| 880 | $webvar{notes} = $q->escapeHTML($webvar{notes}); # escape first...
|
---|
| 881 | $webvar{notes} =~ s/\n/<br>\n/; # ... then convert newlines
|
---|
| 882 | $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " ");
|
---|
| 883 | $webvar{privdata} =~ s/\n/<br>\n/;
|
---|
| 884 |
|
---|
[634] | 885 | $page->param(cidr => $binfo->{block});
|
---|
[588] | 886 | $page->param(rdns => $webvar{rdns});
|
---|
[517] | 887 | $page->param(city => $webvar{city});
|
---|
| 888 | $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
|
---|
| 889 | $page->param(custid => $webvar{custid});
|
---|
| 890 | $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
|
---|
[536] | 891 | $page->param(circid => $webvar{circid});
|
---|
| 892 | $page->param(desc => $webvar{desc});
|
---|
| 893 | $page->param(notes => $webvar{notes});
|
---|
[517] | 894 | $page->param(privdata => $webvar{privdata})
|
---|
| 895 | if $IPDBacl{$authuser} =~ /s/;
|
---|
[4] | 896 |
|
---|
| 897 | } # update()
|
---|
| 898 |
|
---|
| 899 |
|
---|
| 900 | # Delete an allocation.
|
---|
[106] | 901 | sub remove {
|
---|
[233] | 902 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 903 | $aclerr = 'delblock';
|
---|
[233] | 904 | return;
|
---|
| 905 | }
|
---|
| 906 |
|
---|
[4] | 907 | # Serves'em right for getting here...
|
---|
| 908 | if (!defined($webvar{block})) {
|
---|
[517] | 909 | $page->param(err => "Can't delete a block that doesn't exist");
|
---|
[111] | 910 | return;
|
---|
[4] | 911 | }
|
---|
| 912 |
|
---|
[538] | 913 | my $blockdata;
|
---|
[638] | 914 | $blockdata = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
[4] | 915 |
|
---|
[638] | 916 | if ($blockdata->{parent_id} == 0) { # $webvar{alloctype} eq 'mm'
|
---|
[538] | 917 | $blockdata->{city} = "N/A";
|
---|
| 918 | $blockdata->{custid} = "N/A";
|
---|
| 919 | $blockdata->{circuitid} = "N/A";
|
---|
| 920 | $blockdata->{description} = "N/A";
|
---|
| 921 | $blockdata->{notes} = "N/A";
|
---|
| 922 | $blockdata->{privdata} = "N/A";
|
---|
[638] | 923 | } # end cases for different alloctypes
|
---|
[517] | 924 |
|
---|
[638] | 925 | $page->param(blockid => $webvar{block});
|
---|
| 926 | $page->param(basetype => $webvar{basetype});
|
---|
[4] | 927 |
|
---|
[538] | 928 | $page->param(block => $blockdata->{block});
|
---|
[589] | 929 | $page->param(rdns => $blockdata->{rdns});
|
---|
| 930 |
|
---|
| 931 | # maybe need to apply more magic here?
|
---|
| 932 | # most allocations we *do* want to autodelete the forward as well as reverse; for a handful we don't.
|
---|
| 933 | # -> all real blocks (nb: pool IPs need extra handling)
|
---|
| 934 | # -> NOC/private-IP (how to ID?)
|
---|
| 935 | # -> anything with a pattern matching $IPDB::domain?
|
---|
| 936 | if ($blockdata->{type} !~ /^.i$/) {
|
---|
| 937 | $page->param(autodel => 1);
|
---|
| 938 | }
|
---|
| 939 |
|
---|
[538] | 940 | $page->param(disptype => $disp_alloctypes{$blockdata->{type}});
|
---|
| 941 | $page->param(city => $blockdata->{city});
|
---|
| 942 | $page->param(custid => $blockdata->{custid});
|
---|
| 943 | $page->param(circid => $blockdata->{circuitid});
|
---|
| 944 | $page->param(desc => $blockdata->{description});
|
---|
| 945 | $blockdata->{notes} = $q->escapeHTML($blockdata->{notes});
|
---|
| 946 | $blockdata->{notes} =~ s/\n/<br>\n/;
|
---|
| 947 | $page->param(notes => $blockdata->{notes});
|
---|
| 948 | $blockdata->{privdata} = $q->escapeHTML($blockdata->{privdata});
|
---|
[540] | 949 | $blockdata->{privdata} = ' ' if !$blockdata->{privdata};
|
---|
[538] | 950 | $blockdata->{privdata} =~ s/\n/<br>\n/;
|
---|
| 951 | $page->param(privdata => $blockdata->{privdata}) if $IPDBacl{$authuser} =~ /s/;
|
---|
| 952 | $page->param(delpool => $blockdata->{type} =~ /^.[pd]$/);
|
---|
[4] | 953 |
|
---|
[517] | 954 | } # end remove()
|
---|
[4] | 955 |
|
---|
| 956 |
|
---|
| 957 | # Delete an allocation. Return it to the freeblocks table; munge
|
---|
| 958 | # data as necessary to keep as few records as possible in freeblocks
|
---|
| 959 | # to prevent weirdness when allocating blocks later.
|
---|
| 960 | # Remove IPs from pool listing if necessary
|
---|
| 961 | sub finalDelete {
|
---|
[233] | 962 | if ($IPDBacl{$authuser} !~ /d/) {
|
---|
[517] | 963 | $aclerr = 'delblock';
|
---|
[233] | 964 | return;
|
---|
| 965 | }
|
---|
[4] | 966 |
|
---|
[370] | 967 | # need to retrieve block data before deleting so we can notify on that
|
---|
[638] | 968 | my $blockinfo = getBlockData($ip_dbh, $webvar{block}, $webvar{basetype});
|
---|
| 969 | my $pinfo = getBlockData($ip_dbh, $blockinfo->{parent_id}, 'b');
|
---|
[370] | 970 |
|
---|
[638] | 971 | my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{basetype}, $webvar{delforward}, $authuser);
|
---|
[4] | 972 |
|
---|
[638] | 973 | $page->param(block => $blockinfo->{block});
|
---|
[651] | 974 | $page->param(bdisp => $q->escapeHTML($disp_alloctypes{$blockinfo->{type}}));
|
---|
[638] | 975 | $page->param(delparent_id => $blockinfo->{parent_id});# if $webvar{rdepth};
|
---|
[651] | 976 | if ($pinfo) {
|
---|
| 977 | $page->param(delparent => $pinfo->{block});
|
---|
| 978 | $page->param(pdisp => $q->escapeHTML($disp_alloctypes{$pinfo->{type}}));
|
---|
| 979 | }
|
---|
[638] | 980 | $page->param(returnpool => ($webvar{basetype} eq 'i') );
|
---|
[591] | 981 | if ($code =~ /^WARN(POOL|MERGE)/) {
|
---|
[638] | 982 | my ($pid,$pcidr) = split /,/, $msg;
|
---|
[654] | 983 | my $real_pinfo = getBlockData($ip_dbh, $pid, 'b');
|
---|
[638] | 984 | $page->param(parent_id => $pid);
|
---|
| 985 | $page->param(parent => $pcidr);
|
---|
[654] | 986 | $page->param(real_disp => $q->escapeHTML($disp_alloctypes{$real_pinfo->{type}}));
|
---|
[577] | 987 | $page->param(mergeip => $code eq 'WARNPOOL');
|
---|
| 988 | }
|
---|
[591] | 989 | if ($code eq 'WARN') {
|
---|
| 990 | $msg =~ s/\n/<br>\n/g;
|
---|
| 991 | $page->param(genwarn => $msg);
|
---|
| 992 | }
|
---|
[577] | 993 | if ($code eq 'OK' || $code =~ /^WARN/) {
|
---|
[638] | 994 | syslog "notice", "$authuser deallocated '".$blockinfo->{type}."'-type netblock $webvar{block} ".
|
---|
[528] | 995 | $blockinfo->{custid}.", ".$blockinfo->{city}.", desc='".$blockinfo->{description}."'";
|
---|
[638] | 996 | mailNotify($ip_dbh, 'da', "REMOVED: ".$disp_alloctypes{$blockinfo->{type}}." $webvar{block}",
|
---|
| 997 | $disp_alloctypes{$blockinfo->{type}}." $webvar{block} deallocated by $authuser\n".
|
---|
[528] | 998 | "CustID: ".$blockinfo->{custid}."\nCity: ".$blockinfo->{city}.
|
---|
| 999 | "\nDescription: ".$blockinfo->{description}."\n");
|
---|
[106] | 1000 | } else {
|
---|
[517] | 1001 | $page->param(failmsg => $msg);
|
---|
[106] | 1002 | if ($webvar{alloctype} =~ /^.i$/) {
|
---|
| 1003 | syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
|
---|
| 1004 | } else {
|
---|
| 1005 | syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
|
---|
[517] | 1006 | $page->param(netblock => 1);
|
---|
[4] | 1007 | }
|
---|
[106] | 1008 | }
|
---|
[4] | 1009 |
|
---|
| 1010 | } # finalDelete
|
---|