source: branches/stable/cgi-bin/main.cgi@ 96

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

/branches/stable

Overhaul of city listings - first stage. Cities are now listed in
ONE place for stuffing into HTML and so on. City list also updated
with most of the cities currently listed, and a few that have
probably been removed.
SQL schema updated with new table

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