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

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

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