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