#!/usr/bin/perl
# ipdb/cgi-bin/main.cgi
# Started munging from noc.vianet's old IPDB 04/22/2004
###
# SVN revision info
# $Date$
# SVN revision $Rev$
# Last update by $Author$
###

use strict;		
use warnings;	
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use CommonWeb qw(:ALL);
use IPDB qw(:ALL);
use POSIX qw(ceil);
use NetAddr::IP;

use Sys::Syslog;

openlog "IPDB","pid","local2";

# Collect the username from HTTP auth.  If undefined, we're in a test environment.
my $authuser;
if (!defined($ENV{'REMOTE_USER'})) {
  $authuser = '__temptest';
} else {
  $authuser = $ENV{'REMOTE_USER'};
}

syslog "debug", "$authuser active";

checkDBSanity();

#prototypes
sub viewBy($$);		# feed it the category and query
sub queryResults($$$);	# args is the sql, the page# and the rowCount
# Needs rewrite/rename
sub countRows($);	# returns first element of first row of passed SQL
			# Only usage passes "select count(*) ..."

my $RESULTS_PER_PAGE = 50;
my %webvar = parse_post();
cleanInput(\%webvar);

my %full_alloc_types = (
	"ci","Cable pool IP",
	"di","DSL pool IP",
	"si","Server pool IP",
	"mi","Static dialup IP",
	"wi","Static wireless IP",
	"cp","Cable pool",
	"dp","DSL pool",
	"sp","Server pool",
	"mp","Static dialup pool",
	"wp","Static wireless pool",
	"dn","Dialup netblock",
	"dy","Dynamic DSL netblock",
	"dc","Dynamic cable netblock",
	"cn","Customer netblock",
	"ee","End-use netblock",
	"rr","Routed netblock",
	"ii","Internal netblock",
	"mm","Master block"
);

# Other global variables
my @masterblocks;
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;

# Slurp up the master block list - we need this several places
# While we're at it, initialize the related hashes.
my $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;
}




#main()

if(!defined($webvar{action})) {
  $webvar{action} = "<NULL>";	#shuts up the warnings.
}

if($webvar{action} eq 'index') {
  showSummary();
} elsif ($webvar{action} eq 'newmaster') {
  printHeader('');

  my $cidr = new NetAddr::IP $webvar{cidr};

  print "<div type=heading align=center>Adding $cidr as master block....\n";

  # Allow transactions, and raise an exception on errors so we can catch it later.
  # Use local to make sure these get "reset" properly on exiting this block
  local $ip_dbh->{AutoCommit} = 0;
  local $ip_dbh->{RaiseError} = 1;

  # Wrap the SQL in a transaction
  eval {
    $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
    $sth->execute;
# Don't need this with RaiseError, but leave it for now.
#    croak $sth->errstr if ($sth->errstr());

# Unrouted blocks aren't associated with a city (yet).  We don't rely on this
# elsewhere though;  legacy data may have traps and pitfalls in it to break this.
# Thus the "routed" flag.

    $sth = $ip_dbh->prepare("insert into freeblocks values ('$webvar{cidr}',".
	$cidr->masklen.",'<NULL>','n')");
    $sth->execute;
# Don't need this with RaiseError, but leave it for now.
#    croak $sth->errstr if ($sth->errstr());

    # If we get here, everything is happy.  Commit changes.
    $ip_dbh->commit;
  }; # end eval

  if ($@) {
    carp "Transaction aborted because $@";
    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;
} # end add new master

elsif($webvar{action} eq 'showmaster') {
  showMaster();
}
elsif($webvar{action} eq 'showrouted') {
  showRBlock();
}
elsif($webvar{action} eq 'listpool') {
  listPool();
}
elsif($webvar{action} eq 'search') {
  printHeader('');
  if (!$webvar{input}) {
    # No search term.  Display everything.
    viewBy('all', '');
  } else {
    # Search term entered.  Display matches.
    # We should really sanitize $webvar{input}, no?
    viewBy($webvar{searchfor}, $webvar{input});
  }
  printFooter();
}

# Not modified or added;  just shuffled
elsif($webvar{action} eq 'assign') {
  assignBlock();
}
elsif($webvar{action} eq 'confirm') {
  confirmAssign();
}
elsif($webvar{action} eq 'insert') {
  insertAssign();
}
elsif($webvar{action} eq 'edit') {
  edit();
}
elsif($webvar{action} eq 'update') {
  update();
}
elsif($webvar{action} eq 'delete') {
  remove();
}
elsif($webvar{action} eq 'finaldelete') {
  finalDelete();
}

# Default is an error.  It shouldn't be possible to easily get here.
# The only way I can think of offhand is to just call main.cgi bare-
# which is not in any way guaranteed to provide anything useful.
else {
  printHeader('');
  my $rnd = rand 500;
  my $boing = sprintf("%.2f", rand 500);
  my @excuses = ("Aether cloudy.  Ask again later.","The gods are unhappy with your sacrifice.",
	"Because one of it's legs are both the same", "*wibble*",
	"Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
	"8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
  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;


sub viewBy($$) {
  my ($category,$query) = @_;

  # Local variables
  my $sql;

#print "<pre>\n";

#print "start querysub: query '$query'\n";
# this may happen with more than one subcategory.  Unlikely, but possible.

  # Calculate start point for LIMIT clause
  my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;

# Possible cases:
# 1) Partial IP/subnet.  Treated as "first-three-octets-match" in old IPDB,
#    I should be able to handle it similarly here.
# 2a) CIDR subnet.  Treated more or less as such in old IPDB.
# 2b) CIDR netmask.  Not sure how it's treated.
# 3) Customer ID.  Not handled in old IPDB
# 4) Description.
# 5) Invalid data which might be interpretable as an IP or something, but
#    which probably shouldn't be for reasons of sanity.

  if ($category eq 'all') {

    print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
    $sql = "select * from searchme";
    my $count = countRows("select count(*) from ($sql) foo");
    $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    queryResults($sql, $webvar{page}, $count);

  } elsif ($category eq 'cust') {

    print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);

    # Query for a customer ID.  Note that we can't restrict to "numeric-only"
    # as we have non-numeric custIDs in the legacy data.  :/
    $sql = "select * from searchme where custid like '%$query%'";
    my $count = countRows("select count(*) from ($sql) foo");
    $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    queryResults($sql, $webvar{page}, $count);

  } elsif ($category eq 'desc') {

    print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
    # Query based on description (includes "name" from old DB).
    $sql = "select * from searchme where description like '%$query%'";
    my $count = countRows("select count(*) from ($sql) foo");
    $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    queryResults($sql, $webvar{page}, $count);

  } elsif ($category =~ /ipblock/) {

    # Query is for a partial IP, a CIDR block in some form, or a flat IP.
    print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);

    $query =~ s/\s+//g;
    if ($query =~ /\//) {
      # 209.91.179/26 should show all /26 subnets in 209.91.179
      my ($net,$maskbits) = split /\//, $query;
      if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
	# /0->/9 are silly to worry about right now.  I don't think
	# we'll be getting a class A anytime soon.  <g>
        $sql = "select * from searchme where cidr='$query'";
	queryResults($sql, $webvar{page}, 1);
      } else {
	print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
	# Partial match;  beginning of subnet and maskbits are provided
	$sql = "select * from searchme where text(cidr) like '$net%' and ".
		"text(cidr) like '%$maskbits'";
	my $count = countRows("select count(*) from ($sql) foo");
	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	queryResults($sql, $webvar{page}, $count);
      }
    } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
      # Specific IP address match
      print "4-octet pattern found;  finding netblock containing IP $query<br>\n";
      my ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/);
      my $sfor = new NetAddr::IP $query;
      $sth = $ip_dbh->prepare("select * from searchme where text(cidr) like '$net%'");
      $sth->execute;
      while (my @data = $sth->fetchrow_array()) {
        my $cidr = new NetAddr::IP $data[0];
	if ($cidr->contains($sfor)) {
	  queryResults("select * from searchme where cidr='$cidr'", $webvar{page}, 1);
	}
      }
    } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
      print "Finding matches where the first three octets are $query<br>\n";
      $sql = "select * from searchme where text(cidr) like '$query%'";
      my $count = countRows("select count(*) from ($sql) foo");
      $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
      queryResults($sql, $webvar{page}, $count);
    } else {
      # This shouldn't happen, but if it does, whoever gets it deserves what they get...
      printAndExit("Invalid query.");
    }
  } else {
    # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    printAndExit("Invalid searchfor.");
  }
} # viewBy


