Changeset 702 for trunk/cgi-bin/IPDB.pm

Timestamp:

02/23/15 18:16:11 (9 years ago)

Author:

Kris Deugau

Message:

/trunk

Add "split block" feature. See #7. May still need a little tweaking
("List IPs" link for pools, refiddle rDNS template records?)

Also stubbed out "shrink block" (branch for "split block"), and added
a placeholder for "merge blocks".

File:

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

trunk/cgi-bin/IPDB.pm

@@ -32 +32 @@
         &getMasterList &getTypeList &getPoolSelect &findAllocateFrom
         &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-        &allocateBlock &updateBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
+        &allocateBlock &updateBlock &splitBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
         &getNodeList &getNodeName &getNodeInfo
         &mailNotify
@@ -47 +47 @@
                 &getMasterList &getTypeList &getPoolSelect &findAllocateFrom
                 &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-                &allocateBlock &updateBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
+                &allocateBlock &updateBlock &splitBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
                 &getNodeList &getNodeName &getNodeInfo
                 &mailNotify
@@ -1453 +1453 @@
 
 
+## IPDB::splitBlock()
+# Splits an existing allocation into two or more smaller allocations based on a passed netmask
+# Duplicates all other data
+# Returns an arrayref to a list of hashrefs with ID and CIDR keys for the list of new allocations.
+# Should probably commit DNS magic to realign DNS data
+sub splitBlock {
+  my $dbh = shift;
+  my $id = shift;
+  my $basetype = shift;
+  my $newmask = shift;
+
+##fixme:  set errstr on errors so caller can suitably clue-by-four the user
+  return if $basetype ne 'b';  # only netblocks allowed!
+
+  my $binfo = getBlockData($dbh, $id);
+  return if !$binfo;
+
+  return if $newmask !~ /^\d+$/;
+
+  my @ret;
+  my $block = new NetAddr::IP $binfo->{block};
+  my $oldmask = $block->masklen;
+
+  # Fail if the block to split is "too small" - eg, can't split a v4 /32 at all
+  # failure modes:
+  # difference between $oldmask and $newmask is negative or 0
+  if ($newmask - $oldmask <= 0) {
+    $errstr = "Can't split a /$oldmask allocation into /$newmask pieces";
+    return;
+  }
+#  # difference between $oldmask and $newmask is > n, for arbitrary n?
+#  if ($newmask - $oldmask > 42) {  # because 42
+#  }
+  # $oldmask > n, for arbitrary n?  At least check limits of data type.
+  if ($block->{isv6}) {
+    if ($newmask - $oldmask > 128) {
+      $errstr = "Impossible IPv6 mask length /$newmask requested";
+      return;
+    }
+  } else {
+    if ($newmask - $oldmask > 32) {
+      $errstr = "Impossible IPv4 mask length /$newmask requested";
+      return;
+    }
+  }
+
+  my @newblocks = $block->split($newmask);
+
+  local $dbh->{AutoCommit} = 0;
+  local $dbh->{RaiseError} = 1;
+
+  eval {
+    # line up a list of fields and values.  Be nice if there was a handy way to do,
+    # direct in SQL, something like
+    # "INSERT INTO foo (f1,f2,f3) VALUES (newf1,(SELECT oldf2,oldf3 FROM foo WHERE baz))"
+    my @fieldlist = qw(type city description notes circuitid privdata custid swip vrf vlan rdns parent_id master_id);
+    my $fields_sql = join(',', @fieldlist);
+    my @vals;
+    foreach (@fieldlist) {
+      push @vals, $binfo->{$_};
+    }
+    # note the first block in the split for return
+    push @ret, {nid => $id, nblock => "$newblocks[0]"};
+
+    # prepare
+    my $idsth = $dbh->prepare("SELECT currval('allocations_id_seq')");
+    my $poolsth = $dbh->prepare("INSERT INTO allocations (cidr, $fields_sql)".
+        " VALUES (?".',?'x(scalar(@fieldlist)).")");
+    my $poolchildsth = $dbh->prepare("UPDATE poolips SET parent_id = ? WHERE ip << ? AND parent_id = ?");
+    my $nbsth = $dbh->prepare("DELETE FROM poolips WHERE parent_id = ? AND ip = ?");
+
+    # set up update of existing block
+    $dbh->do("UPDATE allocations SET cidr = ? WHERE id = ?", undef, ("$newblocks[0]", $id) );
+
+    # axe the net, gw, and bcast IPs as necessary when splitting a "normal" pool
+    if ($binfo->{type} =~ /.d/) {
+      $newblocks[0]--;
+      $nbsth->execute($id, $newblocks[0]->addr);
+    }
+
+    # Loop over the new blocks that are not the base block
+    for (my $i = 1; $i <= $#newblocks; $i++) {
+      # add the new pool
+      $poolsth->execute($newblocks[$i], @vals);
+      # fetch the ID of the entry we just added...
+      $idsth->execute();
+      my ($nid) = $idsth->fetchrow_array();
+      # ... so we can pass back the list of blocks and IDs...
+      push @ret, {nid => $nid, nblock => "$newblocks[$i]"};
+      # axe the net, gw, and bcast IPs as necessary when splitting a "normal" pool
+      if ($binfo->{type} =~ /.d/) {
+        # net
+        $nbsth->execute($id, $newblocks[$i]->addr);
+        $newblocks[$i]++;
+        # gw
+        $nbsth->execute($id, $newblocks[$i]->addr);
+        $newblocks[$i]--;
+        $newblocks[$i]--;
+        # bcast
+        $nbsth->execute($id, $newblocks[$i]->addr);
+        $newblocks[$i]++;
+      }
+      # ... and update the existing IPs with the new parent_id
+      $poolchildsth->execute($nid, $newblocks[$i], $id);
+    }
+
+    $dbh->commit;
+  };
+  if ($@) {
+    $errstr = "Error splitting $binfo->{block}: $@";
+    $dbh->rollback;
+    return;
+  }
+
+  return \@ret;
+} # end splitBlock()
+
+
 ## IPDB::deleteBlock()
 # Removes an allocation from the database, including deleting IPs