source: trunk/cgi-bin/main-beta1.cgi@ 6

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

Add intermediate development files for posterity
  • Property svn:executable set to *
File size: 41.0 KB
RevLine 
[6]1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3# Started munging from noc.vianet's old IPDB 04/22/2004
4# Current version 05/18/2004 kdeugau@vianet
5
6#use strict;
7use warnings;
8use CGI::Carp qw/fatalsToBrowser/;
9use DBI;
10use CommonWeb qw/:ALL/;
11use POSIX qw/ceil/;
12use NetAddr::IP;
13
14checkDBSanity();
15
16#prototypes
17sub viewBy($$); # feed it the category and query
18sub queryResults($$$); # args is the sql, the page# and the rowCount
19# Needs rewrite/rename
20sub countRows($); # returns first element of first row of passed SQL
21 # Only usage passes "select count(*) ..."
22
23my $RESULTS_PER_PAGE = 50;
24my %webvar = parse_post();
25cleanInput(\%webvar);
26
27my %full_alloc_types = (
28 "ci","Cable pool IP",
29 "di","DSL pool IP",
30 "si","Server pool IP",
31 "cp","Cable pool",
32 "dp","DSL pool",
33 "sp","Server pool",
34 "dn","Dialup netblock",
35 "dy","Dynamic DSL netblock",
36 "dc","Dynamic cable netblock",
37 "cn","Customer netblock",
38 "e","End-use netblock",
39 "r","Routed netblock",
40 "i","Internal netblock",
41 "m","Master block"
42);
43
44
45# Start new code: 04/22/2004
46###
47
48# Initial display: Show master blocks with total allocated subnets, total free subnets
49# foreach block (allocations[type=cust])
50# check which master it's in
51# increment appropriate counter
52# foreach block (freeblocks)
53# check which master it's in
54# increment appropriate counter
55
56# Some things we will need to do every time.
57
58# Why not a global DB handle?
59# We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
60my $ip_dbh = DBI->connect("dbi:mysql:ipdb", "root", "");
61
62# Slurp up the master block list - we need this several places
63my $sth = $ip_dbh->prepare("select * from masterblocks;");
64$sth->execute;
65my $i=0;
66for ($i=0; @data = $sth->fetchrow_array(); $i++) {
67 $masterblocks[$i] = new NetAddr::IP $data[0];
68 $allocated{"$masterblocks[$i]"} = 0;
69 $free{"$masterblocks[$i]"} = 0;
70 $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
71 # Set to 128 to prepare for IPv6
72 $routed{"$masterblocks[$i]"} = 0;
73}
74
75
76
77
78#main()
79
80if(!defined($webvar{action})) {
81 $webvar{action} = "<NULL>"; #shuts up the warnings.
82}
83
84if($webvar{action} eq 'index') {
85 showSummary();
86} elsif ($webvar{action} eq 'newmaster') {
87 printHeader('');
88
89 $cidr = new NetAddr::IP $webvar{cidr};
90
91 print "<div type=heading align=center>Adding $cidr as master block....\n";
92 $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
93 $sth->execute;
94 die $sth->errstr if ($sth->errstr());
95
96# Unrouted blocks aren't associated with a city (yet). We don't rely on this
97# elsewhere though; legacy data may have traps and pitfalls in it to break this.
98# Thus the "routed" flag.
99
100 $sth = $ip_dbh->prepare("insert into freeblocks values ('$webvar{cidr}',".
101 $cidr->masklen.",'<NULL>','n')");
102 $sth->execute;
103 die $sth->errstr if ($sth->errstr());
104
105 print "Success!</div>\n";
106
107 printFooter;
108} elsif($webvar{action} eq 'showmaster') {
109 showMaster();
110} elsif($webvar{action} eq 'showrouted') {
111 showRBlock();
112} elsif($webvar{action} eq 'listpool') {
113 listPool();
114} elsif($webvar{action} eq 'search') {
115 printHeader('');
116 if (!$webvar{input}) {
117 # No search term. Display everything.
118 viewBy('all', '');
119 } else {
120 # Search term entered. Display matches.
121 # We should really sanitize $webvar{input}, no?
122 viewBy($webvar{searchfor}, $webvar{input});
123 }
124 printFooter();
125}
126
127# Not modified or added; just shuffled
128elsif($webvar{action} eq 'assign') {
129 assignBlock();
130}
131elsif($webvar{action} eq 'confirm') {
132 confirmAssign();
133}
134elsif($webvar{action} eq 'edit') {
135 edit();
136}
137elsif($webvar{action} eq 'update') {
138 update();
139}
140elsif($webvar{action} eq 'delete') {
141 remove();
142}
143elsif($webvar{action} eq 'finaldelete') {
144 finalDelete();
145}
146
147
148#
149#elsif($webvar{action} eq 'free')
150#{
151# showFree();
152#}
153#elsif($webvar{action} eq 'free2')
154#{
155# showFreeDetail();
156#}
157#elsif($webvar{action} eq 'insert')
158#{
159# insertAssign();
160#}
161#elsif($webvar{action} eq 'showedit')
162#{
163# showEdit();
164#}
165#elsif($webvar{action} eq 'view')
166#{
167# view();
168#}
169
170
171# Default is an error. It shouldn't be possible to easily get here.
172else {
173 printHeader('');
174 my $rnd = rand 500;
175 my $boing = sprintf("%.2f", rand 500);
176 my @excuses = ("Aether cloudy. Ask again later.","2",
177 "3","4","5","6","7","8","9","10","11","12","13","14","15","16","17");
178 printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
179}
180
181
182#end main()
183
184# Just in case something waaaayyy down isn't in place properly...
185exit 0;
186
187
188sub viewBy($$) {
189 my ($category,$query) = @_;
190
191print "<pre>\n";
192
193print "start querysub: query '$query'\n";
194# this may happen with more than one subcategory. Unlikely, but possible.
195 my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
196
197# Possible cases:
198# 1) Partial IP/subnet. Treated as "first-three-octets-match" in old IPDB,
199# I should be able to handle it similarly here.
200# 2a) CIDR subnet. Treated more or less as such in old IPDB.
201# 2b) CIDR netmask. Not sure how it's treated.
202# 3) Customer ID. Not handled in old IPDB
203# 4) Customer "name". If doing customer search, and we have non-numerics,
204# search on customer name.
205# 5) Invalid data which might be interpretable as an IP or something, but
206# which probably shouldn't be for reasons of sanity.
207
208 if ($category =~ /all/) {
209 print "Showing all allocations\n";
210 my $count = countRows('select count(*) from allocations');
211 $sql = "select * from allocations order by cidr limit $offset,$RESULTS_PER_PAGE";
212 queryResults($sql, $webvar{page}, $count);
213 } elsif ($category =~ /cust/) {
214 # Query for a customer ID.
215 if ($query =~ /^\s*[0-9]+\s*$/) {
216 # All numeric. Search on customer ID.
217 $sql = "select * from allocations where custid like '%$query%'";
218 queryResults($sql, $webvar{page}, $count);
219 } else {
220 print "Searching for a customer based on (partial) name....\n";
221 $sth = $ip_dbh->prepare("select * from customers where name like '%$query%'");
222 $sth->execute;
223
224# sth->rows may not work properly- it's not guaranteed to be accurate until
225# ALL rows have actually been fetch...()'ed
226 if ($sth->rows eq 1) {
227 @data = $sth->fetchrow_array;
228 # Only 1 cust matched.
229print "Found 1 cust. Displaying...\n";
230 $sql = "select * from allocations where custid like '%$data[0]%'";
231 queryResults($sql, $webvar{page}, $count);
232 } elsif ($sth->rows == 0) {
233 # D'Oh! Nothing found!
234 printAndExit("No customers found. Try searching on a smaller string.");
235 } else {
236 # More than one found. List'em and let the searcher decide.
237 print "Found more than one. Click the customer ID you want to show allocations for:\n";
238 startTable('custid','name','city','phone','abuse contact','description');
239 $count = 0;
240 while (@data = $sth->fetchrow_array) {
241 # custid,name,street,street2,city,province,pocode,phone,abuse,def_rdns,description
242 @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=search&input=$data[0]&searchfor=cust\">$data[0]</a>",
243 $data[1],$data[4],$data[7],$data[8],$data[10]);
244 printRow(\@row, 'color1' ) if($count%2==0);
245 printRow(\@row, 'color2' ) if($count%2!=0);
246 }
247 print "</table>\n";
248 } # end if sth->rows
249 } # query pattern if
250 } elsif ($category =~ /ipblock/) {
251 # Query is for a partial IP, a CIDR block in some form, or a flat IP.
252 $query =~ s/\s+//g;
253print "Looking for IP-based matches on '$query':<br>\n";
254 if ($query =~ /\//) {
255print "CIDR query. Results may vary.\n";
256 # 209.91.179/26 should show all /26 subnets in 209.91.179
257 ($net,$maskbits) = split /\//, $query;
258 if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
259 # /0->/9 are silly to worry about right now. :/
260 print "Exact subnet search...\n";
261 $sth = $ip_dbh->prepare("select * from allocations where cidr='$query'");
262 $sth->execute;
263 if ($sth->rows == 0) {
264 print "No matches\n";
265 } elsif ($sth->rows == 1) {
266 @data = $sth->fetchrow_array;
267 print "Found $data[0]\n";
268 } else {
269 print "Too many matches (".$sth->rows.", should be 1). Database is b0rked.\n";
270 }
271 } else {
272 # select * from allocations where cidr like '$net%' and cidr like '%$maskbits'
273 }
274 } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
275 ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3})\.(\d{1,3})/);
276 print "Trying to find based on net '$net' and ip '$ip'...";
277 $sfor = new NetAddr::IP $query;
278 $sth = $ip_dbh->prepare("select * from allocations where cidr like '$net%'");
279 $sth->execute;
280 while (@data = $sth->fetchrow_array()) {
281 $cidr = new NetAddr::IP $data[0];
282 if ($cidr->contains($sfor)) {
283 print "Found '$cidr'!\n";
284 }
285 }
286 } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
287 print "3-octet block pattern.";
288 $sql = "select * from allocations where cidr like '$query%'";
289 queryResults($sql, $webvar{page}, $count);
290 } else {
291 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
292 printAndExit("Invalid query.");
293 }
294 } else {
295 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
296 printAndExit("Invalid searchfor.");
297 }
298} # viewBy
299
300# args are: a reference to an array with the row to be printed and the
301# class(stylesheet) to use for formatting.
302# if ommitting the class - call the sub as &printRow(\@array)
303sub printRow {
304 my ($rowRef,$class) = @_;
305
306 $class = '' if (!$class);
307
308 print "<tr class=\"$class\">\n";
309 foreach my $element (@$rowRef) {
310 print "<td></td>" if (!defined($element));
311 $element =~ s|\n|</br>|g;
312 print "<td>$element</td>\n";
313 }
314 print "</tr>";
315} # printRow
316
317# Display certain types of search query. Note that this can't be
318# cleanly reused much of anywhere else as the data isn't neatly tabulated.
319# This is tied to the search sub tightly enough I may just gut it and provide
320# more appropriate tables directly as needed.
321sub queryResults($$$) {
322 my ($sql, $pageNo, $rowCount) = @_;
323 my $offset = 0;
324 $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);
325 my $sth = $ip_dbh->prepare($sql);
326 $sth->execute();
327# Need some error checking...
328print "About to start showing allocations: ".$ip_dbh->errstr;
329 startTable('Allocation','CustID','Type','City','Description/Name');
330 my $count = 0;
331 while(my @data = ($sth->fetchrow_array())) {
332 # cidr,custid,type,city,description,notes
333# We need to munge row[0] here. We may also need to extract additional data.
334 @row = (qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
335 $data[1], $full_alloc_types{$data[2]}, $data[3], $data[4]);
336 printRow(\@row, 'color1', 1) if ($count%2==0);
337 printRow(\@row, 'color2', 1) if ($count%2!=0);
338 $count++;
339 }
340
341# Have to think on this call, it's primarily to clean up unfetched rows from a select.
342 $sth->finish();
343
344 my $upper = $offset+$count;
345 print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: $offset - $upper</i></td></tr>\n";
346 print "</table></center>\n";
347
348# print the page thing..
349 if ($rowCount > $RESULTS_PER_PAGE) {
350 my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
351 print qq(<div class="center"> Page: );
352 for (my $i = 1; $i <= $pages; $i++) {
353 if($i == $pageNo){
354 print "<b>$i&nbsp</b>\n";
355 } else {
356 print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}">$i&nbsp</a>\n);
357 }
358 }
359 print "</div>";
360 }
361} # queryResults
362
363# Prints table headings. Accepts any number of arguments;
364# each argument is a table heading.
365sub startTable {
366 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
367
368 foreach(@_) {
369 print qq(<td class="heading">$_</td>);
370 }
371 print "</tr>\n";
372} # startTable
373
374
375sub countRows($)
376{
377 my $sth = $ip_dbh->prepare($_[0]);
378 $sth->execute();
379 my @a = $sth->fetchrow_array();
380 $sth->finish();
381 $ip_dbh->disconnect();
382 return $a[0];
383}
384
385
386# Initial display: Show master blocks with total allocated subnets, total free subnets
387sub showSummary
388{
389 print "Content-type: text/html\n\n";
390
391 startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
392 'Free netblocks', 'Largest free block');
393
394# Snag the allocations.
395# I think it's too confusing to leave out internal allocations.
396 my $sth = $ip_dbh->prepare("select * from allocations");
397 $sth->execute();
398 while (@data = $sth->fetchrow_array()) {
399 # cidr,custid,type,city,description
400 # We only need the cidr
401 my $cidr = new NetAddr::IP $data[0];
402 foreach $master (@masterblocks) {
403 if ($master->contains($cidr)) {
404 $allocated{"$master"}++;
405 }
406 }
407 }
408
409# Snag routed blocks
410 my $sth = $ip_dbh->prepare("select * from routed");
411 $sth->execute();
412 while (@data = $sth->fetchrow_array()) {
413 # cidr,maskbits,city
414 # We only need the cidr
415 my $cidr = new NetAddr::IP $data[0];
416 foreach $master (@masterblocks) {
417 if ($master->contains($cidr)) {
418 $routed{"$master"}++;
419 }
420 }
421 }
422
423# Snag the free blocks.
424 my $sth = $ip_dbh->prepare("select * from freeblocks");
425 $sth->execute();
426 while (@data = $sth->fetchrow_array()) {
427 # cidr,maskbits,city
428 # We only need the cidr
429 my $cidr = new NetAddr::IP $data[0];
430 foreach $master (@masterblocks) {
431 if ($master->contains($cidr)) {
432 $free{"$master"}++;
433 if ($cidr->masklen < $bigfree{"$master"}) { $bigfree{"$master"} = $cidr->masklen; }
434 }
435 }
436 }
437
438# Print the data.
439 $count=0;
440 foreach $master (@masterblocks) {
441 @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
442 $routed{"$master"}, $allocated{"$master"}, $free{"$master"},
443 ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
444 );
445
446 printRow(\@row, 'color1' ) if($count%2==0);
447 printRow(\@row, 'color2' ) if($count%2!=0);
448 $count++;
449 }
450 print "</table>\n";
451 print qq(<a href="/ip/addmaster.shtml">Add new master block</a><br><br>\n);
452 print "Note: Free blocks noted here include both routed and unrouted blocks.\n";
453# For some *very* strange reason, we don't have to call printFooter here.
454# If we do, the footer comes in twice...
455# printFooter;
456} # showSummary
457
458# Display detail on master
459# Alrighty then! We're showing routed blocks within a single master this time.
460# We should be able to steal code from showSummary(), and if I'm really smart
461# I'll figger a way to munge the two together. (Once I've done that, everything
462# else should follow. YMMV.)
463sub showMaster {
464 printHeader('');
465
466 print qq(<center><div class="heading">Summarizing routed blocks for ).
467 qq($webvar{block}:</div></center><br>\n);
468
469 my $master = new NetAddr::IP $webvar{block};
470
471 my $sth = $ip_dbh->prepare("select * from routed");
472 $sth->execute();
473
474 $i=0;
475 while (@data = $sth->fetchrow_array()) {
476 my $cidr = new NetAddr::IP $data[0];
477 if ($master->contains($cidr)) {
478 $localmasters[$i++] = $cidr;
479 $free{"$cidr"} = 0;
480 $allocated{"$cidr"} = 0;
481 # Retain the routing destination
482 $routed{"$cidr"} = $data[2];
483 }
484 }
485
486# Check if there were actually any blocks routed from this master
487 if ($i > 0) {
488 startTable('Routed block','Routed to','Allocated blocks',
489 'Free blocks','Largest free block');
490
491 # Count the allocations
492 $sth = $ip_dbh->prepare("select * from allocations");
493 $sth->execute();
494 while (@data = $sth->fetchrow_array()) {
495 # cidr,custid,type,city,description
496 # We only need the cidr
497 my $cidr = new NetAddr::IP $data[0];
498 foreach $master (@localmasters) {
499 if ($master->contains($cidr)) {
500 $allocated{"$master"}++;
501 }
502 }
503 }
504
505 # Snag the free blocks.
506 $sth = $ip_dbh->prepare("select * from freeblocks");
507 $sth->execute();
508 while (@data = $sth->fetchrow_array()) {
509 # cidr,maskbits,city
510 # We only need the cidr
511 my $cidr = new NetAddr::IP $data[0];
512 my $mask = 128;
513 foreach $master (@localmasters) {
514 if ($master->contains($cidr)) {
515 $free{"$master"}++;
516 if ($cidr->masklen < $mask) {
517 $bigfree{"$master"} = $cidr;
518 $mask = $cidr->masklen;
519 }
520 }
521 # check for largest free block
522 }
523 }
524
525 # Print the data.
526 $count=0;
527 foreach $master (@localmasters) {
528 @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
529 $routed{"$master"}, $allocated{"$master"},
530 $free{"$master"}, $bigfree{"$master"});
531 printRow(\@row, 'color1' ) if($count%2==0);
532 printRow(\@row, 'color2' ) if($count%2!=0);
533 $count++;
534 }
535 } else {
536 print qq(<center>No routed blocks found for $master</center><br>\n);
537 } # end check for existence of routed blocks in master
538
539 print qq(</table>\n<hr width="60%">\n).
540 qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
541
542 startTable('Netblock','Range');
543
544 # Snag the free blocks.
545 $count = 0;
546 $sth = $ip_dbh->prepare("select * from freeblocks where routed='n'");
547 $sth->execute();
548 while (@data = $sth->fetchrow_array()) {
549 # cidr,maskbits,city
550 # We only need the cidr
551 my $cidr = new NetAddr::IP $data[0];
552 if ($master->contains($cidr)) {
553 @row = ("$cidr", $cidr->range);
554 printRow(\@row, 'color1' ) if($count%2==0);
555 printRow(\@row, 'color2' ) if($count%2!=0);
556 $count++;
557 }
558 }
559
560 print "</table>\n";
561 printFooter;
562} # showMaster
563
564# Display details of a routed block
565# Alrighty then! We're showing allocations within a routed block this time.
566# We should be able to steal code from showSummary() and showMaster(), and if
567# I'm really smart I'll figger a way to munge all three together. (Once I've
568# done that, everything else should follow. YMMV.
569# This time, we check the database before spewing, because we may
570# not have anything useful to spew.
571sub showRBlock {
572 printHeader('');
573
574 my $master = new NetAddr::IP $webvar{block};
575
576 print qq(<center><div class="heading">Summarizing allocated blocks for ).
577 qq($master:</div></center><br>\n);
578
579 my $sth = $ip_dbh->prepare("select * from allocations");
580 $sth->execute();
581
582 startTable('CIDR allocation','Type','CustID','Description/Name');
583
584 $count=0;
585 while (@data = $sth->fetchrow_array()) {
586 # cidr,custid,type,city,description
587 my $cidr = new NetAddr::IP $data[0];
588 if (!$master->contains($cidr)) { next; }
589
590 @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=edit&block=$data[0]\">$data[0]</a>",
591 $full_alloc_types{$data[2]}, $data[1], $data[4]);
592
593 # If the allocation is a pool, allow listing of the IPs in the pool.
594 if ($data[2] =~ /^[sdc]p$/) {
595 $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
596 "&pool=$data[0]\">List IPs</a>";
597 }
598
599 printRow(\@row, 'color1') if ($count%2 == 0);
600 printRow(\@row, 'color2') if ($count%2 != 0);
601 $count++;
602 }
603
604 print "</table>\n";
605
606 # If the routed block has no allocations, by definition it only has
607 # one free block, and therefore may be deleted.
608 if ($count == 0) {
609 print qq(<hr width="60%"><center><div class="heading">No allocations in ).
610 qq($master.</div></center>\n).
611 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
612 qq(<input type=hidden name=action value="delete">\n).
613 qq(<input type=hidden name=block value="$master">\n).
614 qq(<input type=hidden name=alloctype value="r">\n).
615 qq(<input type=submit value=" Remove this block ">\n).
616 qq(</form>\n);
617 }
618
619 print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
620 qq(submaster $master</div></center>\n);
621
622 startTable('');
623
624 # Snag the free blocks. We don't really *need* to be pedantic about avoiding
625 # unrouted free blocks, but it's better to let the database do the work if we can.
626 $count = 0;
627 $sth = $ip_dbh->prepare("select * from freeblocks where routed='y'");
628 $sth->execute();
629 while (@data = $sth->fetchrow_array()) {
630 # cidr,maskbits,city
631 my $cidr = new NetAddr::IP $data[0];
632 if ($master->contains($cidr)) {
633 @row = ($data[0]);
634 printRow(\@row, 'color1') if ($count%2 == 0);
635 printRow(\@row, 'color2') if ($count%2 != 0);
636 $count++;
637 }
638 }
639
640 print "</table>\n";
641 printFooter;
642} # showRBlock
643
644# List the IPs used in a pool
645sub listPool {
646 printHeader('');
647
648 my $cidr = new NetAddr::IP $webvar{pool};
649
650 # Snag pool info for heading
651 $sth = $ip_dbh->prepare("select * from allocations where cidr='$cidr'");
652 $sth->execute;
653 my @data = $sth->fetchrow_array;
654 my $type = $data[2]; # We'll need this later.
655
656 print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
657 qq(($full_alloc_types{$type} in $data[3])</div></center><br>\n);
658 print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
659 print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
660 $cidr->addr."</td></tr>\n";
661 $cidr++;
662 print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
663 $cidr--; $cidr--;
664 print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
665 "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
666 "</table></div></div>\n";
667
668# probably have to add an "edit IP allocation" link here somewhere.
669
670 startTable('IP','Customer ID','Available?','');
671 $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{pool}'");
672 $sth->execute;
673 $count = 0;
674 while (@data = $sth->fetchrow_array) {
675 # pool,ip,custid,city,ptype,available
676 # Some nice hairy Perl to decide whether to allow unassigning each IP
677 @row = ($data[1],$data[2],$data[5],
678 ( ($data[5] eq 'n') ?
679 ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[1]&".
680 "alloctype=$data[4]i\">Unassign this IP</a>") :
681 ("&nbsp;") )
682 );
683 printRow(\@row, 'color1') if($count%2==0);
684 printRow(\@row, 'color2') if($count%2!=0);
685 $count++;
686 }
687 print "</table>\n";
688
689 printFooter;
690} # end listPool
691
692# Should this maybe just be a full static page?
693sub assignBlock
694{
695 printHeader('');
696
697 open HTML, "../assign.html"
698 or die "Could not open assign.html: $!";
699 my $html = join('',<HTML>);
700 close(HTML);
701
702 print $html;
703
704 printFooter();
705} # assignBlock
706
707# Take info on requested IP assignment and see what we can provide.
708sub confirmAssign
709{
710 printHeader('');
711
712 # Going to manually validate some items.
713 # custid and city are automagic.
714 validateInput();
715
716# This isn't always useful.
717# if (!$webvar{maskbits}) {
718# printAndExit("Please enter a CIDR block length.");
719# }
720
721# Several different cases here.
722# Static IP vs netblock
723# + Different flavours of static IP
724# + Different flavours of netblock
725
726 if ($webvar{alloctype} =~ /^[cds]i$/) {
727 ($base,$tmp) = split //, $webvar{alloctype}; # split into individual chars
728 # Check for pools in Subury or North Bay if DSL or server pool. Anywhere else is
729 # invalid and shouldn't be in the db in the first place.
730 # Note that we want to retain the requested city to relate to customer info.
731 if ($base =~ /^[ds]$/) {
732 $sql = "select * from poolips where available='y' and".
733 " ptype='$base' and city='Sudbury' or city='North Bay'";
734 } else {
735 $sql = "select * from poolips where available='y' and".
736 " ptype='$base' and city='$city'";
737 }
738
739 # Now that we know where we're looking, we can list the pools with free IPs.
740 $sth = $ip_dbh->prepare($sql);
741 $sth->execute;
742 while (@data = $sth->fetchrow_array) {
743 $ipcount{$data[0]}++;
744 }
745 foreach $key (keys %ipcount) {
746 $optionlist .= "<option value='$key'>$key [$ipcount{$key} free IP(s)]</option>\n";
747 }
748 $cidr = "Single static IP";
749 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
750
751 } else { # end show pool options
752
753 if ($webvar{alloctype} eq 'r') {
754 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
755 " order by maskbits desc";
756 $failmsg = "No suitable free block found.<br>\nWe do not have a free".
757 " routeable block of that size.<br>\nYou will have to either route".
758 " a set of smaller netblocks or a single smaller netblock.";
759 } else {
760 if ($webvar{alloctype} =~ /^[sd]p$/) {
761 if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
762 printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
763 if ($webvar{alloctype} eq 'sp') { $city = "Sudbury"; } else { $city = $webvar{city}; }
764 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
765 " superblock <br>\nfrom one of the master blocks in Sudbury or chose a smaller".
766 " block size for the pool.";
767 } else {
768 $city = $webvar{city};
769 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
770 " superblock to $webvar{city}<br>\nfrom one of the master blocks in Sudbury or".
771 " chose a smaller blocksize.";
772 }
773 $sql = "select * from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
774 " and routed='y' order by maskbits desc";
775 }
776 $sth = $ip_dbh->prepare($sql);
777 $sth->execute;
778 @data = $sth->fetchrow_array();
779 if ($data[0] eq "") {
780 printAndExit($failmsg);
781 }
782
783 $cidr = new NetAddr::IP $data[0];
784 $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
785
786 # If the block to be allocated is smaller than the one we found,
787 # figure out the "real" block to be allocated.
788 if ($cidr->masklen() ne $webvar{maskbits}) {
789 $maskbits = $cidr->masklen();
790 while ($maskbits++ < $webvar{maskbits}) {
791 @subblocks = $cidr->split($maskbits);
792 }
793 $cidr = $subblocks[0];
794 }
795 } # if ($webvar{alloctype} =~ /^[cds]i$/) {
796
797 open HTML, "../confirm.html"
798 or die "Could not open confirm.html: $!";
799 my $html = join '', <HTML>;
800 close HTML;
801
802### gotta fix this in final
803 # Stick in customer info as necessary - if it's blank, it just ends
804 # up as blank lines ignored in the rendering of the page
805 $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
806###
807
808 # Stick in the allocation data
809 $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
810 $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$webvar{alloctype}}|g;
811 $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
812 $html =~ s|\$\$CIDR\$\$|$cidr|g;
813 $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
814 $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
815 $webvar{desc} = desanitize($webvar{desc});
816 $webvar{notes} = desanitize($webvar{notes});
817 $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
818 $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
819 $html =~ s|\$\$ACTION\$\$|insert|g;
820
821 print $html;
822
823 printFooter;
824} # end confirmAssign
825
826sub insertAssign
827{
828 # Some things are done more than once.
829 printHeader('');
830 validateInput();
831
832# here we do the donkeywork of actually adding a block.
833# Check cidr and alloc_from to see how bad it's going to be.
834
835# MySQL doesn't enforce referential integrity, but Postgres can.
836# So we insert the customer data (if any) before the allocation.
837# Note that city may be DIFFERENT than the city used for allocation!
838#if ($webvar{newcust} eq 'y') {
839# $sth = $ip_dbh->prepare("insert into customers values ('$webvar{custid}', ".
840# "'$webvar{custname}', '$webvar{custaddr1}', '$webvar{custaddr2}', ".
841# "'$webvar{custcity}', '$webvar{custprov}', '$webvar{custpocode}', ".
842# "'$webvar{custphone}', '$webvar{custabuse}', '$webvar{custrdns}', ".
843# "'$webvar{custdesc}')");
844# $sth->execute;
845# print "customers: '".$sth->errstr."'\n";
846#}
847
848# Set some things that may be needed
849# Don't set $cidr here as it may not even be a valid IP address.
850 $alloc_from = new NetAddr::IP $webvar{alloc_from};
851
852# dynDSL (dy), sIP DSL(dp), and server pools (sp) are nominally allocated to Sudbury
853# no matter what else happens.
854# if ($webvar{alloctype} =~ /^([sd]p|dy)$/) { $webvar{city} = "Sudbury"; }
855# OOPS. forgot about North Bay DSL.
856#### Gotta make this cleaner and more accurate
857# if ($webvar{alloctype} eq "sp") { $webvar{city} = "Sudbury"; }
858
859# Same ordering as confirmation page
860
861 if ($webvar{alloctype} =~ /^[cds]i$/) {
862 ($base,$tmp) = split //, $webvar{alloctype}; # split into individual chars
863
864 # We'll just have to put up with the oddities caused by SQL (un)sort order
865 $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{alloc_from}'".
866 " and available='y'");
867 $sth->execute;
868
869 @data = $sth->fetchrow_array;
870 $cidr = $data[1];
871
872 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',available='n'".
873 " where ip='$cidr'");
874 $sth->execute;
875 print qq(<div class="center"><div class="heading">The IP $cidr has been allocated to customer $webvar{custid}</div></div>);
876
877### had some idea I needed something here. Do we?
878
879 } else { # end IP-from-pool allocation
880
881 # Set $cidr here as it may not be a valid IP address elsewhere.
882 $cidr = new NetAddr::IP $webvar{fullcidr};
883
884 if ($webvar{fullcidr} eq $webvar{alloc_from}) {
885 # Easiest case- insert in one table, delete in the other, and go home. More or less.
886 # insert into allocations values (cidr,custid,type,city,desc) and
887 # delete from freeblocks where cidr='cidr'
888 # For data safety on non-transaction DBs, we delete first.
889
890 if ($webvar{alloctype} eq 'r') {
891 $sth = $ip_dbh->prepare("update freeblocks set routed='y',city='$webvar{city}'".
892 " where cidr='$webvar{fullcidr}'");
893 $sth->execute;
894 $sth = $ip_dbh->prepare("insert into routed values ('$webvar{fullcidr}',".
895 $cidr->masklen.",'$webvar{city}')");
896 $sth->execute;
897 } else {
898 # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
899
900 # city has to be reset for DSL/server pools; nominally to Sudbury.
901 if ($webvar{alloctype} =~ /^[sd]p$/) { $webvar{city} = 'Sudbury'; }
902
903 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{fullcidr}'");
904 $sth->execute;
905
906 $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
907 "'$webvar{custid}','$webvar{alloctype}','$webvar{city}','$webvar{desc}',".
908 "'$webvar{notes}')");
909 $sth->execute;
910 } # routing vs non-routing netblock
911
912 } else { # webvar{fullcidr} != webvar{alloc_from}
913 # Hard case. Allocation is smaller than free block.
914
915 $wantmaskbits = $cidr->masklen;
916
917 $maskbits = $alloc_from->masklen;
918 my $i=0;
919 while ($maskbits++ < $wantmaskbits) {
920 @subblocks = $alloc_from->split($maskbits);
921 $newfreeblocks[$i++] = $subblocks[1];
922 } # while
923
924 # Delete old freeblocks entry
925 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{alloc_from}'");
926 $sth->execute();
927
928 # now we have to do some magic for routing blocks
929 if ($webvar{alloctype} eq 'r') {
930 # Insert the new freeblocks entries
931 # Note that non-routed blocks are assigned to <NULL>
932 $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
933 foreach $block (@newfreeblocks) {
934 $sth->execute("$block", $block->masklen);
935 }
936 # Insert the entry in the routed table
937 $sth = $ip_dbh->prepare("insert into routed values ('$cidr',".
938 $cidr->masklen.",'$webvar{city}')");
939 $sth->execute;
940 # Insert the (almost) same entry in the freeblocks table
941 $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".
942 $cidr->masklen.",'$webvar{city}','y')");
943 $sth->execute;
944
945 } else { # done with alloctype == r
946
947 # Insert the new freeblocks entries
948 $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ?,'y')");
949 foreach $block (@newfreeblocks) {
950 $sth->execute("$block", $block->masklen, $webvar{city});
951 }
952 # Insert the allocations entry
953 $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
954 "'$webvar{custid}','$webvar{alloctype}','$webvar{city}',".
955 "'$webvar{desc}','$webvar{notes}')");
956 $sth->execute;
957 } # done with netblock alloctype != r
958
959 } # end fullcidr != alloc_from
960
961 # special extra handling for pools.
962 # Note that this must be done for ANY pool allocation!
963 if ( my ($pooltype) = ($webvar{alloctype} =~ /^([sdc])p$/) ) {
964 # have to insert all pool IPs into poolips table as "unallocated".
965 # sql: insert into poolips values (fullcidr,$ip,'6750400',alloctype,'n')
966 $sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
967 " ?, '6750400', '$webvar{city}', '$pooltype', 'y', '')");
968 $cidr = new NetAddr::IP $webvar{fullcidr};
969 @poolip_list = $cidr->hostenum;
970 for (my $i=1; $i<=$#poolip_list; $i++) {
971 $sth->execute($poolip_list[$i]->addr);
972 }
973 } # end pool special
974
975 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>);
976
977 } # end static-IP vs netblock allocation
978
979 printFooter();
980} # end insertAssign()
981
982
983# Does some basic checks on common input data to make sure nothing
984# *really* weird gets in to the database through this script.
985# Does NOT do complete input validation!!!
986sub validateInput {
987 if ($webvar{city} eq '-') {
988 printAndExit("Please choose a city.");
989 }
990 if ($webvar{alloctype} =~ /^(ci|di|cn)$/) {
991 if (!$webvar{custid}) {
992 printAndExit("Please enter a customer ID.");
993 }
994 print "[ In validateInput(). Insert customer ID cross-check here. ]<br>\n";
995 } elsif ($webvar{alloctype} =~ /^([sdc]p|si|e|dn|dy|dc|e|r|i)$/){
996 # All non-customer allocations MUST be entered with "our" customer ID.
997 # I have Defined this as 6750400 for consistency.
998 $webvar{custid} = "6750400";
999 } else {
1000 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
1001 # managing to call things in such a way as to cause this deserves a cryptic error.
1002 printAndExit("Invalid alloctype");
1003 }
1004 return 0;
1005} # end validateInput
1006
1007
1008# Displays details of a specific allocation in a form
1009# Allows update/delete
1010# action=edit
1011sub edit
1012{
1013 printHeader('');
1014
1015 # gotta snag block info from db
1016 $sth = $ip_dbh->prepare("select * from allocations where cidr='$webvar{block}'");
1017 $sth->execute;
1018 @data = $sth->fetchrow_array;
1019
1020 open (HTML, "../editDisplay.html") || die "Could not open editDisplay.html :$!";
1021 my $html = join('', <HTML>);
1022
1023 # We can't let the city be changed here; this block is a part of
1024 # a larger routed allocation and therefore by definition can't be moved.
1025 # block and city are static.
1026 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1027 $html =~ s/\$\$CITY\$\$/$data[3]/g;
1028
1029# Screw it. Changing allocation types gets very ugly VERY quickly- especially
1030# with the much longer list of allocation types.
1031# We'll just show what type of block it is.
1032
1033 $html =~ s/\$\$TYPE\$\$/$data[2]/g;
1034 $html =~ s/\$\$FULLTYPE\$\$/$full_alloc_types{$data[2]}/g;
1035
1036 # These can be modified, although CustID changes may get ignored.
1037 $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
1038 $html =~ s/\$\$DESC\$\$/$data[4]/g;
1039 $html =~ s/\$\$NOTES\$\$/$data[5]/g;
1040
1041 print $html;
1042
1043 printFooter();
1044} # edit()
1045
1046
1047### needs work
1048# Stuff new info about a block into the db
1049# action=update
1050sub update {
1051 printHeader('');
1052
1053print "<pre>\n";
1054
1055print " block: $webvar{block}\n";
1056print " type: $webvar{alloctype} ($full_alloc_types{$webvar{alloctype}})\n";
1057print "custid: $webvar{custid}\n";
1058print " desc: $webvar{desc}\n";
1059print " notes: $webvar{notes}\n";
1060
1061# -> Always update desc and notes
1062# better yet, just update the customer id every time, based on allocation type...
1063
1064if ($webvar{alloctype} eq 'c') {
1065 print "Updating customer alloc:\n ";
1066 $sth = $ip_dbh->prepare("update allocations set type='$webvar{alloctype}',".
1067 "custid='$webvar{custid}',description='$webvar{desc}',notes='$webvar{notes}' ".
1068 "where cidr='$webvar{block}'");
1069} else {
1070 print "Updating non-customer alloc:\n ";
1071 $sth = $ip_dbh->prepare("update allocations set type='$webvar{alloctype}',".
1072 "custid='6750400',description='$webvar{desc}',notes='$webvar{notes}' ".
1073 "where cidr='$webvar{block}'");
1074}
1075$sth->execute;
1076
1077if($sth->errstr()) {
1078 print $sth->errstr()
1079} else {
1080 print "Update successful.\n";
1081}
1082
1083print "</pre>\n";
1084
1085 printFooter;
1086} # update()
1087
1088
1089# Delete an allocation.
1090sub remove
1091{
1092 printHeader('');
1093 #show confirm screen.
1094 open HTML, "../confirmRemove.html"
1095 or die "Could not open confirmRemove.html :$!";
1096 my $html = join('', <HTML>);
1097 close HTML;
1098
1099 # Serves'em right for getting here...
1100 if (!defined($webvar{block})) {
1101 printAndExit("Error 332");
1102 }
1103
1104 my ($cidr, $custid, $type, $city, $desc, $notes);
1105
1106
1107 if ($webvar{alloctype} eq 'r') {
1108 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1109 $sth->execute();
1110
1111# This feels... extreme.
1112 die $sth->errstr() if($sth->errstr());
1113
1114 $sth->bind_columns(\$cidr,\$city);
1115 $sth->execute();
1116 $sth->fetch || die $sth->errstr();
1117 $custid = "N/A";
1118 $alloctype = $webvar{alloctype};
1119 $desc = "N/A";
1120 $notes = "N/A";
1121
1122 } elsif ($webvar{alloctype} =~ /^[sdc]i$/) { # done with alloctype=r
1123
1124 # Unassigning a static IP
1125 my $sth = $ip_dbh->prepare("select ip,custid,city,ptype,notes from poolips".
1126 " where ip='$webvar{block}'");
1127 $sth->execute();
1128# die $sth->errstr() if($sth->errstr());
1129
1130 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes);
1131 $sth->fetch() || die;
1132
1133 $alloctype .="i";
1134
1135 } else { # done with alloctype=[sdc]i
1136
1137 my $sth = $ip_dbh->prepare("select * from allocations where cidr='$webvar{block}'");
1138 $sth->execute();
1139# die $sth->errstr() if($sth->errstr());
1140
1141 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$desc, \$notes);
1142 $sth->fetch() || die;
1143 } # end cases for different alloctypes
1144
1145 # Munge everything into HTML
1146 $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
1147 $html =~ s|\$\$BLOCK\$\$|$cidr|g;
1148 $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$alloctype}|g;
1149 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
1150 $html =~ s|\$\$CITY\$\$|$city|g;
1151 $html =~ s|\$\$CUSTID\$\$|$custid|g;
1152 $html =~ s|\$\$DESC\$\$|$desc|g;
1153 $html =~ s|\$\$NOTES\$\$|$notes|g;
1154
1155 $html =~ s|\$\$ACTION\$\$|finaldelete|g;
1156
1157 # Set the warning text.
1158 if ($alloctype =~ /^[sdc]p$/) {
1159 $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>|;
1160 } else {
1161 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
1162 }
1163
1164 print $html;
1165 printFooter;
1166} # end edit()
1167
1168
1169# Delete an allocation. Return it to the freeblocks table; munge
1170# data as necessary to keep as few records as possible in freeblocks
1171# to prevent weirdness when allocating blocks later.
1172# Remove IPs from pool listing if necessary
1173sub finalDelete
1174{
1175 printHeader('');
1176
1177 if ($webvar{alloctype} =~ /^[sdc]i$/) {
1178
1179 $sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
1180 $sth->execute;
1181 @data = $sth->fetchrow_array;
1182 $sth = $ip_dbh->prepare("select city from allocations where cidr='$data[0]'");
1183 $sth->execute;
1184 @data = $sth->fetchrow_array;
1185 $sth = $ip_dbh->prepare("update poolips set custid='6750400', available='y',".
1186 " city='$data[0]' where ip='$webvar{block}'");
1187 $sth->execute;
1188 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
1189
1190 } else { # end alloctype = [sdc]i
1191
1192 $cidr = new NetAddr::IP $webvar{block};
1193 if ($webvar{alloctype} eq 'r') {
1194
1195 $sth = $ip_dbh->prepare("delete from routed where cidr='$webvar{block}'");
1196 $sth->execute;
1197
1198 # Make sure block getting deleted is properly accounted for.
1199 $sth = $ip_dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
1200 " where cidr='$webvar{block}'");
1201 $sth->execute;
1202
1203 $sth = $ip_dbh->prepare("select * from freeblocks where ".
1204 "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
1205
1206 } else { # end alloctype routing case
1207
1208 $sth = $ip_dbh->prepare("delete from allocations where cidr='$webvar{block}'");
1209 $sth->execute;
1210
1211 # Special case - delete pool IPs
1212 if ($webvar{alloctype} =~ /^[sdc]p$/) {
1213 # We have to delete the IPs from the pool listing.
1214 $sth = $ip_dbh->prepare("delete * from poolips where pool='$webvar{block}'");
1215 $sth->execute;
1216 }
1217
1218 # Set up query for compacting free blocks.
1219 $sth = $ip_dbh->prepare("select * from freeblocks where city='$webvar{city}'".
1220 " and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
1221
1222 } # end alloctype general case
1223
1224 # Now we look for larger-or-equal-sized free blocks in the same master (routed)
1225 # (super)block. If there aren't any, we can't combine blocks anyway. If there
1226 # are, we check to see if we can combine blocks.
1227 # Execute the statement prepared in the if-else above.
1228
1229 $sth->execute;
1230
1231# NetAddr::IP->compact() attempts to produce the smallest inclusive block
1232# from the caller and the passed terms.
1233# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
1234# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
1235# .64-.95, and .96-.128), you will get an array containing a single
1236# /25 as element 0 (.0-.127). Order is not important; you could have
1237# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
1238
1239 my $i=0;
1240 while (@data = $sth->fetchrow_array) {
1241 my $testIP = new NetAddr::IP $data[0];
1242 @together = $testIP->compact($cidr);
1243 $num = @together;
1244 if ($num == 1) {
1245 $cidr = $together[0];
1246 $combinelist[$i++] = $testIP;
1247 }
1248 }
1249
1250 # Clear old freeblocks entries - if any. $i==0 if not.
1251 if ($i>0) {
1252 $sth = $ip_dbh->prepare("delete from freeblocks where cidr=?");
1253 foreach $block (@combinelist) {
1254 $sth->execute($block);
1255 }
1256 }
1257
1258 # insert "new" freeblocks entry
1259 if ($webvar{alloctype} eq 'r') {
1260 $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
1261 ",'<NULL>','n')");
1262 } else {
1263 $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
1264 ",'$webvar{city}','y')");
1265 }
1266 $sth->execute;
1267
1268 print "<div class=heading align=center>Success! $webvar{block} deleted.</div>\n";
1269
1270 } # end alloctype != netblock
1271
1272 printFooter;
1273} # finalDelete
1274
1275
1276# Just in case we manage to get here.
1277exit 0;
Note: See TracBrowser for help on using the repository browser.