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