Context Navigation

source: branches/stable/cgi-bin/IPDB.pm@ 448

Last change on this file since 448 was 445, checked in by Kris Deugau, 14 years ago

/branches/stable

Bring /branches/stable up to date with /trunk. See #13.

Property svn:keywords set to Date Rev Author

File size: 29.2 KB

Rev	Line
[8]	1	# ipdb/cgi-bin/IPDB.pm
[71]	2	# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
[8]	3	###
	4	# SVN revision info
	5	# $Date: 2010-07-26 21:00:00 +0000 (Mon, 26 Jul 2010) $
	6	# SVN revision $Rev: 445 $
	7	# Last update by $Author: kdeugau $
	8	###
[445]	9	# Copyright (C) 2004-2010 - Kris Deugau
[8]	10
[4]	11	package IPDB;
	12
	13	use strict;
	14	use warnings;
	15	use Exporter;
[125]	16	use DBI;
[71]	17	use Net::SMTP;
[365]	18	use NetAddr::IP qw( Compact );
[71]	19	use POSIX;
[4]	20	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	21
[445]	22	$VERSION = 2; ##VERSION##
[4]	23	@ISA = qw(Exporter);
[125]	24	@EXPORT_OK = qw(
[168]	25	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
[242]	26	%allocated %free %routed %bigfree %IPDBacl
[365]	27	&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &addMaster
	28	&deleteBlock &getBlockData &mailNotify
[125]	29	);
[4]	30
	31	@EXPORT = (); # Export nothing by default.
[125]	32	%EXPORT_TAGS = ( ALL => [qw(
[168]	33	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
[242]	34	@masterblocks %allocated %free %routed %bigfree %IPDBacl
[125]	35	&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
[365]	36	&addMaster &deleteBlock &getBlockData &mailNotify
[125]	37	)]
	38	);
[4]	39
[125]	40	##
	41	## Global variables
	42	##
	43	our %disp_alloctypes;
	44	our %list_alloctypes;
[168]	45	our %def_custids;
[125]	46	our @citylist;
	47	our @poplist;
	48	our @masterblocks;
	49	our %allocated;
	50	our %free;
	51	our %routed;
	52	our %bigfree;
[242]	53	our %IPDBacl;
[71]	54
[445]	55	our $org_name = 'Example Corp';
	56	our $smtphost = 'smtp.example.com';
	57	our $domain = 'example.com';
	58	our $defcustid = '5554242';
	59	# mostly for rwhois
	60	##fixme: leave these blank by default?
	61	our $rwhoisDataPath = '/usr/local/rwhoisd/etc/rwhoisd'; # to match ./configure defaults from rwhoisd-1.5.9.6
	62	our $org_street = '123 4th Street';
	63	our $org_city = 'Anytown';
	64	our $org_prov_state = 'ON';
	65	our $org_pocode = 'H0H 0H0';
	66	our $org_country = 'CA';
	67	our $org_phone = '000-555-1234';
	68	our $org_techhandle = 'ISP-ARIN-HANDLE';
	69	our $org_email = 'noc@example.com';
	70	our $hostmaster = 'dns@example.com';
	71
	72	our $syslog_facility = 'local2';
	73
[125]	74	# Let's initialize the globals.
	75	## IPDB::initIPDBGlobals()
	76	# Initialize all globals. Takes a database handle, returns a success or error code
	77	sub initIPDBGlobals {
	78	my $dbh = $_[0];
	79	my $sth;
	80
	81	# Initialize alloctypes hashes
[168]	82	$sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
[125]	83	$sth->execute;
	84	while (my @data = $sth->fetchrow_array) {
	85	$disp_alloctypes{$data[0]} = $data[2];
[168]	86	$def_custids{$data[0]} = $data[4];
[125]	87	if ($data[3] < 900) {
	88	$list_alloctypes{$data[0]} = $data[1];
	89	}
	90	}
	91
	92	# City and POP listings
[159]	93	$sth = $dbh->prepare("select city,routing from cities order by city");
[125]	94	$sth->execute;
	95	return (undef,$sth->errstr) if $sth->err;
	96	while (my @data = $sth->fetchrow_array) {
	97	push @citylist, $data[0];
	98	if ($data[1] eq 'y') {
	99	push @poplist, $data[0];
	100	}
	101	}
	102
	103	# Master block list
[159]	104	$sth = $dbh->prepare("select cidr from masterblocks order by cidr");
[125]	105	$sth->execute;
[242]	106	return (undef,$sth->errstr) if $sth->err;
[125]	107	for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
	108	$masterblocks[$i] = new NetAddr::IP $data[0];
	109	$allocated{"$masterblocks[$i]"} = 0;
	110	$free{"$masterblocks[$i]"} = 0;
	111	$bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
	112	# Set to 128 to prepare for IPv6
	113	$routed{"$masterblocks[$i]"} = 0;
	114	}
[242]	115
	116	# Load ACL data. Specific username checks are done at a different level.
	117	$sth = $dbh->prepare("select username,acl from users");
	118	$sth->execute;
[125]	119	return (undef,$sth->errstr) if $sth->err;
[242]	120	while (my @data = $sth->fetchrow_array) {
	121	$IPDBacl{$data[0]} = $data[1];
	122	}
[125]	123
	124	return (1,"OK");
	125	} # end initIPDBGlobals
	126
	127
	128	## IPDB::connectDB()
[4]	129	# Creates connection to IPDB.
[125]	130	# Requires the database name, username, and password.
[4]	131	# Returns a handle to the db.
[125]	132	# Set up for a PostgreSQL db; could be any transactional DBMS with the
	133	# right changes.
[4]	134	sub connectDB {
[445]	135	my $dbname = shift;
	136	my $user = shift;
	137	my $pass = shift;
	138	my $dbhost = shift;
	139
[4]	140	my $dbh;
[445]	141	my $DSN = "DBI:Pg:".($dbhost ? "host=$dbhost;" : '')."dbname=$dbname";
[4]	142
	143	# Note that we want to autocommit by default, and we will turn it off locally as necessary.
[125]	144	# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
	145	$dbh = DBI->connect($DSN, $user, $pass, {
	146	AutoCommit => 1,
	147	PrintError => 0
	148	})
	149	or return (undef, $DBI::errstr) if(!$dbh);
[4]	150
[125]	151	# Return here if we can't select. Note that this indicates a
	152	# problem executing the select.
[185]	153	my $sth = $dbh->prepare("select type from alloctypes");
[125]	154	$sth->execute();
	155	return (undef,$DBI::errstr) if ($sth->err);
	156
	157	# See if the select returned anything (or null data). This should
	158	# succeed if the select executed, but...
	159	$sth->fetchrow();
	160	return (undef,$DBI::errstr) if ($sth->err);
	161
	162	# If we get here, we should be OK.
	163	return ($dbh,"DB connection OK");
[4]	164	} # end connectDB
	165
[125]	166
	167	## IPDB::finish()
	168	# Cleans up after database handles and so on.
	169	# Requires a database handle
	170	sub finish {
	171	my $dbh = $_[0];
	172	$dbh->disconnect;
	173	} # end finish
	174
	175
	176	## IPDB::checkDBSanity()
[4]	177	# Quick check to see if the db is responding. A full integrity
	178	# check will have to be a separate tool to walk the IP allocation trees.
	179	sub checkDBSanity {
[125]	180	my ($dbh) = $_[0];
[4]	181
	182	if (!$dbh) {
[125]	183	print "No database handle, or connection has been closed.";
	184	return -1;
[4]	185	} else {
	186	# it connects, try a stmt.
[185]	187	my $sth = $dbh->prepare("select type from alloctypes");
[4]	188	my $err = $sth->execute();
	189
	190	if ($sth->fetchrow()) {
	191	# all is well.
	192	return 1;
	193	} else {
[16]	194	print "Connected to the database, but could not execute test statement. ".$sth->errstr();
[125]	195	return -1;
[4]	196	}
	197	}
	198	# Clean up after ourselves.
[125]	199	# $dbh->disconnect;
[4]	200	} # end checkDBSanity
	201
