#!/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: 2010-05-11 18:56:06 +0000 (Tue, 11 May 2010) $
# SVN revision $Rev: 398 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004-2006 - Kris Deugau
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use CommonWeb qw(:ALL);
use MyIPDB;
#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'};
}
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);
if ($IPDBacl{$authuser} !~ /A/) {
print "Content-Type: text/html\n\n".
"Access denied".
qq(\n).
'Access to this tool is restricted. Contact Kris '.
"for more information.\n";
exit;
}
my %webvar = parse_post();
cleanInput(\%webvar);
print "Content-type: text/html\n\n".
"\n\n\tTEST [IPDB admin tools] TEST\n".
qq(\t\n).
qq(\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";
}
my $masterlist = '';
$sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr");
$sth->execute;
while (my @data = $sth->fetchrow_array) {
$masterlist .= "\n";
}
print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
main interface if at all possible.
Add allocationrWHOIS tools:
Edit customer data for rWHOISList IP Pools for manual tweaking and updates
Manage users (add/remove users; change
internal access controls - note that this does NOT include IP-based limits)
Consistency check tools General: Check general netblock consistency. Free space: List total and aggregate free space. Does not
include private networks (192.168.0.0/16, 172.16.0.0/12, 10.0.0.0/8)
(r)WHOIS List customer data for WHOIS - data used for blocks with the SWIP box checkmarked.
Links to edit/add data are on this page.
);
} 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 '') {
# Type that doesn't have a default custid
$custid = $webvar{custid};
}
##fixme Check billing DB here
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];
} elsif ($webvar{alloctype} =~ /^(.)i$/) {
$sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')");
$sth->execute;
@data = $sth->fetchrow_array;
# User deserves errors if user can't be bothered to find the pool and a free IP first.
printAndExit("Can't allocate static IP from outside a pool!!\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 {
if ($webvar{alloctype} =~ /^.i$/) {
$sth = $ip_dbh->prepare("update poolips set available='n', custid='$webvar{custid}', ".
"city='$webvar{city}', description='$webvar{desc}', notes='$webvar{notes}' ".
"where ip='$webvar{cidr}'");
$sth->execute;
if ($sth->err) {
print "Allocation failed! DBI said:\n".$sth->errstr."\n";
syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
"'$webvar{alloctype}' failed: '".$sth->errstr."'";
} else {
print "Allocation OK!\n";
syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
"'$webvar{alloctype}'";
# Notify tech@example.com
mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
"$disp_alloctypes{$webvar{alloctype}} $webvar{cidr} allocated to customer".
" $webvar{custid}\n".
"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
}
} 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";
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{alloctype}' failed: '$msg'";
}
} # static IP vs netblock
} # 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(