Index: trunk/cgi-bin/IPDB.pm
===================================================================
--- trunk/cgi-bin/IPDB.pm	(revision 348)
+++ trunk/cgi-bin/IPDB.pm	(revision 349)
@@ -193,4 +193,9 @@
   my $sth;
 
+  # Snag the "type" of the freeblock (alloc_from) "just in case"
+  $sth = $dbh->prepare("select routed from freeblocks where cidr='$alloc_from'");
+  $sth->execute;
+  my ($alloc_from_type) = $sth->fetchrow_array;
+
   # To contain the error message, if any.
   my $msg = "Unknown error allocating $cidr as '$type'";
@@ -344,9 +349,15 @@
 
 	  # Insert the new freeblocks entries
-	  # Along with some more HairyPerl(TM) in case we're inserting a
-	  # subblock (.r) allocation
+	  # Along with some more HairyPerl(TM):
+	  #   if $alloc_type_from is p
+	  #   OR
+	  #   $type matches /^(.)r$/
+	  # inserted value for routed column should match.
+	  # This solves the case of inserting an arbitrary block into a
+	  # "Reserve-for-routed-DSL" block.  Which you really shouldn't
+	  # do in the first place, but anyway...
 	  $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
 		" values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
-		(($type =~ /^(.)r$/) ? "$1" : 'y')."')");
+		( ( ($alloc_from_type =~ /^(p)$/) || ($type =~ /^(.)r$/) ) ? "$1" : 'y')."')");
 	  foreach my $block (@newfreeblocks) {
  	    $sth->execute("$block", $block->masklen);
@@ -463,4 +474,8 @@
   my $sth;
 
+  # Magic variables used for odd allocation cases.
+  my $container;
+  my $con_type;
+
   # To contain the error message, if any.
   my $msg = "Unknown error deallocating $type $cidr";
@@ -529,4 +544,10 @@
       } else { # end alloctype routing case
 
+	# Magic.  We need to get information about the containing block (if any)
+	# so as to make sure that the freeblocks we insert get the correct "type".
+	$sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'");
+	$sth->execute;
+	($container, $con_type) = $sth->fetchrow_array;
+
 	# Delete all allocations within the block being deleted.  This is
 	# deliberate and correct, and removes the need to special-case
@@ -543,9 +564,17 @@
 
 	# Set up query for compacting free blocks.
-	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
+	if ($con_type && $con_type eq 'pc') {
+	  # Clean up after "bad" allocations (blocks that are not formally
+	  # contained which have nevertheless been allocated from a container block)
+	  # We want to make certain that the freeblocks are properly "labelled"
+	  $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container'");
+	} else {
+	  # Standard deallocation.
+	  $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
 		"(select cidr from routed where cidr >>= '$cidr') ".
 		" and maskbits<=".$cidr->masklen.
 		" and routed='".(($type =~ /^(.)r$/) ? '$1' : 'y').
 		"' order by maskbits desc");
+	}
 
       } # end alloctype general case
@@ -588,4 +617,8 @@
 		" values ('$cidr',".$cidr->masklen.",'<NULL>')");
       } else {
+	# Magic hackery to insert "correct" data for deallocation of
+	# non-contained blocks allocated from within a container.
+	$type = 'pr' if $con_type && $con_type eq 'pc';
+
 	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
 		" values ('$cidr',".$cidr->masklen.