#!/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.
Allocate block from this /24:

Manually update allocation data in this /24:

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); } $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g; print $html; } elsif ($webvar{action} eq 'confirm') { print "Assigning $webvar{block} to $webvar{custid} (\"$webvar{desc}\")...\n"; allocBlock($ip_dbh, $webvar{allocfrom}, $webvar{block}, $webvar{alloctype}, $webvar{custid}, $webvar{city}, $webvar{desc}, $webvar{notes}); #my ($dbh,from,block,$type,$custid,$city,$desc,$notes) = @_; } elsif ($webvar{action} eq 'showpools') { print "IP Pools currently allocated:\n". "\n\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"; } print "
Pool# of free IPs
$key$poolfree{$key}
\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". qq(\n). "". qq(). "\n\n"; } print "
$temp". (($temp->masklen == 30) ? '30' : "$data[2]
\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(\n). qq(\n); print "\n"; print qq(\n). "". qq(\n); } print "
$data[0]$data[4]$data[5]
\n"; # notes print "
Notes:\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 * from poolips where pool='$pool' order by ip"); $sth->execute; while (my @data = $sth->fetchrow_array) { print qq(). "". "\n"; } print "
$data[1]$data[2]$data[3]$data[4]$data[5]$data[6]$data[7]
\n"; }