source: branches/stable/cgi-bin/IPDB.pm@ 354

Last change on this file since 354 was 354, checked in by Kris Deugau, 17 years ago

/branches/stable

Fix lurking buglet in deallocation of static IPs.

If the admin interface (or direct DB manipulation) were used to create an
IP pool within another block, deallocation would fail because the SQL
statement came up with 2 results where it would otherwise only have found 1.
  • Property svn:keywords set to Date Rev Author
File size: 22.5 KB
Line 
1# ipdb/cgi-bin/IPDB.pm
2# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
3###
4# SVN revision info
5# $Date: 2006-12-27 16:13:46 +0000 (Wed, 27 Dec 2006) $
6# SVN revision $Rev: 354 $
7# Last update by $Author: kdeugau $
8###
9# Copyright (C) 2004-2006 - Kris Deugau
10
11package IPDB;
12
13use strict;
14use warnings;
15use Exporter;
16use DBI;
17use Net::SMTP;
18use POSIX;
19use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
20
21$VERSION = 2.0;
22@ISA = qw(Exporter);
23@EXPORT_OK = qw(
24 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
25 %allocated %free %routed %bigfree %IPDBacl
26 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
27 &mailNotify
28 );
29
30@EXPORT = (); # Export nothing by default.
31%EXPORT_TAGS = ( ALL => [qw(
32 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
33 @masterblocks %allocated %free %routed %bigfree %IPDBacl
34 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
35 &deleteBlock &mailNotify
36 )]
37 );
38
39##
40## Global variables
41##
42our %disp_alloctypes;
43our %list_alloctypes;
44our %def_custids;
45our @citylist;
46our @poplist;
47our @masterblocks;
48our %allocated;
49our %free;
50our %routed;
51our %bigfree;
52our %IPDBacl;
53
54# Let's initialize the globals.
55## IPDB::initIPDBGlobals()
56# Initialize all globals. Takes a database handle, returns a success or error code
57sub initIPDBGlobals {
58 my $dbh = $_[0];
59 my $sth;
60
61 # Initialize alloctypes hashes
62 $sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
63 $sth->execute;
64 while (my @data = $sth->fetchrow_array) {
65 $disp_alloctypes{$data[0]} = $data[2];
66 $def_custids{$data[0]} = $data[4];
67 if ($data[3] < 900) {
68 $list_alloctypes{$data[0]} = $data[1];
69 }
70 }
71
72 # City and POP listings
73 $sth = $dbh->prepare("select city,routing from cities order by city");
74 $sth->execute;
75 return (undef,$sth->errstr) if $sth->err;
76 while (my @data = $sth->fetchrow_array) {
77 push @citylist, $data[0];
78 if ($data[1] eq 'y') {
79 push @poplist, $data[0];
80 }
81 }
82
83 # Master block list
84 $sth = $dbh->prepare("select cidr from masterblocks order by cidr");
85 $sth->execute;
86 return (undef,$sth->errstr) if $sth->err;
87 for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
88 $masterblocks[$i] = new NetAddr::IP $data[0];
89 $allocated{"$masterblocks[$i]"} = 0;
90 $free{"$masterblocks[$i]"} = 0;
91 $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
92 # Set to 128 to prepare for IPv6
93 $routed{"$masterblocks[$i]"} = 0;
94 }
95
96 # Load ACL data. Specific username checks are done at a different level.
97 $sth = $dbh->prepare("select username,acl from users");
98 $sth->execute;
99 return (undef,$sth->errstr) if $sth->err;
100 while (my @data = $sth->fetchrow_array) {
101 $IPDBacl{$data[0]} = $data[1];
102 }
103
104 return (1,"OK");
105} # end initIPDBGlobals
106
107
108## IPDB::connectDB()
109# Creates connection to IPDB.
110# Requires the database name, username, and password.
111# Returns a handle to the db.
112# Set up for a PostgreSQL db; could be any transactional DBMS with the
113# right changes.
114# This definition should be sub connectDB($$$) to be technically correct,
115# but this breaks. GRR.
116sub connectDB {
117 my ($dbname,$user,$pass) = @_;
118 my $dbh;
119 my $DSN = "DBI:Pg:dbname=$dbname";
120# my $user = 'ipdb';
121# my $pw = 'ipdbpwd';
122
123# Note that we want to autocommit by default, and we will turn it off locally as necessary.
124# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
125 $dbh = DBI->connect($DSN, $user, $pass, {
126 AutoCommit => 1,
127 PrintError => 0
128 })
129 or return (undef, $DBI::errstr) if(!$dbh);
130
131# Return here if we can't select. Note that this indicates a
132# problem executing the select.
133 my $sth = $dbh->prepare("select type from alloctypes");
134 $sth->execute();
135 return (undef,$DBI::errstr) if ($sth->err);
136
137# See if the select returned anything (or null data). This should
138# succeed if the select executed, but...
139 $sth->fetchrow();
140 return (undef,$DBI::errstr) if ($sth->err);
141
142# If we get here, we should be OK.
143 return ($dbh,"DB connection OK");
144} # end connectDB
145
146
147## IPDB::finish()
148# Cleans up after database handles and so on.
149# Requires a database handle
150sub finish {
151 my $dbh = $_[0];
152 $dbh->disconnect;
153} # end finish
154
155
156## IPDB::checkDBSanity()
157# Quick check to see if the db is responding. A full integrity
158# check will have to be a separate tool to walk the IP allocation trees.
159sub checkDBSanity {
160 my ($dbh) = $_[0];
161
162 if (!$dbh) {
163 print "No database handle, or connection has been closed.";
164 return -1;
165 } else {
166 # it connects, try a stmt.
167 my $sth = $dbh->prepare("select type from alloctypes");
168 my $err = $sth->execute();
169
170 if ($sth->fetchrow()) {
171 # all is well.
172 return 1;
173 } else {
174 print "Connected to the database, but could not execute test statement. ".$sth->errstr();
175 return -1;
176 }
177 }
178 # Clean up after ourselves.
179# $dbh->disconnect;
180} # end checkDBSanity
181
182
183## IPDB::allocateBlock()
184# Does all of the magic of actually allocating a netblock
185# Requires database handle, block to allocate, custid, type, city,
186# description, notes, circuit ID, block to allocate from, private data
187# Returns a success code and optional error message.
188sub allocateBlock {
189 my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata) = @_;
190
191 my $cidr = new NetAddr::IP $_[1];
192 my $alloc_from = new NetAddr::IP $_[2];
193 my $sth;
194
195 # Snag the "type" of the freeblock (alloc_from) "just in case"
196 $sth = $dbh->prepare("select routed from freeblocks where cidr='$alloc_from'");
197 $sth->execute;
198 my ($alloc_from_type) = $sth->fetchrow_array;
199
200 # To contain the error message, if any.
201 my $msg = "Unknown error allocating $cidr as '$type'";
202
203 # Enable transactions and error handling
204 local $dbh->{AutoCommit} = 0; # These need to be local so we don't
205 local $dbh->{RaiseError} = 1; # step on our toes by accident.
206
207 if ($type =~ /^.i$/) {
208 $msg = "Unable to assign static IP $cidr to $custid";
209 eval {
210 # We have to do this in two parts because otherwise we lose
211 # the ability to return the IP assigned. Should that change,
212 # the commented SQL statement below may become usable.
213# update poolips set custid='$custid',city='$city',available='n',
214# description='$desc',notes='$notes',circuitid='$circid'
215# where ip=(select ip from poolips where pool='$alloc_from'
216# and available='y' order by ip limit 1);
217
218 $sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'".
219 " and available='y' order by ip");
220 $sth->execute;
221
222 my @data = $sth->fetchrow_array;
223 $cidr = $data[0]; # $cidr is already declared when we get here!
224
225 $sth = $dbh->prepare("update poolips set custid='$custid',".
226 "city='$city',available='n',description='$desc',notes='$notes',".
227 "circuitid='$circid',privdata='$privdata'".
228 " where ip='$cidr'");
229 $sth->execute;
230 $dbh->commit;
231 };
232 if ($@) {
233 $msg .= ": '".$sth->errstr."'";
234 eval { $dbh->rollback; };
235 return ('FAIL',$msg);
236 } else {
237 return ('OK',"$cidr");
238 }
239
240 } else { # end IP-from-pool allocation
241
242 if ($cidr == $alloc_from) {
243 # Easiest case- insert in one table, delete in the other, and go home. More or less.
244 # insert into allocations values (cidr,custid,type,city,desc) and
245 # delete from freeblocks where cidr='cidr'
246 # For data safety on non-transaction DBs, we delete first.
247
248 eval {
249 $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
250 if ($type eq 'rm') {
251 $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
252 " where cidr='$cidr'");
253 $sth->execute;
254 $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
255 " values ('$cidr',".$cidr->masklen.",'$city')");
256 $sth->execute;
257 } else {
258 # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
259
260 # special case - block is a container/"reserve" block
261 if ($type =~ /^(.)c$/) {
262 $sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
263 $sth->execute;
264 } else {
265 # "normal" case
266 $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
267 $sth->execute;
268 }
269 $sth = $dbh->prepare("insert into allocations".
270 " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
271 " values ('$cidr','$custid','$type','$city','$desc','$notes',".
272 $cidr->masklen.",'$circid','$privdata')");
273 $sth->execute;
274
275 # And initialize the pool, if necessary
276 # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
277 # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
278 if ($type =~ /^.p$/) {
279 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
280 my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
281 die $rmsg if $code eq 'FAIL';
282 } elsif ($type =~ /^.d$/) {
283 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
284 my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
285 die $rmsg if $code eq 'FAIL';
286 }
287
288 } # routing vs non-routing netblock
289
290 $dbh->commit;
291 }; # end of eval
292 if ($@) {
293 $msg .= ": ".$@;
294 eval { $dbh->rollback; };
295 return ('FAIL',$msg);
296 } else {
297 return ('OK',"OK");
298 }
299
300 } else { # cidr != alloc_from
301
302 # Hard case. Allocation is smaller than free block.
303 my $wantmaskbits = $cidr->masklen;
304 my $maskbits = $alloc_from->masklen;
305
306 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
307
308 # This determines which blocks will be left "free" after allocation. We take the
309 # block we're allocating from, and split it in half. We see which half the wanted
310 # block is in, and repeat until the wanted block is equal to one of the halves.
311 my $i=0;
312 my $tmp_from = $alloc_from; # So we don't munge $alloc_from
313 while ($maskbits++ < $wantmaskbits) {
314 my @subblocks = $tmp_from->split($maskbits);
315 $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
316 $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
317 } # while
318
319 # Begin SQL transaction block
320 eval {
321 $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
322
323 # Delete old freeblocks entry
324 $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
325 $sth->execute();
326
327 # now we have to do some magic for routing blocks
328 if ($type eq 'rm') {
329
330 # Insert the new freeblocks entries
331 # Note that non-routed blocks are assigned to <NULL>
332 # and use the default value for the routed column ('n')
333 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
334 " values (?, ?, '<NULL>')");
335 foreach my $block (@newfreeblocks) {
336 $sth->execute("$block", $block->masklen);
337 }
338
339 # Insert the entry in the routed table
340 $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
341 " values ('$cidr',".$cidr->masklen.",'$city')");
342 $sth->execute;
343 # Insert the (almost) same entry in the freeblocks table
344 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
345 " values ('$cidr',".$cidr->masklen.",'$city','y')");
346 $sth->execute;
347
348 } else { # done with alloctype == rm
349
350 # Insert the new freeblocks entries
351 # Along with some more HairyPerl(TM):
352 # if $alloc_type_from is p
353 # OR
354 # $type matches /^(.)r$/
355 # inserted value for routed column should match.
356 # This solves the case of inserting an arbitrary block into a
357 # "Reserve-for-routed-DSL" block. Which you really shouldn't
358 # do in the first place, but anyway...
359 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
360 " values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
361 ( ( ($alloc_from_type =~ /^(p)$/) || ($type =~ /^(.)r$/) ) ? "$1" : 'y')."')");
362 foreach my $block (@newfreeblocks) {
363 $sth->execute("$block", $block->masklen);
364 }
365 # Special-case for reserve/"container" blocks - generate
366 # the "extra" freeblocks entry for the container
367 if ($type =~ /^(.)c$/) {
368 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
369 " values ('$cidr',".$cidr->masklen.",'$city','$1')");
370 $sth->execute;
371 }
372 # Insert the allocations entry
373 $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
374 "description,notes,maskbits,circuitid,privdata)".
375 " values ('$cidr','$custid','$type','$city','$desc','$notes',".
376 $cidr->masklen.",'$circid','$privdata')");
377 $sth->execute;
378
379 # And initialize the pool, if necessary
380 # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
381 # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
382 if ($type =~ /^.p$/) {
383 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
384 my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
385 die $rmsg if $code eq 'FAIL';
386 } elsif ($type =~ /^.d$/) {
387 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
388 my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
389 die $rmsg if $code eq 'FAIL';
390 }
391
392 } # done with netblock alloctype != rm
393
394 $dbh->commit;
395 }; # end eval
396 if ($@) {
397 $msg .= ": ".$@;
398 eval { $dbh->rollback; };
399 return ('FAIL',$msg);
400 } else {
401 return ('OK',"OK");
402 }
403
404 } # end fullcidr != alloc_from
405
406 } # end static-IP vs netblock allocation
407
408} # end allocateBlock()
409
410
411## IPDB::initPool()
412# Initializes a pool
413# Requires a database handle, the pool CIDR, type, city, and a parameter
414# indicating whether the pool should allow allocation of literally every
415# IP, or if it should reserve network/gateway/broadcast IPs
416# Note that this is NOT done in a transaction, that's why it's a private
417# function and should ONLY EVER get called from allocateBlock()
418sub initPool {
419 my ($dbh,undef,$type,$city,$class) = @_;
420 my $pool = new NetAddr::IP $_[1];
421
422##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
423 $type =~ s/[pd]$/i/;
424 my $sth;
425 my $msg;
426
427 # Trap errors so we can pass them back to the caller. Even if the
428 # caller is only ever supposed to be local, and therefore already
429 # trapping errors. >:(
430 local $dbh->{AutoCommit} = 0; # These need to be local so we don't
431 local $dbh->{RaiseError} = 1; # step on our toes by accident.
432
433 eval {
434 # have to insert all pool IPs into poolips table as "unallocated".
435 $sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
436 " values ('$pool', ?, '6750400', '$city', '$type')");
437 my @poolip_list = $pool->hostenum;
438 if ($class eq 'all') { # (DSL-ish block - *all* IPs available
439 if ($pool->addr !~ /\.0$/) { # .0 causes weirdness.
440 $sth->execute($pool->addr);
441 }
442 for (my $i=0; $i<=$#poolip_list; $i++) {
443 $sth->execute($poolip_list[$i]->addr);
444 }
445 $pool--;
446 if ($pool->addr !~ /\.255$/) { # .255 can cause weirdness.
447 $sth->execute($pool->addr);
448 }
449 } else { # (real netblock)
450 for (my $i=1; $i<=$#poolip_list; $i++) {
451 $sth->execute($poolip_list[$i]->addr);
452 }
453 }
454 };
455 if ($@) {
456 $msg = "'".$sth->errstr."'";
457 eval { $dbh->rollback; };
458 return ('FAIL',$msg);
459 } else {
460 return ('OK',"OK");
461 }
462} # end initPool()
463
464
465## IPDB::deleteBlock()
466# Removes an allocation from the database, including deleting IPs
467# from poolips and recombining entries in freeblocks if possible
468# Also handles "deleting" a static IP allocation, and removal of a master
469# Requires a database handle, the block to delete, and the type of block
470sub deleteBlock {
471 my ($dbh,undef,$type) = @_;
472 my $cidr = new NetAddr::IP $_[1];
473
474 my $sth;
475
476 # Magic variables used for odd allocation cases.
477 my $container;
478 my $con_type;
479
480 # To contain the error message, if any.
481 my $msg = "Unknown error deallocating $type $cidr";
482 # Enable transactions and exception-on-errors... but only for this sub
483 local $dbh->{AutoCommit} = 0;
484 local $dbh->{RaiseError} = 1;
485
486 # First case. The "block" is a static IP
487 # Note that we still need some additional code in the odd case
488 # of a netblock-aligned contiguous group of static IPs
489 if ($type =~ /^.i$/) {
490
491 eval {
492 $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
493 $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
494 "city=(select city from allocations where cidr >>= '$cidr'".
495 " order by masklen(cidr) desc limit 1),".
496 "description='',notes='',circuitid='' where ip='$cidr'");
497 $sth->execute;
498 $dbh->commit;
499 };
500 if ($@) {
501 eval { $dbh->rollback; };
502 return ('FAIL',$msg);
503 } else {
504 return ('OK',"OK");
505 }
506
507 } elsif ($type eq 'mm') { # end alloctype =~ /.i/
508
509 $msg = "Unable to delete master block $cidr";
510 eval {
511 $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
512 $sth->execute;
513 $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
514 $sth->execute;
515 $dbh->commit;
516 };
517 if ($@) {
518 eval { $dbh->rollback; };
519 return ('FAIL', $msg);
520 } else {
521 return ('OK',"OK");
522 }
523
524 } else { # end alloctype master block case
525
526 ## This is a big block; but it HAS to be done in a chunk. Any removal
527 ## of a netblock allocation may result in a larger chunk of free
528 ## contiguous IP space - which may in turn be combined into a single
529 ## netblock rather than a number of smaller netblocks.
530
531 eval {
532
533 if ($type eq 'rm') {
534 $msg = "Unable to remove routing allocation $cidr";
535 $sth = $dbh->prepare("delete from routed where cidr='$cidr'");
536 $sth->execute;
537 # Make sure block getting deleted is properly accounted for.
538 $sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
539 " where cidr='$cidr'");
540 $sth->execute;
541 # Set up query to start compacting free blocks.
542 $sth = $dbh->prepare("select cidr from freeblocks where ".
543 "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
544
545 } else { # end alloctype routing case
546
547 # Magic. We need to get information about the containing block (if any)
548 # so as to make sure that the freeblocks we insert get the correct "type".
549 $sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'");
550 $sth->execute;
551 ($container, $con_type) = $sth->fetchrow_array;
552
553 # Delete all allocations within the block being deleted. This is
554 # deliberate and correct, and removes the need to special-case
555 # removal of "container" blocks.
556 $sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
557 $sth->execute;
558
559 # Special case - delete pool IPs
560 if ($type =~ /^.[pd]$/) {
561 # We have to delete the IPs from the pool listing.
562 $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
563 $sth->execute;
564 }
565
566 # Set up query for compacting free blocks.
567 if ($con_type && $con_type eq 'pc') {
568 # Clean up after "bad" allocations (blocks that are not formally
569 # contained which have nevertheless been allocated from a container block)
570 # We want to make certain that the freeblocks are properly "labelled"
571 $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container'");
572 } else {
573 # Standard deallocation.
574 $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
575 "(select cidr from routed where cidr >>= '$cidr') ".
576 " and maskbits<=".$cidr->masklen.
577 " and routed='".(($type =~ /^(.)r$/) ? "$1" : 'y').
578 "' order by maskbits desc");
579 }
580
581 } # end alloctype general case
582
583##TEMP
584## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24
585## Note that we should really general-case this.
586my $staticpool = new NetAddr::IP "209.91.185.0/24";
587##TEMP
588if ($cidr->within($staticpool)) {
589##TEMP
590 # We've already deleted the block, now we have to stuff its IPs into the pool.
591 my $sth2 = $dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','Sudbury','di','y','','','')");
592 $sth2->execute($cidr->addr);
593 foreach my $ip ($cidr->hostenum) {
594 $sth2->execute("$ip");
595 }
596 $cidr--;
597 $sth2->execute($cidr->addr);
598
599##TEMP
600} else {
601##TEMP
602
603 # Now we look for larger-or-equal-sized free blocks in the same master (routed)
604 # (super)block. If there aren't any, we can't combine blocks anyway. If there
605 # are, we check to see if we can combine blocks.
606 # Execute the statement prepared in the if-else above.
607
608 $sth->execute;
609
610# NetAddr::IP->compact() attempts to produce the smallest inclusive block
611# from the caller and the passed terms.
612# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
613# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
614# .64-.95, and .96-.128), you will get an array containing a single
615# /25 as element 0 (.0-.127). Order is not important; you could have
616# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
617
618 my (@together, @combinelist);
619 my $i=0;
620 while (my @data = $sth->fetchrow_array) {
621 my $testIP = new NetAddr::IP $data[0];
622 @together = $testIP->compact($cidr);
623 my $num = @together;
624 if ($num == 1) {
625 $cidr = $together[0];
626 $combinelist[$i++] = $testIP;
627 }
628 }
629
630 # Clear old freeblocks entries - if any. They should all be within
631 # the $cidr determined above.
632 $sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
633 $sth->execute;
634
635 # insert "new" freeblocks entry
636 if ($type eq 'rm') {
637 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
638 " values ('$cidr',".$cidr->masklen.",'<NULL>')");
639 } else {
640 # Magic hackery to insert "correct" data for deallocation of
641 # non-contained blocks allocated from within a container.
642 $type = 'pr' if $con_type && $con_type eq 'pc';
643
644 $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
645 " values ('$cidr',".$cidr->masklen.
646 ",(select city from routed where cidr >>= '$cidr'),'".
647 (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
648 }
649 $sth->execute;
650
651##TEMP
652}
653##TEMP
654
655 # If we got here, we've succeeded. Whew!
656 $dbh->commit;
657 }; # end eval
658 if ($@) {
659 eval { $dbh->rollback; };
660 return ('FAIL', $msg);
661 } else {
662 return ('OK',"OK");
663 }
664
665 } # end alloctype != netblock
666
667} # end deleteBlock()
668
669
670## IPDB::mailNotify()
671# Sends notification mail to recipients regarding an IPDB operation
672sub mailNotify ($$$) {
673 my ($recip,$subj,$message) = @_;
674 my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
675
676 $mailer->mail('ipdb@example.com');
677 $mailer->to($recip);
678 $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
679 "To: $recip\n",
680 "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
681 "Subject: {IPDB} $subj\n",
682 "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
683 "Organization: Example Corp\n",
684 "\n$message\n");
685 $mailer->quit;
686}
687
688# Indicates module loaded OK. Required by Perl.
6891;
Note: See TracBrowser for help on using the repository browser.