Context Navigation

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

Last change on this file since 286 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.

Property svn:keywords set to Date Rev Author

File size: 21.0 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: 2005-09-23 19:54:31 +0000 (Fri, 23 Sep 2005) $
	6	# SVN revision $Rev: 286 $
	7	# Last update by $Author: kdeugau $
	8	###
[158]	9	# Copyright (C) 2004,2005 - 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;
	18	use POSIX;
[4]	19	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	20
[125]	21	$VERSION = 2.0;
[4]	22	@ISA = qw(Exporter);
[125]	23	@EXPORT_OK = qw(
[168]	24	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
[242]	25	%allocated %free %routed %bigfree %IPDBacl
[125]	26	&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
	27	&mailNotify
	28	);
[4]	29
	30	@EXPORT = (); # Export nothing by default.
[125]	31	%EXPORT_TAGS = ( ALL => [qw(
[168]	32	%disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
[242]	33	@masterblocks %allocated %free %routed %bigfree %IPDBacl
[125]	34	&initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
	35	&deleteBlock &mailNotify
	36	)]
	37	);
[4]	38
[125]	39	##
	40	## Global variables
	41	##
	42	our %disp_alloctypes;
	43	our %list_alloctypes;
[168]	44	our %def_custids;
[125]	45	our @citylist;
	46	our @poplist;
	47	our @masterblocks;
	48	our %allocated;
	49	our %free;
	50	our %routed;
	51	our %bigfree;
[242]	52	our %IPDBacl;
[71]	53
[125]	54	# Let's initialize the globals.
	55	## IPDB::initIPDBGlobals()
	56	# Initialize all globals. Takes a database handle, returns a success or error code
	57	sub initIPDBGlobals {
	58	my $dbh = $_[0];
	59	my $sth;
	60
	61	# Initialize alloctypes hashes
[168]	62	$sth = $dbh->prepare("select type,listname,dispname,listorder,def_custid from alloctypes order by listorder");
[125]	63	$sth->execute;
	64	while (my @data = $sth->fetchrow_array) {
	65	$disp_alloctypes{$data[0]} = $data[2];
[168]	66	$def_custids{$data[0]} = $data[4];
[125]	67	if ($data[3] < 900) {
	68	$list_alloctypes{$data[0]} = $data[1];
	69	}
	70	}
	71
	72	# City and POP listings
[159]	73	$sth = $dbh->prepare("select city,routing from cities order by city");
[125]	74	$sth->execute;
	75	return (undef,$sth->errstr) if $sth->err;
	76	while (my @data = $sth->fetchrow_array) {
	77	push @citylist, $data[0];
	78	if ($data[1] eq 'y') {
	79	push @poplist, $data[0];
	80	}
	81	}
	82
	83	# Master block list
[159]	84	$sth = $dbh->prepare("select cidr from masterblocks order by cidr");
[125]	85	$sth->execute;
[242]	86	return (undef,$sth->errstr) if $sth->err;
[125]	87	for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
	88	$masterblocks[$i] = new NetAddr::IP $data[0];
	89	$allocated{"$masterblocks[$i]"} = 0;
	90	$free{"$masterblocks[$i]"} = 0;
	91	$bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
	92	# Set to 128 to prepare for IPv6
	93	$routed{"$masterblocks[$i]"} = 0;
	94	}
[242]	95
	96	# Load ACL data. Specific username checks are done at a different level.
	97	$sth = $dbh->prepare("select username,acl from users");
	98	$sth->execute;
[125]	99	return (undef,$sth->errstr) if $sth->err;
[242]	100	while (my @data = $sth->fetchrow_array) {
	101	$IPDBacl{$data[0]} = $data[1];
	102	}
[125]	103
	104	return (1,"OK");
	105	} # end initIPDBGlobals
	106
	107
	108	## IPDB::connectDB()
[4]	109	# Creates connection to IPDB.
[125]	110	# Requires the database name, username, and password.
[4]	111	# Returns a handle to the db.
[125]	112	# Set up for a PostgreSQL db; could be any transactional DBMS with the
	113	# right changes.
	114	# This definition should be sub connectDB($$$) to be technically correct,
	115	# but this breaks. GRR.
[4]	116	sub connectDB {
[125]	117	my ($dbname,$user,$pass) = @_;
[4]	118	my $dbh;
[125]	119	my $DSN = "DBI:Pg:dbname=$dbname";
	120	# my $user = 'ipdb';
	121	# my $pw = 'ipdbpwd';
[4]	122
	123	# Note that we want to autocommit by default, and we will turn it off locally as necessary.
[125]	124	# We may not want to print gobbledygook errors; YMMV. Have to ponder that further.
	125	$dbh = DBI->connect($DSN, $user, $pass, {
	126	AutoCommit => 1,
	127	PrintError => 0
	128	})
	129	or return (undef, $DBI::errstr) if(!$dbh);
[4]	130
[125]	131	# Return here if we can't select. Note that this indicates a
	132	# problem executing the select.
[185]	133	my $sth = $dbh->prepare("select type from alloctypes");
[125]	134	$sth->execute();
	135	return (undef,$DBI::errstr) if ($sth->err);
	136
	137	# See if the select returned anything (or null data). This should
	138	# succeed if the select executed, but...
	139	$sth->fetchrow();
	140	return (undef,$DBI::errstr) if ($sth->err);
	141
	142	# If we get here, we should be OK.
	143	return ($dbh,"DB connection OK");
[4]	144	} # end connectDB
	145
[125]	146
	147	## IPDB::finish()
	148	# Cleans up after database handles and so on.
	149	# Requires a database handle
	150	sub finish {
	151	my $dbh = $_[0];
	152	$dbh->disconnect;
	153	} # end finish
	154
	155
	156	## IPDB::checkDBSanity()
[4]	157	# Quick check to see if the db is responding. A full integrity
	158	# check will have to be a separate tool to walk the IP allocation trees.
	159	sub checkDBSanity {
[125]	160	my ($dbh) = $_[0];
[4]	161
	162	if (!$dbh) {
[125]	163	print "No database handle, or connection has been closed.";
	164	return -1;
[4]	165	} else {
	166	# it connects, try a stmt.
[185]	167	my $sth = $dbh->prepare("select type from alloctypes");
[4]	168	my $err = $sth->execute();
	169
	170	if ($sth->fetchrow()) {
	171	# all is well.
	172	return 1;
	173	} else {
[16]	174	print "Connected to the database, but could not execute test statement. ".$sth->errstr();
[125]	175	return -1;
[4]	176	}
	177	}
	178	# Clean up after ourselves.
[125]	179	# $dbh->disconnect;
[4]	180	} # end checkDBSanity
	181
[71]	182
[125]	183	## IPDB::allocateBlock()
[71]	184	# Does all of the magic of actually allocating a netblock
[125]	185	# Requires database handle, block to allocate, custid, type, city,
[286]	186	# description, notes, circuit ID, block to allocate from, private data
[125]	187	# Returns a success code and optional error message.
	188	sub allocateBlock {
[286]	189	my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid,$privdata) = @_;
	190
[125]	191	my $cidr = new NetAddr::IP $_[1];
	192	my $alloc_from = new NetAddr::IP $_[2];
	193	my $sth;
[71]	194
[125]	195	# To contain the error message, if any.
	196	my $msg = "Unknown error allocating $cidr as '$type'";
[71]	197
[125]	198	# Enable transactions and error handling
	199	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	200	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	201
[159]	202	if ($type =~ /^.i$/) {
[125]	203	$msg = "Unable to assign static IP $cidr to $custid";
	204	eval {
[159]	205	# We have to do this in two parts because otherwise we lose
	206	# the ability to return the IP assigned. Should that change,
	207	# the commented SQL statement below may become usable.
[125]	208	# update poolips set custid='$custid',city='$city',available='n',
	209	# description='$desc',notes='$notes',circuitid='$circid'
	210	# where ip=(select ip from poolips where pool='$alloc_from'
	211	# and available='y' order by ip limit 1);
[159]	212
	213	$sth = $dbh->prepare("select ip from poolips where pool='$alloc_from'".
	214	" and available='y' order by ip");
	215	$sth->execute;
	216
[125]	217	my @data = $sth->fetchrow_array;
[159]	218	$cidr = $data[0]; # $cidr is already declared when we get here!
[125]	219
	220	$sth = $dbh->prepare("update poolips set custid='$custid',".
	221	"city='$city',available='n',description='$desc',notes='$notes',".
[286]	222	"circuitid='$circid',privdata='$privdata'".
[125]	223	" where ip='$cidr'");
	224	$sth->execute;
	225	$dbh->commit;
	226	};
	227	if ($@) {
	228	$msg .= ": '".$sth->errstr."'";
	229	eval { $dbh->rollback; };
	230	return ('FAIL',$msg);
	231	} else {
	232	return ('OK',"$cidr");
	233	}
	234
	235	} else { # end IP-from-pool allocation
	236
	237	if ($cidr == $alloc_from) {
	238	# Easiest case- insert in one table, delete in the other, and go home. More or less.
	239	# insert into allocations values (cidr,custid,type,city,desc) and
	240	# delete from freeblocks where cidr='cidr'
	241	# For data safety on non-transaction DBs, we delete first.
	242
	243	eval {
	244	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
[192]	245	if ($type eq 'rm') {
[125]	246	$sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
	247	" where cidr='$cidr'");
	248	$sth->execute;
[159]	249	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	250	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	251	$sth->execute;
	252	} else {
	253	# common stuff for end-use, dialup, dynDSL, pools, etc, etc.
	254
[192]	255	# special case - block is a container/"reserve" block
	256	if ($type =~ /^(.)c$/) {
	257	$sth = $dbh->prepare("update freeblocks set routed='$1' where cidr='$cidr'");
	258	$sth->execute;
	259	} else {
	260	# "normal" case
	261	$sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
	262	$sth->execute;
	263	}
[159]	264	$sth = $dbh->prepare("insert into allocations".
[286]	265	" (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
[159]	266	" values ('$cidr','$custid','$type','$city','$desc','$notes',".
[286]	267	$cidr->masklen.",'$circid','$privdata')");
[125]	268	$sth->execute;
	269
	270	# And initialize the pool, if necessary
[159]	271	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	272	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	273	if ($type =~ /^.p$/) {
[159]	274	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	275	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	276	die $rmsg if $code eq 'FAIL';
	277	} elsif ($type =~ /^.d$/) {
	278	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	279	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	280	die $rmsg if $code eq 'FAIL';
[125]	281	}
	282
	283	} # routing vs non-routing netblock
	284
	285	$dbh->commit;
	286	}; # end of eval
	287	if ($@) {
[159]	288	$msg .= ": ".$@;
[125]	289	eval { $dbh->rollback; };
[159]	290	return ('FAIL',$msg);
[125]	291	} else {
	292	return ('OK',"OK");
	293	}
	294
	295	} else { # cidr != alloc_from
	296
	297	# Hard case. Allocation is smaller than free block.
	298	my $wantmaskbits = $cidr->masklen;
	299	my $maskbits = $alloc_from->masklen;
	300
	301	my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
	302
	303	# This determines which blocks will be left "free" after allocation. We take the
	304	# block we're allocating from, and split it in half. We see which half the wanted
	305	# block is in, and repeat until the wanted block is equal to one of the halves.
	306	my $i=0;
	307	my $tmp_from = $alloc_from; # So we don't munge $alloc_from
	308	while ($maskbits++ < $wantmaskbits) {
	309	my @subblocks = $tmp_from->split($maskbits);
	310	$newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
	311	$tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
	312	} # while
	313
	314	# Begin SQL transaction block
	315	eval {
	316	$msg = "Unable to allocate $cidr as '$disp_alloctypes{$type}'";
	317
	318	# Delete old freeblocks entry
	319	$sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
	320	$sth->execute();
	321
	322	# now we have to do some magic for routing blocks
[192]	323	if ($type eq 'rm') {
[125]	324
	325	# Insert the new freeblocks entries
	326	# Note that non-routed blocks are assigned to <NULL>
[159]	327	# and use the default value for the routed column ('n')
	328	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
	329	" values (?, ?, '<NULL>')");
[125]	330	foreach my $block (@newfreeblocks) {
	331	$sth->execute("$block", $block->masklen);
	332	}
	333
	334	# Insert the entry in the routed table
[159]	335	$sth = $dbh->prepare("insert into routed (cidr,maskbits,city)".
	336	" values ('$cidr',".$cidr->masklen.",'$city')");
[125]	337	$sth->execute;
	338	# Insert the (almost) same entry in the freeblocks table
[159]	339	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	340	" values ('$cidr',".$cidr->masklen.",'$city','y')");
[125]	341	$sth->execute;
	342
[192]	343	} else { # done with alloctype == rm
[125]	344
	345	# Insert the new freeblocks entries
[192]	346	# Along with some more HairyPerl(TM) in case we're inserting a
	347	# subblock (.r) allocation
[159]	348	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
[192]	349	" values (?, ?, (select city from routed where cidr >>= '$cidr'),'".
	350	(($type =~ /^(.)r$/) ? "$1" : 'y')."')");
