Context Navigation

source: trunk/cgi-bin/main.cgi@ 52

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

/trunk

Merge bugfixes and updates from /branches/stable r49 and r50

Property svn:executable set to *

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

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

Download in other formats: