Context Navigation

source: trunk/cgi-bin/IPDB.pm@ 520

Last change on this file since 520 was 519, checked in by Kris Deugau, 12 years ago

/trunk

Move SQL for node search page into IPDB.pm. See #34.
Also tweak some handling for the lingering global statement handle
variable, since it may be undefined instead of a statement handle.

Property svn:keywords set to Date Rev Author

File size: 30.0 KB

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

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

Download in other formats: