Changeset 702 for trunk/cgi-bin

Timestamp:

02/23/15 18:16:11 (10 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".

Location:

trunk/cgi-bin

Files:

• IPDB.pm (modified) (3 diffs)
• main.cgi (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

trunk/cgi-bin/main.cgi

@@ -171 +171 @@
 elsif($webvar{action} eq 'update') {
   update();
+}
+elsif($webvar{action} eq 'split') {
+  prepSplit();
+}
+elsif($webvar{action} eq 'dosplit') {
+  doSplit();
 }
 elsif($webvar{action} eq 'delete') {
@@ -965 +971 @@
   $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
 
+  # Need to find internal knobs to twist to actually vary these.  (Ab)use "change" flag for now
+  $page->param(maymerge => ($IPDBacl{$authuser} =~ /c/ && $blockinfo->{type} !~ /^.i$/));
+  if ($IPDBacl{$authuser} =~ /c/ && $blockinfo->{type} !~ /^.i$/) {
+    if ($blockinfo->{type} =~ /^.p$/) {
+      # PPP pools
+      $page->param(maysplit => 1) if $cidr->masklen+1 < $cidr->bits;
+    } elsif ($blockinfo->{type} =~ /.d/) {
+      # Non-PPP pools
+      $page->param(maysplit => 1) if $cidr->masklen+2 < $cidr->bits;
+    } else {
+      # Standard netblocks.  Arguably allowing splitting these down to single IPs
+      # doesn't make much sense, but forcing users to apply allocation types
+      # "properly" is worse than herding cats.
+      $page->param(maysplit => 1) if $cidr->masklen < $cidr->bits;
+    }
+  }
+
 } # edit()
 
@@ -1061 +1084 @@
 
 
+sub prepSplit {
+  if ($IPDBacl{$authuser} !~ /c/) {
+    $aclerr = 'splitblock';
+    return;
+  }
+
+  my $blockinfo = getBlockData($ip_dbh, $webvar{block});
+
+  if ($blockinfo->{type} =~ /^.i$/) {
+    $page->param(err => "Can't split a single IP allocation");
+    return;
+  }
+
+  # Info about current allocation
+  $page->param(oldblock => $blockinfo->{block});
+  $page->param(block => $webvar{block});
+
+# Note that there are probably different rules that should be followed to restrict splitting IPv6 blocks;
+# strictly speaking it will be exceptionally rare to see smaller than a /64 assigned to a customer, since that
+# breaks auto-addressing schemes.
+
+  # Generate possible splits
+  my $block = new NetAddr::IP $blockinfo->{block};
+  my $oldmask = $block->masklen;
+  if ($blockinfo->{type} =~ /^.d$/) {
+    # Non-PPP pools
+    if ($oldmask+2 >= $block->bits) {
+      $page->param(err => "Can't split a standard netblock pool any further");
+      return;
+    }
+    # Allow splitting down to v4 /30 (which results in one usable IP;  dubiously useful)
+    $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-2;
+  } elsif ($blockinfo->{type} =~ /.p/) {
+    # Allow splitting PPP pools down to v4 /31
+    $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-1;
+  } else {
+    # Allow splitting all other non-pool netblocks down to single IPs, which...
+    # arguably should be *aggregated* in a pool.  Except where they shouldn't.
+    $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits;
+  }
+  # set the split-in-half mask
+  $page->param(sp2mask => $oldmask+1);
+
+  # Generate possible shrink targets
+  my @keepers = $block->split($block->masklen+1);
+  $page->param(newblockA => $keepers[0]);
+  $page->param(newblockB => $keepers[1]);
+} # prepSplit()
+
+
+sub doSplit {
+  if ($IPDBacl{$authuser} !~ /c/) {
+    $aclerr = 'splitblock';
+    return;
+  }
+
+##fixme:  need consistent way to identify "this thing that is this thing" with only the ID
+# also applies to other locations
+  my $blockinfo = getBlockData($ip_dbh, $webvar{block});
+
+  if ($blockinfo->{type} =~ /^.i$/) {
+    $page->param(err => "Can't split a single IP allocation");
+    return;
+  }
+
+  if ($webvar{subact} eq 'split') {
+    $page->param(issplit => 1);
+    my $binfo = getBlockData($ip_dbh, $webvar{block});
+    $page->param(cidr => $binfo->{block});
+    my $block = new NetAddr::IP $binfo->{block};
+    my $newblocks = splitBlock($ip_dbh, $webvar{block}, 'b', $webvar{split});
+    if ($newblocks) {
+      $page->param(newblocks => $newblocks);
+      # and the backlink to the parent container
+      my $pinfo = getBlockData($ip_dbh, $binfo->{parent_id});
+      $page->param(backid => $binfo->{parent_id});
+      $page->param(backblock => $pinfo->{block});
+    } else {
+      $page->param(err => $IPDB::errstr);
+    }
+
+  } else {
+    # Shrink
+  }
+} # doSplit()
+
+
 # Delete an allocation.
 sub remove {