Index: trunk/cgi-bin/IPDB.pm =================================================================== --- trunk/cgi-bin/IPDB.pm (revision 557) +++ trunk/cgi-bin/IPDB.pm (revision 558) @@ -1002,8 +1002,20 @@ # 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 +# Requires a database handle, the block to delete, the routing depth (if applicable), +# and the VRF ID sub deleteBlock { - my ($dbh,undef,$type) = @_; + my ($dbh,undef,$rdepth,$vrf) = @_; my $cidr = new NetAddr::IP $_[1]; + +# For possible auto-VRF-ignoring (since public IPs shouldn't usually be present in more than one VRF) +# is_rfc1918 requires NetAddr::IP >= 4.059 +# rather than doing this over and over and over..... + my $tmpnum = $cidr->numeric; +# 192.168.0.0/16 -> 192.168.255.255 => 3232235520 -> 3232301055 +# 172.16.0.0/12 -> 172.31.255.255 => 2886729728 -> 2887778303 +# 10.0.0.0/8 -> 10.255.255.255 => 167772160 -> 184549375 + my $isprivnet = (3232235520 <= $tmpnum && $tmpnum <= 3232301055) || + (2886729728 <= $tmpnum && $tmpnum <= 2887778303) || + (167772160 <= $tmpnum && $tmpnum <= 184549375); my $sth; @@ -1013,6 +1025,14 @@ my $con_type; + # Collect info about the block we're going to delete + my $binfo = getBlockData($dbh, $cidr, $rdepth, $vrf); + + # temporarily forced null, until a sane UI for VRF tracking can be found. + $vrf = '';# if !$vrf; # as with SQL, the null value is not equal to ''. *sigh* + # To contain the error message, if any. - my $msg = "Unknown error deallocating $type $cidr"; + my $msg = "Unknown error deallocating $binfo->{type} $cidr"; + my $goback; # to put the parent in so we can link back where the deallocate started + # Enable transactions and exception-on-errors... but only for this sub local $dbh->{AutoCommit} = 0; @@ -1022,16 +1042,18 @@ # Note that we still need some additional code in the odd case # of a netblock-aligned contiguous group of static IPs - if ($type =~ /^.i$/) { + if ($binfo->{type} =~ /^.i$/) { eval { - $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr"; - $sth = $dbh->prepare("update poolips set custid=?,available='y',". - "city=(select city from allocations where cidr >>= ?". - " order by masklen(cidr) desc limit 1),". - "description='',notes='',circuitid='' where ip=?"); - $sth->execute($defcustid, "$cidr", "$cidr"); + $msg = "Unable to deallocate $disp_alloctypes{$binfo->{type}} $cidr"; + my ($pool,$pcust,$pvrf) = $dbh->selectrow_array("SELECT pool,custid,vrf FROM poolips WHERE ip=?", undef, ($cidr) ); +##fixme: VRF and rdepth + $dbh->do("UPDATE poolips SET custid=?,available='y',". + "city=(SELECT city FROM allocations WHERE cidr=?),". + "description='',notes='',circuitid='',vrf=? WHERE ip=?", undef, ($pcust, $pool, $pvrf, $cidr) ); + $goback = $pool; $dbh->commit; }; if ($@) { + $msg .= ": $@"; eval { $dbh->rollback; }; return ('FAIL',$msg); @@ -1040,15 +1062,16 @@ } - } elsif ($type eq 'mm') { # end alloctype =~ /.i/ - + } elsif ($binfo->{type} eq 'mm') { # end alloctype =~ /.i/ + +##fixme: VRF limit $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->do("DELETE FROM masterblocks WHERE cidr = ?", undef, ($cidr) ); + $dbh->do("DELETE FROM allocations WHERE cidr <<= ?", undef, ($cidr) ); + $dbh->do("DELETE FROM freeblocks WHERE cidr <<= ?", undef, ($cidr) ); $dbh->commit; }; if ($@) { + $msg .= ": $@"; eval { $dbh->rollback; }; return ('FAIL', $msg); @@ -1064,74 +1087,104 @@ ## netblock rather than a number of smaller netblocks. + my $retcode = 'OK'; + 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 - - # Magic. We need to get information about the containing block (if any) - # so as to make sure that the freeblocks we insert get the correct "type". - $sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'"); - $sth->execute; - ($container, $con_type) = $sth->fetchrow_array; - - # 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. - if ($con_type && $con_type eq 'pc') { - # Clean up after "bad" allocations (blocks that are not formally - # contained which have nevertheless been allocated from a container block) - # We want to make certain that the freeblocks are properly "labelled" - $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container' order by maskbits desc"); - } else { - # Standard deallocation. - $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 - - ## Deallocate legacy blocks stashed in the middle of a static IP pool - ## This may be expandable to an even more general case of contained netblock, or other pool types. - - # Find out if the block we're deallocating is within a DSL pool - my $sth2 = $dbh->prepare("SELECT cidr,city,type FROM allocations WHERE type LIKE '_p' AND cidr >>= ?"); - $sth2->execute("$cidr"); - my ($pool,$poolcity,$pooltype) = $sth2->fetchrow_array; - - if ($pool || $sth2->rows) { +##fixme: add recursive flag to allow "YES DAMMIT DELETE ALL EVARYTHING!!1!!" without +# explicitly deleting any suballocations of the block to be deleted. + + # find the current parent of the block we're deleting + my ($parent) = $dbh->selectrow_array("SELECT parent FROM allocations WHERE cidr=? AND rdepth=?", + undef, ($cidr, $rdepth) ); + + # Delete the block + $dbh->do("DELETE FROM allocations WHERE cidr=? AND rdepth=?", undef, ($cidr, $rdepth) ); + +##fixme: we could maybe eliminate a special case if we put masterblocks in the allocations table...? + my ($ptype,$pcity); + if ($rdepth == 1) { + # parent is a master block. + $ptype = 'mm'; + $pcity = ''; + } else { + # get that parent's details + ($ptype,$pcity) = $dbh->selectrow_array("SELECT type,city FROM allocations ". + "WHERE cidr=? AND rdepth=?", undef, ($parent, $rdepth-1) ); + } + + # munge the parent type a little + $ptype = (split //, $ptype)[0]; + +##fixme: you can't... CAN NOT.... assign the same public IP to multiple things. +# 'Net don't work like that, homey. Restrict VRF-uniqueness to private IPs? +# -> $isprivnet flag from start of sub + + # if the block to be deleted is a container, move its freeblock(s) up a level, and reset their parenting info + if ($binfo->{type} =~ /^.[mc]/) { + # move the freeblocks into the parent + # we don't insert a new freeblock because there could be a live reparented sub. + $dbh->do("UPDATE freeblocks SET rdepth=rdepth-1,parent=?,routed=?,city=? ". + "WHERE parent=? AND rdepth=?", undef, + ($parent, $ptype, $pcity, $cidr, $rdepth+1) ); + } else { + # ... otherwise, add the freeblock + $dbh->do("INSERT INTO freeblocks (cidr, city, routed, parent, rdepth) VALUES (?,?,?,?,?)", undef, + ($cidr, $pcity, $ptype, $parent, $rdepth) ); + } + + my $fbrdepth = $rdepth; + + # check to see if any container allocations could be the "true" parent + my ($tparent,$trdepth,$trtype,$tcity) = $dbh->selectrow_array("SELECT cidr,rdepth,type,city FROM allocations ". + "WHERE (type='rm' OR type LIKE '_c') AND cidr >> ? ". + "ORDER BY masklen(cidr) DESC", undef, ($cidr) ); + + my $fparent; + if ($tparent && $tparent ne $parent) { + # found an alternate parent; reset some parent-info bits + $parent = $tparent; + $ptype = (split //, $trtype)[0]; + $pcity = $tcity; + ##fixme: hmm. collect $rdepth into $goback here before vanishing? + $retcode = 'WARN'; # may be redundant + $goback = $tparent; + # munge freeblock rdepth and parent to match true parent + $dbh->do("UPDATE freeblocks SET rdepth = ?, parent = ?, routed = ? WHERE cidr <<= ? AND rdepth = ?", undef, + ($trdepth+1, $parent, $ptype, $cidr, $rdepth) ); + $rdepth = $trdepth; + $fbrdepth = $trdepth+1; + } + + $parent = new NetAddr::IP $parent; + $goback = "$parent,$fbrdepth"; # breadcrumb in case of live-parent-is-not-true-parent + + # Special case - delete pool IPs + if ($binfo->{type} =~ /^.[pd]$/) { + # We have to delete the IPs from the pool listing. +##fixme: rdepth? vrf? + $dbh->do("DELETE FROM poolips WHERE pool = ?", undef, ($cidr) ); + } + + # Find out if the block we're deallocating is within a DSL pool (legacy goo) + my ($pool,$poolcity,$pooltype,$pooldepth) = $dbh->selectrow_array( + "SELECT cidr,city,type,rdepth FROM allocations WHERE type LIKE '_p' AND cidr >>= ?", + undef, ($cidr) ); + + # If so, return the block's IPs to the pool, instead of to freeblocks +## NB: not possible to currently cause this even via admin tools, only legacy data. + if ($pool) { + ## Deallocate legacy blocks stashed in the middle of a static IP pool + ## This may be expandable to an even more general case of contained netblock, or other pool types. + $retcode = 'WARNPOOL'; + $goback = "$pool,$pooldepth"; # We've already deleted the block, now we have to stuff its IPs into the pool. $pooltype =~ s/p$/i/; # change type to static IP - $sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) values ". + my $sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) VALUES ". "('$pool',?,'$poolcity','$pooltype','$defcustid')"); + # don't insert .0 ##fixme: need to not insert net, gateway, and bcast on "real netblock" pools (DHCPish) - # don't insert .0 $sth2->execute($cidr->addr) unless $cidr->addr =~ m|\.0$|; foreach my $ip ($cidr->hostenum) { - $sth2->execute("$ip"); + $sth2->execute($ip); } $cidr--; @@ -1140,10 +1193,14 @@ } else { # done returning IPs from a block to a static DSL pool - # 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; + # If the block wasn't legacy goo embedded in a static pool, we check the + # freeblocks in the identified parent to see if we can combine any of them. + +##fixme: vrf + # set up the query to get the list of blocks to try to merge. + $sth = $dbh->prepare("SELECT cidr FROM freeblocks ". + "WHERE parent = ? AND routed = ? AND rdepth = ? ". + "ORDER BY masklen(cidr) DESC"); + + $sth->execute($parent, $ptype, $fbrdepth); # NetAddr::IP->compact() attempts to produce the smallest inclusive block @@ -1155,36 +1212,28 @@ # $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27. - my (@together, @combinelist); + my (@rawfb, @combinelist); my $i=0; + # for each free block under $parent, push a NetAddr::IP object into one list, and + # continuously use NetAddr::IP->compact to automagically merge netblocks as possible. 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; - } + push @rawfb, $testIP; + @combinelist = $testIP->compact(@combinelist); } - # 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 { - # Magic hackery to insert "correct" data for deallocation of - # non-contained blocks allocated from within a container. - $type = 'pr' if $con_type && $con_type eq 'pc'; - - $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')."')"); + # now that we have the full list of "compacted" freeblocks, go back over + # the list of raw freeblocks, and delete the ones that got merged. + $sth = $dbh->prepare("DELETE FROM freeblocks WHERE cidr=? AND parent=? AND rdepth=?"); + foreach my $rawfree (@rawfb) { + next if grep { $rawfree == $_ } @combinelist; # skip if the raw block is in the compacted list + $sth->execute($rawfree, $parent, $fbrdepth); } - $sth->execute; + + # now we walk the new list of compacted blocks, and see which ones we need to insert + $sth = $dbh->prepare("INSERT INTO freeblocks (cidr,city,routed,parent,rdepth) VALUES (?,?,?,?,?)"); + foreach my $cme (@combinelist) { + next if grep { $cme == $_ } @rawfb; # skip if the combined block was in the raw list + $sth->execute($cme, $pcity, $ptype, $parent, $fbrdepth); + } } # done returning IPs to the appropriate place @@ -1194,9 +1243,9 @@ }; # end eval if ($@) { - $msg = $@; + $msg .= ": $@"; eval { $dbh->rollback; }; return ('FAIL', $msg); } else { - return ('OK',"OK"); + return ($retcode, $goback); }