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

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

/branches/htmlform

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