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
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-11-30 19:22:50 +0000 (Tue, 30 Nov 2004) $
7# SVN revision $Rev: 91 $
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 CustIDCK;
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 = (
49 "ci","Static cable IP",
50 "di","Static DSL IP",
51 "si","Server pool IP",
52 "mi","Static dialup IP",
53 "wi","Static wireless IP",
54 "cp","Cable pool",
55 "dp","DSL pool",
56 "sp","Server pool",
57 "mp","Static dialup pool",
58 "wp","Static wireless pool",
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;
71my @citylist;
72my @poplist;
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;
82my $sth;
83
84# Slurp up the master block list - we need this several places
85# While we're at it, initialize the related hashes.
86$sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
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
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}
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; };
151 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
152 printAndExit("Could not add master block $webvar{cidr} to database: $@");
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. :/
266 $sql = "select * from searchme where custid ilike '%$query%'";
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).
275 $sql = "select * from searchme where description ilike '%$query%'";
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
332
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. :(
373 if ($data[2] =~ /^[sdcmw]$/) {
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.
379 if ($data[2] =~ /^[sdcmw]p$/) {
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 {
404 print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}&action=search&searchfor=$webvar{searchfor}">$i</a>&nbsp;\n);
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.
668 if ($data[2] =~ /^[sdcmw]p$/) {
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)) {
707 my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=assign&block=$cidr\">$cidr</a>",
708 $cidr->range);
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) {
751 # pool,ip,custid,city,ptype,available,notes,description,circuitid
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
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"
793 or croak "Could not open assign.html: $!";
794 $html = join('',<HTML>);
795 close HTML;
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;
802 my $pops = '';
803 foreach my $pop (@poplist) {
804 $pops .= "<option>$pop</option>\n";
805 }
806 $html =~ s|\$\$POPLIST\$\$|$pops|g;
807 }
808 my $cities = '';
809 foreach my $city (@citylist) {
810 $cities .= "<option>$city</option>\n";
811 }
812 $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
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
841 if ($webvar{alloctype} =~ /^[scdmw]i$/) {
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".
850 " ptype='$base' and (city='Sudbury' or city='North Bay')";
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".
855 " ptype='$base' and city='$webvar{pop}'";
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 }
866 $sth = $ip_dbh->prepare("select city from allocations where cidr=?");
867 foreach my $key (keys %ipcount) {
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";
871 }
872 $cidr = "Single static IP";
873 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
874
875 } else { # end show pool options
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') {
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 }
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.";
899 } else {
900 if ($webvar{alloctype} =~ /^[scdmw]p$/) {
901 if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
902 printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
903 $city = $webvar{city};
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 }
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 }
920 }
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
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;
961 $webvar{city} = desanitize($webvar{city});
962 $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
963 $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
964 $webvar{circid} = desanitize($webvar{circid});
965 $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
966 $webvar{desc} = desanitize($webvar{desc});
967 $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
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}'".
1002 " and available='y' order by ip");
1003 $sth->execute;
1004
1005 my @data = $sth->fetchrow_array;
1006 my $cidr = $data[1];
1007
1008 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',".
1009 "city='$webvar{city}',available='n',description='$webvar{desc}',".
1010 "circuitid='$webvar{circid}'".
1011 " where ip='$cidr'");
1012 $sth->execute;
1013 if ($sth->err) {
1014 syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser failed: ".
1015 "'".$sth->errstr."'";
1016 printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
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}";
1020# Notify tech@example.com
1021 mailNotify('tech@example.com',"$full_alloc_types{$webvar{alloctype}} allocation",
1022 "$full_alloc_types{$webvar{alloctype}} $cidr allocated to customer $webvar{custid}");
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,
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.
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}',".
1062 "'$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
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; };
1070 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
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}',".
1128 "'$webvar{desc}','$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
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; };
1136 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
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}',".
1151 " ?, '6750400', '$webvar{city}', '$pooltype', 'y', '', '', '')");
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; };
1162 syslog "err", "Initialization of pool '$webvar{fullcidr}' by $authuser failed: '$@'";
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 }
1188 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF|TEMP)(?:-\d\d?)?$/) {
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.");
1201 }
1202# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
1203 } elsif ($webvar{alloctype} =~ /^([sdcmw]p|si|dn|dy|dc|ee|rr|ii)$/){
1204 # All non-customer allocations MUST be entered with "our" customer ID.
1205 # I have Defined this as 6750400 for consistency.
1206 # STAFF is also acceptable.
1207 if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
1208 $webvar{custid} = "6750400";
1209 }
1210 if ($webvar{alloctype} eq 'rr') {
1211 if ($webvar{city} !~ /^(?:Huntsville|North Bay|Ottawa|Pembroke|Sault Ste. Marie|Sudbury|Timmins|Thunder Bay|Toronto)$/) {
1212 printAndExit("Please choose a valid POP location for a routed netblock. Valid ".
1213 "POP locations are currently:<br>\n Elliot Lake - Huntsville - North Bay -".
1214 " Ottawa -".
1215 " Pembroke - Sault Ste. Marie - Sudbury - Timmins - Thunder Bay - Toronto");
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$/) {
1238 $sql = "select ip,custid,ptype,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
1239 } else {
1240 $sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
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
1272# this has now been Requested, so here goes.
1273
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
1289 # These can be modified, although CustID changes may get ignored.
1290 $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
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;
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$/) ) {
1315 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
1316 "circuitid='$webvar{circid}',description='$webvar{desc}' ".
1317 "where ip='$webvar{block}'";
1318 } else {
1319 $sql = "update allocations set custid='$webvar{custid}',".
1320 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
1321 "type='$webvar{alloctype}',circuitid='$webvar{circid}' where cidr='$webvar{block}'";
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; };
1331 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
1332 printAndExit("Could not update block/IP $webvar{block}: $@");
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;
1342 $webvar{city} = desanitize($webvar{city});
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;
1347 $webvar{circid} = desanitize($webvar{circid});
1348 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
1349 $webvar{desc} = desanitize($webvar{desc});
1350 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
1351 $webvar{notes} = desanitize($webvar{notes});
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
1375 my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype);
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};
1389 $circid = "N/A";
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};
1398 $circid = "N/A";
1399 $desc = "N/A";
1400 $notes = "N/A";
1401 } elsif ($webvar{alloctype} =~ /^[sdcmw]i$/) { # done with alloctype=rr
1402
1403 # Unassigning a static IP
1404 my $sth = $ip_dbh->prepare("select ip,custid,city,ptype,notes,circuitid from poolips".
1405 " where ip='$webvar{block}'");
1406 $sth->execute();
1407# croak $sth->errstr() if($sth->errstr());
1408
1409 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid);
1410 $sth->fetch() || croak $sth->errstr;
1411
1412 $alloctype .="i";
1413
1414 } else { # done with alloctype=[sdcmw]i
1415
1416 my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes from ".
1417 "allocations where cidr='$webvar{block}'");
1418 $sth->execute();
1419# croak $sth->errstr() if($sth->errstr());
1420
1421 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc, \$notes);
1422 $sth->fetch() || carp $sth->errstr;
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;
1432 $html =~ s|\$\$CIRCID\$\$|$circid|g;
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.
1439 if ($alloctype =~ /^[sdcmw]p$/) {
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
1461 if ($webvar{alloctype} =~ /^[sdcmw]i$/) {
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',".
1471 " city='$data[0]', description='' where ip='$webvar{block}'");
1472 $sth->execute;
1473 $ip_dbh->commit;
1474 };
1475 if ($@) {
1476 carp "Transaction aborted because $@";
1477 eval { $ip_dbh->rollback; };
1478 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$@'";
1479 printAndExit("Could not deallocate static IP $webvar{block}: $@");
1480 }
1481 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
1482 syslog "notice", "$authuser deallocated static IP $webvar{block}";
1483
1484 } elsif ($webvar{alloctype} eq 'mm') { # end alloctype = [sdcmw]i
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; };
1496 syslog "err", "$authuser could not remove master block '$webvar{block}': '$@'";
1497 printAndExit("Could not remove master block $webvar{block}: $@");
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
1529 if ($webvar{alloctype} =~ /^[sdcmw]p$/) {
1530 # We have to delete the IPs from the pool listing.
1531 $sth = $ip_dbh->prepare("delete from poolips where pool='$webvar{block}'");
1532 $sth->execute;
1533 }
1534
1535 # Set up query for compacting free blocks.
1536 $sth = $ip_dbh->prepare("select * from freeblocks where cidr << ".
1537 "(select cidr from routed where cidr >> '$cidr') ".
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) {
1573 $sth->execute("$block");
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.
1583 ",(select city from routed where cidr >>= '$cidr'),'y')");
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; };
1593 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$@'";
1594 printAndExit("Could not deallocate netblock $webvar{block}: $@");
1595 }
1596 print "<div class=heading align=center>Success! $webvar{block} deleted.</div>\n";
1597 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
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.