Changeset 705 for trunk/cgi-bin

Timestamp:

02/25/15 18:09:13 (10 years ago)

Author:

Kris Deugau

Message:

/trunk

• Complete internal handling for "shrink block". See #7 (more or less).
• Add "breadcrumb" navigation fragments to split/shrink prep and do pages
• Add link to pool IP list on edit and split/shrink prep pages
• Shave off some useless code showing the split results
• Catch the theoretically impossible case of "no subact value" on submitting split/shrink form

Still need to add calls to monkey rDNS on split/shrink changes

Location:

trunk/cgi-bin

Files:

• IPDB.pm (modified) (3 diffs)
• main.cgi (modified) (6 diffs)

trunk/cgi-bin/IPDB.pm

@@ -32 +32 @@
         &getMasterList &getTypeList &getPoolSelect &findAllocateFrom
         &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-        &allocateBlock &updateBlock &splitBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
+        &allocateBlock &updateBlock &splitBlock &shrinkBlock &deleteBlock &getBlockData
+        &getBlockRDNS &getRDNSbyIP
         &getNodeList &getNodeName &getNodeInfo
         &mailNotify
@@ -47 +48 @@
                 &getMasterList &getTypeList &getPoolSelect &findAllocateFrom
                 &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-                &allocateBlock &updateBlock &splitBlock &deleteBlock &getBlockData &getBlockRDNS &getRDNSbyIP
+                &allocateBlock &updateBlock &splitBlock &shrinkBlock &deleteBlock &getBlockData
+                &getBlockRDNS &getRDNSbyIP
                 &getNodeList &getNodeName &getNodeInfo
                 &mailNotify
