#!/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-03-17 18:28:03 +0000 (Thu, 17 Mar 2005) $
# SVN revision $Rev: 200 $
# 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 MyIPDB;
use CustIDCK;
#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";
# Why not a global DB handle? (And a global statement handle, as well...)
# Use the connectDB function, otherwise we end up confusing ourselves
my $ip_dbh;
my $sth;
my $errstr;
($ip_dbh,$errstr) = connectDB_My;
if (!$ip_dbh) {
printAndExit("Database error: $errstr\n");
}
initIPDBGlobals($ip_dbh);
my %webvar = parse_post();
cleanInput(\%webvar);
print "Content-type: text/html\n\n".
"\n\n\tTEST [IPDB admin tools] TEST\n".
qq(\t\n).
"\n\n".
"
IPDB - Administrative Tools
\n\n";
if(!defined($webvar{action})) {
$webvar{action} = ""; #shuts up the warnings.
my $typelist = '';
$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
$sth->execute;
my @data = $sth->fetchrow_array;
$typelist .= "\n";
while (my @data = $sth->fetchrow_array) {
$typelist .= "\n";
}
print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
main interface if at all possible.
Add allocationList IP Pools for manual tweaking and updates
);
} else {
print 'Back to main';
}
## Possible actions.
if ($webvar{action} eq 'alloc') {
# OK, we know what we're allocating.
if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) {
printAndExit("Can't allocate something that's not a netblock/ip");
}
$sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'");
$sth->execute;
my @data = $sth->fetchrow_array;
my $custid = $data[0];
if ($custid eq '') {
if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
# Force uppercase for now...
$webvar{custid} =~ tr/a-z/A-Z/;
# Crosscheck with ... er... something.
my $status = CustIDCK->custid_exist($webvar{custid});
if ($CustIDCK::Error) {
printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
return;
}
if (!$status) {
printError("Customer ID not valid. Make sure the Customer ID ".
"is correct. \nUse STAFF for staff static IPs, and 6750400 for any other ".
"non-customer assignments.");
return;
}
}
# Type that doesn't have a default custid
$custid = $webvar{custid};
}
my $cidr = new NetAddr::IP $webvar{cidr};
my @data;
if ($webvar{alloctype} eq 'rm') {
$sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'");
$sth->execute;
@data = $sth->fetchrow_array;
# User deserves errors if user can't be bothered to find the free block first.
printAndExit("Can't allocate from outside a free block!!\n")
if !$data[0];
} else {
$sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')");
$sth->execute;
@data = $sth->fetchrow_array;
# User deserves errors if user can't be bothered to find the free block first.
printAndExit("Can't allocate from outside a routed block!!\n")
if !$data[0];
}
my $alloc_from = new NetAddr::IP $data[0];
$sth->finish;
my $cities = '';
foreach my $city (@citylist) {
$cities .= "\n";
}
print qq(
);
} elsif ($webvar{action} eq 'confirm') {
print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ".
"$disp_alloctypes{$webvar{alloctype}}... \n";
# Only need to check city here.
if ($webvar{city} eq '-') {
printError("Invalid customer location! Go back and select customer's location.");
} else {
my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from},
$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
$webvar{circid});
if ($retcode eq 'OK') {
print "Allocation OK!\n";
if ($webvar{alloctype} =~ /^.i$/) {
# Notify tech@example.com
mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
}
syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
"'$webvar{alloctype}'";
} else {
print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";
syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
"'$webvar{type}' failed: '$msg'";
}
} # done city check
} 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' or type like '%d' 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}', type='$webvar{type}', 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";
}
}
# 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 pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
print qq(