Context Navigation

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

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

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

Download in other formats: