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

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

/branches/stable

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