#!/usr/bin/perl
# ipdb/cgi-bin/admin.cgi
# Hack interface to make specific changes to IPDB that (for one reason
# or another) can't be made through the main interface.
###
# 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-admin","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'};
}

if ($authuser !~ /^(kdeugau|jodyh|__temptest)$/) {
  print "Content-Type: text/html\n\n".
	"<html><head><title>Access denied</title></head><body>\n".
	'Access to this tool is restricted.  Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
	"for more information.</body></html>\n";
  exit;
}

syslog "debug", "$authuser active";

my %webvar = parse_post();
cleanInput(\%webvar);
my $ip_dbh = connectDB;
my $sth;

print "Content-type: text/html\n\n".
	"<html>\n<head>\n\t<title>IPDB admin tools</title>\n</head>\n<body>\n".
	"<h2>IPDB - Administrative Tools</h2>\n<hr>\n";

if(!defined($webvar{action})) {
  $webvar{action} = "<NULL>";   #shuts up the warnings.
  print qq(WARNING:  There are FAR fewer controls on what you can do here.  Use the
main interface if at all possible.
<hr><form action="admin.cgi" method="POST">
<input type=hidden name=action value=alloc>
Allocate block from this /24: <input name=allocfrom>
<input type=submit value="List available free blocks">
</form>
<hr><form action="admin.cgi" method="POST">
<input type=hidden name=action value=alloctweak>
Manually update allocation data in this /24: <input name=allocfrom>
<input type=submit value="Show allocations">
);
} else {
  print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
}

if ($webvar{action} eq 'alloc') {
  fix_allocfrom();
  showfree($webvar{allocfrom});
} elsif ($webvar{action} eq 'alloctweak') {
  fix_allocfrom();
  showAllocs($webvar{allocfrom});
} elsif ($webvar{action} eq 'update') {
  update();
}

# Hokay.  This is a little different.  We have a few specific functions here:
#  -> Assign arbitrary subnet from arbitrary free space
#  -> Tweak individual DB fields
#


printFooter;

$ip_dbh->disconnect;

exit;


# List free blocks in a /24 for arbitrary manual allocation
sub showfree($) {
  my $cidr = $_[0];
  print "Showing free blocks in $cidr\n";
}

# Tweak allocfrom into shape.
sub fix_allocfrom {
  if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
    # 3-octet class C specified
    $webvar{allocfrom} .= ".0/24";
  } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
    # 4-octet IP specified;  
    $webvar{allocfrom} .= "/24";
  }
}


# Show allocations to allow editing.
sub showAllocs($) {
  my $cidr = new NetAddr::IP $_[0];
  print "Edit custID, allocation type, city for allocations in ".
	"$cidr:\n<table border=1>";
  $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
  $sth->execute;
  while (my @data = $sth->fetchrow_array) {
    print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
	qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
	qq(<td><input name=custid value="$data[1]"></td>\n);

    print "<td><select name=alloctype><option".
        (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
	(($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
	(($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
	(($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
	(($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
	(($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
	(($data[2] eq 'sp') ? ' selected' : '') ." value='sp'>Static Pool - Server pool</option>\n<option".
	(($data[2] eq 'cp') ? ' selected' : '') ." value='cp'>Static Pool - Cable</option>\n<option".
	(($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
	(($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
	(($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option".
	(($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option".
	(($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option".
	(($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option".
	(($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
	(($data[2] eq 'ii') ? ' selected' : '') ." value='ii'>Internal netblock</option>\n".
        "</select></td>\n";
    print qq(<td><input name=city value="$data[3]"></td>\n).
	"<td>$data[4]</td><td>$data[5]</td>".
	qq(<td><input type=submit value="Update"></td></form></tr>\n);
  }
  print "</table>\n";

  # notes
  print "<hr><b>Notes:</b>\n".
	"<ul>\n<li>Use the main interface to update description and notes fields\n".
	"<li>Changing the allocation type here will NOT affect IP pool data.\n".
	"</ul>\n";
}


# Stuff updates into DB
sub update {
  eval {
    # Relatively simple SQL transaction here.  Note that we're deliberately NOT
    # updating notes/desc here as it's available through the main interface.
    $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
	"city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
    $sth->execute;
    $ip_dbh->commit;
  };
  if ($@) {
    carp "Transaction aborted because $@";
    eval { $ip_dbh->rollback; };
    syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
  } else {
    # If we get here, the operation succeeded.
    syslog "notice", "$authuser updated $webvar{block}";
    print "Allocation $webvar{block} updated<hr>\n";
  }
  # need to get /24 that block is part of
  my @bits = split /\./, $webvar{block};
  $bits[3] = "0/24";
  showAllocs((join ".", @bits));
}
