Changeset 93 for trunk/cgi-bin

Timestamp:

12/01/04 15:29:09 (20 years ago)

Author:

Kris Deugau

Message:

/trunk

Add deleteBlock() sub

File:

• trunk/cgi-bin/IPDB.pm (modified) (2 diffs)

trunk/cgi-bin/IPDB.pm

@@ -22 +22 @@
 @ISA            = qw(Exporter);
 @EXPORT_OK      = qw(&initIPDBGlocals &connectDB &finish &checkDBSanity &allocateBlock
-                        &mailNotify);
+                        &deleteBlock &mailNotify);
 
 @EXPORT         = (); # Export nothing by default.
 %EXPORT_TAGS    = ( ALL => [qw( &initIPDBGlocals &connectDB &finish &checkDBSanity
-                                &allocateBlock &mailNotify)]
+                                &allocateBlock &deleteBlock &mailNotify)]
                   );
 
@@ -337 +337 @@
 
 
+## 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 $type $cidr";
+      $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
+        "city=(select city from allocations ".
+        "where cidr=(select pool from poolips where ip='$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 'rr') {
+        $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='<NULL>'".
+                " where cidr='$cidr'");
+        $sth->execute;
+        # Set up query to start compacting free blocks.
+        $sth = $dbh->prepare("select * from freeblocks where ".
+                "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
+
+      } else { # end alloctype routing case
+
+        $sth = $dbh->prepare("delete from allocations where cidr='$cidr'");
+        $sth->execute;
+        # Special case - delete pool IPs
+        if ($type =~ /^.p$/) {
+          # 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 * from freeblocks where cidr << ".
+                "(select cidr from routed where cidr >> '$cidr') ".
+                " and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
+
+      } # end alloctype general case
+
+      # 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.  $i==0 if not.
+      if ($i>0) {
+        $sth = $dbh->prepare("delete from freeblocks where cidr=?");
+        foreach my $block (@combinelist) {
+          $sth->execute("$block");
+        }
+      }
+
+      # insert "new" freeblocks entry
+      if ($type eq 'rr') {
+        $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+                ",'<NULL>','n')");
+      } else {
+        $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+                ",(select city from routed where cidr >>= '$cidr'),'y')");
+      }
+      $sth->execute;
+
+      # 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