[125]	351	foreach my $block (@newfreeblocks) {
	352	$sth->execute("$block", $block->masklen);
	353	}
[192]	354	# Special-case for reserve/"container" blocks - generate
	355	# the "extra" freeblocks entry for the container
	356	if ($type =~ /^(.)c$/) {
	357	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	358	" values ('$cidr',".$cidr->masklen.",'$city','$1')");
	359	$sth->execute;
	360	}
[125]	361	# Insert the allocations entry
[159]	362	$sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
[286]	363	"description,notes,maskbits,circuitid,privdata)".
[159]	364	" values ('$cidr','$custid','$type','$city','$desc','$notes',".
[286]	365	$cidr->masklen.",'$circid','$privdata')");
[125]	366	$sth->execute;
	367
	368	# And initialize the pool, if necessary
[159]	369	# PPPoE pools (currently dialup, DSL, and WiFi) get all IPs made available
	370	# "DHCP" or "real-subnet" pools have the net, gw, and bcast IPs removed.
[125]	371	if ($type =~ /^.p$/) {
	372	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
[159]	373	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"all");
	374	die $rmsg if $code eq 'FAIL';
	375	} elsif ($type =~ /^.d$/) {
	376	$msg = "Could not initialize IPs in new $disp_alloctypes{$type} $cidr";
	377	my ($code,$rmsg) = initPool($dbh,$cidr,$type,$city,"normal");
	378	die $rmsg if $code eq 'FAIL';
[125]	379	}
	380
[192]	381	} # done with netblock alloctype != rm
[125]	382
	383	$dbh->commit;
	384	}; # end eval
	385	if ($@) {
[250]	386	$msg .= ": ".$@;
[125]	387	eval { $dbh->rollback; };
	388	return ('FAIL',$msg);
	389	} else {
	390	return ('OK',"OK");
	391	}
	392
	393	} # end fullcidr != alloc_from
	394
	395	} # end static-IP vs netblock allocation
	396
	397	} # end allocateBlock()
	398
	399
	400	## IPDB::initPool()
	401	# Initializes a pool
	402	# Requires a database handle, the pool CIDR, type, city, and a parameter
	403	# indicating whether the pool should allow allocation of literally every
	404	# IP, or if it should reserve network/gateway/broadcast IPs
	405	# Note that this is NOT done in a transaction, that's why it's a private
	406	# function and should ONLY EVER get called from allocateBlock()
	407	sub initPool {
	408	my ($dbh,undef,$type,$city,$class) = @_;
	409	my $pool = new NetAddr::IP $_[1];
	410
[159]	411	##fixme Need to just replace 2nd char of type with i rather than capturing 1st char of type
	412	$type =~ s/[pd]$/i/;
[125]	413	my $sth;
[159]	414	my $msg;
[125]	415
[159]	416	# Trap errors so we can pass them back to the caller. Even if the
	417	# caller is only ever supposed to be local, and therefore already
	418	# trapping errors. >:(
	419	local $dbh->{AutoCommit} = 0; # These need to be local so we don't
	420	local $dbh->{RaiseError} = 1; # step on our toes by accident.
	421
	422	eval {
	423	# have to insert all pool IPs into poolips table as "unallocated".
	424	$sth = $dbh->prepare("insert into poolips (pool,ip,custid,city,type)".
	425	" values ('$pool', ?, '6750400', '$city', '$type')");
	426	my @poolip_list = $pool->hostenum;
	427	if ($class eq 'all') { # (DSL-ish block - all IPs available
[248]	428	if ($pool->addr !~ /\.0$/) { # .0 causes weirdness.
	429	$sth->execute($pool->addr);
	430	}
[159]	431	for (my $i=0; $i<=$#poolip_list; $i++) {
	432	$sth->execute($poolip_list[$i]->addr);
	433	}
	434	$pool--;
[248]	435	if ($pool->addr !~ /\.255$/) { # .255 can cause weirdness.
	436	$sth->execute($pool->addr);
	437	}
[159]	438	} else { # (real netblock)
	439	for (my $i=1; $i<=$#poolip_list; $i++) {
	440	$sth->execute($poolip_list[$i]->addr);
	441	}
[125]	442	}
[159]	443	};
	444	if ($@) {
	445	$msg = "'".$sth->errstr."'";
	446	eval { $dbh->rollback; };
	447	return ('FAIL',$msg);
	448	} else {
	449	return ('OK',"OK");
[125]	450	}
	451	} # end initPool()
	452
	453
	454	## IPDB::deleteBlock()
	455	# Removes an allocation from the database, including deleting IPs
	456	# from poolips and recombining entries in freeblocks if possible
	457	# Also handles "deleting" a static IP allocation, and removal of a master
	458	# Requires a database handle, the block to delete, and the type of block
	459	sub deleteBlock {
	460	my ($dbh,undef,$type) = @_;
	461	my $cidr = new NetAddr::IP $_[1];
	462
	463	my $sth;
	464
	465	# To contain the error message, if any.
	466	my $msg = "Unknown error deallocating $type $cidr";
	467	# Enable transactions and exception-on-errors... but only for this sub
	468	local $dbh->{AutoCommit} = 0;
	469	local $dbh->{RaiseError} = 1;
	470
	471	# First case. The "block" is a static IP
	472	# Note that we still need some additional code in the odd case
	473	# of a netblock-aligned contiguous group of static IPs
	474	if ($type =~ /^.i$/) {
	475
	476	eval {
[159]	477	$msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
[125]	478	$sth = $dbh->prepare("update poolips set custid='6750400',available='y',".
	479	"city=(select city from allocations where cidr >>= '$cidr'),".
	480	"description='',notes='',circuitid='' where ip='$cidr'");
	481	$sth->execute;
	482	$dbh->commit;
	483	};
	484	if ($@) {
	485	eval { $dbh->rollback; };
	486	return ('FAIL',$msg);
	487	} else {
	488	return ('OK',"OK");
	489	}
	490
	491	} elsif ($type eq 'mm') { # end alloctype =~ /.i/
	492
	493	$msg = "Unable to delete master block $cidr";
	494	eval {
	495	$sth = $dbh->prepare("delete from masterblocks where cidr='$cidr'");
	496	$sth->execute;
	497	$sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
	498	$sth->execute;
	499	$dbh->commit;
	500	};
	501	if ($@) {
	502	eval { $dbh->rollback; };
	503	return ('FAIL', $msg);
	504	} else {
	505	return ('OK',"OK");
	506	}
	507
	508	} else { # end alloctype master block case
	509
	510	## This is a big block; but it HAS to be done in a chunk. Any removal
	511	## of a netblock allocation may result in a larger chunk of free
	512	## contiguous IP space - which may in turn be combined into a single
	513	## netblock rather than a number of smaller netblocks.
	514
	515	eval {
	516
[192]	517	if ($type eq 'rm') {
[125]	518	$msg = "Unable to remove routing allocation $cidr";
	519	$sth = $dbh->prepare("delete from routed where cidr='$cidr'");
	520	$sth->execute;
	521	# Make sure block getting deleted is properly accounted for.
	522	$sth = $dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
	523	" where cidr='$cidr'");
	524	$sth->execute;
	525	# Set up query to start compacting free blocks.
[159]	526	$sth = $dbh->prepare("select cidr from freeblocks where ".
[125]	527	"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
	528
	529	} else { # end alloctype routing case
	530
[192]	531	# Delete all allocations within the block being deleted. This is
	532	# deliberate and correct, and removes the need to special-case
	533	# removal of "container" blocks.
	534	$sth = $dbh->prepare("delete from allocations where cidr <<='$cidr'");
[125]	535	$sth->execute;
[192]	536
[125]	537	# Special case - delete pool IPs
[159]	538	if ($type =~ /^.[pd]$/) {
[125]	539	# We have to delete the IPs from the pool listing.
	540	$sth = $dbh->prepare("delete from poolips where pool='$cidr'");
	541	$sth->execute;
	542	}
	543
	544	# Set up query for compacting free blocks.
[159]	545	$sth = $dbh->prepare("select cidr from freeblocks where cidr <<= ".
[125]	546	"(select cidr from routed where cidr >>= '$cidr') ".
[192]	547	" and maskbits<=".$cidr->masklen.
	548	" and routed='".(($type =~ /^(.)r$/) ? '$1' : 'y').
	549	"' order by maskbits desc");
[125]	550
	551	} # end alloctype general case
	552
[126]	553	##TEMP
	554	## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24
	555	## Note that we should really general-case this.
	556	my $staticpool = new NetAddr::IP "209.91.185.0/24";
	557	##TEMP
	558	if ($cidr->within($staticpool)) {
	559	##TEMP
	560	# We've already deleted the block, now we have to stuff its IPs into the pool.
[127]	561	$sth = $dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','Sudbury','d','y','','','')");
[126]	562	$sth->execute($cidr->addr);
	563	foreach my $ip ($cidr->hostenum) {
	564	$sth->execute("$ip");
	565	}
	566	$cidr--;
	567	$sth->execute($cidr->addr);
	568
	569	##TEMP
	570	} else {
	571	##TEMP
	572
[125]	573	# Now we look for larger-or-equal-sized free blocks in the same master (routed)
	574	# (super)block. If there aren't any, we can't combine blocks anyway. If there
	575	# are, we check to see if we can combine blocks.
	576	# Execute the statement prepared in the if-else above.
	577
	578	$sth->execute;
	579
	580	# NetAddr::IP->compact() attempts to produce the smallest inclusive block
	581	# from the caller and the passed terms.
	582	# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
	583	# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
	584	# .64-.95, and .96-.128), you will get an array containing a single
	585	# /25 as element 0 (.0-.127). Order is not important; you could have
	586	# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
	587
	588	my (@together, @combinelist);
	589	my $i=0;
	590	while (my @data = $sth->fetchrow_array) {
	591	my $testIP = new NetAddr::IP $data[0];
	592	@together = $testIP->compact($cidr);
	593	my $num = @together;
	594	if ($num == 1) {
	595	$cidr = $together[0];
	596	$combinelist[$i++] = $testIP;
	597	}
	598	}
	599
[192]	600	# Clear old freeblocks entries - if any. They should all be within
	601	# the $cidr determined above.
	602	$sth = $dbh->prepare("delete from freeblocks where cidr <<='$cidr'");
	603	$sth->execute;
[125]	604
	605	# insert "new" freeblocks entry
[192]	606	if ($type eq 'rm') {
[159]	607	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city)".
	608	" values ('$cidr',".$cidr->masklen.",'<NULL>')");
[125]	609	} else {
[159]	610	$sth = $dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
	611	" values ('$cidr',".$cidr->masklen.
[192]	612	",(select city from routed where cidr >>= '$cidr'),'".
	613	(($type =~ /^(.)r$/) ? "$1" : 'y')."')");
[125]	614	}
	615	$sth->execute;
	616
[126]	617	##TEMP
	618	}
	619	##TEMP
	620
