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

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

Import "new" IPDB development:

March 2004 through end of August 2004

Changes include:

-> Entirely new method of allocating IP space; which should

hopefully reduce the amount of messiness in allocations.

-> IP address processing provided by NetAddr::IP rather than

homebrew code

-> Change DB to PostgreSQL to eliminate some of the problems

caused by using MySQL, and to gain native RDBMS support for
IP addresses.

-> Using NetAddr::IP and Postgres allows (eventually, with

PG >= 7.4) IPV6 without any code changes. In theory.

-> Logging so that if someone makes a change that turns out

to have been wrong for some reason, Blame Can Be Assigned.

-> General code cleanups (split IPDB.pm from CommonWeb.pm,

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