source: branches/htmlform/cgi-bin/main.cgi@ 471

Last change on this file since 471 was 471, checked in by Kris Deugau, 14 years ago

/branches/htmlform

Convert listpool to template. See #3.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 42.4 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3###
4# SVN revision info
5# $Date: 2010-08-17 20:33:43 +0000 (Tue, 17 Aug 2010) $
6# SVN revision $Rev: 471 $
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 CommonWeb qw(:ALL);
18use CustIDCK;
19use POSIX qw(ceil);
20use NetAddr::IP;
21
22use Sys::Syslog;
23
24# don't remove! required for GNU/FHS-ish install from tarball
25##uselib##
26
27use MyIPDB;
28
29openlog "IPDB","pid","$IPDB::syslog_facility";
30
31# Collect the username from HTTP auth. If undefined, we're in
32# a test environment, or called without a username.
33my $authuser;
34if (!defined($ENV{'REMOTE_USER'})) {
35 $authuser = '__temptest';
36} else {
37 $authuser = $ENV{'REMOTE_USER'};
38}
39
40syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
41
42# Why not a global DB handle? (And a global statement handle, as well...)
43# Use the connectDB function, otherwise we end up confusing ourselves
44my $ip_dbh;
45my $sth;
46my $errstr;
47($ip_dbh,$errstr) = connectDB_My;
48if (!$ip_dbh) {
49 exitError("Database error: $errstr\n");
50}
51initIPDBGlobals($ip_dbh);
52
53# Set up some globals
54##fixme - need to autofill this somehow
55$ENV{HTML_TEMPLATE_ROOT} = '/home/kdeugau/dev/ipdb/trunk/templates';
56
57my $header = HTML::Template->new(filename => "header.tmpl");
58my $footer = HTML::Template->new(filename => "footer.tmpl");
59
60$header->param(version => $IPDB::VERSION);
61$header->param(addperm => $IPDBacl{$authuser} =~ /a/);
62print "Content-type: text/html\n\n", $header->output;
63
64# Set up the CGI object...
65my $q = new CGI::Simple;
66# ... and get query-string params as well as POST params if necessary
67$q->parse_query_string;
68
69# Convenience; saves changing all references to %webvar
70##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection)
71my %webvar = $q->Vars;
72
73
74#main()
75
76if(!defined($webvar{action})) {
77 $webvar{action} = "index"; #shuts up the warnings.
78}
79
80my $page = HTML::Template->new(filename => "$webvar{action}.tmpl");
81
82if($webvar{action} eq 'index') {
83 showSummary();
84} elsif ($webvar{action} eq 'addmaster') {
85 if ($IPDBacl{$authuser} !~ /a/) {
86 printError("You shouldn't have been able to get here. Access denied.");
87 } else {
88 open HTML, "<../addmaster.html";
89 print while <HTML>;
90 }
91} elsif ($webvar{action} eq 'newmaster') {
92
93 if ($IPDBacl{$authuser} !~ /a/) {
94 printError("You shouldn't have been able to get here. Access denied.");
95 } else {
96
97 my $cidr = new NetAddr::IP $webvar{cidr};
98
99 print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
100
101 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr});
102
103 if ($code eq 'FAIL') {
104 carp "Transaction aborted because $msg";
105 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
106 printError("Could not add master block $webvar{cidr} to database: $msg");
107 } else {
108 print "<div type=heading align=center>Success!</div>\n";
109 syslog "info", "$authuser added master block $webvar{cidr}";
110 }
111
112 } # ACL check
113
114} # end add new master
115
116elsif($webvar{action} eq 'showmaster') {
117 showMaster();
118}
119elsif($webvar{action} eq 'showrouted') {
120 showRBlock();
121}
122elsif($webvar{action} eq 'listpool') {
123 listPool();
124}
125
126# Not modified or added; just shuffled
127elsif($webvar{action} eq 'assign') {
128 assignBlock();
129}
130elsif($webvar{action} eq 'confirm') {
131 confirmAssign();
132}
133elsif($webvar{action} eq 'insert') {
134 insertAssign();
135}
136elsif($webvar{action} eq 'edit') {
137 edit();
138}
139elsif($webvar{action} eq 'update') {
140 update();
141}
142elsif($webvar{action} eq 'delete') {
143 remove();
144}
145elsif($webvar{action} eq 'finaldelete') {
146 finalDelete();
147}
148elsif ($webvar{action} eq 'nodesearch') {
149 open HTML, "<../nodesearch.html";
150 my $html = join('',<HTML>);
151 close HTML;
152
153 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
154 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
155 my $nodes = '';
156 while (my ($nid,$nname) = $sth->fetchrow_array()) {
157 $nodes .= "<option value='$nid'>$nname</option>\n";
158 }
159 $html =~ s/\$\$NODELIST\$\$/$nodes/;
160
161 print $html;
162}
163
164# Default is an error. It shouldn't be possible to easily get here.
165# The only way I can think of offhand is to just call main.cgi bare-
166# which is not in any way guaranteed to provide anything useful.
167else {
168 my $rnd = rand 500;
169 my $boing = sprintf("%.2f", rand 500);
170 my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.",
171 "Because one of it's legs are both the same", "*wibble*",
172 "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
173 "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
174 printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
175}
176## Finally! Done with that NASTY "case" emulation!
177
178
179
180# Clean up IPDB globals, DB handle, etc.
181finish($ip_dbh);
182
183#print qq(<div align=right style="position: absolute; right: 30px;">).
184# qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
185# if $IPDBacl{$authuser} =~ /A/;
186
187## Do all our printing here so we can generate errors and stick them into the slots in the templates.
188
189# can't do this yet, too many blowups
190#print "Content-type: text/html\n\n", $header->output;
191
192print $page->output;
193
194# include the admin tools link in the output?
195$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
196
197print $footer->output;
198
199# Just in case something waaaayyy down isn't in place
200# properly... we exit explicitly.
201exit;
202
203
204
205# args are: a reference to an array with the row to be printed and the
206# class(stylesheet) to use for formatting.
207# if ommitting the class - call the sub as &printRow(\@array)
208sub printRow {
209 my ($rowRef,$class) = @_;
210
211 if (!$class) {
212 print "<tr>\n";
213 } else {
214 print "<tr class=\"$class\">\n";
215 }
216
217ELEMENT: foreach my $element (@$rowRef) {
218 if (!defined($element)) {
219 print "<td></td>\n";
220 next ELEMENT;
221 }
222 $element =~ s|\n|</br>|g;
223 print "<td>$element</td>\n";
224 }
225 print "</tr>";
226} # printRow
227
228
229# Prints table headings. Accepts any number of arguments;
230# each argument is a table heading.
231sub startTable {
232 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
233
234 foreach(@_) {
235 print qq(<td class="heading">$_</td>);
236 }
237 print "</tr>\n";
238} # startTable
239
240
241# Initial display: Show master blocks with total allocated subnets, total free subnets
242sub showSummary {
243 my %allocated;
244 my %free;
245 my %routed;
246 my %bigfree;
247
248 # Count the allocations.
249 $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
250 foreach my $master (@masterblocks) {
251 $sth->execute("$master");
252 $sth->bind_columns(\$allocated{"$master"});
253 $sth->fetch();
254 }
255
256 # Count routed blocks
257 $sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
258 foreach my $master (@masterblocks) {
259 $sth->execute("$master");
260 $sth->bind_columns(\$routed{"$master"});
261 $sth->fetch();
262 }
263
264 # Count the free blocks.
265 $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
266 "(routed='y' or routed='n')");
267 foreach my $master (@masterblocks) {
268 $sth->execute("$master");
269 $sth->bind_columns(\$free{"$master"});
270 $sth->fetch();
271 }
272
273 # Find the largest free block in each master
274 $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
275 "(routed='y' or routed='n') order by maskbits limit 1");
276 foreach my $master (@masterblocks) {
277 $sth->execute("$master");
278 $sth->bind_columns(\$bigfree{"$master"});
279 $sth->fetch();
280 }
281
282 # Assemble the data to stuff into the template.
283 my @masterlist;
284 my $rowclass=0;
285 foreach my $master (@masterblocks) {
286 my %row = (rowclass => "row$rowclass",
287 master => "$master",
288 routed => $routed{"$master"},
289 allocated => $allocated{"$master"},
290 free => $free{"$master"},
291 bigfree => ( ($bigfree{"$master"} eq '') ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
292 );
293 push (@masterlist, \%row);
294 $rowclass++; $rowclass = $rowclass % 2;
295 }
296 $page->param(masterlist => \@masterlist);
297
298 $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
299
300} # showSummary
301
302
303# Display detail on master
304# Alrighty then! We're showing routed blocks within a single master this time.
305# We should be able to steal code from showSummary(), and if I'm really smart
306# I'll figger a way to munge the two together. (Once I've done that, everything
307# else should follow. YMMV.)
308sub showMaster {
309
310 $page->param(master => $webvar{block});
311
312 my %allocated;
313 my %free;
314 my %cities;
315 my %bigfree;
316
317 my $master = new NetAddr::IP $webvar{block};
318 my @localmasters;
319
320 # Fetch only the blocks relevant to this master
321 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr <<= '$master' order by cidr");
322 $sth->execute();
323
324 my $i=0;
325 while (my @data = $sth->fetchrow_array()) {
326 my $cidr = new NetAddr::IP $data[0];
327 $localmasters[$i++] = $cidr;
328 $free{"$cidr"} = 0;
329 $allocated{"$cidr"} = 0;
330 $bigfree{"$cidr"} = 128;
331 # Retain the routing destination
332 $cities{"$cidr"} = $data[1];
333 }
334
335 # Check if there were actually any blocks routed from this master
336 if ($i > 0) {
337
338 # Count the allocations
339 $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
340 foreach my $master (@localmasters) {
341 $sth->execute("$master");
342 $sth->bind_columns(\$allocated{"$master"});
343 $sth->fetch();
344 }
345
346 # Count the free blocks.
347 $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
348 "(routed='y' or routed='n')");
349 foreach my $master (@localmasters) {
350 $sth->execute("$master");
351 $sth->bind_columns(\$free{"$master"});
352 $sth->fetch();
353 }
354
355 # Get the size of the largest free block
356 $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
357 "(routed='y' or routed='n') order by maskbits limit 1");
358 foreach my $master (@localmasters) {
359 $sth->execute("$master");
360 $sth->bind_columns(\$bigfree{"$master"});
361 $sth->fetch();
362 }
363
364 my @routed;
365 my $rowclass = 0;
366 foreach my $master (@localmasters) {
367 my %row = (
368 rowclass => $rowclass % 2,
369 block => "$master",
370 city => $cities{"$master"},
371 nsubs => $allocated{"$master"},
372 nfree => $free{"$master"},
373 lfree => ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
374 );
375 push @routed, \%row;
376 $rowclass++;
377 }
378 $page->param(routedlist => \@routed);
379
380 } # end check for existence of routed blocks in master
381
382 $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/));
383
384 # Snag the free blocks.
385 my $count = 0;
386 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
387 "routed='n' order by cidr");
388 $sth->execute();
389 my @unrouted;
390 my $rowclass = 0;
391 while (my @data = $sth->fetchrow_array()) {
392 my $cidr = new NetAddr::IP $data[0];
393 my %row = (
394 rowclass => $rowclass % 2,
395 fblock => "$cidr",
396 frange => $cidr->range
397 );
398 push @unrouted, \%row;
399 $rowclass++;
400 }
401 $page->param(unrouted => \@unrouted);
402
403} # showMaster
404
405
406# Display details of a routed block
407# Alrighty then! We're showing allocations within a routed block this time.
408# We should be able to steal code from showSummary() and showMaster(), and if
409# I'm really smart I'll figger a way to munge all three together. (Once I've
410# done that, everything else should follow. YMMV.
411# This time, we check the database before spewing, because we may
412# not have anything useful to spew.
413sub showRBlock {
414
415 my $master = new NetAddr::IP $webvar{block};
416
417 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
418 $sth->execute;
419 my ($rcity) = $sth->fetchrow_array;
420
421 $page->param(master => "$master");
422 $page->param(rcity => $rcity);
423
424 # Snag the allocations for this block
425 $sth = $ip_dbh->prepare("select cidr,city,type,custid,swip,description".
426 " from allocations where cidr <<= '$master' order by cidr");
427 $sth->execute();
428
429 # hack hack hack
430 # set up to flag swip=y records if they don't actually have supporting data in the customers table
431 my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
432
433 my $rowclass = 0;
434 my @blocklist;
435 while (my ($cidr,$city,$type,$custid,$swip,$desc) = $sth->fetchrow_array()) {
436 $custsth->execute($custid);
437 my ($ncust) = $custsth->fetchrow_array();
438
439 my %row = (
440 rowclass => $rowclass++ % 2,
441 block => $cidr,
442 city => $city,
443 type => $disp_alloctypes{$type},
444 custid => $custid,
445 swip => ($swip eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'),
446 desc => $desc
447 );
448 $row{subblock} = ($type =~ /^.r$/); # hmf. wonder why these won't work in the hash declaration...
449 $row{listpool} = ($type =~ /^.[pd]$/);
450 push (@blocklist, \%row);
451 }
452 $page->param(blocklist => \@blocklist);
453
454 $page->param(delrouted => $IPDBacl{$authuser} =~ /d/);
455
456 # Snag the free blocks. We don't really *need* to be pedantic about avoiding
457 # unrouted free blocks, but it's better to let the database do the work if we can.
458 $rowclass = 0;
459 my @unassigned;
460 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
461 " order by cidr");
462 $sth->execute();
463 while (my ($cidr_db,$routed) = $sth->fetchrow_array()) {
464 my $cidr = new NetAddr::IP $cidr_db;
465
466 my %row = (
467 rowclass => $rowclass++ % 2,
468 subblock => ($routed ne 'y' && $routed ne 'n'),
469 fblock => $cidr_db,
470 fbtype => $routed,
471 frange => $cidr->range,
472 );
473 push @unassigned, \%row;
474 }
475 $page->param(unassigned => \@unassigned);
476
477} # showRBlock
478
479
480# List the IPs used in a pool
481sub listPool {
482
483 my $cidr = new NetAddr::IP $webvar{pool};
484
485 $page->param(block => $webvar{pool});
486 $page->param(netip => $cidr->addr);
487 $cidr++;
488 $page->param(gate => $cidr->addr);
489 $cidr--; $cidr--;
490 $page->param(bcast => $cidr->addr);
491 $page->param(mask => $cidr->mask);
492
493 # Snag pool info for heading
494 $sth = $ip_dbh->prepare("select type,city from allocations where cidr=?");
495 $sth->execute($webvar{pool});
496 my ($pooltype, $poolcity) = $sth->fetchrow_array;
497
498 $page->param(disptype => $disp_alloctypes{$pooltype});
499 $page->param(city => $poolcity);
500
501# print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
502# qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
503 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
504 $page->param(realblock => $pooltype =~ /^.d$/);
505
506# probably have to add an "edit IP allocation" link here somewhere.
507
508 $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
509 " from poolips where pool='$webvar{pool}' order by ip");
510 $sth->execute;
511 my @poolips;
512 my $rowclass = 0;
513 while (my ($ip,$custid,$available,$desc,$type) = $sth->fetchrow_array) {
514 my %row = (
515 rowclass => $rowclass++ % 2,
516 ip => $ip,
517 custid => $custid,
518 available => $available,
519 desc => $desc,
520 maydel => $IPDBacl{$authuser} =~ /d/,
521 delme => $available eq 'n'
522 );
523 push @poolips, \%row;
524 }
525 $page->param(poolips => \@poolips);
526
527} # end listPool
528
529
530# Show "Add new allocation" page. Note that the actual page may
531# be one of two templates, and the lists come from the database.
532sub assignBlock {
533
534 if ($IPDBacl{$authuser} !~ /a/) {
535 printError("You shouldn't have been able to get here. Access denied.");
536 return;
537 }
538
539 # hack pthbttt eww
540 $webvar{block} = '' if !$webvar{block};
541
542# hmm. TMPL_IF block and TMPL_ELSE block on these instead?
543 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
544 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
545 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
546 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y'));
547
548 # New special case- block to assign is specified
549 if ($webvar{block} ne '') {
550 my $block = new NetAddr::IP $webvar{block};
551
552 # Handle contained freeblock allocation.
553 # This is a little dangerous, as it's *theoretically* possible to
554 # get fbtype='n' (aka a non-routed freeblock). However, should
555 # someone manage to get there, they get what they deserve.
556 if ($webvar{fbtype} ne 'y') {
557 # Snag the type of the container block from the database.
558 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
559 $sth->execute;
560 my @data = $sth->fetchrow_array;
561 $data[0] =~ s/c$/r/; # Munge the type into the correct form
562 $page->param(fbdisptype => $list_alloctypes{$data[0]});
563 $page->param(type => $data[0]);
564 } else {
565 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
566 "and type not like '_i' and type not like '_r' order by listorder");
567 $sth->execute;
568 my @data = $sth->fetchrow_array;
569 my @typelist;
570 my $selflag = 0;
571 while (my @data = $sth->fetchrow_array) {
572 my %row = (tval => $data[0],
573 type => $data[1],
574 sel => ($selflag == 0 ? ' selected' : '')
575 );
576 push (@typelist, \%row);
577 $selflag++;
578 }
579 $page->param(typelist => \@typelist);
580 }
581 } else {
582 my @masterlist;
583 foreach my $master (@masterblocks) {
584 my %row = (master => "$master");
585 push (@masterlist, \%row);
586 }
587 $page->param(masterlist => \@masterlist);
588
589 my @pops;
590 foreach my $pop (@poplist) {
591 my %row = (pop => $pop);
592 push (@pops, \%row);
593 }
594 $page->param(pops => \@pops);
595
596 # could arguably include routing (500) in the list, but ATM it doesn't
597 # make sense, and in any case that shouldn't be structurally possible here.
598 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder");
599 $sth->execute;
600 my @typelist;
601 my $selflag = 0;
602 while (my @data = $sth->fetchrow_array) {
603 my %row = (tval => $data[0],
604 type => $data[1],
605 sel => ($selflag == 0 ? ' selected' : '')
606 );
607 push (@typelist, \%row);
608 $selflag++;
609 }
610 $page->param(typelist => \@typelist);
611 }
612
613 my @cities;
614 foreach my $city (@citylist) {
615 my %row = (city => $city);
616 push (@cities, \%row);
617 }
618 $page->param(citylist => \@cities);
619
620## node hack
621 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
622 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
623 my @nodes;
624 while (my ($nid,$nname) = $sth->fetchrow_array()) {
625 my %row = (nid => $nid, nname => $nname);
626 push (@nodes, \%row);
627 }
628 $page->param(nodelist => \@nodes);
629## end node hack
630
631 $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
632
633} # assignBlock
634
635
636# Take info on requested IP assignment and see what we can provide.
637sub confirmAssign {
638 if ($IPDBacl{$authuser} !~ /a/) {
639 printError("You shouldn't have been able to get here. Access denied.");
640 return;
641 }
642
643 my $cidr;
644 my $alloc_from;
645
646 # Going to manually validate some items.
647 # custid and city are automagic.
648 return if !validateInput();
649
650# Several different cases here.
651# Static IP vs netblock
652# + Different flavours of static IP
653# + Different flavours of netblock
654
655 if ($webvar{alloctype} =~ /^.i$/) {
656 my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
657
658# Ewww. But it works.
659 $sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
660 "poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
661 "poolips.pool=allocations.cidr AND allocations.city='$webvar{pop}' AND poolips.type LIKE '".$base."_' ".
662 "GROUP BY pool");
663 $sth->execute;
664 my $optionlist;
665
666 my @poollist;
667 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) {
668 # city,pool cidr,free IP count
669 if ($poolfree > 0) {
670 my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree);
671 push (@poollist, \%row);
672 }
673 }
674 $page->param(staticip => 1);
675 $page->param(poollist => \@poollist);
676 $cidr = "Single static IP";
677##fixme: need to handle "no available pools"
678
679 } else { # end show pool options
680
681 if ($webvar{fbassign} eq 'y') {
682 $cidr = new NetAddr::IP $webvar{block};
683 $webvar{maskbits} = $cidr->masklen;
684 } else { # done with direct freeblocks assignment
685
686 if (!$webvar{maskbits}) {
687 $page->param(err => "Please specify a CIDR mask length.");
688 return;
689 }
690 my $sql;
691 my $city;
692 my $failmsg;
693 my $extracond = '';
694 if ($webvar{allocfrom} eq '-') {
695 $extracond = ($webvar{allowpriv} eq 'on' ? '' :
696 " and not (cidr <<= '192.168.0.0/16'".
697 " or cidr <<= '10.0.0.0/8'".
698 " or cidr <<= '172.16.0.0/12')");
699 }
700 my $sortorder;
701 if ($webvar{alloctype} eq 'rm') {
702 if ($webvar{allocfrom} ne '-') {
703 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
704 " and cidr <<= '$webvar{allocfrom}'";
705 $sortorder = "maskbits desc";
706 } else {
707 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
708 $sortorder = "maskbits desc";
709 }
710 $failmsg = "No suitable free block found.<br>\nWe do not have a free".
711 " routeable block of that size.<br>\nYou will have to either route".
712 " a set of smaller netblocks or a single smaller netblock.";
713 } else {
714##fixme
715# This section needs serious Pondering.
716 # Pools of most types get assigned to the POP they're "routed from"
717 # This includes WAN blocks and other netblock "containers"
718 # This does NOT include cable pools.
719 if ($webvar{alloctype} =~ /^.[pc]$/) {
720 $city = $webvar{city};
721 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
722 " superblock from one of the<br>\nmaster blocks or chose a smaller".
723 " block size for the pool.";
724 } else {
725 $city = $webvar{pop};
726 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
727 " superblock to $webvar{pop}<br>\nfrom one of the master blocks or".
728 " chose a smaller blocksize.";
729 }
730 if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
731 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
732 " and cidr <<= '$webvar{allocfrom}' and routed='".
733 (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
734 $sortorder = "maskbits desc,cidr";
735 } else {
736 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
737 " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
738 $sortorder = "maskbits desc,cidr";
739 }
740 }
741 $sql = $sql.$extracond." order by ".$sortorder;
742 $sth = $ip_dbh->prepare($sql);
743 $sth->execute;
744 my @data = $sth->fetchrow_array();
745 if ($data[0] eq "") {
746 $page->param(err => $failmsg);
747 return;
748 }
749 $cidr = new NetAddr::IP $data[0];
750 } # check for freeblocks assignment or IPDB-controlled assignment
751
752 $alloc_from = "$cidr";
753
754 # If the block to be allocated is smaller than the one we found,
755 # figure out the "real" block to be allocated.
756 if ($cidr->masklen() ne $webvar{maskbits}) {
757 my $maskbits = $cidr->masklen();
758 my @subblocks;
759 while ($maskbits++ < $webvar{maskbits}) {
760 @subblocks = $cidr->split($maskbits);
761 }
762 $cidr = $subblocks[0];
763 }
764 } # if ($webvar{alloctype} =~ /^.i$/)
765
766## node hack
767 if ($webvar{node} && $webvar{node} ne '-') {
768 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
769 $sth->execute($webvar{node});
770 my ($nodename) = $sth->fetchrow_array();
771 $page->param(nodename => $nodename);
772 $page->param(nodeid => $webvar{node});
773 }
774## end node hack
775
776 # Stick in the allocation data
777 $page->param(alloc_type => $webvar{alloctype});
778 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
779 $page->param(alloc_from => $alloc_from);
780 $page->param(cidr => $cidr);
781 $page->param(city => $q->escapeHTML($webvar{city}));
782 $page->param(custid => $webvar{custid});
783 $page->param(circid => $q->escapeHTML($webvar{circid}));
784 $page->param(desc => $q->escapeHTML($webvar{desc}));
785
786##fixme: find a way to have the displayed copy have <br> substitutions
787# for newlines, and the <input> value have either encoded or bare newlines.
788# Also applies to privdata.
789 $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
790
791 # Check to see if user is allowed to do anything with sensitive data
792 my $privdata = '';
793 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
794 if $IPDBacl{$authuser} =~ /s/;
795
796 # Yay! This now has it's very own little home.
797 $page->param(billinguser => $webvar{userid})
798 if $webvar{userid};
799
800##fixme: this is only needed iff confirm.tmpl/confirm.html and
801# confirmRemove.html/confirmRemove.tmpl are merged (quite possible, just
802# a little tedious)
803 $page->param(action => "insert");
804
805} # end confirmAssign
806
807
808# Do the work of actually inserting a block in the database.
809sub insertAssign {
810 if ($IPDBacl{$authuser} !~ /a/) {
811 printError("You shouldn't have been able to get here. Access denied.");
812 return;
813 }
814 # Some things are done more than once.
815 return if !validateInput();
816
817 if (!defined($webvar{privdata})) {
818 $webvar{privdata} = '';
819 }
820 # $code is "success" vs "failure", $msg contains OK for a
821 # successful netblock allocation, the IP allocated for static
822 # IP, or the error message if an error occurred.
823
824 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
825 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
826 $webvar{circid}, $webvar{privdata}, $webvar{node});
827
828 if ($code eq 'OK') {
829 if ($webvar{alloctype} =~ /^.i$/) {
830 $msg =~ s|/32||;
831 $page->param(staticip => $msg);
832 $page->param(custid => $webvar{custid});
833 $page->param(billinguser => $webvar{billinguser});
834 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
835 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
836 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
837 } else {
838 my $netblock = new NetAddr::IP $webvar{fullcidr};
839 $page->param(fullcidr => $webvar{fullcidr});
840 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
841 $page->param(custid => $webvar{custid});
842 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
843 $page->param(billinguser => $webvar{billinguser});
844 $page->param(custid => $webvar{custid});
845 $page->param(netaddr => $netblock->addr);
846 $page->param(masklen => $netblock->masklen);
847 }
848 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
849 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
850 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
851 }
852 syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
853 "'$webvar{alloctype}' ($msg)";
854 } else {
855 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
856 "'$webvar{alloctype}' by $authuser failed: '$msg'";
857 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
858 " failed:<br>\n$msg\n");
859 }
860
861} # end insertAssign()
862
863
864# Does some basic checks on common input data to make sure nothing
865# *really* weird gets in to the database through this script.
866# Does NOT do complete input validation!!!
867sub validateInput {
868 if ($webvar{city} eq '-') {
869 printError("Please choose a city.");
870 return;
871 }
872
873 # Alloctype check.
874 chomp $webvar{alloctype};
875 if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
876 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
877 # managing to call things in such a way as to cause this deserves a cryptic error.
878 printError("Invalid alloctype");
879 return;
880 }
881
882 # CustID check
883 # We have different handling for customer allocations and "internal" or "our" allocations
884 if ($def_custids{$webvar{alloctype}} eq '') {
885 if (!$webvar{custid}) {
886 printError("Please enter a customer ID.");
887 return;
888 }
889 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
890 # Force uppercase for now...
891 $webvar{custid} =~ tr/a-z/A-Z/;
892 # Crosscheck with billing.
893 my $status = CustIDCK->custid_exist($webvar{custid});
894 if ($CustIDCK::Error) {
895 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
896 return;
897 }
898 if (!$status) {
899 printError("Customer ID not valid. Make sure the Customer ID ".
900 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
901 "non-customer assignments.");
902 return;
903 }
904 }
905# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
906 } else {
907 # New! Improved! And now Loaded From The Database!!
908 if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
909 $webvar{custid} = $def_custids{$webvar{alloctype}};
910 }
911 }
912
913 # Check POP location
914 my $flag;
915 if ($webvar{alloctype} eq 'rm') {
916 $flag = 'for a routed netblock';
917 foreach (@poplist) {
918 if (/^$webvar{city}$/) {
919 $flag = 'n';
920 last;
921 }
922 }
923 } else {
924 $flag = 'n';
925##fixme: hook to force-set POP or city on certain alloctypes
926# if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
927 if ($webvar{pop} =~ /^-$/) {
928 $flag = 'to route the block from/through';
929 }
930 }
931 if ($flag ne 'n') {
932 printError("Please choose a valid POP location $flag. Valid ".
933 "POP locations are currently:<br>\n".join (" - ", @poplist));
934 return;
935 }
936
937 return 'OK';
938} # end validateInput
939
940
941# Displays details of a specific allocation in a form
942# Allows update/delete
943# action=edit
944sub edit {
945
946 my $sql;
947
948 # Two cases: block is a netblock, or block is a static IP from a pool
949 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
950##fixme: allow "SWIP" (publication to rWHOIS) of static IP data
951 if ($webvar{block} =~ /\/32$/) {
952 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
953 } else {
954 $sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip from allocations where cidr='$webvar{block}'"
955 }
956
957 # gotta snag block info from db
958 $sth = $ip_dbh->prepare($sql);
959 $sth->execute;
960 my @data = $sth->fetchrow_array;
961
962 # Clean up extra whitespace on alloc type
963 $data[2] =~ s/\s//;
964
965 # We can't let the city be changed here; this block is a part of
966 # a larger routed allocation and therefore by definition can't be moved.
967 # block and city are static.
968##fixme
969# Needs thinking. Have to allow changes to city to correct errors, no?
970# Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads
971
972# @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip
973
974 $page->param(block => $webvar{block});
975
976 $page->param(custid => $data[1]);
977 $page->param(city => $data[3]);
978 $page->param(circid => $data[4]);
979 $page->param(desc => $data[5]);
980 $page->param(notes => $data[6]);
981
982##fixme The check here should be built from the database
983# Need to expand to support pool types too
984 if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
985 $page->param(changetype => 1);
986 $page->param(alloctype => [
987 { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" },
988 { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
989 { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
990 { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
991 { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" },
992 { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" },
993 { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" },
994 ]
995 );
996 } else {
997 $page->param(disptype => $disp_alloctypes{$data[2]});
998 $page->param(type => $data[2]);
999 }
1000
1001## node hack
1002 $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef".
1003 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
1004 $sth->execute;
1005 my ($nodeid,$nodename) = $sth->fetchrow_array();
1006 $page->param(havenodeid => $nodeid);
1007
1008 if ($data[2] eq 'fr' || $data[2] eq 'bi') {
1009 $page->param(typesupportsnodes => 1);
1010 $page->param(nodename => $nodename);
1011
1012##fixme: this whole hack needs cleanup and generalization for all alloctypes
1013##fixme: arguably a bug that presence of a nodeid implies it can be changed..
1014# but except for manual database changes, only the two types fr and bi can
1015# (currently) have a nodeid set in the first place.
1016 if ($IPDBacl{$authuser} =~ /c/) {
1017 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
1018 $sth->execute;
1019 my @nodelist;
1020 while (my ($nid,$nname) = $sth->fetchrow_array()) {
1021 my %row = (
1022 selme => ($nodeid == $nid),
1023 nodeid => $nid,
1024 nodename => $nname,
1025 );
1026 push (@nodelist, \%row);
1027 }
1028 $page->param(nodelist => \@nodelist);
1029 }
1030 }
1031## end node hack
1032
1033 my ($lastmod,undef) = split /\s+/, $data[7];
1034 $page->param(lastmod => $lastmod);
1035
1036 # not happy with the upside-down logic, but...
1037 $page->param(swipable => $data[2] !~ /.i/);
1038 $page->param(swip => $data[10] ne 'n');
1039
1040 # Check to see if we can display sensitive data
1041 $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
1042 $page->param(privdata => $data[8]);
1043
1044 # ACL trickery - these two template booleans control the presence of all form/input tags
1045 $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
1046 $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
1047
1048} # edit()
1049
1050
1051# Stuff new info about a block into the db
1052# action=update
1053sub update {
1054 if ($IPDBacl{$authuser} !~ /c/) {
1055 printError("You shouldn't have been able to get here. Access denied.");
1056 return;
1057 }
1058
1059 # Check to see if we can update restricted data
1060 my $privdata = '';
1061 if ($IPDBacl{$authuser} =~ /s/) {
1062 $privdata = ",privdata='$webvar{privdata}'";
1063 }
1064
1065 # Make sure incoming data is in correct format - custID among other things.
1066 return if !validateInput;
1067
1068 # SQL transaction wrapper
1069 eval {
1070 # Relatively simple SQL transaction here.
1071 my $sql;
1072 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1073 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
1074 "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
1075 "$privdata where ip='$webvar{block}'";
1076 } else {
1077 $sql = "update allocations set custid='$webvar{custid}',".
1078 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
1079 "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
1080 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
1081 "where cidr='$webvar{block}'";
1082 }
1083 # Log the details of the change.
1084 syslog "debug", $sql;
1085 $sth = $ip_dbh->prepare($sql);
1086 $sth->execute;
1087## node hack
1088 if ($webvar{node}) {
1089 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
1090 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
1091 $sth->execute($webvar{block},$webvar{node});
1092 }
1093## end node hack
1094 $ip_dbh->commit;
1095 };
1096 if ($@) {
1097 my $msg = $@;
1098 carp "Transaction aborted because $msg";
1099 eval { $ip_dbh->rollback; };
1100 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
1101 printError("Could not update block/IP $webvar{block}: $msg");
1102 return;
1103 }
1104
1105 # If we get here, the operation succeeded.
1106 syslog "notice", "$authuser updated $webvar{block}";
1107##fixme: need to wedge something in to allow "update:field" notifications
1108## hmm. how to tell what changed? O_o
1109mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1110 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
1111 open (HTML, "../updated.html")
1112 or croak "Could not open updated.html :$!";
1113 my $html = join('', <HTML>);
1114
1115 # Link back to browse-routed or list-pool page on "Update complete" page.
1116 my $backlink = "/ip/cgi-bin/main.cgi?action=";
1117 my $cblock; # to contain the CIDR of the container block we're retrieving.
1118 my $sql;
1119 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1120 $sql = "select pool from poolips where ip='$webvar{block}'";
1121 $backlink .= "listpool&pool=";
1122 } else {
1123 $sql = "select cidr from routed where cidr >>= '$webvar{block}'";
1124 $backlink .= "showrouted&block=";
1125 }
1126 # I define there to be no errors on this operation... so we don't need to check for them.
1127 $sth = $ip_dbh->prepare($sql);
1128 $sth->execute;
1129 $sth->bind_columns(\$cblock);
1130 $sth->fetch();
1131 $sth->finish;
1132 $backlink .= $cblock;
1133
1134my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
1135 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1136 $webvar{city} = $q->escapeHTML($webvar{city});
1137 $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
1138 $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
1139 $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
1140 $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
1141 $html =~ s/\$\$SWIP\$\$/$swiptmp/g;
1142 $webvar{circid} = $q->escapeHTML($webvar{circid});
1143 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
1144 $webvar{desc} = $q->escapeHTML($webvar{desc});
1145 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
1146 $webvar{notes} = $q->escapeHTML($webvar{notes});
1147 $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
1148 $html =~ s/\$\$BACKLINK\$\$/$backlink/g;
1149 $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
1150
1151 if ($IPDBacl{$authuser} =~ /s/) {
1152 $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
1153 qq(<td class="regular">).$q->escapeHTML($webvar{privdata}).qq(</td></tr>\n);
1154 }
1155 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1156
1157 print $html;
1158
1159} # update()
1160
1161
1162# Delete an allocation.
1163sub remove {
1164 if ($IPDBacl{$authuser} !~ /d/) {
1165 printError("You shouldn't have been able to get here. Access denied.");
1166 return;
1167 }
1168
1169 #show confirm screen.
1170 open HTML, "../confirmRemove.html"
1171 or croak "Could not open confirmRemove.html :$!";
1172 my $html = join('', <HTML>);
1173 close HTML;
1174
1175 # Serves'em right for getting here...
1176 if (!defined($webvar{block})) {
1177 printError("Error 332");
1178 return;
1179 }
1180
1181 my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
1182
1183 if ($webvar{alloctype} eq 'rm') {
1184 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1185 $sth->execute();
1186
1187# This feels... extreme.
1188 croak $sth->errstr() if($sth->errstr());
1189
1190 $sth->bind_columns(\$cidr,\$city);
1191 $sth->execute();
1192 $sth->fetch || croak $sth->errstr();
1193 $custid = "N/A";
1194 $alloctype = $webvar{alloctype};
1195 $circid = "N/A";
1196 $desc = "N/A";
1197 $notes = "N/A";
1198
1199 } elsif ($webvar{alloctype} eq 'mm') {
1200 $cidr = $webvar{block};
1201 $city = "N/A";
1202 $custid = "N/A";
1203 $alloctype = $webvar{alloctype};
1204 $circid = "N/A";
1205 $desc = "N/A";
1206 $notes = "N/A";
1207 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
1208
1209 # Unassigning a static IP
1210 my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
1211 " from poolips where ip='$webvar{block}'");
1212 $sth->execute();
1213# croak $sth->errstr() if($sth->errstr());
1214
1215 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
1216 \$privdata);
1217 $sth->fetch() || croak $sth->errstr;
1218
1219 } else { # done with alloctype=~ /^.i$/
1220
1221 my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
1222 " from allocations where cidr='$webvar{block}'");
1223 $sth->execute();
1224# croak $sth->errstr() if($sth->errstr());
1225
1226 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
1227 \$notes, \$privdata);
1228 $sth->fetch() || carp $sth->errstr;
1229 } # end cases for different alloctypes
1230
1231 # Munge everything into HTML
1232 $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
1233 $html =~ s|\$\$BLOCK\$\$|$cidr|g;
1234 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
1235 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
1236 $html =~ s|\$\$CITY\$\$|$city|g;
1237 $html =~ s|\$\$CUSTID\$\$|$custid|g;
1238 $html =~ s|\$\$CIRCID\$\$|$circid|g;
1239 $html =~ s|\$\$DESC\$\$|$desc|g;
1240 $html =~ s|\$\$NOTES\$\$|$notes|g;
1241
1242 $html =~ s|\$\$ACTION\$\$|finaldelete|g;
1243
1244 # Set the warning text.
1245 if ($alloctype =~ /^.[pd]$/) {
1246 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>|;
1247 } else {
1248 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
1249 }
1250
1251 my $i = 1;
1252 # Check to see if user is allowed to do anything with sensitive data
1253 if ($IPDBacl{$authuser} =~ /s/) {
1254 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
1255 qq(<td class=regular>$privdata</td></tr>\n);
1256 $i++;
1257 }
1258 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1259
1260 $i = ++$i % 2;
1261 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
1262
1263 print $html;
1264} # end edit()
1265
1266
1267# Delete an allocation. Return it to the freeblocks table; munge
1268# data as necessary to keep as few records as possible in freeblocks
1269# to prevent weirdness when allocating blocks later.
1270# Remove IPs from pool listing if necessary
1271sub finalDelete {
1272 if ($IPDBacl{$authuser} !~ /d/) {
1273 printError("You shouldn't have been able to get here. Access denied.");
1274 return;
1275 }
1276
1277 # need to retrieve block data before deleting so we can notify on that
1278 my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
1279
1280 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
1281
1282 if ($code eq 'OK') {
1283 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
1284 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
1285 " $custid, $city, desc='$description'";
1286 mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1287 "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
1288 "CustID: $custid\nCity: $city\nDescription: $description\n");
1289 } else {
1290 if ($webvar{alloctype} =~ /^.i$/) {
1291 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
1292 printError("Could not deallocate static IP $webvar{block}: $msg");
1293 } else {
1294 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
1295 printError("Could not deallocate netblock $webvar{block}: $msg");
1296 }
1297 }
1298
1299} # finalDelete
1300
1301
1302# going, going, gone... this sub to be removed Any Day Real Soon Now(TM)
1303sub exitError {
1304 my $errStr = $_[0];
1305 printHeader('','');
1306 print qq(<center><p class="regular"> $errStr </p>
1307<input type="button" value="Back" onclick="history.go(-1)">
1308</center>
1309);
1310
1311 # We print the footer here, so we don't have to do it elsewhere.
1312 # include the admin tools link in the output?
1313 $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
1314
1315 print $footer->output;
1316
1317 exit;
1318} # errorExit
1319
1320
1321# Just in case we manage to get here.
1322exit 0;
Note: See TracBrowser for help on using the repository browser.