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

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

/branches/htmlform

Convert listpool to template. See #3.

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