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

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

/trunk

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