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

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

/branches/htmlform

Merge trunk bugfixes and updates
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 45.7 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3###
4# SVN revision info
5# $Date: 2010-08-12 16:00:28 +0000 (Thu, 12 Aug 2010) $
6# SVN revision $Rev: 468 $
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 my ($pooltype,$poolcity);
486
487 # Snag pool info for heading
488 $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
489 $sth->execute;
490 $sth->bind_columns(\$pooltype, \$poolcity);
491 $sth->fetch() || carp $sth->errstr;
492
493 print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
494 qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
495 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
496 if ($pooltype =~ /^.d$/) {
497 print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
498 print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
499 $cidr->addr."</td></tr>\n";
500 $cidr++;
501 print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
502 $cidr--; $cidr--;
503 print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
504 "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
505 "</table></div></div>\n";
506 }
507
508# probably have to add an "edit IP allocation" link here somewhere.
509
510 startTable('IP','Customer ID','Available?','Description','');
511 $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
512 " from poolips where pool='$webvar{pool}' order by ip");
513 $sth->execute;
514 my $count = 0;
515 while (my @data = $sth->fetchrow_array) {
516 # pool,ip,custid,city,ptype,available,notes,description,circuitid
517 # ip,custid,available,description,type
518 # If desc is "null", make it not null. <g>
519 if ($data[3] eq '') {
520 $data[3] = '&nbsp;';
521 }
522 # Some nice hairy Perl to decide whether to allow unassigning each IP
523 # -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
524 # else we print a blank space
525 my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
526 $data[1],$data[2],$data[3],
527 ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
528 ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
529 "alloctype=$data[4]\">Unassign this IP</a>") :
530 ("&nbsp;") )
531 );
532 printRow(\@row, 'color1') if($count%2==0);
533 printRow(\@row, 'color2') if($count%2!=0);
534 $count++;
535 }
536 print "</table>\n";
537
538} # end listPool
539
540
541# Show "Add new allocation" page. Note that the actual page may
542# be one of two templates, and the lists come from the database.
543sub assignBlock {
544
545 if ($IPDBacl{$authuser} !~ /a/) {
546 printError("You shouldn't have been able to get here. Access denied.");
547 return;
548 }
549
550 # hack pthbttt eww
551 $webvar{block} = '' if !$webvar{block};
552
553# hmm. TMPL_IF block and TMPL_ELSE block on these instead?
554 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
555 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
556 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
557 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y'));
558
559 # New special case- block to assign is specified
560 if ($webvar{block} ne '') {
561 my $block = new NetAddr::IP $webvar{block};
562
563 # Handle contained freeblock allocation.
564 # This is a little dangerous, as it's *theoretically* possible to
565 # get fbtype='n' (aka a non-routed freeblock). However, should
566 # someone manage to get there, they get what they deserve.
567 if ($webvar{fbtype} ne 'y') {
568 # Snag the type of the container block from the database.
569 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
570 $sth->execute;
571 my @data = $sth->fetchrow_array;
572 $data[0] =~ s/c$/r/; # Munge the type into the correct form
573 $page->param(fbdisptype => $list_alloctypes{$data[0]});
574 $page->param(type => $data[0]);
575 } else {
576 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
577 "and type not like '_i' and type not like '_r' order by listorder");
578 $sth->execute;
579 my @data = $sth->fetchrow_array;
580 my @typelist;
581 my $selflag = 0;
582 while (my @data = $sth->fetchrow_array) {
583 my %row = (tval => $data[0],
584 type => $data[1],
585 sel => ($selflag == 0 ? ' selected' : '')
586 );
587 push (@typelist, \%row);
588 $selflag++;
589 }
590 $page->param(typelist => \@typelist);
591 }
592 } else {
593 my @masterlist;
594 foreach my $master (@masterblocks) {
595 my %row = (master => "$master");
596 push (@masterlist, \%row);
597 }
598 $page->param(masterlist => \@masterlist);
599
600 my @pops;
601 foreach my $pop (@poplist) {
602 my %row = (pop => $pop);
603 push (@pops, \%row);
604 }
605 $page->param(pops => \@pops);
606
607 # could arguably include routing (500) in the list, but ATM it doesn't
608 # make sense, and in any case that shouldn't be structurally possible here.
609 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder");
610 $sth->execute;
611 my @typelist;
612 my $selflag = 0;
613 while (my @data = $sth->fetchrow_array) {
614 my %row = (tval => $data[0],
615 type => $data[1],
616 sel => ($selflag == 0 ? ' selected' : '')
617 );
618 push (@typelist, \%row);
619 $selflag++;
620 }
621 $page->param(typelist => \@typelist);
622 }
623
624 my @cities;
625 foreach my $city (@citylist) {
626 my %row = (city => $city);
627 push (@cities, \%row);
628 }
629 $page->param(citylist => \@cities);
630
631## node hack
632 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
633 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
634 my @nodes;
635 while (my ($nid,$nname) = $sth->fetchrow_array()) {
636 my %row = (nid => $nid, nname => $nname);
637 push (@nodes, \%row);
638 }
639 $page->param(nodelist => \@nodes);
640## end node hack
641
642 $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
643
644} # assignBlock
645
646
647# Take info on requested IP assignment and see what we can provide.
648sub confirmAssign {
649 if ($IPDBacl{$authuser} !~ /a/) {
650 printError("You shouldn't have been able to get here. Access denied.");
651 return;
652 }
653
654 my $cidr;
655 my $alloc_from;
656
657 # Going to manually validate some items.
658 # custid and city are automagic.
659 return if !validateInput();
660
661# Several different cases here.
662# Static IP vs netblock
663# + Different flavours of static IP
664# + Different flavours of netblock
665
666 if ($webvar{alloctype} =~ /^.i$/) {
667 my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
668
669# Ewww. But it works.
670 $sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
671 "poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
672 "poolips.pool=allocations.cidr AND allocations.city='$webvar{pop}' AND poolips.type LIKE '".$base."_' ".
673 "GROUP BY pool");
674 $sth->execute;
675 my $optionlist;
676
677 my @poollist;
678 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) {
679 # city,pool cidr,free IP count
680 if ($poolfree > 0) {
681 my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree);
682 push (@poollist, \%row);
683 }
684 }
685 $page->param(staticip => 1);
686 $page->param(poollist => \@poollist);
687 $cidr = "Single static IP";
688##fixme: need to handle "no available pools"
689
690 } else { # end show pool options
691
692 if ($webvar{fbassign} eq 'y') {
693 $cidr = new NetAddr::IP $webvar{block};
694 $webvar{maskbits} = $cidr->masklen;
695 } else { # done with direct freeblocks assignment
696
697 if (!$webvar{maskbits}) {
698 $page->param(err => "Please specify a CIDR mask length.");
699 return;
700 }
701 my $sql;
702 my $city;
703 my $failmsg;
704 my $extracond = '';
705 if ($webvar{allocfrom} eq '-') {
706 $extracond = ($webvar{allowpriv} eq 'on' ? '' :
707 " and not (cidr <<= '192.168.0.0/16'".
708 " or cidr <<= '10.0.0.0/8'".
709 " or cidr <<= '172.16.0.0/12')");
710 }
711 my $sortorder;
712 if ($webvar{alloctype} eq 'rm') {
713 if ($webvar{allocfrom} ne '-') {
714 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
715 " and cidr <<= '$webvar{allocfrom}'";
716 $sortorder = "maskbits desc";
717 } else {
718 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
719 $sortorder = "maskbits desc";
720 }
721 $failmsg = "No suitable free block found.<br>\nWe do not have a free".
722 " routeable block of that size.<br>\nYou will have to either route".
723 " a set of smaller netblocks or a single smaller netblock.";
724 } else {
725##fixme
726# This section needs serious Pondering.
727 # Pools of most types get assigned to the POP they're "routed from"
728 # This includes WAN blocks and other netblock "containers"
729 # This does NOT include cable pools.
730 if ($webvar{alloctype} =~ /^.[pc]$/) {
731 $city = $webvar{city};
732 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
733 " superblock from one of the<br>\nmaster blocks or chose a smaller".
734 " block size for the pool.";
735 } else {
736 $city = $webvar{pop};
737 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
738 " superblock to $webvar{pop}<br>\nfrom one of the master blocks or".
739 " chose a smaller blocksize.";
740 }
741 if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
742 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
743 " and cidr <<= '$webvar{allocfrom}' and routed='".
744 (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
745 $sortorder = "maskbits desc,cidr";
746 } else {
747 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
748 " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
749 $sortorder = "maskbits desc,cidr";
750 }
751 }
752 $sql = $sql.$extracond." order by ".$sortorder;
753 $sth = $ip_dbh->prepare($sql);
754 $sth->execute;
755 my @data = $sth->fetchrow_array();
756 if ($data[0] eq "") {
757 $page->param(err => $failmsg);
758 return;
759 }
760 $cidr = new NetAddr::IP $data[0];
761 } # check for freeblocks assignment or IPDB-controlled assignment
762
763 $alloc_from = "$cidr";
764
765 # If the block to be allocated is smaller than the one we found,
766 # figure out the "real" block to be allocated.
767 if ($cidr->masklen() ne $webvar{maskbits}) {
768 my $maskbits = $cidr->masklen();
769 my @subblocks;
770 while ($maskbits++ < $webvar{maskbits}) {
771 @subblocks = $cidr->split($maskbits);
772 }
773 $cidr = $subblocks[0];
774 }
775 } # if ($webvar{alloctype} =~ /^.i$/)
776
777## node hack
778 if ($webvar{node} && $webvar{node} ne '-') {
779 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
780 $sth->execute($webvar{node});
781 my ($nodename) = $sth->fetchrow_array();
782 $page->param(nodename => $nodename);
783 $page->param(nodeid => $webvar{node});
784 }
785## end node hack
786
787 # Stick in the allocation data
788 $page->param(alloc_type => $webvar{alloctype});
789 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
790 $page->param(alloc_from => $alloc_from);
791 $page->param(cidr => $cidr);
792 $page->param(city => $q->escapeHTML($webvar{city}));
793 $page->param(custid => $webvar{custid});
794 $page->param(circid => $q->escapeHTML($webvar{circid}));
795 $page->param(desc => $q->escapeHTML($webvar{desc}));
796
797##fixme: find a way to have the displayed copy have <br> substitutions
798# for newlines, and the <input> value have either encoded or bare newlines.
799# Also applies to privdata.
800 $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
801
802 # Check to see if user is allowed to do anything with sensitive data
803 my $privdata = '';
804 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
805 if $IPDBacl{$authuser} =~ /s/;
806
807 # Yay! This now has it's very own little home.
808 $page->param(billinguser => $webvar{userid})
809 if $webvar{userid};
810
811##fixme: this is only needed iff confirm.tmpl/confirm.html and
812# confirmRemove.html/confirmRemove.tmpl are merged (quite possible, just
813# a little tedious)
814 $page->param(action => "insert");
815
816} # end confirmAssign
817
818
819# Do the work of actually inserting a block in the database.
820sub insertAssign {
821 if ($IPDBacl{$authuser} !~ /a/) {
822 printError("You shouldn't have been able to get here. Access denied.");
823 return;
824 }
825 # Some things are done more than once.
826 return if !validateInput();
827
828 if (!defined($webvar{privdata})) {
829 $webvar{privdata} = '';
830 }
831 # $code is "success" vs "failure", $msg contains OK for a
832 # successful netblock allocation, the IP allocated for static
833 # IP, or the error message if an error occurred.
834
835 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
836 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
837 $webvar{circid}, $webvar{privdata}, $webvar{node});
838
839 if ($code eq 'OK') {
840 if ($webvar{alloctype} =~ /^.i$/) {
841 $msg =~ s|/32||;
842 $page->param(staticip => $msg);
843 $page->param(custid => $webvar{custid});
844 $page->param(billinguser => $webvar{billinguser});
845 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
846 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
847 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
848 } else {
849 my $netblock = new NetAddr::IP $webvar{fullcidr};
850 $page->param(fullcidr => $webvar{fullcidr});
851 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
852 $page->param(custid => $webvar{custid});
853 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
854 $page->param(billinguser => $webvar{billinguser});
855 $page->param(custid => $webvar{custid});
856 $page->param(netaddr => $netblock->addr);
857 $page->param(masklen => $netblock->masklen);
858 }
859 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
860 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
861 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
862 }
863 syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
864 "'$webvar{alloctype}' ($msg)";
865 } else {
866 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
867 "'$webvar{alloctype}' by $authuser failed: '$msg'";
868 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
869 " failed:<br>\n$msg\n");
870 }
871
872} # end insertAssign()
873
874
875# Does some basic checks on common input data to make sure nothing
876# *really* weird gets in to the database through this script.
877# Does NOT do complete input validation!!!
878sub validateInput {
879 if ($webvar{city} eq '-') {
880 printError("Please choose a city.");
881 return;
882 }
883
884 # Alloctype check.
885 chomp $webvar{alloctype};
886 if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
887 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
888 # managing to call things in such a way as to cause this deserves a cryptic error.
889 printError("Invalid alloctype");
890 return;
891 }
892
893 # CustID check
894 # We have different handling for customer allocations and "internal" or "our" allocations
895 if ($def_custids{$webvar{alloctype}} eq '') {
896 if (!$webvar{custid}) {
897 printError("Please enter a customer ID.");
898 return;
899 }
900 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
901 # Force uppercase for now...
902 $webvar{custid} =~ tr/a-z/A-Z/;
903 # Crosscheck with billing.
904 my $status = CustIDCK->custid_exist($webvar{custid});
905 if ($CustIDCK::Error) {
906 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
907 return;
908 }
909 if (!$status) {
910 printError("Customer ID not valid. Make sure the Customer ID ".
911 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
912 "non-customer assignments.");
913 return;
914 }
915 }
916# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
917 } else {
918 # New! Improved! And now Loaded From The Database!!
919 if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
920 $webvar{custid} = $def_custids{$webvar{alloctype}};
921 }
922 }
923
924 # Check POP location
925 my $flag;
926 if ($webvar{alloctype} eq 'rm') {
927 $flag = 'for a routed netblock';
928 foreach (@poplist) {
929 if (/^$webvar{city}$/) {
930 $flag = 'n';
931 last;
932 }
933 }
934 } else {
935 $flag = 'n';
936##fixme: hook to force-set POP or city on certain alloctypes
937# if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
938 if ($webvar{pop} =~ /^-$/) {
939 $flag = 'to route the block from/through';
940 }
941 }
942 if ($flag ne 'n') {
943 printError("Please choose a valid POP location $flag. Valid ".
944 "POP locations are currently:<br>\n".join (" - ", @poplist));
945 return;
946 }
947
948 return 'OK';
949} # end validateInput
950
951
952# Displays details of a specific allocation in a form
953# Allows update/delete
954# action=edit
955sub edit {
956
957 my $sql;
958
959 # Two cases: block is a netblock, or block is a static IP from a pool
960 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
961 if ($webvar{block} =~ /\/32$/) {
962 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
963 } else {
964 $sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip from allocations where cidr='$webvar{block}'"
965 }
966
967 # gotta snag block info from db
968 $sth = $ip_dbh->prepare($sql);
969 $sth->execute;
970 my @data = $sth->fetchrow_array;
971
972 # Clean up extra whitespace on alloc type
973 $data[2] =~ s/\s//;
974
975 open (HTML, "../editDisplay.html")
976 or croak "Could not open editDisplay.html :$!";
977 my $html = join('', <HTML>);
978
979 # We can't let the city be changed here; this block is a part of
980 # a larger routed allocation and therefore by definition can't be moved.
981 # block and city are static.
982##fixme
983# Needs thinking. Have to allow changes to city to correct errors, no?
984 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
985
986 if ($IPDBacl{$authuser} =~ /c/) {
987 $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
988
989# Screw it. Changing allocation types gets very ugly VERY quickly- especially
990# with the much longer list of allocation types.
991# We'll just show what type of block it is.
992
993# this has now been Requested, so here goes.
994
995##fixme The check here should be built from the database
996 if ($data[2] =~ /^.[ne]$/) {
997 # Block that can be changed
998 my $blockoptions = "<select name=alloctype><option".
999 (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
1000 (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
1001 (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
1002 (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
1003 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
1004 (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
1005 (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
1006 "</select>\n";
1007 $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
1008 } else {
1009 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
1010 }
1011## node hack
1012 $sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
1013 $sth->execute;
1014 my ($nodeid) = $sth->fetchrow_array();
1015 if ($nodeid) {
1016 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
1017 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
1018 my $nodes = "<select name=node>\n";
1019 while (my ($nid,$nname) = $sth->fetchrow_array()) {
1020 $nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
1021 }
1022 $nodes .= "</select>\n";
1023 $html =~ s/\$\$NODE\$\$/$nodes/;
1024 } else {
1025 if ($data[2] eq 'fr' || $data[2] eq 'bi') {
1026 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
1027 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
1028 my $nodes = "<select name=node>\n<option value=>--</option>\n";
1029 while (my ($nid,$nname) = $sth->fetchrow_array()) {
1030 $nodes .= "<option value='$nid'>$nname</option>\n";
1031 }
1032 $nodes .= "</select>\n";
1033 $html =~ s/\$\$NODE\$\$/$nodes/;
1034 } else {
1035 $html =~ s|\$\$NODE\$\$|N/A|;
1036 }
1037 }
1038## end node hack
1039 $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
1040 $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
1041 $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
1042 $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
1043 } else {
1044## node hack
1045 if ($data[2] eq 'fr' || $data[2] eq 'bi') {
1046 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
1047 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
1048 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
1049 my ($node) = $sth->fetchrow_array;
1050 $html =~ s/\$\$NODE\$\$/$node/;
1051 } else {
1052 $html =~ s|\$\$NODE\$\$|N/A|;
1053 }
1054## end node hack
1055 $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
1056 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
1057 $html =~ s/\$\$CITY\$\$/$data[3]/g;
1058 $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
1059 $html =~ s/\$\$DESC\$\$/$data[5]/g;
1060 $html =~ s/\$\$NOTES\$\$/$data[6]/g;
1061 }
1062 my ($lastmod,undef) = split /\s+/, $data[7];
1063 $html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
1064
1065## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
1066if ($data[2] =~ /.i/) {
1067 $html =~ s/\$\$SWIP\$\$/N\/A/;
1068} else {
1069 my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
1070 '<input type=checkbox name=swip checked=yes>');
1071 $html =~ s/\$\$SWIP\$\$/$tmp/;
1072}
1073
1074 # Allows us to "correctly" colour backgrounds in table
1075 my $i=1;
1076
1077 # Check to see if we can display sensitive data
1078 my $privdata = '';
1079 if ($IPDBacl{$authuser} =~ /s/) {
1080 $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
1081 qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
1082 qq($data[8]</textarea></td></tr>\n);
1083 $i++;
1084 }
1085 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1086
1087 # More ACL trickery - we can live with forms that don't submit,
1088 # but we can't leave the extra table rows there, and we *really*
1089 # can't leave the submit buttons there.
1090 my $updok = '';
1091 if ($IPDBacl{$authuser} =~ /c/) {
1092 $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
1093 qq(<input type="submit" value=" Update this block " class="regular">).
1094 "</div></td></tr></form>\n";
1095 $i++;
1096 }
1097 $html =~ s/\$\$UPDOK\$\$/$updok/g;
1098
1099 my $delok = '';
1100 if ($IPDBacl{$authuser} =~ /d/) {
1101 $delok = qq(<form method="POST" action="main.cgi">
1102 <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
1103 <input type="hidden" name="action" value="delete">
1104 <input type="hidden" name="block" value="$webvar{block}">
1105 <input type="hidden" name="alloctype" value="$data[2]">
1106 <input type=submit value=" Delete this block ">
1107 </div></td></tr>);
1108 }
1109 $html =~ s/\$\$DELOK\$\$/$delok/;
1110
1111 print $html;
1112
1113} # edit()
1114
1115
1116# Stuff new info about a block into the db
1117# action=update
1118sub update {
1119 if ($IPDBacl{$authuser} !~ /c/) {
1120 printError("You shouldn't have been able to get here. Access denied.");
1121 return;
1122 }
1123
1124 # Check to see if we can update restricted data
1125 my $privdata = '';
1126 if ($IPDBacl{$authuser} =~ /s/) {
1127 $privdata = ",privdata='$webvar{privdata}'";
1128 }
1129
1130 # Make sure incoming data is in correct format - custID among other things.
1131 return if !validateInput;
1132
1133 # SQL transaction wrapper
1134 eval {
1135 # Relatively simple SQL transaction here.
1136 my $sql;
1137 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1138 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
1139 "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
1140 "$privdata where ip='$webvar{block}'";
1141 } else {
1142 $sql = "update allocations set custid='$webvar{custid}',".
1143 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
1144 "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
1145 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
1146 "where cidr='$webvar{block}'";
1147 }
1148 # Log the details of the change.
1149 syslog "debug", $sql;
1150 $sth = $ip_dbh->prepare($sql);
1151 $sth->execute;
1152## node hack
1153 if ($webvar{node}) {
1154 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
1155 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
1156 $sth->execute($webvar{block},$webvar{node});
1157 }
1158## end node hack
1159 $ip_dbh->commit;
1160 };
1161 if ($@) {
1162 my $msg = $@;
1163 carp "Transaction aborted because $msg";
1164 eval { $ip_dbh->rollback; };
1165 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
1166 printError("Could not update block/IP $webvar{block}: $msg");
1167 return;
1168 }
1169
1170 # If we get here, the operation succeeded.
1171 syslog "notice", "$authuser updated $webvar{block}";
1172##fixme: need to wedge something in to allow "update:field" notifications
1173## hmm. how to tell what changed? O_o
1174mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1175 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
1176 open (HTML, "../updated.html")
1177 or croak "Could not open updated.html :$!";
1178 my $html = join('', <HTML>);
1179
1180 # Link back to browse-routed or list-pool page on "Update complete" page.
1181 my $backlink = "/ip/cgi-bin/main.cgi?action=";
1182 my $cblock; # to contain the CIDR of the container block we're retrieving.
1183 my $sql;
1184 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1185 $sql = "select pool from poolips where ip='$webvar{block}'";
1186 $backlink .= "listpool&pool=";
1187 } else {
1188 $sql = "select cidr from routed where cidr >>= '$webvar{block}'";
1189 $backlink .= "showrouted&block=";
1190 }
1191 # I define there to be no errors on this operation... so we don't need to check for them.
1192 $sth = $ip_dbh->prepare($sql);
1193 $sth->execute;
1194 $sth->bind_columns(\$cblock);
1195 $sth->fetch();
1196 $sth->finish;
1197 $backlink .= $cblock;
1198
1199my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
1200 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1201 $webvar{city} = $q->escapeHTML($webvar{city});
1202 $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
1203 $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
1204 $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
1205 $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
1206 $html =~ s/\$\$SWIP\$\$/$swiptmp/g;
1207 $webvar{circid} = $q->escapeHTML($webvar{circid});
1208 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
1209 $webvar{desc} = $q->escapeHTML($webvar{desc});
1210 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
1211 $webvar{notes} = $q->escapeHTML($webvar{notes});
1212 $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
1213 $html =~ s/\$\$BACKLINK\$\$/$backlink/g;
1214 $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
1215
1216 if ($IPDBacl{$authuser} =~ /s/) {
1217 $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
1218 qq(<td class="regular">).$q->escapeHTML($webvar{privdata}).qq(</td></tr>\n);
1219 }
1220 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1221
1222 print $html;
1223
1224} # update()
1225
1226
1227# Delete an allocation.
1228sub remove {
1229 if ($IPDBacl{$authuser} !~ /d/) {
1230 printError("You shouldn't have been able to get here. Access denied.");
1231 return;
1232 }
1233
1234 #show confirm screen.
1235 open HTML, "../confirmRemove.html"
1236 or croak "Could not open confirmRemove.html :$!";
1237 my $html = join('', <HTML>);
1238 close HTML;
1239
1240 # Serves'em right for getting here...
1241 if (!defined($webvar{block})) {
1242 printError("Error 332");
1243 return;
1244 }
1245
1246 my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
1247
1248 if ($webvar{alloctype} eq 'rm') {
1249 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1250 $sth->execute();
1251
1252# This feels... extreme.
1253 croak $sth->errstr() if($sth->errstr());
1254
1255 $sth->bind_columns(\$cidr,\$city);
1256 $sth->execute();
1257 $sth->fetch || croak $sth->errstr();
1258 $custid = "N/A";
1259 $alloctype = $webvar{alloctype};
1260 $circid = "N/A";
1261 $desc = "N/A";
1262 $notes = "N/A";
1263
1264 } elsif ($webvar{alloctype} eq 'mm') {
1265 $cidr = $webvar{block};
1266 $city = "N/A";
1267 $custid = "N/A";
1268 $alloctype = $webvar{alloctype};
1269 $circid = "N/A";
1270 $desc = "N/A";
1271 $notes = "N/A";
1272 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
1273
1274 # Unassigning a static IP
1275 my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
1276 " from poolips where ip='$webvar{block}'");
1277 $sth->execute();
1278# croak $sth->errstr() if($sth->errstr());
1279
1280 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
1281 \$privdata);
1282 $sth->fetch() || croak $sth->errstr;
1283
1284 } else { # done with alloctype=~ /^.i$/
1285
1286 my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
1287 " from allocations where cidr='$webvar{block}'");
1288 $sth->execute();
1289# croak $sth->errstr() if($sth->errstr());
1290
1291 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
1292 \$notes, \$privdata);
1293 $sth->fetch() || carp $sth->errstr;
1294 } # end cases for different alloctypes
1295
1296 # Munge everything into HTML
1297 $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
1298 $html =~ s|\$\$BLOCK\$\$|$cidr|g;
1299 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
1300 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
1301 $html =~ s|\$\$CITY\$\$|$city|g;
1302 $html =~ s|\$\$CUSTID\$\$|$custid|g;
1303 $html =~ s|\$\$CIRCID\$\$|$circid|g;
1304 $html =~ s|\$\$DESC\$\$|$desc|g;
1305 $html =~ s|\$\$NOTES\$\$|$notes|g;
1306
1307 $html =~ s|\$\$ACTION\$\$|finaldelete|g;
1308
1309 # Set the warning text.
1310 if ($alloctype =~ /^.[pd]$/) {
1311 $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>|;
1312 } else {
1313 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
1314 }
1315
1316 my $i = 1;
1317 # Check to see if user is allowed to do anything with sensitive data
1318 if ($IPDBacl{$authuser} =~ /s/) {
1319 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
1320 qq(<td class=regular>$privdata</td></tr>\n);
1321 $i++;
1322 }
1323 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1324
1325 $i = ++$i % 2;
1326 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
1327
1328 print $html;
1329} # end edit()
1330
1331
1332# Delete an allocation. Return it to the freeblocks table; munge
1333# data as necessary to keep as few records as possible in freeblocks
1334# to prevent weirdness when allocating blocks later.
1335# Remove IPs from pool listing if necessary
1336sub finalDelete {
1337 if ($IPDBacl{$authuser} !~ /d/) {
1338 printError("You shouldn't have been able to get here. Access denied.");
1339 return;
1340 }
1341
1342 # need to retrieve block data before deleting so we can notify on that
1343 my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
1344
1345 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
1346
1347 if ($code eq 'OK') {
1348 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
1349 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
1350 " $custid, $city, desc='$description'";
1351 mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1352 "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
1353 "CustID: $custid\nCity: $city\nDescription: $description\n");
1354 } else {
1355 if ($webvar{alloctype} =~ /^.i$/) {
1356 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
1357 printError("Could not deallocate static IP $webvar{block}: $msg");
1358 } else {
1359 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
1360 printError("Could not deallocate netblock $webvar{block}: $msg");
1361 }
1362 }
1363
1364} # finalDelete
1365
1366
1367# going, going, gone... this sub to be removed Any Day Real Soon Now(TM)
1368sub exitError {
1369 my $errStr = $_[0];
1370 printHeader('','');
1371 print qq(<center><p class="regular"> $errStr </p>
1372<input type="button" value="Back" onclick="history.go(-1)">
1373</center>
1374);
1375
1376 # We print the footer here, so we don't have to do it elsewhere.
1377 # include the admin tools link in the output?
1378 $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
1379
1380 print $footer->output;
1381
1382 exit;
1383} # errorExit
1384
1385
1386# Just in case we manage to get here.
1387exit 0;
Note: See TracBrowser for help on using the repository browser.