A single IP address from a designated pool
+on the cable network.
+
+
Static IP - DSL
A single IP address from a designated pool
+on the DSL network. Note that these are nominally in Sudbury or North Bay,
+even if the customer isn't.
+
+
Static IP - Dialup
A single IP address from a designated pool
+on a dialup RAS.
+
+
Static IP - Wireless
A single IP address from a designated pool
+on one of our wireless networks.
+
+
+
+
Static pool - Servers
A pool of IP addresses available for one-by-one
+assignment to servers in a POP. This will usually only be in Sudbury.
+
+
Static pool - Cable
A pool of IP addresses available for one-by-one assignment
+to customers on cable.
+
+
Static pool - DSL
A pool of IP addresses available for one-by-one assignment to
+customers on DSL. Note that individual IPs will be "assigned" to the customer's
+city, but the pool they are a part of will normally be "assigned" to Sudbury or
+North Bay.
+
+
Static pool - Dialup
A pool of IP addresses available for one-by-one
+assignment to dialup customers.
+
+
Static pool - Wireless
A pool of IP addresses available for one-by-one
+assignment to customers on one of our wireless networks.
+
+
+
+
End-use netblock
A /30 or larger allocation for arbitrary services (LAN
+management, servers we want fully subnet-isolated, etc)
+
+
+
Dialup netblock
Netblock assigned to one or more RAS units in a POP
+
+
Dynamic DSL block
Netblock for (mostly residential) PPPoE DSL. Nominally
+"assigned" to Sudbury
+
+
Dynamic cable block
Netblock for (mostly residential) DHCP cable.
+
+
+
Routing
Blocks not actually assigned to a service on their own, but which
+have been routed to individual POPs- typically /24, /23, /22
+ );
+ printFooter();
+ exit(0);
+}
+
+# needs a reference to the webvar hash.
+# takes out backticks and single quotes
+sub cleanInput($)
+{
+ my $hashRef = $_[0];
+
+ foreach my $key (keys %$hashRef)
+ {
+ $hashRef->{$key} =~ s/`/\\`/g;
+ $hashRef->{$key} =~ s/'/\'/g;
+ }
+}
+
+# undoes clean input. takes a string as an arg.
+sub desanitize($)
+{
+ my $string = $_[0];
+ $string =~ s/\\`/`/g;
+ $string =~ s/\\'/'/g;
+ return $string;
+}
+
+# indicate that the module loaded okay.
+1;
Index: branches/new-custids/cgi-bin/IPDB.pm
===================================================================
--- branches/new-custids/cgi-bin/IPDB.pm (revision 196)
+++ branches/new-custids/cgi-bin/IPDB.pm (revision 196)
@@ -0,0 +1,617 @@
+# ipdb/cgi-bin/IPDB.pm
+# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004,2005 - Kris Deugau
+
+package IPDB;
+
+use strict;
+use warnings;
+use Exporter;
+use DBI;
+use Net::SMTP;
+use POSIX;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+$VERSION = 2.0;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(
+ %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
+ %allocated %free %routed %bigfree
+ &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
+ &mailNotify
+ );
+
+@EXPORT = (); # Export nothing by default.
+%EXPORT_TAGS = ( ALL => [qw(
+ %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
+ @masterblocks %allocated %free %routed %bigfree
+ &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
+ &deleteBlock &mailNotify
+ )]
+ );
+
+##
+## Global variables
+##
+our %disp_alloctypes;
+our %list_alloctypes;
+our %def_custids;
+our @citylist;
+our @poplist;
+our @masterblocks;
+our %allocated;
+our %free;
+our %routed;
+our %bigfree;
+
+# Let's initialize the globals.
+## IPDB::initIPDBGlobals()
+# Initialize all globals. Takes a database handle, returns a success or error code
+sub initIPDBGlobals {
+ my $dbh = $_[0];
+ my $sth;
+
+ # Initialize alloctypes hashes
+ $sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
+ $sth->execute;
+ while (my @data = $sth->fetchrow_array) {
+ $disp_alloctypes{$data[0]} = $data[2];
+ $def_custids{$data[0]} = $data[4];
+ if ($data[3] < 900) {
+ $list_alloctypes{$data[0]} = $data[1];
+ }
+ }
+
+ # City and POP listings
+ $sth = $dbh->prepare("select city,routing from cities order by city");
+ $sth->execute;
+ return (undef,$sth->errstr) if $sth->err;
+ while (my @data = $sth->fetchrow_array) {
+ push @citylist, $data[0];
+ if ($data[1] eq 'y') {
+ push @poplist, $data[0];
+ }
+ }
+
+ # Master block list
+ $sth = $dbh->prepare("select cidr from masterblocks order by cidr");
+ $sth->execute;
+ for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
+ $masterblocks[$i] = new NetAddr::IP $data[0];
+ $allocated{"$masterblocks[$i]"} = 0;
+ $free{"$masterblocks[$i]"} = 0;
+ $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
+ # Set to 128 to prepare for IPv6
+ $routed{"$masterblocks[$i]"} = 0;
+ }
+ return (undef,$sth->errstr) if $sth->err;
+
+ return (1,"OK");
+} # end initIPDBGlobals
+
+
+## IPDB::connectDB()
+# Creates connection to IPDB.
+# Requires the database name, username, and password.
+# Returns a handle to the db.
+# Set up for a PostgreSQL db; could be any transactional DBMS with the
+# right changes.
+# This definition should be sub connectDB($$$) to be technically correct,
+# but this breaks. GRR.
+sub connectDB {
+ my ($dbname,$user,$pass) = @_;
+ my $dbh;
+ my $DSN = "DBI:Pg:dbname=$dbname";
+# my $user = 'ipdb';
+# my $pw = 'ipdbpwd';
+
+# Note that we want to autocommit by default, and we will turn it off locally as necessary.
+# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
+ $dbh = DBI->connect($DSN, $user, $pass, {
+ AutoCommit => 1,
+ PrintError => 0
+ })
+ or return (undef, $DBI::errstr) if(!$dbh);
+
+# Return here if we can't select. Note that this indicates a
+# problem executing the select.
+ my $sth = $dbh->prepare("select type from alloctypes");
+ $sth->execute();
+ return (undef,$DBI::errstr) if ($sth->err);
+
+# See if the select returned anything (or null data). This should
+# succeed if the select executed, but...
+ $sth->fetchrow();
+ return (undef,$DBI::errstr) if ($sth->err);
+
+# If we get here, we should be OK.
+ return ($dbh,"DB connection OK");
+} # end connectDB
+
+
+## IPDB::finish()
+# Cleans up after database handles and so on.
+# Requires a database handle
+sub finish {
+ my $dbh = $_[0];
+ $dbh->disconnect;
+} # end finish
+
+
+## IPDB::checkDBSanity()
+# Quick check to see if the db is responding. A full integrity
+# check will have to be a separate tool to walk the IP allocation trees.
+sub checkDBSanity {
+ my ($dbh) = $_[0];
+
+ if (!$dbh) {
+ print "No database handle, or connection has been closed.";
+ return -1;
+ } else {
+ # it connects, try a stmt.
+ my $sth = $dbh->prepare("select type from alloctypes");
+ my $err = $sth->execute();
+
+ if ($sth->fetchrow()) {
+ # all is well.
+ return 1;
+ } else {
+ print "Connected to the database, but could not execute test statement. ".$sth->errstr();
+ return -1;
+ }
+ }
+ # Clean up after ourselves.
+# $dbh->disconnect;
+} # end checkDBSanity
+
+
+## IPDB::allocateBlock()
+# Does all of the magic of actually allocating a netblock
+# Requires database handle, block to allocate, custid, type, city,
+# description, notes, circuit ID, block to allocate from,
+# Returns a success code and optional error message.
+sub allocateBlock {
+ my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid) = @_;
+
+ my $cidr = new NetAddr::IP $_[1];
+ my $alloc_from = new NetAddr::IP $_[2];
+ my $sth;
+
+ # To contain the error message, if any.
+ my $msg = "Unknown error allocating $cidr as '$type'";
+
+ # Enable transactions and error handling
+ local $dbh->{AutoCommit} = 0; # These need to be local so we don't
+ local $dbh->{RaiseError} = 1; # step on our toes by accident.
+
+ if ($type =~ /^.i$/) {
+ $msg = "Unable to assign static IP $cidr to $custid";
+ eval {
+ # We have to do this in two parts because otherwise we lose
+ # the ability to return the IP assigned. Should that change,
+ # the commented SQL statement below may become usable.
+# update poolips set custid='$custid',city='$city',available='n',
+# description='$desc',notes='$notes',circuitid='$circid'
+# where ip=(select ip from poolips where pool='$alloc_from'
+# and available='y' order by ip limit 1);
+
+ $sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'".
+ " and available='y' order by ip");
+ $sth->execute;
+
+ my @data = $sth->fetchrow_array;
+ $cidr = $data[0]; # $cidr is already declared when we get here!
+
+ $sth = $dbh->prepare("update poolips set custid='$custid',".
+ "city='$city',available='n',description='$desc',notes='$notes',".
+ "circuitid='$circid'".
+ " where ip='$cidr'");
+ $sth->execute;
+ $dbh->commit;
+ };
+ if ($@) {
+ $msg .= ": '".$sth->errstr."'";
+ eval { $dbh->rollback; };
+ return ('FAIL',$msg);
+ } else {
+ return ('OK',"$cidr");
+ }
+
+ } else { # end IP-from-pool allocation
+
+ if ($cidr == $alloc_from) {
+ # Easiest case- insert in one table, delete in the other, and go home. More or less.
+ # insert into allocations values (cidr,custid,type,city,desc) and
+ # delete from freeblocks where cidr='cidr'
+ # For data safety on non-transaction DBs, we delete first.
+
+ eval {
+ $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
+ if ($type eq 'rm') {
+ $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
+ " where cidr='$cidr'");
+ $sth->execute;
+ $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
+ " values ('$cidr',".$cidr->masklen.",'$city')");
+ $sth->execute;
+ } else {
+ # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
+
+ # special case - block is a container/"reserve" block
+ if ($type =~ /^(.)c$/) {
+ $sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
+ $sth->execute;
+ } else {
+ # "normal" case
+ $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
+ $sth->execute;
+ }
+ $sth = $dbh->prepare("insert into allocations".
+ " (cidr,custid,type,city,description,notes,maskbits,circuitid)".
+ " values ('$cidr','$custid','$type','$city','$desc','$notes',".
+ $cidr->masklen.",'$circid')");
+ $sth->execute;
+
+ # And initialize the pool, if necessary
+ # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
+ # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
+ if ($type =~ /^.p$/) {
+ $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
+ my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
+ die $rmsg if $code eq 'FAIL';
+ } elsif ($type =~ /^.d$/) {
+ $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
+ my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
+ die $rmsg if $code eq 'FAIL';
+ }
+
+ } # routing vs non-routing netblock
+
+ $dbh->commit;
+ }; # end of eval
+ if ($@) {
+ $msg .= ": ".$@;
+ eval { $dbh->rollback; };
+ return ('FAIL',$msg);
+ } else {
+ return ('OK',"OK");
+ }
+
+ } else { # cidr != alloc_from
+
+ # Hard case. Allocation is smaller than free block.
+ my $wantmaskbits = $cidr->masklen;
+ my $maskbits = $alloc_from->masklen;
+
+ my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
+
+ # This determines which blocks will be left "free" after allocation. We take the
+ # block we're allocating from, and split it in half. We see which half the wanted
+ # block is in, and repeat until the wanted block is equal to one of the halves.
+ my $i=0;
+ my $tmp_from = $alloc_from; # So we don't munge $alloc_from
+ while ($maskbits++ < $wantmaskbits) {
+ my @subblocks = $tmp_from->split($maskbits);
+ $newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
+ $tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
+ } # while
+
+ # Begin SQL transaction block
+ eval {
+ $msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
+
+ # Delete old freeblocks entry
+ $sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
+ $sth->execute();
+
+ # now we have to do some magic for routing blocks
+ if ($type eq 'rm') {
+
+ # Insert the new freeblocks entries
+ # Note that non-routed blocks are assigned to
+ # and use the default value for the routed column ('n')
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
+ " values (?, ?, '')");
+ foreach my $block (@newfreeblocks) {
+ $sth->execute("$block", $block->masklen);
+ }
+
+ # Insert the entry in the routed table
+ $sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
+ " values ('$cidr',".$cidr->masklen.",'$city')");
+ $sth->execute;
+ # Insert the (almost) same entry in the freeblocks table
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
+ " values ('$cidr',".$cidr->masklen.",'$city','y')");
+ $sth->execute;
+
+ } else { # done with alloctype == rm
+
+ # Insert the new freeblocks entries
+ # Along with some more HairyPerl(TM) in case we're inserting a
+ # subblock (.r) allocation
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
+ " values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
+ (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
+ foreach my $block (@newfreeblocks) {
+ $sth->execute("$block", $block->masklen);
+ }
+ # Special-case for reserve/"container" blocks - generate
+ # the "extra" freeblocks entry for the container
+ if ($type =~ /^(.)c$/) {
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
+ " values ('$cidr',".$cidr->masklen.",'$city','$1')");
+ $sth->execute;
+ }
+ # Insert the allocations entry
+ $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
+ "description,notes,maskbits,circuitid)".
+ " values ('$cidr','$custid','$type','$city','$desc','$notes',".
+ $cidr->masklen.",'$circid')");
+ $sth->execute;
+
+ # And initialize the pool, if necessary
+ # PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
+ # "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
+ if ($type =~ /^.p$/) {
+ $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
+ my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
+ die $rmsg if $code eq 'FAIL';
+ } elsif ($type =~ /^.d$/) {
+ $msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
+ my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
+ die $rmsg if $code eq 'FAIL';
+ }
+
+ } # done with netblock alloctype != rm
+
+ $dbh->commit;
+ }; # end eval
+ if ($@) {
+ eval { $dbh->rollback; };
+ return ('FAIL',$msg);
+ } else {
+ return ('OK',"OK");
+ }
+
+ } # end fullcidr != alloc_from
+
+ } # end static-IP vs netblock allocation
+
+} # end allocateBlock()
+
+
+## IPDB::initPool()
+# Initializes a pool
+# Requires a database handle, the pool CIDR, type, city, and a parameter
+# indicating whether the pool should allow allocation of literally every
+# IP, or if it should reserve network/gateway/broadcast IPs
+# Note that this is NOT done in a transaction, that's why it's a private
+# function and should ONLY EVER get called from allocateBlock()
+sub initPool {
+ my ($dbh,undef,$type,$city,$class) = @_;
+ my $pool = new NetAddr::IP $_[1];
+
+##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
+ $type =~ s/[pd]$/i/;
+ my $sth;
+ my $msg;
+
+ # Trap errors so we can pass them back to the caller. Even if the
+ # caller is only ever supposed to be local, and therefore already
+ # trapping errors. >:(
+ local $dbh->{AutoCommit} = 0; # These need to be local so we don't
+ local $dbh->{RaiseError} = 1; # step on our toes by accident.
+
+ eval {
+ # have to insert all pool IPs into poolips table as "unallocated".
+ $sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
+ " values ('$pool', ?, '6750400', '$city', '$type')");
+ my @poolip_list = $pool->hostenum;
+ if ($class eq 'all') { # (DSL-ish block - *all* IPs available
+ $sth->execute($pool->addr);
+ for (my $i=0; $i<=$#poolip_list; $i++) {
+ $sth->execute($poolip_list[$i]->addr);
+ }
+ $pool--;
+ $sth->execute($pool->addr);
+ } else { # (real netblock)
+ for (my $i=1; $i<=$#poolip_list; $i++) {
+ $sth->execute($poolip_list[$i]->addr);
+ }
+ }
+ };
+ if ($@) {
+ $msg = "'".$sth->errstr."'";
+ eval { $dbh->rollback; };
+ return ('FAIL',$msg);
+ } else {
+ return ('OK',"OK");
+ }
+} # end initPool()
+
+
+## IPDB::deleteBlock()
+# Removes an allocation from the database, including deleting IPs
+# from poolips and recombining entries in freeblocks if possible
+# Also handles "deleting" a static IP allocation, and removal of a master
+# Requires a database handle, the block to delete, and the type of block
+sub deleteBlock {
+ my ($dbh,undef,$type) = @_;
+ my $cidr = new NetAddr::IP $_[1];
+
+ my $sth;
+
+ # To contain the error message, if any.
+ my $msg = "Unknown error deallocating $type $cidr";
+ # Enable transactions and exception-on-errors... but only for this sub
+ local $dbh->{AutoCommit} = 0;
+ local $dbh->{RaiseError} = 1;
+
+ # First case. The "block" is a static IP
+ # Note that we still need some additional code in the odd case
+ # of a netblock-aligned contiguous group of static IPs
+ if ($type =~ /^.i$/) {
+
+ eval {
+ $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
+ $sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
+ "city=(select city from allocations where cidr >>= '$cidr'),".
+ "description='',notes='',circuitid='' where ip='$cidr'");
+ $sth->execute;
+ $dbh->commit;
+ };
+ if ($@) {
+ eval { $dbh->rollback; };
+ return ('FAIL',$msg);
+ } else {
+ return ('OK',"OK");
+ }
+
+ } elsif ($type eq 'mm') { # end alloctype =~ /.i/
+
+ $msg = "Unable to delete master block $cidr";
+ eval {
+ $sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
+ $sth->execute;
+ $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
+ $sth->execute;
+ $dbh->commit;
+ };
+ if ($@) {
+ eval { $dbh->rollback; };
+ return ('FAIL', $msg);
+ } else {
+ return ('OK',"OK");
+ }
+
+ } else { # end alloctype master block case
+
+ ## This is a big block; but it HAS to be done in a chunk. Any removal
+ ## of a netblock allocation may result in a larger chunk of free
+ ## contiguous IP space - which may in turn be combined into a single
+ ## netblock rather than a number of smaller netblocks.
+
+ eval {
+
+ if ($type eq 'rm') {
+ $msg = "Unable to remove routing allocation $cidr";
+ $sth = $dbh->prepare("delete from routed where cidr='$cidr'");
+ $sth->execute;
+ # Make sure block getting deleted is properly accounted for.
+ $sth = $dbh->prepare("update freeblocks set routed='n',city=''".
+ " where cidr='$cidr'");
+ $sth->execute;
+ # Set up query to start compacting free blocks.
+ $sth = $dbh->prepare("select cidr from freeblocks where ".
+ "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
+
+ } else { # end alloctype routing case
+
+ # Delete all allocations within the block being deleted. This is
+ # deliberate and correct, and removes the need to special-case
+ # removal of "container" blocks.
+ $sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
+ $sth->execute;
+
+ # Special case - delete pool IPs
+ if ($type =~ /^.[pd]$/) {
+ # We have to delete the IPs from the pool listing.
+ $sth = $dbh->prepare("delete from poolips where pool='$cidr'");
+ $sth->execute;
+ }
+
+ # Set up query for compacting free blocks.
+ $sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
+ "(select cidr from routed where cidr >>= '$cidr') ".
+ " and maskbits<=".$cidr->masklen.
+ " and routed='".(($type =~ /^(.)r$/) ? '$1' : 'y').
+ "' order by maskbits desc");
+
+ } # end alloctype general case
+
+ # Now we look for larger-or-equal-sized free blocks in the same master (routed)
+ # (super)block. If there aren't any, we can't combine blocks anyway. If there
+ # are, we check to see if we can combine blocks.
+ # Execute the statement prepared in the if-else above.
+
+ $sth->execute;
+
+# NetAddr::IP->compact() attempts to produce the smallest inclusive block
+# from the caller and the passed terms.
+# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
+# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
+# .64-.95, and .96-.128), you will get an array containing a single
+# /25 as element 0 (.0-.127). Order is not important; you could have
+# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
+
+ my (@together, @combinelist);
+ my $i=0;
+ while (my @data = $sth->fetchrow_array) {
+ my $testIP = new NetAddr::IP $data[0];
+ @together = $testIP->compact($cidr);
+ my $num = @together;
+ if ($num == 1) {
+ $cidr = $together[0];
+ $combinelist[$i++] = $testIP;
+ }
+ }
+
+ # Clear old freeblocks entries - if any. They should all be within
+ # the $cidr determined above.
+ $sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
+ $sth->execute;
+
+ # insert "new" freeblocks entry
+ if ($type eq 'rm') {
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
+ " values ('$cidr',".$cidr->masklen.",'')");
+ } else {
+ $sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
+ " values ('$cidr',".$cidr->masklen.
+ ",(select city from routed where cidr >>= '$cidr'),'".
+ (($type =~ /^(.)r$/) ? "$1" : 'y')."')");
+ }
+ $sth->execute;
+
+ # If we got here, we've succeeded. Whew!
+ $dbh->commit;
+ }; # end eval
+ if ($@) {
+ eval { $dbh->rollback; };
+ return ('FAIL', $msg);
+ } else {
+ return ('OK',"OK");
+ }
+
+ } # end alloctype != netblock
+
+} # end deleteBlock()
+
+
+## IPDB::mailNotify()
+# Sends notification mail to recipients regarding an IPDB operation
+sub mailNotify ($$$) {
+ my ($recip,$subj,$message) = @_;
+ my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
+
+ $mailer->mail('ipdb@example.com');
+ $mailer->to($recip);
+ $mailer->data("From: \"IP Database\" \n",
+ "To: $recip\n",
+ "Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
+ "Subject: {IPDB} $subj\n",
+ "X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
+ "Organization: Example Corp\n",
+ "\n$message\n");
+ $mailer->quit;
+}
+
+# Indicates module loaded OK. Required by Perl.
+1;
Index: branches/new-custids/cgi-bin/MyIPDB.pm
===================================================================
--- branches/new-custids/cgi-bin/MyIPDB.pm (revision 196)
+++ branches/new-custids/cgi-bin/MyIPDB.pm (revision 196)
@@ -0,0 +1,22 @@
+# ipdb/cgi-bin/MyIPDB.pm
+# Contains site-specific functions for IPDB
+# May override some functions from IPDB.pm, wraps others
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004,2005 - Kris Deugau
+
+use IPDB 2.0 qw(:ALL);
+
+## connectDB_My()
+# Wrapper for IPDB::connectDB
+# Takes no arguments, returns whatever IPDB::connectDB returns.
+sub connectDB_My {
+ return connectDB("ipdb", "ipdb", "ipdbpwd");
+} # end connectDB_My()
+
+# Keep Perl from complaining.
+1;
Index: branches/new-custids/cgi-bin/admin.cgi
===================================================================
--- branches/new-custids/cgi-bin/admin.cgi (revision 196)
+++ branches/new-custids/cgi-bin/admin.cgi (revision 196)
@@ -0,0 +1,414 @@
+#!/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$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# 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.
+
+
+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";
+ $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";
+} 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";
+ }
+ 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 * 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";
+}
Index: branches/new-custids/cgi-bin/consistency-check.pl
===================================================================
--- branches/new-custids/cgi-bin/consistency-check.pl (revision 196)
+++ branches/new-custids/cgi-bin/consistency-check.pl (revision 196)
@@ -0,0 +1,224 @@
+#!/usr/bin/perl
+# ipdb/cgi-bin/consistency-check.pl
+# Does full check to see if the data in the db is consistent and complete.
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004 - Kris Deugau
+
+use DBI;
+use MyIPDB;
+use NetAddr::IP;
+
+($dbh,$errstr) = connectDB_My;
+
+# May as well. We need a number of globals.
+initIPDBGlobals($dbh);
+
+print "Checking master containment...\n";
+
+# First check - make sure ALL routes and allocated blocks are part
+# of one of the master blocks.
+print " Checking routed blocks:";
+$sth = $dbh->prepare("select cidr from routed");
+$sth->execute;
+$flag = '';
+ROUTED: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next ROUTED; }
+ }
+ print "\n $cidr not mastered";
+}
+print "$flag done.\n";
+
+# Next test: All allocations must be part of a master.
+print " Checking allocations:";
+$sth = $dbh->prepare("select cidr from allocations");
+$sth->execute;
+$flag = '';
+ALLOCATED: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next ALLOCATED; }
+ }
+ print "\n $cidr not mastered";
+ $flag = "\n ";
+}
+print "$flag done.\n";
+
+# Next: free blocks
+print " Checking freeblocks:";
+$sth = $dbh->prepare("select cidr from freeblocks order by cidr");
+$sth->execute;
+$flag = '';
+FREEBLOCK: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next FREEBLOCK; }
+ }
+ print "\n $cidr not mastered";
+ $flag = "\n ";
+}
+print "$flag done.\n";
+
+print "Done checking master containment.\n\n";
+
+print "Checking pool containment...\n";
+
+$sth = $dbh->prepare("select pool,ip from poolips order by ip");
+$sth->execute;
+while (@data = $sth->fetchrow_array) {
+ $pool = new NetAddr::IP $data[0];
+ $ip = new NetAddr::IP $data[1];
+ print " IP $ip listed with incorrect pool $pool\n"
+ if !$pool->contains($ip);
+}
+$sth = $dbh->prepare("select distinct pool from poolips order by pool");
+$sth->execute;
+while (@data = $sth->fetchrow_array) {
+ $sth2 = $dbh->prepare("select cidr from allocations where cidr='$data[0]'");
+ $sth2->execute;
+ print " Pool $data[0] does not exist in allocations table\n"
+ if (($sth2->fetchrow_array)[0] eq '');
+}
+
+print "Done checking pool containment.\n\n";
+
+print "Checking block-alignment consistency...\n";
+
+# Block alignment consistency: All allocated+free blocks within a master
+# must NOT overlap, and they must show no gaps.
+# eg, if we have blocks:
+# master is 192.168.2.0/24
+# allocated 192.168.2.0/29, 192.168.2.8/29, 192.168.2.64/26
+# free 192.168.2.16/28, 192.168.2.32/27, 192.168.2.128/25
+# then we're OK, but if any one of the allocated or free blocks is missing,
+# something b0rked.
+
+# (select cidr from allocations where cidr <<= '$master') union
+# (select cidr from freeblocks where cidr <<= '$master')
+# order by cidr
+
+foreach $master (@masterblocks) {
+ print " Master $master:\n";
+ $prev = $master;
+ $sth = $dbh->prepare("(select network(cidr) as net, broadcast(cidr) as bcast ".
+ "from allocations where cidr <<= '$master' and type not like '_c') ".
+ "union (select network(cidr) as net, broadcast(cidr) as bcast ".
+ "from freeblocks where cidr <<= '$master' and not (routed='c')) order by net");
+ $sth->execute;
+
+ while (@data = $sth->fetchrow_array) {
+ $cur = new NetAddr::IP $data[0];
+
+ if ($master->numeric == $prev->numeric) {
+ # check if cur starts with master
+ if ($cur->numeric > $prev->numeric) {
+ print " Gap from start of master $master to first block $cur\n";
+ } elsif ($cur->numeric < $prev->numeric) {
+ print " BIG problem! Current block $cur begins before master $master!\n";
+ }
+ } else {
+ if ($cur->numeric < ($prev->numeric + 1)) {
+ print " Block ".$prev->network." overlaps block $cur\n";
+ } elsif ($cur->numeric > ($prev->numeric + 1)) {
+ print " Gap between end of block ".$prev->network." and block $cur\n";
+ }
+ }
+
+ $prev = $cur;
+ $prev--;
+
+ } # while (@data...)
+
+ $cur--;
+ $master--;
+ if ($cur->numeric ne $master->numeric) {
+ print " Gap from $cur to end of master at $master\n";
+ }
+ print " done $master.\n";
+}
+
+print "Done checking block alignment.\n\n";
+
+print "Checking containment on container blocks...\n";
+# First, we need a list of containers.
+# Then, we check all of the contained blocks to see if they're within
+# the proper container.
+$sth = $dbh->prepare("select cidr from allocations where type like '_c' order by cidr");
+$sth->execute;
+$i=0;
+while (@data = $sth->fetchrow_array) {
+ $containers[$i++] = new NetAddr::IP $data[0];
+}
+print " Checking general containment:";
+$sth = $dbh->prepare("select cidr from allocations where type like '_r' order by cidr");
+$sth->execute;
+$flag = '';
+CONTAINED: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $container (@containers) {
+ next CONTAINED if $container->contains($cidr);
+ }
+ print "\n $cidr not contained";
+ $flag = "\n ";
+}
+print "$flag done.\n";
+print " Checking alignment:\n";
+foreach $container (@containers) {
+ print " Container $container:\n";
+ $prev = $container;
+ $sth = $dbh->prepare("(select network(cidr) as net, broadcast(cidr) as bcast ".
+ "from allocations where cidr <<= '$container' and type like '_r') ".
+ "union (select network(cidr) as net, broadcast(cidr) as bcast ".
+ "from freeblocks where cidr <<= '$container' and routed='w') order by net");
+ $sth->execute;
+
+ while (@data = $sth->fetchrow_array) {
+ $cur = new NetAddr::IP $data[0];
+
+ if ($container->numeric == $prev->numeric) {
+ # check if cur starts with master
+ if ($cur->numeric > $prev->numeric) {
+ print " Gap from start of container $container to first block $cur\n";
+ } elsif ($cur->numeric < $prev->numeric) {
+ print " BIG problem! Current block $cur begins before container $container!\n";
+ }
+ } else {
+ if ($cur->numeric < ($prev->numeric + 1)) {
+ print " Block ".$prev->network." overlaps block $cur\n";
+ } elsif ($cur->numeric > ($prev->numeric + 1)) {
+ print " Gap between end of block ".$prev->network." and block $cur\n";
+ }
+ }
+
+ $prev = $cur;
+ $prev--;
+
+ } # while (@data...)
+
+ $cur--;
+ $container--;
+ if ($cur->numeric ne $container->numeric) {
+ print " Gap from $cur to end of container at $container\n";
+ }
+ print " done $container.\n";
+
+}
+print " done container alignment.\n";
+print "Done checking container containment.\n\n";
+
+print "Checking for correctness on 'defined' CustIDs:\n";
+# New check: Make sure "defined" CustIDs are correct.
+$sth = $dbh->prepare("select cidr,type,custid from allocations where not type='cn' order by cidr");
+$sth->execute;
+while (@data = $sth->fetchrow_array) {
+ print "$data[0] ($disp_alloctypes{$data[1]}) has incorrect CustID $data[2]\n"
+ if $data[2] ne $def_custids{$data[1]};
+}
+
+print "Done CustID correctness check.\n";
Index: branches/new-custids/cgi-bin/extras/db2rwhois.pl
===================================================================
--- branches/new-custids/cgi-bin/extras/db2rwhois.pl (revision 196)
+++ branches/new-custids/cgi-bin/extras/db2rwhois.pl (revision 196)
@@ -0,0 +1,155 @@
+#!/usr/bin/perl
+# -T
+# ipdb/cgi-bin/extras/db2rwhois.pl
+# Pull data from ipdb and mangle it into RWHOIS
+# Initial version 03/26/2004 kdeugau against IPDB v1
+###
+# Revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004,2005 - Kris Deugau
+
+use strict;
+use warnings;
+use DBI;
+use NetAddr::IP;
+use MyIPDB;
+
+$ENV{"PATH"} = "/bin;/usr/bin";
+
+my $rwhoisDataPath = "/etc/rwhoisd";
+
+# We'll pull this out of the database instead. Just make sure our
+# master blocks are actually listed....
+#@masterblocks = (
+# (new NetAddr::IP "209.91.128.0/18"),
+# (new NetAddr::IP "66.186.64.0/19"),
+# (new NetAddr::IP "192.168.99.0/24")
+# );
+
+my ($dbh,$msg) = connectDB_My;
+
+# For WHOIS purposes this may not be very useful. YMMV, we'll see.
+#initIPDBGlobals($dbh);
+
+my @masterblocks;
+
+# Fill in data about our master blocks as allocated from ARIN
+# We open separate files for each of these as appropriate.
+# Note that this ASS-U-MEs that we do not add master IP blocks-
+# there should probably be a separate system for doing that.
+my $sth = $dbh->prepare("select * from masterblocks;");
+$sth->execute;
+my $i=0;
+GETMASTERS: while (my @data = $sth->fetchrow_array()) {
+
+ if ($data[0] =~ /^(192.168.0.0|172.16.0.0|10.0.0.0)/) {
+ next GETMASTERS;
+ }
+ $masterblocks[$i] = new NetAddr::IP $data[0];
+
+print "$masterblocks[$i]\n";
+
+ my $date;
+ chomp ($date = `/bin/date +"%Y%m%d"`);
+
+# Whew! Ugly little varmint.
+ my $masterfilename = "net-".$masterblocks[$i]->addr."-".$masterblocks[$i]->masklen.
+ "/data/network/".$masterblocks[$i]->addr."-".$masterblocks[$i]->masklen.".txt";
+
+# Need check here to create tree for netblock?
+
+ open MASTERFILE,">$rwhoisDataPath/$masterfilename";
+
+ print MASTERFILE "ID: NETBLK-ISP.$masterblocks[$i]\n".
+ "Auth-Area: $masterblocks[$i]\n".
+ "Network-Name: ISP-".$masterblocks[$i]->network."\n".
+ "IP-Network: $masterblocks[$i]\n".
+ "IP-Network-Block: ".$masterblocks[$i]->range."\n".
+ "Organization: Friendly ISP\n".
+ "Tech-Contact: noc\@example.com\n".
+ "Admin-Contact: ISP-ARIN-HANDLE\n".
+ "Abuse-Contact: abuse\@example.com\n".
+ "Created: 20040308\n".
+ "Updated: $date\n".
+ "Updated-By: noc\@example.com\n";
+
+ close MASTERFILE;
+ $i++;
+}
+
+# Now read out the data in the "main" delegation list, and check it
+# with the master blocks. We need to do this to decide which rWHOIS
+# "net-xxx.xxx.xxx.xxx-mask" tree the data belongs in.
+
+# Make sure to remove the private netblocks from this.
+# No use or point in broadcasting our use of them.
+$sth = $dbh->prepare("select * from allocations where not (cidr <<= '192.168.0.0/16') and not (cidr <<= '172.16.0.0/12') and not (cidr <<= '10.0.0.0/8') and custid='6750400'");
+$sth->execute;
+
+while (my @data = $sth->fetchrow_array()) {
+
+# We get master block info from @masterblocks.
+ # ID: NETBLK-ISP.10.0.0.0/8
+ # Auth-Area: 10.0.0.0/8
+ # Network-Name: ISP-10.0.2.144
+ # IP-Network: 10.0.2.144.144/29
+ # IP-Network-Block: 10.0.2.144 - 10.0.2.151
+ # Organization: WidgetCorp
+ # Tech-Contact: bob@widgetcorp.com
+ # Admin-Contact: ISP-ARIN-HANDLE
+ # Created: 20040314
+ # Updated: 20040314
+ # Updated-By: noc@example.com
+
+ # Get the "full" network number
+ my $net = new NetAddr::IP $data[0];
+
+# Assumptions: All data in ipdb is public
+# If not, we need another field to indicate "public/private".
+
+ foreach my $master (@masterblocks) {
+ if ($master->contains($net)) {
+
+# Whew! Ugly little varmint.
+ my $masterfilename = "net-".$master->addr."-".$master->masklen.
+ "/data/network/".$master->addr."-".$master->masklen.".txt";
+
+ open MASTERFILE,">>$rwhoisDataPath/$masterfilename"
+ or print "File open error: '$!' on '$rwhoisDataPath/$masterfilename'\n";
+
+# cidr custid type city description notes maskbits
+
+# Creation date in record to eventually be "correct"; near-term will
+# be master's creation date; immediate is today's date.
+my $date;
+ chomp ($date = `/bin/date +"%Y%m%d"`);
+if ($data[4] =~ /^\s*$/) { $data[4] = 'Friendly ISP'; }
+ print MASTERFILE "---\nID: NETBLK-ISP.$master\n".
+ "Auth-Area: $master\n".
+ "Network-Name: ISP-".$net->network."\n".
+ "IP-Network: $net\n".
+ "IP-Network-Block: ".$net->range."\n".
+ "Organization: $data[4]\n".
+# "Tech-Contact: $data[9]\n".
+ "Tech-Contact: abuse\@example.com\n".
+ "Admin-Contact: ISP-ARIN-HANDLE\n".
+ "Created: $date\n".
+ "Updated: $date\n".
+ "Updated-By: noc\@example.com\n";
+ }
+ }
+
+
+
+ # print "$data[0]\t| $data[1]\t| $data[2]\t| $data[3]\t| $data[4]\t| ".
+ # "$data[5]\t| $data[6]\t| $data[7]\t| $data[8]\t| $data[9]\n";
+ # print "$data[0]\t| $data[1]\t| $data[2]\t| $data[3]\t| $data[4]\t| ".
+ # "$data[5]\t| $data[6]\t| $data[7]\t| $data[8]\n";
+
+} # while fetchrow_array()
+
+
+$dbh->disconnect;
Index: branches/new-custids/cgi-bin/freespace.pl
===================================================================
--- branches/new-custids/cgi-bin/freespace.pl (revision 196)
+++ branches/new-custids/cgi-bin/freespace.pl (revision 196)
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+# ipdb/cgi-bin/freespace.pl
+# Quick hack to calculate aggregate free IP space, and statistic-ify the blocks.
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004,2005 - Kris Deugau
+
+use DBI;
+use MyIPDB;
+use NetAddr::IP;
+
+($dbh,$errstr) = connectDB_My;
+
+print "Content-type: text/plain\n\n";
+
+$tnumfree = $bigrfree = $bigufree = 0;
+
+# General counts first
+if ($ARGV[0]) {
+ $sth = $dbh->prepare("select * from freeblocks where maskbits >= $ARGV[0] order by maskbits desc");
+} else {
+ $sth = $dbh->prepare("select * from freeblocks order by maskbits desc");
+}
+$sth->execute;
+while (@data = $sth->fetchrow_array) {
+ # cidr,maskbits,city,routed
+ $tnumfree++;
+ $numfree{"$data[1]"}++;
+}
+
+foreach $size (sort {$a cmp $b} keys %numfree) {
+ print "/$size: $numfree{$size}\n";
+}
+print "\n";
+
+for ($i=30; $i>16; $i--) {
+ $j = $i-1;
+ $numfree{"$j"} += int $numfree{"$i"}/2;
+ $numfree{"$i"} -= (int $numfree{"$i"}/2)*2;
+}
+
+foreach $size (sort {$a cmp $b} keys %numfree) {
+ print "/$size: $numfree{$size}\n";
+}
Index: branches/new-custids/cgi-bin/ipdb.psql
===================================================================
--- branches/new-custids/cgi-bin/ipdb.psql (revision 196)
+++ branches/new-custids/cgi-bin/ipdb.psql (revision 196)
@@ -0,0 +1,183 @@
+CREATE DATABASE ipdb;
+
+\connect ipdb ipdb
+
+CREATE TABLE "customers" (
+ "custid" character varying(16) DEFAULT '' NOT NULL,
+ "name" character varying(64),
+ "street" character varying(25),
+ "street2" character varying(25),
+ "city" character varying(30),
+ "province" character(2),
+ "pocode" character varying(7),
+ "phone" character varying(15),
+ "abuse" character varying(50),
+ "def_rdns" character varying(40),
+ "description" text,
+ Constraint "customers_pkey" Primary Key ("custid")
+);
+
+REVOKE ALL on "customers" from PUBLIC;
+GRANT ALL on "customers" to "kdeugau";
+GRANT ALL on "customers" to "ipdb";
+
+CREATE TABLE "masterblocks" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL PRIMARY KEY
+);
+
+REVOKE ALL on "masterblocks" from PUBLIC;
+GRANT ALL on "masterblocks" to "kdeugau";
+GRANT ALL on "masterblocks" to "ipdb";
+
+CREATE TABLE "routed" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL PRIMARY KEY,
+ "maskbits" integer DEFAULT 128,
+ "city" character varying(30) DEFAULT ''
+);
+
+REVOKE ALL on "routed" from PUBLIC;
+GRANT ALL on "routed" to "kdeugau";
+GRANT ALL on "routed" to "ipdb";
+
+CREATE TABLE "temp" (
+ "ofs" integer
+);
+
+REVOKE ALL on "temp" from PUBLIC;
+GRANT ALL on "temp" to "kdeugau";
+GRANT ALL on "temp" to "ipdb";
+
+CREATE TABLE "freeblocks" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL PRIMARY KEY,
+ "maskbits" integer DEFAULT 128,
+ "city" character varying(30) DEFAULT '',
+ "routed" character(1) DEFAULT 'n'
+);
+
+REVOKE ALL on "freeblocks" from PUBLIC;
+GRANT ALL on "freeblocks" to "kdeugau";
+GRANT ALL on "freeblocks" to "ipdb";
+
+CREATE TABLE "poolips" (
+ "pool" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "ip" cidr DEFAULT '255.255.255.255/32' NOT NULL PRIMARY KEY,
+ "custid" character varying(16) DEFAULT '' NOT NULL,
+ "city" character varying(30) DEFAULT '' NOT NULL,
+ "type" character(2) DEFAULT '' NOT NULL,
+ "available" character(1) DEFAULT 'y' NOT NULL,
+ "notes" text DEFAULT '' NOT NULL,
+ "description" character varying(64) DEFAULT '' NOT NULL,
+ "circuitid" character varying(128) DEFAULT '' NOT NULL,
+ "newcustid" integer,
+ CHECK (((available = 'y'::bpchar) OR (available = 'n'::bpchar)))
+);
+
+REVOKE ALL on "poolips" from PUBLIC;
+GRANT ALL on "poolips" to "kdeugau";
+GRANT ALL on "poolips" to "ipdb";
+
+CREATE TABLE "allocations" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL PRIMARY KEY,
+ "custid" character varying(16) DEFAULT '',
+ "type" character(2) DEFAULT '',
+ "city" character varying(30) DEFAULT '',
+ "description" character varying(64) DEFAULT '',
+ "notes" text DEFAULT '',
+ "maskbits" integer DEFAULT 128,
+ "circuitid" character varying(128) DEFAULT '',
+ "newcustid" integer
+);
+
+REVOKE ALL on "allocations" from PUBLIC;
+GRANT ALL on "allocations" to "kdeugau";
+GRANT ALL on "allocations" to "ipdb";
+
+CREATE VIEW "searchme" as SELECT allocations.cidr, allocations.custid, allocations."type", allocations.city, allocations.description FROM allocations UNION SELECT poolips.ip, poolips.custid, poolips.type, poolips.city, poolips.description FROM poolips;
+
+REVOKE ALL on "searchme" from PUBLIC;
+GRANT ALL on "searchme" to "kdeugau";
+GRANT ALL on "searchme" to "ipdb";
+
+CREATE TABLE "alloctypes" (
+ "type" character(2) DEFAULT '' NOT NULL PRIMARY KEY,
+ "listname" character varying(40) DEFAULT '',
+ "dispname" character varying(40) DEFAULT '',
+ "listorder" integer DEFAULT 0,
+ "def_custid" character varying(16) DEFAULT ''
+);
+
+REVOKE ALL on "alloctypes" from PUBLIC;
+GRANT ALL on "alloctypes" to "kdeugau";
+GRANT ALL on "alloctypes" to "ipdb";
+
+CREATE TABLE "cities" (
+ "city" character varying(30) DEFAULT '' NOT NULL PRIMARY KEY,
+ "routing" character(1) DEFAULT 'n' NOT NULL
+);
+
+REVOKE ALL on "cities" from PUBLIC;
+GRANT ALL on "cities" to "kdeugau";
+GRANT ALL on "cities" to "ipdb";
+
+--
+-- Selected TOC Entries:
+--
+\connect - ipdb
+
+--
+-- TOC Entry ID 2 (OID 92809)
+--
+-- Name: alloctypes Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "alloctypes" (
+ "type" character(2) DEFAULT '' NOT NULL,
+ "listname" character varying(40) DEFAULT '',
+ "dispname" character varying(40) DEFAULT '',
+ "listorder" integer DEFAULT 0,
+ "def_custid" character varying(16) DEFAULT '',
+ Constraint "alloctypes_pkey" Primary Key ("type")
+);
+
+--
+-- TOC Entry ID 3 (OID 92809)
+--
+-- Name: alloctypes Type: ACL Owner:
+--
+
+REVOKE ALL on "alloctypes" from PUBLIC;
+GRANT ALL on "alloctypes" to "kdeugau";
+GRANT ALL on "alloctypes" to "ipdb";
+
+--
+-- Data for TOC Entry ID 4 (OID 92809)
+--
+-- Name: alloctypes Type: TABLE DATA Owner: ipdb
+--
+
+
+COPY "alloctypes" FROM stdin;
+cd Static Pool - Cable Cable pool 41 CBL-BUS
+dp Static Pool - DSL DSL pool 42 DSL-BUS
+mp Static Pool - Dialup Static dialup pool 43 DIAL-BUS
+wp Static Pool - Wireless Static wireless pool 44 WL-BUS
+mm Master block Master block 999 6750400
+in Internal netblock Internal netblock 990 6750400
+sd Static Pool - Servers Server pool 40 6750400
+cn Customer netblock Customer netblock 0
+ci Static IP - Cable Static cable IP 21
+di Static IP - DSL Static DSL IP 22
+mi Static IP - Dialup Static dialup IP 23
+wi Static IP - Wireless Static wireless IP 24
+si Static IP - Server pool Server pool IP 20 6750400
+wc Reserve for WAN blocks WAN IP blocks 200 6750400
+wr Internal WAN block Internal WAN block 201 6750400
+pc Reserve for dynamic-route DSL netblocks Dynamic-route netblocks 202 6750400
+en End-use netblock End-use netblock 100 6750400
+me Dialup netblock Dialup netblock 101 DIAL-RES
+de Dynamic DSL block Dynamic DSL block 102 DSL-RES
+ce Dynamic cable block Dynamic cable block 103 CBL-RES
+we Dynamic WiFi block Dynamic WiFi block 104 WL-RES
+rm Routing Routed netblock 500 6750400
+pr Dynamic-route DSL netblock Dynamic-route DSL 203
+\.
Index: branches/new-custids/cgi-bin/main.cgi
===================================================================
--- branches/new-custids/cgi-bin/main.cgi (revision 196)
+++ branches/new-custids/cgi-bin/main.cgi (revision 196)
@@ -0,0 +1,1305 @@
+#!/usr/bin/perl
+# ipdb/cgi-bin/main.cgi
+# Started munging from noc.vianet's old IPDB 04/22/2004
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+
+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","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);
+
+#prototypes
+sub viewBy($$); # feed it the category and query
+sub queryResults($$$); # args is the sql, the page# and the rowCount
+# Needs rewrite/rename
+sub countRows($); # returns first element of first row of passed SQL
+ # Only usage passes "select count(*) ..."
+
+# Global variables
+my $RESULTS_PER_PAGE = 50;
+my %webvar = parse_post();
+cleanInput(\%webvar);
+
+
+#main()
+
+if(!defined($webvar{action})) {
+ $webvar{action} = ""; #shuts up the warnings.
+}
+
+if($webvar{action} eq 'index') {
+ showSummary();
+} elsif ($webvar{action} eq 'newmaster') {
+ printHeader('');
+
+ my $cidr = new NetAddr::IP $webvar{cidr};
+
+ print "
Adding $cidr as master block....
\n";
+
+ # Allow transactions, and raise an exception on errors so we can catch it later.
+ # Use local to make sure these get "reset" properly on exiting this block
+ local $ip_dbh->{AutoCommit} = 0;
+ local $ip_dbh->{RaiseError} = 1;
+
+ # Wrap the SQL in a transaction
+ eval {
+ $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
+ $sth->execute;
+
+# Unrouted blocks aren't associated with a city (yet). We don't rely on this
+# elsewhere though; legacy data may have traps and pitfalls in it to break this.
+# Thus the "routed" flag.
+
+ $sth = $ip_dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
+ " values ('$webvar{cidr}',".$cidr->masklen.",'','n')");
+ $sth->execute;
+
+ # If we get here, everything is happy. Commit changes.
+ $ip_dbh->commit;
+ }; # end eval
+
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
+ printError("Could not add master block $webvar{cidr} to database: $@");
+ } else {
+ print "
Success!
\n";
+ syslog "info", "$authuser added master block $webvar{cidr}";
+ }
+
+} # end add new master
+
+elsif($webvar{action} eq 'showmaster') {
+ showMaster();
+}
+elsif($webvar{action} eq 'showrouted') {
+ showRBlock();
+}
+elsif($webvar{action} eq 'listpool') {
+ listPool();
+}
+elsif($webvar{action} eq 'search') {
+ printHeader('');
+ if (!$webvar{input}) {
+ # No search term. Display everything.
+ viewBy('all', '');
+ } else {
+ # Search term entered. Display matches.
+ # We should really sanitize $webvar{input}, no?
+ viewBy($webvar{searchfor}, $webvar{input});
+ }
+}
+
+# Not modified or added; just shuffled
+elsif($webvar{action} eq 'assign') {
+ assignBlock();
+}
+elsif($webvar{action} eq 'confirm') {
+ confirmAssign();
+}
+elsif($webvar{action} eq 'insert') {
+ insertAssign();
+}
+elsif($webvar{action} eq 'edit') {
+ edit();
+}
+elsif($webvar{action} eq 'update') {
+ update();
+}
+elsif($webvar{action} eq 'delete') {
+ remove();
+}
+elsif($webvar{action} eq 'finaldelete') {
+ finalDelete();
+}
+
+# Default is an error. It shouldn't be possible to easily get here.
+# The only way I can think of offhand is to just call main.cgi bare-
+# which is not in any way guaranteed to provide anything useful.
+else {
+ printHeader('');
+ my $rnd = rand 500;
+ my $boing = sprintf("%.2f", rand 500);
+ my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.",
+ "Because one of it's legs are both the same", "*wibble*",
+ "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
+ "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
+ printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
+}
+## Finally! Done with that NASTY "case" emulation!
+
+
+
+# Clean up IPDB globals, DB handle, etc.
+finish($ip_dbh);
+# We print the footer here, so we don't have to do it elsewhere.
+printFooter;
+# Just in case something waaaayyy down isn't in place
+# properly... we exit explicitly.
+exit;
+
+
+
+sub viewBy($$) {
+ my ($category,$query) = @_;
+
+ # Local variables
+ my $sql;
+
+#print "
\n";
+
+#print "start querysub: query '$query'\n";
+# this may happen with more than one subcategory. Unlikely, but possible.
+
+ # Calculate start point for LIMIT clause
+ my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
+
+# Possible cases:
+# 1) Partial IP/subnet. Treated as "first-three-octets-match" in old IPDB,
+# I should be able to handle it similarly here.
+# 2a) CIDR subnet. Treated more or less as such in old IPDB.
+# 2b) CIDR netmask. Not sure how it's treated.
+# 3) Customer ID. Not handled in old IPDB
+# 4) Description.
+# 5) Invalid data which might be interpretable as an IP or something, but
+# which probably shouldn't be for reasons of sanity.
+
+ if ($category eq 'all') {
+
+ print qq(
Showing all netblock and static-IP allocations
\n);
+
+ # Need to assemble SQL query in this order to avoid breaking things.
+ $sql = "select cidr,custid,type,city,description from searchme";
+ my $count = countRows("select count(*) from ($sql) foo");
+ $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
+ queryResults($sql, $webvar{page}, $count);
+
+ } elsif ($category eq 'cust') {
+
+ print qq(
Searching for Customer IDs containing '$query'
\n);
+
+ # Query for a customer ID. Note that we can't restrict to "numeric-only"
+ # as we have non-numeric custIDs in the legacy data. :/
+ $sql = "select cidr,custid,type,city,description from searchme where custid ilike '%$query%'";
+ my $count = countRows("select count(*) from ($sql) foo");
+ $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
+ queryResults($sql, $webvar{page}, $count);
+
+ } elsif ($category eq 'desc') {
+
+ print qq(
Searching for descriptions containing '$query'
\n);
+ # Query based on description (includes "name" from old DB).
+ $sql = "select cidr,custid,type,city,description from searchme where description ilike '%$query%'";
+ my $count = countRows("select count(*) from ($sql) foo");
+ $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
+ queryResults($sql, $webvar{page}, $count);
+
+ } elsif ($category =~ /ipblock/) {
+
+ # Query is for a partial IP, a CIDR block in some form, or a flat IP.
+ print qq(
Searching for IP-based matches on '$query'
\n);
+
+ $query =~ s/\s+//g;
+ if ($query =~ /\//) {
+ # 209.91.179/26 should show all /26 subnets in 209.91.179
+ my ($net,$maskbits) = split /\//, $query;
+ if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
+ # /0->/9 are silly to worry about right now. I don't think
+ # we'll be getting a class A anytime soon.
+ $sql = "select cidr,custid,type,city,description from searchme where cidr='$query'";
+ queryResults($sql, $webvar{page}, 1);
+ } else {
+ print "Finding all blocks with netmask /$maskbits, leading octet(s) $net \n";
+ # Partial match; beginning of subnet and maskbits are provided
+ $sql = "select cidr,custid,type,city,description from searchme where ".
+ "text(cidr) like '$net%' and text(cidr) like '%$maskbits'";
+ my $count = countRows("select count(*) from ($sql) foo");
+ $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
+ queryResults($sql, $webvar{page}, $count);
+ }
+ } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
+ # Specific IP address match
+ my $sfor = new NetAddr::IP $query;
+# We do this convoluted roundabout way of finding things in order
+# to bring up matches for single IPs that are within a static block;
+# we want to show both the "container" block and the static IP itself.
+ $sth = $ip_dbh->prepare("select cidr from searchme where cidr >>= '$sfor'");
+ $sth->execute;
+ while (my @data = $sth->fetchrow_array()) {
+ my $cidr = new NetAddr::IP $data[0];
+ queryResults("select cidr,custid,type,city,description from searchme where ".
+ "cidr='$cidr'", $webvar{page}, 1);
+ }
+ } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
+ print "Finding matches where the first three octets are $query \n";
+ $sql = "select cidr,custid,type,city,description from searchme where ".
+ "text(cidr) like '$query%'";
+ my $count = countRows("select count(*) from ($sql) foo");
+ $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
+ queryResults($sql, $webvar{page}, $count);
+ } else {
+ # This shouldn't happen, but if it does, whoever gets it deserves what they get...
+ printError("Invalid query.");
+ }
+ } else {
+ # This shouldn't happen, but if it does, whoever gets it deserves what they get...
+ printError("Invalid searchfor.");
+ }
+} # viewBy
+
+
+# args are: a reference to an array with the row to be printed and the
+# class(stylesheet) to use for formatting.
+# if ommitting the class - call the sub as &printRow(\@array)
+sub printRow {
+ my ($rowRef,$class) = @_;
+
+ if (!$class) {
+ print "
\n";
+ } else {
+ print "
\n";
+ }
+
+ELEMENT: foreach my $element (@$rowRef) {
+ if (!defined($element)) {
+ print "
";
+} # printRow
+
+
+# Display certain types of search query. Note that this can't be
+# cleanly reused much of anywhere else as the data isn't neatly tabulated.
+# This is tied to the search sub tightly enough I may just gut it and provide
+# more appropriate tables directly as needed.
+sub queryResults($$$) {
+ my ($sql, $pageNo, $rowCount) = @_;
+ my $offset = 0;
+ $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);
+
+ my $sth = $ip_dbh->prepare($sql);
+ $sth->execute();
+
+ startTable('Allocation','CustID','Type','City','Description/Name');
+ my $count = 0;
+
+ while (my @data = $sth->fetchrow_array) {
+ # cidr,custid,type,city,description
+ # Prefix subblocks with "Sub "
+ my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
+ qq($data[0]),
+ $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
+ # Allow listing of pool if desired/required.
+ if ($data[2] =~ /^.[pd]$/) {
+ $row[0] .= ' List IPs";
+ }
+ printRow(\@row, 'color1', 1) if ($count%2==0);
+ printRow(\@row, 'color2', 1) if ($count%2!=0);
+ $count++;
+ }
+
+ # Have to think on this call, it's primarily to clean up unfetched rows from a select.
+ # In this context it's probably a good idea.
+ $sth->finish();
+
+ my $upper = $offset+$count;
+ print "
Records found: $rowCount Displaying: $offset - $upper
\n";
+ print "\n";
+
+ # print the page thing..
+ if ($rowCount > $RESULTS_PER_PAGE) {
+ my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
+ print qq(
";
+ }
+} # queryResults
+
+
+# Prints table headings. Accepts any number of arguments;
+# each argument is a table heading.
+sub startTable {
+ print qq(
);
+
+ foreach(@_) {
+ print qq(
$_
);
+ }
+ print "
\n";
+} # startTable
+
+
+# Return first element of passed SQL query
+sub countRows($) {
+ my $sth = $ip_dbh->prepare($_[0]);
+ $sth->execute();
+ my @a = $sth->fetchrow_array();
+ $sth->finish();
+ return $a[0];
+}
+
+
+# Initial display: Show master blocks with total allocated subnets, total free subnets
+sub showSummary {
+ # this is horrible-ugly-bad and will Go Away real soon now(TM)
+ print "Content-type: text/html\n\n";
+
+ startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
+ 'Free netblocks', 'Largest free block');
+
+ my %allocated;
+ my %free;
+ my %routed;
+ my %bigfree;
+
+ # Count the allocations.
+ $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
+ foreach my $master (@masterblocks) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$allocated{"$master"});
+ $sth->fetch();
+ }
+
+ # Count routed blocks
+ $sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
+ foreach my $master (@masterblocks) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$routed{"$master"});
+ $sth->fetch();
+ }
+
+ # Count the free blocks.
+ $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
+ foreach my $master (@masterblocks) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$free{"$master"});
+ $sth->fetch();
+ }
+
+ # Find the largest free block in each master
+ $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
+ foreach my $master (@masterblocks) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$bigfree{"$master"});
+ $sth->fetch();
+ }
+
+ # Print the data.
+ my $count=0;
+ foreach my $master (@masterblocks) {
+ my @row = ("$master",
+ $routed{"$master"}, $allocated{"$master"}, $free{"$master"},
+ ( ($bigfree{"$master"} eq '') ? ("<NONE>") : ("/".$bigfree{"$master"}) )
+ );
+
+ printRow(\@row, 'color1' ) if($count%2==0);
+ printRow(\@row, 'color2' ) if($count%2!=0);
+ $count++;
+ }
+ print "
\n);
+ print "Note: Free blocks noted here include both routed and unrouted blocks.\n";
+
+} # showSummary
+
+
+# Display detail on master
+# Alrighty then! We're showing routed blocks within a single master this time.
+# We should be able to steal code from showSummary(), and if I'm really smart
+# I'll figger a way to munge the two together. (Once I've done that, everything
+# else should follow. YMMV.)
+sub showMaster {
+ printHeader('');
+
+ print qq(
Summarizing routed blocks for ).
+ qq($webvar{block}:
\n);
+
+ my %allocated;
+ my %free;
+ my %routed;
+ my %bigfree;
+
+ my $master = new NetAddr::IP $webvar{block};
+ my @localmasters;
+
+ # Fetch only the blocks relevant to this master
+ $sth = $ip_dbh->prepare("select cidr,city from routed where cidr <<= '$master' order by cidr");
+ $sth->execute();
+
+ my $i=0;
+ while (my @data = $sth->fetchrow_array()) {
+ my $cidr = new NetAddr::IP $data[0];
+ $localmasters[$i++] = $cidr;
+ $free{"$cidr"} = 0;
+ $allocated{"$cidr"} = 0;
+ $bigfree{"$cidr"} = 128;
+ # Retain the routing destination
+ $routed{"$cidr"} = $data[1];
+ }
+
+ # Check if there were actually any blocks routed from this master
+ if ($i > 0) {
+ startTable('Routed block','Routed to','Allocated blocks',
+ 'Free blocks','Largest free block');
+
+ # Count the allocations
+ $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
+ foreach my $master (@localmasters) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$allocated{"$master"});
+ $sth->fetch();
+ }
+
+ # Count the free blocks.
+ $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
+ foreach my $master (@localmasters) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$free{"$master"});
+ $sth->fetch();
+ }
+
+ # Get the size of the largest free block
+ $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
+ foreach my $master (@localmasters) {
+ $sth->execute("$master");
+ $sth->bind_columns(\$bigfree{"$master"});
+ $sth->fetch();
+ }
+
+ # Print the data.
+ my $count=0;
+ foreach my $master (@localmasters) {
+ my @row = ("$master",
+ $routed{"$master"}, $allocated{"$master"},
+ $free{"$master"},
+ ( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) )
+ );
+ printRow(\@row, 'color1' ) if($count%2==0);
+ printRow(\@row, 'color2' ) if($count%2!=0);
+ $count++;
+ }
+ } else {
+ # If a master block has no routed blocks, then by definition it has no
+ # allocations, and can be deleted.
+ print qq(
No allocations in ).
+ qq($master.
\n).
+ qq(
\n);
+
+ } # end check for existence of routed blocks in master
+
+ print qq(\n\n).
+ qq(
Unrouted blocks in $master:
\n);
+
+ startTable('Netblock','Range');
+
+ # Snag the free blocks.
+ my $count = 0;
+ $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
+ "routed='n' order by cidr");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ my $cidr = new NetAddr::IP $data[0];
+ my @row = ("$cidr", $cidr->range);
+ printRow(\@row, 'color1' ) if($count%2==0);
+ printRow(\@row, 'color2' ) if($count%2!=0);
+ $count++;
+ }
+
+ print "\n";
+} # showMaster
+
+
+# Display details of a routed block
+# Alrighty then! We're showing allocations within a routed block this time.
+# We should be able to steal code from showSummary() and showMaster(), and if
+# I'm really smart I'll figger a way to munge all three together. (Once I've
+# done that, everything else should follow. YMMV.
+# This time, we check the database before spewing, because we may
+# not have anything useful to spew.
+sub showRBlock {
+ printHeader('');
+
+ my $master = new NetAddr::IP $webvar{block};
+
+ $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+
+ print qq(
Summarizing allocated blocks for ).
+ qq($master ($data[0]):
\n);
+
+ startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
+
+ # Snag the allocations for this block
+ $sth = $ip_dbh->prepare("select cidr,city,type,custid,description".
+ " from allocations where cidr <<= '$master' order by cidr");
+ $sth->execute();
+
+ my $count=0;
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,city,type,custid,description, as per the SELECT
+ my $cidr = new NetAddr::IP $data[0];
+
+ # Clean up extra spaces that are borking things.
+# $data[2] =~ s/\s+//g;
+
+ # Prefix subblocks with "Sub "
+ my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
+ qq($data[0]),
+ $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
+ # If the allocation is a pool, allow listing of the IPs in the pool.
+ if ($data[2] =~ /^.[pd]$/) {
+ $row[0] .= ' List IPs";
+ }
+
+ printRow(\@row, 'color1') if ($count%2 == 0);
+ printRow(\@row, 'color2') if ($count%2 != 0);
+ $count++;
+ }
+
+ print "\n";
+
+ # If the routed block has no allocations, by definition it only has
+ # one free block, and therefore may be deleted.
+ if ($count == 0) {
+ print qq(
No allocations in ).
+ qq($master.
\n).
+ qq(\n);
+ }
+
+ print qq(\n
Free blocks within routed ).
+ qq(submaster $master
\n);
+
+ startTable('CIDR block','Range');
+
+ # Snag the free blocks. We don't really *need* to be pedantic about avoiding
+ # unrouted free blocks, but it's better to let the database do the work if we can.
+ $count = 0;
+ $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
+ " order by cidr");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,routed
+ my $cidr = new NetAddr::IP $data[0];
+ # Include some HairyPerl(TM) to prefix subblocks with "Sub "
+ my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
+ qq($cidr),
+ $cidr->range);
+ printRow(\@row, 'color1') if ($count%2 == 0);
+ printRow(\@row, 'color2') if ($count%2 != 0);
+ $count++;
+ }
+
+ print "\n";
+} # showRBlock
+
+
+# List the IPs used in a pool
+sub listPool {
+ printHeader('');
+
+ my $cidr = new NetAddr::IP $webvar{pool};
+
+ my ($pooltype,$poolcity);
+
+ # Snag pool info for heading
+ $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
+ $sth->execute;
+ $sth->bind_columns(\$pooltype, \$poolcity);
+ $sth->fetch() || carp $sth->errstr;
+
+ print qq(
Listing pool IPs for $cidr \n).
+ qq(($disp_alloctypes{$pooltype} in $poolcity)
\n);
+ # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
+ if ($pooltype =~ /^.d$/) {
+ print qq(
Reserved IPs: \n);
+ print qq(
Network IP:
).
+ $cidr->addr."
\n";
+ $cidr++;
+ print "
Gateway:
".$cidr->addr."
\n";
+ $cidr--; $cidr--;
+ print "
Broadcast:
".$cidr->addr."
\n".
+ "
Netmask:
".$cidr->mask."
\n".
+ "
\n";
+ }
+
+# probably have to add an "edit IP allocation" link here somewhere.
+
+ startTable('IP','Customer ID','Available?','Description','');
+ $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
+ " from poolips where pool='$webvar{pool}' order by ip");
+ $sth->execute;
+ my $count = 0;
+ while (my @data = $sth->fetchrow_array) {
+ # pool,ip,custid,city,ptype,available,notes,description,circuitid
+ # ip,custid,available,description,type
+ # If desc is "null", make it not null.
+ if ($data[3] eq '') {
+ $data[3] = ' ';
+ }
+ # Some nice hairy Perl to decide whether to allow unassigning each IP
+ # -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
+ # else we print a blank space
+ my @row = ( qq($data[0]),
+ $data[1],$data[2],$data[3],
+ ( ($data[2] eq 'n') ?
+ ("Unassign this IP") :
+ (" ") )
+ );
+ printRow(\@row, 'color1') if($count%2==0);
+ printRow(\@row, 'color2') if($count%2!=0);
+ $count++;
+ }
+ print "\n";
+
+} # end listPool
+
+
+# Show "Add new allocation" page. Note that the actual page may
+# be one of two templates, and the lists come from the database.
+sub assignBlock {
+ printHeader('');
+
+ my $html;
+
+ # New special case- block to assign is specified
+ if ($webvar{block} ne '') {
+ open HTML, "../fb-assign.html"
+ or croak "Could not open fb-assign.html: $!";
+ $html = join('',);
+ close HTML;
+ my $block = new NetAddr::IP $webvar{block};
+ $html =~ s|\$\$BLOCK\$\$|$block|g;
+ $html =~ s|\$\$MASKBITS\$\$|$block->masklen|;
+ my $typelist = '';
+
+ # This is a little dangerous, as it's *theoretically* possible to
+ # get fbtype='n' (aka a non-routed freeblock). However, should
+ # someone manage to get there, they get what they deserve.
+ if ($webvar{fbtype} ne 'y') {
+ # Snag the type of the block from the database. We have no
+ # convenient way to pass this in from the calling location. :/
+ $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+ $data[0] =~ s/c$/r/; # Munge the type into the correct form
+ $typelist = "$list_alloctypes{$data[0]}\n";
+ } else {
+ $typelist .= qq(\n";
+ }
+ $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
+ } else {
+ open HTML, "../assign.html"
+ or croak "Could not open assign.html: $!";
+ $html = join('',);
+ close HTML;
+ my $masterlist = "\n";
+ $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g;
+ my $pops = '';
+ foreach my $pop (@poplist) {
+ $pops .= "\n";
+ }
+ $html =~ s|\$\$POPLIST\$\$|$pops|g;
+ 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";
+ }
+ $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
+ }
+ my $cities = '';
+ foreach my $city (@citylist) {
+ $cities .= "\n";
+ }
+ $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
+
+ print $html;
+
+} # assignBlock
+
+
+# Take info on requested IP assignment and see what we can provide.
+sub confirmAssign {
+ printHeader('');
+
+ my $cidr;
+ my $alloc_from;
+
+ # Going to manually validate some items.
+ # custid and city are automagic.
+ return if !validateInput();
+
+# Several different cases here.
+# Static IP vs netblock
+# + Different flavours of static IP
+# + Different flavours of netblock
+
+ if ($webvar{alloctype} =~ /^.i$/) {
+ my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
+ my $sql;
+ # Check for pools in Subury or North Bay if DSL or server pool. Anywhere else is
+ # invalid and shouldn't be in the db in the first place.
+ # ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
+ # Note that we want to retain the requested city to relate to customer info.
+##fixme This needs thought.
+##SELECT DISTINCT pool, Count(*) FROM poolips where available='y' GROUP BY pool;
+ if ($base =~ /^[ds]$/) {
+ $sql = "select * from poolips where available='y' and".
+ " type='$webvar{alloctype}' and (city='Sudbury' or city='North Bay')";
+ } else {
+ $sql = "select * from poolips where available='y' and".
+ " type='$webvar{alloctype}' and city='$webvar{pop}'";
+ }
+
+ # Now that we know where we're looking, we can list the pools with free IPs.
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ my %ipcount;
+ my $optionlist;
+ while (my @data = $sth->fetchrow_array) {
+ $ipcount{$data[0]}++;
+ }
+ $sth = $ip_dbh->prepare("select city from allocations where cidr=?");
+ foreach my $key (keys %ipcount) {
+ $sth->execute($key);
+ my @data = $sth->fetchrow_array;
+ $optionlist .= "\n";
+ }
+ $cidr = "Single static IP";
+ $alloc_from = "\n";
+
+ } else { # end show pool options
+
+ if ($webvar{fbassign} eq 'y') {
+ $cidr = new NetAddr::IP $webvar{block};
+ $webvar{maskbits} = $cidr->masklen;
+ } else { # done with direct freeblocks assignment
+
+ if (!$webvar{maskbits}) {
+ printError("Please specify a CIDR mask length.");
+ return;
+ }
+ my $sql;
+ my $city;
+ my $failmsg;
+ if ($webvar{alloctype} eq 'rm') {
+ if ($webvar{allocfrom} ne '-') {
+ $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
+ " and cidr <<= '$webvar{allocfrom}' order by maskbits desc";
+ } else {
+ $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
+ " order by maskbits desc";
+ }
+ $failmsg = "No suitable free block found. \nWe do not have a free".
+ " routeable block of that size. \nYou will have to either route".
+ " a set of smaller netblocks or a single smaller netblock.";
+ } else {
+##fixme
+# This section needs serious Pondering.
+ # Pools of all types get assigned to the POP they're "routed from"
+ # This includes WAN blocks and other netblock "containers"
+ if ($webvar{alloctype} =~ /^.[pdc]$/) {
+ if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
+ printError("You must chose Sudbury or North Bay for DSL pools.");
+ return;
+ }
+ $city = $webvar{city};
+ $failmsg = "No suitable free block found. \nYou will have to route another".
+ " superblock from one of the \nmaster blocks in Sudbury or chose a smaller".
+ " block size for the pool.";
+ } else {
+ $city = $webvar{pop};
+ $failmsg = "No suitable free block found. \nYou will have to route another".
+ " superblock to $webvar{pop} \nfrom one of the master blocks in Sudbury or".
+ " chose a smaller blocksize.";
+ }
+ if ($webvar{allocfrom} ne '-') {
+ $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
+ " and cidr <<= '$webvar{allocfrom}' and routed='".
+ (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."' order by maskbits desc,cidr";
+ } else {
+ $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
+ " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y').
+ "' order by maskbits desc,cidr";
+ }
+ }
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ my @data = $sth->fetchrow_array();
+ if ($data[0] eq "") {
+ printError($failmsg);
+ return;
+ }
+ $cidr = new NetAddr::IP $data[0];
+ } # check for freeblocks assignment or IPDB-controlled assignment
+
+ $alloc_from = qq($cidr);
+
+ # If the block to be allocated is smaller than the one we found,
+ # figure out the "real" block to be allocated.
+ if ($cidr->masklen() ne $webvar{maskbits}) {
+ my $maskbits = $cidr->masklen();
+ my @subblocks;
+ while ($maskbits++ < $webvar{maskbits}) {
+ @subblocks = $cidr->split($maskbits);
+ }
+ $cidr = $subblocks[0];
+ }
+ } # if ($webvar{alloctype} =~ /^.i$/)
+
+ open HTML, "../confirm.html"
+ or croak "Could not open confirm.html: $!";
+ my $html = join '', ;
+ close HTML;
+
+### gotta fix this in final
+ # Stick in customer info as necessary - if it's blank, it just ends
+ # up as blank lines ignored in the rendering of the page
+ my $custbits;
+ $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
+###
+
+ # Stick in the allocation data
+ $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
+ $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
+ $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
+ $html =~ s|\$\$CIDR\$\$|$cidr|g;
+ $webvar{city} = desanitize($webvar{city});
+ $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
+ $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
+ $webvar{circid} = desanitize($webvar{circid});
+ $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
+ $webvar{desc} = desanitize($webvar{desc});
+ $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
+ $webvar{notes} = desanitize($webvar{notes});
+ $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
+ $html =~ s|\$\$ACTION\$\$|insert|g;
+
+ print $html;
+
+} # end confirmAssign
+
+
+# Do the work of actually inserting a block in the database.
+sub insertAssign {
+ # Some things are done more than once.
+ printHeader('');
+ return if !validateInput();
+
+ # $code is "success" vs "failure", $msg contains OK for a
+ # successful netblock allocation, the IP allocated for static
+ # IP, or the error message if an error occurred.
+ my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
+ $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
+ $webvar{circid});
+
+ if ($code eq 'OK') {
+ if ($webvar{alloctype} =~ /^.i$/) {
+ print qq(
The IP $msg has been allocated to customer $webvar{custid}
The block $webvar{fullcidr} was ).
+ "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}
";
+ }
+ syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
+ "'$webvar{alloctype}'";
+ } else {
+ syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
+ "'$webvar{alloctype}' by $authuser failed: '$msg'";
+ printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
+ " failed: \n$msg\n");
+ }
+
+} # end insertAssign()
+
+
+# Does some basic checks on common input data to make sure nothing
+# *really* weird gets in to the database through this script.
+# Does NOT do complete input validation!!!
+sub validateInput {
+ if ($webvar{city} eq '-') {
+ printError("Please choose a city.");
+ return;
+ }
+
+ # Alloctype check.
+ chomp $webvar{alloctype};
+ if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
+ # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
+ # managing to call things in such a way as to cause this deserves a cryptic error.
+ printError("Invalid alloctype");
+ return;
+ }
+
+ # CustID check
+ # We have different handling for customer allocations and "internal" or "our" allocations
+ if ($webvar{alloctype} =~ /^(cn|.i)$/) {
+ if (!$webvar{custid}) {
+ printError("Please enter a customer ID.");
+ return;
+ }
+ if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF|TEMP)(?:-\d\d?)?$/) {
+ printError("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
+ return;
+ }
+ print "\n";
+ } else {
+ # New! Improved! And now Loaded From The Database!!
+ $webvar{custid} = $def_custids{$webvar{alloctype}};
+ }
+
+ # Check POP location
+ my $flag;
+ if ($webvar{alloctype} eq 'rm') {
+ $flag = 'for a routed netblock';
+ foreach (@poplist) {
+ if (/^$webvar{city}$/) {
+ $flag = 'n';
+ last;
+ }
+ }
+ } else {
+ $flag = 'n';
+ if ($webvar{pop} =~ /^-$/) {
+ $flag = 'to route the block from/through';
+ }
+ }
+ if ($flag ne 'n') {
+ printError("Please choose a valid POP location $flag. Valid ".
+ "POP locations are currently: \n".join (" - ", @poplist));
+ return;
+ }
+
+ return 'OK';
+} # end validateInput
+
+
+# Displays details of a specific allocation in a form
+# Allows update/delete
+# action=edit
+sub edit {
+ printHeader('');
+
+ my $sql;
+
+ # Two cases: block is a netblock, or block is a static IP from a pool
+ # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
+ if ($webvar{block} =~ /\/32$/) {
+ $sql = "select ip,custid,type,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
+ } else {
+ $sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
+ }
+
+ # gotta snag block info from db
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+
+ # Clean up extra whitespace on alloc type
+ $data[2] =~ s/\s//;
+
+##fixme LEGACY CODE
+ # Postfix "i" on pool IP types
+ if ($data[2] =~ /^[cdsmw]$/) {
+ $data[2] .= "i";
+ }
+
+ open (HTML, "../editDisplay.html")
+ or croak "Could not open editDisplay.html :$!";
+ my $html = join('', );
+
+ # We can't let the city be changed here; this block is a part of
+ # a larger routed allocation and therefore by definition can't be moved.
+ # block and city are static.
+##fixme
+# Needs thinking. Have to allow changes to city to correct errors, no?
+ $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
+ $html =~ s/\$\$CITY\$\$/$data[3]/g;
+
+# Screw it. Changing allocation types gets very ugly VERY quickly- especially
+# with the much longer list of allocation types.
+# We'll just show what type of block it is.
+
+# this has now been Requested, so here goes.
+
+##fixme The check here should be built from the database
+ if ($data[2] =~ /^.[ne]$/) {
+ # Block that can be changed
+ my $blockoptions = "\n";
+ $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
+ } else {
+ $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
+ }
+
+ # These can be modified, although CustID changes may get ignored.
+ $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
+ $html =~ s/\$\$TYPE\$\$/$data[2]/g;
+ $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
+ $html =~ s/\$\$DESC\$\$/$data[5]/g;
+ $html =~ s/\$\$NOTES\$\$/$data[6]/g;
+
+ print $html;
+
+} # edit()
+
+
+# Stuff new info about a block into the db
+# action=update
+sub update {
+ printHeader('');
+
+ # Make sure incoming data is in correct format - custID among other things.
+ validateInput;
+
+ # SQL transaction wrapper
+ eval {
+ # Relatively simple SQL transaction here.
+ my $sql;
+ if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
+ # Note the hack ( available='n' ) to work around "update" additions
+ # to static IP space. Eww.
+ $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
+ "circuitid='$webvar{circid}',description='$webvar{desc}',available='n' ".
+ "where ip='$webvar{block}'";
+ } else {
+ $sql = "update allocations set custid='$webvar{custid}',".
+ "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
+ "type='$webvar{alloctype}',circuitid='$webvar{circid}' where cidr='$webvar{block}'";
+ }
+ # Log the details of the change.
+ syslog "debug", $sql;
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ $ip_dbh->commit;
+ };
+ if ($@) {
+ my $msg = $@;
+ carp "Transaction aborted because $msg";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
+ printError("Could not update block/IP $webvar{block}: $msg");
+ return;
+ }
+
+ # If we get here, the operation succeeded.
+ syslog "notice", "$authuser updated $webvar{block}";
+ open (HTML, "../updated.html")
+ or croak "Could not open updated.html :$!";
+ my $html = join('', );
+
+ $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
+ $webvar{city} = desanitize($webvar{city});
+ $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
+ $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
+ $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
+ $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
+ $webvar{circid} = desanitize($webvar{circid});
+ $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
+ $webvar{desc} = desanitize($webvar{desc});
+ $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
+ $webvar{notes} = desanitize($webvar{notes});
+ $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
+
+ print $html;
+
+} # update()
+
+
+# Delete an allocation.
+sub remove {
+ printHeader('');
+ #show confirm screen.
+ open HTML, "../confirmRemove.html"
+ or croak "Could not open confirmRemove.html :$!";
+ my $html = join('', );
+ close HTML;
+
+ # Serves'em right for getting here...
+ if (!defined($webvar{block})) {
+ printError("Error 332");
+ return;
+ }
+
+ my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype);
+
+ if ($webvar{alloctype} eq 'rm') {
+ $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
+ $sth->execute();
+
+# This feels... extreme.
+ croak $sth->errstr() if($sth->errstr());
+
+ $sth->bind_columns(\$cidr,\$city);
+ $sth->execute();
+ $sth->fetch || croak $sth->errstr();
+ $custid = "N/A";
+ $alloctype = $webvar{alloctype};
+ $circid = "N/A";
+ $desc = "N/A";
+ $notes = "N/A";
+
+ } elsif ($webvar{alloctype} eq 'mm') {
+ $cidr = $webvar{block};
+ $city = "N/A";
+ $custid = "N/A";
+ $alloctype = $webvar{alloctype};
+ $circid = "N/A";
+ $desc = "N/A";
+ $notes = "N/A";
+ } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
+
+ # Unassigning a static IP
+ my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid from poolips".
+ " where ip='$webvar{block}'");
+ $sth->execute();
+# croak $sth->errstr() if($sth->errstr());
+
+ $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid);
+ $sth->fetch() || croak $sth->errstr;
+
+ } else { # done with alloctype=~ /^.i$/
+
+ my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes from ".
+ "allocations where cidr='$webvar{block}'");
+ $sth->execute();
+# croak $sth->errstr() if($sth->errstr());
+
+ $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc, \$notes);
+ $sth->fetch() || carp $sth->errstr;
+ } # end cases for different alloctypes
+
+ # Munge everything into HTML
+ $html =~ s|Please confirm|Please confirm removal of|;
+ $html =~ s|\$\$BLOCK\$\$|$cidr|g;
+ $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
+ $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
+ $html =~ s|\$\$CITY\$\$|$city|g;
+ $html =~ s|\$\$CUSTID\$\$|$custid|g;
+ $html =~ s|\$\$CIRCID\$\$|$circid|g;
+ $html =~ s|\$\$DESC\$\$|$desc|g;
+ $html =~ s|\$\$NOTES\$\$|$notes|g;
+
+ $html =~ s|\$\$ACTION\$\$|finaldelete|g;
+
+ # Set the warning text.
+ if ($alloctype =~ /^.[pd]$/) {
+ $html =~ s||
Warning: clicking confirm will remove this record entirely. Any IPs allocated from this pool will also be removed!
|;
+ } else {
+ $html =~ s||
Warning: clicking confirm will remove this record entirely.
|;
+ }
+
+ print $html;
+} # end edit()
+
+
+# Delete an allocation. Return it to the freeblocks table; munge
+# data as necessary to keep as few records as possible in freeblocks
+# to prevent weirdness when allocating blocks later.
+# Remove IPs from pool listing if necessary
+sub finalDelete {
+ printHeader('');
+
+ my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
+
+ if ($code eq 'OK') {
+ print "
Success! $webvar{block} deallocated.
\n";
+ syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
+ } else {
+ if ($webvar{alloctype} =~ /^.i$/) {
+ syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
+ printError("Could not deallocate static IP $webvar{block}: $msg");
+ } else {
+ syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
+ printError("Could not deallocate netblock $webvar{block}: $msg");
+ }
+ }
+
+} # finalDelete
+
+
+# Just in case we manage to get here.
+exit 0;
Index: branches/new-custids/cgi-bin/newcity.cgi
===================================================================
--- branches/new-custids/cgi-bin/newcity.cgi (revision 196)
+++ branches/new-custids/cgi-bin/newcity.cgi (revision 196)
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+# ipdb/cgi-bin/newcity.cgi
+# Add new city to database
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004,2005 - 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","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'};
+}
+
+my %webvar = parse_post();
+cleanInput(\%webvar);
+
+my ($dbh,$errstr) = connectDB_My;
+my $sth;
+
+print "Content-type: text/html\n\n";
+
+if ($webvar{pop} eq 'on') {
+ $sth = $dbh->prepare("insert into cities values ('$webvar{city}','y')");
+} else {
+ $sth = $dbh->prepare("insert into cities values ('$webvar{city}','n')");
+}
+$sth->execute;
+
+if ($sth->err) {
+ print "Error adding city to database: ".$sth->errstr;
+ mailNotify('kdeugau@vianet.ca',"IPDB city add failure",$sth->errstr);
+ syslog "err", "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr;
+} else {
+ print "City added. Closing this window should refresh the page.";
+ syslog "notice", "$authuser added city/location '$webvar{pop}'".
+ (($webvar{pop} eq 'on') ? ' as POP location' : '');
+}
+
+finish($dbh);
Index: branches/new-custids/cgi-bin/snCalc.cgi
===================================================================
--- branches/new-custids/cgi-bin/snCalc.cgi (revision 196)
+++ branches/new-custids/cgi-bin/snCalc.cgi (revision 196)
@@ -0,0 +1,177 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+#file snCalc.cgi little subnet calculator app
+
+my %webvar = parse_post();
+my $input;
+
+print "Content-Type: text/html\n\n";
+
+open(HTML, "../startsn.html")|| die "Could not open starsn.html :$!";
+my $start = join('', );
+close(HTML);
+print $start;
+
+if($webvar{input} =~ m/(\/\d\d)/)
+{
+ $input = $1;
+}
+else
+{
+ $input = '/29';
+}
+
+if(substr($input, 1, 2) > 32 || substr($input, 1, 2) < 24)
+{
+ printAndExit("'$input' is an invalid netmask.");
+}
+else
+{ $input = substr($input, 1, 2);
+ my $ltinput = $input -1;
+ my $gtinput = $input +1;
+
+ print qq(
New cities/locations can now be added to the database here.
+
+
+
11/30/2004
+
Overhauled the city listings; they should be somewhat more complete now. Still needs a
+mechanism to easily add new cities.
+
+
+
11/26/2004
+
Allocating a static IP is now a little different. Use the "Customer Location" field to
+enter the customer's actual city, and use the "Route from/through" field to pick the POP or
+cable node the IP should come from.
+
![[ Logo ]](/ip/images/logo.png)