#!/usr/bin/perl
# ipdb/cgi-bin/main.cgi
# Started munging from noc.vianet's old IPDB 04/22/2004
# Current version 05/18/2004 kdeugau@vianet

#use strict;		
use warnings;	
use CGI::Carp qw/fatalsToBrowser/;
use DBI;
use CommonWeb qw/:ALL/;
use POSIX qw/ceil/;
use NetAddr::IP;

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",
	"cp","Cable pool",
	"dp","DSL pool",
	"sp","Server pool",
	"dn","Dialup netblock",
	"dy","Dynamic DSL netblock",
	"dc","Dynamic cable netblock",
	"cn","Customer netblock",
	"e","End-use netblock",
	"r","Routed netblock",
	"i","Internal netblock",
	"m","Master block"
);


# Start new code:  04/22/2004
###

# Initial display:  Show master blocks with total allocated subnets, total free subnets
# foreach block (allocations[type=cust])
#   check which master it's in
#     increment appropriate counter
# foreach block (freeblocks)
#   check which master it's in
#     increment appropriate counter

# Some things we will need to do every time.

# Why not a global DB handle?
# We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
my $ip_dbh = DBI->connect("dbi:mysql:ipdb", "root", "");

# Slurp up the master block list - we need this several places
my $sth = $ip_dbh->prepare("select * from masterblocks;");
$sth->execute;
my $i=0;
for ($i=0; @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('');

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

  print "<div type=heading align=center>Adding $cidr as master block....\n";
  $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
  $sth->execute;
  die $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;
  die $sth->errstr if ($sth->errstr());

  print "Success!</div>\n";

  printFooter;
} 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 'edit') {
  edit();
}
elsif($webvar{action} eq 'update') {
  update();
}
elsif($webvar{action} eq 'delete') {
  remove();
}
elsif($webvar{action} eq 'finaldelete') {
  finalDelete();
}


#
#elsif($webvar{action} eq 'free')
#{
#	showFree();
#}
#elsif($webvar{action} eq 'free2')
#{
#	showFreeDetail();
#}
#elsif($webvar{action} eq 'insert')
#{
#	insertAssign();
#}
#elsif($webvar{action} eq 'showedit')
#{
#	showEdit();
#}
#elsif($webvar{action} eq 'view')
#{
#	view();
#}


# Default is an error.  It shouldn't be possible to easily get here.
else {
  printHeader('');
  my $rnd = rand 500;
  my $boing = sprintf("%.2f", rand 500);
  my @excuses = ("Aether cloudy.  Ask again later.","2",
	"3","4","5","6","7","8","9","10","11","12","13","14","15","16","17");
  printAndExit("Error $boing:  ".$excuses[$rnd/30.0]);
}


#end main()

# Just in case something waaaayyy down isn't in place properly...
exit 0;


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

print "<pre>\n";

print "start querysub: query '$query'\n";
# this may happen with more than one subcategory.  Unlikely, but possible.
  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) Customer "name".  If doing customer search, and we have non-numerics,
#	search on customer name.
# 5) Invalid data which might be interpretable as an IP or something, but
#    which probably shouldn't be for reasons of sanity.

  if ($category =~ /all/) {
    print "Showing all allocations\n";
    my $count = countRows('select count(*) from allocations');
    $sql = "select * from allocations order by cidr limit $offset,$RESULTS_PER_PAGE";
    queryResults($sql, $webvar{page}, $count);
  } elsif ($category =~ /cust/) {
    # Query for a customer ID.
    if ($query =~ /^\s*[0-9]+\s*$/) {
      # All numeric.  Search on customer ID.
      $sql = "select * from allocations where custid like '%$query%'";
      queryResults($sql, $webvar{page}, $count);
    } else {
	print "Searching for a customer based on (partial) name....\n";
      $sth = $ip_dbh->prepare("select * from customers where name like '%$query%'");
      $sth->execute;

# sth->rows may not work properly- it's not guaranteed to be accurate until
# ALL rows have actually been fetch...()'ed
      if ($sth->rows eq 1) {
	@data = $sth->fetchrow_array;
	# Only 1 cust matched.
print "Found 1 cust.  Displaying...\n";
	$sql = "select * from allocations where custid like '%$data[0]%'";
	queryResults($sql, $webvar{page}, $count);
      } elsif ($sth->rows == 0) {
	# D'Oh!  Nothing found!
	printAndExit("No customers found.  Try searching on a smaller string.");
      } else {
	# More than one found.  List'em and let the searcher decide.
	print "Found more than one.  Click the customer ID you want to show allocations for:\n";
	startTable('custid','name','city','phone','abuse contact','description');
	$count = 0;
	while (@data = $sth->fetchrow_array) {
	# custid,name,street,street2,city,province,pocode,phone,abuse,def_rdns,description
	  @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=search&input=$data[0]&searchfor=cust\">$data[0]</a>",
	  $data[1],$data[4],$data[7],$data[8],$data[10]);
	  printRow(\@row, 'color1' ) if($count%2==0);
	  printRow(\@row, 'color2' ) if($count%2!=0);
        }
	print "</table>\n";
      } # end if sth->rows
    } # query pattern if
  } elsif ($category =~ /ipblock/) {
    # Query is for a partial IP, a CIDR block in some form, or a flat IP.
    $query =~ s/\s+//g;
print "Looking for IP-based matches on '$query':<br>\n";
    if ($query =~ /\//) {
print "CIDR query.  Results may vary.\n";
      # 209.91.179/26 should show all /26 subnets in 209.91.179
      ($net,$maskbits) = split /\//, $query;
      if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
	# /0->/9 are silly to worry about right now.  :/
	print "Exact subnet search...\n";
	$sth = $ip_dbh->prepare("select * from allocations where cidr='$query'");
	$sth->execute;
	if ($sth->rows == 0) {
	  print "No matches\n";
	} elsif ($sth->rows == 1) {
	  @data = $sth->fetchrow_array;
	  print "Found $data[0]\n";
	} else {
	  print "Too many matches (".$sth->rows.", should be 1).  Database is b0rked.\n";
	}
      } else {
        # select * from allocations where cidr like '$net%' and cidr like '%$maskbits'
      }
    } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
      ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3})\.(\d{1,3})/);
      print "Trying to find based on net '$net' and ip '$ip'...";
      $sfor = new NetAddr::IP $query;
      $sth = $ip_dbh->prepare("select * from allocations where cidr like '$net%'");
      $sth->execute;
      while (@data = $sth->fetchrow_array()) {
        $cidr = new NetAddr::IP $data[0];
	if ($cidr->contains($sfor)) {
	  print "Found '$cidr'!\n";
	}
      }
    } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
      print "3-octet block pattern.";
      $sql = "select * from allocations where cidr like '$query%'";
      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) = @_;

  $class = '' if (!$class);
	
  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();
# Need some error checking...
print "About to start showing allocations: ".$ip_dbh->errstr;
  startTable('Allocation','CustID','Type','City','Description/Name');
  my $count = 0;
  while(my @data = ($sth->fetchrow_array())) {
    # cidr,custid,type,city,description,notes
# We need to munge row[0] here.  We may also need to extract additional data.
    @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]);
    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.
  $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}">$i&nbsp</a>\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


sub countRows($)
{
	my $sth = $ip_dbh->prepare($_[0]);
	$sth->execute();
	my @a = $sth->fetchrow_array();
	$sth->finish();
	$ip_dbh->disconnect();
	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.
  my $sth = $ip_dbh->prepare("select * from allocations");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    # cidr,custid,type,city,description
    # We only need the cidr
    my $cidr = new NetAddr::IP $data[0];
    foreach $master (@masterblocks) {
      if ($master->contains($cidr)) {
	$allocated{"$master"}++;
      }
    }
  }

# Snag routed blocks
  my $sth = $ip_dbh->prepare("select * from routed");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    # cidr,maskbits,city
    # We only need the cidr
    my $cidr = new NetAddr::IP $data[0];
    foreach $master (@masterblocks) {
      if ($master->contains($cidr)) {
	$routed{"$master"}++;
      }
    }
  }

# Snag the free blocks.
  my $sth = $ip_dbh->prepare("select * from freeblocks");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    # cidr,maskbits,city
    # We only need the cidr
    my $cidr = new NetAddr::IP $data[0];
    foreach $master (@masterblocks) {
      if ($master->contains($cidr)) {
	$free{"$master"}++;
	if ($cidr->masklen < $bigfree{"$master"}) { $bigfree{"$master"} = $cidr->masklen; }
      }
    }
  }

# Print the data.
  $count=0;
  foreach $master (@masterblocks) {
    @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";
# For some *very* strange reason, we don't have to call printFooter here.
# 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 $sth = $ip_dbh->prepare("select * from routed");
  $sth->execute();

  $i=0;
  while (@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 (@data = $sth->fetchrow_array()) {
      # cidr,custid,type,city,description
      # We only need the cidr
      my $cidr = new NetAddr::IP $data[0];
      foreach $master (@localmasters) {
	if ($master->contains($cidr)) {
	  $allocated{"$master"}++;
	}
      }
    }

    # Snag the free blocks.
    $sth = $ip_dbh->prepare("select * from freeblocks");
    $sth->execute();
    while (@data = $sth->fetchrow_array()) {
      # cidr,maskbits,city
      # We only need the cidr
      my $cidr = new NetAddr::IP $data[0];
      my $mask = 128;
      foreach $master (@localmasters) {
	if ($master->contains($cidr)) {
	  $free{"$master"}++;
	  if ($cidr->masklen < $mask) {
	    $bigfree{"$master"} = $cidr;
	    $mask = $cidr->masklen;
          }
	}
	# check for largest free block
      }
    }

    # Print the data.
    $count=0;
    foreach $master (@localmasters) {
      @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
	$routed{"$master"}, $allocated{"$master"},
	$free{"$master"}, $bigfree{"$master"});
      printRow(\@row, 'color1' ) if($count%2==0);
      printRow(\@row, 'color2' ) if($count%2!=0);
      $count++;
    }
  } else {
    print qq(<center>No routed blocks found for $master</center><br>\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.
  $count = 0;
  $sth = $ip_dbh->prepare("select * from freeblocks where routed='n'");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    # cidr,maskbits,city
    # We only need the cidr
    my $cidr = new NetAddr::IP $data[0];
    if ($master->contains($cidr)) {
      @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};

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

  my $sth = $ip_dbh->prepare("select * from allocations");
  $sth->execute();

  startTable('CIDR allocation','Type','CustID','Description/Name');

  $count=0;
  while (@data = $sth->fetchrow_array()) {
    # cidr,custid,type,city,description
    my $cidr = new NetAddr::IP $data[0];
    if (!$master->contains($cidr)) { next; }

    @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=edit&block=$data[0]\">$data[0]</a>",
	$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] =~ /^[sdc]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="r">\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('');

  # 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'");
  $sth->execute();
  while (@data = $sth->fetchrow_array()) {
    # cidr,maskbits,city
    my $cidr = new NetAddr::IP $data[0];
    if ($master->contains($cidr)) {
      @row = ($data[0]);
      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?','');
  $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{pool}'");
  $sth->execute;
  $count = 0;
  while (@data = $sth->fetchrow_array) {
    # pool,ip,custid,city,ptype,available
    # Some nice hairy Perl to decide whether to allow unassigning each IP
    @row = ($data[1],$data[2],$data[5],
	( ($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?
sub assignBlock
{
  printHeader('');

  open HTML, "../assign.html"
	or die "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('');

  # 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} =~ /^[cds]i$/) {
    ($base,$tmp) = split //, $webvar{alloctype};	# split into individual chars
    # 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.
    # 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 {
      $sql = "select * from poolips where available='y' and".
	" ptype='$base' and city='$city'";
    }

    # Now that we know where we're looking, we can list the pools with free IPs.
    $sth = $ip_dbh->prepare($sql);
    $sth->execute;
    while (@data = $sth->fetchrow_array) {
      $ipcount{$data[0]}++;
    }
    foreach $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{alloctype} eq 'r') {
      $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{city};
	$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 maskbits desc";
    }
    $sth = $ip_dbh->prepare($sql);
    $sth->execute;
    @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}) {
      $maskbits = $cidr->masklen();
      while ($maskbits++ < $webvar{maskbits}) {
	@subblocks = $cidr->split($maskbits);
      }
      $cidr = $subblocks[0];
    }
  } # if ($webvar{alloctype} =~ /^[cds]i$/) {

  open HTML, "../confirm.html"
	or die "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
  $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

sub insertAssign
{
  # Some things are done more than once.
  printHeader('');
  validateInput();

# here we do the donkeywork of actually adding a block.
# Check cidr and alloc_from to see how bad it's going to be.

# MySQL doesn't enforce referential integrity, but Postgres can.
# So we insert the customer data (if any) before the allocation.
# Note that city may be DIFFERENT than the city used for allocation!
#if ($webvar{newcust} eq 'y') {
#  $sth = $ip_dbh->prepare("insert into customers values ('$webvar{custid}', ".
#	"'$webvar{custname}', '$webvar{custaddr1}', '$webvar{custaddr2}', ".
#	"'$webvar{custcity}', '$webvar{custprov}', '$webvar{custpocode}', ".
#	"'$webvar{custphone}', '$webvar{custabuse}', '$webvar{custrdns}', ".
#	"'$webvar{custdesc}')");
#  $sth->execute;
#  print "customers: '".$sth->errstr."'\n";
#}

# Set some things that may be needed
# Don't set $cidr here as it may not even be a valid IP address.
  $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} =~ /^[cds]i$/) {
    ($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;

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

    $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',available='n'".
	" where ip='$cidr'");
    $sth->execute;
    print qq(<div class="center"><div class="heading">The IP $cidr has been allocated to customer $webvar{custid}</div></div>);

### had some idea I needed something here.  Do we?

  } else { # end IP-from-pool allocation

    # Set $cidr here as it may not be a valid IP address elsewhere.
    $cidr = new NetAddr::IP $webvar{fullcidr};

    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.

      if ($webvar{alloctype} eq 'r') {
	$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.
	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}')");
	$sth->execute;
      } # routing vs non-routing netblock

    } else { # webvar{fullcidr} != webvar{alloc_from}
      # Hard case.  Allocation is smaller than free block.

      $wantmaskbits = $cidr->masklen;

      $maskbits = $alloc_from->masklen;
      my $i=0;
      while ($maskbits++ < $wantmaskbits) {
	@subblocks = $alloc_from->split($maskbits);
	$newfreeblocks[$i++] = $subblocks[1];
      } # while

      # 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 'r') {
	# 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 $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 == r

	# Insert the new freeblocks entries
	$sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ?,'y')");
	foreach $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}')");
	$sth->execute;
      } # done with netblock alloctype != r

    } # end fullcidr != alloc_from

    # special extra handling for pools.
    # Note that this must be done for ANY pool allocation!
    if ( my ($pooltype) = ($webvar{alloctype} =~ /^([sdc])p$/) ) {
      # have to insert all pool IPs into poolips table as "unallocated".
      # sql: insert into poolips values (fullcidr,$ip,'6750400',alloctype,'n')
      $sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
	" ?, '6750400', '$webvar{city}', '$pooltype', 'y', '')");
      $cidr = new NetAddr::IP $webvar{fullcidr};
      @poolip_list = $cidr->hostenum;
      for (my $i=1; $i<=$#poolip_list; $i++) {
	$sth->execute($poolip_list[$i]->addr);
      }
    } # end pool special

    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.");
  }
  if ($webvar{alloctype} =~ /^(ci|di|cn)$/) {
    if (!$webvar{custid}) {
      printAndExit("Please enter a customer ID.");
    }
    print "[ In validateInput().  Insert customer ID cross-check here. ]<br>\n";
  } elsif ($webvar{alloctype} =~ /^([sdc]p|si|e|dn|dy|dc|e|r|i)$/){
    # All non-customer allocations MUST be entered with "our" customer ID.
    # I have Defined this as 6750400 for consistency.
    $webvar{custid} = "6750400";
  } 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('');

  # gotta snag block info from db
  $sth = $ip_dbh->prepare("select * from allocations where cidr='$webvar{block}'");
  $sth->execute;
  @data = $sth->fetchrow_array;

  open (HTML, "../editDisplay.html") || die "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.
  $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()


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

