Context Navigation

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

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

/branches/stable

Introduce informational VRF tags on allocations to match uncomitted patch
in production.
Also add a minor main.cgi error-log-cleanup hack around deleting routed
blocks and master blocks instead of bending getBlockData() out of shape
only to have to put it back when the database structure changes get merged.

Property svn:keywords set to Date Rev Author

File size: 46.5 KB

Rev	Line
[8]	1	# ipdb/cgi-bin/IPDB.pm
[71]	2	# Contains functions for IPDB - database access, subnet mangling, block allocation, etc
[8]	3	###
	4	# SVN revision info
	5	# $Date: 2013-05-16 20:43:45 +0000 (Thu, 16 May 2013) $
	6	# SVN revision $Rev: 598 $
	7	# Last update by $Author: kdeugau $
	8	###
[445]	9	# Copyright (C) 2004-2010 - Kris Deugau
[8]	10
[4]	11	package IPDB;
	12
	13	use strict;
	14	use warnings;
	15	use Exporter;
[125]	16	use DBI;
[71]	17	use Net::SMTP;
[365]	18	use NetAddr::IP qw( Compact );
[71]	19	use POSIX;
[4]	20	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	21
[445]	22	$VERSION = 2; ##VERSION##
[4]	23	@ISA = qw(Exporter);
[125]	24	@EXPORT_OK = qw(
[594]	25	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
	26	%IPDBacl %aclmsg
	27	&initIPDBGlobals &connectDB &finish &checkDBSanity
	28	&addMaster &touchMaster
	29	&listSummary &listMaster &listRBlock &listFree &listPool
	30	&getMasterList &getTypeList &getPoolSelect &findAllocateFrom
	31	&ipParent &subParent &blockParent &getRoutedCity
	32	&allocateBlock &updateBlock &deleteBlock &getBlockData
	33	&getNodeList &getNodeName &getNodeInfo
	34	&mailNotify
[125]	35	);
[4]	36
	37	@EXPORT = (); # Export nothing by default.
[125]	38	%EXPORT_TAGS = ( ALL => [qw(
[168]	39	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
[594]	40	%IPDBacl %aclmsg
	41	&initIPDBGlobals &connectDB &finish &checkDBSanity
	42	&addMaster &touchMaster
	43	&listSummary &listMaster &listRBlock &listFree &listPool
	44	&getMasterList &getTypeList &getPoolSelect &findAllocateFrom
	45	&ipParent &subParent &blockParent &getRoutedCity
	46	&allocateBlock &updateBlock &deleteBlock &getBlockData
	47	&getNodeList &getNodeName &getNodeInfo
	48	&mailNotify
[125]	49	)]
	50	);
[4]	51
[125]	52	##
	53	## Global variables
	54	##
	55	our %disp_alloctypes;
	56	our %list_alloctypes;
[168]	57	our %def_custids;
[125]	58	our @citylist;
	59	our @poplist;
[242]	60	our %IPDBacl;
[71]	61
[593]	62	# mapping table for functional-area => error message
	63	our %aclmsg = (
	64	addmaster => 'add a master block',
	65	addblock => 'add an allocation',
	66	updateblock => 'update a block',
	67	delblock => 'delete an allocation',
	68	);
	69
[445]	70	our $org_name = 'Example Corp';
	71	our $smtphost = 'smtp.example.com';
	72	our $domain = 'example.com';
	73	our $defcustid = '5554242';
	74	# mostly for rwhois
	75	##fixme: leave these blank by default?
	76	our $rwhoisDataPath = '/usr/local/rwhoisd/etc/rwhoisd'; # to match ./configure defaults from rwhoisd-1.5.9.6
	77	our $org_street = '123 4th Street';
	78	our $org_city = 'Anytown';
	79	our $org_prov_state = 'ON';
	80	our $org_pocode = 'H0H 0H0';
	81	our $org_country = 'CA';
	82	our $org_phone = '000-555-1234';
	83	our $org_techhandle = 'ISP-ARIN-HANDLE';
	84	our $org_email = 'noc@example.com';
	85	our $hostmaster = 'dns@example.com';
	86
	87	our $syslog_facility = 'local2';
	88
[508]	89	# Allow allocations to come from private IP ranges by default?
	90	# Set to 'y' or 'on' to enable.
	91	our $allowprivrange = '';
	92
[125]	93	# Let's initialize the globals.
	94	## IPDB::initIPDBGlobals()
	95	# Initialize all globals. Takes a database handle, returns a success or error code
	96	sub initIPDBGlobals {
	97	my $dbh = $_[0];
	98	my $sth;
	99
	100	# Initialize alloctypes hashes
[168]	101	$sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
[125]	102	$sth->execute;
	103	while (my @data = $sth->fetchrow_array) {
	104	$disp_alloctypes{$data[0]} = $data[2];
[168]	105	$def_custids{$data[0]} = $data[4];
[125]	106	if ($data[3] < 900) {
	107	$list_alloctypes{$data[0]} = $data[1];
	108	}
	109	}
	110
	111	# City and POP listings
[159]	112	$sth = $dbh->prepare("select city,routing from cities order by city");
[125]	113	$sth->execute;
	114	return (undef,$sth->errstr) if $sth->err;
	115	while (my @data = $sth->fetchrow_array) {
	116	push @citylist, $data[0];
	117	if ($data[1] eq 'y') {
	118	push @poplist, $data[0];
	119	}
	120	}
	121
[242]	122	# Load ACL data. Specific username checks are done at a different level.
	123	$sth = $dbh->prepare("select username,acl from users");
	124	$sth->execute;
[125]	125	return (undef,$sth->errstr) if $sth->err;
[242]	126	while (my @data = $sth->fetchrow_array) {
	127	$IPDBacl{$data[0]} = $data[1];
	128	}
[125]	129
[593]	130	##fixme: initialize HTML::Template env var for template path
	131	# something like $self->path().'/templates' ?
	132	# $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar';
	133
[125]	134	return (1,"OK");
	135	} # end initIPDBGlobals
	136
	137
	138	## IPDB::connectDB()
[4]	139	# Creates connection to IPDB.
[125]	140	# Requires the database name, username, and password.
[4]	141	# Returns a handle to the db.
[125]	142	# Set up for a PostgreSQL db; could be any transactional DBMS with the
	143	# right changes.
[4]	144	sub connectDB {
[445]	145	my $dbname = shift;
	146	my $user = shift;
	147	my $pass = shift;
	148	my $dbhost = shift;
	149
[4]	150	my $dbh;
[445]	151	my $DSN = "DBI:Pg:".($dbhost ? "host=$dbhost;" : '')."dbname=$dbname";
[4]	152
	153	# Note that we want to autocommit by default, and we will turn it off locally as necessary.
[125]	154	# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
	155	$dbh = DBI->connect($DSN, $user, $pass, {
	156	AutoCommit => 1,
	157	PrintError => 0
	158	})
	159	or return (undef, $DBI::errstr) if(!$dbh);
[4]	160
[125]	161	# Return here if we can't select. Note that this indicates a
	162	# problem executing the select.
[185]	163	my $sth = $dbh->prepare("select type from alloctypes");
[125]	164	$sth->execute();
	165	return (undef,$DBI::errstr) if ($sth->err);
	166
	167	# See if the select returned anything (or null data). This should
	168	# succeed if the select executed, but...
	169	$sth->fetchrow();
	170	return (undef,$DBI::errstr) if ($sth->err);
	171
	172	# If we get here, we should be OK.
	173	return ($dbh,"DB connection OK");
[4]	174	} # end connectDB
	175
[125]	176
	177	## IPDB::finish()
	178	# Cleans up after database handles and so on.
	179	# Requires a database handle
	180	sub finish {
	181	my $dbh = $_[0];
[593]	182	$dbh->disconnect if $dbh;
[125]	183	} # end finish
	184
	185
	186	## IPDB::checkDBSanity()
[4]	187	# Quick check to see if the db is responding. A full integrity
	188	# check will have to be a separate tool to walk the IP allocation trees.
	189	sub checkDBSanity {
[125]	190	my ($dbh) = $_[0];
[4]	191
	192	if (!$dbh) {
[125]	193	print "No database handle, or connection has been closed.";
	194	return -1;
[4]	195	} else {
	196	# it connects, try a stmt.
[185]	197	my $sth = $dbh->prepare("select type from alloctypes");
[4]	198	my $err = $sth->execute();
	199
	200	if ($sth->fetchrow()) {
	201	# all is well.
	202	return 1;
	203	} else {
[16]	204	print "Connected to the database, but could not execute test statement. ".$sth->errstr();
[125]	205	return -1;
[4]	206	}
	207	}
	208	# Clean up after ourselves.
[125]	209	# $dbh->disconnect;
[4]	210	} # end checkDBSanity
	211
[71]	212
[365]	213	## IPDB::addMaster()
	214	# Does all the magic necessary to sucessfully add a master block
	215	# Requires database handle, block to add
	216	# Returns failure code and error message or success code and "message"
	217	sub addMaster {
	218	my $dbh = shift;
	219	my $cidr = new NetAddr::IP shift;
	220
	221	# Allow transactions, and raise an exception on errors so we can catch it later.
	222	# Use local to make sure these get "reset" properly on exiting this block
	223	local $dbh->{AutoCommit} = 0;
	224	local $dbh->{RaiseError} = 1;
	225
	226	# Wrap all the SQL in a transaction
	227	eval {
[594]	228	my ($mexist) = $dbh->selectrow_array("SELECT cidr FROM masterblocks WHERE cidr <<= ?", undef, ($cidr) );
[365]	229
[594]	230	if (!$mexist) {
[365]	231	# First case - master is brand-spanking-new.
	232	##fixme: rwhois should be globally-flagable somewhere, much like a number of other things
	233	## maybe a db table called "config"?
[594]	234	$dbh->do("INSERT INTO masterblocks (cidr,rwhois) VALUES (?,?)", undef, ($cidr,'y') );
[365]	235
	236	# Unrouted blocks aren't associated with a city (yet). We don't rely on this
	237	# elsewhere though; legacy data may have traps and pitfalls in it to break this.
	238	# Thus the "routed" flag.
[594]	239	$dbh->do("INSERT INTO freeblocks (cidr,maskbits,city,routed) VALUES (?,?,?,?)", undef,
	240	($cidr, $cidr->masklen, '<NULL>', 'n') );
[365]	241
	242	# If we get here, everything is happy. Commit changes.
	243	$dbh->commit;
	244
[594]	245	} # done new master does not contain existing master(s)
[365]	246	else {
	247
	248	# collect the master(s) we're going to absorb, and snag the longest netmask while we're at it.
	249	my $smallmask = $cidr->masklen;
[594]	250	my $sth = $dbh->prepare("SELECT cidr FROM masterblocks WHERE cidr <<= ?");
	251	$sth->execute($cidr);
[365]	252	my @cmasters;
	253	while (my @data = $sth->fetchrow_array) {
	254	my $master = new NetAddr::IP $data[0];
	255	push @cmasters, $master;
	256	$smallmask = $master->masklen if $master->masklen > $smallmask;
	257	}
	258
	259	# split the new master, and keep only those blocks not part of an existing master
	260	my @blocklist;
	261	foreach my $seg ($cidr->split($smallmask)) {
	262	my $contained = 0;
	263	foreach my $master (@cmasters) {
	264	$contained = 1 if $master->contains($seg);
	265	}
	266	push @blocklist, $seg if !$contained;
	267	}
	268
	269	# collect the unrouted free blocks within the new master
[594]	270	$sth = $dbh->prepare("SELECT cidr FROM freeblocks WHERE maskbits <= ? AND cidr <<= ? AND routed = 'n'");
	271	$sth->execute($smallmask, $cidr);
[365]	272	while (my @data = $sth->fetchrow_array) {
	273	my $freeblock = new NetAddr::IP $data[0];
	274	push @blocklist, $freeblock;
	275	}
	276
	277	# combine the set of free blocks we should have now.
	278	@blocklist = Compact(@blocklist);
	279
	280	# and now insert the new data. Make sure to delete old masters too.
	281
	282	# freeblocks
[594]	283	$sth = $dbh->prepare("DELETE FROM freeblocks WHERE cidr <<= ?");
	284	my $sth2 = $dbh->prepare("INSERT INTO freeblocks (cidr,maskbits,city,routed) VALUES (?,?,'<NULL>','n')");
[365]	285	foreach my $newblock (@blocklist) {
[594]	286	$sth->execute($newblock);
	287	$sth2->execute($newblock, $newblock->masklen);
[365]	288	}
	289
	290	# master
[594]	291	$dbh->do("DELETE FROM masterblocks WHERE cidr <<= ?", undef, ($cidr) );
	292	$dbh->do("INSERT INTO masterblocks (cidr,rwhois) VALUES (?,?)", undef, ($cidr, 'y') );
[365]	293
	294	# whew If we got here, we likely suceeded.
	295	$dbh->commit;
	296	} # new master contained existing master(s)
	297	}; # end eval
	298
	299	if ($@) {
	300	my $msg = $@;
	301	eval { $dbh->rollback; };
	302	return ('FAIL',$msg);
	303	} else {
	304	return ('OK','OK');
	305	}
	306	} # end addMaster
	307
	308
[594]	309	## IPDB::touchMaster()
	310	# Update last-changed timestamp on a master block.
	311	sub touchMaster {
	312	my $dbh = shift;
	313	my $master = shift;
	314
	315	local $dbh->{AutoCommit} = 0;
	316	local $dbh->{RaiseError} = 1;
	317
	318	eval {
	319	$dbh->do("UPDATE masterblocks SET mtime=now() WHERE cidr = ?", undef, ($master));
	320	$dbh->commit;
	321	};
	322
	323	if ($@) {
	324	my $msg = $@;
	325	eval { $dbh->rollback; };
	326	return ('FAIL',$msg);
	327	}
	328	return ('OK','OK');
	329	} # end touchMaster()
	330
	331
	332	## IPDB::listSummary()
	333	# Get summary list of all master blocks
	334	# Returns an arrayref to a list of hashrefs containing the master block, routed count,
	335	# allocated count, free count, and largest free block masklength
	336	sub listSummary {
	337	my $dbh = shift;
	338
	339	my $mlist = $dbh->selectall_arrayref("SELECT cidr AS master FROM masterblocks ORDER BY cidr", { Slice => {} });
	340
	341	foreach (@{$mlist}) {
	342	my ($rcnt) = $dbh->selectrow_array("SELECT count(*) FROM routed WHERE cidr <<= ?", undef, ($$_{master}));
	343	$$_{routed} = $rcnt;
	344	my ($acnt) = $dbh->selectrow_array("SELECT count(*) FROM allocations WHERE cidr <<= ?", undef, ($$_{master}));
	345	$$_{allocated} = $acnt;
	346	my ($fcnt) = $dbh->selectrow_array("SELECT count(*) FROM freeblocks WHERE cidr <<= ?".
	347	" AND (routed='y' OR routed='n')", undef, ($$_{master}));
	348	$$_{free} = $fcnt;
	349	my ($bigfree) = $dbh->selectrow_array("SELECT maskbits FROM freeblocks WHERE cidr <<= ?".
	350	" AND (routed='y' OR routed='n') ORDER BY maskbits LIMIT 1", undef, ($$_{master}));
	351	##fixme: should find a way to do this without having to HTMLize the <>
	352	$bigfree = "/$bigfree" if $bigfree;
	353	$bigfree = '<NONE>' if !$bigfree;
	354	$$_{bigfree} = $bigfree;
	355	}
	356	return $mlist;
	357	} # end listSummary()
	358
	359
	360	## IPDB::listMaster()
	361	# Get list of routed blocks in the requested master
	362	# Returns an arrayref to a list of hashrefs containing the routed block, POP/city the block is routed to,
	363	# allocated count, free count, and largest free block masklength
	364	sub listMaster {
	365	my $dbh = shift;
	366	my $master = shift;
	367
	368	my $rlist = $dbh->selectall_arrayref("SELECT cidr AS block,city FROM routed WHERE cidr <<= ? ORDER BY cidr",
	369	{ Slice => {} }, ($master) );
	370
	371	foreach (@{$rlist}) {
	372	my ($acnt) = $dbh->selectrow_array("SELECT count(*) FROM allocations WHERE cidr <<= ?", undef, ($$_{block}));
	373	$$_{nsubs} = $acnt;
	374	my ($fcnt) = $dbh->selectrow_array("SELECT count(*) FROM freeblocks WHERE cidr <<= ?".
	375	" AND (routed='y' OR routed='n')", undef, ($$_{block}));
	376	$$_{nfree} = $fcnt;
	377	my ($bigfree) = $dbh->selectrow_array("SELECT maskbits FROM freeblocks WHERE cidr <<= ?".
	378	" AND (routed='y' OR routed='n') ORDER BY maskbits LIMIT 1", undef, ($$_{block}));
	379	##fixme: should find a way to do this without having to HTMLize the <>
	380	$bigfree = "/$bigfree" if $bigfree;
	381	$bigfree = '<NONE>' if !$bigfree;
	382	$$_{lfree} = $bigfree;
	383	}
	384	return $rlist;
	385	} # end listMaster()
	386
	387
	388	## IPDB::listRBlock()
	389	# Gets a list of free blocks in the requested parent/master in both CIDR and range notation
	390	# Takes a parent/master and an optional flag to look at routed or unrouted blocks, depending
	391	# on whether the master is a direct master or a routed block
	392	# Returns an arrayref to a list of hashrefs containing the CIDR and range-notation blocks
	393	sub listRBlock {
	394	my $dbh = shift;
	395	my $routed = shift;
	396
	397	# Snag the allocations for this block
[598]	398	my $sth = $dbh->prepare("SELECT cidr,city,type,custid,swip,description,vrf".
[594]	399	" FROM allocations WHERE cidr <<= ? ORDER BY cidr");
	400	$sth->execute($routed);
	401
	402	# hack hack hack
	403	# set up to flag swip=y records if they don't actually have supporting data in the customers table
	404	my $custsth = $dbh->prepare("SELECT count(*) FROM customers WHERE custid = ?");
	405
	406	my @blocklist;
[598]	407	while (my ($cidr,$city,$type,$custid,$swip,$desc,$vrf) = $sth->fetchrow_array()) {
	408	$desc .= " - vrf:$vrf" if $desc && $vrf;
	409	$desc = "vrf:$vrf" if !$desc && $vrf;
[594]	410	$custsth->execute($custid);
	411	my ($ncust) = $custsth->fetchrow_array();
	412	my %row = (
	413	block => $cidr,
	414	city => $city,
	415	type => $disp_alloctypes{$type},
	416	custid => $custid,
	417	swip => ($swip eq 'y' ? 'Yes' : 'No'),
	418	partswip => ($swip eq 'y' && $ncust == 0 ? 1 : 0),
	419	desc => $desc
	420	);
	421	$row{subblock} = ($type =~ /^.r$/); # hmf. wonder why these won't work in the hash declaration...
	422	$row{listpool} = ($type =~ /^.[pd]$/);
	423	push (@blocklist, \%row);
	424	}
	425	return \@blocklist;
	426	} # end listRBlock()
	427
	428
	429	## IPDB::listFree()
	430	# Gets a list of free blocks in the requested parent/master in both CIDR and range notation
	431	# Takes a parent/master and an optional "routed or unrouted" flag that defaults to unrouted.
	432	# Returns an arrayref to a list of hashrefs containing the CIDR and range-notation blocks
	433	# Returns some extra flags in the hashrefs for routed blocks, since those can have several subtypes
	434	sub listFree {
	435	my $dbh = shift;
	436	my $master = shift;
	437	my $routed = shift \|\| 'n';
	438
	439	# do it this way so we can waste a little less time iterating
	440	my $sth = $dbh->prepare("SELECT cidr,routed FROM freeblocks WHERE cidr <<= ? AND ".
	441	($routed eq 'n' ? '' : 'NOT')." routed = 'n' ORDER BY cidr");
	442	$sth->execute($master);
	443	my @flist;
	444	while (my ($cidr,$rtype) = $sth->fetchrow_array()) {
	445	$cidr = new NetAddr::IP $cidr;
	446	my %row = (
	447	fblock => "$cidr",
	448	frange => $cidr->range,
	449	);
	450	if ($routed eq 'y') {
	451	$row{subblock} = ($rtype ne 'y' && $rtype ne 'n');
	452	$row{fbtype} = $rtype;
	453	}
	454	push @flist, \%row;
	455	}
	456	return \@flist;
	457	} # end listFree()
	458
	459
	460	## IPDB::listPool()
	461	#
	462	sub listPool {
	463	my $dbh = shift;
	464	my $pool = shift;
	465
[598]	466	my $sth = $dbh->prepare("SELECT ip,custid,available,description,type,vrf".
[594]	467	" FROM poolips WHERE pool = ? ORDER BY ip");
	468	$sth->execute($pool);
	469	my @poolips;
[598]	470	while (my ($ip,$custid,$available,$desc,$type,$vrf) = $sth->fetchrow_array) {
	471	$desc .= " - vrf:$vrf" if $desc && $vrf;
	472	$desc = "vrf:$vrf" if !$desc && $vrf;
[594]	473	my %row = (
	474	ip => $ip,
	475	custid => $custid,
	476	available => $available,
	477	desc => $desc,
	478	delme => $available eq 'n'
	479	);
	480	push @poolips, \%row;
	481	}
	482	return \@poolips;
	483	} # end listPool()
	484
	485
	486	## IPDB::getMasterList()
	487	# Get a list of master blocks, optionally including last-modified timestamps
	488	# Takes an optional flag to indicate whether to include timestamps;
	489	# 'm' includes ctime, all others (suggest 'c') do not.
	490	# Returns an arrayref to a list of hashrefs
	491	sub getMasterList {
	492	my $dbh = shift;
	493	my $stampme = shift \|\| 'm'; # optional but should be set by caller for clarity
	494
	495	my $mlist = $dbh->selectall_arrayref("SELECT cidr AS master".($stampme eq 'm' ? ',mtime' : '').
	496	" FROM masterblocks ORDER BY cidr", { Slice => {} });
	497	return $mlist;
	498	} # end getMasterList()
	499
	500
	501	## IPDB::getTypeList()
	502	# Get an alloctype/description pair list suitable for dropdowns
	503	# Takes a flag to determine which general groups of types are returned
	504	# Returns an reference to an array of hashrefs
	505	sub getTypeList {
	506	my $dbh = shift;
	507	my $tgroup = shift \|\| 'a'; # technically optional, like this, but should
	508	# really be specified in the call for clarity
	509	my $tlist;
[595]	510	if ($tgroup eq 'n') {
	511	# grouping 'n' - all netblock types. These include routed blocks, containers (_c)
	512	# and contained (_r) types, dynamic-allocation ranges (_e), static IP pools (_d and _p),
	513	# and the "miscellaneous" cn, in, and en types.
	514	$tlist = $dbh->selectall_arrayref("SELECT type,listname FROM alloctypes WHERE listorder <= 500 ".
	515	"AND type NOT LIKE '_i' ORDER BY listorder", { Slice => {} });
	516	} elsif ($tgroup eq 'p') {
	517	# grouping 'p' - primary allocation types. As with 'n' above but without the _r contained types.
	518	$tlist = $dbh->selectall_arrayref("SELECT type,listname FROM alloctypes WHERE listorder <= 500 ".
	519	"AND type NOT LIKE '_i' AND type NOT LIKE '_r' ORDER BY listorder", { Slice => {} });
[594]	520	} elsif ($tgroup eq 'c') {
	521	# grouping 'c' - contained types. These include all static IPs and all _r types.
	522	$tlist = $dbh->selectall_arrayref("SELECT type,listname FROM alloctypes WHERE listorder <= 500 ".
[595]	523	" AND (type LIKE '_i' OR type LIKE '_r') ORDER BY listorder", { Slice => {} });
	524	} elsif ($tgroup eq 'i') {
	525	# grouping 'i' - static IP types.
	526	$tlist = $dbh->selectall_arrayref("SELECT type,listname FROM alloctypes WHERE listorder <= 500 ".
	527	" AND type LIKE '_i' ORDER BY listorder", { Slice => {} });
[594]	528	} else {
	529	# grouping 'a' - all standard allocation types. This includes everything
	530	# but mm (present only as a formality). Make this the default.
	531	$tlist = $dbh->selectall_arrayref("SELECT type,listname FROM alloctypes WHERE listorder <= 500 ".
[595]	532	" ORDER BY listorder", { Slice => {} });
[594]	533	}
	534	return $tlist;
	535	}
	536
	537
	538	## IPDB::getPoolSelect()
	539	# Get a list of pools matching the passed city and type that have 1 or more free IPs
	540	# Returns an arrayref to a list of hashrefs
	541	sub getPoolSelect {
	542	my $dbh = shift;
	543	my $iptype = shift;
	544	my $pcity = shift;
	545
	546	my ($ptype) = ($iptype =~ /^(.)i$/);
	547	return if !$ptype;
	548	$ptype .= '_';
	549
	550	my $plist = $dbh->selectall_arrayref(
	551	"SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool) AS poolcit, ".
	552	"poolips.pool AS poolblock, COUNT(*) AS poolfree FROM poolips,allocations ".
	553	"WHERE poolips.available='y' AND poolips.pool=allocations.cidr ".
	554	"AND allocations.city = ? AND poolips.type LIKE ? ".
	555	"GROUP BY pool", { Slice => {} }, ($pcity, $ptype) );
	556	return $plist;
	557	} # end getPoolSelect()
	558
	559
	560	## IPDB::findAllocateFrom()
	561	# Find free block to add a new allocation from. (CIDR block version of pool select above, more or less)
	562	# Takes
	563	# - mask length
	564	# - allocation type
	565	# - POP city "parent"
	566	# - optional master-block restriction
	567	# - optional flag to allow automatic pick-from-private-network-ranges
	568	# Returns a string with the first CIDR block matching the criteria, if any
	569	sub findAllocateFrom {
	570	my $dbh = shift;
	571	my $maskbits = shift;
	572	my $type = shift;
	573	my $city = shift;
	574	my $pop = shift;
	575	my %optargs = @_;
	576
	577	my $failmsg = "No suitable free block found\n";
	578
	579	## Set up the SQL to find out what freeblock we can (probably) use for an allocation.
	580	## Very large systems will require development of a reserve system (possibly an extension
	581	## of the reserve-for-expansion concept in https://secure.deepnet.cx/trac/ipdb/ticket/24?)
	582	## Also populate a value list for the DBI call.
	583
	584	my @vallist = ($maskbits, ($type eq 'rm' ? 'n' : ($type =~ /^(.)r$/ ? "$1" : 'y')) );
	585	my $sql = "SELECT cidr FROM freeblocks WHERE maskbits <= ? AND routed = ?";
	586
	587	# for PPP(oE) and container types, the POP city is the one attached to the pool.
	588	# individual allocations get listed with the customer city site.
	589	##fixme: chain cities to align roughly with a full layer-2 node graph
	590	$city = $pop if $type !~ /^.[pc]$/;
	591	if ($type ne 'rm' && $city) {
	592	$sql .= " AND city = ?";
	593	push @vallist, $city;
	594	}
	595	# Allow specifying an arbitrary full block, instead of a master
	596	if ($optargs{gimme}) {
	597	$sql .= " AND cidr >>= ?";
	598	push @vallist, $optargs{gimme};
	599	}
	600	# if a specific master was requested, allow the requestor to self->shoot(foot)
	601	if ($optargs{master} && $optargs{master} ne '-') {
	602	$sql .= " AND cidr <<= ?" if $optargs{master} ne '-';
	603	push @vallist, $optargs{master};
	604	} else {
	605	# if a specific master was NOT requested, filter out the RFC 1918 private networks
	606	if (!$optargs{allowpriv}) {
	607	$sql .= " AND NOT (cidr <<= '192.168.0.0/16' OR cidr <<= '10.0.0.0/8' OR cidr <<= '172.16.0.0/12')";
	608	}
	609	}
	610	# Sorting and limiting, since we don't (currently) care to provide a selection of
	611	# blocks to carve up. This preserves something resembling optimal usage of the IP
	612	# space by forcing contiguous allocations and free blocks as much as possible.
	613	$sql .= " ORDER BY maskbits DESC,cidr LIMIT 1";
	614
	615	my ($fbfound) = $dbh->selectrow_array($sql, undef, @vallist);
	616	return $fbfound;
	617	} # end findAllocateFrom()
	618
	619
	620	## IPDB::ipParent()
	621	# Get an IP's parent pool's details
	622	# Takes a database handle and IP
	623	# Returns a hashref to the parent pool block, if any
	624	sub ipParent {
	625	my $dbh = shift;
	626	my $block = shift;
	627
	628	my $pinfo = $dbh->selectrow_hashref("SELECT cidr,custid,type,city,description FROM allocations".
	629	" WHERE cidr >>= ?", undef, ($block) );
	630	return $pinfo;
	631	} # end ipParent()
	632
	633
	634	## IPDB::subParent()
	635	# Get a block's parent's details
	636	# Takes a database handle and CIDR block
	637	# Returns a hashref to the parent container block, if any
	638	sub subParent {
	639	my $dbh = shift;
	640	my $block = shift;
	641
	642	my $pinfo = $dbh->selectrow_hashref("SELECT cidr,custid,type,city,description FROM allocations".
	643	" WHERE cidr >>= ?", undef, ($block) );
	644	return $pinfo;
	645	} # end subParent()
	646
	647
	648	## IPDB::blockParent()
	649	# Get a block's parent's details
	650	# Takes a database handle and CIDR block
	651	# Returns a hashref to the parent container block, if any
	652	sub blockParent {
	653	my $dbh = shift;
	654	my $block = shift;
	655
	656	my $pinfo = $dbh->selectrow_hashref("SELECT cidr,city FROM routed".
	657	" WHERE cidr >>= ?", undef, ($block) );
	658	return $pinfo;
	659	} # end blockParent()
	660
	661
	662	## IPDB::getRoutedCity()
	663	# Get the city for a routed block.
	664	sub getRoutedCity {
	665	my $dbh = shift;
	666	my $block = shift;
	667
	668	my ($rcity) = $dbh->selectrow_array("SELECT city FROM routed WHERE cidr = ?", undef, ($block) );
	669	return $rcity;
	670	} # end getRoutedCity()
	671
	672
[125]	673	## IPDB::allocateBlock()
[71]	674	# Does all of the magic of actually allocating a netblock
[125]	675	# Requires database handle, block to allocate, custid, type, city,
[286]	676	# description, notes, circuit ID, block to allocate from, private data
[125]	677	# Returns a success code and optional error message.
	678	sub allocateBlock {
[598]	679	my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata,$nodeid,$vrf) = @_;
[508]	680	$privdata = '' if !defined($privdata);
[598]	681	$vrf = '' if !defined($vrf);
[286]	682
[125]	683	my $cidr = new NetAddr::IP $_[1];
	684	my $alloc_from = new NetAddr::IP $_[2];
	685	my $sth;
[71]	686
[592]	687	$desc = '' if !$desc;
	688	$notes = '' if !$notes;
	689	$circid = '' if !$circid;
	690	$privdata = '' if !$privdata;
	691
[336]	692	# Snag the "type" of the freeblock (alloc_from) "just in case"
	693	$sth = $dbh->prepare("select routed from freeblocks where cidr='$alloc_from'");
	694	$sth->execute;
	695	my ($alloc_from_type) = $sth->fetchrow_array;
	696
[125]	697	# To contain the error message, if any.
	698	my $msg = "Unknown error allocating $cidr as '$type'";
[71]	699
[125]	700	# Enable transactions and error handling
	701	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	702	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	703
[159]	704	if ($type =~ /^.i$/) {
[125]	705	$msg = "Unable to assign static IP $cidr to $custid";
	706	eval {
[159]	707	# We have to do this in two parts because otherwise we lose
	708	# the ability to return the IP assigned. Should that change,
	709	# the commented SQL statement below may become usable.
[125]	710	# update poolips set custid='$custid',city='$city',available='n',
	711	# description='$desc',notes='$notes',circuitid='$circid'
	712	# where ip=(select ip from poolips where pool='$alloc_from'
	713	# and available='y' order by ip limit 1);
[159]	714
[594]	715	if ($cidr) {
	716	my ($isavail) = $dbh->selectrow_array("SELECT available FROM poolips WHERE ip=?", undef, ($cidr) );
	717	if ($isavail eq 'n') {
	718	die "IP already allocated. Deallocate and reallocate, or update the entry\n";
	719	}
	720	if (!$isavail) {
	721	die "IP is not in an IP pool.\n";
	722	}
	723	} else {
	724	($cidr) = $dbh->selectrow_array("SELECT ip FROM poolips WHERE pool=? AND available='y' ORDER BY ip",
	725	undef, ($alloc_from) );
[550]	726	}
[598]	727	$dbh->do("UPDATE poolips SET custid=?,city=?,available='n',description=?,".
	728	"notes=?,circuitid=?,privdata=?,vrf=? ".
	729	"WHERE ip=?", undef, ($custid, $city, $desc, $notes, $circid, $privdata, $vrf, $cidr) );
[125]	730
[394]	731	# node hack
	732	if ($nodeid && $nodeid ne '') {
	733	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	734	$sth->execute("$cidr",$nodeid);
	735	}
	736	# end node hack
[594]	737
[125]	738	$dbh->commit;
	739	};
	740	if ($@) {
[594]	741	$msg .= ": $@";
[125]	742	eval { $dbh->rollback; };
	743	return ('FAIL',$msg);
	744	} else {
	745	return ('OK',"$cidr");
	746	}
	747
	748	} else { # end IP-from-pool allocation
	749
[549]	750	my $errcode = 'OK';
[125]	751	if ($cidr == $alloc_from) {
	752	# Easiest case- insert in one table, delete in the other, and go home. More or less.
	753	# insert into allocations values (cidr,custid,type,city,desc) and
	754	# delete from freeblocks where cidr='cidr'
	755	# For data safety on non-transaction DBs, we delete first.
	756
	757	eval {
	758	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
[192]	759	if ($type eq 'rm') {
[125]	760	$sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
	761	" where cidr='$cidr'");
	762	$sth->execute;
[159]	763	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	764	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	765	$sth->execute;
	766	} else {
	767	# common stuff for end-use, dialup, dynDSL, pools, etc, etc.
	768
[192]	769	# special case - block is a container/"reserve" block
	770	if ($type =~ /^(.)c$/) {
	771	$sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
	772	$sth->execute;
	773	} else {
	774	# "normal" case
	775	$sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
	776	$sth->execute;
	777	}
[159]	778	$sth = $dbh->prepare("insert into allocations".
[598]	779	" (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata,vrf)".
	780	" values (?,?,?,?,?,?,?,?,?,?)");
	781	$sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata, $vrf);
[125]	782
	783	# And initialize the pool, if necessary
[159]	784	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	785	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	786	if ($type =~ /^.p$/) {
[159]	787	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	788	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	789	die $rmsg if $code eq 'FAIL';
[549]	790	$msg = $rmsg;
	791	$errcode = $code;
[159]	792	} elsif ($type =~ /^.d$/) {
	793	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	794	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	795	die $rmsg if $code eq 'FAIL';
[549]	796	$msg = $rmsg;
	797	$errcode = $code;
[125]	798	}
	799
	800	} # routing vs non-routing netblock
	801
[394]	802	# node hack
	803	if ($nodeid && $nodeid ne '') {
	804	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	805	$sth->execute("$cidr",$nodeid);
	806	}
	807	# end node hack
[125]	808	$dbh->commit;
	809	}; # end of eval
	810	if ($@) {
[159]	811	$msg .= ": ".$@;
[125]	812	eval { $dbh->rollback; };
[159]	813	return ('FAIL',$msg);
[125]	814	} else {
[549]	815	return ($errcode,($type =~ /^.[pd]$/ ? $msg : "OK"));
[125]	816	}
	817
	818	} else { # cidr != alloc_from
	819
	820	# Hard case. Allocation is smaller than free block.
	821	my $wantmaskbits = $cidr->masklen;
	822	my $maskbits = $alloc_from->masklen;
	823
	824	my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
	825
	826	# This determines which blocks will be left "free" after allocation. We take the
	827	# block we're allocating from, and split it in half. We see which half the wanted
	828	# block is in, and repeat until the wanted block is equal to one of the halves.
	829	my $i=0;
	830	my $tmp_from = $alloc_from; # So we don't munge $alloc_from
	831	while ($maskbits++ < $wantmaskbits) {
	832	my @subblocks = $tmp_from->split($maskbits);
	833	$newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
	834	$tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
	835	} # while
	836
	837	# Begin SQL transaction block
	838	eval {
	839	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
	840
	841	# Delete old freeblocks entry
	842	$sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
	843	$sth->execute();
	844
	845	# now we have to do some magic for routing blocks
[192]	846	if ($type eq 'rm') {
[125]	847
	848	# Insert the new freeblocks entries
	849	# Note that non-routed blocks are assigned to <NULL>
[159]	850	# and use the default value for the routed column ('n')
	851	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
	852	" values (?, ?, '<NULL>')");
[125]	853	foreach my $block (@newfreeblocks) {
	854	$sth->execute("$block", $block->masklen);
	855	}
	856
	857	# Insert the entry in the routed table
[159]	858	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	859	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	860	$sth->execute;
	861	# Insert the (almost) same entry in the freeblocks table
[159]	862	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	863	" values ('$cidr',".$cidr->masklen.",'$city','y')");
[125]	864	$sth->execute;
	865
[192]	866	} else { # done with alloctype == rm
[125]	867
	868	# Insert the new freeblocks entries
[336]	869	# Along with some more HairyPerl(TM):
	870	# if $alloc_type_from is p
	871	# OR
	872	# $type matches /^(.)r$/
	873	# inserted value for routed column should match.
	874	# This solves the case of inserting an arbitrary block into a
	875	# "Reserve-for-routed-DSL" block. Which you really shouldn't
	876	# do in the first place, but anyway...
[159]	877	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
[192]	878	" values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
[336]	879	( ( ($alloc_from_type =~ /^(p)$/) \|\| ($type =~ /^(.)r$/) ) ? "$1" : 'y')."')");
[125]	880	foreach my $block (@newfreeblocks) {
	881	$sth->execute("$block", $block->masklen);
	882	}
[192]	883	# Special-case for reserve/"container" blocks - generate
	884	# the "extra" freeblocks entry for the container
	885	if ($type =~ /^(.)c$/) {
	886	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	887	" values ('$cidr',".$cidr->masklen.",'$city','$1')");
	888	$sth->execute;
	889	}
[125]	890	# Insert the allocations entry
[159]	891	$sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
[598]	892	"description,notes,maskbits,circuitid,privdata,vrf)".
	893	" values (?,?,?,?,?,?,?,?,?,?)");
	894	$sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata, $vrf);
[125]	895
	896	# And initialize the pool, if necessary
[159]	897	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	898	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	899	if ($type =~ /^.p$/) {
	900	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
[159]	901	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	902	die $rmsg if $code eq 'FAIL';
	903	} elsif ($type =~ /^.d$/) {
	904	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	905	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	906	die $rmsg if $code eq 'FAIL';
[125]	907	}
	908
[192]	909	} # done with netblock alloctype != rm
[125]	910
[394]	911	# node hack
	912	if ($nodeid && $nodeid ne '') {
	913	$sth = $dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	914	$sth->execute("$cidr",$nodeid);
	915	}
	916	# end node hack
[125]	917	$dbh->commit;
	918	}; # end eval
	919	if ($@) {
[250]	920	$msg .= ": ".$@;
[125]	921	eval { $dbh->rollback; };
	922	return ('FAIL',$msg);
	923	} else {
[549]	924	return ($errcode,($type =~ /^.[pd]$/ ? $msg : "OK"));
[125]	925	}
	926
	927	} # end fullcidr != alloc_from
	928
	929	} # end static-IP vs netblock allocation
	930
	931	} # end allocateBlock()
	932
	933
	934	## IPDB::initPool()
	935	# Initializes a pool
	936	# Requires a database handle, the pool CIDR, type, city, and a parameter
	937	# indicating whether the pool should allow allocation of literally every
	938	# IP, or if it should reserve network/gateway/broadcast IPs
	939	# Note that this is NOT done in a transaction, that's why it's a private
	940	# function and should ONLY EVER get called from allocateBlock()
	941	sub initPool {
	942	my ($dbh,undef,$type,$city,$class) = @_;
	943	my $pool = new NetAddr::IP $_[1];
	944
[549]	945	return ('WARN','Refusing to melt server with IPv6 IP pool') if $pool->bits == 128;
	946
[159]	947	##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
	948	$type =~ s/[pd]$/i/;
[125]	949	my $sth;
[159]	950	my $msg;
[125]	951
[159]	952	# Trap errors so we can pass them back to the caller. Even if the
	953	# caller is only ever supposed to be local, and therefore already
	954	# trapping errors. >:(
	955	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	956	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	957
	958	eval {
	959	# have to insert all pool IPs into poolips table as "unallocated".
	960	$sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
[592]	961	" values ('$pool', ?, '$defcustid', ?, '$type')");
[159]	962	my @poolip_list = $pool->hostenum;
	963	if ($class eq 'all') { # (DSL-ish block - all IPs available
[248]	964	if ($pool->addr !~ /\.0$/) { # .0 causes weirdness.
[592]	965	$sth->execute($pool->addr, $city);
[248]	966	}
[159]	967	for (my $i=0; $i<=$#poolip_list; $i++) {
[592]	968	$sth->execute($poolip_list[$i]->addr, $city);
[159]	969	}
	970	$pool--;
[248]	971	if ($pool->addr !~ /\.255$/) { # .255 can cause weirdness.
[592]	972	$sth->execute($pool->addr, $city);
[248]	973	}
[159]	974	} else { # (real netblock)
	975	for (my $i=1; $i<=$#poolip_list; $i++) {
[592]	976	$sth->execute($poolip_list[$i]->addr, $city);
[159]	977	}
[125]	978	}
[159]	979	};
	980	if ($@) {
[592]	981	$msg = $@." '".$sth->errstr."'";
[159]	982	eval { $dbh->rollback; };
	983	return ('FAIL',$msg);
	984	} else {
	985	return ('OK',"OK");
[125]	986	}
	987	} # end initPool()
	988
	989
[594]	990	## IPDB::updateBlock()
	991	# Update an allocation
	992	# Takes all allocation fields in a hash
	993	sub updateBlock {
	994	my $dbh = shift;
	995	my %args = @_;
	996
	997	return ('FAIL', 'Missing block to update') if !$args{block};
	998
	999	# do it all in a transaction
	1000	local $dbh->{AutoCommit} = 0;
	1001	local $dbh->{RaiseError} = 1;
	1002
	1003	my @fieldlist;
	1004	my @vallist;
[598]	1005	foreach ('custid', 'city', 'description', 'notes', 'circuitid', 'privdata', 'vrf') {
[594]	1006	if ($args{$_}) {
	1007	push @fieldlist, $_;
	1008	push @vallist, $args{$_};
	1009	}
	1010	}
	1011
	1012	my $updtable = 'allocations';
	1013	my $keyfield = 'cidr';
	1014	if ($args{type} =~ /^(.)i$/) {
	1015	$updtable = 'poolips';
	1016	$keyfield = 'ip';
	1017	} else {
	1018	## fixme: there's got to be a better way...
	1019	if ($args{swip}) {
	1020	if ($args{swip} eq 'on' \|\| $args{swip} eq '1' \|\| $args{swip} eq 'y') {
	1021	$args{swip} = 'y';
	1022	} else {
	1023	$args{swip} = 'n';
	1024	}
	1025	}
	1026	foreach ('type', 'swip') {
	1027	if ($args{$_}) {
	1028	push @fieldlist, $_;
	1029	push @vallist, $args{$_};
	1030	}
	1031	}
	1032	}
	1033
	1034	return ('FAIL', 'No fields to update') if !@fieldlist;
	1035
	1036	push @vallist, $args{block};
	1037	my $sql = "UPDATE $updtable SET ";
	1038	$sql .= join " = ?, ", @fieldlist;
	1039	$sql .= " = ? WHERE $keyfield = ?";
	1040
	1041	eval {
	1042	# do the update
	1043	$dbh->do($sql, undef, @vallist);
	1044
	1045	if ($args{node}) {
	1046	# done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there
	1047	$dbh->do("DELETE FROM noderef WHERE block = ?", undef, ($args{block}) );
	1048	$dbh->do("INSERT INTO noderef (block,node_id) VALUES (?,?)", undef, ($args{block}, $args{node}) );
	1049	}
	1050
	1051	$dbh->commit;
	1052	};
	1053	if ($@) {
	1054	my $msg = $@;
	1055	$dbh->rollback;
	1056	return ('FAIL', $msg);
	1057	}
	1058	return 0;
	1059	} # end updateBlock()
	1060
	1061
[125]	1062	## IPDB::deleteBlock()
	1063	# Removes an allocation from the database, including deleting IPs
	1064	# from poolips and recombining entries in freeblocks if possible
	1065	# Also handles "deleting" a static IP allocation, and removal of a master
	1066	# Requires a database handle, the block to delete, and the type of block
	1067	sub deleteBlock {
	1068	my ($dbh,undef,$type) = @_;
	1069	my $cidr = new NetAddr::IP $_[1];
	1070
	1071	my $sth;
	1072
[336]	1073	# Magic variables used for odd allocation cases.
	1074	my $container;
	1075	my $con_type;
	1076
[125]	1077	# To contain the error message, if any.
	1078	my $msg = "Unknown error deallocating $type $cidr";
	1079	# Enable transactions and exception-on-errors... but only for this sub
	1080	local $dbh->{AutoCommit} = 0;
	1081	local $dbh->{RaiseError} = 1;
	1082
	1083	# First case. The "block" is a static IP
	1084	# Note that we still need some additional code in the odd case
	1085	# of a netblock-aligned contiguous group of static IPs
	1086	if ($type =~ /^.i$/) {
	1087
	1088	eval {
[159]	1089	$msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
[593]	1090	$sth = $dbh->prepare("update poolips set custid=?,available='y',".
	1091	"city=(select city from allocations where cidr >>= ?".
[354]	1092	" order by masklen(cidr) desc limit 1),".
[593]	1093	"description='',notes='',circuitid='' where ip=?");
	1094	$sth->execute($defcustid, "$cidr", "$cidr");
[125]	1095	$dbh->commit;
	1096	};
	1097	if ($@) {
	1098	eval { $dbh->rollback; };
	1099	return ('FAIL',$msg);
	1100	} else {
	1101	return ('OK',"OK");
	1102	}
	1103
	1104	} elsif ($type eq 'mm') { # end alloctype =~ /.i/
	1105
	1106	$msg = "Unable to delete master block $cidr";
	1107	eval {
[598]	1108	$sth = $dbh->prepare("delete from masterblocks where cidr=?");
	1109	$sth->execute($cidr);
	1110	$sth = $dbh->prepare("delete from freeblocks where cidr <<= ?");
	1111	$sth->execute($cidr);
[125]	1112	$dbh->commit;
	1113	};
	1114	if ($@) {
	1115	eval { $dbh->rollback; };
	1116	return ('FAIL', $msg);
	1117	} else {
	1118	return ('OK',"OK");
	1119	}
	1120
	1121	} else { # end alloctype master block case
	1122
	1123	## This is a big block; but it HAS to be done in a chunk. Any removal
	1124	## of a netblock allocation may result in a larger chunk of free
	1125	## contiguous IP space - which may in turn be combined into a single
	1126	## netblock rather than a number of smaller netblocks.
	1127
	1128	eval {
	1129
[192]	1130	if ($type eq 'rm') {
[125]	1131	$msg = "Unable to remove routing allocation $cidr";
	1132	$sth = $dbh->prepare("delete from routed where cidr='$cidr'");
	1133	$sth->execute;
	1134	# Make sure block getting deleted is properly accounted for.
	1135	$sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
	1136	" where cidr='$cidr'");
	1137	$sth->execute;
	1138	# Set up query to start compacting free blocks.
[159]	1139	$sth = $dbh->prepare("select cidr from freeblocks where ".
[125]	1140	"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
	1141
	1142	} else { # end alloctype routing case
	1143
[336]	1144	# Magic. We need to get information about the containing block (if any)
	1145	# so as to make sure that the freeblocks we insert get the correct "type".
	1146	$sth = $dbh->prepare("select cidr,type from allocations where cidr >> '$cidr'");
	1147	$sth->execute;
	1148	($container, $con_type) = $sth->fetchrow_array;
	1149
[192]	1150	# Delete all allocations within the block being deleted. This is
	1151	# deliberate and correct, and removes the need to special-case
	1152	# removal of "container" blocks.
	1153	$sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
[125]	1154	$sth->execute;
[192]	1155
[125]	1156	# Special case - delete pool IPs
[159]	1157	if ($type =~ /^.[pd]$/) {
[125]	1158	# We have to delete the IPs from the pool listing.
	1159	$sth = $dbh->prepare("delete from poolips where pool='$cidr'");
	1160	$sth->execute;
	1161	}
	1162
	1163	# Set up query for compacting free blocks.
[336]	1164	if ($con_type && $con_type eq 'pc') {
	1165	# Clean up after "bad" allocations (blocks that are not formally
	1166	# contained which have nevertheless been allocated from a container block)
	1167	# We want to make certain that the freeblocks are properly "labelled"
[362]	1168	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= '$container' order by maskbits desc");
[336]	1169	} else {
	1170	# Standard deallocation.
	1171	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
[125]	1172	"(select cidr from routed where cidr >>= '$cidr') ".
[192]	1173	" and maskbits<=".$cidr->masklen.
[304]	1174	" and routed='".(($type =~ /^(.)r$/) ? "$1" : 'y').
[192]	1175	"' order by maskbits desc");
[336]	1176	}
[125]	1177
	1178	} # end alloctype general case
	1179
[445]	1180	## Deallocate legacy blocks stashed in the middle of a static IP pool
	1181	## This may be expandable to an even more general case of contained netblock, or other pool types.
[126]	1182
[445]	1183	# Find out if the block we're deallocating is within a DSL pool
	1184	my $sth2 = $dbh->prepare("SELECT cidr,city,type FROM allocations WHERE type LIKE '_p' AND cidr >>= ?");
	1185	$sth2->execute("$cidr");
	1186	my ($pool,$poolcity,$pooltype) = $sth2->fetchrow_array;
[126]	1187
[445]	1188	if ($pool \|\| $sth2->rows) {
	1189	# We've already deleted the block, now we have to stuff its IPs into the pool.
	1190	$pooltype =~ s/p$/i/; # change type to static IP
	1191	$sth2 = $dbh->prepare("INSERT INTO poolips (pool,ip,city,type,custid) values ".
	1192	"('$pool',?,'$poolcity','$pooltype','$defcustid')");
	1193	##fixme: need to not insert net, gateway, and bcast on "real netblock" pools (DHCPish)
	1194	# don't insert .0
	1195	$sth2->execute($cidr->addr) unless $cidr->addr =~ m\|\.0$\|;
	1196	foreach my $ip ($cidr->hostenum) {
	1197	$sth2->execute("$ip");
	1198	}
	1199	$cidr--;
	1200	# don't insert .255
	1201	$sth2->execute($cidr->addr) unless $cidr->addr =~ m\|\.255$\|;
	1202	} else { # done returning IPs from a block to a static DSL pool
[125]	1203
[445]	1204	# Now we look for larger-or-equal-sized free blocks in the same master (routed)
	1205	# (super)block. If there aren't any, we can't combine blocks anyway. If there
	1206	# are, we check to see if we can combine blocks.
	1207	# Execute the statement prepared in the if-else above.
[125]	1208
[445]	1209	$sth->execute;
	1210
[125]	1211	# NetAddr::IP->compact() attempts to produce the smallest inclusive block
	1212	# from the caller and the passed terms.
	1213	# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
	1214	# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
	1215	# .64-.95, and .96-.128), you will get an array containing a single
	1216	# /25 as element 0 (.0-.127). Order is not important; you could have
	1217	# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
	1218
[445]	1219	my (@together, @combinelist);
	1220	my $i=0;
	1221	while (my @data = $sth->fetchrow_array) {
	1222	my $testIP = new NetAddr::IP $data[0];
	1223	@together = $testIP->compact($cidr);
	1224	my $num = @together;
	1225	if ($num == 1) {
	1226	$cidr = $together[0];
	1227	$combinelist[$i++] = $testIP;
	1228	}
[125]	1229	}
	1230
[445]	1231	# Clear old freeblocks entries - if any. They should all be within
	1232	# the $cidr determined above.
	1233	$sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
	1234	$sth->execute;
[125]	1235
[445]	1236	# insert "new" freeblocks entry
	1237	if ($type eq 'rm') {
	1238	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
[159]	1239	" values ('$cidr',".$cidr->masklen.",'<NULL>')");
[445]	1240	} else {
	1241	# Magic hackery to insert "correct" data for deallocation of
	1242	# non-contained blocks allocated from within a container.
	1243	$type = 'pr' if $con_type && $con_type eq 'pc';
[336]	1244
[445]	1245	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
[159]	1246	" values ('$cidr',".$cidr->masklen.
[192]	1247	",(select city from routed where cidr >>= '$cidr'),'".
	1248	(($type =~ /^(.)r$/) ? "$1" : 'y')."')");
[445]	1249	}
	1250	$sth->execute;
[125]	1251
[445]	1252	} # done returning IPs to the appropriate place
[126]	1253
[125]	1254	# If we got here, we've succeeded. Whew!
	1255	$dbh->commit;
	1256	}; # end eval
	1257	if ($@) {
[445]	1258	$msg = $@;
[125]	1259	eval { $dbh->rollback; };
	1260	return ('FAIL', $msg);
	1261	} else {
	1262	return ('OK',"OK");
	1263	}
	1264
	1265	} # end alloctype != netblock
	1266
	1267	} # end deleteBlock()
	1268
	1269
