Index: branches/stable/cgi-bin/IPDB.pm
===================================================================
--- branches/stable/cgi-bin/IPDB.pm	(revision 124)
+++ branches/stable/cgi-bin/IPDB.pm	(revision 125)
@@ -14,42 +14,142 @@
 use warnings;
 use Exporter;
+use DBI;
 use Net::SMTP;
 use POSIX;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
-$VERSION	= 1.0;
+$VERSION	= 2.0;
 @ISA		= qw(Exporter);
-@EXPORT_OK	= qw(&connectDB &checkDBSanity &allocateBlock &mailNotify);
+@EXPORT_OK    = qw(
+	%disp_alloctypes %list_alloctypes @citylist @poplist @masterblocks
+	%allocated %free %routed %bigfree
+	&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
+	&mailNotify
+	);
 
 @EXPORT		= (); # Export nothing by default.
-%EXPORT_TAGS	= ( ALL => [qw( &connectDB &checkDBSanity &allocateBlock &mailNotify)]
-		  );
-
-
+%EXPORT_TAGS	= ( ALL => [qw(
+		%disp_alloctypes %list_alloctypes @citylist @poplist @masterblocks
+		%allocated %free %routed %bigfree
+		&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
+		&deleteBlock &mailNotify
+		)]
+	);
+
+##
+## Global variables
+##
+our %disp_alloctypes;
+our %list_alloctypes;
+our @citylist;
+our @poplist;
+our @masterblocks;
+our %allocated;
+our %free;
+our %routed;
+our %bigfree;
+
+# Let's initialize the globals.
+## IPDB::initIPDBGlobals()
+# Initialize all globals.  Takes a database handle, returns a success or error code
+sub initIPDBGlobals {
+  my $dbh = $_[0];
+  my $sth;
+
+  # Initialize alloctypes hashes
+  $sth = $dbh->prepare("select * from alloctypes order by listorder");
+  $sth->execute;
+  while (my @data = $sth->fetchrow_array) {
+    $disp_alloctypes{$data[0]} = $data[2];
+    if ($data[3] < 900) {
+      $list_alloctypes{$data[0]} = $data[1];
+    }
+  }
+
+  # City and POP listings
+  $sth = $dbh->prepare("select * from cities");
+  $sth->execute;
+  return (undef,$sth->errstr) if $sth->err;
+  while (my @data = $sth->fetchrow_array) {
+    push @citylist, $data[0];
+    if ($data[1] eq 'y') {
+      push @poplist, $data[0];
+    }
+  }
+
+  # Master block list
+  $sth = $dbh->prepare("select * from masterblocks order by cidr");
+  $sth->execute;
+  for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
+    $masterblocks[$i] = new NetAddr::IP $data[0];
+    $allocated{"$masterblocks[$i]"} = 0;
+    $free{"$masterblocks[$i]"} = 0;
+    $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
+					# Set to 128 to prepare for IPv6
+    $routed{"$masterblocks[$i]"} = 0;
+  }
+  return (undef,$sth->errstr) if $sth->err;
+
+  return (1,"OK");
+} # end initIPDBGlobals
+
+
+## IPDB::connectDB()
 # Creates connection to IPDB.
-# Default is a PostgreSQL db;  could be any DBMS with the
-# right changes.  MySQL in comments.  Note that some DBMS's don't
-# support transactions, this is a Bad Thing!
+# Requires the database name, username, and password.
 # Returns a handle to the db.
+# Set up for a PostgreSQL db;  could be any transactional DBMS with the
+# right changes.
+# This definition should be sub connectDB($$$) to be technically correct,
+# but this breaks.  GRR.
 sub connectDB {
+  my ($dbname,$user,$pass) = @_;
   my $dbh;
-  my $DSN = "DBI:Pg:dbname=ipdb";
-  my $user = 'ipdb';
-  my $pw   = 'ipdbpwd';
+  my $DSN = "DBI:Pg:dbname=$dbname";
+#  my $user = 'ipdb';
+#  my $pw   = 'ipdbpwd';
 
 # Note that we want to autocommit by default, and we will turn it off locally as necessary.
-  $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
-    or return undef if(!$dbh);
-
-  return $dbh;
+# We may not want to print gobbledygook errors;  YMMV.  Have to ponder that further.
+  $dbh = DBI->connect($DSN, $user, $pass, {
+	AutoCommit => 1,
+	PrintError => 0
+	})
+    or return (undef, $DBI::errstr) if(!$dbh);
+
+# Return here if we can't select.  Note that this indicates a
+# problem executing the select.
+  my $sth = $dbh->prepare('select cidr from masterblocks');
+  $sth->execute();
+  return (undef,$DBI::errstr) if ($sth->err);
+
+# See if the select returned anything (or null data).  This should
+# succeed if the select executed, but...
+  $sth->fetchrow();
+  return (undef,$DBI::errstr)  if ($sth->err);
+
+# If we get here, we should be OK.
+  return ($dbh,"DB connection OK");
 } # end connectDB
 
+
+## IPDB::finish()
+# Cleans up after database handles and so on.
+# Requires a database handle
+sub finish {
+  my $dbh = $_[0];
+  $dbh->disconnect;
+} # end finish
+
+
+## IPDB::checkDBSanity()
 # Quick check to see if the db is responding.  A full integrity
 # check will have to be a separate tool to walk the IP allocation trees.
 sub checkDBSanity {
-  my $dbh = connectDB();
+  my ($dbh) = $_[0];
 
   if (!$dbh) {
-    print "Cannot connect to the database!";
+    print "No database handle, or connection has been closed.";
+    return -1;
   } else {
     # it connects, try a stmt.
@@ -62,18 +162,379 @@
     } else {
       print "Connected to the database, but could not execute test statement.  ".$sth->errstr();
+      return -1;
     }
   }
   # Clean up after ourselves.
-  $dbh->disconnect;
+#  $dbh->disconnect;
 } # end checkDBSanity
 
 
-# allocateBlock()
+## IPDB::allocateBlock()
 # Does all of the magic of actually allocating a netblock
-sub allocateBlock($) {
-}
-
-
-# mailNotify()
+# Requires database handle, block to allocate, custid, type, city,
+#	description, notes, circuit ID, block to allocate from, 
+# Returns a success code and optional error message.
+sub allocateBlock {
+  my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid) = @_;
+  
+  my $cidr = new NetAddr::IP $_[1];
+  my $alloc_from = new NetAddr::IP $_[2];
+  my $sth;
+
+  # To contain the error message, if any.
+  my $msg = "Unknown error allocating $cidr as '$type'";
+
+  # Enable transactions and error handling
+  local $dbh->{AutoCommit} = 0;	# These need to be local so we don't
+  local $dbh->{RaiseError} = 1;	# step on our toes by accident.
+
+  if ($type =~ /^[cdsmw]i$/) {
+    $msg = "Unable to assign static IP $cidr to $custid";
+    eval {
+      # We'll just have to put up with the oddities caused by SQL (un)sort order
+      $sth = $dbh->prepare("select * from poolips where pool='$alloc_from'".
+	" and available='y' order by ip");
+      $sth->execute;
+
+# 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);
+##err Need better handling here;  what if there's no free IPs when this sub gets called?
+      my @data = $sth->fetchrow_array;
+      my $cidr = $data[1];
+
+      $sth = $dbh->prepare("update poolips set custid='$custid',".
+	"city='$city',available='n',description='$desc',notes='$notes',".
+	"circuitid='$circid'".
+	" where ip='$cidr'");
+      $sth->execute;
+      $dbh->commit;
+    };
+    if ($@) {
+      $msg .= ": '".$sth->errstr."'";
+      eval { $dbh->rollback; };
+      return ('FAIL',$msg);
+    } else {
+      return ('OK',"$cidr");
+    }
+
+  } else { # end IP-from-pool allocation
+
+    if ($cidr == $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
+      # delete from freeblocks where cidr='cidr'
+      # For data safety on non-transaction DBs, we delete first.
+
+      eval {
+	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
+	if ($type eq 'rr') {
+	  $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
+	    " where cidr='$cidr'");
+	  $sth->execute;
+	  $sth = $dbh->prepare("insert into routed values ('$cidr',".
+	    $cidr->masklen.",'$city')");
+	  $sth->execute;
+	} else {
+	  # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
+	  $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
+	  $sth->execute;
+
+	  $sth = $dbh->prepare("insert into allocations values ('$cidr',".
+		"'$custid','$type','$city','$desc','$notes',".
+		$cidr->masklen.",'$circid')");
+	  $sth->execute;
+
+	  # And initialize the pool, if necessary
+	  if ($type =~ /^.p$/) {
+	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} pool $cidr";
+	    initPool($dbh,$cidr,$type,$city,($type eq 'dp' ? "all" : "normal"));
+	  }
+
+	} # routing vs non-routing netblock
+
+	$dbh->commit;
+      }; # end of eval
+      if ($@) {
+	$msg = $@;
+	eval { $dbh->rollback; };
+	return ('FAIL',$@);
+      } else {
+	return ('OK',"OK");
+      }
+
+    } else { # cidr != alloc_from
+
+      # Hard case.  Allocation is smaller than free block.
+      my $wantmaskbits = $cidr->masklen;
+      my $maskbits = $alloc_from->masklen;
+
+      my @newfreeblocks;	# Holds free blocks generated from splitting the source freeblock.
+
+      # This determines which blocks will be left "free" after allocation.  We take the
+      # block we're allocating from, and split it in half.  We see which half the wanted
+      # 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
+      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] );
+      } # while
+
+      # Begin SQL transaction block
+      eval {
+	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
+
+	# 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 'rr') {
+
+	  # Insert the new freeblocks entries
+	  # Note that non-routed blocks are assigned to <NULL>
+	  $sth = $dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
+	  foreach my $block (@newfreeblocks) {
+ 	    $sth->execute("$block", $block->masklen);
+	  }
+
+	  # Insert the entry in the routed table
+	  $sth = $dbh->prepare("insert into routed values ('$cidr',".
+	    $cidr->masklen.",'$city')");
+	  $sth->execute;
+	  # Insert the (almost) same entry in the freeblocks table
+	  $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".
+	    $cidr->masklen.",'$city','y')");
+	  $sth->execute;
+
+	} else { # done with alloctype == rr
+
+	  # Insert the new freeblocks entries
+	  $sth = $dbh->prepare("insert into freeblocks values (?, ?, ".
+		"(select city from routed where cidr >>= '$cidr'),'y')");
+	  foreach my $block (@newfreeblocks) {
+ 	    $sth->execute("$block", $block->masklen);
+	  }
+
+	  # Insert the allocations entry
+	  $sth = $dbh->prepare("insert into allocations values ('$cidr',".
+		"'$custid','$type','$city','$desc','$notes',".$cidr->masklen.
+		",'$circid')");
+	  $sth->execute;
+
+	  # And initialize the pool, if necessary
+	  if ($type =~ /^.p$/) {
+	    $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
+	    initPool($dbh,$cidr,$type,$city,($type eq 'dp' ? "all" : "normal"));
+	  }
+
+	} # done with netblock alloctype != rr
+
+        $dbh->commit;
+      }; # end eval
+      if ($@) {
+	eval { $dbh->rollback; };
+	return ('FAIL',$msg);
+      } else {
+	return ('OK',"OK");
+      }
+
+    } # end fullcidr != alloc_from
+
+  } # end static-IP vs netblock allocation
+
+} # end allocateBlock()
+
+
+## IPDB::initPool()
+# Initializes a pool
+# Requires a database handle, the pool CIDR, type, city, and a parameter
+# indicating whether the pool should allow allocation of literally every
+# IP, or if it should reserve network/gateway/broadcast IPs
+# Note that this is NOT done in a transaction, that's why it's a private
+# function and should ONLY EVER get called from allocateBlock()
+sub initPool {
+  my ($dbh,undef,$type,$city,$class) = @_;
+  my $pool = new NetAddr::IP $_[1];
+
+  my ($pooltype) = ($type =~ /^(.)p$/);
+  my $sth;
+
+  # have to insert all pool IPs into poolips table as "unallocated".
+  $sth = $dbh->prepare("insert into poolips values ('$pool',".
+	" ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
+  my @poolip_list = $pool->hostenum;
+  if ($class eq 'all') { # (DSL-ish block - *all* IPs available
+    $sth->execute($pool->addr);
+    for (my $i=0; $i<=$#poolip_list; $i++) {
+      $sth->execute($poolip_list[$i]->addr);
+    }
+    $pool--;
+    $sth->execute($pool->addr);
+  } else { # (real netblock)
+    for (my $i=1; $i<=$#poolip_list; $i++) {
+      $sth->execute($poolip_list[$i]->addr);
+    }
+  }
+} # end initPool()
+
+
+## IPDB::deleteBlock()
+# Removes an allocation from the database, including deleting IPs
+# from poolips and recombining entries in freeblocks if possible
+# Also handles "deleting" a static IP allocation, and removal of a master
+# Requires a database handle, the block to delete, and the type of block
+sub deleteBlock {
+  my ($dbh,undef,$type) = @_;
+  my $cidr = new NetAddr::IP $_[1];
+
+  my $sth;
+
+  # To contain the error message, if any.
+  my $msg = "Unknown error deallocating $type $cidr";
+  # Enable transactions and exception-on-errors... but only for this sub
+  local $dbh->{AutoCommit} = 0;
+  local $dbh->{RaiseError} = 1;
+
+  # First case.  The "block" is a static IP
+  # Note that we still need some additional code in the odd case
+  # of a netblock-aligned contiguous group of static IPs
+  if ($type =~ /^.i$/) {
+
+    eval {
+      $msg = "Unable to deallocate $type $cidr";
+      $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
+	"city=(select city from allocations where cidr >>= '$cidr'),".
+	"description='',notes='',circuitid='' where ip='$cidr'");
+      $sth->execute;
+      $dbh->commit;
+    };
+    if ($@) {
+      eval { $dbh->rollback; };
+      return ('FAIL',$msg);
+    } else {
+      return ('OK',"OK");
+    }
+
+  } elsif ($type eq 'mm') { # end alloctype =~ /.i/
+
+    $msg = "Unable to delete master block $cidr";
+    eval {
+      $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
+      $sth->execute;
+      $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
+      $sth->execute;
+      $dbh->commit;
+    };
+    if ($@) {
+      eval { $dbh->rollback; };
+      return ('FAIL', $msg);
+    } else {
+      return ('OK',"OK");
+    }
+
+  } else { # end alloctype master block case
+
+    ## This is a big block; but it HAS to be done in a chunk.  Any removal
+    ## of a netblock allocation may result in a larger chunk of free
+    ## contiguous IP space - which may in turn be combined into a single
+    ## netblock rather than a number of smaller netblocks.
+
+    eval {
+
+      if ($type eq 'rr') {
+        $msg = "Unable to remove routing allocation $cidr";
+	$sth = $dbh->prepare("delete from routed where cidr='$cidr'");
+	$sth->execute;
+	# Make sure block getting deleted is properly accounted for.
+	$sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
+		" where cidr='$cidr'");
+	$sth->execute;
+	# Set up query to start compacting free blocks.
+	$sth = $dbh->prepare("select * from freeblocks where ".
+		"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
+
+      } else { # end alloctype routing case
+
+	$sth = $dbh->prepare("delete from allocations where cidr='$cidr'");
+	$sth->execute;
+	# Special case - delete pool IPs
+	if ($type =~ /^.p$/) {
+	  # We have to delete the IPs from the pool listing.
+	  $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
+	  $sth->execute;
+	}
+
+	# Set up query for compacting free blocks.
+	$sth = $dbh->prepare("select * from freeblocks where cidr <<= ".
+		"(select cidr from routed where cidr >>= '$cidr') ".
+		" and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
+
+      } # end alloctype general case
+
+      # Now we look for larger-or-equal-sized free blocks in the same master (routed)
+      # (super)block. If there aren't any, we can't combine blocks anyway.  If there
+      # are, we check to see if we can combine blocks.
+      # Execute the statement prepared in the if-else above.
+
+      $sth->execute;
+
+# NetAddr::IP->compact() attempts to produce the smallest inclusive block
+# from the caller and the passed terms.
+# EG:  if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
+#	and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
+#	.64-.95, and .96-.128), you will get an array containing a single
+#	/25 as element 0 (.0-.127).  Order is not important;  you could have
+#	$cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
+
+      my (@together, @combinelist);
+      my $i=0;
+      while (my @data = $sth->fetchrow_array) {
+	my $testIP = new NetAddr::IP $data[0];
+	@together = $testIP->compact($cidr);
+	my $num = @together;
+	if ($num == 1) {
+	  $cidr = $together[0];
+	  $combinelist[$i++] = $testIP;
+	}
+      }
+
+      # Clear old freeblocks entries - if any.  $i==0 if not.
+      if ($i>0) {
+	$sth = $dbh->prepare("delete from freeblocks where cidr=?");
+	foreach my $block (@combinelist) {
+	  $sth->execute("$block");
+	}
+      }
+
+      # insert "new" freeblocks entry
+      if ($type eq 'rr') {
+	$sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+		",'<NULL>','n')");
+      } else {
+	$sth = $dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+		",(select city from routed where cidr >>= '$cidr'),'y')");
+      }
+      $sth->execute;
+
+      # If we got here, we've succeeded.  Whew!
+      $dbh->commit;
+    }; # end eval
+    if ($@) {
+      eval { $dbh->rollback; };
+      return ('FAIL', $msg);
+    } else {
+      return ('OK',"OK");
+    }
+
+  } # end alloctype != netblock
+
+} # end deleteBlock()
+
+
+## IPDB::mailNotify()
 # Sends notification mail to recipients regarding an IPDB operation
 sub mailNotify ($$$) {
@@ -84,5 +545,4 @@
   $mailer->to($recip);
   $mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
-	"To: $recip\n",
 	"Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
 	"Subject: {IPDB} $subj\n",
Index: branches/stable/cgi-bin/consistency-check.pl
===================================================================
--- branches/stable/cgi-bin/consistency-check.pl	(revision 124)
+++ branches/stable/cgi-bin/consistency-check.pl	(revision 125)
@@ -10,8 +10,8 @@
 
 use DBI;
-use IPDB qw(:ALL);
+use IPDB 2.0 qw(:ALL);
 use NetAddr::IP;
 
-$dbh = connectDB;
+($dbh,$errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
 
 # Schlep up the masters
Index: branches/stable/cgi-bin/freespace.pl
===================================================================
--- branches/stable/cgi-bin/freespace.pl	(revision 124)
+++ branches/stable/cgi-bin/freespace.pl	(revision 125)
@@ -8,10 +8,11 @@
 # Last update by $Author$
 ###
+# Copyright (C) 2004 - Kris Deugau
 
 use DBI;
-use IPDB qw(:ALL);
+use IPDB 2.0 qw(:ALL);
 use NetAddr::IP;
 
-$dbh = connectDB;
+($dbh,errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
 
 print "Content-type: text/plain\n\n";
Index: branches/stable/cgi-bin/main.cgi
===================================================================
--- branches/stable/cgi-bin/main.cgi	(revision 124)
+++ branches/stable/cgi-bin/main.cgi	(revision 125)
@@ -14,5 +14,5 @@
 use DBI;
 use CommonWeb qw(:ALL);
-use IPDB qw(:ALL);
+use IPDB 2.0 qw(:ALL);
 use CustIDCK;
 use POSIX qw(ceil);
@@ -33,5 +33,15 @@
 syslog "debug", "$authuser active";
 
-checkDBSanity();
+# Why not a global DB handle?  (And a global statement handle, as well...)
+# Use the connectDB function, otherwise we end up confusing ourselves
+my $ip_dbh;
+my $sth;
+my $errstr;
+($ip_dbh,$errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
+if (!$ip_dbh) {
+  printAndExit("Failed to connect to database: $errstr\n");
+}
+checkDBSanity($ip_dbh);
+initIPDBGlobals($ip_dbh);
 
 #prototypes
@@ -48,54 +58,24 @@
 
 # Stuff that gets loaded from the database
-my @masterblocks;
-my @citylist;
-my @poplist;
-my %disp_alloctypes;
-my %list_alloctypes;
-my %allocated;	# Count for allocated blocks in a master block
-my %free;	# Count for free blocks (routed and unrouted) in a master block
-my %bigfree;	# Tracking largest free block in a master block
-my %routed;	# Number of routed blocks in a master block
-
-# Why not a global DB handle?  (And a global statement handle, as well...)
-# We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
-# Use the connectDB function, otherwise we end up confusing ourselves
-my $ip_dbh = connectDB;
-my $sth;
+#my @citylist;
+#my @poplist;
+#my %allocated;	# Count for allocated blocks in a master block
+#my %free;	# Count for free blocks (routed and unrouted) in a master block
+#my %bigfree;	# Tracking largest free block in a master block
+#my %routed;	# Number of routed blocks in a master block
 
 # Slurp up the master block list - we need this several places
 # While we're at it, initialize the related hashes.
-$sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
-$sth->execute;
-for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
-  $masterblocks[$i] = new NetAddr::IP $data[0];
-  $allocated{"$masterblocks[$i]"} = 0;
-  $free{"$masterblocks[$i]"} = 0;
-  $bigfree{"$masterblocks[$i]"} = 128;	# Larger number means smaller block.
-					# Set to 128 to prepare for IPv6
-  $routed{"$masterblocks[$i]"} = 0;
-}
-
-# Initialize the city and poplist arrays
-$sth = $ip_dbh->prepare("select * from cities order by city");
-$sth->execute;
-my $i = 0;
-my $j = 0;
-while (my @data = $sth->fetchrow_array) {
-  $citylist[$i++] = $data[0];
-  if ($data[1] eq 'y') {
-    $poplist[$j++] = $data[0];
-  }
-}
-
-# Initialize alloctypes hashes
-$sth = $ip_dbh->prepare("select * from alloctypes order by listorder");
-$sth->execute;
-while (my @data = $sth->fetchrow_array) {
-  $disp_alloctypes{$data[0]} = $data[2];
-  if ($data[3] < 900) {
-    $list_alloctypes{$data[0]} = $data[1];
-  }
-}
+#$sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
+#$sth->execute;
+#for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
+#  $masterblocks[$i] = new NetAddr::IP $data[0];
+#  $allocated{"$masterblocks[$i]"} = 0;
+#  $free{"$masterblocks[$i]"} = 0;
+#  $bigfree{"$masterblocks[$i]"} = 128;	# Larger number means smaller block.
+#					# Set to 128 to prepare for IPv6
+#  $routed{"$masterblocks[$i]"} = 0;
+#}
+
 
 
@@ -114,5 +94,5 @@
   my $cidr = new NetAddr::IP $webvar{cidr};
 
-  print "<div type=heading align=center>Adding $cidr as master block....\n";
+  print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
 
   # Allow transactions, and raise an exception on errors so we can catch it later.
@@ -142,10 +122,10 @@
     eval { $ip_dbh->rollback; };
     syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
-    printAndExit("Could not add master block $webvar{cidr} to database: $@");
-  }
-
-  print "Success!</div>\n";
-
-  printFooter;
+    printError("Could not add master block $webvar{cidr} to database: $@");
+  } else {
+    print "<div type=heading align=center>Success!</div>\n";
+    syslog "info", "$authuser added master block $webvar{cidr}";
+  }
+
 } # end add new master
 
@@ -169,5 +149,4 @@
     viewBy($webvar{searchfor}, $webvar{input});
   }
-  printFooter();
 }
 
@@ -208,12 +187,16 @@
   printAndExit("Error $boing:  ".$excuses[$rnd/30.0]);
 }
-
-
-#end main()
-
-# Shut up error log warning about not disconnecting.  Maybe.
-$ip_dbh->disconnect;
-# Just in case something waaaayyy down isn't in place properly...
-exit 0;
+## Finally! Done with that NASTY "case" emulation!
+
+
+
+# Clean up IPDB globals, DB handle, etc.
+finish($ip_dbh);
+# We print the footer here, so we don't have to do it elsewhere.
+printFooter;
+# Just in case something waaaayyy down isn't in place
+# properly... we exit explicitly.
+exit;
+
 
 
@@ -314,9 +297,9 @@
     } else {
       # This shouldn't happen, but if it does, whoever gets it deserves what they get...
-      printAndExit("Invalid query.");
+      printError("Invalid query.");
     }
   } else {
     # This shouldn't happen, but if it does, whoever gets it deserves what they get...
-    printAndExit("Invalid searchfor.");
+    printError("Invalid searchfor.");
   }
 } # viewBy
@@ -425,6 +408,6 @@
 
 # Initial display:  Show master blocks with total allocated subnets, total free subnets
-sub showSummary
-{
+sub showSummary {
+  # this is horrible-ugly-bad and will Go Away real soon now(TM)
   print "Content-type: text/html\n\n";
 
@@ -432,49 +415,42 @@
 	'Free netblocks', 'Largest free block');
 
-# Snag the allocations.
-# I think it's too confusing to leave out internal allocations.
-  $sth = $ip_dbh->prepare("select * from allocations");
-  $sth->execute();
-  while (my @data = $sth->fetchrow_array()) {
-    # cidr,custid,type,city,description
-    # We only need the cidr
-    my $cidr = new NetAddr::IP $data[0];
-    foreach my $master (@masterblocks) {
-      if ($master->contains($cidr)) {
-	$allocated{"$master"}++;
-      }
-    }
-  }
-
-# Snag routed blocks
-  $sth = $ip_dbh->prepare("select * from routed");
-  $sth->execute();
-  while (my @data = $sth->fetchrow_array()) {
-    # cidr,maskbits,city
-    # We only need the cidr
-    my $cidr = new NetAddr::IP $data[0];
-    foreach my $master (@masterblocks) {
-      if ($master->contains($cidr)) {
-	$routed{"$master"}++;
-      }
-    }
-  }
-
-# Snag the free blocks.
-  $sth = $ip_dbh->prepare("select * from freeblocks");
-  $sth->execute();
-  while (my @data = $sth->fetchrow_array()) {
-    # cidr,maskbits,city
-    # We only need the cidr
-    my $cidr = new NetAddr::IP $data[0];
-    foreach my $master (@masterblocks) {
-      if ($master->contains($cidr)) {
-	$free{"$master"}++;
-	if ($cidr->masklen < $bigfree{"$master"}) { $bigfree{"$master"} = $cidr->masklen; }
-      }
-    }
-  }
-
-# Print the data.
+  my %allocated;
+  my %free;
+  my %routed;
+  my %bigfree;
+
+  # Count the allocations.
+  $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
+  foreach my $master (@masterblocks) {
+    $sth->execute("$master");
+    $sth->bind_columns(\$allocated{"$master"});
+    $sth->fetch();
+  }
+
+  # Count routed blocks
+  $sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
+  foreach my $master (@masterblocks) {
+    $sth->execute("$master");
+    $sth->bind_columns(\$routed{"$master"});
+    $sth->fetch();
+  }
+
+  # Count the free blocks.
+  $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
+  foreach my $master (@masterblocks) {
+    $sth->execute("$master");
+    $sth->bind_columns(\$free{"$master"});
+    $sth->fetch();
+  }
+
+  # Find the largest free block in each master
+  $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
+  foreach my $master (@masterblocks) {
+    $sth->execute("$master");
+    $sth->bind_columns(\$bigfree{"$master"});
+    $sth->fetch();
+  }
+
+  # Print the data.
   my $count=0;
   foreach my $master (@masterblocks) {
@@ -492,8 +468,4 @@
   print "Note:  Free blocks noted here include both routed and unrouted blocks.\n";
 
-  # Because of the way this sub gets called, we don't need to print the footer here.
-  # (index.shtml makes an SSI #include call to cgi-bin/main.cgi?action=index)
-  # If we do, the footer comes in twice...
-  #printFooter;
 } # showSummary
 
@@ -510,8 +482,14 @@
 	qq($webvar{block}:</div></center><br>\n);
 
+  my %allocated;
+  my %free;
+  my %routed;
+  my %bigfree;
+
   my $master = new NetAddr::IP $webvar{block};
   my @localmasters;
 
-  $sth = $ip_dbh->prepare("select * from routed order by cidr");
+  # Fetch only the blocks relevant to this master
+  $sth = $ip_dbh->prepare("select * from routed where cidr <<= '$master' order by cidr");
   $sth->execute();
 
@@ -519,53 +497,39 @@
   while (my @data = $sth->fetchrow_array()) {
     my $cidr = new NetAddr::IP $data[0];
-    if ($master->contains($cidr)) {
-      $localmasters[$i++] = $cidr;
-      $free{"$cidr"} = 0;
-      $allocated{"$cidr"} = 0;
+    $localmasters[$i++] = $cidr;
+    $free{"$cidr"} = 0;
+    $allocated{"$cidr"} = 0;
+    $bigfree{"$cidr"} = 128;
     # Retain the routing destination
-      $routed{"$cidr"} = $data[2];
-    }
-  }
-
-# Check if there were actually any blocks routed from this master
+    $routed{"$cidr"} = $data[2];
+  }
+
+  # Check if there were actually any blocks routed from this master
   if ($i > 0) {
     startTable('Routed block','Routed to','Allocated blocks',
 	'Free blocks','Largest free block');
 
-  # Count the allocations
-    $sth = $ip_dbh->prepare("select * from allocations");
-    $sth->execute();
-    while (my @data = $sth->fetchrow_array()) {
-      # cidr,custid,type,city,description
-      # We only need the cidr
-      my $cidr = new NetAddr::IP $data[0];
-      foreach my $master (@localmasters) {
-	if ($master->contains($cidr)) {
-	  $allocated{"$master"}++;
-	}
-      }
-    }
-
-    # initialize bigfree base points
-    foreach my $lmaster (@localmasters) {
-      $bigfree{"$lmaster"} = 128;
-    }
-
-    # Snag the free blocks.
-    $sth = $ip_dbh->prepare("select * from freeblocks");
-    $sth->execute();
-    while (my @data = $sth->fetchrow_array()) {
-      # cidr,maskbits,city
-      # We only need the cidr
-      my $cidr = new NetAddr::IP $data[0];
-      foreach my $lmaster (@localmasters) {
-	if ($lmaster->contains($cidr)) {
-	  $free{"$lmaster"}++;
-	  if ($cidr->masklen < $bigfree{"$lmaster"}) {
-	    $bigfree{"$lmaster"} = $cidr->masklen;
-          }
-	}
-	# check for largest free block
-      }
+    # Count the allocations
+    $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
+    foreach my $master (@localmasters) {
+      $sth->execute("$master");
+      $sth->bind_columns(\$allocated{"$master"});
+      $sth->fetch();
+    }
+
+    # Count the free blocks.
+    $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
+    foreach my $master (@localmasters) {
+      $sth->execute("$master");
+      $sth->bind_columns(\$free{"$master"});
+      $sth->fetch();
+    }
+
+    # Get the size of the largest free block
+    $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
+    foreach my $master (@localmasters) {
+      $sth->execute("$master");
+      $sth->bind_columns(\$bigfree{"$master"});
+      $sth->fetch();
     }
 
@@ -603,20 +567,16 @@
   # Snag the free blocks.
   my $count = 0;
-  $sth = $ip_dbh->prepare("select * from freeblocks where routed='n' order by cidr");
+  $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
+	"routed='n' order by cidr");
   $sth->execute();
   while (my @data = $sth->fetchrow_array()) {
-    # cidr,maskbits,city
-    # We only need the cidr
     my $cidr = new NetAddr::IP $data[0];
-    if ($master->contains($cidr)) {
-      my @row = ("$cidr", $cidr->range);
-      printRow(\@row, 'color1' ) if($count%2==0);
-      printRow(\@row, 'color2' ) if($count%2!=0);
-      $count++;
-    }
+    my @row = ("$cidr", $cidr->range);
+    printRow(\@row, 'color1' ) if($count%2==0);
+    printRow(\@row, 'color2' ) if($count%2!=0);
+    $count++;
   }
 
   print "</table>\n";
-  printFooter;
 } # showMaster
 
@@ -641,14 +601,14 @@
 	qq($master ($data[2]):</div></center><br>\n);
 
-  $sth = $ip_dbh->prepare("select * from allocations order by cidr");
+  startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
+
+  # Snag the allocations for this block
+  $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$master' order by cidr");
   $sth->execute();
-
-  startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
 
   my $count=0;
   while (my @data = $sth->fetchrow_array()) {
-    # cidr,custid,type,city,description,notes,maskbits
+    # cidr,custid,type,city,description,notes,maskbits,circuitid
     my $cidr = new NetAddr::IP $data[0];
-    if (!$master->contains($cidr)) { next; }
 
     # Clean up extra spaces that are borking things.
@@ -691,20 +651,17 @@
   # unrouted free blocks, but it's better to let the database do the work if we can.
   $count = 0;
-  $sth = $ip_dbh->prepare("select * from freeblocks where routed='y' order by cidr");
+  $sth = $ip_dbh->prepare("select * from freeblocks where routed='y' and cidr <<= '$master' order by cidr");
   $sth->execute();
   while (my @data = $sth->fetchrow_array()) {
     # cidr,maskbits,city
     my $cidr = new NetAddr::IP $data[0];
-    if ($master->contains($cidr)) {
-      my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=assign&block=$cidr\">$cidr</a>",
+    my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=assign&block=$cidr\">$cidr</a>",
 	$cidr->range);
-      printRow(\@row, 'color1') if ($count%2 == 0);
-      printRow(\@row, 'color2') if ($count%2 != 0);
-      $count++;
-    }
+    printRow(\@row, 'color1') if ($count%2 == 0);
+    printRow(\@row, 'color2') if ($count%2 != 0);
+    $count++;
   }
 
   print "</table>\n";
-  printFooter;
 } # showRBlock
 
@@ -762,9 +719,9 @@
   print "</table>\n";
 
-  printFooter;
 } # end listPool
 
 
-# Should this maybe just be a full static page?  It just spews out some predefined HTML.
+# Show "Add new allocation" page.  Note that the actual page may
+# be one of two templates, and the lists come from the database.
 sub assignBlock {
   printHeader('');
@@ -824,5 +781,4 @@
   print $html;
 
-  printFooter();
 } # assignBlock
 
@@ -837,10 +793,5 @@
   # Going to manually validate some items.
   # custid and city are automagic.
-  validateInput();
-
-# This isn't always useful.
-#  if (!$webvar{maskbits}) {
-#    printAndExit("Please enter a CIDR block length.");
-#  }
+  return if !validateInput();
 
 # Several different cases here.
@@ -860,6 +811,4 @@
 	" ptype='$base' and (city='Sudbury' or city='North Bay')";
     } else {
-## $city doesn't seem to get defined here.
-my $city;	# Shut up Perl's "strict" scoping/usage check.
       $sql = "select * from poolips where available='y' and".
 	" ptype='$base' and city='$webvar{pop}'";
@@ -891,5 +840,6 @@
 
       if (!$webvar{maskbits}) {
-        printAndExit("Please specify a CIDR mask length.");
+        printError("Please specify a CIDR mask length.");
+	return;
       }
       my $sql;
@@ -908,10 +858,14 @@
 	  " a set of smaller netblocks or a single smaller netblock.";
       } else {
+##fixme
+# This section needs serious Pondering.
 	if ($webvar{alloctype} =~ /^[cdsmw]p$/) {
 	  if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
-	    printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
+	    printError("You must chose Sudbury or North Bay for DSL pools.");
+	    return;
+	  }
 	  $city = $webvar{city};
 	  $failmsg = "No suitable free block found.<br>\nYou will have to route another".
-	    " superblock <br>\nfrom one of the master blocks in Sudbury or chose a smaller".
+	    " superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
 	    " block size for the pool.";
 	} else {
@@ -933,5 +887,6 @@
       my @data = $sth->fetchrow_array();
       if ($data[0] eq "") {
-	printAndExit($failmsg);
+	printError($failmsg);
+	return;
       }
       $cidr = new NetAddr::IP $data[0];
@@ -982,5 +937,4 @@
   print $html;
 
-  printFooter;
 } # end confirmAssign
 
@@ -990,202 +944,34 @@
   # Some things are done more than once.
   printHeader('');
-  validateInput();
-
-  # Set some things that may be needed
-  # Don't set $cidr here as it may not even be a valid IP address.
-  my $alloc_from = new NetAddr::IP $webvar{alloc_from};
-
-# dynDSL (dy), sIP DSL(dp), and server pools (sp) are nominally allocated to Sudbury
-# no matter what else happens.
-#  if ($webvar{alloctype} =~ /^([sd]p|dy)$/) { $webvar{city} = "Sudbury"; }
-# OOPS.  forgot about North Bay DSL.
-#### Gotta make this cleaner and more accurate
-#  if ($webvar{alloctype} eq "sp") { $webvar{city} = "Sudbury"; }
-
-# Same ordering as confirmation page
-
-  if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
-    my ($base,$tmp) = split //, $webvar{alloctype};	# split into individual chars
-
-    # We'll just have to put up with the oddities caused by SQL (un)sort order
-    $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{alloc_from}'".
-	" and available='y' order by ip");
-    $sth->execute;
-
-    my @data = $sth->fetchrow_array;
-    my $cidr = $data[1];
-
-    $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',".
-	"city='$webvar{city}',available='n',description='$webvar{desc}',".
-	"circuitid='$webvar{circid}'".
-	" where ip='$cidr'");
-    $sth->execute;
-    if ($sth->err) {
-      syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser failed: ".
-	"'".$sth->errstr."'";
-      printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
-    }
-    print qq(<div class="center"><div class="heading">The IP $cidr has been allocated to customer $webvar{custid}</div></div>);
-    syslog "notice", "$authuser allocated $cidr to $webvar{custid}";
-# Notify tech@example.com
-    mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
-	"$disp_alloctypes{$webvar{alloctype}} $cidr allocated to customer $webvar{custid}\n".
-	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
-
-  } else { # end IP-from-pool allocation
-
-    # Set $cidr here as it may not be a valid IP address elsewhere.
-    my $cidr = new NetAddr::IP $webvar{fullcidr};
-
-# Allow transactions, and make errors much easier to catch.
-# Much as I would like to error-track specifically on each ->execute,
-# that's a LOT of code, and some SQL blocks MUST be atomic at a
-# multi-statement level.  :/
-    local $ip_dbh->{AutoCommit} = 0;	# These need to be local so we don't
-    local $ip_dbh->{RaiseError} = 1;	# step on our toes by accident.
-
-    if ($webvar{fullcidr} eq $webvar{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
-      # delete from freeblocks where cidr='cidr'
-      # For data safety on non-transaction DBs, we delete first.
-
-      eval {
-	if ($webvar{alloctype} eq 'rr') {
-	  $sth = $ip_dbh->prepare("update freeblocks set routed='y',city='$webvar{city}'".
-	    " where cidr='$webvar{fullcidr}'");
-	  $sth->execute;
-	  $sth = $ip_dbh->prepare("insert into routed values ('$webvar{fullcidr}',".
-	    $cidr->masklen.",'$webvar{city}')");
-	  $sth->execute;
-	} else {
-	  # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
-
-	  # city has to be reset for DSL/server pools;  nominally to Sudbury.
-	  ## Gotta rethink this;  DSL pools can be in North Bay as well.  :/
-	  #if ($webvar{alloctype} =~ /^[sd]p$/) { $webvar{city} = 'Sudbury'; }
-
-	  $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{fullcidr}'");
-	  $sth->execute;
-
-	  $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
-	    "'$webvar{custid}','$webvar{alloctype}','$webvar{city}','$webvar{desc}',".
-	    "'$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
-	  $sth->execute;
-	} # routing vs non-routing netblock
-	$ip_dbh->commit;
-      };  # end of eval
-      if ($@) {
-	carp "Transaction aborted because $@";
-	eval { $ip_dbh->rollback; };
-	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
-		"'$webvar{alloctype}' by $authuser failed: '$@'";
-	printAndExit("Allocation of $cidr as $disp_alloctypes{$webvar{alloctype}} failed.\n");
-      }
-
-      # If we get here, the DB transaction has succeeded.
-      syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
-
-# How to log SQL without munging too many error-checking wrappers in?
-#      syslog "info", "
-# We don't.  GRRR.
-
-    } else { # webvar{fullcidr} != webvar{alloc_from}
-      # Hard case.  Allocation is smaller than free block.
-      my $wantmaskbits = $cidr->masklen;
-      my $maskbits = $alloc_from->masklen;
-
-      my @newfreeblocks;	# Holds free blocks generated from splitting the source freeblock.
-
-      my $i=0;
-      while ($maskbits++ < $wantmaskbits) {
-	my @subblocks = $alloc_from->split($maskbits);
-	$newfreeblocks[$i++] = $subblocks[1];
-      } # while
-
-      # Begin SQL transaction block
-      eval {
-	# Delete old freeblocks entry
-	$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{alloc_from}'");
-	$sth->execute();
-
-	# now we have to do some magic for routing blocks
-	if ($webvar{alloctype} eq 'rr') {
-	  # Insert the new freeblocks entries
-	  # Note that non-routed blocks are assigned to <NULL>
-	  $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
-	  foreach my $block (@newfreeblocks) {
- 	    $sth->execute("$block", $block->masklen);
-	  }
-	  # Insert the entry in the routed table
-	  $sth = $ip_dbh->prepare("insert into routed values ('$cidr',".
-	    $cidr->masklen.",'$webvar{city}')");
-	  $sth->execute;
-	  # Insert the (almost) same entry in the freeblocks table
-	  $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".
-	    $cidr->masklen.",'$webvar{city}','y')");
-	  $sth->execute;
-
-	} else { # done with alloctype == rr
-
-	  # Insert the new freeblocks entries
-	  $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, (select city from routed where cidr >> '$cidr'),'y')");
-	  foreach my $block (@newfreeblocks) {
- 	    $sth->execute("$block", $block->masklen);
-	  }
-	  # Insert the allocations entry
-	  $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
-	    "'$webvar{custid}','$webvar{alloctype}','$webvar{city}',".
-	    "'$webvar{desc}','$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
-	  $sth->execute;
-	} # done with netblock alloctype != rr
-        $ip_dbh->commit;
-      }; # end eval
-      if ($@) {
-	carp "Transaction aborted because $@";
-	eval { $ip_dbh->rollback; };
-        syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
-                "'$webvar{alloctype}' by $authuser failed: '$@'";
-        printAndExit("Allocation of $cidr as $disp_alloctypes{$webvar{alloctype}} failed.\n");
-      }
-      syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
-
-    } # end fullcidr != alloc_from
-
-    # Begin SQL transaction block
-    eval {
-      # special extra handling for pools.
-      # Note that this must be done for ANY pool allocation!
-      if ( my ($pooltype) = ($webvar{alloctype} =~ /^([cdsmw])p$/) ) {
-	# have to insert all pool IPs into poolips table as "unallocated".
-	$sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
-	  " ?, '6750400', '$webvar{city}', '$pooltype', 'y', '', '', '')");
-	my @poolip_list = $cidr->hostenum;
-	for (my $i=1; $i<=$#poolip_list; $i++) {
-	  $sth->execute($poolip_list[$i]->addr);
-	}
-      } # end pool special
-      $ip_dbh->commit;
-    }; # end eval
-    if ($@) {
-      carp "Transaction aborted because $@";
-      eval { $ip_dbh->rollback; };
-      syslog "err", "Initialization of pool '$webvar{fullcidr}' by $authuser failed: '$@'";
-      printAndExit("$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} not completely initialized.");
-    }
-    syslog "notice", "$disp_alloctypes{$webvar{alloctype}} '$webvar{fullcidr}' successfully initialized by $authuser";
-
-    print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was sucessfully added as type '$webvar{alloctype}' ($disp_alloctypes{$webvar{alloctype}})</div></div>);
-
-    if ($webvar{alloctype} eq 'cn') {
+  return if !validateInput();
+
+  # $code is "success" vs "failure", $msg contains OK for a
+  # successful netblock allocation, the IP allocated for static
+  # IP, or the error message if an error occurred.
+  my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
+	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
+	$webvar{circid});
+
+  if ($code eq 'OK') {
+    if ($webvar{alloctype} =~ /^.i$/) {
+      print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
       # Notify tech@example.com
       mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
-	"$disp_alloctypes{$webvar{alloctype}} $cidr allocated to customer $webvar{custid}\n".
+	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
 	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
-    }
-
-  } # end static-IP vs netblock allocation
-
-  printFooter();
+    } else {
+      print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
+	"sucessfully added as type '$webvar{alloctype}' ".
+	"($disp_alloctypes{$webvar{alloctype}})</div></div>";
+    }
+    syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
+	"'$webvar{alloctype}'";
+  } else {
+    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
+	"'$webvar{alloctype}' by $authuser failed: '$msg'";
+    printError("Allocation of $webvar{fullcidr} as $disp_alloctypes{$webvar{alloctype}}".
+	" failed: $msg\n");
+  }
+
 } # end insertAssign()
 
@@ -1196,5 +982,6 @@
 sub validateInput {
   if ($webvar{city} eq '-') {
-    printAndExit("Please choose a city.");
+    printError("Please choose a city.");
+    return;
   }
   chomp $webvar{alloctype};
@@ -1202,5 +989,6 @@
   if ($webvar{alloctype} =~ /^(ci|di|cn|mi|wi)$/) {
     if (!$webvar{custid}) {
-      printAndExit("Please enter a customer ID.");
+      printError("Please enter a customer ID.");
+      return;
     }
     if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
@@ -1209,15 +997,19 @@
       # Crosscheck with ... er...  something.
       my $status = CustIDCK->custid_exist($webvar{custid});
-      printAndExit("Error verifying customer ID: ".$CustIDCK::ErrMsg)
-	if $CustIDCK::Error;
-      printAndExit("Customer ID not valid.  Make sure the Customer ID ".
-	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
-	"non-customer assignments.")
-	if !$status;
+      if ($CustIDCK::Error) {
+	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
+	return;
+      }
+      if (!$status) {
+	printError("Customer ID not valid.  Make sure the Customer ID ".
+	  "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
+	  "non-customer assignments.");
+	return;
+      }
 #"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
 #static IPs for staff.");
     }
 #    print "<!-- [ In validateInput().  Insert customer ID cross-check here. ] -->\n";
-  } elsif ($webvar{alloctype} =~ /^([cdsmw]p|si|dn|dy|dc|ee|rr|ii)$/){
+  } elsif ($webvar{alloctype} =~ /^([cdsmw]p|si|dn|dy|dc|ee|rr|in)$/){
     # All non-customer allocations MUST be entered with "our" customer ID.
     # I have Defined this as 6750400 for consistency.
@@ -1226,22 +1018,34 @@
       $webvar{custid} = "6750400";
     }
-    if ($webvar{alloctype} eq 'rr') {
-      my $flag;
-      foreach (@poplist) {
-        if (/^$webvar{city}$/) {
-	  $flag = 'y'; last;
-	}
-      }
-      if (!$flag) {
-	printAndExit("Please choose a valid POP location for a routed netblock.  Valid ".
-		"POP locations are currently:<br>\n".join (" - ", @poplist));
-      }
-    }
   } else {
     # Danger! Danger!  alloctype should ALWAYS be set by a dropdown.  Anyone
     # managing to call things in such a way as to cause this deserves a cryptic error.
-    printAndExit("Invalid alloctype");
-  }
-  return 0;
+    printError("Invalid alloctype");
+    return;
+  }
+
+  # Check POP location
+  my $flag;
+  if ($webvar{alloctype} eq 'rr') {
+    $flag = 'for a routed netblock';
+    foreach (@poplist) {
+      if (/^$webvar{city}$/) {
+	$flag = 'n';
+	last;
+      }
+    }
+  } else {
+    $flag = 'n';
+    if ($webvar{pop} =~ /^-$/) {
+      $flag = 'to route the block from/through';
+    }
+  }
+  if ($flag ne 'n') {
+    printError("Please choose a valid POP location $flag.  Valid ".
+	"POP locations are currently:<br>\n".join (" - ", @poplist));
+    return;
+  }
+
+  return 'OK';
 } # end validateInput
 
@@ -1318,5 +1122,4 @@
   print $html;
 
-  printFooter();
 } # edit()
 
@@ -1352,5 +1155,6 @@
     eval { $ip_dbh->rollback; };
     syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
-    printAndExit("Could not update block/IP $webvar{block}: $@");
+    printError("Could not update block/IP $webvar{block}: $@");
+    return;
   }
 
@@ -1358,5 +1162,5 @@
   syslog "notice", "$authuser updated $webvar{block}";
   open (HTML, "../updated.html")
-        or croak "Could not open updated.html :$!";
+	or croak "Could not open updated.html :$!";
   my $html = join('', <HTML>);
 
@@ -1376,11 +1180,9 @@
   print $html;
 
-  printFooter;
 } # update()
 
 
 # Delete an allocation.
-sub remove
-{
+sub remove {
   printHeader('');
   #show confirm screen.
@@ -1392,5 +1194,6 @@
   # Serves'em right for getting here...
   if (!defined($webvar{block})) {
-    printAndExit("Error 332");
+    printError("Error 332");
+    return;
   }
 
@@ -1466,5 +1269,4 @@
 
   print $html;
-  printFooter;
 } # end edit()
 
@@ -1477,172 +1279,19 @@
   printHeader('');
 
-  # Enable transactions and exception-on-errors... but only for this sub
-  local $ip_dbh->{AutoCommit} = 0;
-  local $ip_dbh->{RaiseError} = 1;
-
-  if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
-
-    eval {
-      $sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
-      $sth->execute;
-      my @data = $sth->fetchrow_array;
-      $sth = $ip_dbh->prepare("select city from allocations where cidr='$data[0]'");
-      $sth->execute;
-      @data = $sth->fetchrow_array;
-      $sth = $ip_dbh->prepare("update poolips set custid='6750400', available='y',".
-	" city='$data[0]', description='', notes='', circuitid='' where ip='$webvar{block}'");
-      $sth->execute;
-      $ip_dbh->commit;
-    };
-    if ($@) {
-      carp "Transaction aborted because $@";
-      eval { $ip_dbh->rollback; };
-      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$@'";
-      printAndExit("Could not deallocate static IP $webvar{block}: $@");
-    }
+  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
+
+  if ($code eq 'OK') {
     print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";
-    syslog "notice", "$authuser deallocated static IP $webvar{block}";
-
-  } elsif ($webvar{alloctype} eq 'mm') { # end alloctype = [cdsmw]i
-
-    eval {
-      $sth = $ip_dbh->prepare("delete from masterblocks where cidr='$webvar{block}'");
-      $sth->execute;
-      $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{block}'");
-      $sth->execute;
-      $ip_dbh->commit;
-    };
-    if ($@) {
-      carp "Transaction aborted because $@";
-      eval { $ip_dbh->rollback; };
-      syslog "err", "$authuser could not remove master block '$webvar{block}': '$@'";
-      printAndExit("Could not remove master block $webvar{block}: $@");
-    }
-    print "<div class=heading align=center>Success!  Master $webvar{block} removed.</div>\n";
-    syslog "notice", "$authuser removed master block $webvar{block}";
-
-  } else { # end alloctype master block case
-
-    ## This is a big block; but it HAS to be done in a chunk.  Any removal
-    ## of a netblock allocation may result in a larger chunk of free
-    ## contiguous IP space - which may in turn be combined into a single
-    ## netblock rather than a number of smaller netblocks.
-
-    eval {
-
-      my $cidr = new NetAddr::IP $webvar{block};
-      if ($webvar{alloctype} eq 'rr') {
-
-	$sth = $ip_dbh->prepare("delete from routed where cidr='$webvar{block}'");
-	$sth->execute;
-	# Make sure block getting deleted is properly accounted for.
-	$sth = $ip_dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
-		" where cidr='$webvar{block}'");
-	$sth->execute;
-	# Set up query to start compacting free blocks.
-	$sth = $ip_dbh->prepare("select * from freeblocks where ".
-		"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
-
-      } else { # end alloctype routing case
-
-	$sth = $ip_dbh->prepare("delete from allocations where cidr='$webvar{block}'");
-	$sth->execute;
-	# Special case - delete pool IPs
-	if ($webvar{alloctype} =~ /^[cdsmw]p$/) {
-	  # We have to delete the IPs from the pool listing.
-	  $sth = $ip_dbh->prepare("delete from poolips where pool='$webvar{block}'");
-	  $sth->execute;
-	}
-
-	# Set up query for compacting free blocks.
-	$sth = $ip_dbh->prepare("select * from freeblocks where cidr << ".
-		"(select cidr from routed where cidr >> '$cidr') ".
-		" and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
-
-      } # end alloctype general case
-
-##TEMP
-## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24
-my $staticpool = new NetAddr::IP "209.91.185.0/24";
-##TEMP
-if ($cidr->within($staticpool)) {
-##TEMP
-  # We've already deleted the block, now we have to stuff its IPs into the pool.
-  $sth = $ip_dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','Sudbury','d','y','','','')");
-  $sth->execute($cidr->addr);
-  foreach my $ip ($cidr->hostenum) {
-    $sth->execute("$ip");
-  }
-  $cidr--;
-  $sth->execute($cidr->addr);
-
-##TEMP
-} else {
-##TEMP
-
-      # Now we look for larger-or-equal-sized free blocks in the same master (routed)
-      # (super)block. If there aren't any, we can't combine blocks anyway.  If there
-      # are, we check to see if we can combine blocks.
-      # Execute the statement prepared in the if-else above.
-
-      $sth->execute;
-
-# NetAddr::IP->compact() attempts to produce the smallest inclusive block
-# from the caller and the passed terms.
-# EG:  if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
-#	and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
-#	.64-.95, and .96-.128), you will get an array containing a single
-#	/25 as element 0 (.0-.127).  Order is not important;  you could have
-#	$cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
-
-      my (@together, @combinelist);
-      my $i=0;
-      while (my @data = $sth->fetchrow_array) {
-	my $testIP = new NetAddr::IP $data[0];
-	@together = $testIP->compact($cidr);
-	my $num = @together;
-	if ($num == 1) {
-	  $cidr = $together[0];
-	  $combinelist[$i++] = $testIP;
-	}
-      }
-
-      # Clear old freeblocks entries - if any.  $i==0 if not.
-      if ($i>0) {
-	$sth = $ip_dbh->prepare("delete from freeblocks where cidr=?");
-	foreach my $block (@combinelist) {
-	  $sth->execute("$block");
-	}
-      }
-
-      # insert "new" freeblocks entry
-      if ($webvar{alloctype} eq 'rr') {
-	$sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
-		",'<NULL>','n')");
-      } else {
-	$sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
-		",(select city from routed where cidr >>= '$cidr'),'y')");
-      }
-      $sth->execute;
-
-##TEMP
-}
-##TEMP
-
-      # If we got here, we've succeeded.  Whew!
-      $ip_dbh->commit;
-    }; # end eval
-    if ($@) {
-      carp "Transaction aborted because $@";
-      eval { $ip_dbh->rollback; };
-      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$@'";
-      printAndExit("Could not deallocate netblock $webvar{block}: $@");
-    }
-    print "<div class=heading align=center>Success!  $webvar{block} deleted.</div>\n";
     syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
-
-  } # end alloctype != netblock
-
-  printFooter;
+  } else {
+    if ($webvar{alloctype} =~ /^.i$/) {
+      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
+      printError("Could not deallocate static IP $webvar{block}: $msg");
+    } else {
+      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
+      printError("Could not deallocate netblock $webvar{block}: $msg");
+    }
+  }
+
 } # finalDelete
 
Index: branches/stable/index.shtml
===================================================================
--- branches/stable/index.shtml	(revision 124)
+++ branches/stable/index.shtml	(revision 125)
@@ -1,3 +1,2 @@
 <!--#include file="header.inc"-->
 <!--#include virtual="/ip/cgi-bin/main.cgi?action=index" -->
-<!--#include file="footer.inc"-->