A single IP address from a designated pool
+on the cable network.
+
+
Customer static IP - DSL
A single IP address from a designated pool
+on the DSL network. Note that these are nominally in Sudbury, even if the customer
+isn't.
+
+
IP from server pool
A single IP from a pool designated for servers
+
+
+
+
Pool - Cable
A pool of IP addresses available for one-by-one assignment to
+customers on cable.
+
+
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.
+
+
Pool - Servers
A pool of IP addresses available for one-by-one assignment to
+servers in Sudbury.
+
+
+
+
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/stable/cgi-bin/IPDB.pm
===================================================================
--- /branches/stable/cgi-bin/IPDB.pm (revision 18)
+++ /branches/stable/cgi-bin/IPDB.pm (revision 18)
@@ -0,0 +1,69 @@
+# ipdb/cgi-bin/IPDB.pm
+# Contains DB-related functions for IPDB
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+
+# Split from CommonWeb.pm 08/13/2004 kdeugau@vianet
+
+package IPDB;
+
+use strict;
+use warnings;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+$VERSION = 1.0;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(&connectDB &checkDBSanity);
+
+@EXPORT = (); # Export nothing by default.
+%EXPORT_TAGS = ( ALL => [qw( &connectDB &checkDBSanity )]
+ );
+
+# Creates connection to IPDB.
+# Default is a PostgreSQL db; could be any DBMS with the
+# right changes. MySQL in comments. Note that some DBMS's don't
+# support transactions, this is a Bad Thing!
+# Returns a handle to the db.
+sub connectDB {
+ my $dbh;
+ my $DSN = "DBI:Pg:dbname=ipdb";
+ my $user = 'ipdb';
+ my $pw = 'ipdbpwd';
+
+# Note that we want to autocommit by default, and we will turn it off locally as necessary.
+ $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
+ or return undef if(!$dbh);
+
+ return $dbh;
+} # end connectDB
+
+# 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 = connectDB();
+
+ if (!$dbh) {
+ print "Cannot connect to the database!";
+ } else {
+ # it connects, try a stmt.
+ my $sth = $dbh->prepare('select cidr from masterblocks');
+ 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();
+ }
+ }
+ # Clean up after ourselves.
+ $dbh->disconnect;
+} # end checkDBSanity
+
+# Indicates module loaded OK. Required by Perl.
+1;
Index: /branches/stable/cgi-bin/consistency-check.pl
===================================================================
--- /branches/stable/cgi-bin/consistency-check.pl (revision 18)
+++ /branches/stable/cgi-bin/consistency-check.pl (revision 18)
@@ -0,0 +1,120 @@
+#!/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$
+###
+
+use DBI;
+use IPDB qw(:ALL);
+use NetAddr::IP;
+
+$dbh = connectDB;
+
+# Schlep up the masters
+$sth = $dbh->prepare("select * from masterblocks order by cidr");
+$sth->execute;
+for ($i=0; @data = $sth->fetchrow_array; $i++) {
+ $masterblocks[$i] = new NetAddr::IP $data[0];
+}
+
+print "First check: All blocks must be within one of the master blocks\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");
+# union select cidr from allocations union select cidr from freeblocks");
+$sth->execute;
+ROUTED: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next ROUTED; }
+ }
+ print "$cidr not mastered\n";
+}
+print " done.\n";
+
+# Next test: All allocations must be part of a master.
+print "Checking allocations: ";
+$sth = $dbh->prepare("select cidr from allocations");
+$sth->execute;
+ALLOCATED: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next ALLOCATED; }
+ }
+ print "$cidr not mastered\n";
+}
+print " done.\n";
+
+# Next: free blocks
+print "Checking freeblocks: ";
+$sth = $dbh->prepare("select cidr from freeblocks");
+$sth->execute;
+FREEBLOCK: while (@data = $sth->fetchrow_array) {
+ $cidr = new NetAddr::IP $data[0];
+ foreach $master (@masterblocks) {
+ if ($master->contains($cidr)) { next FREEBLOCK; }
+ }
+ print "$cidr not mastered\n";
+}
+print " done.\n";
+
+print "Done checking master containment.\n\nChecking 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') union ".
+ "(select network(cidr) as net, broadcast(cidr) as bcast ".
+ "from freeblocks where cidr <<= '$master') 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";
+}
Index: /branches/stable/cgi-bin/extras/db2rwhois.pl
===================================================================
--- /branches/stable/cgi-bin/extras/db2rwhois.pl (revision 18)
+++ /branches/stable/cgi-bin/extras/db2rwhois.pl (revision 18)
@@ -0,0 +1,151 @@
+#!/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$
+###
+
+use strict;
+use warnings;
+use DBI;
+use NetAddr::IP;
+use IPDB qw(:ALL);
+
+$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 = connectDB;
+
+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/stable/cgi-bin/ipdb.psql
===================================================================
--- /branches/stable/cgi-bin/ipdb.psql (revision 18)
+++ /branches/stable/cgi-bin/ipdb.psql (revision 18)
@@ -0,0 +1,129 @@
+--
+-- Selected TOC Entries:
+--
+\connect - postgres
+
+--
+-- TOC Entry ID 9 (OID 16556)
+--
+-- Name: "plpgsql_call_handler" () Type: FUNCTION Owner: postgres
+--
+
+CREATE FUNCTION "plpgsql_call_handler" () RETURNS opaque AS '$libdir/plpgsql', 'plpgsql_call_handler' LANGUAGE 'C';
+
+--
+-- TOC Entry ID 10 (OID 16557)
+--
+-- Name: plpgsql Type: PROCEDURAL LANGUAGE Owner:
+--
+
+CREATE TRUSTED PROCEDURAL LANGUAGE 'plpgsql' HANDLER "plpgsql_call_handler" LANCOMPILER '';
+
+\connect - ipdb
+
+--
+-- TOC Entry ID 2 (OID 25848)
+--
+-- Name: allocations Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "allocations" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "custid" character varying(16) DEFAULT '',
+ "type" character(2) DEFAULT '',
+ "city" character varying(30) DEFAULT '',
+ "description" character varying(64) DEFAULT '',
+ "notes" text,
+ "maskbits" integer DEFAULT 128,
+ Constraint "allocations_pkey" Primary Key ("cidr")
+);
+
+--
+-- TOC Entry ID 3 (OID 25854)
+--
+-- Name: customers Type: TABLE Owner: 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")
+);
+
+--
+-- TOC Entry ID 4 (OID 25860)
+--
+-- Name: freeblocks Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "freeblocks" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "maskbits" integer DEFAULT 128,
+ "city" character varying(30) DEFAULT '',
+ "routed" character(1) DEFAULT 'n',
+ CHECK (((routed = 'y'::bpchar) OR (routed = 'n'::bpchar))),
+ Constraint "freeblocks_pkey" Primary Key ("cidr")
+);
+
+--
+-- TOC Entry ID 5 (OID 25866)
+--
+-- Name: poolips Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "poolips" (
+ "pool" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "ip" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "custid" character varying(16) DEFAULT '' NOT NULL,
+ "city" character varying(30) DEFAULT '',
+ "ptype" character(1) DEFAULT 'c' NOT NULL,
+ "available" character(1) DEFAULT 'y',
+ "notes" text,
+ CHECK ((((ptype = 'c'::bpchar) OR (ptype = 'd'::bpchar)) OR (ptype = 's'::bpchar))),
+ CHECK (((available = 'y'::bpchar) OR (available = 'n'::bpchar))),
+ Constraint "poolips_pkey" Primary Key ("ip")
+);
+
+--
+-- TOC Entry ID 6 (OID 25872)
+--
+-- Name: masterblocks Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "masterblocks" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ Constraint "masterblocks_pkey" Primary Key ("cidr")
+);
+
+--
+-- TOC Entry ID 7 (OID 25875)
+--
+-- Name: routed Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "routed" (
+ "cidr" cidr DEFAULT '255.255.255.255/32' NOT NULL,
+ "maskbits" integer DEFAULT 128,
+ "city" character varying(30) DEFAULT '',
+ Constraint "routed_pkey" Primary Key ("cidr")
+);
+
+--
+-- TOC Entry ID 8 (OID 31131)
+--
+-- Name: temp Type: TABLE Owner: ipdb
+--
+
+CREATE TABLE "temp" (
+ "ofs" integer
+);
+
Index: /branches/stable/cgi-bin/main.cgi
===================================================================
--- /branches/stable/cgi-bin/main.cgi (revision 18)
+++ /branches/stable/cgi-bin/main.cgi (revision 18)
@@ -0,0 +1,1500 @@
+#!/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 IPDB qw(:ALL);
+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";
+
+checkDBSanity();
+
+#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(*) ..."
+
+my $RESULTS_PER_PAGE = 50;
+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"
+);
+
+# Other global variables
+my @masterblocks;
+my %allocated; # Count for allocated blocks in a master block
+my %free; # Count for free blocks (routed and unrouted) in a master block
+my %bigfree; # Tracking largest free block in a master block
+my %routed; # Number of routed blocks in a master block
+
+# Why not a global DB handle? (And a global statement handle, as well...)
+# We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
+# Use the connectDB function, otherwise we end up confusing ourselves
+my $ip_dbh = connectDB;
+
+# Slurp up the master block list - we need this several places
+# While we're at it, initialize the related hashes.
+my $sth = $ip_dbh->prepare("select * 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;
+}
+
+
+
+
+#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;
+# Don't need this with RaiseError, but leave it for now.
+# croak $sth->errstr if ($sth->errstr());
+
+# 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 values ('$webvar{cidr}',".
+ $cidr->masklen.",'','n')");
+ $sth->execute;
+# Don't need this with RaiseError, but leave it for now.
+# croak $sth->errstr if ($sth->errstr());
+
+ # 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: '$@'";
+ printAndExit("Could not add master block $webvar{cidr} to database");
+ }
+
+ print "Success!
\n";
+
+ printFooter;
+} # 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});
+ }
+ printFooter();
+}
+
+# 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]);
+}
+
+
+#end main()
+
+# Shut up error log warning about not disconnecting. Maybe.
+$ip_dbh->disconnect;
+# Just in case something waaaayyy down isn't in place properly...
+exit 0;
+
+
+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);
+ $sql = "select * 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 * from searchme where custid 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);
+
+ } elsif ($category eq 'desc') {
+
+ print qq(
Searching for descriptions containing '$query'
\n);
+ # Query based on description (includes "name" from old DB).
+ $sql = "select * from searchme where description 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);
+
+ } 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 * 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 * 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
+ print "4-octet pattern found; finding netblock containing IP $query \n";
+ my ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/);
+ my $sfor = new NetAddr::IP $query;
+ $sth = $ip_dbh->prepare("select * from searchme where text(cidr) like '$net%'");
+ $sth->execute;
+ while (my @data = $sth->fetchrow_array()) {
+ my $cidr = new NetAddr::IP $data[0];
+ if ($cidr->contains($sfor)) {
+ queryResults("select * 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 * 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...
+ printAndExit("Invalid query.");
+ }
+ } else {
+ # This shouldn't happen, but if it does, whoever gets it deserves what they get...
+ printAndExit("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 "
" if (!defined($element));
+ $element =~ s|\n||g;
+ print "
$element
\n";
+ }
+ 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,notes
+ # Fix up types from pools (which are single-char)
+ # Fixing the database would be... painful. :(
+ if ($data[2] =~ /^[cdsm]$/) {
+ $data[2] .= 'i';
+ }
+ my @row = (qq($data[0]),
+ $data[1], $full_alloc_types{$data[2]}, $data[3], $data[4]);
+ # Allow listing of pool if desired/required.
+ if ($data[2] =~ /^[sdcmw]p$/) {
+ $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
+{
+ print "Content-type: text/html\n\n";
+
+ startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
+ 'Free netblocks', 'Largest free block');
+
+# Snag the allocations.
+# I think it's too confusing to leave out internal allocations.
+ $sth = $ip_dbh->prepare("select * from allocations");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,custid,type,city,description
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ foreach my $master (@masterblocks) {
+ if ($master->contains($cidr)) {
+ $allocated{"$master"}++;
+ }
+ }
+ }
+
+# Snag routed blocks
+ $sth = $ip_dbh->prepare("select * from routed");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,maskbits,city
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ foreach my $master (@masterblocks) {
+ if ($master->contains($cidr)) {
+ $routed{"$master"}++;
+ }
+ }
+ }
+
+# Snag the free blocks.
+ $sth = $ip_dbh->prepare("select * from freeblocks");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,maskbits,city
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ foreach my $master (@masterblocks) {
+ if ($master->contains($cidr)) {
+ $free{"$master"}++;
+ if ($cidr->masklen < $bigfree{"$master"}) { $bigfree{"$master"} = $cidr->masklen; }
+ }
+ }
+ }
+
+# Print the data.
+ my $count=0;
+ foreach my $master (@masterblocks) {
+ 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++;
+ }
+ print "
\n);
+ print "Note: Free blocks noted here include both routed and unrouted blocks.\n";
+
+ # Because of the way this sub gets called, we don't need to print the footer here.
+ # (index.shtml makes an SSI #include call to cgi-bin/main.cgi?action=index)
+ # If we do, the footer comes in twice...
+ #printFooter;
+} # 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 $master = new NetAddr::IP $webvar{block};
+ my @localmasters;
+
+ $sth = $ip_dbh->prepare("select * from routed order by cidr");
+ $sth->execute();
+
+ my $i=0;
+ while (my @data = $sth->fetchrow_array()) {
+ my $cidr = new NetAddr::IP $data[0];
+ if ($master->contains($cidr)) {
+ $localmasters[$i++] = $cidr;
+ $free{"$cidr"} = 0;
+ $allocated{"$cidr"} = 0;
+ # Retain the routing destination
+ $routed{"$cidr"} = $data[2];
+ }
+ }
+
+# 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 * from allocations");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,custid,type,city,description
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ foreach my $master (@localmasters) {
+ if ($master->contains($cidr)) {
+ $allocated{"$master"}++;
+ }
+ }
+ }
+
+ # initialize bigfree base points
+ foreach my $lmaster (@localmasters) {
+ $bigfree{"$lmaster"} = 128;
+ }
+
+ # Snag the free blocks.
+ $sth = $ip_dbh->prepare("select * from freeblocks");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,maskbits,city
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ foreach my $lmaster (@localmasters) {
+ if ($lmaster->contains($cidr)) {
+ $free{"$lmaster"}++;
+ if ($cidr->masklen < $bigfree{"$lmaster"}) {
+ $bigfree{"$lmaster"} = $cidr->masklen;
+ }
+ }
+ # check for largest free block
+ }
+ }
+
+ # 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 * from freeblocks where routed='n' order by cidr");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,maskbits,city
+ # We only need the cidr
+ my $cidr = new NetAddr::IP $data[0];
+ if ($master->contains($cidr)) {
+ my @row = ("$cidr", $cidr->range);
+ printRow(\@row, 'color1' ) if($count%2==0);
+ printRow(\@row, 'color2' ) if($count%2!=0);
+ $count++;
+ }
+ }
+
+ print "\n";
+ printFooter;
+} # 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 * from routed where cidr='$master'");
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+
+ print qq(
Summarizing allocated blocks for ).
+ qq($master ($data[2]):
\n);
+
+ $sth = $ip_dbh->prepare("select * from allocations order by cidr");
+ $sth->execute();
+
+ startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
+
+ my $count=0;
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,custid,type,city,description,notes,maskbits
+ my $cidr = new NetAddr::IP $data[0];
+ if (!$master->contains($cidr)) { next; }
+
+ # Clean up extra spaces that are borking things.
+ $data[2] =~ s/\s+//g;
+
+ my @row = ("$data[0]",
+ $data[3], $full_alloc_types{$data[2]}, $data[1], $data[4]);
+ # If the allocation is a pool, allow listing of the IPs in the pool.
+ if ($data[2] =~ /^[sdcmw]p$/) {
+ $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 * from freeblocks where routed='y' order by cidr");
+ $sth->execute();
+ while (my @data = $sth->fetchrow_array()) {
+ # cidr,maskbits,city
+ my $cidr = new NetAddr::IP $data[0];
+ if ($master->contains($cidr)) {
+ my @row = ("$cidr", $cidr->range);
+ printRow(\@row, 'color1') if ($count%2 == 0);
+ printRow(\@row, 'color2') if ($count%2 != 0);
+ $count++;
+ }
+ }
+
+ print "\n";
+ printFooter;
+} # showRBlock
+
+
+# List the IPs used in a pool
+sub listPool {
+ printHeader('');
+
+ my $cidr = new NetAddr::IP $webvar{pool};
+
+ # Snag pool info for heading
+ $sth = $ip_dbh->prepare("select * from allocations where cidr='$cidr'");
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+ my $type = $data[2]; # We'll need this later.
+
+ print qq(
Listing pool IPs for $cidr \n).
+ qq(($full_alloc_types{$type} in $data[3])
\n);
+ 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 * 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
+ # If desc is null, make it not null.
+ if ($data[7] eq '') {
+ $data[7] = ' ';
+ }
+ # Some nice hairy Perl to decide whether to allow unassigning each IP
+ # -> if $data[5] (aka poolips.available) == 'n' then we print the unassign link
+ # else we print a blank space
+ my @row = ( qq($data[1]),
+ $data[2],$data[5],$data[7],
+ ( ($data[5] eq 'n') ?
+ ("Unassign this IP") :
+ (" ") )
+ );
+ printRow(\@row, 'color1') if($count%2==0);
+ printRow(\@row, 'color2') if($count%2!=0);
+ $count++;
+ }
+ print "\n";
+
+ printFooter;
+} # end listPool
+
+
+# Should this maybe just be a full static page? It just spews out some predefined HTML.
+sub assignBlock {
+ printHeader('');
+
+ open HTML, "../assign.html"
+ or croak "Could not open assign.html: $!";
+ my $html = join('',);
+ close(HTML);
+
+ print $html;
+
+ printFooter();
+} # 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.
+ validateInput();
+
+# This isn't always useful.
+# if (!$webvar{maskbits}) {
+# printAndExit("Please enter a CIDR block length.");
+# }
+
+# Several different cases here.
+# Static IP vs netblock
+# + Different flavours of static IP
+# + Different flavours of netblock
+
+ if ($webvar{alloctype} =~ /^[cdsm]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.
+ if ($base =~ /^[ds]$/) {
+ $sql = "select * from poolips where available='y' and".
+ " ptype='$base' and city='Sudbury' or city='North Bay'";
+ } else {
+## $city doesn't seem to get defined here.
+my $city; # Shut up Perl's "strict" scoping/usage check.
+ $sql = "select * from poolips where available='y' and".
+ " ptype='$base' and city='$webvar{city}'";
+ }
+
+ # 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]}++;
+ }
+ foreach my $key (keys %ipcount) {
+ $optionlist .= "\n";
+ }
+ $cidr = "Single static IP";
+ $alloc_from = "\n";
+
+ } else { # end show pool options
+ if (!$webvar{maskbits}) {
+ printAndExit("Please specify a CIDR mask length.");
+ }
+ my $sql;
+ my $city;
+ my $failmsg;
+ if ($webvar{alloctype} eq 'rr') {
+ $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 {
+ if ($webvar{alloctype} =~ /^[sd]p$/) {
+ if (($webvar{city} !~ /^(Sudbury|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
+ printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
+ if ($webvar{alloctype} eq 'sp') { $city = "Sudbury"; } else { $city = $webvar{city}; }
+ $failmsg = "No suitable free block found. \nYou will have to route another".
+ " superblock \nfrom one of the master 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{city} \nfrom one of the master blocks in Sudbury or".
+ " chose a smaller blocksize.";
+ }
+ $sql = "select * from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
+ " and routed='y' order by cidr,maskbits desc";
+ }
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ my @data = $sth->fetchrow_array();
+ if ($data[0] eq "") {
+ printAndExit($failmsg);
+ }
+
+ $cidr = new NetAddr::IP $data[0];
+ $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} =~ /^[cdsm]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\$\$|$full_alloc_types{$webvar{alloctype}}|g;
+ $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
+ $html =~ s|\$\$CIDR\$\$|$cidr|g;
+ $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
+ $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
+ $webvar{desc} = desanitize($webvar{desc});
+ $webvar{notes} = desanitize($webvar{notes});
+ $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
+ $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
+ $html =~ s|\$\$ACTION\$\$|insert|g;
+
+ print $html;
+
+ printFooter;
+} # end confirmAssign
+
+
+# Do the work of actually inserting a block in the database.
+sub insertAssign {
+ # Some things are done more than once.
+ printHeader('');
+ validateInput();
+
+ # Set some things that may be needed
+ # Don't set $cidr here as it may not even be a valid IP address.
+ my $alloc_from = new NetAddr::IP $webvar{alloc_from};
+
+# dynDSL (dy), sIP DSL(dp), and server pools (sp) are nominally allocated to Sudbury
+# no matter what else happens.
+# if ($webvar{alloctype} =~ /^([sd]p|dy)$/) { $webvar{city} = "Sudbury"; }
+# OOPS. forgot about North Bay DSL.
+#### Gotta make this cleaner and more accurate
+# if ($webvar{alloctype} eq "sp") { $webvar{city} = "Sudbury"; }
+
+# Same ordering as confirmation page
+
+ if ($webvar{alloctype} =~ /^[cdsm]i$/) {
+ my ($base,$tmp) = split //, $webvar{alloctype}; # split into individual chars
+
+ # We'll just have to put up with the oddities caused by SQL (un)sort order
+ $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{alloc_from}'".
+ " and available='y'");
+ $sth->execute;
+
+ my @data = $sth->fetchrow_array;
+ my $cidr = $data[1];
+
+ $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',available='n'".
+ " where ip='$cidr'");
+ $sth->execute;
+ if ($sth->err) {
+ printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
+ syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser failed: ".
+ "'".$sth->errstr."'";
+ }
+ print qq(
The IP $cidr has been allocated to customer $webvar{custid}
);
+ syslog "notice", "$authuser allocated $cidr to $webvar{custid}";
+
+ } else { # end IP-from-pool allocation
+
+ # Set $cidr here as it may not be a valid IP address elsewhere.
+ my $cidr = new NetAddr::IP $webvar{fullcidr};
+
+# Allow transactions, and make errors much easier to catch.
+# Much as I would like to error-track specifically on each ->execute,
+# that's a LOT of code. :/
+ $ip_dbh->{AutoCommit} = 0;
+ $ip_dbh->{RaiseError} = 1;
+
+ if ($webvar{fullcidr} eq $webvar{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 {
+ if ($webvar{alloctype} eq 'rr') {
+ $sth = $ip_dbh->prepare("update freeblocks set routed='y',city='$webvar{city}'".
+ " where cidr='$webvar{fullcidr}'");
+ $sth->execute;
+ $sth = $ip_dbh->prepare("insert into routed values ('$webvar{fullcidr}',".
+ $cidr->masklen.",'$webvar{city}')");
+ $sth->execute;
+ } else {
+ # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
+
+ # city has to be reset for DSL/server pools; nominally to Sudbury.
+ ## Gotta rethink this; DSL pools can be in North Bay as well. :/
+ #if ($webvar{alloctype} =~ /^[sd]p$/) { $webvar{city} = 'Sudbury'; }
+
+ $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{fullcidr}'");
+ $sth->execute;
+
+ $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
+ "'$webvar{custid}','$webvar{alloctype}','$webvar{city}','$webvar{desc}',".
+ "'$webvar{notes}',".$cidr->masklen.")");
+ $sth->execute;
+ } # routing vs non-routing netblock
+ $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");
+ }
+
+ # If we get here, the DB transaction has succeeded.
+ syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
+
+# How to log SQL without munging too many error-checking wrappers in?
+# syslog "info", "
+# We don't. GRRR.
+
+ } else { # webvar{fullcidr} != webvar{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.
+
+ my $i=0;
+ while ($maskbits++ < $wantmaskbits) {
+ my @subblocks = $alloc_from->split($maskbits);
+ $newfreeblocks[$i++] = $subblocks[1];
+ } # while
+
+ # Begin SQL transaction block
+ eval {
+ # Delete old freeblocks entry
+ $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{alloc_from}'");
+ $sth->execute();
+
+ # now we have to do some magic for routing blocks
+ if ($webvar{alloctype} eq 'rr') {
+ # Insert the new freeblocks entries
+ # Note that non-routed blocks are assigned to
+ $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, '','n')");
+ foreach my $block (@newfreeblocks) {
+ $sth->execute("$block", $block->masklen);
+ }
+ # Insert the entry in the routed table
+ $sth = $ip_dbh->prepare("insert into routed values ('$cidr',".
+ $cidr->masklen.",'$webvar{city}')");
+ $sth->execute;
+ # Insert the (almost) same entry in the freeblocks table
+ $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".
+ $cidr->masklen.",'$webvar{city}','y')");
+ $sth->execute;
+
+ } else { # done with alloctype == rr
+
+ # Insert the new freeblocks entries
+ $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ?,'y')");
+ foreach my $block (@newfreeblocks) {
+ $sth->execute("$block", $block->masklen, $webvar{city});
+ }
+ # Insert the allocations entry
+ $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
+ "'$webvar{custid}','$webvar{alloctype}','$webvar{city}',".
+ "'$webvar{desc}','$webvar{notes}',".$cidr->masklen.")");
+ $sth->execute;
+ } # done with netblock alloctype != rr
+ $ip_dbh->commit;
+ }; # end 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");
+ }
+ syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
+
+ } # end fullcidr != alloc_from
+
+ # Begin SQL transaction block
+ eval {
+ # special extra handling for pools.
+ # Note that this must be done for ANY pool allocation!
+ if ( my ($pooltype) = ($webvar{alloctype} =~ /^([cdsm])p$/) ) {
+ # have to insert all pool IPs into poolips table as "unallocated".
+ $sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
+ " ?, '6750400', '$webvar{city}', '$pooltype', 'y', '')");
+ my @poolip_list = $cidr->hostenum;
+ for (my $i=1; $i<=$#poolip_list; $i++) {
+ $sth->execute($poolip_list[$i]->addr);
+ }
+ } # end pool special
+ $ip_dbh->commit;
+ }; # end eval
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "Initialization of pool '$webvar{fullcidr}' by $authuser failed: '$@'";
+ printAndExit("$full_alloc_types{$webvar{alloctype}} $webvar{fullcidr} not completely initialized.");
+ }
+ syslog "notice", "$full_alloc_types{$webvar{alloctype}} '$webvar{fullcidr}' successfully initialized by $authuser";
+
+ # Turn off transactions and exception-on-error'ing
+ $ip_dbh->{AutoCommit} = 0;
+ $ip_dbh->{RaiseError} = 1;
+
+ print qq(
The block $webvar{fullcidr} was sucessfully added as type '$webvar{alloctype}' ($full_alloc_types{$webvar{alloctype}})
);
+
+ } # end static-IP vs netblock allocation
+
+ printFooter();
+} # 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 '-') {
+ printAndExit("Please choose a city.");
+ }
+ chomp $webvar{alloctype};
+ # We have different handling for customer allocations and "internal" or "our" allocations
+ if ($webvar{alloctype} =~ /^(ci|di|cn|mi)$/) {
+ if (!$webvar{custid}) {
+ printAndExit("Please enter a customer ID.");
+ }
+ if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)$/) {
+ printAndExit("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
+ }
+ print "\n";
+ } elsif ($webvar{alloctype} =~ /^([sdcmw]p|si|dn|dy|dc|ee|rr|ii)$/){
+ # All non-customer allocations MUST be entered with "our" customer ID.
+ # I have Defined this as 6750400 for consistency.
+ $webvar{custid} = "6750400";
+ if ($webvar{alloctype} eq 'rr') {
+ if ($webvar{city} !~ /^(?:Huntsville|North Bay|Ottawa|Pembroke|Sault Ste. Marie|Sudbury|Timmins|Toronto)$/) {
+ printAndExit("Please choose a valid POP location for a routed netblock. Valid ".
+ "POP locations are currently: \n Huntsville North Bay Ottawa Pembroke ".
+ "Sault Ste. Marie Sudbury Timmins Toronto");
+ }
+ }
+ } else {
+ # 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.
+ printAndExit("Invalid alloctype");
+ }
+ return 0;
+} # 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,ptype,city,description,notes from poolips where ip='$webvar{block}'";
+ } else {
+ $sql = "select cidr,custid,type,city,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//;
+
+ # Postfix "i" on pool IP types
+ if ($data[2] =~ /^[cdsm]$/) {
+ $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.
+
+ $html =~ s/\$\$TYPE\$\$/$data[2]/g;
+ $html =~ s/\$\$FULLTYPE\$\$/$full_alloc_types{$data[2]}/g;
+
+ # These can be modified, although CustID changes may get ignored.
+ $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
+ $html =~ s/\$\$DESC\$\$/$data[4]/g;
+ $html =~ s/\$\$NOTES\$\$/$data[5]/g;
+
+ print $html;
+
+ printFooter();
+} # 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} =~ /^([cdms])i$/) ) {
+ $sql = "update poolips set custid='$webvar{custid}',".
+ "notes='$webvar{notes}',description='$webvar{desc}' ".
+ "where ip='$webvar{block}'";
+ } else {
+ $sql = "update allocations set custid='$webvar{custid}',".
+ "description='$webvar{desc}',notes='$webvar{notes}' ".
+ "where cidr='$webvar{block}'";
+ }
+syslog "debug", $sql;
+ $sth = $ip_dbh->prepare($sql);
+ $sth->execute;
+ $ip_dbh->commit;
+ };
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
+ printAndExit("Could not update block/IP $webvar{block}");
+ }
+
+ # 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;
+ $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
+ $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
+ $html =~ s/\$\$TYPEFULL\$\$/$full_alloc_types{$webvar{alloctype}}/g;
+ $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
+ $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
+ $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
+
+ print $html;
+
+ printFooter;
+} # 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})) {
+ printAndExit("Error 332");
+ }
+
+ my ($cidr, $custid, $type, $city, $desc, $notes, $alloctype);
+
+ if ($webvar{alloctype} eq 'rr') {
+ $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};
+ $desc = "N/A";
+ $notes = "N/A";
+
+ } elsif ($webvar{alloctype} eq 'mm') {
+ $cidr = $webvar{block};
+ $city = "N/A";
+ $custid = "N/A";
+ $alloctype = $webvar{alloctype};
+ $desc = "N/A";
+ $notes = "N/A";
+ } elsif ($webvar{alloctype} =~ /^[sdcmw]i$/) { # done with alloctype=rr
+
+ # Unassigning a static IP
+ my $sth = $ip_dbh->prepare("select ip,custid,city,ptype,notes from poolips".
+ " where ip='$webvar{block}'");
+ $sth->execute();
+# croak $sth->errstr() if($sth->errstr());
+
+ $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes);
+ $sth->fetch() || croak $sth->errstr;
+
+ $alloctype .="i";
+
+ } else { # done with alloctype=[sdcmw]i
+
+ my $sth = $ip_dbh->prepare("select cidr,custid,type,city,description,notes from ".
+ "allocations where cidr='$webvar{block}'");
+ $sth->execute();
+# croak $sth->errstr() if($sth->errstr());
+
+ $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$desc, \$notes);
+ $sth->fetch() || croak $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\$\$|$full_alloc_types{$alloctype}|g;
+ $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
+ $html =~ s|\$\$CITY\$\$|$city|g;
+ $html =~ s|\$\$CUSTID\$\$|$custid|g;
+ $html =~ s|\$\$DESC\$\$|$desc|g;
+ $html =~ s|\$\$NOTES\$\$|$notes|g;
+
+ $html =~ s|\$\$ACTION\$\$|finaldelete|g;
+
+ # Set the warning text.
+ if ($alloctype =~ /^[sdcmw]p$/) {
+ $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;
+ printFooter;
+} # 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('');
+
+ # Enable transactions and exception-on-errors... but only for this sub
+ local $ip_dbh->{AutoCommit} = 0;
+ local $ip_dbh->{RaiseError} = 1;
+
+ if ($webvar{alloctype} =~ /^[sdcmw]i$/) {
+
+ eval {
+ $sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
+ $sth->execute;
+ my @data = $sth->fetchrow_array;
+ $sth = $ip_dbh->prepare("select city from allocations where cidr='$data[0]'");
+ $sth->execute;
+ @data = $sth->fetchrow_array;
+ $sth = $ip_dbh->prepare("update poolips set custid='6750400', available='y',".
+ " city='$data[0]' where ip='$webvar{block}'");
+ $sth->execute;
+ $ip_dbh->commit;
+ };
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$@'";
+ printAndExit("Could not deallocate static IP $webvar{block}");
+ }
+ print "
Success! $webvar{block} deallocated.
\n";
+ syslog "notice", "$authuser deallocated static IP $webvar{block}";
+
+ } elsif ($webvar{alloctype} eq 'mm') { # end alloctype = [sdcmw]i
+
+ eval {
+ $sth = $ip_dbh->prepare("delete from masterblocks where cidr='$webvar{block}'");
+ $sth->execute;
+ $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{block}'");
+ $sth->execute;
+ $ip_dbh->commit;
+ };
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "$authuser could not remove master block '$webvar{block}': '$@'";
+ printAndExit("Could not remove master block $webvar{block}");
+ }
+ print "
Success! Master $webvar{block} removed.
\n";
+ syslog "notice", "$authuser removed master block $webvar{block}";
+
+ } 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 {
+
+ my $cidr = new NetAddr::IP $webvar{block};
+ if ($webvar{alloctype} eq 'rr') {
+
+ $sth = $ip_dbh->prepare("delete from routed where cidr='$webvar{block}'");
+ $sth->execute;
+ # Make sure block getting deleted is properly accounted for.
+ $sth = $ip_dbh->prepare("update freeblocks set routed='n',city=''".
+ " where cidr='$webvar{block}'");
+ $sth->execute;
+ # Set up query to start compacting free blocks.
+ $sth = $ip_dbh->prepare("select * from freeblocks where ".
+ "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
+
+ } else { # end alloctype routing case
+
+ $sth = $ip_dbh->prepare("delete from allocations where cidr='$webvar{block}'");
+ $sth->execute;
+ # Special case - delete pool IPs
+ if ($webvar{alloctype} =~ /^[sdcmw]p$/) {
+ # We have to delete the IPs from the pool listing.
+ $sth = $ip_dbh->prepare("delete from poolips where pool='$webvar{block}'");
+ $sth->execute;
+ }
+
+ # Set up query for compacting free blocks.
+ $sth = $ip_dbh->prepare("select * from freeblocks where city='$webvar{city}'".
+ " and maskbits<=".$cidr->masklen." and routed='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. $i==0 if not.
+ if ($i>0) {
+ $sth = $ip_dbh->prepare("delete from freeblocks where cidr=?");
+ foreach my $block (@combinelist) {
+ $sth->execute("$block");
+ }
+ }
+
+ # insert "new" freeblocks entry
+ if ($webvar{alloctype} eq 'rr') {
+ $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+ ",'','n')");
+ } else {
+ $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
+ ",'$webvar{city}','y')");
+ }
+ $sth->execute;
+
+ # If we got here, we've succeeded. Whew!
+ $ip_dbh->commit;
+ }; # end eval
+ if ($@) {
+ carp "Transaction aborted because $@";
+ eval { $ip_dbh->rollback; };
+ syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$@'";
+ printAndExit("Could not deallocate netblock $webvar{block}");
+ }
+ print "
![[ Logo ]](/ip/images/logo.png)