source: trunk/cgi-bin/main.cgi@ 866

Last change on this file since 866 was 866, checked in by Kris Deugau, 8 years ago

/trunk

main.cgi:

  • Don't spew warnings and break the UI when retrieval of the zone list for a netblock fails

IPDB.pm, ipdb-rpc.cgi:

  • Fill out rpc_listPool stub in ipdb-rpc.cgi. The first likely consumer may not want the full UI dataset (with description and "deleteme" flag) so the core sub has been extended with an optional flag that defaults to on.

ipdb-rpc.cgi:

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