Context Navigation

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

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

/trunk

checkpoint, email notice management. See #21.
Completed: display list, edit reciplist

Property svn:keywords set to Date Rev Author

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

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

Download in other formats: