Context Navigation

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

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

/trunk

Port forward bugfixes from /branches/stable r215, r220, and r224.

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

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

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

Download in other formats: