Context Navigation

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

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

/trunk

Port bugfixes and tweaks from /branches/stable r79:86 forward.

Property svn:executable set to *

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

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

Download in other formats: