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

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

/trunk

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