[356]	1270	## IPDB::getBlockData()
[594]	1271	# Get CIDR or IP, custid, type, city, circuit ID, description, notes, modification time, private/restricted
[598]	1272	# data, and VRF tag, for a CIDR block or pool IP
[594]	1273	# Also returns SWIP status flag for CIDR blocks
	1274	# Takes the block/IP to look up
	1275	# Returns an arrayref to a list of hashrefs
[356]	1276	sub getBlockData {
	1277	my $dbh = shift;
	1278	my $block = shift;
	1279
[594]	1280	my $cidr = new NetAddr::IP $block;
	1281
	1282	my $keycol = 'cidr';
	1283	my $blocktable = 'allocations';
	1284	my $poolip = 0;
	1285
	1286	# Pool IP and IPv6 check all in one! Still needs to be tightened
	1287	# up a little for the as-yet-unhandled case of IPv6 IP pools
	1288	if ($cidr->bits == 32 && $cidr->masklen == 32) {
	1289	$poolip = 1;
	1290	$keycol = 'ip';
	1291	$blocktable = 'poolips';
	1292	}
	1293	my $binfo = $dbh->selectrow_hashref("SELECT $keycol AS block, custid, type, city, circuitid, description,".
[598]	1294	" notes, modifystamp AS lastmod, privdata, vrf".($poolip ? '' : ', swip')." FROM $blocktable".
[594]	1295	" WHERE $keycol = ?", undef, ($block) );
	1296	return $binfo;
[356]	1297	} # end getBlockData()
	1298
	1299
[594]	1300	## IPDB::getNodeList()
	1301	# Gets a list of node ID+name pairs as an arrayref to a list of hashrefs
	1302	sub getNodeList {
	1303	my $dbh = shift;
	1304
	1305	my $ret = $dbh->selectall_arrayref("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id",
	1306	{ Slice => {} });
	1307	return $ret;
	1308	} # end getNodeList()
	1309
	1310
	1311	## IPDB::getNodeName()
	1312	# Get node name from the ID
	1313	sub getNodeName {
	1314	my $dbh = shift;
	1315	my $nid = shift;
	1316
	1317	my ($nname) = $dbh->selectrow_array("SELECT node_name FROM nodes WHERE node_id = ?", undef, ($nid) );
	1318	return $nname;
	1319	} # end getNodeName()
	1320
	1321
	1322	## IPDB::getNodeInfo()
	1323	# Get node name and ID associated with a block
	1324	sub getNodeInfo {
	1325	my $dbh = shift;
	1326	my $block = shift;
	1327
	1328	my ($nid, $nname) = $dbh->selectrow_array("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef".
	1329	" ON nodes.node_id=noderef.node_id WHERE noderef.block = ?", undef, ($block) );
	1330	return ($nid, $nname);
	1331	} # end getNodeInfo()
	1332
	1333
[125]	1334	## IPDB::mailNotify()
[71]	1335	# Sends notification mail to recipients regarding an IPDB operation
[445]	1336	sub mailNotify {
	1337	my $dbh = shift;
	1338	my ($action,$subj,$message) = @_;
[71]	1339
[592]	1340	return if $smtphost eq 'smtp.example.com'; # do nothing if still using default SMTP host.
[509]	1341
[445]	1342	##fixme: need to redesign the breakdown/processing for $action for proper handling of all cases
	1343
	1344	# split action into parts for fiddlement. nb: there are almost certainly better ways to do this.
	1345	my @actionbits = split //, $action;
	1346
	1347	# want to notify anyone who has specifically requested notify on this type ($action as passed),
	1348	# on "all static IP types" or "all pool types" (and other last-char-in-type groupings), on eg "all DSL types",
	1349	# and "all events with this action"
	1350	my @actionsets = ($action);
	1351	##fixme: ick, eww. really gotta find a better way to handle this...
	1352	push @actionsets, ($actionbits[0].'.'.$actionbits[2],
	1353	$actionbits[0].$actionbits[1].'.', $actionbits[0].'a') if $action =~ /^.{3}$/;
	1354
	1355	my $mailer = Net::SMTP->new($smtphost, Hello => "ipdb.$domain");
	1356
	1357	# get recip list from db
	1358	my $sth = $dbh->prepare("SELECT reciplist FROM notify WHERE action=?");
	1359
	1360	my %reciplist;
	1361	foreach (@actionsets) {
	1362	$sth->execute($_);
	1363	##fixme - need to handle db errors
	1364	my ($recipsub) = $sth->fetchrow_array;
	1365	next if !$recipsub;
	1366	foreach (split(/,/, $recipsub)) {
	1367	$reciplist{$_}++;
	1368	}
	1369	}
	1370
	1371	return if !%reciplist;
	1372
	1373	foreach my $recip (keys %reciplist) {
	1374	$mailer->mail("ipdb\@$domain");
	1375	$mailer->to($recip);
	1376	$mailer->data("From: \"$org_name IP Database\" <ipdb\@$domain>\n",
[131]	1377	"To: $recip\n",
[71]	1378	"Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
	1379	"Subject: {IPDB} $subj\n",
	1380	"X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
[445]	1381	"Organization: $org_name\n",
[71]	1382	"\n$message\n");
[445]	1383	}
[71]	1384	$mailer->quit;
	1385	}
	1386
[4]	1387	# Indicates module loaded OK. Required by Perl.
	1388	1;

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

Download in other formats: