Context Navigation

source: branches/stable/cgi-bin/main.cgi@ 114

Last change on this file since 114 was 104, checked in by Kris Deugau, 20 years ago

/branches/stable

Added description and "authuser" (HTTP-auth user) notes to
static-IP notifications

Property svn:executable set to *
Property svn:keywords set to Date Rev Author

File size: 56.0 KB

Rev	Line
[4]	1	#!/usr/bin/perl
	2	# ipdb/cgi-bin/main.cgi
	3	# Started munging from noc.vianet's old IPDB 04/22/2004
[8]	4	###
	5	# SVN revision info
	6	# $Date: 2004-12-21 19:35:43 +0000 (Tue, 21 Dec 2004) $
	7	# SVN revision $Rev: 104 $
	8	# Last update by $Author: kdeugau $
	9	###
[4]	10
	11	use strict;
	12	use warnings;
	13	use CGI::Carp qw(fatalsToBrowser);
	14	use DBI;
	15	use CommonWeb qw(:ALL);
	16	use IPDB qw(:ALL);
[56]	17	use CustIDCK;
[4]	18	use POSIX qw(ceil);
	19	use NetAddr::IP;
	20
	21	use Sys::Syslog;
	22
	23	openlog "IPDB","pid","local2";
	24
	25	# Collect the username from HTTP auth. If undefined, we're in a test environment.
	26	my $authuser;
	27	if (!defined($ENV{'REMOTE_USER'})) {
	28	$authuser = '__temptest';
	29	} else {
	30	$authuser = $ENV{'REMOTE_USER'};
	31	}
	32
	33	syslog "debug", "$authuser active";
	34
	35	checkDBSanity();
	36
	37	#prototypes
	38	sub viewBy($$); # feed it the category and query
	39	sub queryResults($$$); # args is the sql, the page# and the rowCount
	40	# Needs rewrite/rename
	41	sub countRows($); # returns first element of first row of passed SQL
	42	# Only usage passes "select count(*) ..."
	43
[99]	44	# Global variables
[4]	45	my $RESULTS_PER_PAGE = 50;
	46	my %webvar = parse_post();
	47	cleanInput(\%webvar);
	48
[99]	49	# Stuff that gets loaded from the database
[4]	50	my @masterblocks;
[91]	51	my @citylist;
	52	my @poplist;
[98]	53	my %disp_alloctypes;
	54	my %list_alloctypes;
[4]	55	my %allocated; # Count for allocated blocks in a master block
	56	my %free; # Count for free blocks (routed and unrouted) in a master block
	57	my %bigfree; # Tracking largest free block in a master block
	58	my %routed; # Number of routed blocks in a master block
	59
	60	# Why not a global DB handle? (And a global statement handle, as well...)
	61	# We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
	62	# Use the connectDB function, otherwise we end up confusing ourselves
	63	my $ip_dbh = connectDB;
[91]	64	my $sth;
[4]	65
	66	# Slurp up the master block list - we need this several places
	67	# While we're at it, initialize the related hashes.
[91]	68	$sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
[4]	69	$sth->execute;
	70	for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
	71	$masterblocks[$i] = new NetAddr::IP $data[0];
	72	$allocated{"$masterblocks[$i]"} = 0;
	73	$free{"$masterblocks[$i]"} = 0;
	74	$bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
	75	# Set to 128 to prepare for IPv6
	76	$routed{"$masterblocks[$i]"} = 0;
	77	}
	78
[91]	79	# Initialize the city and poplist arrays
	80	$sth = $ip_dbh->prepare("select * from cities order by city");
	81	$sth->execute;
	82	my $i = 0;
	83	my $j = 0;
	84	while (my @data = $sth->fetchrow_array) {
	85	$citylist[$i++] = $data[0];
	86	if ($data[1] eq 'y') {
	87	$poplist[$j++] = $data[0];
	88	}
	89	}
[4]	90
[98]	91	# Initialize alloctypes hashes
	92	$sth = $ip_dbh->prepare("select * from alloctypes order by listorder");
	93	$sth->execute;
	94	while (my @data = $sth->fetchrow_array) {
	95	$disp_alloctypes{$data[0]} = $data[2];
	96	if ($data[3] < 900) {
	97	$list_alloctypes{$data[0]} = $data[1];
	98	}
	99	}
[4]	100
	101
[98]	102
[4]	103	#main()
	104
	105	if(!defined($webvar{action})) {
	106	$webvar{action} = "<NULL>"; #shuts up the warnings.
	107	}
	108
	109	if($webvar{action} eq 'index') {
	110	showSummary();
	111	} elsif ($webvar{action} eq 'newmaster') {
	112	printHeader('');
	113
	114	my $cidr = new NetAddr::IP $webvar{cidr};
	115
	116	print "<div type=heading align=center>Adding $cidr as master block....\n";
	117
	118	# Allow transactions, and raise an exception on errors so we can catch it later.
	119	# Use local to make sure these get "reset" properly on exiting this block
	120	local $ip_dbh->{AutoCommit} = 0;
	121	local $ip_dbh->{RaiseError} = 1;
	122
	123	# Wrap the SQL in a transaction
	124	eval {
	125	$sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
	126	$sth->execute;
	127
	128	# Unrouted blocks aren't associated with a city (yet). We don't rely on this
	129	# elsewhere though; legacy data may have traps and pitfalls in it to break this.
	130	# Thus the "routed" flag.
	131
	132	$sth = $ip_dbh->prepare("insert into freeblocks values ('$webvar{cidr}',".
	133	$cidr->masklen.",'<NULL>','n')");
	134	$sth->execute;
	135
	136	# If we get here, everything is happy. Commit changes.
	137	$ip_dbh->commit;
	138	}; # end eval
	139
	140	if ($@) {
	141	carp "Transaction aborted because $@";
	142	eval { $ip_dbh->rollback; };
[17]	143	syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
[48]	144	printAndExit("Could not add master block $webvar{cidr} to database: $@");
[4]	145	}
	146
	147	print "Success!</div>\n";
	148
	149	printFooter;
	150	} # end add new master
	151
	152	elsif($webvar{action} eq 'showmaster') {
	153	showMaster();
	154	}
	155	elsif($webvar{action} eq 'showrouted') {
	156	showRBlock();
	157	}
	158	elsif($webvar{action} eq 'listpool') {
	159	listPool();
	160	}
	161	elsif($webvar{action} eq 'search') {
	162	printHeader('');
	163	if (!$webvar{input}) {
	164	# No search term. Display everything.
	165	viewBy('all', '');
	166	} else {
	167	# Search term entered. Display matches.
	168	# We should really sanitize $webvar{input}, no?
	169	viewBy($webvar{searchfor}, $webvar{input});
	170	}
	171	printFooter();
	172	}
	173
	174	# Not modified or added; just shuffled
	175	elsif($webvar{action} eq 'assign') {
	176	assignBlock();
	177	}
	178	elsif($webvar{action} eq 'confirm') {
	179	confirmAssign();
	180	}
	181	elsif($webvar{action} eq 'insert') {
	182	insertAssign();
	183	}
	184	elsif($webvar{action} eq 'edit') {
	185	edit();
	186	}
	187	elsif($webvar{action} eq 'update') {
	188	update();
	189	}
	190	elsif($webvar{action} eq 'delete') {
	191	remove();
	192	}
	193	elsif($webvar{action} eq 'finaldelete') {
	194	finalDelete();
	195	}
	196
	197	# Default is an error. It shouldn't be possible to easily get here.
	198	# The only way I can think of offhand is to just call main.cgi bare-
	199	# which is not in any way guaranteed to provide anything useful.
	200	else {
	201	printHeader('');
	202	my $rnd = rand 500;
	203	my $boing = sprintf("%.2f", rand 500);
	204	my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.",
	205	"Because one of it's legs are both the same", "wibble",
	206	"Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
	207	"8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
	208	printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
	209	}
	210
	211
	212	#end main()
	213
	214	# Shut up error log warning about not disconnecting. Maybe.
	215	$ip_dbh->disconnect;
	216	# Just in case something waaaayyy down isn't in place properly...
	217	exit 0;
	218
	219
	220	sub viewBy($$) {
	221	my ($category,$query) = @_;
	222
	223	# Local variables
	224	my $sql;
	225
	226	#print "<pre>\n";
	227
	228	#print "start querysub: query '$query'\n";
	229	# this may happen with more than one subcategory. Unlikely, but possible.
	230
	231	# Calculate start point for LIMIT clause
	232	my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
	233
	234	# Possible cases:
	235	# 1) Partial IP/subnet. Treated as "first-three-octets-match" in old IPDB,
	236	# I should be able to handle it similarly here.
	237	# 2a) CIDR subnet. Treated more or less as such in old IPDB.
	238	# 2b) CIDR netmask. Not sure how it's treated.
	239	# 3) Customer ID. Not handled in old IPDB
	240	# 4) Description.
	241	# 5) Invalid data which might be interpretable as an IP or something, but
	242	# which probably shouldn't be for reasons of sanity.
	243
	244	if ($category eq 'all') {
	245
	246	print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
	247	$sql = "select * from searchme";
	248	my $count = countRows("select count(*) from ($sql) foo");
	249	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	250	queryResults($sql, $webvar{page}, $count);
	251
	252	} elsif ($category eq 'cust') {
	253
	254	print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
	255
	256	# Query for a customer ID. Note that we can't restrict to "numeric-only"
	257	# as we have non-numeric custIDs in the legacy data. :/
[49]	258	$sql = "select * from searchme where custid ilike '%$query%'";
[4]	259	my $count = countRows("select count(*) from ($sql) foo");
	260	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	261	queryResults($sql, $webvar{page}, $count);
	262
	263	} elsif ($category eq 'desc') {
	264
	265	print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
	266	# Query based on description (includes "name" from old DB).
[49]	267	$sql = "select * from searchme where description ilike '%$query%'";
[4]	268	my $count = countRows("select count(*) from ($sql) foo");
	269	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	270	queryResults($sql, $webvar{page}, $count);
	271
	272	} elsif ($category =~ /ipblock/) {
	273
	274	# Query is for a partial IP, a CIDR block in some form, or a flat IP.
	275	print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);
	276
	277	$query =~ s/\s+//g;
	278	if ($query =~ /\//) {
	279	# 209.91.179/26 should show all /26 subnets in 209.91.179
	280	my ($net,$maskbits) = split /\//, $query;
	281	if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
	282	# /0->/9 are silly to worry about right now. I don't think
	283	# we'll be getting a class A anytime soon. <g>
	284	$sql = "select * from searchme where cidr='$query'";
	285	queryResults($sql, $webvar{page}, 1);
	286	} else {
	287	print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
	288	# Partial match; beginning of subnet and maskbits are provided
	289	$sql = "select * from searchme where text(cidr) like '$net%' and ".
	290	"text(cidr) like '%$maskbits'";
	291	my $count = countRows("select count(*) from ($sql) foo");
	292	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	293	queryResults($sql, $webvar{page}, $count);
	294	}
	295	} elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
	296	# Specific IP address match
	297	print "4-octet pattern found; finding netblock containing IP $query<br>\n";
	298	my ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/);
	299	my $sfor = new NetAddr::IP $query;
	300	$sth = $ip_dbh->prepare("select * from searchme where text(cidr) like '$net%'");
	301	$sth->execute;
	302	while (my @data = $sth->fetchrow_array()) {
	303	my $cidr = new NetAddr::IP $data[0];
	304	if ($cidr->contains($sfor)) {
	305	queryResults("select * from searchme where cidr='$cidr'", $webvar{page}, 1);
	306	}
	307	}
	308	} elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
	309	print "Finding matches where the first three octets are $query<br>\n";
	310	$sql = "select * from searchme where text(cidr) like '$query%'";
	311	my $count = countRows("select count(*) from ($sql) foo");
	312	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	313	queryResults($sql, $webvar{page}, $count);
	314	} else {
	315	# This shouldn't happen, but if it does, whoever gets it deserves what they get...
	316	printAndExit("Invalid query.");
	317	}
	318	} else {
	319	# This shouldn't happen, but if it does, whoever gets it deserves what they get...
	320	printAndExit("Invalid searchfor.");
	321	}
	322	} # viewBy
	323
[9]	324
[4]	325	# args are: a reference to an array with the row to be printed and the
	326	# class(stylesheet) to use for formatting.
	327	# if ommitting the class - call the sub as &printRow(\@array)
	328	sub printRow {
	329	my ($rowRef,$class) = @_;
	330
	331	if (!$class) {
	332	print "<tr>\n";
	333	} else {
	334	print "<tr class=\"$class\">\n";
	335	}
	336
	337	foreach my $element (@$rowRef) {
	338	print "<td></td>" if (!defined($element));
	339	$element =~ s\|\n\|</br>\|g;
	340	print "<td>$element</td>\n";
	341	}
	342	print "</tr>";
	343	} # printRow
	344
	345
	346	# Display certain types of search query. Note that this can't be
	347	# cleanly reused much of anywhere else as the data isn't neatly tabulated.
	348	# This is tied to the search sub tightly enough I may just gut it and provide
	349	# more appropriate tables directly as needed.
	350	sub queryResults($$$) {
	351	my ($sql, $pageNo, $rowCount) = @_;
	352	my $offset = 0;
	353	$offset = $1 if($sql =~ m/.limit\s+(.),.*/);
	354
	355	my $sth = $ip_dbh->prepare($sql);
	356	$sth->execute();
	357
	358	startTable('Allocation','CustID','Type','City','Description/Name');
	359	my $count = 0;
	360
	361	while (my @data = $sth->fetchrow_array) {
	362	# cidr,custid,type,city,description,notes
	363	# Fix up types from pools (which are single-char)
	364	# Fixing the database would be... painful. :(
[97]	365	if ($data[2] =~ /^[cdsmw]$/) {
[4]	366	$data[2] .= 'i';
	367	}
	368	my @row = (qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
[98]	369	$data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
[4]	370	# Allow listing of pool if desired/required.
[97]	371	if ($data[2] =~ /^[cdsmw]p$/) {
[4]	372	$row[0] .= '   <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	373	"&pool=$data[0]\">List IPs</a>";
	374	}
	375	printRow(\@row, 'color1', 1) if ($count%2==0);
	376	printRow(\@row, 'color2', 1) if ($count%2!=0);
	377	$count++;
	378	}
	379
	380	# Have to think on this call, it's primarily to clean up unfetched rows from a select.
	381	# In this context it's probably a good idea.
	382	$sth->finish();
	383
	384	my $upper = $offset+$count;
	385	print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: $offset - $upper</i></td></tr>\n";
	386	print "</table></center>\n";
	387
	388	# print the page thing..
	389	if ($rowCount > $RESULTS_PER_PAGE) {
	390	my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
	391	print qq(<div class="center"> Page: );
	392	for (my $i = 1; $i <= $pages; $i++) {
	393	if ($i == $pageNo) {
	394	print "<b>$i </b>\n";
	395	} else {
[53]	396	print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}&action=search&searchfor=$webvar{searchfor}">$i</a> \n);
[4]	397	}
	398	}
	399	print "</div>";
	400	}
	401	} # queryResults
	402
	403
	404	# Prints table headings. Accepts any number of arguments;
	405	# each argument is a table heading.
	406	sub startTable {
	407	print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
	408
	409	foreach(@_) {
	410	print qq(<td class="heading">$_</td>);
	411	}
	412	print "</tr>\n";
	413	} # startTable
	414
	415
	416	# Return first element of passed SQL query
	417	sub countRows($) {
	418	my $sth = $ip_dbh->prepare($_[0]);
	419	$sth->execute();
	420	my @a = $sth->fetchrow_array();
	421	$sth->finish();
	422	return $a[0];
	423	}
	424
	425
	426	# Initial display: Show master blocks with total allocated subnets, total free subnets
	427	sub showSummary
	428	{
	429	print "Content-type: text/html\n\n";
	430
	431	startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
	432	'Free netblocks', 'Largest free block');
	433
	434	# Snag the allocations.
	435	# I think it's too confusing to leave out internal allocations.
	436	$sth = $ip_dbh->prepare("select * from allocations");
	437	$sth->execute();
	438	while (my @data = $sth->fetchrow_array()) {
	439	# cidr,custid,type,city,description
	440	# We only need the cidr
	441	my $cidr = new NetAddr::IP $data[0];
	442	foreach my $master (@masterblocks) {
	443	if ($master->contains($cidr)) {
	444	$allocated{"$master"}++;
	445	}
	446	}
	447	}
	448
	449	# Snag routed blocks
	450	$sth = $ip_dbh->prepare("select * from routed");
	451	$sth->execute();
	452	while (my @data = $sth->fetchrow_array()) {
	453	# cidr,maskbits,city
	454	# We only need the cidr
	455	my $cidr = new NetAddr::IP $data[0];
	456	foreach my $master (@masterblocks) {
	457	if ($master->contains($cidr)) {
	458	$routed{"$master"}++;
	459	}
	460	}
	461	}
	462
	463	# Snag the free blocks.
	464	$sth = $ip_dbh->prepare("select * from freeblocks");
	465	$sth->execute();
	466	while (my @data = $sth->fetchrow_array()) {
	467	# cidr,maskbits,city
	468	# We only need the cidr
	469	my $cidr = new NetAddr::IP $data[0];
	470	foreach my $master (@masterblocks) {
	471	if ($master->contains($cidr)) {
	472	$free{"$master"}++;
	473	if ($cidr->masklen < $bigfree{"$master"}) { $bigfree{"$master"} = $cidr->masklen; }
	474	}
	475	}
	476	}
	477
	478	# Print the data.
	479	my $count=0;
	480	foreach my $master (@masterblocks) {
	481	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
	482	$routed{"$master"}, $allocated{"$master"}, $free{"$master"},
	483	( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) )
	484	);
	485
	486	printRow(\@row, 'color1' ) if($count%2==0);
	487	printRow(\@row, 'color2' ) if($count%2!=0);
	488	$count++;
	489	}
	490	print "</table>\n";
	491	print qq(<a href="/ip/addmaster.shtml">Add new master block</a><br><br>\n);
	492	print "Note: Free blocks noted here include both routed and unrouted blocks.\n";
	493
	494	# Because of the way this sub gets called, we don't need to print the footer here.
	495	# (index.shtml makes an SSI #include call to cgi-bin/main.cgi?action=index)
	496	# If we do, the footer comes in twice...
	497	#printFooter;
	498	} # showSummary
	499
	500
	501	# Display detail on master
	502	# Alrighty then! We're showing routed blocks within a single master this time.
	503	# We should be able to steal code from showSummary(), and if I'm really smart
	504	# I'll figger a way to munge the two together. (Once I've done that, everything
	505	# else should follow. YMMV.)
	506	sub showMaster {
	507	printHeader('');
	508
	509	print qq(<center><div class="heading">Summarizing routed blocks for ).
	510	qq($webvar{block}:</div></center><br>\n);
	511
	512	my $master = new NetAddr::IP $webvar{block};
	513	my @localmasters;
	514
	515	$sth = $ip_dbh->prepare("select * from routed order by cidr");
	516	$sth->execute();
	517
	518	my $i=0;
	519	while (my @data = $sth->fetchrow_array()) {
	520	my $cidr = new NetAddr::IP $data[0];
	521	if ($master->contains($cidr)) {
	522	$localmasters[$i++] = $cidr;
	523	$free{"$cidr"} = 0;
	524	$allocated{"$cidr"} = 0;
	525	# Retain the routing destination
	526	$routed{"$cidr"} = $data[2];
	527	}
	528	}
	529
	530	# Check if there were actually any blocks routed from this master
	531	if ($i > 0) {
	532	startTable('Routed block','Routed to','Allocated blocks',
	533	'Free blocks','Largest free block');
	534
	535	# Count the allocations
	536	$sth = $ip_dbh->prepare("select * from allocations");
	537	$sth->execute();
	538	while (my @data = $sth->fetchrow_array()) {
	539	# cidr,custid,type,city,description
	540	# We only need the cidr
	541	my $cidr = new NetAddr::IP $data[0];
	542	foreach my $master (@localmasters) {
	543	if ($master->contains($cidr)) {
	544	$allocated{"$master"}++;
	545	}
	546	}
	547	}
	548
	549	# initialize bigfree base points
	550	foreach my $lmaster (@localmasters) {
	551	$bigfree{"$lmaster"} = 128;
	552	}
	553
	554	# Snag the free blocks.
	555	$sth = $ip_dbh->prepare("select * from freeblocks");
	556	$sth->execute();
	557	while (my @data = $sth->fetchrow_array()) {
	558	# cidr,maskbits,city
	559	# We only need the cidr
	560	my $cidr = new NetAddr::IP $data[0];
	561	foreach my $lmaster (@localmasters) {
	562	if ($lmaster->contains($cidr)) {
	563	$free{"$lmaster"}++;
	564	if ($cidr->masklen < $bigfree{"$lmaster"}) {
	565	$bigfree{"$lmaster"} = $cidr->masklen;
	566	}
	567	}
	568	# check for largest free block
	569	}
	570	}
	571
	572	# Print the data.
	573	my $count=0;
	574	foreach my $master (@localmasters) {
	575	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
	576	$routed{"$master"}, $allocated{"$master"},
	577	$free{"$master"},
	578	( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) )
	579	);
	580	printRow(\@row, 'color1' ) if($count%2==0);
	581	printRow(\@row, 'color2' ) if($count%2!=0);
	582	$count++;
	583	}
	584	} else {
	585	# If a master block has no routed blocks, then by definition it has no
	586	# allocations, and can be deleted.
	587	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	588	qq($master.</div>\n).
	589	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	590	qq(<input type=hidden name=action value="delete">\n).
	591	qq(<input type=hidden name=block value="$master">\n).
	592	qq(<input type=hidden name=alloctype value="mm">\n).
	593	qq(<input type=submit value=" Remove this master ">\n).
	594	qq(</form></center>\n);
	595
	596	} # end check for existence of routed blocks in master
	597
	598	print qq(</table>\n<hr width="60%">\n).
	599	qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
	600
	601	startTable('Netblock','Range');
	602
	603	# Snag the free blocks.
	604	my $count = 0;
	605	$sth = $ip_dbh->prepare("select * from freeblocks where routed='n' order by cidr");
	606	$sth->execute();
	607	while (my @data = $sth->fetchrow_array()) {
	608	# cidr,maskbits,city
	609	# We only need the cidr
	610	my $cidr = new NetAddr::IP $data[0];
	611	if ($master->contains($cidr)) {
	612	my @row = ("$cidr", $cidr->range);
	613	printRow(\@row, 'color1' ) if($count%2==0);
	614	printRow(\@row, 'color2' ) if($count%2!=0);
	615	$count++;
	616	}
	617	}
	618
	619	print "</table>\n";
	620	printFooter;
	621	} # showMaster
	622
	623
	624	# Display details of a routed block
	625	# Alrighty then! We're showing allocations within a routed block this time.
	626	# We should be able to steal code from showSummary() and showMaster(), and if
	627	# I'm really smart I'll figger a way to munge all three together. (Once I've
	628	# done that, everything else should follow. YMMV.
	629	# This time, we check the database before spewing, because we may
	630	# not have anything useful to spew.
	631	sub showRBlock {
	632	printHeader('');
	633
	634	my $master = new NetAddr::IP $webvar{block};
	635
	636	$sth = $ip_dbh->prepare("select * from routed where cidr='$master'");
	637	$sth->execute;
	638	my @data = $sth->fetchrow_array;
	639
	640	print qq(<center><div class="heading">Summarizing allocated blocks for ).
	641	qq($master ($data[2]):</div></center><br>\n);
	642
	643	$sth = $ip_dbh->prepare("select * from allocations order by cidr");
	644	$sth->execute();
	645
	646	startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
	647
	648	my $count=0;
	649	while (my @data = $sth->fetchrow_array()) {
	650	# cidr,custid,type,city,description,notes,maskbits
	651	my $cidr = new NetAddr::IP $data[0];
	652	if (!$master->contains($cidr)) { next; }
	653
	654	# Clean up extra spaces that are borking things.
	655	$data[2] =~ s/\s+//g;
	656
	657	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=edit&block=$data[0]\">$data[0]</a>",
[98]	658	$data[3], $disp_alloctypes{$data[2]}, $data[1], $data[4]);
[4]	659	# If the allocation is a pool, allow listing of the IPs in the pool.
[97]	660	if ($data[2] =~ /^[cdsmw]p$/) {
[4]	661	$row[0] .= '   <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	662	"&pool=$data[0]\">List IPs</a>";
	663	}
	664
	665	printRow(\@row, 'color1') if ($count%2 == 0);
	666	printRow(\@row, 'color2') if ($count%2 != 0);
	667	$count++;
	668	}
	669
	670	print "</table>\n";
	671
	672	# If the routed block has no allocations, by definition it only has
	673	# one free block, and therefore may be deleted.
	674	if ($count == 0) {
	675	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	676	qq($master.</div></center>\n).
	677	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	678	qq(<input type=hidden name=action value="delete">\n).
	679	qq(<input type=hidden name=block value="$master">\n).
	680	qq(<input type=hidden name=alloctype value="rr">\n).
	681	qq(<input type=submit value=" Remove this block ">\n).
	682	qq(</form>\n);
	683	}
	684
	685	print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
	686	qq(submaster $master</div></center>\n);
	687
	688	startTable('CIDR block','Range');
	689
	690	# Snag the free blocks. We don't really need to be pedantic about avoiding
	691	# unrouted free blocks, but it's better to let the database do the work if we can.
	692	$count = 0;
	693	$sth = $ip_dbh->prepare("select * from freeblocks where routed='y' order by cidr");
	694	$sth->execute();
	695	while (my @data = $sth->fetchrow_array()) {
	696	# cidr,maskbits,city
	697	my $cidr = new NetAddr::IP $data[0];
	698	if ($master->contains($cidr)) {
[24]	699	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=assign&block=$cidr\">$cidr</a>",
	700	$cidr->range);
[4]	701	printRow(\@row, 'color1') if ($count%2 == 0);
	702	printRow(\@row, 'color2') if ($count%2 != 0);
	703	$count++;
	704	}
	705	}
	706
	707	print "</table>\n";
	708	printFooter;
	709	} # showRBlock
	710
	711
	712	# List the IPs used in a pool
	713	sub listPool {
	714	printHeader('');
	715
	716	my $cidr = new NetAddr::IP $webvar{pool};
	717
	718	# Snag pool info for heading
	719	$sth = $ip_dbh->prepare("select * from allocations where cidr='$cidr'");
	720	$sth->execute;
	721	my @data = $sth->fetchrow_array;
	722	my $type = $data[2]; # We'll need this later.
	723
	724	print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
[98]	725	qq(($disp_alloctypes{$type} in $data[3])</div></center><br>\n);
[4]	726	print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
	727	print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
	728	$cidr->addr."</td></tr>\n";
	729	$cidr++;
	730	print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
	731	$cidr--; $cidr--;
	732	print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
	733	"<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
	734	"</table></div></div>\n";
	735
	736	# probably have to add an "edit IP allocation" link here somewhere.
	737
	738	startTable('IP','Customer ID','Available?','Description','');
	739	$sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{pool}' order by ip");
	740	$sth->execute;
	741	my $count = 0;
	742	while (my @data = $sth->fetchrow_array) {
[75]	743	# pool,ip,custid,city,ptype,available,notes,description,circuitid
[4]	744	# If desc is null, make it not null. <g>
	745	if ($data[7] eq '') {
	746	$data[7] = ' ';
	747	}
	748	# Some nice hairy Perl to decide whether to allow unassigning each IP
	749	# -> if $data[5] (aka poolips.available) == 'n' then we print the unassign link
	750	# else we print a blank space
	751	my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[1]">$data[1]</a>),
	752	$data[2],$data[5],$data[7],
	753	( ($data[5] eq 'n') ?
	754	("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[1]&".
	755	"alloctype=$data[4]i\">Unassign this IP</a>") :
	756	(" ") )
	757	);
	758	printRow(\@row, 'color1') if($count%2==0);
	759	printRow(\@row, 'color2') if($count%2!=0);
	760	$count++;
	761	}
	762	print "</table>\n";
	763
	764	printFooter;
	765	} # end listPool
	766
	767
	768	# Should this maybe just be a full static page? It just spews out some predefined HTML.
	769	sub assignBlock {
	770	printHeader('');
	771
[24]	772	my $html;
	773
	774	# New special case- block to assign is specified
	775	if ($webvar{block} ne '') {
	776	open HTML, "../fb-assign.html"
	777	or croak "Could not open fb-assign.html: $!";
	778	$html = join('',<HTML>);
	779	close HTML;
	780	my $block = new NetAddr::IP $webvar{block};
	781	$html =~ s\|\$\$BLOCK\$\$\|$block\|g;
	782	$html =~ s\|\$\$MASKBITS\$\$\|$block->masklen\|;
[98]	783	my $typelist = '';
	784	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 and type not like '_i' order by listorder");
	785	$sth->execute;
	786	my @data = $sth->fetchrow_array;
	787	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	788	while (my @data = $sth->fetchrow_array) {
	789	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	790	}
	791	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[24]	792	} else {
	793	open HTML, "../assign.html"
[4]	794	or croak "Could not open assign.html: $!";
[24]	795	$html = join('',<HTML>);
[91]	796	close HTML;
[32]	797	my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
	798	foreach my $master (@masterblocks) {
	799	$masterlist .= "<option>$master</option>\n";
	800	}
	801	$masterlist .= "</select>\n";
	802	$html =~ s\|\$\$MASTERLIST\$\$\|$masterlist\|g;
[91]	803	my $pops = '';
	804	foreach my $pop (@poplist) {
	805	$pops .= "<option>$pop</option>\n";
	806	}
	807	$html =~ s\|\$\$POPLIST\$\$\|$pops\|g;
[98]	808	my $typelist = '';
	809	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
	810	$sth->execute;
	811	my @data = $sth->fetchrow_array;
	812	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	813	while (my @data = $sth->fetchrow_array) {
	814	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	815	}
	816	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[24]	817	}
[91]	818	my $cities = '';
	819	foreach my $city (@citylist) {
	820	$cities .= "<option>$city</option>\n";
	821	}
	822	$html =~ s\|\$\$ALLCITIES\$\$\|$cities\|g;
[4]	823
	824	print $html;
	825
	826	printFooter();
	827	} # assignBlock
	828
	829
	830	# Take info on requested IP assignment and see what we can provide.
	831	sub confirmAssign {
	832	printHeader('');
	833
	834	my $cidr;
	835	my $alloc_from;
	836
	837	# Going to manually validate some items.
	838	# custid and city are automagic.
	839	validateInput();
	840
	841	# This isn't always useful.
	842	# if (!$webvar{maskbits}) {
	843	# printAndExit("Please enter a CIDR block length.");
	844	# }
	845
	846	# Several different cases here.
	847	# Static IP vs netblock
	848	# + Different flavours of static IP
	849	# + Different flavours of netblock
	850
[97]	851	if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
[4]	852	my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
	853	my $sql;
	854	# Check for pools in Subury or North Bay if DSL or server pool. Anywhere else is
	855	# invalid and shouldn't be in the db in the first place.
	856	# ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
	857	# Note that we want to retain the requested city to relate to customer info.
	858	if ($base =~ /^[ds]$/) {
	859	$sql = "select * from poolips where available='y' and".
[43]	860	" ptype='$base' and (city='Sudbury' or city='North Bay')";
[4]	861	} else {
	862	## $city doesn't seem to get defined here.
	863	my $city; # Shut up Perl's "strict" scoping/usage check.
	864	$sql = "select * from poolips where available='y' and".
[86]	865	" ptype='$base' and city='$webvar{pop}'";
[4]	866	}
	867
	868	# Now that we know where we're looking, we can list the pools with free IPs.
	869	$sth = $ip_dbh->prepare($sql);
	870	$sth->execute;
	871	my %ipcount;
	872	my $optionlist;
	873	while (my @data = $sth->fetchrow_array) {
	874	$ipcount{$data[0]}++;
	875	}
[86]	876	$sth = $ip_dbh->prepare("select city from allocations where cidr=?");
[4]	877	foreach my $key (keys %ipcount) {
[86]	878	$sth->execute($key);
	879	my @data = $sth->fetchrow_array;
	880	$optionlist .= "<option value='$key'>$key [$ipcount{$key} free IP(s)] in $data[0]</option>\n";
[4]	881	}
	882	$cidr = "Single static IP";
	883	$alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
	884
	885	} else { # end show pool options
[24]	886
	887	if ($webvar{fbassign} eq 'y') {
	888	$cidr = new NetAddr::IP $webvar{block};
	889	$webvar{maskbits} = $cidr->masklen;
	890	} else { # done with direct freeblocks assignment
	891
	892	if (!$webvar{maskbits}) {
	893	printAndExit("Please specify a CIDR mask length.");
	894	}
	895	my $sql;
	896	my $city;
	897	my $failmsg;
	898	if ($webvar{alloctype} eq 'rr') {
[32]	899	if ($webvar{allocfrom} ne '-') {
	900	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
	901	" and cidr <<= '$webvar{allocfrom}' order by maskbits desc";
	902	} else {
	903	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
	904	" order by maskbits desc";
	905	}
[24]	906	$failmsg = "No suitable free block found.<br>\nWe do not have a free".
	907	" routeable block of that size.<br>\nYou will have to either route".
	908	" a set of smaller netblocks or a single smaller netblock.";
[4]	909	} else {
[97]	910	if ($webvar{alloctype} =~ /^[cdsmw]p$/) {
[24]	911	if (($webvar{city} !~ /^(Sudbury\|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
	912	printAndExit("You must chose Sudbury or North Bay for DSL pools."); }
[39]	913	$city = $webvar{city};
[24]	914	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
	915	" superblock <br>\nfrom one of the master blocks in Sudbury or chose a smaller".
	916	" block size for the pool.";
	917	} else {
	918	$city = $webvar{pop};
	919	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[101]	920	" superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
[24]	921	" chose a smaller blocksize.";
	922	}
[32]	923	if ($webvar{allocfrom} ne '-') {
	924	$sql = "select * from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
	925	" and cidr <<= '$webvar{allocfrom}' and routed='y' order by cidr,maskbits desc";
	926	} else {
	927	$sql = "select * from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
	928	" and routed='y' order by cidr,maskbits desc";
	929	}
[4]	930	}
[24]	931	$sth = $ip_dbh->prepare($sql);
	932	$sth->execute;
	933	my @data = $sth->fetchrow_array();
	934	if ($data[0] eq "") {
	935	printAndExit($failmsg);
	936	}
	937	$cidr = new NetAddr::IP $data[0];
	938	} # check for freeblocks assignment or IPDB-controlled assignment
[4]	939
	940	$alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
	941
	942	# If the block to be allocated is smaller than the one we found,
	943	# figure out the "real" block to be allocated.
	944	if ($cidr->masklen() ne $webvar{maskbits}) {
	945	my $maskbits = $cidr->masklen();
	946	my @subblocks;
	947	while ($maskbits++ < $webvar{maskbits}) {
	948	@subblocks = $cidr->split($maskbits);
	949	}
	950	$cidr = $subblocks[0];
	951	}
[97]	952	} # if ($webvar{alloctype} =~ /^[cdsmw]i$/)
[4]	953
	954	open HTML, "../confirm.html"
	955	or croak "Could not open confirm.html: $!";
	956	my $html = join '', <HTML>;
	957	close HTML;
	958
	959	### gotta fix this in final
	960	# Stick in customer info as necessary - if it's blank, it just ends
	961	# up as blank lines ignored in the rendering of the page
	962	my $custbits;
	963	$html =~ s\|\$\$CUSTBITS\$\$\|$custbits\|g;
	964	###
	965
	966	# Stick in the allocation data
	967	$html =~ s\|\$\$ALLOC_TYPE\$\$\|$webvar{alloctype}\|g;
[98]	968	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$webvar{alloctype}}\|g;
[4]	969	$html =~ s\|\$\$ALLOC_FROM\$\$\|$alloc_from\|g;
	970	$html =~ s\|\$\$CIDR\$\$\|$cidr\|g;
[82]	971	$webvar{city} = desanitize($webvar{city});
[4]	972	$html =~ s\|\$\$CITY\$\$\|$webvar{city}\|g;
	973	$html =~ s\|\$\$CUSTID\$\$\|$webvar{custid}\|g;
[83]	974	$webvar{circid} = desanitize($webvar{circid});
[75]	975	$html =~ s\|\$\$CIRCID\$\$\|$webvar{circid}\|g;
[4]	976	$webvar{desc} = desanitize($webvar{desc});
[89]	977	$html =~ s\|\$\$DESC\$\$\|$webvar{desc}\|g;
[4]	978	$webvar{notes} = desanitize($webvar{notes});
	979	$html =~ s\|\$\$NOTES\$\$\|$webvar{notes}\|g;
	980	$html =~ s\|\$\$ACTION\$\$\|insert\|g;
	981
	982	print $html;
	983
	984	printFooter;
	985	} # end confirmAssign
	986
	987
	988	# Do the work of actually inserting a block in the database.
	989	sub insertAssign {
	990	# Some things are done more than once.
	991	printHeader('');
	992	validateInput();
	993
	994	# Set some things that may be needed
	995	# Don't set $cidr here as it may not even be a valid IP address.
	996	my $alloc_from = new NetAddr::IP $webvar{alloc_from};
	997
	998	# dynDSL (dy), sIP DSL(dp), and server pools (sp) are nominally allocated to Sudbury
	999	# no matter what else happens.
	1000	# if ($webvar{alloctype} =~ /^([sd]p\|dy)$/) { $webvar{city} = "Sudbury"; }
	1001	# OOPS. forgot about North Bay DSL.
	1002	#### Gotta make this cleaner and more accurate
	1003	# if ($webvar{alloctype} eq "sp") { $webvar{city} = "Sudbury"; }
	1004
	1005	# Same ordering as confirmation page
	1006
[97]	1007	if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
[4]	1008	my ($base,$tmp) = split //, $webvar{alloctype}; # split into individual chars
	1009
	1010	# We'll just have to put up with the oddities caused by SQL (un)sort order
	1011	$sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{alloc_from}'".
[41]	1012	" and available='y' order by ip");
[4]	1013	$sth->execute;
	1014
	1015	my @data = $sth->fetchrow_array;
	1016	my $cidr = $data[1];
	1017
