Index: trunk/cgi-bin/IPDB.pm
===================================================================
--- trunk/cgi-bin/IPDB.pm	(revision 547)
+++ trunk/cgi-bin/IPDB.pm	(revision 554)
@@ -656,26 +656,31 @@
 ## IPDB::allocateBlock()
 # Does all of the magic of actually allocating a netblock
-# Requires database handle, block to allocate, custid, type, city,
-#	description, notes, circuit ID, block to allocate from, private data
+# Requires a database handle, and a hash containing the block to allocate, routing depth, custid,
+#   type, city, block to allocate from, and optionally a description, notes, circuit ID,
+#   and private data
 # Returns a success code and optional error message.
 sub allocateBlock {
-  my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata,$nodeid) = @_;
-
-  my $cidr = new NetAddr::IP $_[1];
-  my $alloc_from = new NetAddr::IP $_[2];
+  my $dbh = shift;
+
+  my %args = @_;
+
+  $args{cidr} = new NetAddr::IP $args{cidr};
+  $args{alloc_from} = new NetAddr::IP $args{alloc_from};
+
+  $args{desc} = '' if !$args{desc};
+  $args{notes} = '' if !$args{notes};
+  $args{circid} = '' if !$args{circid};
+  $args{privdata} = '' if !$args{privdata};
+  $args{vrf} = '' if !$args{vrf};
+
   my $sth;
 
-  $desc = '' if !$desc;
-  $notes = '' if !$notes;
-  $circid = '' if !$circid;
-  $privdata = '' if !$privdata;
-
   # Snag the "type" of the freeblock (alloc_from) "just in case"
-  $sth = $dbh->prepare("select routed from freeblocks where cidr='$alloc_from'");
+  $sth = $dbh->prepare("select routed from freeblocks where cidr='$args{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'";
+  my $msg = "Unknown error allocating $args{cidr} as '$disp_alloctypes{$args{type}}'";
 
   # Enable transactions and error handling
@@ -683,34 +688,24 @@
   local $dbh->{RaiseError} = 1;	# step on our toes by accident.
 
-  if ($type =~ /^.i$/) {
-    $msg = "Unable to assign static IP $cidr to $custid";
+  if ($args{type} =~ /^.i$/) {
+    $msg = "Unable to assign static IP $args{cidr} to $args{custid}";
     eval {
-      # We have to do this in two parts because otherwise we lose
-      # the ability to return the IP assigned.  Should that change,
-      # the commented SQL statement below may become usable.
-# update poolips set custid='$custid',city='$city',available='n',
-#	description='$desc',notes='$notes',circuitid='$circid'
-#	where ip=(select ip from poolips where pool='$alloc_from'
-#	and available='y' order by ip limit 1);
-
-      if ($cidr) {
-	my ($isavail) = $dbh->selectrow_array("SELECT available FROM poolips WHERE ip=?", undef, ($cidr) );
-	if ($isavail eq 'n') {
-	  die "IP already allocated.  Deallocate and reallocate, or update the entry\n";
-	}
-	if (!$isavail) {
-	  die "IP is not in an IP pool.\n";
-	}
-      } else {
-	($cidr) = $dbh->selectrow_array("SELECT ip FROM poolips WHERE pool=? AND available='y' ORDER BY ip",
-		undef, ($alloc_from) );
-      }
-      $dbh->do("UPDATE poolips SET custid=?,city=?,available='n',description=?,notes=?,circuitid=?,privdata=? ".
-	"WHERE ip=?", undef, ($custid, $city, $desc, $notes, $circid, $privdata, $cidr) );
+      if ($args{cidr}) {	# IP specified
+	my ($isavail) = $dbh->selectrow_array("SELECT available FROM poolips WHERE ip=?", undef, ($args{cidr}) );
+	die "IP is not in an IP pool.\n"
+	  if !$isavail;
+	die "IP already allocated.  Deallocate and reallocate, or update the entry\n"
+	  if $isavail eq 'n';
+      } else {	# IP not specified, take first available
+	($args{cidr}) = $dbh->selectrow_array("SELECT ip FROM poolips WHERE pool=? AND available='y' ORDER BY ip",
+		undef, ($args{alloc_from}) );
+      }
+      $dbh->do("UPDATE poolips SET custid=?,city=?,available='n',description=?,notes=?,circuitid=?,privdata=?,vrf=? ".
+	"WHERE ip=?", undef, ($args{custid}, $args{city}, $args{desc}, $args{notes}, $args{circid},
+		$args{privdata}, $args{vrf}, $args{cidr}) );
 
 # node hack
-      if ($nodeid && $nodeid ne '') {
-        $sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
-        $sth->execute("$cidr",$nodeid);
+      if ($args{nodeid} && $args{nodeid} ne '') {
+        $dbh->do("INSERT INTO noderef (block,node_id) VALUES (?,?)", undef, ($args{cidr}, $args{nodeid}) );
       }
 # end node hack
@@ -723,10 +718,10 @@
       return ('FAIL',$msg);
     } else {
-      return ('OK',"$cidr");
+      return ('OK',"$args{cidr}");
     }
 
   } else { # end IP-from-pool allocation
 
-    if ($cidr == $alloc_from) {
+    if ($args{cidr} == $args{alloc_from}) {
       # Easiest case- insert in one table, delete in the other, and go home.  More or less.
       # insert into allocations values (cidr,custid,type,city,desc) and
@@ -735,48 +730,44 @@
 
       eval {
-	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
-	if ($type eq 'rm') {
-	  $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
-	    " where cidr='$cidr'");
-	  $sth->execute;
-	  $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
-		" values ('$cidr',".$cidr->masklen.",'$city')");
-	  $sth->execute;
+	$msg = "Unable to allocate $args{cidr} as '$disp_alloctypes{$args{type}}'";
+
+	# Munge freeblocks
+	if ($args{type} =~ /^(.)[mc]$/) {
+	  # special case - block is a routed or container/"reserve" block
+	  my $rtype = $1;
+	  $dbh->do("UPDATE freeblocks SET routed=?,rdepth=rdepth+1,city=?,parent=? WHERE cidr=? AND rdepth=?",
+		undef, ($rtype, $args{city}, $args{cidr}, $args{cidr}, $args{rdepth}));
 	} else {
-	  # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
-
-	  # special case - block is a container/"reserve" block
-	  if ($type =~ /^(.)c$/) {
-	    $sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
-	    $sth->execute;
-	  } else {
-	    # "normal" case
-	    $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
-	    $sth->execute;
-	  }
-	  $sth = $dbh->prepare("insert into allocations".
-		" (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
-		" values (?,?,?,?,?,?,?,?,?)");
-	  $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
-
-	  # And initialize the pool, if necessary
-	  # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
-	  # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
-	  if ($type =~ /^.p$/) {
-	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
-	    my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
-	    die $rmsg if $code eq 'FAIL';
-	  } elsif ($type =~ /^.d$/) {
-	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
-	    my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
-	    die $rmsg if $code eq 'FAIL';
-	  }
-
-	} # routing vs non-routing netblock
+	  # "normal" case
+	  $dbh->do("DELETE FROM freeblocks WHERE cidr=? AND rdepth=?", undef, ($args{cidr}, $args{rdepth}));
+	}
+
+	# get old freeblocks parent/depth/routed for new entries
+	my ($fparent) = $dbh->selectrow_array("SELECT parent,city,routed FROM freeblocks".
+		" WHERE cidr=? AND rdepth=?", undef, ($args{alloc_from}, $args{rdepth}));
+
+	# Insert the allocations entry
+	$dbh->do("INSERT INTO allocations ".
+		"(cidr,parent,vrf,rdepth,custid,type,city,description,notes,circuitid,privdata)".
+		" VALUES (?,?,?,?,?,?,?,?,?,?,?)", undef,
+		($args{cidr}, $fparent, $args{vrf}, $args{rdepth}, $args{custid}, $args{type}, $args{city},
+		$args{desc}, $args{notes}, $args{circid}, $args{privdata}) );
+
+	# And initialize the pool, if necessary
+	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
+	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
+	if ($args{type} =~ /^.p$/) {
+	  $msg = "Could not initialize IPs in new $disp_alloctypes{$args{type}} $args{cidr}";
+	  my ($code,$rmsg) = initPool($dbh, $args{cidr}, $args{type}, $args{city}, "all");
+	  die $rmsg if $code eq 'FAIL';
+	} elsif ($args{type} =~ /^.d$/) {
+	  $msg = "Could not initialize IPs in new $disp_alloctypes{$args{type}} $args{cidr}";
+	  my ($code,$rmsg) = initPool($dbh, $args{cidr}, $args{type}, $args{city}, "normal");
+	  die $rmsg if $code eq 'FAIL';
+	}
 
 # node hack
-      if ($nodeid && $nodeid ne '') {
-        $sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
-        $sth->execute("$cidr",$nodeid);
+      if ($args{nodeid} && $args{nodeid} ne '') {
+        $dbh->do("INSERT INTO noderef (block,node_id) VALUES (?,?)", undef, ($args{cidr}, $args{nodeid}) );
       }
 # end node hack
@@ -794,6 +785,6 @@
 
       # Hard case.  Allocation is smaller than free block.
-      my $wantmaskbits = $cidr->masklen;
-      my $maskbits = $alloc_from->masklen;
+      my $wantmaskbits = $args{cidr}->masklen;
+      my $maskbits = $args{alloc_from}->masklen;
 
       my @newfreeblocks;	# Holds free blocks generated from splitting the source freeblock.
@@ -803,91 +794,60 @@
       # block is in, and repeat until the wanted block is equal to one of the halves.
       my $i=0;
-      my $tmp_from = $alloc_from;	# So we don't munge $alloc_from
+      my $tmp_from = $args{alloc_from};	# So we don't munge $args{alloc_from}
       while ($maskbits++ < $wantmaskbits) {
 	my @subblocks = $tmp_from->split($maskbits);
-	$newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
-	$tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
+	$newfreeblocks[$i++] = (($args{cidr}->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
+	$tmp_from = ( ($args{cidr}->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
       } # while
 
       # Begin SQL transaction block
       eval {
-	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
+	$msg = "Unable to allocate $args{cidr} as '$disp_alloctypes{$args{type}}'";
+
+	# Get old freeblocks parent/depth/routed for new entries
+	my ($fparent,$fcity,$wasrouted) = $dbh->selectrow_array("SELECT parent,city,routed FROM freeblocks".
+		" WHERE cidr=? AND rdepth=?", undef, ($args{alloc_from}, $args{rdepth}) );
 
 	# Delete old freeblocks entry
-	$sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
-	$sth->execute();
-
-	# now we have to do some magic for routing blocks
-	if ($type eq 'rm') {
-
-	  # Insert the new freeblocks entries
-	  # Note that non-routed blocks are assigned to <NULL>
-	  # and use the default value for the routed column ('n')
-	  $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
-		" values (?, ?, '<NULL>')");
-	  foreach my $block (@newfreeblocks) {
- 	    $sth->execute("$block", $block->masklen);
-	  }
-
-	  # Insert the entry in the routed table
-	  $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
-		" values ('$cidr',".$cidr->masklen.",'$city')");
-	  $sth->execute;
-	  # Insert the (almost) same entry in the freeblocks table
-	  $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
-		" values ('$cidr',".$cidr->masklen.",'$city','y')");
-	  $sth->execute;
-
-	} else { # done with alloctype == rm
-
-	  # Insert the new freeblocks entries
-	  # 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'),'".
-		( ( ($alloc_from_type =~ /^(p)$/) || ($type =~ /^(.)r$/) ) ? "$1" : 'y')."')");
-	  foreach my $block (@newfreeblocks) {
- 	    $sth->execute("$block", $block->masklen);
-	  }
-	  # Special-case for reserve/"container" blocks - generate
-	  # the "extra" freeblocks entry for the container
-	  if ($type =~ /^(.)c$/) {
-	    $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
-		" values ('$cidr',".$cidr->masklen.",'$city','$1')");
-	    $sth->execute;
-	  }
-	  # Insert the allocations entry
-	  $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
-		"description,notes,maskbits,circuitid,privdata)".
-		" values (?,?,?,?,?,?,?,?,?)");
-	  $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
-
-	  # And initialize the pool, if necessary
-	  # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
-	  # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
-	  if ($type =~ /^.p$/) {
-	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
-	    my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
-	    die $rmsg if $code eq 'FAIL';
-	  } elsif ($type =~ /^.d$/) {
-	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
-	    my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
-	    die $rmsg if $code eq 'FAIL';
-	  }
-
-	} # done with netblock alloctype != rm
+	$dbh->do("DELETE FROM freeblocks WHERE cidr=? AND rdepth=?", undef, ($args{alloc_from}, $args{rdepth}) );
+
+	# Insert new list of smaller free blocks left over
+	$sth = $dbh->prepare("INSERT INTO freeblocks (cidr,city,routed,vrf,parent,rdepth) VALUES (?,?,?,?,?,?)");
+	foreach my $block (@newfreeblocks) {
+	  $sth->execute($block, $fcity, $wasrouted, $args{vrf}, $fparent, $args{rdepth});
+	}
+
+	# For routed/container types, add a freeblock within the allocated block so we can subdivide it further
+	if ($args{type} =~ /(.)[mc]/) { # rm and .c types - containers
+	  my $rtype = $1;
+	  $sth->execute($args{cidr}, $args{city}, $rtype, $args{vrf}, $args{cidr}, $args{rdepth}+1);
+	}
+
+	# Insert the allocations entry
+	$dbh->do("INSERT INTO allocations ".
+		"(cidr,parent,vrf,rdepth,custid,type,city,description,notes,circuitid,privdata)".
+		" VALUES (?,?,?,?,?,?,?,?,?,?,?)", undef,
+		($args{cidr}, $fparent, $args{vrf}, $args{rdepth}, $args{custid}, $args{type}, $args{city},
+		$args{desc}, $args{notes}, $args{circid}, $args{privdata}) );
+
+	# And initialize the pool, if necessary
+	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
+	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
+	if ($args{type} =~ /^.p$/) {
+	  $msg = "Could not initialize IPs in new $disp_alloctypes{$args{type}} $args{cidr}";
+	  my ($code,$rmsg) = initPool($dbh, $args{cidr}, $args{type}, $args{city}, "all");
+	  die $rmsg if $code eq 'FAIL';
+	} elsif ($args{type} =~ /^.d$/) {
+	  $msg = "Could not initialize IPs in new $disp_alloctypes{$args{type}} $args{cidr}";
+	  my ($code,$rmsg) = initPool($dbh, $args{cidr}, $args{type}, $args{city}, "normal");
+	  die $rmsg if $code eq 'FAIL';
+	}
 
 # node hack
-      if ($nodeid && $nodeid ne '') {
-        $sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
-        $sth->execute("$cidr",$nodeid);
+      if ($args{nodeid} && $args{nodeid} ne '') {
+        $dbh->do("INSERT INTO noderef (block,node_id) VALUES (?,?)", undef, ($args{cidr}, $args{nodeid}) );
       }
 # end node hack
+
         $dbh->commit;
       }; # end eval
