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

Last change on this file since 570 was 570, checked in by Kris Deugau, 12 years ago

/trunk

Work in progress, see #5:
Update IP pool listing with new fields.
Also update the listing itself to allow allocation of unassigned IPs
right from the list, rather than forcing use of either admin tools
or guided assignment.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 27.6 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3###
4# SVN revision info
5# $Date: 2012-12-19 22:17:04 +0000 (Wed, 19 Dec 2012) $
6# SVN revision $Rev: 570 $
7# Last update by $Author: kdeugau $
8###
9# Copyright (C) 2004-2010 - Kris Deugau
10
11use strict;
12use warnings;
13use CGI::Carp qw(fatalsToBrowser);
14use CGI::Simple;
15use HTML::Template;
16use DBI;
17use POSIX qw(ceil);
18use NetAddr::IP;
19
20use Sys::Syslog;
21
22# don't remove! required for GNU/FHS-ish install from tarball
23##uselib##
24
25use CustIDCK;
26use MyIPDB;
27
28openlog "IPDB","pid","$IPDB::syslog_facility";
29
30## Environment. Collect some things, process some things, set some things...
31
32# Collect the username from HTTP auth. If undefined, we're in
33# a test environment, or called without a username.
34my $authuser;
35if (!defined($ENV{'REMOTE_USER'})) {
36 $authuser = '__temptest';
37} else {
38 $authuser = $ENV{'REMOTE_USER'};
39}
40
41# anyone got a better name? :P
42my $thingroot = $ENV{SCRIPT_FILENAME};
43$thingroot =~ s|cgi-bin/main.cgi||;
44
45syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
46
47##fixme there *must* be a better order to do things in so this can go back where it was
48# CGI fiddling done here so we can declare %webvar so we can alter $webvar{action}
49# to show the right page on DB errors.
50# Set up the CGI object...
51my $q = new CGI::Simple;
52# ... and get query-string params as well as POST params if necessary
53$q->parse_query_string;
54
55# Convenience; saves changing all references to %webvar
56##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection)
57my %webvar = $q->Vars;
58
59# Why not a global DB handle? (And a global statement handle, as well...)
60# Use the connectDB function, otherwise we end up confusing ourselves
61my $ip_dbh;
62my $errstr;
63($ip_dbh,$errstr) = connectDB_My;
64if (!$ip_dbh) {
65 $webvar{action} = "dberr";
66} else {
67 initIPDBGlobals($ip_dbh);
68}
69
70# Set up some globals
71$ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
72
73my $header = HTML::Template->new(filename => "header.tmpl");
74my $footer = HTML::Template->new(filename => "footer.tmpl");
75
76$header->param(version => $IPDB::VERSION);
77$header->param(addperm => $IPDBacl{$authuser} =~ /a/);
78$header->param(webpath => $IPDB::webpath);
79print "Content-type: text/html\n\n", $header->output;
80
81
82#main()
83my $aclerr;
84
85if(!defined($webvar{action})) {
86 $webvar{action} = "index"; #shuts up the warnings.
87}
88
89my $page;
90if (-e "$ENV{HTML_TEMPLATE_ROOT}/$webvar{action}.tmpl") {
91 $page = HTML::Template->new(filename => "$webvar{action}.tmpl", loop_context_vars => 1, global_vars => 1);
92} else {
93 $page = HTML::Template->new(filename => "dunno.tmpl");
94}
95
96if($webvar{action} eq 'index') {
97 showSummary();
98} elsif ($webvar{action} eq 'addmaster') {
99 if ($IPDBacl{$authuser} !~ /a/) {
100 $aclerr = 'addmaster';
101 }
102} elsif ($webvar{action} eq 'newmaster') {
103
104 if ($IPDBacl{$authuser} !~ /a/) {
105 $aclerr = 'addmaster';
106 } else {
107 my $cidr = new NetAddr::IP $webvar{cidr};
108 $page->param(cidr => "$cidr");
109
110 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr});
111
112 if ($code eq 'FAIL') {
113 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
114 $page->param(err => $msg);
115 } else {
116 syslog "info", "$authuser added master block $webvar{cidr}";
117 }
118
119 } # ACL check
120
121} # end add new master
122
123elsif ($webvar{action} eq 'showsubs') {
124 showSubs();
125}
126
127elsif($webvar{action} eq 'listpool') {
128 showPool();
129}
130
131# Not modified or added; just shuffled
132elsif($webvar{action} eq 'assign') {
133 assignBlock();
134}
135elsif($webvar{action} eq 'confirm') {
136 confirmAssign();
137}
138elsif($webvar{action} eq 'insert') {
139 insertAssign();
140}
141elsif($webvar{action} eq 'edit') {
142 edit();
143}
144elsif($webvar{action} eq 'update') {
145 update();
146}
147elsif($webvar{action} eq 'delete') {
148 remove();
149}
150elsif($webvar{action} eq 'finaldelete') {
151 finalDelete();
152}
153elsif ($webvar{action} eq 'nodesearch') {
154 my $nodelist = getNodeList($ip_dbh);
155 $page->param(nodelist => $nodelist);
156}
157
158# DB failure. Can't do much here, really.
159elsif ($webvar{action} eq 'dberr') {
160 $page->param(errmsg => $errstr);
161}
162
163# Default is an error. It shouldn't be possible to get here unless you're
164# randomly feeding in values for webvar{action}.
165else {
166 my $rnd = rand 500;
167 my $boing = sprintf("%.2f", rand 500);
168 my @excuses = (
169 "Aether cloudy. Ask again later about $webvar{action}.",
170 "The gods are unhappy with your sacrificial $webvar{action}.",
171 "Because one of $webvar{action}'s legs are both the same",
172 "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!",
173 "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....",
174 "I ain't done $webvar{action}",
175 "Oooo, look! A flying $webvar{action}!",
176 "$webvar{action} too evil, avoiding.",
177 "Rocks fall, $webvar{action} dies.",
178 "Bit bucket must be emptied before I can $webvar{action}..."
179 );
180 $page->param(dunno => $excuses[$rnd/50.0]);
181}
182## Finally! Done with that NASTY "case" emulation!
183
184
185# Switch to a different template if we've tripped on an ACL error.
186# Note that this should only be exercised in development, when
187# deeplinked, or when being attacked; normal ACL handling should
188# remove the links a user is not allowed to click on.
189if ($aclerr) {
190 $page = HTML::Template->new(filename => "aclerror.tmpl");
191 $page->param(ipdbfunc => $aclmsg{$aclerr});
192}
193
194# Clean up IPDB globals, DB handle, etc.
195finish($ip_dbh);
196
197## Do all our printing here so we can generate errors and stick them into the slots in the templates.
198
199# can't do this yet, too many blowups
200#print "Content-type: text/html\n\n", $header->output;
201$page->param(webpath => $IPDB::webpath);
202print $page->output;
203
204# include the admin tools link in the output?
205$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
206$footer->param(webpath => $IPDB::webpath);
207print $footer->output;
208
209# Just in case something waaaayyy down isn't in place
210# properly... we exit explicitly.
211exit 0;
212
213
214# Initial display: Show master blocks with total allocated subnets, total free subnets
215sub showSummary {
216 my $masterlist = listSummary($ip_dbh);
217 $page->param(masterlist => $masterlist);
218
219 $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
220} # showSummary
221
222
223# Display blocks immediately within a given parent
224sub showSubs {
225 $page->param(block => $webvar{block});
226 $page->param(mayadd => ($IPDBacl{$authuser} =~ /a/));
227 $page->param(maydel => ($IPDBacl{$authuser} =~ /d/));
228
229 my $sublist = listSubs($ip_dbh, block => $webvar{block}, rdepth => $webvar{rdepth});
230 $page->param(deldepth => $webvar{rdepth} - 1);
231 $page->param(rdepth => $webvar{rdepth});
232 $page->param(subdepth => $webvar{rdepth} + 1);
233 $page->param(sublist => $sublist);
234
235 my $flist = listFree($ip_dbh, master => $webvar{block}, rdepth => $webvar{rdepth});
236 $page->param(freelist => $flist);
237} # showSubs
238
239
240# List the IPs used in a pool
241sub showPool {
242
243 my $cidr = new NetAddr::IP $webvar{pool};
244
245 $page->param(block => $webvar{pool});
246 $page->param(netip => $cidr->addr);
247 $cidr++;
248 $page->param(gate => $cidr->addr);
249 $cidr--; $cidr--;
250 $page->param(bcast => $cidr->addr);
251 $page->param(mask => $cidr->mask);
252
253 # Snag pool info for heading
254 my $poolinfo = getBlockData($ip_dbh, $webvar{pool}, $webvar{rdepth});
255
256 $page->param(disptype => $disp_alloctypes{$poolinfo->{type}});
257 $page->param(city => $poolinfo->{city});
258
259 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
260 $page->param(realblock => $poolinfo->{type} =~ /^.d$/);
261
262# probably have to add an "edit IP allocation" link here somewhere.
263
264 my $plist = listPool($ip_dbh, $webvar{pool});
265 # technically slightly more efficient to check the ACL in an if () once outside the foreach
266 foreach (@{$plist}) {
267 $$_{maydel} = $IPDBacl{$authuser} =~ /d/;
268 }
269 $page->param(poolips => $plist);
270} # end showPool
271
272
273# Show "Add new allocation" page. Note that the actual page may
274# be one of two templates, and the lists come from the database.
275sub assignBlock {
276
277 if ($IPDBacl{$authuser} !~ /a/) {
278 $aclerr = 'addblock';
279 return;
280 }
281
282 # hack pthbttt eww
283 $webvar{block} = '' if !$webvar{block};
284
285# hmm. TMPL_IF block and TMPL_ELSE block on these instead?
286 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
287 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
288 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
289 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y'));
290
291 # New special case- block to assign is specified
292 if ($webvar{block} ne '') {
293 my $block = new NetAddr::IP $webvar{block};
294
295 # Handle contained freeblock allocation.
296 # This is a little dangerous, as it's *theoretically* possible to
297 # get fbtype='n' (aka a non-routed freeblock). However, should
298 # someone manage to get there, they get what they deserve.
299 if ($webvar{fbtype} ne 'y') {
300 # Snag the type of the container block from the database.
301## hmm. need a flag for parent class/type, sort of?
302 my $pblock = subParent($ip_dbh, $webvar{block});
303 my $ptype = $pblock->{type};
304 $ptype =~ s/c$/r/;
305 $page->param(fbdisptype => $list_alloctypes{$ptype});
306 $page->param(type => $ptype);
307 } else {
308 # get "primary" alloctypes, since these are all that can correctly be assigned if we're in this branch
309 my $tlist = getTypeList($ip_dbh, 'p');
310 $tlist->[0]->{sel} = 1;
311 $page->param(typelist => $tlist);
312 }
313 } else {
314 my $mlist = getMasterList($ip_dbh, 'c');
315 $page->param(masterlist => $mlist);
316
317 my @pops;
318 foreach my $pop (@poplist) {
319 my %row = (pop => $pop);
320 push (@pops, \%row);
321 }
322 $page->param(pops => \@pops);
323
324 # get all standard alloctypes
325 my $tlist = getTypeList($ip_dbh, 'a');
326 $tlist->[0]->{sel} = 1;
327 $page->param(typelist => $tlist);
328 }
329
330 my @cities;
331 foreach my $city (@citylist) {
332 my %row = (city => $city);
333 push (@cities, \%row);
334 }
335 $page->param(citylist => \@cities);
336
337## node hack
338 my $nlist = getNodeList($ip_dbh);
339 $page->param(nodelist => $nlist);
340## end node hack
341
342 $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
343
344} # assignBlock
345
346
347# Take info on requested IP assignment and see what we can provide.
348sub confirmAssign {
349 if ($IPDBacl{$authuser} !~ /a/) {
350 $aclerr = 'addblock';
351 return;
352 }
353
354 my $cidr;
355 my $alloc_from;
356
357 # Going to manually validate some items.
358 # custid and city are automagic.
359 return if !validateInput();
360
361# Several different cases here.
362# Static IP vs netblock
363# + Different flavours of static IP
364# + Different flavours of netblock
365
366 if ($webvar{alloctype} =~ /^.i$/) {
367 my $plist = getPoolSelect($ip_dbh, $webvar{alloctype}, $webvar{pop});
368 $page->param(staticip => 1);
369 $page->param(poollist => $plist) if $plist;
370 $cidr = "Single static IP";
371##fixme: need to handle "no available pools"
372
373 } else { # end show pool options
374
375 if ($webvar{fbassign} && $webvar{fbassign} eq 'y') {
376 $cidr = new NetAddr::IP $webvar{block};
377 $webvar{maskbits} = $cidr->masklen;
378 } else { # done with direct freeblocks assignment
379
380 if (!$webvar{maskbits}) {
381 $page->param(err => "Please specify a CIDR mask length.");
382 return;
383 }
384
385##fixme ick, ew, bleh. gotta handle the failure message generation better. push it into findAllocateFrom()?
386 my $failmsg = "No suitable free block found.<br>\n";
387 if ($webvar{alloctype} eq 'rm') {
388 $failmsg .= "We do not have a free routeable block of that size.<br>\n".
389 "You will have to either route a set of smaller netblocks or a single smaller netblock.";
390 } else {
391 if ($webvar{alloctype} =~ /^.[pc]$/) {
392 $failmsg .= "You will have to route another superblock from one of the<br>\n".
393 "master blocks or chose a smaller block size for the pool.";
394 } else {
395 if (!$webvar{pop}) {
396 $page->param(err => 'Please select a POP to route the block from/through.');
397 return;
398 }
399 $failmsg .= "You will have to route another superblock to $webvar{pop}<br>\n".
400 "from one of the master blocks or chose a smaller blocksize.";
401 }
402 }
403
404 $cidr = findAllocateFrom($ip_dbh, $webvar{maskbits}, $webvar{alloctype}, $webvar{city}, $webvar{pop},
405 (master => $webvar{allocfrom}, allowpriv => $webvar{allowpriv}) );
406 if (!$cidr) {
407 $page->param(err => $failmsg);
408 return;
409 }
410 $cidr = new NetAddr::IP $cidr;
411 } # check for freeblocks assignment or IPDB-controlled assignment
412
413 $alloc_from = "$cidr";
414
415 # If the block to be allocated is smaller than the one we found,
416 # figure out the "real" block to be allocated.
417 if ($cidr->masklen() ne $webvar{maskbits}) {
418 my $maskbits = $cidr->masklen();
419 my @subblocks;
420 while ($maskbits++ < $webvar{maskbits}) {
421 @subblocks = $cidr->split($maskbits);
422 }
423 $cidr = $subblocks[0];
424 }
425 } # if ($webvar{alloctype} =~ /^.i$/)
426
427## node hack
428 if ($webvar{node} && $webvar{node} ne '-') {
429 my $nodename = getNodeName($ip_dbh, $webvar{node});
430 $page->param(nodename => $nodename);
431 $page->param(nodeid => $webvar{node});
432 }
433## end node hack
434
435 # Stick in the allocation data
436 $page->param(alloc_type => $webvar{alloctype});
437 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
438 $page->param(alloc_from => $alloc_from);
439 $page->param(cidr => $cidr);
440 $page->param(city => $q->escapeHTML($webvar{city}));
441 $page->param(custid => $webvar{custid});
442 $page->param(circid => $q->escapeHTML($webvar{circid}));
443 $page->param(desc => $q->escapeHTML($webvar{desc}));
444
445##fixme: find a way to have the displayed copy have <br> substitutions
446# for newlines, and the <input> value have either encoded or bare newlines.
447# Also applies to privdata.
448 $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
449
450 # Check to see if user is allowed to do anything with sensitive data
451 my $privdata = '';
452 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
453 if $IPDBacl{$authuser} =~ /s/;
454
455 # Yay! This now has it's very own little home.
456 $page->param(billinguser => $webvar{userid})
457 if $webvar{userid};
458
459##fixme: this is only needed iff confirm.tmpl and
460# confirmRemove.tmpl are merged (quite possible, just
461# a little tedious)
462 $page->param(action => "insert");
463
464} # end confirmAssign
465
466
467# Do the work of actually inserting a block in the database.
468sub insertAssign {
469 if ($IPDBacl{$authuser} !~ /a/) {
470 $aclerr = 'addblock';
471 return;
472 }
473 # Some things are done more than once.
474 return if !validateInput();
475
476 if (!defined($webvar{privdata})) {
477 $webvar{privdata} = '';
478 }
479 # $code is "success" vs "failure", $msg contains OK for a
480 # successful netblock allocation, the IP allocated for static
481 # IP, or the error message if an error occurred.
482
483 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
484 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
485 $webvar{circid}, $webvar{privdata}, $webvar{node});
486
487 if ($code eq 'OK') {
488 if ($webvar{alloctype} =~ /^.i$/) {
489 $msg =~ s|/32||;
490 $page->param(staticip => $msg);
491 $page->param(custid => $webvar{custid});
492 $page->param(billinguser => $webvar{billinguser});
493 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
494 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
495 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
496 } else {
497 my $netblock = new NetAddr::IP $webvar{fullcidr};
498 $page->param(fullcidr => $webvar{fullcidr});
499 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
500 $page->param(custid => $webvar{custid});
501 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
502 $page->param(billinguser => $webvar{billinguser});
503 $page->param(custid => $webvar{custid});
504 $page->param(netaddr => $netblock->addr);
505 $page->param(masklen => $netblock->masklen);
506 }
507 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
508 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
509 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
510 }
511 syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
512 "'$webvar{alloctype}' ($msg)";
513 } else {
514 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
515 "'$webvar{alloctype}' by $authuser failed: '$msg'";
516 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
517 " failed:<br>\n$msg\n");
518 }
519
520} # end insertAssign()
521
522
523# Does some basic checks on common input data to make sure nothing
524# *really* weird gets in to the database through this script.
525# Does NOT do complete input validation!!!
526sub validateInput {
527 if ($webvar{city} eq '-') {
528 $page->param(err => 'Please choose a city');
529 return;
530 }
531
532 # Alloctype check.
533 chomp $webvar{alloctype};
534 if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
535 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
536 # managing to call things in such a way as to cause this deserves a cryptic error.
537 $page->param(err => 'Invalid alloctype');
538 return;
539 }
540
541 # CustID check
542 # We have different handling for customer allocations and "internal" or "our" allocations
543 if ($def_custids{$webvar{alloctype}} eq '') {
544 if (!$webvar{custid}) {
545 $page->param(err => 'Please enter a customer ID.');
546 return;
547 }
548 # Crosscheck with billing.
549 my $status = CustIDCK->custid_exist($webvar{custid});
550 if ($CustIDCK::Error) {
551 $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
552 return;
553 }
554 if (!$status) {
555 $page->param(err => "Customer ID not valid. Make sure the Customer ID ".
556 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
557 "non-customer assignments.");
558 return;
559 }
560# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
561 } else {
562 # New! Improved! And now Loaded From The Database!!
563 if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
564 $webvar{custid} = $def_custids{$webvar{alloctype}};
565 }
566 }
567
568 # Check POP location
569 my $flag;
570 if ($webvar{alloctype} eq 'rm') {
571 $flag = 'for a routed netblock';
572 foreach (@poplist) {
573 if (/^$webvar{city}$/) {
574 $flag = 'n';
575 last;
576 }
577 }
578 } else {
579 $flag = 'n';
580##fixme: hook to force-set POP or city on certain alloctypes
581# if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
582 if ($webvar{pop} && $webvar{pop} =~ /^-$/) {
583 $flag = 'to route the block from/through';
584 }
585 }
586
587 # if the alloctype has a restricted city/POP list as determined above,
588 # and the reqested city/POP does not match that list, complain
589 if ($flag ne 'n') {
590 $page->param(err => "Please choose a valid POP location $flag. Valid ".
591 "POP locations are currently:<br>\n".join (" - ", @poplist));
592 return;
593 }
594
595 return 'OK';
596} # end validateInput
597
598
599# Displays details of a specific allocation in a form
600# Allows update/delete
601# action=edit
602sub edit {
603
604 # snag block info from db
605 my $blockinfo = getBlockData($ip_dbh, $webvar{block});
606
607 # Clean up extra whitespace on alloc type. Mainly a legacy-data cleanup.
608 $blockinfo->{type} =~ s/\s//;
609
610 $page->param(block => $webvar{block});
611
612 $page->param(custid => $blockinfo->{custid});
613 $page->param(city => $blockinfo->{city});
614 $page->param(circid => $blockinfo->{circuitid});
615 $page->param(desc => $blockinfo->{description});
616 $page->param(notes => $blockinfo->{notes});
617
618##fixme The check here should be built from the database
619# Need to expand to support pool types too
620 if ($blockinfo->{type} =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
621 $page->param(changetype => 1);
622 $page->param(alloctype => [
623 { selme => ($blockinfo->{type} eq 'me'), type => "me", disptype => "Dialup netblock" },
624 { selme => ($blockinfo->{type} eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
625 { selme => ($blockinfo->{type} eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
626 { selme => ($blockinfo->{type} eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
627 { selme => ($blockinfo->{type} eq 'cn'), type => "cn", disptype => "Customer netblock" },
628 { selme => ($blockinfo->{type} eq 'en'), type => "en", disptype => "End-use netblock" },
629 { selme => ($blockinfo->{type} eq 'in'), type => "in", disptype => "Internal netblock" },
630 ]
631 );
632 } else {
633 $page->param(disptype => $disp_alloctypes{$blockinfo->{type}});
634 $page->param(type => $blockinfo->{type});
635 }
636
637## node hack
638 my ($nodeid,$nodename) = getNodeInfo($ip_dbh, $webvar{block});
639 $page->param(havenodeid => $nodeid);
640
641 if ($blockinfo->{type} eq 'fr' || $blockinfo->{type} eq 'bi') {
642 $page->param(typesupportsnodes => 1);
643 $page->param(nodename => $nodename);
644
645##fixme: this whole hack needs cleanup and generalization for all alloctypes
646##fixme: arguably a bug that presence of a nodeid implies it can be changed..
647# but except for manual database changes, only the two types fr and bi can
648# (currently) have a nodeid set in the first place.
649 if ($IPDBacl{$authuser} =~ /c/) {
650 my $nlist = getNodeList($ip_dbh);
651 foreach (@{$nlist}) {
652 $$_{selme} = ($$_{node_id} == $nodeid);
653 }
654 $page->param(nodelist => $nlist);
655 }
656 }
657## end node hack
658
659 my ($lastmod,undef) = split /\s+/, $blockinfo->{lastmod};
660 $page->param(lastmod => $lastmod);
661
662 # not happy with the upside-down logic, but...
663 $page->param(swipable => $blockinfo->{type} !~ /.i/);
664 $page->param(swip => $blockinfo->{swip} ne 'n') if $blockinfo->{swip};
665
666 # Check to see if we can display sensitive data
667 $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
668 $page->param(privdata => $blockinfo->{privdata});
669
670 # ACL trickery - these two template booleans control the presence of all form/input tags
671 $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
672 $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
673
674} # edit()
675
676
677# Stuff new info about a block into the db
678# action=update
679sub update {
680 if ($IPDBacl{$authuser} !~ /c/) {
681 $aclerr = 'updateblock';
682 return;
683 }
684
685 # Make sure incoming data is in correct format - custID among other things.
686 return if !validateInput;
687
688 $webvar{swip} = 'n' if !$webvar{swip};
689
690 my %updargs = (
691 custid => $webvar{custid},
692 city => $webvar{city},
693 description => $webvar{desc},
694 notes => $webvar{notes},
695 circuitid => $webvar{circid},
696 block => $webvar{block},
697 type => $webvar{alloctype},
698 swip => $webvar{swip},
699 );
700
701 # Semioptional values
702 $updargs{privdata} = $webvar{privdata} if $IPDBacl{$authuser} =~ /s/;
703 $updargs{node} = $webvar{node} if $webvar{node};
704
705 my ($code,$msg) = updateBlock($ip_dbh, %updargs);
706
707 if ($code eq 'FAIL') {
708 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
709 $page->param(err => "Could not update block/IP $webvar{block}: $msg");
710 return;
711 }
712
713 # If we get here, the operation succeeded.
714 syslog "notice", "$authuser updated $webvar{block}";
715##fixme: log details of the change? old way is in the .debug stream anyway.
716##fixme: need to wedge something in to allow "update:field" notifications
717## hmm. how to tell what changed? O_o
718mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
719 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
720
721## node hack
722 if ($webvar{node} && $webvar{node} ne '-') {
723 my $nodename = getNodeName($ip_dbh, $webvar{node});
724 $page->param(nodename => $nodename);
725 }
726## end node hack
727
728 # Link back to browse-routed or list-pool page on "Update complete" page.
729 my $cblock;
730 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
731 $page->param(backpool => 1);
732 $cblock = ipParent($ip_dbh, $webvar{block});
733 } else {
734 $cblock = blockParent($ip_dbh, $webvar{block});
735 }
736 $page->param(backblock => $cblock->{cidr});
737
738 # Do some HTML fiddling here instead of using ESCAPE=HTML in the template,
739 # because otherwise we can't convert \n to <br>. *sigh*
740 $webvar{notes} = $q->escapeHTML($webvar{notes}); # escape first...
741 $webvar{notes} =~ s/\n/<br>\n/; # ... then convert newlines
742 $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : "&nbsp;");
743 $webvar{privdata} =~ s/\n/<br>\n/;
744
745 $page->param(cidr => $webvar{block});
746 $page->param(city => $webvar{city});
747 $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
748 $page->param(custid => $webvar{custid});
749 $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
750 $page->param(circid => $webvar{circid});
751 $page->param(desc => $webvar{desc});
752 $page->param(notes => $webvar{notes});
753 $page->param(privdata => $webvar{privdata})
754 if $IPDBacl{$authuser} =~ /s/;
755
756} # update()
757
758
759# Delete an allocation.
760sub remove {
761 if ($IPDBacl{$authuser} !~ /d/) {
762 $aclerr = 'delblock';
763 return;
764 }
765
766 # Serves'em right for getting here...
767 if (!defined($webvar{block})) {
768 $page->param(err => "Can't delete a block that doesn't exist");
769 return;
770 }
771
772 my $blockdata;
773
774 if ($webvar{alloctype} eq 'rm') {
775
776 $blockdata->{block} = $webvar{block};
777 $blockdata->{city} = getRoutedCity($ip_dbh, $webvar{block});
778 $blockdata->{custid} = "N/A";
779 $blockdata->{type} = $webvar{alloctype};
780 $blockdata->{circuitid} = "N/A";
781 $blockdata->{description} = "N/A";
782 $blockdata->{notes} = "N/A";
783 $blockdata->{privdata} = "N/A";
784
785 } elsif ($webvar{alloctype} eq 'mm') {
786
787 $blockdata->{block} = $webvar{block};
788 $blockdata->{city} = "N/A";
789 $blockdata->{custid} = "N/A";
790 $blockdata->{type} = $webvar{alloctype};
791 $blockdata->{circuitid} = "N/A";
792 $blockdata->{description} = "N/A";
793 $blockdata->{notes} = "N/A";
794 $blockdata->{privdata} = "N/A";
795
796 } else {
797
798 $blockdata = getBlockData($ip_dbh, $webvar{block})
799
800 } # end cases for different alloctypes
801
802 $page->param(block => $blockdata->{block});
803 $page->param(disptype => $disp_alloctypes{$blockdata->{type}});
804 $page->param(type => $blockdata->{type});
805 $page->param(city => $blockdata->{city});
806 $page->param(custid => $blockdata->{custid});
807 $page->param(circid => $blockdata->{circuitid});
808 $page->param(desc => $blockdata->{description});
809 $blockdata->{notes} = $q->escapeHTML($blockdata->{notes});
810 $blockdata->{notes} =~ s/\n/<br>\n/;
811 $page->param(notes => $blockdata->{notes});
812 $blockdata->{privdata} = $q->escapeHTML($blockdata->{privdata});
813 $blockdata->{privdata} = '&nbsp;' if !$blockdata->{privdata};
814 $blockdata->{privdata} =~ s/\n/<br>\n/;
815 $page->param(privdata => $blockdata->{privdata}) if $IPDBacl{$authuser} =~ /s/;
816 $page->param(delpool => $blockdata->{type} =~ /^.[pd]$/);
817
818} # end remove()
819
820
821# Delete an allocation. Return it to the freeblocks table; munge
822# data as necessary to keep as few records as possible in freeblocks
823# to prevent weirdness when allocating blocks later.
824# Remove IPs from pool listing if necessary
825sub finalDelete {
826 if ($IPDBacl{$authuser} !~ /d/) {
827 $aclerr = 'delblock';
828 return;
829 }
830
831 # need to retrieve block data before deleting so we can notify on that
832 my $blockinfo = getBlockData($ip_dbh, $webvar{block});
833
834 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
835
836 $page->param(block => $webvar{block});
837 if ($code eq 'OK') {
838 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block} ".
839 $blockinfo->{custid}.", ".$blockinfo->{city}.", desc='".$blockinfo->{description}."'";
840 mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
841 "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
842 "CustID: ".$blockinfo->{custid}."\nCity: ".$blockinfo->{city}.
843 "\nDescription: ".$blockinfo->{description}."\n");
844 } else {
845 $page->param(failmsg => $msg);
846 if ($webvar{alloctype} =~ /^.i$/) {
847 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
848 } else {
849 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
850 $page->param(netblock => 1);
851 }
852 }
853
854} # finalDelete
Note: See TracBrowser for help on using the repository browser.