# args are: a reference to an array with the row to be printed and the 
# class(stylesheet) to use for formatting.
# if ommitting the class - call the sub as &printRow(\@array)
sub printRow {
  my ($rowRef,$class) = @_;

  if (!$class) {
    print "<tr>\n";
  } else {
    print "<tr class=\"$class\">\n";
  }

  foreach my $element (@$rowRef) {
    print "<td></td>" if (!defined($element));
    $element =~ s|\n|</br>|g;
    print "<td>$element</td>\n";
  }
  print "</tr>";
} # printRow


# Display certain types of search query.  Note that this can't be
# cleanly reused much of anywhere else as the data isn't neatly tabulated.
# This is tied to the search sub tightly enough I may just gut it and provide
# more appropriate tables directly as needed.
sub queryResults($$$) {
  my ($sql, $pageNo, $rowCount) = @_;
  my $offset = 0;
  $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);

  my $sth = $ip_dbh->prepare($sql);
  $sth->execute();

  startTable('Allocation','CustID','Type','City','Description/Name');
  my $count = 0;

  while (my @data = $sth->fetchrow_array) {
    # cidr,custid,type,city,description,notes
    # Fix up types from pools (which are single-char)
    # Fixing the database would be...  painful.  :(
    if ($data[2] =~ /^[cdsm]$/) {
      $data[2] .= 'i';
    }
    my @row = (qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
	$data[1], $full_alloc_types{$data[2]}, $data[3], $data[4]);
    # Allow listing of pool if desired/required.
    if ($data[2] =~ /^[sdcmw]p$/) {
      $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	"&pool=$data[0]\">List IPs</a>";
    }
    printRow(\@row, 'color1', 1) if ($count%2==0); 
    printRow(\@row, 'color2', 1) if ($count%2!=0);
    $count++;
  }

  # Have to think on this call, it's primarily to clean up unfetched rows from a select.
  # In this context it's probably a good idea.
  $sth->finish();

  my $upper = $offset+$count;
  print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: $offset - $upper</i></td></tr>\n";
  print "</table></center>\n";

  # print the page thing..
  if ($rowCount > $RESULTS_PER_PAGE) {
    my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
    print qq(<div class="center"> Page: );
    for (my $i = 1; $i <= $pages; $i++) {
      if ($i == $pageNo) {
	print "<b>$i&nbsp;</b>\n";
      } else {
	print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}&action=search">$i</a>&nbsp;\n);
      }
    }
    print "</div>";
  }
} # queryResults


# Prints table headings.  Accepts any number of arguments;
# each argument is a table heading.
sub startTable {
  print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);

  foreach(@_) {
    print qq(<td class="heading">$_</td>);
  }
  print "</tr>\n";
} # startTable


# Return first element of passed SQL query
sub countRows($) {
  my $sth = $ip_dbh->prepare($_[0]);
  $sth->execute();
  my @a = $sth->fetchrow_array();
  $sth->finish();
  return $a[0];
}


# Initial display:  Show master blocks with total allocated subnets, total free subnets
sub showSummary
{
  print "Content-type: text/html\n\n";

  startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
	'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 $count=0;
  foreach my $master (@masterblocks) {
    my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
	$routed{"$master"}, $allocated{"$master"}, $free{"$master"}, 
	( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
	);

    printRow(\@row, 'color1' ) if($count%2==0);
    printRow(\@row, 'color2' ) if($count%2!=0);
    $count++;
  }
  print "</table>\n";
  print qq(<a href="/ip/addmaster.shtml">Add new master block</a><br><br>\n);
  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


# Display detail on master
# Alrighty then!  We're showing routed blocks within a single master this time.
# We should be able to steal code from showSummary(), and if I'm really smart
# I'll figger a way to munge the two together.  (Once I've done that, everything
# else should follow.  YMMV.)
sub showMaster {
  printHeader('');

  print qq(<center><div class="heading">Summarizing routed blocks for ).
	qq($webvar{block}:</div></center><br>\n);

  my $master = new NetAddr::IP $webvar{block};
  my @localmasters;

  $sth = $ip_dbh->prepare("select * from routed order by cidr");
  $sth->execute();

  my $i=0;
  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;
    # Retain the routing destination
      $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
      }
    }

    # Print the data.
    my $count=0;
    foreach my $master (@localmasters) {
      my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
	$routed{"$master"}, $allocated{"$master"},
	$free{"$master"},
	( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
      );
      printRow(\@row, 'color1' ) if($count%2==0);
      printRow(\@row, 'color2' ) if($count%2!=0);
      $count++;
    }
  } else {
    # If a master block has no routed blocks, then by definition it has no
    # allocations, and can be deleted.
    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
        qq($master.</div>\n).
        qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
        qq(<input type=hidden name=action value="delete">\n).
        qq(<input type=hidden name=block value="$master">\n).
        qq(<input type=hidden name=alloctype value="mm">\n).
        qq(<input type=submit value=" Remove this master ">\n).
        qq(</form></center>\n);

  } # end check for existence of routed blocks in master

  print qq(</table>\n<hr width="60%">\n).
	qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);

  startTable('Netblock','Range');

  # Snag the free blocks.
  my $count = 0;
  $sth = $ip_dbh->prepare("select * from freeblocks where 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++;
    }
  }

  print "</table>\n";
  printFooter;
} # showMaster


# Display details of a routed block
# Alrighty then!  We're showing allocations within a routed block this time.
# We should be able to steal code from showSummary() and showMaster(), and if
# I'm really smart I'll figger a way to munge all three together.  (Once I've
# done that, everything else should follow.  YMMV.
# This time, we check the database before spewing, because we may
# not have anything useful to spew.
sub showRBlock {
  printHeader('');

  my $master = new NetAddr::IP $webvar{block};

  $sth = $ip_dbh->prepare("select * from routed where cidr='$master'");
  $sth->execute;
  my @data = $sth->fetchrow_array;

  print qq(<center><div class="heading">Summarizing allocated blocks for ).
	qq($master ($data[2]):</div></center><br>\n);

  $sth = $ip_dbh->prepare("select * from allocations 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
    my $cidr = new NetAddr::IP $data[0];
    if (!$master->contains($cidr)) { next; }

    # Clean up extra spaces that are borking things.
    $data[2] =~ s/\s+//g;

    my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=edit&block=$data[0]\">$data[0]</a>",
	$data[3], $full_alloc_types{$data[2]}, $data[1], $data[4]);
    # If the allocation is a pool, allow listing of the IPs in the pool.
    if ($data[2] =~ /^[sdcmw]p$/) {
      $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	"&pool=$data[0]\">List IPs</a>";
    }

    printRow(\@row, 'color1') if ($count%2 == 0);
    printRow(\@row, 'color2') if ($count%2 != 0);
    $count++;
  }

  print "</table>\n";

  # If the routed block has no allocations, by definition it only has
  # one free block, and therefore may be deleted.
  if ($count == 0) {
    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	qq($master.</div></center>\n).
	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	qq(<input type=hidden name=action value="delete">\n).
	qq(<input type=hidden name=block value="$master">\n).
	qq(<input type=hidden name=alloctype value="rr">\n).
	qq(<input type=submit value=" Remove this block ">\n).
	qq(</form>\n);
  }

  print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
	qq(submaster $master</div></center>\n);

  startTable('CIDR block','Range');

  # Snag the free blocks.  We don't really *need* to be pedantic about avoiding
  # 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->execute();
  while (my @data = $sth->fetchrow_array()) {
    # cidr,maskbits,city
    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++;
    }
  }

  print "</table>\n";
  printFooter;
} # showRBlock


# List the IPs used in a pool
sub listPool {
  printHeader('');

  my $cidr = new NetAddr::IP $webvar{pool};

  # Snag pool info for heading
  $sth = $ip_dbh->prepare("select * from allocations where cidr='$cidr'");
  $sth->execute;
  my @data = $sth->fetchrow_array;
  my $type = $data[2];	# We'll need this later.

  print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
	qq(($full_alloc_types{$type} in $data[3])</div></center><br>\n);
  print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
  print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
	$cidr->addr."</td></tr>\n";
  $cidr++;
  print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
  $cidr--;  $cidr--;
  print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
	"<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
	"</table></div></div>\n";

# probably have to add an "edit IP allocation" link here somewhere.

  startTable('IP','Customer ID','Available?','Description','');
  $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{pool}' order by ip");
  $sth->execute;
  my $count = 0;
  while (my @data = $sth->fetchrow_array) {
    # pool,ip,custid,city,ptype,available,notes,description
    # If desc is null, make it not null.  <g>
    if ($data[7] eq '') {
      $data[7] = '&nbsp;';
    }
    # Some nice hairy Perl to decide whether to allow unassigning each IP
    #   -> if $data[5] (aka poolips.available) == 'n' then we print the unassign link
    #	   else we print a blank space
    my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[1]">$data[1]</a>),
	$data[2],$data[5],$data[7],
	( ($data[5] eq 'n') ?
	  ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[1]&".
	   "alloctype=$data[4]i\">Unassign this IP</a>") :
	  ("&nbsp;") )
	);
    printRow(\@row, 'color1') if($count%2==0);
    printRow(\@row, 'color2') if($count%2!=0);
    $count++;
  }
  print "</table>\n";

  printFooter;
} # end listPool


# Should this maybe just be a full static page?  It just spews out some predefined HTML.
sub assignBlock {
  printHeader('');

  open HTML, "../assign.html"
	or croak "Could not open assign.html: $!";
  my $html = join('',<HTML>);
  close(HTML);

  print $html;

  printFooter();
} # assignBlock


# Take info on requested IP assignment and see what we can provide.
sub confirmAssign {
  printHeader('');

  my $cidr;
  my $alloc_from;

  # 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.");
#  }

# Several different cases here.
# Static IP vs netblock
#  + Different flavours of static IP
#  + Different flavours of netblock

  if ($webvar{alloctype} =~ /^[cdsm]i$/) {
    my ($base,undef) = split //, $webvar{alloctype};	# split into individual chars
    my $sql;
    # Check for pools in Subury or North Bay if DSL or server pool.  Anywhere else is
    # invalid and shouldn't be in the db in the first place.
    # ... aside from #^%#$%#@#^%^^!!!! legacy data.  GRRR.
    # Note that we want to retain the requested city to relate to customer info.
    if ($base =~ /^[ds]$/) {
      $sql = "select * from poolips where available='y' and".
	" 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{city}'";
    }

    # Now that we know where we're looking, we can list the pools with free IPs.
    $sth = $ip_dbh->prepare($sql);
    $sth->execute;
    my %ipcount;
    my $optionlist;
    while (my @data = $sth->fetchrow_array) {
      $ipcount{$data[0]}++;
    }
    foreach my $key (keys %ipcount) {
      $optionlist .= "<option value='$key'>$key [$ipcount{$key} free IP(s)]</option>\n";
    }
    $cidr = "Single static IP";
    $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";

  } else { # end show pool options
    if (!$webvar{maskbits}) {
      printAndExit("Please specify a CIDR mask length.");
    }
    my $sql;
    my $city;
    my $failmsg;
    if ($webvar{alloctype} eq 'rr') {
      $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
	" order by maskbits desc";
      $failmsg = "No suitable free block found.<br>\nWe do not have a free".
	" routeable block of that size.<br>\nYou will have to either route".
	" a set of smaller netblocks or a single smaller netblock.";
    } else {
      if ($webvar{alloctype} =~ /^[sd]p$/) {
	if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
	  printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
	if ($webvar{alloctype} eq 'sp') { $city = "Sudbury"; } else { $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".
	  " block size for the pool.";
      } else {
	$city = $webvar{pop};
	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
	  " superblock to $webvar{city}<br>\nfrom one of the master blocks in Sudbury or".
	  " chose a smaller blocksize.";
      }
      $sql = "select * from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
	" and routed='y' order by cidr,maskbits desc";
    }
    $sth = $ip_dbh->prepare($sql);
    $sth->execute;
    my @data = $sth->fetchrow_array();
    if ($data[0] eq "") {
      printAndExit($failmsg);
    }

    $cidr = new NetAddr::IP $data[0];
    $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);

    # If the block to be allocated is smaller than the one we found,
    # figure out the "real" block to be allocated.
    if ($cidr->masklen() ne $webvar{maskbits}) {
      my $maskbits = $cidr->masklen();
      my @subblocks;
      while ($maskbits++ < $webvar{maskbits}) {
	@subblocks = $cidr->split($maskbits);
      }
      $cidr = $subblocks[0];
    }
  } # if ($webvar{alloctype} =~ /^[cdsm]i$/) {

  open HTML, "../confirm.html"
	or croak "Could not open confirm.html: $!";
  my $html = join '', <HTML>;
  close HTML;

### gotta fix this in final
  # Stick in customer info as necessary - if it's blank, it just ends
  # up as blank lines ignored in the rendering of the page
	my $custbits;
  $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
###

  # Stick in the allocation data
  $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
  $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$webvar{alloctype}}|g;
  $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
  $html =~ s|\$\$CIDR\$\$|$cidr|g;
  $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
  $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
  $webvar{desc} = desanitize($webvar{desc});
  $webvar{notes} = desanitize($webvar{notes});
  $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
  $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
  $html =~ s|\$\$ACTION\$\$|insert|g;

  print $html;

  printFooter;
} # end confirmAssign


# Do the work of actually inserting a block in the database.
sub insertAssign {
  # 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} =~ /^[cdsm]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'");
    $sth->execute;

    my @data = $sth->fetchrow_array;
    my $cidr = $data[1];

    $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',available='n'".
	" where ip='$cidr'");
    $sth->execute;
    if ($sth->err) {
      printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
      syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser 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}";

  } 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.  :/
    $ip_dbh->{AutoCommit} = 0;
    $ip_dbh->{RaiseError} = 1;

    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.")");
	  $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 $full_alloc_types{$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 (?, ?, ?,'y')");
	  foreach my $block (@newfreeblocks) {
 	    $sth->execute("$block", $block->masklen, $webvar{city});
	  }
	  # 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.")");
	  $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 $full_alloc_types{$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} =~ /^([cdsm])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("$full_alloc_types{$webvar{alloctype}} $webvar{fullcidr} not completely initialized.");
    }
    syslog "notice", "$full_alloc_types{$webvar{alloctype}} '$webvar{fullcidr}' successfully initialized by $authuser";

    # Turn off transactions and exception-on-error'ing
    $ip_dbh->{AutoCommit} = 0;
    $ip_dbh->{RaiseError} = 1;

    print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was sucessfully added as type '$webvar{alloctype}' ($full_alloc_types{$webvar{alloctype}})</div></div>);

  } # end static-IP vs netblock allocation

  printFooter();
} # end insertAssign()