[125]	621	# If we got here, we've succeeded. Whew!
	622	$dbh->commit;
	623	}; # end eval
	624	if ($@) {
	625	eval { $dbh->rollback; };
	626	return ('FAIL', $msg);
	627	} else {
	628	return ('OK',"OK");
	629	}
	630
	631	} # end alloctype != netblock
	632
	633	} # end deleteBlock()
	634
	635
	636	## IPDB::mailNotify()
[71]	637	# Sends notification mail to recipients regarding an IPDB operation
	638	sub mailNotify ($$$) {
	639	my ($recip,$subj,$message) = @_;
	640	my $mailer = Net::SMTP->new("smtp.example.com", Hello => "ipdb.example.com");
	641
	642	$mailer->mail('ipdb@example.com');
	643	$mailer->to($recip);
	644	$mailer->data("From: \"IP Database\" <ipdb\@example.com>\n",
[131]	645	"To: $recip\n",
[71]	646	"Date: ".strftime("%a, %d %b %Y %H:%M:%S %z",localtime)."\n",
	647	"Subject: {IPDB} $subj\n",
	648	"X-Mailer: IPDB Notify v".sprintf("%.1d",$IPDB::VERSION)."\n",
	649	"Organization: Example Corp\n",
	650	"\n$message\n");
	651	$mailer->quit;
	652	}
	653
[4]	654	# Indicates module loaded OK. Required by Perl.
	655	1;

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

Download in other formats: