#!/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: 2004-12-01 20:42:57 +0000 (Wed, 01 Dec 2004) $ # SVN revision $Rev: 94 $ # Last update by $Author: kdeugau $ ### 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: ); } 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) = @_; } else { print "webvar{action} check failed"; } # 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]; # First, figure out what free blocks will get mangled. if ($from eq $block) { # Whee! Easy. Just allocate the block } 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 "OK!
\n"; } } # 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/IP '$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)); }