source: trunk/cgi-bin/main.cgi@ 108

Last change on this file since 108 was 106, checked in by Kris Deugau, 20 years ago

/trunk

IPDB rewrite, first stable iteration.

-> uses allocateBlock(), deleteBlock() from IPDB module rather

than hardcoding that in the web script

-> uses global variables from IPDB module for "static" data such

as allocation types and ities (which are loaded from the
database in much the same way that master blocks have been loaded)

-> IPDB.pm contains NO locally-exiting code, nor calls to any code

which exits before returning. This allows returning status codes
to the caller, so that things like database handles can be
properly cleaned up.

There are probably also a long list of minor bugfixes that I've forgotten.

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