Changeset 558 for trunk/cgi-bin


Ignore:
Timestamp:
12/19/12 13:05:45 (12 years ago)
Author:
Kris Deugau
Message:

/trunk

Work in progress, see #5:
Update deleteBlock() to handle new table logic and fields

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/cgi-bin/IPDB.pm

    r557 r558  
    10021002# from poolips and recombining entries in freeblocks if possible
    10031003# Also handles "deleting" a static IP allocation, and removal of a master
    1004 # Requires a database handle, the block to delete, and the type of block
     1004# Requires a database handle, the block to delete, the routing depth (if applicable),
     1005# and the VRF ID
    10051006sub deleteBlock {
    1006   my ($dbh,undef,$type) = @_;
     1007  my ($dbh,undef,$rdepth,$vrf) = @_;
    10071008  my $cidr = new NetAddr::IP $_[1];
     1009
     1010# For possible auto-VRF-ignoring (since public IPs shouldn't usually be present in more than one VRF)
     1011# is_rfc1918 requires NetAddr::IP >= 4.059
     1012# rather than doing this over and over and over.....
     1013  my $tmpnum = $cidr->numeric;
     1014# 192.168.0.0/16 -> 192.168.255.255  =>  3232235520 -> 3232301055
     1015# 172.16.0.0/12  -> 172.31.255.255   =>  2886729728 -> 2887778303
     1016# 10.0.0.0/8     -> 10.255.255.255   =>  167772160  -> 184549375
     1017  my $isprivnet = (3232235520 <= $tmpnum && $tmpnum <= 3232301055) ||
     1018        (2886729728 <= $tmpnum && $tmpnum <= 2887778303) ||
     1019        (167772160 <= $tmpnum && $tmpnum <= 184549375);
    10081020
    10091021  my $sth;
    … …  
    10131025  my $con_type;
    10141026
     1027  # Collect info about the block we're going to delete
     1028  my $binfo = getBlockData($dbh, $cidr, $rdepth, $vrf);
     1029
     1030  # temporarily forced null, until a sane UI for VRF tracking can be found.
     1031  $vrf = '';# if !$vrf; # as with SQL, the null value is not equal to ''.  *sigh*
     1032
    10151033  # To contain the error message, if any.
    1016   my $msg = "Unknown error deallocating $type $cidr";
     1034  my $msg = "Unknown error deallocating $binfo->{type} $cidr";
     1035  my $goback;   # to put the parent in so we can link back where the deallocate started
     1036
    10171037  # Enable transactions and exception-on-errors... but only for this sub
    10181038  local $dbh->{AutoCommit} = 0;
    … …  
    10221042  # Note that we still need some additional code in the odd case
    10231043  # of a netblock-aligned contiguous group of static IPs
    1024   if ($type =~ /^.i$/) {
     1044  if ($binfo->{type} =~ /^.i$/) {
    10251045
    10261046    eval {
    1027       $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
    1028       $sth = $dbh->prepare("update poolips set custid=?,available='y',".
    1029         "city=(select city from allocations where cidr >>= ?".
    1030         " order by masklen(cidr) desc limit 1),".
    1031         "description='',notes='',circuitid='' where ip=?");
    1032       $sth->execute($defcustid, "$cidr", "$cidr");
     1047      $msg = "Unable to deallocate $disp_alloctypes{$binfo->{type}} $cidr";
     1048      my ($pool,$pcust,$pvrf) = $dbh->selectrow_array("SELECT pool,custid,vrf FROM poolips WHERE ip=?", undef, ($cidr) );
     1049##fixme: VRF and rdepth
     1050      $dbh->do("UPDATE poolips SET custid=?,available='y',".
     1051        "city=(SELECT city FROM allocations WHERE cidr=?),".
     1052        "description='',notes='',circuitid='',vrf=? WHERE ip=?", undef, ($pcust, $pool, $pvrf, $cidr) );
     1053      $goback = $pool;
    10331054      $dbh->commit;
    10341055    };
    10351056    if ($@) {
     1057      $msg .= ": $@";
    10361058      eval { $dbh->rollback; };
    10371059      return ('FAIL',$msg);
    … …  
    10401062    }
    10411063
    1042   } elsif ($type eq 'mm') { # end alloctype =~ /.i/
    1043 
     1064  } elsif ($binfo->{type} eq 'mm') { # end alloctype =~ /.i/
     1065
     1066##fixme: VRF limit
    10441067    $msg = "Unable to delete master block $cidr";
    10451068    eval {
    1046       $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
    1047       $sth->execute;
    1048       $sth = $dbh->prepare("delete from freeblocks where cidr <<= '$cidr'");
    1049       $sth->execute;
     1069      $dbh->do("DELETE FROM masterblocks WHERE cidr = ?", undef, ($cidr) );
     1070      $dbh->do("DELETE FROM allocations WHERE cidr <<= ?", undef, ($cidr) );
     1071      $dbh->do("DELETE FROM freeblocks WHERE cidr <<= ?", undef, ($cidr) );
    10501072      $dbh->commit;
    10511073    };
    10521074    if ($@) {
     1075      $msg .= ": $@";
    10531076      eval { $dbh->rollback; };
    10541077      return ('FAIL', $msg);
    … …  
    10641087    ## netblock rather than a number of smaller netblocks.
    10651088
     1089    my $retcode = 'OK';
     1090
    10661091    eval {
    10671092
    1068       if ($type eq 'rm') {
    1069         $msg = "Unable to remove routing allocation $cidr";
    1070         $sth = $dbh->prepare("delete from routed where cidr='$cidr'");
    1071         $sth->execute;
    1072         # Make sure block getting deleted is properly accounted for.
    1073         $sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
    1074                 " where cidr='$cidr'");
    1075         $sth->execute;
    1076         # Set up query to start compacting free blocks.
    1077         $sth = $dbh->prepare("select cidr from freeblocks where ".
    1078                 "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
    1079 
    1080       } else { # end alloctype routing case
    1081 
    1082         # Magic.  We need to get information about the containing block (if any)
    1083         # so as to make sure that the freeblocks we insert get the correct "type".
    1084         $sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'");
    1085         $sth->execute;
    1086         ($container, $con_type) = $sth->fetchrow_array;
    1087 
    1088         # Delete all allocations within the block being deleted.  This is
    1089         # deliberate and correct, and removes the need to special-case
    1090         # removal of "container" blocks.
    1091         $sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
    1092         $sth->execute;
    1093 
    1094         # Special case - delete pool IPs
    1095         if ($type =~ /^.[pd]$/) {
    1096           # We have to delete the IPs from the pool listing.
    1097           $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
    1098           $sth->execute;
    1099         }
    1100 
    1101         # Set up query for compacting free blocks.
    1102         if ($con_type && $con_type eq 'pc') {
    1103           # Clean up after "bad" allocations (blocks that are not formally
    1104           # contained which have nevertheless been allocated from a container block)
    1105           # We want to make certain that the freeblocks are properly "labelled"
    1106           $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container' order by maskbits desc");
    1107         } else {
    1108           # Standard deallocation.
    1109           $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
    1110                 "(select cidr from routed where cidr >>= '$cidr') ".
    1111                 " and maskbits<=".$cidr->masklen.
    1112                 " and routed='".(($type =~ /^(.)r$/) ? "$1" : 'y').
    1113                 "' order by maskbits desc");
    1114         }
    1115 
    1116       } # end alloctype general case
    1117 
    1118       ## Deallocate legacy blocks stashed in the middle of a static IP pool
    1119       ## This may be expandable to an even more general case of contained netblock, or other pool types.
    1120 
    1121       # Find out if the block we're deallocating is within a DSL pool
    1122       my $sth2 = $dbh->prepare("SELECT cidr,city,type FROM allocations WHERE type LIKE '_p' AND cidr >>= ?");
    1123       $sth2->execute("$cidr");
    1124       my ($pool,$poolcity,$pooltype) = $sth2->fetchrow_array;
    1125 
    1126       if ($pool || $sth2->rows) {
     1093##fixme:  add recursive flag to allow "YES DAMMIT DELETE ALL EVARYTHING!!1!!" without
     1094# explicitly deleting any suballocations of the block to be deleted.
     1095
     1096      # find the current parent of the block we're deleting
     1097      my ($parent) = $dbh->selectrow_array("SELECT parent FROM allocations WHERE cidr=? AND rdepth=?",
     1098        undef, ($cidr, $rdepth) );
     1099
     1100      # Delete the block
     1101      $dbh->do("DELETE FROM allocations WHERE cidr=? AND rdepth=?", undef, ($cidr, $rdepth) );
     1102
     1103##fixme:  we could maybe eliminate a special case if we put masterblocks in the allocations table...?
     1104      my ($ptype,$pcity);
     1105      if ($rdepth == 1) {
     1106        # parent is a master block.
     1107        $ptype = 'mm';
     1108        $pcity = '<NULL>';
     1109      } else {
     1110        # get that parent's details
     1111        ($ptype,$pcity) = $dbh->selectrow_array("SELECT type,city FROM allocations ".
     1112                "WHERE cidr=? AND rdepth=?", undef, ($parent, $rdepth-1) );
     1113      }
     1114
     1115      # munge the parent type a little
     1116      $ptype = (split //, $ptype)[0];
     1117
     1118##fixme:  you can't...  CAN NOT....  assign the same public IP to multiple things.
     1119#  'Net don't work like that, homey.  Restrict VRF-uniqueness to private IPs?
     1120# -> $isprivnet flag from start of sub
     1121
     1122      # if the block to be deleted is a container, move its freeblock(s) up a level, and reset their parenting info
     1123      if ($binfo->{type} =~ /^.[mc]/) {
     1124        # move the freeblocks into the parent
     1125        # we don't insert a new freeblock because there could be a live reparented sub.
     1126        $dbh->do("UPDATE freeblocks SET rdepth=rdepth-1,parent=?,routed=?,city=? ".
     1127                "WHERE parent=? AND rdepth=?", undef,
     1128                ($parent, $ptype, $pcity, $cidr, $rdepth+1) );
     1129      } else {
     1130        # ... otherwise, add the freeblock
     1131        $dbh->do("INSERT INTO freeblocks (cidr, city, routed, parent, rdepth) VALUES (?,?,?,?,?)", undef,
     1132                ($cidr, $pcity, $ptype, $parent, $rdepth) );
     1133      }
     1134
     1135      my $fbrdepth = $rdepth;
     1136
     1137      # check to see if any container allocations could be the "true" parent
     1138      my ($tparent,$trdepth,$trtype,$tcity) = $dbh->selectrow_array("SELECT cidr,rdepth,type,city FROM allocations ".
     1139        "WHERE (type='rm' OR type LIKE '_c') AND cidr >> ? ".
     1140        "ORDER BY masklen(cidr) DESC", undef, ($cidr) );
     1141
     1142      my $fparent;
     1143      if ($tparent && $tparent ne $parent) {
     1144        # found an alternate parent;  reset some parent-info bits
     1145        $parent = $tparent;
     1146        $ptype = (split //, $trtype)[0];
     1147        $pcity = $tcity;
     1148        ##fixme: hmm.  collect $rdepth into $goback here before vanishing?
     1149        $retcode = 'WARN';      # may be redundant
     1150        $goback = $tparent;
     1151        # munge freeblock rdepth and parent to match true parent
     1152        $dbh->do("UPDATE freeblocks SET rdepth = ?, parent = ?, routed = ? WHERE cidr <<= ? AND rdepth = ?", undef,
     1153                ($trdepth+1, $parent, $ptype, $cidr, $rdepth) );
     1154        $rdepth = $trdepth;
     1155        $fbrdepth = $trdepth+1;
     1156      }
     1157
     1158      $parent = new NetAddr::IP $parent;
     1159      $goback = "$parent,$fbrdepth";    # breadcrumb in case of live-parent-is-not-true-parent
     1160
     1161      # Special case - delete pool IPs
     1162      if ($binfo->{type} =~ /^.[pd]$/) {
     1163        # We have to delete the IPs from the pool listing.
     1164##fixme:  rdepth?  vrf?
     1165        $dbh->do("DELETE FROM poolips WHERE pool = ?", undef, ($cidr) );
     1166      }
     1167
     1168      # Find out if the block we're deallocating is within a DSL pool (legacy goo)
     1169      my ($pool,$poolcity,$pooltype,$pooldepth) = $dbh->selectrow_array(
     1170        "SELECT cidr,city,type,rdepth FROM allocations WHERE type LIKE '_p' AND cidr >>= ?",
     1171        undef, ($cidr) );
     1172
     1173      # If so, return the block's IPs to the pool, instead of to freeblocks
     1174## NB: not possible to currently cause this even via admin tools, only legacy data.
     1175      if ($pool) {
     1176        ## Deallocate legacy blocks stashed in the middle of a static IP pool
     1177        ## This may be expandable to an even more general case of contained netblock, or other pool types.
     1178        $retcode = 'WARNPOOL';
     1179        $goback = "$pool,$pooldepth";
    11271180        # We've already deleted the block, now we have to stuff its IPs into the pool.
    11281181        $pooltype =~ s/p$/i/;   # change type to static IP
    1129         $sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) values ".
     1182        my $sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) VALUES ".
    11301183                "('$pool',?,'$poolcity','$pooltype','$defcustid')");
     1184        # don't insert .0
    11311185##fixme:  need to not insert net, gateway, and bcast on "real netblock" pools (DHCPish)
    1132         # don't insert .0
    11331186        $sth2->execute($cidr->addr) unless $cidr->addr =~ m|\.0$|;
    11341187        foreach my $ip ($cidr->hostenum) {
    1135           $sth2->execute("$ip");
     1188          $sth2->execute($ip);
    11361189        }
    11371190        $cidr--;
    … …  
    11401193      } else {  # done returning IPs from a block to a static DSL pool
    11411194
    1142         # Now we look for larger-or-equal-sized free blocks in the same master (routed)
    1143         # (super)block. If there aren't any, we can't combine blocks anyway.  If there
    1144         # are, we check to see if we can combine blocks.
    1145         # Execute the statement prepared in the if-else above.
    1146 
    1147         $sth->execute;
     1195        # If the block wasn't legacy goo embedded in a static pool, we check the
     1196        # freeblocks in the identified parent to see if we can combine any of them.
     1197
     1198##fixme: vrf
     1199        # set up the query to get the list of blocks to try to merge.
     1200        $sth = $dbh->prepare("SELECT cidr FROM freeblocks ".
     1201                "WHERE parent = ? AND routed = ? AND rdepth = ? ".
     1202                "ORDER BY masklen(cidr) DESC");
     1203
     1204        $sth->execute($parent, $ptype, $fbrdepth);
    11481205
    11491206# NetAddr::IP->compact() attempts to produce the smallest inclusive block
    … …  
    11551212#       $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
    11561213
    1157         my (@together, @combinelist);
     1214        my (@rawfb, @combinelist);
    11581215        my $i=0;
     1216        # for each free block under $parent, push a NetAddr::IP object into one list, and
     1217        # continuously use NetAddr::IP->compact to automagically merge netblocks as possible.
    11591218        while (my @data = $sth->fetchrow_array) {
    11601219          my $testIP = new NetAddr::IP $data[0];
    1161           @together = $testIP->compact($cidr);
    1162           my $num = @together;
    1163           if ($num == 1) {
    1164             $cidr = $together[0];
    1165             $combinelist[$i++] = $testIP;
    1166           }
     1220          push @rawfb, $testIP;
     1221          @combinelist = $testIP->compact(@combinelist);
    11671222        }
    11681223
    1169         # Clear old freeblocks entries - if any.  They should all be within
    1170         # the $cidr determined above.
    1171         $sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
    1172         $sth->execute;
    1173 
    1174         # insert "new" freeblocks entry
    1175         if ($type eq 'rm') {
    1176           $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
    1177                 " values ('$cidr',".$cidr->masklen.",'<NULL>')");
    1178         } else {
    1179           # Magic hackery to insert "correct" data for deallocation of
    1180           # non-contained blocks allocated from within a container.
    1181           $type = 'pr' if $con_type && $con_type eq 'pc';
    1182 
    1183           $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
    1184                 " values ('$cidr',".$cidr->masklen.
    1185                 ",(select city from routed where cidr >>= '$cidr'),'".
    1186                 (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
     1224        # now that we have the full list of "compacted" freeblocks, go back over
     1225        # the list of raw freeblocks, and delete the ones that got merged.
     1226        $sth = $dbh->prepare("DELETE FROM freeblocks WHERE cidr=? AND parent=? AND rdepth=?");
     1227        foreach my $rawfree (@rawfb) {
     1228          next if grep { $rawfree == $_ } @combinelist; # skip if the raw block is in the compacted list
     1229          $sth->execute($rawfree, $parent, $fbrdepth);
    11871230        }
    1188         $sth->execute;
     1231
     1232        # now we walk the new list of compacted blocks, and see which ones we need to insert
     1233        $sth = $dbh->prepare("INSERT INTO freeblocks (cidr,city,routed,parent,rdepth) VALUES (?,?,?,?,?)");
     1234        foreach my $cme (@combinelist) {
     1235          next if grep { $cme == $_ } @rawfb;   # skip if the combined block was in the raw list
     1236          $sth->execute($cme, $pcity, $ptype, $parent, $fbrdepth);
     1237        }
    11891238
    11901239      } # done returning IPs to the appropriate place
    … …  
    11941243    }; # end eval
    11951244    if ($@) {
    1196       $msg = $@;
     1245      $msg .= ": $@";
    11971246      eval { $dbh->rollback; };
    11981247      return ('FAIL', $msg);
    11991248    } else {
    1200       return ('OK',"OK");
     1249      return ($retcode, $goback);
    12011250    }
    12021251
Note: See TracChangeset for help on using the changeset viewer.