source: branches/stable/cgi-bin/main.cgi@ 289

Last change on this file since 289 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

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