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

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

/branches/stable

Modified process for allocating a static IP

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