source: trunk/cgi-bin/IPDB.pm@ 106

Last change on this file since 106 was 106, checked in by Kris Deugau, 19 years ago

/trunk

IPDB rewrite, first stable iteration.

-> uses allocateBlock(), deleteBlock() from IPDB module rather

than hardcoding that in the web script

-> uses global variables from IPDB module for "static" data such

as allocation types and ities (which are loaded from the
database in much the same way that master blocks have been loaded)

-> IPDB.pm contains NO locally-exiting code, nor calls to any code

which exits before returning. This allows returning status codes
to the caller, so that things like database handles can be
properly cleaned up.

There are probably also a long list of minor bugfixes that I've forgotten.
  • Property svn:keywords set to Date Rev Author
File size: 16.7 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: 2004-12-22 21:25:59 +0000 (Wed, 22 Dec 2004) $
6# SVN revision $Rev: 106 $
7# Last update by $Author: kdeugau $
8###
9# Copyright (C) 2004 - 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 @citylist @poplist @masterblocks
25 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
26 &mailNotify
27 );
28
29@EXPORT = (); # Export nothing by default.
30%EXPORT_TAGS = ( ALL => [qw(
31 %disp_alloctypes %list_alloctypes @citylist @poplist @masterblocks
32 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
33 &deleteBlock &mailNotify
34 )]
35 );
36
37##
38## Global variables
39##
40our %disp_alloctypes;
41our %list_alloctypes;
42our @citylist;
43our @poplist;
44our @masterblocks;
45
46# Let's initialize the globals.
47## IPDB::initIPDBGlobals()
48# Initialize all globals. Takes a database handle, returns a success or error code
49sub initIPDBGlobals {
50 my $dbh = $_[0];
51 my $sth;
52
53 # Initialize alloctypes hashes
54 $sth = $dbh->prepare("select * from alloctypes order by listorder");
55 $sth->execute;
56 while (my @data = $sth->fetchrow_array) {
57 $disp_alloctypes{$data[0]} = $data[2];
58 if ($data[3] < 900) {
59 $list_alloctypes{$data[0]} = $data[1];
60 }
61 }
62
63 # City and POP listings
64 $sth = $dbh->prepare("select * from cities");
65 $sth->execute;
66 return (undef,$sth->errstr) if $sth->err;
67 while (my @data = $sth->fetchrow_array) {
68 push @citylist, $data[0];
69 if ($data[1] eq 'y') {
70 push @poplist, $data[0];
71 }
72 }
73
74 # Master block list
75 $sth = $dbh->prepare("select * from masterblocks order by cidr");
76 $sth->execute;
77 for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
78 $masterblocks[$i] = new NetAddr::IP $data[0];
79 }
80 return (undef,$sth->errstr) if $sth->err;
81
82 return (1,"OK");
83} # end initIPDBGlobals
84
85
86## IPDB::connectDB()
87# Creates connection to IPDB.
88# Requires the database name, username, and password.
89# Returns a handle to the db.
90# Set up for a PostgreSQL db; could be any transactional DBMS with the
91# right changes.
92# This definition should be sub connectDB($$$) to be technically correct,
93# but this breaks. GRR.
94sub connectDB {
95 my ($dbname,$user,$pass) = @_;
96 my $dbh;
97 my $DSN = "DBI:Pg:dbname=$dbname";
98# my $user = 'ipdb';
99# my $pw = 'ipdbpwd';
100
101# Note that we want to autocommit by default, and we will turn it off locally as necessary.
102# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
103 $dbh = DBI->connect($DSN, $user, $pass, {
104 AutoCommit => 1,
105 PrintError => 0
106 })
107 or return (undef, $DBI::errstr) if(!$dbh);
108
109# Return here if we can't select. Note that this indicates a
110# problem executing the select.
111 my $sth = $dbh->prepare('select cidr from masterblocks');
112 $sth->execute();
113 return (undef,$DBI::errstr) if ($sth->err);
114
115# See if the select returned anything (or null data). This should
116# succeed if the select executed, but...
117 $sth->fetchrow();
118 return (undef,$DBI::errstr) if ($sth->err);
119
120# If we get here, we should be OK.
121 return ($dbh,"DB connection OK");
122} # end connectDB
123
124
125## IPDB::finish()
126# Cleans up after database handles and so on.
127# Requires a database handle
128sub finish {
129 my $dbh = $_[0];
130 $dbh->disconnect;
131} # end finish
132
133
134## IPDB::checkDBSanity()
135# Quick check to see if the db is responding. A full integrity
136# check will have to be a separate tool to walk the IP allocation trees.
137sub checkDBSanity {
138 my ($dbh) = $_[0];
139
140 if (!$dbh) {
141 print "No database handle, or connection has been closed.";
142 return -1;
143 } else {
144 # it connects, try a stmt.
145 my $sth = $dbh->prepare('select cidr from masterblocks');
146 my $err = $sth->execute();
147
148 if ($sth->fetchrow()) {
149 # all is well.
150 return 1;
151 } else {
152 print "Connected to the database, but could not execute test statement. ".$sth->errstr();
153 return -1;
154 }
155 }
156 # Clean up after ourselves.
157# $dbh->disconnect;
158} # end checkDBSanity
159
160
161## IPDB::allocateBlock()
162# Does all of the magic of actually allocating a netblock
163# Requires database handle, block to allocate, custid, type, city,
164# description, notes, circuit ID, block to allocate from,
165# Returns a success code and optional error message.
166sub allocateBlock {
167 my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid) = @_;
168
169 my $cidr = new NetAddr::IP $_[1];
170 my $alloc_from = new NetAddr::IP $_[2];
171 my $sth;
172
173 # To contain the error message, if any.
174 my $msg = "Unknown error allocating $cidr as '$type'";
175
176 # Enable transactions and error handling
177 local $dbh->{AutoCommit} = 0; # These need to be local so we don't
178 local $dbh->{RaiseError} = 1; # step on our toes by accident.
179
180 if ($type =~ /^[cdsmw]i$/) {
181 $msg = "Unable to assign static IP $cidr to $custid";
182 eval {
183 # We'll just have to put up with the oddities caused by SQL (un)sort order
184 $sth = $dbh->prepare("select * from poolips where pool='$alloc_from'".
185 " and available='y' order by ip");
186 $sth->execute;
187
188# update poolips set custid='$custid',city='$city',available='n',
189# description='$desc',notes='$notes',circuitid='$circid'
190# where ip=(select ip from poolips where pool='$alloc_from'
191# and available='y' order by ip limit 1);
192##err Need better handling here; what if there's no free IPs when this sub gets called?
193 my @data = $sth->fetchrow_array;
194 my $cidr = $data[1];
195
196 $sth = $dbh->prepare("update poolips set custid='$custid',".
197 "city='$city',available='n',description='$desc',notes='$notes'".
198 "circuitid='$circid'".
199 " where ip='$cidr'");
200 $sth->execute;
201 $dbh->commit;
202 };
203 if ($@) {
204 eval { $dbh->rollback; };
205 return ('FAIL',$msg);
206 } else {
207 return ('OK',"$cidr");
208 }
209
210 } else { # end IP-from-pool allocation
211
212 if ($cidr == $alloc_from) {
213 # Easiest case- insert in one table, delete in the other, and go home. More or less.
214 # insert into allocations values (cidr,custid,type,city,desc) and
215 # delete from freeblocks where cidr='cidr'
216 # For data safety on non-transaction DBs, we delete first.
217
218 eval {
219 $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
220 if ($type eq 'rr') {
221 $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
222 " where cidr='$cidr'");
223 $sth->execute;
224 $sth = $dbh->prepare("insert into routed values ('$cidr',".
225 $cidr->masklen.",'$city')");
226 $sth->execute;
227 } else {
228 # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
229 $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
230 $sth->execute;
231
232 $sth = $dbh->prepare("insert into allocations values ('$cidr',".
233 "'$custid','$type','$city','$desc','$notes',".
234 $cidr->masklen.",'$circid')");
235 $sth->execute;
236
237 # And initialize the pool, if necessary
238 if ($type =~ /^.p$/) {
239 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} pool $cidr";
240 initPool($dbh,$cidr,$type,$city,($type eq 'dp' ? "all" : "normal"));
241 }
242
243 } # routing vs non-routing netblock
244
245 $dbh->commit;
246 }; # end of eval
247 if ($@) {
248 $msg = $@;
249 eval { $dbh->rollback; };
250 return ('FAIL',$@);
251 } else {
252 return ('OK',"OK");
253 }
254
255 } else { # cidr != alloc_from
256
257 # Hard case. Allocation is smaller than free block.
258 my $wantmaskbits = $cidr->masklen;
259 my $maskbits = $alloc_from->masklen;
260
261 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
262
263 # This determines which blocks will be left "free" after allocation. We take the
264 # block we're allocating from, and split it in half. We see which half the wanted
265 # block is in, and repeat until the wanted block is equal to one of the halves.
266 my $i=0;
267 my $tmp_from = $alloc_from; # So we don't munge $alloc_from
268 while ($maskbits++ < $wantmaskbits) {
269 my @subblocks = $tmp_from->split($maskbits);
270 $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
271 $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
272 } # while
273
274 # Begin SQL transaction block
275 eval {
276 $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
277
278 # Delete old freeblocks entry
279 $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
280 $sth->execute();
281
282 # now we have to do some magic for routing blocks
283 if ($type eq 'rr') {
284
285 # Insert the new freeblocks entries
286 # Note that non-routed blocks are assigned to <NULL>
287 $sth = $dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
288 foreach my $block (@newfreeblocks) {
289 $sth->execute("$block", $block->masklen);
290 }
291
292 # Insert the entry in the routed table
293 $sth = $dbh->prepare("insert into routed values ('$cidr',".
294 $cidr->masklen.",'$city')");
295 $sth->execute;
296 # Insert the (almost) same entry in the freeblocks table
297 $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".
298 $cidr->masklen.",'$city','y')");
299 $sth->execute;
300
301 } else { # done with alloctype == rr
302
303 # Insert the new freeblocks entries
304 $sth = $dbh->prepare("insert into freeblocks values (?, ?, ".
305 "(select city from routed where cidr >>= '$cidr'),'y')");
306 foreach my $block (@newfreeblocks) {
307 $sth->execute("$block", $block->masklen);
308 }
309
310 # Insert the allocations entry
311 $sth = $dbh->prepare("insert into allocations values ('$cidr',".
312 "'$custid','$type','$city','$desc','$notes',".$cidr->masklen.
313 ",'$circid')");
314 $sth->execute;
315
316 # And initialize the pool, if necessary
317 if ($type =~ /^.p$/) {
318 $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
319 initPool($dbh,$cidr,$type,$city,($type eq 'dp' ? "all" : "normal"));
320 }
321
322 } # done with netblock alloctype != rr
323
324 $dbh->commit;
325 }; # end eval
326 if ($@) {
327 eval { $dbh->rollback; };
328 return ('FAIL',$msg);
329 } else {
330 return ('OK',"OK");
331 }
332
333 } # end fullcidr != alloc_from
334
335 } # end static-IP vs netblock allocation
336
337} # end allocateBlock()
338
339
340## IPDB::initPool()
341# Initializes a pool
342# Requires a database handle, the pool CIDR, type, city, and a parameter
343# indicating whether the pool should allow allocation of literally every
344# IP, or if it should reserve network/gateway/broadcast IPs
345# Note that this is NOT done in a transaction, that's why it's a private
346# function and should ONLY EVER get called from allocateBlock()
347sub initPool {
348 my ($dbh,undef,$type,$city,$class) = @_;
349 my $pool = new NetAddr::IP $_[1];
350
351 my ($pooltype) = ($type =~ /^(.)p$/);
352 my $sth;
353
354 # have to insert all pool IPs into poolips table as "unallocated".
355 $sth = $dbh->prepare("insert into poolips values ('$pool',".
356 " ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
357 my @poolip_list = $pool->hostenum;
358 if ($class eq 'all') { # (DSL-ish block - *all* IPs available
359 $sth->execute($pool->addr);
360 for (my $i=0; $i<=$#poolip_list; $i++) {
361 $sth->execute($poolip_list[$i]->addr);
362 }
363 $pool--;
364 $sth->execute($pool->addr);
365 } else { # (real netblock)
366 for (my $i=1; $i<=$#poolip_list; $i++) {
367 $sth->execute($poolip_list[$i]->addr);
368 }
369 }
370} # end initPool()
371
372
373## IPDB::deleteBlock()
374# Removes an allocation from the database, including deleting IPs
375# from poolips and recombining entries in freeblocks if possible
376# Also handles "deleting" a static IP allocation, and removal of a master
377# Requires a database handle, the block to delete, and the type of block
378sub deleteBlock {
379 my ($dbh,undef,$type) = @_;
380 my $cidr = new NetAddr::IP $_[1];
381
382 my $sth;
383
384 # To contain the error message, if any.
385 my $msg = "Unknown error deallocating $type $cidr";
386 # Enable transactions and exception-on-errors... but only for this sub
387 local $dbh->{AutoCommit} = 0;
388 local $dbh->{RaiseError} = 1;
389
390 # First case. The "block" is a static IP
391 # Note that we still need some additional code in the odd case
392 # of a netblock-aligned contiguous group of static IPs
393 if ($type =~ /^.i$/) {
394
395 eval {
396 $msg = "Unable to deallocate $type $cidr";
397 $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
398 "city=(select city from allocations ".
399 "where cidr=(select pool from poolips where ip='$cidr')),".
400 "description='',notes='',circuitid='' where ip='$cidr'");
401 $sth->execute;
402 $dbh->commit;
403 };
404 if ($@) {
405 eval { $dbh->rollback; };
406 return ('FAIL',$msg);
407 } else {
408 return ('OK',"OK");
409 }
410
411 } elsif ($type eq 'mm') { # end alloctype =~ /.i/
412
413 $msg = "Unable to delete master block $cidr";
414 eval {
415 $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
416 $sth->execute;
417 $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
418 $sth->execute;
419 $dbh->commit;
420 };
421 if ($@) {
422 eval { $dbh->rollback; };
423 return ('FAIL', $msg);
424 } else {
425 return ('OK',"OK");
426 }
427
428 } else { # end alloctype master block case
429
430 ## This is a big block; but it HAS to be done in a chunk. Any removal
431 ## of a netblock allocation may result in a larger chunk of free
432 ## contiguous IP space - which may in turn be combined into a single
433 ## netblock rather than a number of smaller netblocks.
434
435 eval {
436
437 if ($type eq 'rr') {
438 $msg = "Unable to remove routing allocation $cidr";
439 $sth = $dbh->prepare("delete from routed where cidr='$cidr'");
440 $sth->execute;
441 # Make sure block getting deleted is properly accounted for.
442 $sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
443 " where cidr='$cidr'");
444 $sth->execute;
445 # Set up query to start compacting free blocks.
446 $sth = $dbh->prepare("select * from freeblocks where ".
447 "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
448
449 } else { # end alloctype routing case
450
451 $sth = $dbh->prepare("delete from allocations where cidr='$cidr'");
452 $sth->execute;
453 # Special case - delete pool IPs
454 if ($type =~ /^.p$/) {
455 # We have to delete the IPs from the pool listing.
456 $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
457 $sth->execute;
458 }
459
460 # Set up query for compacting free blocks.
461 $sth = $dbh->prepare("select * from freeblocks where cidr << ".
462 "(select cidr from routed where cidr >> '$cidr') ".
463 " and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
464
465 } # end alloctype general case
466
467 # Now we look for larger-or-equal-sized free blocks in the same master (routed)
468 # (super)block. If there aren't any, we can't combine blocks anyway. If there
469 # are, we check to see if we can combine blocks.
470 # Execute the statement prepared in the if-else above.
471
472 $sth->execute;
473
474# NetAddr::IP->compact() attempts to produce the smallest inclusive block
475# from the caller and the passed terms.
476# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
477# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
478# .64-.95, and .96-.128), you will get an array containing a single
479# /25 as element 0 (.0-.127). Order is not important; you could have
480# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
481
482 my (@together, @combinelist);
483 my $i=0;
484 while (my @data = $sth->fetchrow_array) {
485 my $testIP = new NetAddr::IP $data[0];
486 @together = $testIP->compact($cidr);
487 my $num = @together;
488 if ($num == 1) {
489 $cidr = $together[0];
490 $combinelist[$i++] = $testIP;
491 }
492 }
493
494 # Clear old freeblocks entries - if any. $i==0 if not.
495 if ($i>0) {
496 $sth = $dbh->prepare("delete from freeblocks where cidr=?");
497 foreach my $block (@combinelist) {
498 $sth->execute("$block");
499 }
500 }
501
502 # insert "new" freeblocks entry
503 if ($type eq 'rr') {
504 $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
505 ",'<NULL>','n')");
506 } else {
507 $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
508 ",(select city from routed where cidr >>= '$cidr'),'y')");
509 }
510 $sth->execute;
511
512 # If we got here, we've succeeded. Whew!
513 $dbh->commit;
514 }; # end eval
515 if ($@) {
516 eval { $dbh->rollback; };
517 return ('FAIL', $msg);
518 } else {
519 return ('OK',"OK");
520 }
521
522 } # end alloctype != netblock
523
524} # end deleteBlock()
525
526
527## IPDB::mailNotify()
528# Sends notification mail to recipients regarding an IPDB operation
529sub mailNotify ($$$) {
530 my ($recip,$subj,$message) = @_;
531 my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
532
533 $mailer->mail('ipdb@example.com');
534 $mailer->to($recip);
535 $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
536 "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
537 "Subject: {IPDB} $subj\n",
538 "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
539 "Organization: Example Corp\n",
540 "\n$message\n");
541 $mailer->quit;
542}
543
544# Indicates module loaded OK. Required by Perl.
5451;
Note: See TracBrowser for help on using the repository browser.