#!/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-07-06 21:23:27 +0000 (Tue, 06 Jul 2010) $
# SVN revision $Rev: 423 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004-2010 - Kris Deugau
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use CommonWeb qw(:ALL);
use CustIDCK;
#use POSIX qw(ceil);
use NetAddr::IP;
use Sys::Syslog;
# don't remove! required for GNU/FHS-ish install from tarball
##uselib##
use MyIPDB;
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".
"\n
\n\tAccess denied\n".
qq(\t\n).
qq(\t\n).
"\n\n".
qq(Access to this tool is restricted. Contact the IPDB administrator \n).
"for more information.\n\n\n";
exit;
}
my %webvar = parse_post();
cleanInput(\%webvar);
print "Content-type: text/html\n\n".
"\n\n\t[IPDB admin tools]\n".
qq(\t\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";
}
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 rWHOIS - data used for
blocks with the SWIP box checkmarked. Links to edit/add data are on this page.
List 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) Manage email notice options (pick which events
and allocation types cause notifications; configure recipient lists for notices)
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)
);
} 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 billing.
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 $IPDB::defcustid 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];
} 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}'";
mailNotify($ip_dbh, "a$webvar{alloctype}",
"$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(
Updating recipient list for '".dispNoticeCode($webvar{code})."':
\n";
$sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?");
$webvar{reciplist} =~ s/[\r\n]+/,/g;
$sth->execute($webvar{reciplist}, $webvar{code});
if ($sth->err) {
print "Failed: DB error: ".$sth->errstr."\n";
} else {
print "OK! \n"
}
print qq(Back to email notice list\n);
} elsif ($webvar{action} ne '') {
print "webvar{action} check failed: Don't know how to $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
#
print qq(Back to main interface\n);
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".
qq(
$temp
\n).
"
".
(($temp->masklen == 30) ? '30'
: "
".
qq(
$data[2]
).
"\n
\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".
qq(
$data[0]
\n).
qq(
\n).
"
\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
Customer ID:
Customer location:
Type:
Available?
Description/name:
Notes:
).
"
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(
$data[1]
).
"
$data[2]
$data[3]
$data[4]
".
"
$data[5]
$data[6]
$data[7]
\n";
}
print "
\n";
}
# interpret the notify codes
sub dispNoticeCode {
my $code = shift;
my $action_out = '';
# my $code = $notice_code;
if ($code =~ /^f:(.+)$/) {
$code =~ s/^f://;
$action_out = "Failure on ";
}
if (my $target = $code =~ /^n(.+)/) {
$action_out .= "New ";
if ($1 eq 'ci') { $action_out .= "city"; }
elsif ($1 eq 'no') { $action_out .= "node"; }
else { $action_out .= '<unknown>'; }
} else {
my ($action,$target) = ($code =~ /^(.)(.+)$/);
if ($action eq 'a') { $action_out .= 'Add '; }
elsif ($action eq 'u') { $action_out .= 'Update '; }
elsif ($action eq 'd') { $action_out .= 'Delete '; }
##fixme: what if we get something funky?
# What about the eleventy-billion odd combinations possible?
# this should give an idea of the structure tho
if ($target eq 'a') { $action_out .= "all"; }
elsif ($target =~ /^\.i$/) {
$action_out .= "all static IPs";
}
else { $action_out .= $disp_alloctypes{$target}; }
}
return $action_out;
}