#!/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: 2005-02-01 22:02:39 +0000 (Tue, 01 Feb 2005) $
# SVN revision $Rev: 146 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004,2005 - Kris Deugau
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".
"Access denied\n".
'Access to this tool is restricted. Contact Kris '.
"for more information.\n";
exit;
}
syslog "debug", "$authuser active";
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"
);
my $ip_dbh = connectDB;
my $sth;
print "Content-type: text/html\n\n".
"\n\n\tTEST [IPDB admin tools] TEST\n\n\n".
"
IPDB - Administrative Tools
\n\n";
if(!defined($webvar{action})) {
$webvar{action} = ""; #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.
List IP Pools for manual tweaking and updates
);
} else {
print 'Back to main';
}
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();
} elsif ($webvar{action} eq 'assign') {
# Display a list of possible blocks within the requested block.
open (HTML, "../admin_alloc.html")
or croak "Could not open admin_alloc.html :$!";
my $html = join('', );
$html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
$html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
my $from = new NetAddr::IP $webvar{allocfrom};
my @blocklist = $from->split($webvar{masklen});
my $availblocks;
foreach (@blocklist) {
$availblocks .= qq(
\n";
$sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' order by cidr");
$sth->execute;
my %poolfree;
while (my @data = $sth->fetchrow_array) {
$poolfree{$data[0]} = 0;
}
$sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
$poolfree{$data[0]}++;
}
foreach my $key (keys %poolfree) {
print qq(
\n";
} elsif ($webvar{action} eq 'tweakpool') {
showPool($webvar{pool});
} elsif ($webvar{action} eq 'updatepool') {
$sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
"city='$webvar{city}', ptype='$webvar{ptype}', available='".
(($webvar{available} eq 'y') ? 'y' : 'n').
"', notes='$webvar{notes}', description='$webvar{desc}' ".
"where ip='$webvar{ip}'");
$sth->execute;
if ($sth->err) {
print "Error updating pool IP $webvar{ip}: $@\n";
syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
} else {
$sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
$sth->execute;
my @data = $sth->fetchrow_array;
print "$webvar{ip} in $data[0] updated\n\n";
syslog "notice", "$authuser updated pool IP $webvar{ip}";
}
showPool("$data[0]");
#} else {
# print "webvar{action} check failed: $webvar{action}";
}
# 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;
# 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";
}
}
# Do the gruntwork of allocating a block. This should really be in IPDB.pm.
sub allocBlock($$$$$$$$) {
my ($dbh,undef,undef,$type,$custid,$city,$desc,$notes) = @_;
my $from = new NetAddr::IP $_[1];
my $block = new NetAddr::IP $_[2];
local $ip_dbh->{AutoCommit} = 0; # enable transactions, if possible
local $ip_dbh->{RaiseError} = 1; # Use local to limit to this sub
if ($from eq $block) {
eval {
# common stuff for end-use, dialup, dynDSL, pools, etc, etc.
$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$block'");
$sth->execute;
# Insert the allocations entry
$sth = $ip_dbh->prepare("insert into allocations values ('$block',".
"'$custid','$type','$city','$desc','$notes',".$block->masklen.")");
$sth->execute;
$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");
} else {
syslog "notice", "$authuser allocated '$block' to '$custid'".
" as '$webvar{alloctype}'";
print "Block $block allocated to $custid. \n";
}
} else {
# The complex case. An allocation from a larger block.
# Gotta snag the free blocks left over.
my $wantmaskbits = $block->masklen;
my $maskbits = $from->masklen;
my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
my $i=0;
my $tmp_from = $from; # So we don't munge $from
while ($maskbits++ < $wantmaskbits) {
my @subblocks = $tmp_from->split($maskbits);
$newfreeblocks[$i++] = (($block->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
$tmp_from = ( ($block->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
} # while
# insert the data here. Woo.
# Begin SQL transaction block
eval {
# Delete old freeblocks entry
$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$from'");
$sth->execute();
# Insert the new freeblocks entries
$sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ".
"(select city from routed where cidr >>= '$block'),'y')");
foreach my $block (@newfreeblocks) {
$sth->execute("$block", $block->masklen);
}
# Insert the allocations entry
$sth = $ip_dbh->prepare("insert into allocations values ('$block',".
"'$custid','$type','$city','$desc','$notes',".$block->masklen.")");
$sth->execute;
$ip_dbh->commit;
}; # end eval
if ($@) {
carp "Transaction aborted because $@";
eval { $ip_dbh->rollback; };
syslog "err", "Allocation of '$block' to '$custid' as ".
"'$type' by $authuser failed: '$@'";
print "Allocation of $block as $full_alloc_types{$type} failed.\n";
} else {
syslog "notice", "$authuser allocated '$block' to '$custid'".
" as '$type'";
print "Block $block allocated to $custid. \n";
} # done OK?/NOK! check after DB changes
} # done "hard" allocation case.
# need to get /24 that block is part of
my @bits = split /\./, $webvar{block};
$bits[3] = "0/24";
showAllocs((join ".", @bits));
}
# List free blocks in a /24 for arbitrary manual allocation
sub showfree($) {
my $cidr = new NetAddr::IP $_[0];
print "Showing free blocks in $cidr \n".
"
\n";
$sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
my $temp = new NetAddr::IP $data[0];
print "
\n";
}
print "
\n";
}
# Show allocations to allow editing.
sub showAllocs($) {
my $cidr = new NetAddr::IP $_[0];
print "Edit custID, allocation type, city for allocations in ".
"$cidr:\n
";
$sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
print "
\n);
}
print "
\n";
# notes
print "Notes:\n".
"
\n
Use the main interface to update description and notes fields\n".
"
Changing the allocation type here will NOT affect IP pool data.\n".
"
\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 '$webvar{block}': '$@'";
} else {
# If we get here, the operation succeeded.
syslog "notice", "$authuser updated $webvar{block}";
print "Allocation $webvar{block} updated\n";
}
# need to get /24 that block is part of
my @bits = split /\./, $webvar{block};
$bits[3] = "0/24";
showAllocs((join ".", @bits));
}
# showPool()
# List all IPs in a pool, and allow arbitrary admin changes to each
# Allow changes to ALL fields
sub showPool($) {
my $pool = new NetAddr::IP $_[0];
print qq(Listing pool $pool:\n
Update the following record:
\n";
$sth = $ip_dbh->prepare("select * from poolips where pool='$pool' order by ip");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
print qq(