#!/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-10-14 15:19:15 +0000 (Fri, 14 Oct 2005) $
# SVN revision $Rev: 294 $
# 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'};
}
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\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\t[IPDB admin tools]\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
Manage users (add/remove users; change
internal access controls - note that this does NOT include IP-based limits)
);
} 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];
} 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(
\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}";
}
} elsif ($webvar{action} eq 'showusers') {
print "Notes: \n".
"
Admin users automatically get all other priviledges.\n".
"Add new user:\n";
print "Users with access:\n
\n";
print "
General access
\n";
print "
Username
Add new
Change
".
"
Delete
Systems/Networking
Admin user
\n".
"\n);
}
print "
\n";
} elsif ($webvar{action} eq 'updacl') {
print "Updating ACL for $webvar{username}: \n";
my $acl = 'b';
if ($webvar{admin} eq 'on') {
$acl .= "acdsA";
} else {
$acl .= ($webvar{add} eq 'on' ? 'a' : '').
($webvar{change} eq 'on' ? 'c' : '').
($webvar{del} eq 'on' ? 'd' : '').
($webvar{sysnet} eq 'on' ? 's' : '');
}
print "New ACL: $acl \n";
$sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'");
$sth->execute;
print "OK\n" if !$sth->err;
print qq(Back to user listing\n);
} elsif ($webvar{action} eq 'newuser') {
print "Adding user $webvar{username}...\n";
my $cr_pass = ($webvar{preenc} ? $webvar{password} :
crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]));
$sth = $ip_dbh->prepare("insert into users (username,password,acl) values ".
"('$webvar{username}','$cr_pass','b')");
$sth->execute;
if ($sth->err) {
print " Error adding user: ".$sth->errstr;
} else {
print "OK\n";
}
print qq(Back to user listing\n);
} elsif ($webvar{action} eq 'deluser') {
print "Deleting user $webvar{username}. \n";
$sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'");
$sth->execute;
print "OK\n" if !$sth->err;
print qq(Back to user listing\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
#
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(