Context Navigation

source: branches/acl/cgi-bin/main.cgi@ 419

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

/branches/acl

All access to change or "delete" (static IPs aren't actually
deleted unless the whole pool is) should be ACL-ified. Users
without the "c" ACL cannot make changes to existing allocations.
Users without the "d" ACL cannot delete netblocks, routing
allocations, or master netblocks; they also may not deallocate
static IPs. Checks are also done later in the processing to
make sure that a crafted URL can't get around the restrictions.

editDisplay.html required updates to remove form elements from
the static HTML; users that cannot modify content will still
receive a page with some hidden form elements but no submit
button(s) to change or delete content (as determined by their
ACL).

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

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

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

Download in other formats: