Context Navigation

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

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

/trunk

Clean up and move SQL for showmaster to IPDB.pm. See #34.
Tweak template to use odd for row colors

Property svn:keywords set to Date Rev Author

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

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

Download in other formats: