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

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

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