[48]	1018	$sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',".
[75]	1019	"city='$webvar{city}',available='n',description='$webvar{desc}',".
	1020	"circuitid='$webvar{circid}'".
[4]	1021	" where ip='$cidr'");
	1022	$sth->execute;
	1023	if ($sth->err) {
[17]	1024	syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser failed: ".
[4]	1025	"'".$sth->errstr."'";
[48]	1026	printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
[4]	1027	}
	1028	print qq(<div class="center"><div class="heading">The IP $cidr has been allocated to customer $webvar{custid}</div></div>);
	1029	syslog "notice", "$authuser allocated $cidr to $webvar{custid}";
[71]	1030	# Notify tech@example.com
[98]	1031	mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
[104]	1032	"$disp_alloctypes{$webvar{alloctype}} $cidr allocated to customer $webvar{custid}\n".
	1033	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[4]	1034
	1035	} else { # end IP-from-pool allocation
	1036
	1037	# Set $cidr here as it may not be a valid IP address elsewhere.
	1038	my $cidr = new NetAddr::IP $webvar{fullcidr};
	1039
	1040	# Allow transactions, and make errors much easier to catch.
	1041	# Much as I would like to error-track specifically on each ->execute,
[64]	1042	# that's a LOT of code, and some SQL blocks MUST be atomic at a
	1043	# multi-statement level. :/
	1044	local $ip_dbh->{AutoCommit} = 0; # These need to be local so we don't
	1045	local $ip_dbh->{RaiseError} = 1; # step on our toes by accident.
[4]	1046
	1047	if ($webvar{fullcidr} eq $webvar{alloc_from}) {
	1048	# Easiest case- insert in one table, delete in the other, and go home. More or less.
	1049	# insert into allocations values (cidr,custid,type,city,desc) and
	1050	# delete from freeblocks where cidr='cidr'
	1051	# For data safety on non-transaction DBs, we delete first.
	1052
	1053	eval {
	1054	if ($webvar{alloctype} eq 'rr') {
	1055	$sth = $ip_dbh->prepare("update freeblocks set routed='y',city='$webvar{city}'".
	1056	" where cidr='$webvar{fullcidr}'");
	1057	$sth->execute;
	1058	$sth = $ip_dbh->prepare("insert into routed values ('$webvar{fullcidr}',".
	1059	$cidr->masklen.",'$webvar{city}')");
	1060	$sth->execute;
	1061	} else {
	1062	# common stuff for end-use, dialup, dynDSL, pools, etc, etc.
	1063
	1064	# city has to be reset for DSL/server pools; nominally to Sudbury.
	1065	## Gotta rethink this; DSL pools can be in North Bay as well. :/
	1066	#if ($webvar{alloctype} =~ /^[sd]p$/) { $webvar{city} = 'Sudbury'; }
	1067
	1068	$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{fullcidr}'");
	1069	$sth->execute;
	1070
	1071	$sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
	1072	"'$webvar{custid}','$webvar{alloctype}','$webvar{city}','$webvar{desc}',".
[75]	1073	"'$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
[4]	1074	$sth->execute;
	1075	} # routing vs non-routing netblock
	1076	$ip_dbh->commit;
	1077	}; # end of eval
	1078	if ($@) {
	1079	carp "Transaction aborted because $@";
	1080	eval { $ip_dbh->rollback; };
[17]	1081	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
[4]	1082	"'$webvar{alloctype}' by $authuser failed: '$@'";
[98]	1083	printAndExit("Allocation of $cidr as $disp_alloctypes{$webvar{alloctype}} failed.\n");
[4]	1084	}
	1085
	1086	# If we get here, the DB transaction has succeeded.
	1087	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
	1088
	1089	# How to log SQL without munging too many error-checking wrappers in?
	1090	# syslog "info", "
	1091	# We don't. GRRR.
	1092
	1093	} else { # webvar{fullcidr} != webvar{alloc_from}
	1094	# Hard case. Allocation is smaller than free block.
	1095	my $wantmaskbits = $cidr->masklen;
	1096	my $maskbits = $alloc_from->masklen;
	1097
	1098	my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
	1099
	1100	my $i=0;
	1101	while ($maskbits++ < $wantmaskbits) {
	1102	my @subblocks = $alloc_from->split($maskbits);
	1103	$newfreeblocks[$i++] = $subblocks[1];
	1104	} # while
	1105
	1106	# Begin SQL transaction block
	1107	eval {
	1108	# Delete old freeblocks entry
	1109	$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{alloc_from}'");
	1110	$sth->execute();
	1111
	1112	# now we have to do some magic for routing blocks
	1113	if ($webvar{alloctype} eq 'rr') {
	1114	# Insert the new freeblocks entries
	1115	# Note that non-routed blocks are assigned to <NULL>
	1116	$sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
	1117	foreach my $block (@newfreeblocks) {
	1118	$sth->execute("$block", $block->masklen);
	1119	}
	1120	# Insert the entry in the routed table
	1121	$sth = $ip_dbh->prepare("insert into routed values ('$cidr',".
	1122	$cidr->masklen.",'$webvar{city}')");
	1123	$sth->execute;
	1124	# Insert the (almost) same entry in the freeblocks table
	1125	$sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".
	1126	$cidr->masklen.",'$webvar{city}','y')");
	1127	$sth->execute;
	1128
	1129	} else { # done with alloctype == rr
	1130
	1131	# Insert the new freeblocks entries
[101]	1132	$sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, (select city from routed where cidr >> '$cidr'),'y')");
[4]	1133	foreach my $block (@newfreeblocks) {
[101]	1134	$sth->execute("$block", $block->masklen);
[4]	1135	}
	1136	# Insert the allocations entry
	1137	$sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
	1138	"'$webvar{custid}','$webvar{alloctype}','$webvar{city}',".
[75]	1139	"'$webvar{desc}','$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
[4]	1140	$sth->execute;
	1141	} # done with netblock alloctype != rr
	1142	$ip_dbh->commit;
	1143	}; # end eval
	1144	if ($@) {
	1145	carp "Transaction aborted because $@";
	1146	eval { $ip_dbh->rollback; };
[17]	1147	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
[4]	1148	"'$webvar{alloctype}' by $authuser failed: '$@'";
[98]	1149	printAndExit("Allocation of $cidr as $disp_alloctypes{$webvar{alloctype}} failed.\n");
[4]	1150	}
	1151	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
	1152
	1153	} # end fullcidr != alloc_from
	1154
	1155	# Begin SQL transaction block
	1156	eval {
	1157	# special extra handling for pools.
	1158	# Note that this must be done for ANY pool allocation!
[97]	1159	if ( my ($pooltype) = ($webvar{alloctype} =~ /^([cdsmw])p$/) ) {
[4]	1160	# have to insert all pool IPs into poolips table as "unallocated".
	1161	$sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
[75]	1162	" ?, '6750400', '$webvar{city}', '$pooltype', 'y', '', '', '')");
[4]	1163	my @poolip_list = $cidr->hostenum;
	1164	for (my $i=1; $i<=$#poolip_list; $i++) {
	1165	$sth->execute($poolip_list[$i]->addr);
	1166	}
	1167	} # end pool special
	1168	$ip_dbh->commit;
	1169	}; # end eval
	1170	if ($@) {
	1171	carp "Transaction aborted because $@";
	1172	eval { $ip_dbh->rollback; };
[17]	1173	syslog "err", "Initialization of pool '$webvar{fullcidr}' by $authuser failed: '$@'";
[98]	1174	printAndExit("$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} not completely initialized.");
[4]	1175	}
[98]	1176	syslog "notice", "$disp_alloctypes{$webvar{alloctype}} '$webvar{fullcidr}' successfully initialized by $authuser";
[4]	1177
[98]	1178	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was sucessfully added as type '$webvar{alloctype}' ($disp_alloctypes{$webvar{alloctype}})</div></div>);
[4]	1179
	1180	} # end static-IP vs netblock allocation
	1181
	1182	printFooter();
	1183	} # end insertAssign()
	1184
	1185
	1186	# Does some basic checks on common input data to make sure nothing
	1187	# really weird gets in to the database through this script.
	1188	# Does NOT do complete input validation!!!
	1189	sub validateInput {
	1190	if ($webvar{city} eq '-') {
	1191	printAndExit("Please choose a city.");
	1192	}
	1193	chomp $webvar{alloctype};
	1194	# We have different handling for customer allocations and "internal" or "our" allocations
[103]	1195	if ($webvar{alloctype} =~ /^(ci\|di\|cn\|mi\|wi)$/) {
[4]	1196	if (!$webvar{custid}) {
	1197	printAndExit("Please enter a customer ID.");
	1198	}
[82]	1199	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF\|TEMP)(?:-\d\d?)?$/) {
[56]	1200	# Force uppercase for now...
	1201	$webvar{custid} =~ tr/a-z/A-Z/;
	1202	# Crosscheck with ... er... something.
	1203	my $status = CustIDCK->custid_exist($webvar{custid});
	1204	printAndExit("Error verifying customer ID: ".$CustIDCK::ErrMsg)
	1205	if $CustIDCK::Error;
	1206	printAndExit("Customer ID not valid. Make sure the Customer ID ".
	1207	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	1208	"non-customer assignments.")
	1209	if !$status;
	1210	#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
	1211	#static IPs for staff.");
[4]	1212	}
[56]	1213	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[97]	1214	} elsif ($webvar{alloctype} =~ /^([cdsmw]p\|si\|dn\|dy\|dc\|ee\|rr\|ii)$/){
[4]	1215	# All non-customer allocations MUST be entered with "our" customer ID.
	1216	# I have Defined this as 6750400 for consistency.
[56]	1217	# STAFF is also acceptable.
	1218	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
	1219	$webvar{custid} = "6750400";
	1220	}
[4]	1221	if ($webvar{alloctype} eq 'rr') {
[100]	1222	my $flag;
	1223	foreach (@poplist) {
	1224	if (/^$webvar{city}$/) {
	1225	$flag = 'y'; last;
	1226	}
	1227	}
	1228	if (!$flag) {
[4]	1229	printAndExit("Please choose a valid POP location for a routed netblock. Valid ".
[100]	1230	"POP locations are currently:<br>\n".join (" - ", @poplist));
[4]	1231	}
	1232	}
	1233	} else {
	1234	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	1235	# managing to call things in such a way as to cause this deserves a cryptic error.
	1236	printAndExit("Invalid alloctype");
	1237	}
	1238	return 0;
	1239	} # end validateInput
	1240
	1241
	1242	# Displays details of a specific allocation in a form
	1243	# Allows update/delete
	1244	# action=edit
	1245	sub edit {
	1246	printHeader('');
	1247
	1248	my $sql;
	1249
	1250	# Two cases: block is a netblock, or block is a static IP from a pool
	1251	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	1252	if ($webvar{block} =~ /\/32$/) {
[75]	1253	$sql = "select ip,custid,ptype,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
[4]	1254	} else {
[75]	1255	$sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
[4]	1256	}
	1257
	1258	# gotta snag block info from db
	1259	$sth = $ip_dbh->prepare($sql);
	1260	$sth->execute;
	1261	my @data = $sth->fetchrow_array;
	1262
	1263	# Clean up extra whitespace on alloc type
	1264	$data[2] =~ s/\s//;
	1265
	1266	# Postfix "i" on pool IP types
[97]	1267	if ($data[2] =~ /^[cdsmw]$/) {
[4]	1268	$data[2] .= "i";
	1269	}
	1270
	1271	open (HTML, "../editDisplay.html")
	1272	or croak "Could not open editDisplay.html :$!";
	1273	my $html = join('', <HTML>);
	1274
	1275	# We can't let the city be changed here; this block is a part of
	1276	# a larger routed allocation and therefore by definition can't be moved.
	1277	# block and city are static.
	1278	##fixme
	1279	# Needs thinking. Have to allow changes to city to correct errors, no?
	1280	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1281	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1282
	1283	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1284	# with the much longer list of allocation types.
	1285	# We'll just show what type of block it is.
	1286
[35]	1287	# this has now been Requested, so here goes.
[4]	1288
[35]	1289	if ($data[2] =~ /^d[nyc]\|cn\|ee\|ii$/) {
	1290	# Block that can be changed
	1291	my $blockoptions = "<select name=alloctype><option".
	1292	(($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option".
	1293	(($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option".
	1294	(($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
	1295	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
	1296	(($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option".
	1297	(($data[2] eq 'ii') ? ' selected' : '') ." value='ii'>Internal netblock</option>\n".
	1298	"</select>\n";
	1299	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1300	} else {
[98]	1301	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
[35]	1302	}
	1303
[4]	1304	# These can be modified, although CustID changes may get ignored.
	1305	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[75]	1306	$html =~ s/\$\$TYPE\$\$/$data[2]/g;
	1307	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1308	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1309	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[4]	1310
	1311	print $html;
	1312
	1313	printFooter();
	1314	} # edit()
	1315
	1316
	1317	# Stuff new info about a block into the db
	1318	# action=update
	1319	sub update {
	1320	printHeader('');
	1321
	1322	# Make sure incoming data is in correct format - custID among other things.
	1323	validateInput;
	1324
	1325	# SQL transaction wrapper
	1326	eval {
	1327	# Relatively simple SQL transaction here.
	1328	my $sql;
[97]	1329	if (my $pooltype = ($webvar{alloctype} =~ /^([cdsmw])i$/) ) {
[75]	1330	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
	1331	"circuitid='$webvar{circid}',description='$webvar{desc}' ".
[4]	1332	"where ip='$webvar{block}'";
	1333	} else {
	1334	$sql = "update allocations set custid='$webvar{custid}',".
[35]	1335	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[75]	1336	"type='$webvar{alloctype}',circuitid='$webvar{circid}' where cidr='$webvar{block}'";
[4]	1337	}
	1338	syslog "debug", $sql;
	1339	$sth = $ip_dbh->prepare($sql);
	1340	$sth->execute;
	1341	$ip_dbh->commit;
	1342	};
	1343	if ($@) {
	1344	carp "Transaction aborted because $@";
	1345	eval { $ip_dbh->rollback; };
[17]	1346	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
[48]	1347	printAndExit("Could not update block/IP $webvar{block}: $@");
[4]	1348	}
	1349
	1350	# If we get here, the operation succeeded.
	1351	syslog "notice", "$authuser updated $webvar{block}";
	1352	open (HTML, "../updated.html")
	1353	or croak "Could not open updated.html :$!";
	1354	my $html = join('', <HTML>);
	1355
	1356	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[89]	1357	$webvar{city} = desanitize($webvar{city});
[4]	1358	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1359	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[98]	1360	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1361	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[89]	1362	$webvar{circid} = desanitize($webvar{circid});
[75]	1363	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[89]	1364	$webvar{desc} = desanitize($webvar{desc});
[4]	1365	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[89]	1366	$webvar{notes} = desanitize($webvar{notes});
[4]	1367	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
	1368
	1369	print $html;
	1370
	1371	printFooter;
	1372	} # update()
	1373
	1374
	1375	# Delete an allocation.
	1376	sub remove
	1377	{
	1378	printHeader('');
	1379	#show confirm screen.
	1380	open HTML, "../confirmRemove.html"
	1381	or croak "Could not open confirmRemove.html :$!";
	1382	my $html = join('', <HTML>);
	1383	close HTML;
	1384
	1385	# Serves'em right for getting here...
	1386	if (!defined($webvar{block})) {
	1387	printAndExit("Error 332");
	1388	}
	1389
[75]	1390	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype);
[4]	1391
	1392	if ($webvar{alloctype} eq 'rr') {
	1393	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1394	$sth->execute();
	1395
	1396	# This feels... extreme.
	1397	croak $sth->errstr() if($sth->errstr());
	1398
	1399	$sth->bind_columns(\$cidr,\$city);
	1400	$sth->execute();
	1401	$sth->fetch \|\| croak $sth->errstr();
	1402	$custid = "N/A";
	1403	$alloctype = $webvar{alloctype};
[75]	1404	$circid = "N/A";
[4]	1405	$desc = "N/A";
	1406	$notes = "N/A";
	1407
	1408	} elsif ($webvar{alloctype} eq 'mm') {
	1409	$cidr = $webvar{block};
	1410	$city = "N/A";
	1411	$custid = "N/A";
	1412	$alloctype = $webvar{alloctype};
[75]	1413	$circid = "N/A";
[4]	1414	$desc = "N/A";
	1415	$notes = "N/A";
[97]	1416	} elsif ($webvar{alloctype} =~ /^[cdsmw]i$/) { # done with alloctype=rr
[4]	1417
	1418	# Unassigning a static IP
[75]	1419	my $sth = $ip_dbh->prepare("select ip,custid,city,ptype,notes,circuitid from poolips".
[4]	1420	" where ip='$webvar{block}'");
	1421	$sth->execute();
	1422	# croak $sth->errstr() if($sth->errstr());
	1423
[75]	1424	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid);
[4]	1425	$sth->fetch() \|\| croak $sth->errstr;
	1426
	1427	$alloctype .="i";
	1428
[97]	1429	} else { # done with alloctype=[cdsmw]i
[4]	1430
[75]	1431	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes from ".
[4]	1432	"allocations where cidr='$webvar{block}'");
	1433	$sth->execute();
	1434	# croak $sth->errstr() if($sth->errstr());
	1435
[75]	1436	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc, \$notes);
	1437	$sth->fetch() \|\| carp $sth->errstr;
[4]	1438	} # end cases for different alloctypes
	1439
	1440	# Munge everything into HTML
	1441	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1442	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[98]	1443	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1444	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1445	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1446	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[75]	1447	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1448	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1449	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1450
	1451	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1452
	1453	# Set the warning text.
[97]	1454	if ($alloctype =~ /^[cdsmw]p$/) {
[4]	1455	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>\|;
	1456	} else {
	1457	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1458	}
	1459
	1460	print $html;
	1461	printFooter;
	1462	} # end edit()
	1463
	1464
	1465	# Delete an allocation. Return it to the freeblocks table; munge
	1466	# data as necessary to keep as few records as possible in freeblocks
	1467	# to prevent weirdness when allocating blocks later.
	1468	# Remove IPs from pool listing if necessary
	1469	sub finalDelete {
	1470	printHeader('');
	1471
	1472	# Enable transactions and exception-on-errors... but only for this sub
	1473	local $ip_dbh->{AutoCommit} = 0;
	1474	local $ip_dbh->{RaiseError} = 1;
	1475
[97]	1476	if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
[4]	1477
	1478	eval {
	1479	$sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
	1480	$sth->execute;
	1481	my @data = $sth->fetchrow_array;
	1482	$sth = $ip_dbh->prepare("select city from allocations where cidr='$data[0]'");
	1483	$sth->execute;
	1484	@data = $sth->fetchrow_array;
	1485	$sth = $ip_dbh->prepare("update poolips set custid='6750400', available='y',".
[48]	1486	" city='$data[0]', description='' where ip='$webvar{block}'");
[4]	1487	$sth->execute;
	1488	$ip_dbh->commit;
	1489	};
	1490	if ($@) {
	1491	carp "Transaction aborted because $@";
	1492	eval { $ip_dbh->rollback; };
[17]	1493	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$@'";
[48]	1494	printAndExit("Could not deallocate static IP $webvar{block}: $@");
[4]	1495	}
	1496	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
	1497	syslog "notice", "$authuser deallocated static IP $webvar{block}";
	1498
[97]	1499	} elsif ($webvar{alloctype} eq 'mm') { # end alloctype = [cdsmw]i
[4]	1500
	1501	eval {
	1502	$sth = $ip_dbh->prepare("delete from masterblocks where cidr='$webvar{block}'");
	1503	$sth->execute;
	1504	$sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{block}'");
	1505	$sth->execute;
	1506	$ip_dbh->commit;
	1507	};
	1508	if ($@) {
	1509	carp "Transaction aborted because $@";
	1510	eval { $ip_dbh->rollback; };
[17]	1511	syslog "err", "$authuser could not remove master block '$webvar{block}': '$@'";
[48]	1512	printAndExit("Could not remove master block $webvar{block}: $@");
[4]	1513	}
	1514	print "<div class=heading align=center>Success! Master $webvar{block} removed.</div>\n";
	1515	syslog "notice", "$authuser removed master block $webvar{block}";
	1516
	1517	} else { # end alloctype master block case
	1518
	1519	## This is a big block; but it HAS to be done in a chunk. Any removal
	1520	## of a netblock allocation may result in a larger chunk of free
	1521	## contiguous IP space - which may in turn be combined into a single
	1522	## netblock rather than a number of smaller netblocks.
	1523
	1524	eval {
	1525
	1526	my $cidr = new NetAddr::IP $webvar{block};
	1527	if ($webvar{alloctype} eq 'rr') {
	1528
	1529	$sth = $ip_dbh->prepare("delete from routed where cidr='$webvar{block}'");
	1530	$sth->execute;
	1531	# Make sure block getting deleted is properly accounted for.
	1532	$sth = $ip_dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
	1533	" where cidr='$webvar{block}'");
	1534	$sth->execute;
	1535	# Set up query to start compacting free blocks.
	1536	$sth = $ip_dbh->prepare("select * from freeblocks where ".
	1537	"maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
	1538
	1539	} else { # end alloctype routing case
	1540
	1541	$sth = $ip_dbh->prepare("delete from allocations where cidr='$webvar{block}'");
	1542	$sth->execute;
	1543	# Special case - delete pool IPs
[97]	1544	if ($webvar{alloctype} =~ /^[cdsmw]p$/) {
[4]	1545	# We have to delete the IPs from the pool listing.
[13]	1546	$sth = $ip_dbh->prepare("delete from poolips where pool='$webvar{block}'");
[4]	1547	$sth->execute;
	1548	}
	1549
	1550	# Set up query for compacting free blocks.
[50]	1551	$sth = $ip_dbh->prepare("select * from freeblocks where cidr << ".
	1552	"(select cidr from routed where cidr >> '$cidr') ".
[4]	1553	" and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
	1554
	1555	} # end alloctype general case
	1556
[102]	1557	##TEMP
	1558	## Temporary wrapper to "properly" deallocate sIP PPPoE/DSL "netblocks" in 209.91.185.0/24
	1559	my $staticpool = new NetAddr::IP "209.91.185.0/24";
	1560	##TEMP
	1561	if ($cidr->within($staticpool)) {
	1562	##TEMP
	1563	# We've already deleted the block, now we have to stuff its IPs into the pool.
	1564	$sth = $ip_dbh->prepare("insert into poolips values ('209.91.185.0/24',?,'6750400','','d','y','','','')");
	1565	$sth->execute($cidr->addr);
	1566	foreach my $ip ($cidr->hostenum) {
	1567	$sth->execute("$ip");
	1568	}
	1569	$cidr--;
	1570	$sth->execute($cidr->addr);
	1571
	1572	##TEMP
	1573	} else {
	1574	##TEMP
	1575
[4]	1576	# Now we look for larger-or-equal-sized free blocks in the same master (routed)
	1577	# (super)block. If there aren't any, we can't combine blocks anyway. If there
	1578	# are, we check to see if we can combine blocks.
	1579	# Execute the statement prepared in the if-else above.
	1580
	1581	$sth->execute;
	1582
	1583	# NetAddr::IP->compact() attempts to produce the smallest inclusive block
	1584	# from the caller and the passed terms.
	1585	# EG: if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
	1586	# and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
	1587	# .64-.95, and .96-.128), you will get an array containing a single
	1588	# /25 as element 0 (.0-.127). Order is not important; you could have
	1589	# $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
	1590
	1591	my (@together, @combinelist);
	1592	my $i=0;
	1593	while (my @data = $sth->fetchrow_array) {
	1594	my $testIP = new NetAddr::IP $data[0];
	1595	@together = $testIP->compact($cidr);
	1596	my $num = @together;
	1597	if ($num == 1) {
	1598	$cidr = $together[0];
	1599	$combinelist[$i++] = $testIP;
	1600	}
	1601	}
	1602
	1603	# Clear old freeblocks entries - if any. $i==0 if not.
	1604	if ($i>0) {
	1605	$sth = $ip_dbh->prepare("delete from freeblocks where cidr=?");
	1606	foreach my $block (@combinelist) {
[13]	1607	$sth->execute("$block");
[4]	1608	}
	1609	}
	1610
	1611	# insert "new" freeblocks entry
	1612	if ($webvar{alloctype} eq 'rr') {
	1613	$sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
	1614	",'<NULL>','n')");
	1615	} else {
	1616	$sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
[50]	1617	",(select city from routed where cidr >>= '$cidr'),'y')");
[4]	1618	}
	1619	$sth->execute;
	1620
[102]	1621	##TEMP
	1622	}
	1623	##TEMP
	1624
[4]	1625	# If we got here, we've succeeded. Whew!
	1626	$ip_dbh->commit;
	1627	}; # end eval
	1628	if ($@) {
	1629	carp "Transaction aborted because $@";
	1630	eval { $ip_dbh->rollback; };
[17]	1631	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$@'";
[48]	1632	printAndExit("Could not deallocate netblock $webvar{block}: $@");
[4]	1633	}
	1634	print "<div class=heading align=center>Success! $webvar{block} deleted.</div>\n";
[24]	1635	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
[4]	1636
	1637	} # end alloctype != netblock
	1638
	1639	printFooter;
	1640	} # finalDelete
	1641
	1642
	1643	# Just in case we manage to get here.
	1644	exit 0;

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

Download in other formats: