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

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

/trunk

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