print "<pre>\n";

print " block: $webvar{block}\n";
print "  type: $webvar{alloctype} ($full_alloc_types{$webvar{alloctype}})\n";
print "custid: $webvar{custid}\n";
print "  desc: $webvar{desc}\n";
print " notes: $webvar{notes}\n";

# -> Always update desc and notes
# better yet, just update the customer id every time, based on allocation type...

if ($webvar{alloctype} eq 'c') {
  print "Updating customer alloc:\n   ";
    $sth = $ip_dbh->prepare("update allocations set type='$webvar{alloctype}',".
	"custid='$webvar{custid}',description='$webvar{desc}',notes='$webvar{notes}' ".
	"where cidr='$webvar{block}'");
} else {
  print "Updating non-customer alloc:\n   ";
    $sth = $ip_dbh->prepare("update allocations set type='$webvar{alloctype}',".
	"custid='6750400',description='$webvar{desc}',notes='$webvar{notes}' ".
	"where cidr='$webvar{block}'");
}
$sth->execute;

if($sth->errstr()) {
  print $sth->errstr()
} else {
  print "Update successful.\n";
}

print "</pre>\n";

  printFooter;
} # update()


# Delete an allocation.
sub remove
{
  printHeader('');
  #show confirm screen.
  open HTML, "../confirmRemove.html"
    or die "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);


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

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

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

  } elsif ($webvar{alloctype} =~ /^[sdc]i$/) { # done with alloctype=r

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

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

    $alloctype .="i";

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

    my $sth = $ip_dbh->prepare("select * from allocations where cidr='$webvar{block}'");
    $sth->execute();
#	die $sth->errstr() if($sth->errstr());

    $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$desc, \$notes);
    $sth->fetch() || die;
  } # 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 =~ /^[sdc]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('');

  if ($webvar{alloctype} =~ /^[sdc]i$/) {

    $sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
    $sth->execute;
    @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;
    print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";

  } else { # end alloctype = [sdc]i

    $cidr = new NetAddr::IP $webvar{block};
    if ($webvar{alloctype} eq 'r') {

      $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;

      $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} =~ /^[sdc]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 $i=0;
    while (@data = $sth->fetchrow_array) {
      my $testIP = new NetAddr::IP $data[0];
      @together = $testIP->compact($cidr);
      $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 $block (@combinelist) {
	$sth->execute($block);
      }
    }

    # insert "new" freeblocks entry
    if ($webvar{alloctype} eq 'r') {
      $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;

    print "<div class=heading align=center>Success!  $webvar{block} deleted.</div>\n";

  } # end alloctype != netblock

  printFooter;
} # finalDelete


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