# ipdb/cgi-bin/IPDB.pm # Contains functions for IPDB - database access, subnet mangling, block allocation, etc ### # SVN revision info # $Date: 2005-09-28 13:49:58 +0000 (Wed, 28 Sep 2005) $ # SVN revision $Rev: 287 $ # Last update by $Author: kdeugau $ ### # Copyright (C) 2004,2005 - Kris Deugau package IPDB; use strict; use warnings; use Exporter; use DBI; use Net::SMTP; use POSIX; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 2.0; @ISA = qw(Exporter); @EXPORT_OK = qw( %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks %allocated %free %routed %bigfree %IPDBacl &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock &mailNotify ); @EXPORT = (); # Export nothing by default. %EXPORT_TAGS = ( ALL => [qw( %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks %allocated %free %routed %bigfree %IPDBacl &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock &mailNotify )] ); ## ## Global variables ## our %disp_alloctypes; our %list_alloctypes; our %def_custids; our @citylist; our @poplist; our @masterblocks; our %allocated; our %free; our %routed; our %bigfree; our %IPDBacl; # Let's initialize the globals. ## IPDB::initIPDBGlobals() # Initialize all globals. Takes a database handle, returns a success or error code sub initIPDBGlobals { my $dbh = $_[0]; my $sth; # Initialize alloctypes hashes $sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder"); $sth->execute; while (my @data = $sth->fetchrow_array) { $disp_alloctypes{$data[0]} = $data[2]; $def_custids{$data[0]} = $data[4]; if ($data[3] < 900) { $list_alloctypes{$data[0]} = $data[1]; } } # City and POP listings $sth = $dbh->prepare("select city,routing from cities order by city"); $sth->execute; return (undef,$sth->errstr) if $sth->err; while (my @data = $sth->fetchrow_array) { push @citylist, $data[0]; if ($data[1] eq 'y') { push @poplist, $data[0]; } } # Master block list $sth = $dbh->prepare("select cidr from masterblocks order by cidr"); $sth->execute; return (undef,$sth->errstr) if $sth->err; for (my $i=0; my @data = $sth->fetchrow_array(); $i++) { $masterblocks[$i] = new NetAddr::IP $data[0]; $allocated{"$masterblocks[$i]"} = 0; $free{"$masterblocks[$i]"} = 0; $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block. # Set to 128 to prepare for IPv6 $routed{"$masterblocks[$i]"} = 0; } # Load ACL data. Specific username checks are done at a different level. $sth = $dbh->prepare("select username,acl from users"); $sth->execute; return (undef,$sth->errstr) if $sth->err; while (my @data = $sth->fetchrow_array) { $IPDBacl{$data[0]} = $data[1]; } return (1,"OK"); } # end initIPDBGlobals ## IPDB::connectDB() # Creates connection to IPDB. # Requires the database name, username, and password. # Returns a handle to the db. # Set up for a PostgreSQL db; could be any transactional DBMS with the # right changes. # This definition should be sub connectDB($$$) to be technically correct, # but this breaks. GRR. sub connectDB { my ($dbname,$user,$pass) = @_; my $dbh; my $DSN = "DBI:Pg:dbname=$dbname"; # my $user = 'ipdb'; # my $pw = 'ipdbpwd'; # Note that we want to autocommit by default, and we will turn it off locally as necessary. # We may not want to print gobbledygook errors; YMMV. Have to ponder that further. $dbh = DBI->connect($DSN, $user, $pass, { AutoCommit => 1, PrintError => 0 }) or return (undef, $DBI::errstr) if(!$dbh); # Return here if we can't select. Note that this indicates a # problem executing the select. my $sth = $dbh->prepare("select type from alloctypes"); $sth->execute(); return (undef,$DBI::errstr) if ($sth->err); # See if the select returned anything (or null data). This should # succeed if the select executed, but... $sth->fetchrow(); return (undef,$DBI::errstr) if ($sth->err); # If we get here, we should be OK. return ($dbh,"DB connection OK"); } # end connectDB ## IPDB::finish() # Cleans up after database handles and so on. # Requires a database handle sub finish { my $dbh = $_[0]; $dbh->disconnect; } # end finish ## IPDB::checkDBSanity() # Quick check to see if the db is responding. A full integrity # check will have to be a separate tool to walk the IP allocation trees. sub checkDBSanity { my ($dbh) = $_[0]; if (!$dbh) { print "No database handle, or connection has been closed."; return -1; } else { # it connects, try a stmt. my $sth = $dbh->prepare("select type from alloctypes"); my $err = $sth->execute(); if ($sth->fetchrow()) { # all is well. return 1; } else { print "Connected to the database, but could not execute test statement. ".$sth->errstr(); return -1; } } # Clean up after ourselves. # $dbh->disconnect; } # end checkDBSanity ## IPDB::allocateBlock() # Does all of the magic of actually allocating a netblock # Requires database handle, block to allocate, custid, type, city, # description, notes, circuit ID, block to allocate from, private data # Returns a success code and optional error message. sub allocateBlock { my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata) = @_; my $cidr = new NetAddr::IP $_[1]; my $alloc_from = new NetAddr::IP $_[2]; my $sth; # To contain the error message, if any. my $msg = "Unknown error allocating $cidr as '$type'"; # Enable transactions and error handling local $dbh->{AutoCommit} = 0; # These need to be local so we don't local $dbh->{RaiseError} = 1; # step on our toes by accident. if ($type =~ /^.i$/) { $msg = "Unable to assign static IP $cidr to $custid"; eval { # We have to do this in two parts because otherwise we lose # the ability to return the IP assigned. Should that change, # the commented SQL statement below may become usable. # update poolips set custid='$custid',city='$city',available='n', # description='$desc',notes='$notes',circuitid='$circid' # where ip=(select ip from poolips where pool='$alloc_from' # and available='y' order by ip limit 1); $sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'". " and available='y' order by ip"); $sth->execute; my @data = $sth->fetchrow_array; $cidr = $data[0]; # $cidr is already declared when we get here! $sth = $dbh->prepare("update poolips set custid='$custid',". "city='$city',available='n',description='$desc',notes='$notes',". "circuitid='$circid',privdata='$privdata'". " where ip='$cidr'"); $sth->execute; $dbh->commit; }; if ($@) { $msg .= ": '".$sth->errstr."'"; eval { $dbh->rollback; }; return ('FAIL',$msg); } else { return ('OK',"$cidr"); } } else { # end IP-from-pool allocation if ($cidr == $alloc_from) { # Easiest case- insert in one table, delete in the other, and go home. More or less. # insert into allocations values (cidr,custid,type,city,desc) and # delete from freeblocks where cidr='cidr' # For data safety on non-transaction DBs, we delete first. eval { $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'"; if ($type eq 'rm') { $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'". " where cidr='$cidr'"); $sth->execute; $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)". " values ('$cidr',".$cidr->masklen.",'$city')"); $sth->execute; } else { # common stuff for end-use, dialup, dynDSL, pools, etc, etc. # special case - block is a container/"reserve" block if ($type =~ /^(.)c$/) { $sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'"); $sth->execute; } else { # "normal" case $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'"); $sth->execute; } $sth = $dbh->prepare("insert into allocations". " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)". " values ('$cidr','$custid','$type','$city','$desc','$notes',". $cidr->masklen.",'$circid','$privdata')"); $sth->execute; # And initialize the pool, if necessary # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed. if ($type =~ /^.p$/) { $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr"; my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all"); die $rmsg if $code eq 'FAIL'; } elsif ($type =~ /^.d$/) { $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr"; my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal"); die $rmsg if $code eq 'FAIL'; } } # routing vs non-routing netblock $dbh->commit; }; # end of eval if ($@) { $msg .= ": ".$@; eval { $dbh->rollback; }; return ('FAIL',$msg); } else { return ('OK',"OK"); } } else { # cidr != alloc_from # Hard case. Allocation is smaller than free block. my $wantmaskbits = $cidr->masklen; my $maskbits = $alloc_from->masklen; my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock. # This determines which blocks will be left "free" after allocation. We take the # block we're allocating from, and split it in half. We see which half the wanted # block is in, and repeat until the wanted block is equal to one of the halves. my $i=0; my $tmp_from = $alloc_from; # So we don't munge $alloc_from while ($maskbits++ < $wantmaskbits) { my @subblocks = $tmp_from->split($maskbits); $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]); $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] ); } # while # Begin SQL transaction block eval { $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'"; # Delete old freeblocks entry $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'"); $sth->execute(); # now we have to do some magic for routing blocks if ($type eq 'rm') { # Insert the new freeblocks entries # Note that non-routed blocks are assigned to # and use the default value for the routed column ('n') $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)". " values (?, ?, '')"); foreach my $block (@newfreeblocks) { $sth->execute("$block", $block->masklen); } # Insert the entry in the routed table $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)". " values ('$cidr',".$cidr->masklen.",'$city')"); $sth->execute; # Insert the (almost) same entry in the freeblocks table $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)". " values ('$cidr',".$cidr->masklen.",'$city','y')"); $sth->execute; } else { # done with alloctype == rm # Insert the new freeblocks entries # Along with some more HairyPerl(TM) in case we're inserting a # subblock (.r) allocation $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)". " values (?, ?, (select city from routed where cidr >>= '$cidr'),'". (($type =~ /^(.)r$/) ? "$1" : 'y')."')"); foreach my $block (@newfreeblocks) { $sth->execute("$block", $block->masklen); } # Special-case for reserve/"container" blocks - generate # the "extra" freeblocks entry for the container if ($type =~ /^(.)c$/) { $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)". " values ('$cidr',".$cidr->masklen.",'$city','$1')"); $sth->execute; } # Insert the allocations entry $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,". "description,notes,maskbits,circuitid,privdata)". " values ('$cidr','$custid','$type','$city','$desc','$notes',". $cidr->masklen.",'$circid','$privdata')"); $sth->execute; # And initialize the pool, if necessary # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed. if ($type =~ /^.p$/) { $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr"; my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all"); die $rmsg if $code eq 'FAIL'; } elsif ($type =~ /^.d$/) { $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr"; my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal"); die $rmsg if $code eq 'FAIL'; } } # done with netblock alloctype != rm $dbh->commit; }; # end eval if ($@) { $msg .= ": ".$@; eval { $dbh->rollback; }; return ('FAIL',$msg); } else { return ('OK',"OK"); } } # end fullcidr != alloc_from } # end static-IP vs netblock allocation } # end allocateBlock() ## IPDB::initPool() # Initializes a pool # Requires a database handle, the pool CIDR, type, city, and a parameter # indicating whether the pool should allow allocation of literally every # IP, or if it should reserve network/gateway/broadcast IPs # Note that this is NOT done in a transaction, that's why it's a private # function and should ONLY EVER get called from allocateBlock() sub initPool { my ($dbh,undef,$type,$city,$class) = @_; my $pool = new NetAddr::IP $_[1]; ##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type $type =~ s/[pd]$/i/; my $sth; my $msg; # Trap errors so we can pass them back to the caller. Even if the # caller is only ever supposed to be local, and therefore already # trapping errors. >:( local $dbh->{AutoCommit} = 0; # These need to be local so we don't local $dbh->{RaiseError} = 1; # step on our toes by accident. eval { # have to insert all pool IPs into poolips table as "unallocated". $sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)". " values ('$pool', ?, '6750400', '$city', '$type')"); my @poolip_list = $pool->hostenum; if ($class eq 'all') { # (DSL-ish block - *all* IPs available if ($pool->addr !~ /\.0$/) { # .0 causes weirdness. $sth->execute($pool->addr); } for (my $i=0; $i<=$#poolip_list; $i++) { $sth->execute($poolip_list[$i]->addr); } $pool--; if ($pool->addr !~ /\.255$/) { # .255 can cause weirdness. $sth->execute($pool->addr); } } else { # (real netblock) for (my $i=1; $i<=$#poolip_list; $i++) { $sth->execute($poolip_list[$i]->addr); } } }; if ($@) { $msg = "'".$sth->errstr."'"; eval { $dbh->rollback; }; return ('FAIL',$msg); } else { return ('OK',"OK"); } } # end initPool() ## IPDB::deleteBlock() # Removes an allocation from the database, including deleting IPs # from poolips and recombining entries in freeblocks if possible # Also handles "deleting" a static IP allocation, and removal of a master # Requires a database handle, the block to delete, and the type of block sub deleteBlock { my ($dbh,undef,$type) = @_; my $cidr = new NetAddr::IP $_[1]; my $sth; # To contain the error message, if any. my $msg = "Unknown error deallocating $type $cidr"; # Enable transactions and exception-on-errors... but only for this sub local $dbh->{AutoCommit} = 0; local $dbh->{RaiseError} = 1; # First case. The "block" is a static IP # Note that we still need some additional code in the odd case # of a netblock-aligned contiguous group of static IPs if ($type =~ /^.i$/) { eval { $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr"; $sth = $dbh->prepare("update poolips set custid='6750400',available='y',". "city=(select city from allocations where cidr >>= '$cidr'),". "description='',notes='',circuitid='' where ip='$cidr'"); $sth->execute; $dbh->commit; }; if ($@) { eval { $dbh->rollback; }; return ('FAIL',$msg); } else { return ('OK',"OK"); } } elsif ($type eq 'mm') { # end alloctype =~ /.i/ $msg = "Unable to delete master block $cidr"; eval { $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'"); $sth->execute; $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'"); $sth->execute; $dbh->commit; }; if ($@) { eval { $dbh->rollback; }; return ('FAIL', $msg); } else { return ('OK',"OK"); } } else { # end alloctype master block case ## This is a big block; but it HAS to be done in a chunk. Any removal ## of a netblock allocation may result in a larger chunk of free ## contiguous IP space - which may in turn be combined into a single ## netblock rather than a number of smaller netblocks. eval { if ($type eq 'rm') { $msg = "Unable to remove routing allocation $cidr"; $sth = $dbh->prepare("delete from routed where cidr='$cidr'"); $sth->execute; # Make sure block getting deleted is properly accounted for. $sth = $dbh->prepare("update freeblocks set routed='n',city=''". " where cidr='$cidr'"); $sth->execute; # Set up query to start compacting free blocks. $sth = $dbh->prepare("select cidr from freeblocks where ". "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc"); } else { # end alloctype routing case # Delete all allocations within the block being deleted. This is # deliberate and correct, and removes the need to special-case # removal of "container" blocks. $sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'"); $sth->execute; # Special case - delete pool IPs if ($type =~ /^.[pd]$/) { # We have to delete the IPs from the pool listing. $sth = $dbh->prepare("delete from poolips where pool='$cidr'"); $sth->execute; } # Set up query for compacting free blocks. $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ". "(select cidr from routed where cidr >>= '$cidr') ". " and maskbits<=".$cidr->masklen. " and routed='".(($type =~ /^(.)r$/) ? '$1' : 'y'). "' order by maskbits desc"); } # end alloctype general case ##TEMP ## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24 ## Note that we should really general-case this. my $staticpool = new NetAddr::IP "209.91.185.0/24"; ##TEMP if ($cidr->within($staticpool)) { ##TEMP # We've already deleted the block, now we have to stuff its IPs into the pool. $sth = $dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','Sudbury','di','y','','','')"); $sth->execute($cidr->addr); foreach my $ip ($cidr->hostenum) { $sth->execute("$ip"); } $cidr--; $sth->execute($cidr->addr); ##TEMP } else { ##TEMP # Now we look for larger-or-equal-sized free blocks in the same master (routed) # (super)block. If there aren't any, we can't combine blocks anyway. If there # are, we check to see if we can combine blocks. # Execute the statement prepared in the if-else above. $sth->execute; # NetAddr::IP->compact() attempts to produce the smallest inclusive block # from the caller and the passed terms. # EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2, # and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63, # .64-.95, and .96-.128), you will get an array containing a single # /25 as element 0 (.0-.127). Order is not important; you could have # $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27. my (@together, @combinelist); my $i=0; while (my @data = $sth->fetchrow_array) { my $testIP = new NetAddr::IP $data[0]; @together = $testIP->compact($cidr); my $num = @together; if ($num == 1) { $cidr = $together[0]; $combinelist[$i++] = $testIP; } } # Clear old freeblocks entries - if any. They should all be within # the $cidr determined above. $sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'"); $sth->execute; # insert "new" freeblocks entry if ($type eq 'rm') { $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)". " values ('$cidr',".$cidr->masklen.",'')"); } else { $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)". " values ('$cidr',".$cidr->masklen. ",(select city from routed where cidr >>= '$cidr'),'". (($type =~ /^(.)r$/) ? "$1" : 'y')."')"); } $sth->execute; ##TEMP } ##TEMP # If we got here, we've succeeded. Whew! $dbh->commit; }; # end eval if ($@) { eval { $dbh->rollback; }; return ('FAIL', $msg); } else { return ('OK',"OK"); } } # end alloctype != netblock } # end deleteBlock() ## IPDB::mailNotify() # Sends notification mail to recipients regarding an IPDB operation sub mailNotify ($$$) { my ($recip,$subj,$message) = @_; my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com"); $mailer->mail('ipdb@example.com'); $mailer->to($recip); $mailer->data("From: \"IP Database\" \n", "To: $recip\n", "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n", "Subject: {IPDB} $subj\n", "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n", "Organization: Example Corp\n", "\n$message\n"); $mailer->quit; } # Indicates module loaded OK. Required by Perl. 1;