@@ -1571 +1573 @@
 
 
+## IPDB::shrinkBlock()
+# Shrink an allocation to the passed CIDR block
+# Takes an allocation ID and a new CIDR
+# Returns an arrayref to a list of hashrefs with the ID and CIDR of the freed block(s)
+# Refuses to shrink "real netblock" pool types below /30
+sub shrinkBlock {
+  my $dbh = shift;
+  my $id = shift;
+
+  # just take the new CIDR spec;  this way we can shrink eg .16/28 to .20/30 without extra contortions
+  my $newblock = new NetAddr::IP shift;
+
+  if (!$newblock) {
+    $errstr = "Can't shrink something that's not a netblock";
+    return;
+  }
+
+  my $binfo = getBlockData($dbh, $id);
+  my $pinfo = getBlockData($dbh, $binfo->{parent_id});
+
+  if ($binfo->{type} =~ /.d/ && $newblock->masklen > ($newblock->bits+2) ) {
+    $errstr = "Can't shrink a non-PPP pool smaller than ".($newblock->{isv6} ? '/124' : '/30');
+    return;
+  }
+
+  my $oldblock = new NetAddr::IP $binfo->{block};
+
+  # Don't try to shrink the block outside of itself, Bad Things (probably) Happen.
+  if (!$oldblock->contains($newblock)) {
+    $errstr = "Can't shrink an allocation outside of itself";
+    return;
+  }
+
+  local $dbh->{AutoCommit} = 0;
+  local $dbh->{RaiseError} = 1;
+
+  my $fbsth = $dbh->prepare("INSERT INTO freeblocks (cidr,city,routed,vrf,parent_id,master_id) VALUES (?,?,?,?,?,?)");
+  my $idsth = $dbh->prepare("SELECT currval('freeblocks_id_seq')");
+  my $poolsth = $dbh->prepare("DELETE FROM poolips WHERE parent_id = ? AND ip << ?");
+  my $netsth = $dbh->prepare("DELETE FROM poolips WHERE parent_id = ? AND ip = ?");
+
+  my @ret;
+  eval {
+    $dbh->do("UPDATE allocations SET cidr = ? WHERE id = ?", undef, $newblock, $id);
+
+    # find the netblock(s) that are now free
+    my @workingblocks = $oldblock->split($newblock->masklen);
+    my @wb2;
+    foreach my $newsub (@workingblocks) {
+      next if $newsub == $newblock;
+      push @wb2, $newsub;
+    }
+    @wb2 = Compact(@wb2);
+
+    # set new freeblocks, and clean up any IP pool entries if needed.
+    foreach my $newfree (@wb2) {
+      # add as freeblock
+      $fbsth->execute($newfree, $pinfo->{city}, (split //, $pinfo->{type})[1], $pinfo->{vrf},
+        $binfo->{parent_id}, $binfo->{master_id});
+      $idsth->execute;
+      my ($nid) = $idsth->fetchrow_array();
+      # add to return list
+      push @ret, {fbid => $nid, newfree => "$newfree", fbparent => $binfo->{parent_id} };
+      # clean up pool IPs if necessary
+      if ($binfo->{type} =~ /.[dp]/) {
+        $poolsth->execute($id, $newfree);
+      }
+    }
+
+    # additional cleanup on net/gw/bcast IPs in pool
+    if ($binfo->{type} =~ /.d/) {
+      $netsth->execute($id, $newblock->addr);
+      $newblock++;
+      $netsth->execute($id, $newblock->addr);
+      $newblock--;
+      $newblock--;
+      $netsth->execute($id, $newblock->addr);
+    }
+
+    $dbh->commit;
+  };
+  if ($@) {
+    $errstr = "Error splitting $binfo->{block}: $@";
+    $dbh->rollback;
+    return;
+  }
+
+  return \@ret;
+} # end shrinkBlock()
+
+
 ## IPDB::deleteBlock()
 # Removes an allocation from the database, including deleting IPs

trunk/cgi-bin/main.cgi

@@ -875 +875 @@
   $utilbar->param(breadcrumb => \@rcrumbs);
 
+  # Show link to IP list for pools
+  $page->param(ispool => 1) if $blockinfo->{type} =~ /^.[dp]$/;
+
   # Clean up extra whitespace on alloc type.  Mainly a legacy-data cleanup.
   $blockinfo->{type} =~ s/\s//;
@@ -1092 +1095 @@
   my $blockinfo = getBlockData($ip_dbh, $webvar{block});
 
+  # Tree navigation
+  my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
+  my @rcrumbs = reverse (@$crumbs);
+  $utilbar->param(breadcrumb => \@rcrumbs);
+
   if ($blockinfo->{type} =~ /^.i$/) {
     $page->param(err => "Can't split a single IP allocation");
@@ -1110 +1118 @@
   if ($blockinfo->{type} =~ /^.d$/) {
     # Non-PPP pools
+    $page->param(ispool => 1);
     if ($oldmask+2 >= $block->bits) {
       $page->param(err => "Can't split a standard netblock pool any further");
@@ -1117 +1126 @@
     $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-2;
   } elsif ($blockinfo->{type} =~ /.p/) {
+    $page->param(ispool => 1);
     # Allow splitting PPP pools down to v4 /31
     $page->param(sp4mask => $oldmask+2) if $oldmask+2 <= $block->bits-1;
@@ -1144 +1154 @@
   my $blockinfo = getBlockData($ip_dbh, $webvar{block});
 
+  # Tree navigation
+  my $crumbs = getBreadCrumbs($ip_dbh, $blockinfo->{parent_id});
+  my @rcrumbs = reverse (@$crumbs);
+  $utilbar->param(breadcrumb => \@rcrumbs);
+
   if ($blockinfo->{type} =~ /^.i$/) {
     $page->param(err => "Can't split a single IP allocation");
@@ -1151 +1166 @@
   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 $block = new NetAddr::IP $blockinfo->{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);
     }
 
+  } elsif ($webvar{subact} eq 'shrink') {
+    $page->param(nid => $webvar{block});
+    $page->param(newblock => $webvar{shrink});
+    my $newfree = shrinkBlock($ip_dbh, $webvar{block}, $webvar{shrink});
+    if ($newfree) {
+      $page->param(newfb => $newfree);
+    } else {
+      $page->param(err => $IPDB::errstr);
+    }
+
   } else {
-    # Shrink
-  }
+    # Your llama is on fire.
+    $page->param(err => "Missing form field that shouldn't be missing.");
+    return;
+  }
+
+  # common bits
+  $page->param(cidr => $blockinfo->{block});
+  # and the backlink to the parent container
+  my $pinfo = getBlockData($ip_dbh, $blockinfo->{parent_id});
+  $page->param(backid => $blockinfo->{parent_id});
+  $page->param(backblock => $pinfo->{block});
 } # doSplit()