# Does some basic checks on common input data to make sure nothing
# *really* weird gets in to the database through this script.
# Does NOT do complete input validation!!!
sub validateInput {
  if ($webvar{city} eq '-') {
    printAndExit("Please choose a city.");
  }
  chomp $webvar{alloctype};
  # We have different handling for customer allocations and "internal" or "our" allocations
  if ($webvar{alloctype} =~ /^(ci|di|cn|mi)$/) {
    if (!$webvar{custid}) {
      printAndExit("Please enter a customer ID.");
    }
    if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)$/) {
      printAndExit("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} =~ /^([sdcmw]p|si|dn|dy|dc|ee|rr|ii)$/){
    # All non-customer allocations MUST be entered with "our" customer ID.
    # I have Defined this as 6750400 for consistency.
    $webvar{custid} = "6750400";
    if ($webvar{alloctype} eq 'rr') {
      if ($webvar{city} !~ /^(?:Huntsville|North Bay|Ottawa|Pembroke|Sault Ste. Marie|Sudbury|Timmins|Toronto)$/) {
	printAndExit("Please choose a valid POP location for a routed netblock.  Valid ".
		"POP locations are currently:<br>\n Huntsville North Bay Ottawa Pembroke ".
		"Sault Ste. Marie Sudbury Timmins Toronto");
      }
    }
  } 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;
} # end validateInput


# Displays details of a specific allocation in a form
# Allows update/delete
# action=edit
sub edit {
  printHeader('');

  my $sql;

  # Two cases:  block is a netblock, or block is a static IP from a pool
  # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
  if ($webvar{block} =~ /\/32$/) {
    $sql = "select ip,custid,ptype,city,description,notes from poolips where ip='$webvar{block}'";
  } else {
    $sql = "select cidr,custid,type,city,description,notes from allocations where cidr='$webvar{block}'"
  }

  # gotta snag block info from db
  $sth = $ip_dbh->prepare($sql);
  $sth->execute;
  my @data = $sth->fetchrow_array;

  # Clean up extra whitespace on alloc type
  $data[2] =~ s/\s//;

  # Postfix "i" on pool IP types
  if ($data[2] =~ /^[cdsm]$/) {
    $data[2] .= "i";
  }

  open (HTML, "../editDisplay.html")
	or croak "Could not open editDisplay.html :$!";
  my $html = join('', <HTML>);

  # We can't let the city be changed here;  this block is a part of
  # a larger routed allocation and therefore by definition can't be moved.
  # block and city are static.
##fixme
# Needs thinking.  Have to allow changes to city to correct errors, no?
  $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
  $html =~ s/\$\$CITY\$\$/$data[3]/g;

# Screw it.  Changing allocation types gets very ugly VERY quickly- especially
# with the much longer list of allocation types.
# We'll just show what type of block it is.

  $html =~ s/\$\$TYPE\$\$/$data[2]/g;
  $html =~ s/\$\$FULLTYPE\$\$/$full_alloc_types{$data[2]}/g;

  # These can be modified, although CustID changes may get ignored.
  $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
  $html =~ s/\$\$DESC\$\$/$data[4]/g;
  $html =~ s/\$\$NOTES\$\$/$data[5]/g;

  print $html;

  printFooter();
} # edit()


# Stuff new info about a block into the db
# action=update
sub update {
  printHeader('');

  # Make sure incoming data is in correct format - custID among other things.
  validateInput;

  # SQL transaction wrapper
  eval {
    # Relatively simple SQL transaction here.
    my $sql;
    if (my $pooltype = ($webvar{alloctype} =~ /^([cdms])i$/) ) {
      $sql = "update poolips set custid='$webvar{custid}',".
	"notes='$webvar{notes}',description='$webvar{desc}' ".
	"where ip='$webvar{block}'";
    } else {
      $sql = "update allocations set custid='$webvar{custid}',".
	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}' ".
	"where cidr='$webvar{block}'";
    }
syslog "debug", $sql;
    $sth = $ip_dbh->prepare($sql);
    $sth->execute;
    $ip_dbh->commit;
  };
  if ($@) {
    carp "Transaction aborted because $@";
    eval { $ip_dbh->rollback; };
    syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
    printAndExit("Could not update block/IP $webvar{block}");
  }

  # If we get here, the operation succeeded.
  syslog "notice", "$authuser updated $webvar{block}";
  open (HTML, "../updated.html")
        or croak "Could not open updated.html :$!";
  my $html = join('', <HTML>);

  $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
  $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
  $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
  $html =~ s/\$\$TYPEFULL\$\$/$full_alloc_types{$webvar{alloctype}}/g;
  $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
  $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
  $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;

  print $html;

  printFooter;
} # update()


# Delete an allocation.
sub remove
{
  printHeader('');
  #show confirm screen.
  open HTML, "../confirmRemove.html"
	or croak "Could not open confirmRemove.html :$!";
  my $html = join('', <HTML>);
  close HTML;

  # Serves'em right for getting here...
  if (!defined($webvar{block})) {
    printAndExit("Error 332");
  }

  my ($cidr, $custid, $type, $city, $desc, $notes, $alloctype);

  if ($webvar{alloctype} eq 'rr') {
    $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
    $sth->execute();

# This feels...  extreme.
    croak $sth->errstr() if($sth->errstr());

    $sth->bind_columns(\$cidr,\$city);
    $sth->execute();
    $sth->fetch || croak $sth->errstr();
    $custid = "N/A";
    $alloctype = $webvar{alloctype};
    $desc = "N/A";
    $notes = "N/A";

  } elsif ($webvar{alloctype} eq 'mm') {
    $cidr = $webvar{block};
    $city = "N/A";
    $custid = "N/A";
    $alloctype = $webvar{alloctype};
    $desc = "N/A";
    $notes = "N/A";
  } elsif ($webvar{alloctype} =~ /^[sdcmw]i$/) { # done with alloctype=rr

    # Unassigning a static IP
    my $sth = $ip_dbh->prepare("select ip,custid,city,ptype,notes from poolips".
	" where ip='$webvar{block}'");
    $sth->execute();
#  croak $sth->errstr() if($sth->errstr());

    $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes);
    $sth->fetch() || croak $sth->errstr;

    $alloctype .="i";

  } else { # done with alloctype=[sdcmw]i

    my $sth = $ip_dbh->prepare("select cidr,custid,type,city,description,notes from ".
	"allocations where cidr='$webvar{block}'");
    $sth->execute();
#	croak $sth->errstr() if($sth->errstr());

    $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$desc, \$notes);
    $sth->fetch() || croak $sth->errstr;
  } # end cases for different alloctypes

  # Munge everything into HTML
  $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
  $html =~ s|\$\$BLOCK\$\$|$cidr|g;
  $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$alloctype}|g;
  $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
  $html =~ s|\$\$CITY\$\$|$city|g;
  $html =~ s|\$\$CUSTID\$\$|$custid|g;
  $html =~ s|\$\$DESC\$\$|$desc|g;
  $html =~ s|\$\$NOTES\$\$|$notes|g;

  $html =~ s|\$\$ACTION\$\$|finaldelete|g;

  # Set the warning text.
  if ($alloctype =~ /^[sdcmw]p$/) {
    $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>|;
  } else {
    $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
  }

  print $html;
  printFooter;
} # end edit()


# Delete an allocation.  Return it to the freeblocks table;  munge
# data as necessary to keep as few records as possible in freeblocks
# to prevent weirdness when allocating blocks later.
# Remove IPs from pool listing if necessary
sub finalDelete {
  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} =~ /^[sdcmw]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]' 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}");
    }
    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 = [sdcmw]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} =~ /^[sdcmw]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 city='$webvar{city}'".
		" 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 = $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.
		",'$webvar{city}','y')");
      }
      $sth->execute;

      # 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 netblock $webvar{block}";

  } # end alloctype != netblock

  printFooter;
} # finalDelete


# Just in case we manage to get here.
exit 0;