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

Last change on this file since 410 was 394, checked in by Kris Deugau, 15 years ago

/branches/stable

Basic support for network node references: Add, view, edit nodes and

referencess

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