[71]	202
[365]	203	## IPDB::addMaster()
	204	# Does all the magic necessary to sucessfully add a master block
	205	# Requires database handle, block to add
	206	# Returns failure code and error message or success code and "message"
	207	sub addMaster {
	208	my $dbh = shift;
	209	my $cidr = new NetAddr::IP shift;
	210
	211	# Allow transactions, and raise an exception on errors so we can catch it later.
	212	# Use local to make sure these get "reset" properly on exiting this block
	213	local $dbh->{AutoCommit} = 0;
	214	local $dbh->{RaiseError} = 1;
	215
	216	# Wrap all the SQL in a transaction
	217	eval {
	218	my $sth = $dbh->prepare("select count(*) from masterblocks where cidr <<= '$cidr'");
	219	$sth->execute;
	220	my @data = $sth->fetchrow_array;
	221
	222	if ($data[0] eq 0) {
	223	# First case - master is brand-spanking-new.
	224	##fixme: rwhois should be globally-flagable somewhere, much like a number of other things
	225	## maybe a db table called "config"?
	226	$sth = $dbh->prepare("insert into masterblocks (cidr,rwhois) values ('$cidr','y')");
	227	$sth->execute;
	228
	229	# Unrouted blocks aren't associated with a city (yet). We don't rely on this
	230	# elsewhere though; legacy data may have traps and pitfalls in it to break this.
	231	# Thus the "routed" flag.
	232
	233	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	234	" values ('$cidr',".$cidr->masklen.",'<NULL>','n')");
	235	$sth->execute;
	236
	237	# If we get here, everything is happy. Commit changes.
	238	$dbh->commit;
	239
	240	} # new master does not contain existing master(s)
	241	else {
	242
	243	# collect the master(s) we're going to absorb, and snag the longest netmask while we're at it.
	244	my $smallmask = $cidr->masklen;
	245	$sth = $dbh->prepare("select cidr as mask from masterblocks where cidr <<= '$cidr'");
	246	$sth->execute;
	247	my @cmasters;
	248	while (my @data = $sth->fetchrow_array) {
	249	my $master = new NetAddr::IP $data[0];
	250	push @cmasters, $master;
	251	$smallmask = $master->masklen if $master->masklen > $smallmask;
	252	}
	253
	254	# split the new master, and keep only those blocks not part of an existing master
	255	my @blocklist;
	256	foreach my $seg ($cidr->split($smallmask)) {
	257	my $contained = 0;
	258	foreach my $master (@cmasters) {
	259	$contained = 1 if $master->contains($seg);
	260	}
	261	push @blocklist, $seg if !$contained;
	262	}
	263
	264	# collect the unrouted free blocks within the new master
	265	$sth = $dbh->prepare("select cidr from freeblocks where ".
	266	"maskbits>=$smallmask and cidr <<= '$cidr' and routed='n'");
	267	$sth->execute;
	268	while (my @data = $sth->fetchrow_array) {
	269	my $freeblock = new NetAddr::IP $data[0];
	270	push @blocklist, $freeblock;
	271	}
	272
	273	# combine the set of free blocks we should have now.
	274	@blocklist = Compact(@blocklist);
	275
	276	# and now insert the new data. Make sure to delete old masters too.
	277
	278	# freeblocks
	279	$sth = $dbh->prepare("delete from freeblocks where cidr <<= ?");
	280	my $sth2 = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed) values (?,?,'<NULL>','n')");
	281	foreach my $newblock (@blocklist) {
	282	$sth->execute("$newblock");
	283	$sth2->execute("$newblock", $newblock->masklen);
	284	}
	285
	286	# master
	287	$sth = $dbh->prepare("delete from masterblocks where cidr <<= '$cidr'");
	288	$sth->execute;
	289	$sth = $dbh->prepare("insert into masterblocks (cidr,rwhois) values ('$cidr','y')");
	290	$sth->execute;
	291
	292	# whew If we got here, we likely suceeded.
	293	$dbh->commit;
	294	} # new master contained existing master(s)
	295	}; # end eval
	296
	297	if ($@) {
	298	my $msg = $@;
	299	eval { $dbh->rollback; };
	300	return ('FAIL',$msg);
	301	} else {
	302	return ('OK','OK');
	303	}
	304	} # end addMaster
	305
	306
[125]	307	## IPDB::allocateBlock()
[71]	308	# Does all of the magic of actually allocating a netblock
[125]	309	# Requires database handle, block to allocate, custid, type, city,
[286]	310	# description, notes, circuit ID, block to allocate from, private data
[125]	311	# Returns a success code and optional error message.
	312	sub allocateBlock {
[394]	313	my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata,$nodeid) = @_;
[286]	314
[125]	315	my $cidr = new NetAddr::IP $_[1];
	316	my $alloc_from = new NetAddr::IP $_[2];
	317	my $sth;
[71]	318
[336]	319	# Snag the "type" of the freeblock (alloc_from) "just in case"
	320	$sth = $dbh->prepare("select routed from freeblocks where cidr='$alloc_from'");
	321	$sth->execute;
	322	my ($alloc_from_type) = $sth->fetchrow_array;
	323
[125]	324	# To contain the error message, if any.
	325	my $msg = "Unknown error allocating $cidr as '$type'";
[71]	326
[125]	327	# Enable transactions and error handling
	328	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	329	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	330
[159]	331	if ($type =~ /^.i$/) {
[125]	332	$msg = "Unable to assign static IP $cidr to $custid";
	333	eval {
[159]	334	# We have to do this in two parts because otherwise we lose
	335	# the ability to return the IP assigned. Should that change,
	336	# the commented SQL statement below may become usable.
[125]	337	# update poolips set custid='$custid',city='$city',available='n',
	338	# description='$desc',notes='$notes',circuitid='$circid'
	339	# where ip=(select ip from poolips where pool='$alloc_from'
	340	# and available='y' order by ip limit 1);
[159]	341
	342	$sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'".
	343	" and available='y' order by ip");
	344	$sth->execute;
	345
[125]	346	my @data = $sth->fetchrow_array;
[159]	347	$cidr = $data[0]; # $cidr is already declared when we get here!
[125]	348
	349	$sth = $dbh->prepare("update poolips set custid='$custid',".
	350	"city='$city',available='n',description='$desc',notes='$notes',".
[286]	351	"circuitid='$circid',privdata='$privdata'".
[125]	352	" where ip='$cidr'");
	353	$sth->execute;
[394]	354	# node hack
	355	if ($nodeid && $nodeid ne '') {
	356	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	357	$sth->execute("$cidr",$nodeid);
	358	}
	359	# end node hack
[125]	360	$dbh->commit;
	361	};
	362	if ($@) {
	363	$msg .= ": '".$sth->errstr."'";
	364	eval { $dbh->rollback; };
	365	return ('FAIL',$msg);
	366	} else {
	367	return ('OK',"$cidr");
	368	}
	369
	370	} else { # end IP-from-pool allocation
	371
	372	if ($cidr == $alloc_from) {
	373	# Easiest case- insert in one table, delete in the other, and go home. More or less.
	374	# insert into allocations values (cidr,custid,type,city,desc) and
	375	# delete from freeblocks where cidr='cidr'
	376	# For data safety on non-transaction DBs, we delete first.
	377
	378	eval {
	379	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
[192]	380	if ($type eq 'rm') {
[125]	381	$sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
	382	" where cidr='$cidr'");
	383	$sth->execute;
[159]	384	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	385	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	386	$sth->execute;
	387	} else {
	388	# common stuff for end-use, dialup, dynDSL, pools, etc, etc.
	389
[192]	390	# special case - block is a container/"reserve" block
	391	if ($type =~ /^(.)c$/) {
	392	$sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
	393	$sth->execute;
	394	} else {
	395	# "normal" case
	396	$sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
	397	$sth->execute;
	398	}
[159]	399	$sth = $dbh->prepare("insert into allocations".
[286]	400	" (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
[159]	401	" values ('$cidr','$custid','$type','$city','$desc','$notes',".
[286]	402	$cidr->masklen.",'$circid','$privdata')");
[125]	403	$sth->execute;
	404
	405	# And initialize the pool, if necessary
[159]	406	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	407	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	408	if ($type =~ /^.p$/) {
[159]	409	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	410	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	411	die $rmsg if $code eq 'FAIL';
	412	} elsif ($type =~ /^.d$/) {
	413	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	414	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	415	die $rmsg if $code eq 'FAIL';
[125]	416	}
	417
	418	} # routing vs non-routing netblock
	419
[394]	420	# node hack
	421	if ($nodeid && $nodeid ne '') {
	422	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	423	$sth->execute("$cidr",$nodeid);
	424	}
	425	# end node hack
[125]	426	$dbh->commit;
	427	}; # end of eval
	428	if ($@) {
[159]	429	$msg .= ": ".$@;
[125]	430	eval { $dbh->rollback; };
[159]	431	return ('FAIL',$msg);
[125]	432	} else {
	433	return ('OK',"OK");
	434	}
	435
	436	} else { # cidr != alloc_from
	437
	438	# Hard case. Allocation is smaller than free block.
	439	my $wantmaskbits = $cidr->masklen;
	440	my $maskbits = $alloc_from->masklen;
	441
	442	my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
	443
	444	# This determines which blocks will be left "free" after allocation. We take the
	445	# block we're allocating from, and split it in half. We see which half the wanted
	446	# block is in, and repeat until the wanted block is equal to one of the halves.
	447	my $i=0;
	448	my $tmp_from = $alloc_from; # So we don't munge $alloc_from
	449	while ($maskbits++ < $wantmaskbits) {
	450	my @subblocks = $tmp_from->split($maskbits);
	451	$newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
	452	$tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
	453	} # while
	454
	455	# Begin SQL transaction block
	456	eval {
	457	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
	458
	459	# Delete old freeblocks entry
	460	$sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
	461	$sth->execute();
	462
	463	# now we have to do some magic for routing blocks
[192]	464	if ($type eq 'rm') {
[125]	465
	466	# Insert the new freeblocks entries
	467	# Note that non-routed blocks are assigned to <NULL>
[159]	468	# and use the default value for the routed column ('n')
	469	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
	470	" values (?, ?, '<NULL>')");
[125]	471	foreach my $block (@newfreeblocks) {
	472	$sth->execute("$block", $block->masklen);
	473	}
	474
	475	# Insert the entry in the routed table
[159]	476	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	477	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	478	$sth->execute;
	479	# Insert the (almost) same entry in the freeblocks table
[159]	480	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	481	" values ('$cidr',".$cidr->masklen.",'$city','y')");
[125]	482	$sth->execute;
	483
[192]	484	} else { # done with alloctype == rm
[125]	485
	486	# Insert the new freeblocks entries
[336]	487	# Along with some more HairyPerl(TM):
	488	# if $alloc_type_from is p
	489	# OR
	490	# $type matches /^(.)r$/
	491	# inserted value for routed column should match.
	492	# This solves the case of inserting an arbitrary block into a
	493	# "Reserve-for-routed-DSL" block. Which you really shouldn't
	494	# do in the first place, but anyway...
[159]	495	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
[192]	496	" values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
[336]	497	( ( ($alloc_from_type =~ /^(p)$/) \|\| ($type =~ /^(.)r$/) ) ? "$1" : 'y')."')");
[125]	498	foreach my $block (@newfreeblocks) {
	499	$sth->execute("$block", $block->masklen);
	500	}
[192]	501	# Special-case for reserve/"container" blocks - generate
	502	# the "extra" freeblocks entry for the container
	503	if ($type =~ /^(.)c$/) {
	504	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	505	" values ('$cidr',".$cidr->masklen.",'$city','$1')");
	506	$sth->execute;
	507	}
[125]	508	# Insert the allocations entry
[159]	509	$sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
[286]	510	"description,notes,maskbits,circuitid,privdata)".
[159]	511	" values ('$cidr','$custid','$type','$city','$desc','$notes',".
[286]	512	$cidr->masklen.",'$circid','$privdata')");
[125]	513	$sth->execute;
	514
	515	# And initialize the pool, if necessary
[159]	516	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	517	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	518	if ($type =~ /^.p$/) {
	519	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
[159]	520	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	521	die $rmsg if $code eq 'FAIL';
	522	} elsif ($type =~ /^.d$/) {
	523	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	524	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	525	die $rmsg if $code eq 'FAIL';
[125]	526	}
	527
[192]	528	} # done with netblock alloctype != rm
[125]	529
[394]	530	# node hack
	531	if ($nodeid && $nodeid ne '') {
	532	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	533	$sth->execute("$cidr",$nodeid);
	534	}
	535	# end node hack
[125]	536	$dbh->commit;
	537	}; # end eval
	538	if ($@) {
[250]	539	$msg .= ": ".$@;
[125]	540	eval { $dbh->rollback; };
	541	return ('FAIL',$msg);
	542	} else {
	543	return ('OK',"OK");
	544	}
	545
	546	} # end fullcidr != alloc_from
	547
	548	} # end static-IP vs netblock allocation
	549
	550	} # end allocateBlock()
	551
	552
	553	## IPDB::initPool()
	554	# Initializes a pool
	555	# Requires a database handle, the pool CIDR, type, city, and a parameter
	556	# indicating whether the pool should allow allocation of literally every
	557	# IP, or if it should reserve network/gateway/broadcast IPs
	558	# Note that this is NOT done in a transaction, that's why it's a private
	559	# function and should ONLY EVER get called from allocateBlock()
	560	sub initPool {
	561	my ($dbh,undef,$type,$city,$class) = @_;
	562	my $pool = new NetAddr::IP $_[1];
	563
[159]	564	##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
	565	$type =~ s/[pd]$/i/;
[125]	566	my $sth;
[159]	567	my $msg;
[125]	568
[159]	569	# Trap errors so we can pass them back to the caller. Even if the
	570	# caller is only ever supposed to be local, and therefore already
	571	# trapping errors. >:(
	572	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	573	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	574
	575	eval {
	576	# have to insert all pool IPs into poolips table as "unallocated".
	577	$sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
[445]	578	" values ('$pool', ?, '$defcustid', '$city', '$type')");
[159]	579	my @poolip_list = $pool->hostenum;
	580	if ($class eq 'all') { # (DSL-ish block - all IPs available
[248]	581	if ($pool->addr !~ /\.0$/) { # .0 causes weirdness.
	582	$sth->execute($pool->addr);
	583	}
[159]	584	for (my $i=0; $i<=$#poolip_list; $i++) {
	585	$sth->execute($poolip_list[$i]->addr);
	586	}
	587	$pool--;
[248]	588	if ($pool->addr !~ /\.255$/) { # .255 can cause weirdness.
	589	$sth->execute($pool->addr);
	590	}
[159]	591	} else { # (real netblock)
	592	for (my $i=1; $i<=$#poolip_list; $i++) {
	593	$sth->execute($poolip_list[$i]->addr);
	594	}
[125]	595	}
[159]	596	};
	597	if ($@) {
	598	$msg = "'".$sth->errstr."'";
	599	eval { $dbh->rollback; };
	600	return ('FAIL',$msg);
	601	} else {
	602	return ('OK',"OK");
[125]	603	}
	604	} # end initPool()
	605
	606
	607	## IPDB::deleteBlock()
	608	# Removes an allocation from the database, including deleting IPs
	609	# from poolips and recombining entries in freeblocks if possible
	610	# Also handles "deleting" a static IP allocation, and removal of a master
	611	# Requires a database handle, the block to delete, and the type of block
	612	sub deleteBlock {
	613	my ($dbh,undef,$type) = @_;
	614	my $cidr = new NetAddr::IP $_[1];
	615
	616	my $sth;
	617
[336]	618	# Magic variables used for odd allocation cases.
	619	my $container;
	620	my $con_type;
	621
[125]	622	# To contain the error message, if any.
	623	my $msg = "Unknown error deallocating $type $cidr";
	624	# Enable transactions and exception-on-errors... but only for this sub
	625	local $dbh->{AutoCommit} = 0;
	626	local $dbh->{RaiseError} = 1;
	627
	628	# First case. The "block" is a static IP
	629	# Note that we still need some additional code in the odd case
	630	# of a netblock-aligned contiguous group of static IPs
	631	if ($type =~ /^.i$/) {
	632
	633	eval {
[159]	634	$msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
[445]	635	$sth = $dbh->prepare("update poolips set custid='$defcustid',available='y',".
[354]	636	"city=(select city from allocations where cidr >>= '$cidr'".
	637	" order by masklen(cidr) desc limit 1),".
[125]	638	"description='',notes='',circuitid='' where ip='$cidr'");
	639	$sth->execute;
	640	$dbh->commit;
	641	};
	642	if ($@) {
	643	eval { $dbh->rollback; };
	644	return ('FAIL',$msg);
	645	} else {
	646	return ('OK',"OK");
	647	}
	648
	649	} elsif ($type eq 'mm') { # end alloctype =~ /.i/
	650
	651	$msg = "Unable to delete master block $cidr";
	652	eval {
	653	$sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
	654	$sth->execute;
[365]	655	$sth = $dbh->prepare("delete from freeblocks where cidr <<= '$cidr'");
[125]	656	$sth->execute;
	657	$dbh->commit;
	658	};
	659	if ($@) {
	660	eval { $dbh->rollback; };
	661	return ('FAIL', $msg);
	662	} else {
	663	return ('OK',"OK");
	664	}
	665
	666	} else { # end alloctype master block case
	667
	668	## This is a big block; but it HAS to be done in a chunk. Any removal
	669	## of a netblock allocation may result in a larger chunk of free
	670	## contiguous IP space - which may in turn be combined into a single
	671	## netblock rather than a number of smaller netblocks.
	672
	673	eval {
	674
[192]	675	if ($type eq 'rm') {
[125]	676	$msg = "Unable to remove routing allocation $cidr";
	677	$sth = $dbh->prepare("delete from routed where cidr='$cidr'");
	678	$sth->execute;
	679	# Make sure block getting deleted is properly accounted for.
	680	$sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
	681	" where cidr='$cidr'");
	682	$sth->execute;
	683	# Set up query to start compacting free blocks.
[159]	684	$sth = $dbh->prepare("select cidr from freeblocks where ".
[125]	685	"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
	686
	687	} else { # end alloctype routing case
	688
[336]	689	# Magic. We need to get information about the containing block (if any)
	690	# so as to make sure that the freeblocks we insert get the correct "type".
	691	$sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'");
	692	$sth->execute;
	693	($container, $con_type) = $sth->fetchrow_array;
	694
[192]	695	# Delete all allocations within the block being deleted. This is
	696	# deliberate and correct, and removes the need to special-case
	697	# removal of "container" blocks.
	698	$sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
[125]	699	$sth->execute;
[192]	700
[125]	701	# Special case - delete pool IPs
[159]	702	if ($type =~ /^.[pd]$/) {
[125]	703	# We have to delete the IPs from the pool listing.
	704	$sth = $dbh->prepare("delete from poolips where pool='$cidr'");
	705	$sth->execute;
	706	}
	707
	708	# Set up query for compacting free blocks.
[336]	709	if ($con_type && $con_type eq 'pc') {
	710	# Clean up after "bad" allocations (blocks that are not formally
	711	# contained which have nevertheless been allocated from a container block)
	712	# We want to make certain that the freeblocks are properly "labelled"
[362]	713	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container' order by maskbits desc");
[336]	714	} else {
	715	# Standard deallocation.
	716	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
[125]	717	"(select cidr from routed where cidr >>= '$cidr') ".
[192]	718	" and maskbits<=".$cidr->masklen.
[304]	719	" and routed='".(($type =~ /^(.)r$/) ? "$1" : 'y').
[192]	720	"' order by maskbits desc");
[336]	721	}
[125]	722
	723	} # end alloctype general case
	724
[445]	725	## Deallocate legacy blocks stashed in the middle of a static IP pool
	726	## This may be expandable to an even more general case of contained netblock, or other pool types.
[126]	727
[445]	728	# Find out if the block we're deallocating is within a DSL pool
	729	my $sth2 = $dbh->prepare("SELECT cidr,city,type FROM allocations WHERE type LIKE '_p' AND cidr >>= ?");
	730	$sth2->execute("$cidr");
	731	my ($pool,$poolcity,$pooltype) = $sth2->fetchrow_array;
[126]	732
[445]	733	if ($pool \|\| $sth2->rows) {
	734	# We've already deleted the block, now we have to stuff its IPs into the pool.
	735	$pooltype =~ s/p$/i/; # change type to static IP
	736	$sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) values ".
	737	"('$pool',?,'$poolcity','$pooltype','$defcustid')");
	738	##fixme: need to not insert net, gateway, and bcast on "real netblock" pools (DHCPish)
	739	# don't insert .0
	740	$sth2->execute($cidr->addr) unless $cidr->addr =~ m\|\.0$\|;
	741	foreach my $ip ($cidr->hostenum) {
	742	$sth2->execute("$ip");
	743	}
	744	$cidr--;
	745	# don't insert .255
	746	$sth2->execute($cidr->addr) unless $cidr->addr =~ m\|\.255$\|;
	747	} else { # done returning IPs from a block to a static DSL pool
[125]	748
[445]	749	# Now we look for larger-or-equal-sized free blocks in the same master (routed)
	750	# (super)block. If there aren't any, we can't combine blocks anyway. If there
	751	# are, we check to see if we can combine blocks.
	752	# Execute the statement prepared in the if-else above.
[125]	753
[445]	754	$sth->execute;
	755
[125]	756	# NetAddr::IP->compact() attempts to produce the smallest inclusive block
	757	# from the caller and the passed terms.
	758	# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
	759	# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
	760	# .64-.95, and .96-.128), you will get an array containing a single
	761	# /25 as element 0 (.0-.127). Order is not important; you could have
	762	# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
	763
[445]	764	my (@together, @combinelist);
	765	my $i=0;
	766	while (my @data = $sth->fetchrow_array) {
	767	my $testIP = new NetAddr::IP $data[0];
	768	@together = $testIP->compact($cidr);
	769	my $num = @together;
	770	if ($num == 1) {
	771	$cidr = $together[0];
	772	$combinelist[$i++] = $testIP;
	773	}
[125]	774	}
	775
[445]	776	# Clear old freeblocks entries - if any. They should all be within
	777	# the $cidr determined above.
	778	$sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
	779	$sth->execute;
[125]	780
[445]	781	# insert "new" freeblocks entry
	782	if ($type eq 'rm') {
	783	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
[159]	784	" values ('$cidr',".$cidr->masklen.",'<NULL>')");
[445]	785	} else {
	786	# Magic hackery to insert "correct" data for deallocation of
	787	# non-contained blocks allocated from within a container.
	788	$type = 'pr' if $con_type && $con_type eq 'pc';
[336]	789
[445]	790	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
[159]	791	" values ('$cidr',".$cidr->masklen.
[192]	792	",(select city from routed where cidr >>= '$cidr'),'".
	793	(($type =~ /^(.)r$/) ? "$1" : 'y')."')");
[445]	794	}
	795	$sth->execute;
[125]	796
[445]	797	} # done returning IPs to the appropriate place
[126]	798
[125]	799	# If we got here, we've succeeded. Whew!
	800	$dbh->commit;
	801	}; # end eval
	802	if ($@) {
[445]	803	$msg = $@;
[125]	804	eval { $dbh->rollback; };
	805	return ('FAIL', $msg);
	806	} else {
	807	return ('OK',"OK");
	808	}
	809
	810	} # end alloctype != netblock
	811
	812	} # end deleteBlock()
	813
	814
[356]	815	## IPDB::getBlockData()
	816	# Return custid, type, city, and description for a block
	817	sub getBlockData {
	818	my $dbh = shift;
	819	my $block = shift;
	820
	821	my $sth = $dbh->prepare("select cidr,custid,type,city,description from searchme".
	822	" where cidr='$block'");
	823	$sth->execute();
	824	return $sth->fetchrow_array();
	825	} # end getBlockData()
	826
	827
[125]	828	## IPDB::mailNotify()
[71]	829	# Sends notification mail to recipients regarding an IPDB operation
[445]	830	sub mailNotify {
	831	my $dbh = shift;
	832	my ($action,$subj,$message) = @_;
[71]	833
[445]	834	##fixme: need to redesign the breakdown/processing for $action for proper handling of all cases
	835
	836	# split action into parts for fiddlement. nb: there are almost certainly better ways to do this.
	837	my @actionbits = split //, $action;
	838
	839	# want to notify anyone who has specifically requested notify on this type ($action as passed),
	840	# on "all static IP types" or "all pool types" (and other last-char-in-type groupings), on eg "all DSL types",
	841	# and "all events with this action"
	842	my @actionsets = ($action);
	843	##fixme: ick, eww. really gotta find a better way to handle this...
	844	push @actionsets, ($actionbits[0].'.'.$actionbits[2],
	845	$actionbits[0].$actionbits[1].'.', $actionbits[0].'a') if $action =~ /^.{3}$/;
	846
	847	my $mailer = Net::SMTP->new($smtphost, Hello => "ipdb.$domain");
	848
	849	# get recip list from db
	850	my $sth = $dbh->prepare("SELECT reciplist FROM notify WHERE action=?");
	851
	852	my %reciplist;
	853	foreach (@actionsets) {
	854	$sth->execute($_);
	855	##fixme - need to handle db errors
	856	my ($recipsub) = $sth->fetchrow_array;
	857	next if !$recipsub;
	858	foreach (split(/,/, $recipsub)) {
	859	$reciplist{$_}++;
	860	}
	861	}
	862
	863	return if !%reciplist;
	864
	865	foreach my $recip (keys %reciplist) {
	866	$mailer->mail("ipdb\@$domain");
	867	$mailer->to($recip);
	868	$mailer->data("From: \"$org_name IP Database\" <ipdb\@$domain>\n",
[131]	869	"To: $recip\n",
[71]	870	"Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
	871	"Subject: {IPDB} $subj\n",
	872	"X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
[445]	873	"Organization: $org_name\n",
[71]	874	"\n$message\n");
[445]	875	}
[71]	876	$mailer->quit;
	877	}
	878
[4]	879	# Indicates module loaded OK. Required by Perl.
	880	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: