Context Navigation

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

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

/trunk

First round of changes for "clean" handling of subblock allocations.
Note that the code will likely malfunction in a number of corner
and not-so-corner cases. Fixing those will require rethinking of
the allocation types.

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

File size: 43.0 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-03-03 22:14:54 +0000 (Thu, 03 Mar 2005) $
	7	# SVN revision $Rev: 186 $
	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);
	170	# We print the footer here, so we don't have to do it elsewhere.
	171	printFooter;
[106]	172	# Just in case something waaaayyy down isn't in place
	173	# properly... we exit explicitly.
	174	exit;
[4]	175
	176
[111]	177
[4]	178	sub viewBy($$) {
	179	my ($category,$query) = @_;
	180
	181	# Local variables
	182	my $sql;
	183
	184	#print "<pre>\n";
	185
	186	#print "start querysub: query '$query'\n";
	187	# this may happen with more than one subcategory. Unlikely, but possible.
	188
	189	# Calculate start point for LIMIT clause
	190	my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
	191
	192	# Possible cases:
	193	# 1) Partial IP/subnet. Treated as "first-three-octets-match" in old IPDB,
	194	# I should be able to handle it similarly here.
	195	# 2a) CIDR subnet. Treated more or less as such in old IPDB.
	196	# 2b) CIDR netmask. Not sure how it's treated.
	197	# 3) Customer ID. Not handled in old IPDB
	198	# 4) Description.
	199	# 5) Invalid data which might be interpretable as an IP or something, but
	200	# which probably shouldn't be for reasons of sanity.
	201
	202	if ($category eq 'all') {
	203
	204	print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
[173]	205
	206	# Need to assemble SQL query in this order to avoid breaking things.
	207	$sql = "select cidr,custid,type,city,description from searchme";
[4]	208	my $count = countRows("select count(*) from ($sql) foo");
	209	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	210	queryResults($sql, $webvar{page}, $count);
	211
	212	} elsif ($category eq 'cust') {
	213
	214	print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
	215
	216	# Query for a customer ID. Note that we can't restrict to "numeric-only"
	217	# as we have non-numeric custIDs in the legacy data. :/
[173]	218	$sql = "select cidr,custid,type,city,description from searchme where custid ilike '%$query%'";
[4]	219	my $count = countRows("select count(*) from ($sql) foo");
	220	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	221	queryResults($sql, $webvar{page}, $count);
	222
	223	} elsif ($category eq 'desc') {
	224
	225	print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
	226	# Query based on description (includes "name" from old DB).
[173]	227	$sql = "select cidr,custid,type,city,description from searchme where description ilike '%$query%'";
[4]	228	my $count = countRows("select count(*) from ($sql) foo");
	229	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	230	queryResults($sql, $webvar{page}, $count);
	231
	232	} elsif ($category =~ /ipblock/) {
	233
	234	# Query is for a partial IP, a CIDR block in some form, or a flat IP.
	235	print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);
	236
	237	$query =~ s/\s+//g;
	238	if ($query =~ /\//) {
	239	# 209.91.179/26 should show all /26 subnets in 209.91.179
	240	my ($net,$maskbits) = split /\//, $query;
	241	if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
	242	# /0->/9 are silly to worry about right now. I don't think
	243	# we'll be getting a class A anytime soon. <g>
[173]	244	$sql = "select cidr,custid,type,city,description from searchme where cidr='$query'";
[4]	245	queryResults($sql, $webvar{page}, 1);
	246	} else {
	247	print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
	248	# Partial match; beginning of subnet and maskbits are provided
[173]	249	$sql = "select cidr,custid,type,city,description from searchme where ".
	250	"text(cidr) like '$net%' and text(cidr) like '%$maskbits'";
[4]	251	my $count = countRows("select count(*) from ($sql) foo");
	252	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	253	queryResults($sql, $webvar{page}, $count);
	254	}
	255	} elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
	256	# Specific IP address match
	257	my $sfor = new NetAddr::IP $query;
[173]	258	# We do this convoluted roundabout way of finding things in order
	259	# to bring up matches for single IPs that are within a static block;
	260	# we want to show both the "container" block and the static IP itself.
	261	$sth = $ip_dbh->prepare("select cidr from searchme where cidr >>= '$sfor'");
[4]	262	$sth->execute;
	263	while (my @data = $sth->fetchrow_array()) {
	264	my $cidr = new NetAddr::IP $data[0];
[173]	265	queryResults("select cidr,custid,type,city,description from searchme where ".
	266	"cidr='$cidr'", $webvar{page}, 1);
[4]	267	}
	268	} elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
	269	print "Finding matches where the first three octets are $query<br>\n";
[173]	270	$sql = "select cidr,custid,type,city,description from searchme where ".
	271	"text(cidr) like '$query%'";
[4]	272	my $count = countRows("select count(*) from ($sql) foo");
	273	$sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
	274	queryResults($sql, $webvar{page}, $count);
	275	} else {
	276	# This shouldn't happen, but if it does, whoever gets it deserves what they get...
[111]	277	printError("Invalid query.");
[4]	278	}
	279	} else {
	280	# This shouldn't happen, but if it does, whoever gets it deserves what they get...
[111]	281	printError("Invalid searchfor.");
[4]	282	}
	283	} # viewBy
	284
[9]	285
[4]	286	# args are: a reference to an array with the row to be printed and the
	287	# class(stylesheet) to use for formatting.
	288	# if ommitting the class - call the sub as &printRow(\@array)
	289	sub printRow {
	290	my ($rowRef,$class) = @_;
	291
	292	if (!$class) {
	293	print "<tr>\n";
	294	} else {
	295	print "<tr class=\"$class\">\n";
	296	}
	297
[135]	298	ELEMENT: foreach my $element (@$rowRef) {
	299	if (!defined($element)) {
	300	print "<td></td>\n";
	301	next ELEMENT;
	302	}
[4]	303	$element =~ s\|\n\|</br>\|g;
	304	print "<td>$element</td>\n";
	305	}
	306	print "</tr>";
	307	} # printRow
	308
	309
	310	# Display certain types of search query. Note that this can't be
	311	# cleanly reused much of anywhere else as the data isn't neatly tabulated.
	312	# This is tied to the search sub tightly enough I may just gut it and provide
	313	# more appropriate tables directly as needed.
	314	sub queryResults($$$) {
	315	my ($sql, $pageNo, $rowCount) = @_;
	316	my $offset = 0;
	317	$offset = $1 if($sql =~ m/.limit\s+(.),.*/);
	318
	319	my $sth = $ip_dbh->prepare($sql);
	320	$sth->execute();
	321
	322	startTable('Allocation','CustID','Type','City','Description/Name');
	323	my $count = 0;
	324
	325	while (my @data = $sth->fetchrow_array) {
	326	# cidr,custid,type,city,description,notes
	327	# Fix up types from pools (which are single-char)
	328	# Fixing the database would be... painful. :(
[157]	329	##fixme LEGACY CODE
[72]	330	if ($data[2] =~ /^[cdsmw]$/) {
[4]	331	$data[2] .= 'i';
	332	}
[186]	333	my @row = ( (($data[2] =~ /^l.$/) ? 'Sub ' : '').
	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
[186]	601	my @row = ( (($data[2] =~ /^l.$/) ? 'Sub ' : '').
	602	qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
[157]	603	$data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
[4]	604	# If the allocation is a pool, allow listing of the IPs in the pool.
[157]	605	if ($data[2] =~ /^.[pd]$/) {
[4]	606	$row[0] .= '   <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	607	"&pool=$data[0]\">List IPs</a>";
	608	}
	609
	610	printRow(\@row, 'color1') if ($count%2 == 0);
	611	printRow(\@row, 'color2') if ($count%2 != 0);
	612	$count++;
	613	}
	614
	615	print "</table>\n";
	616
	617	# If the routed block has no allocations, by definition it only has
	618	# one free block, and therefore may be deleted.
	619	if ($count == 0) {
	620	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	621	qq($master.</div></center>\n).
	622	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	623	qq(<input type=hidden name=action value="delete">\n).
	624	qq(<input type=hidden name=block value="$master">\n).
	625	qq(<input type=hidden name=alloctype value="rr">\n).
	626	qq(<input type=submit value=" Remove this block ">\n).
	627	qq(</form>\n);
	628	}
	629
	630	print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
	631	qq(submaster $master</div></center>\n);
	632
	633	startTable('CIDR block','Range');
	634
	635	# Snag the free blocks. We don't really need to be pedantic about avoiding
	636	# unrouted free blocks, but it's better to let the database do the work if we can.
	637	$count = 0;
[186]	638	$sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
	639	" order by cidr");
[4]	640	$sth->execute();
	641	while (my @data = $sth->fetchrow_array()) {
[186]	642	# cidr,routed
[4]	643	my $cidr = new NetAddr::IP $data[0];
[186]	644	my @row = ((($data[1] eq 'r') ? 'Sub ' : '').
	645	"<a href=\"/ip/cgi-bin/main.cgi?action=assign&block=$cidr\">$cidr</a>",
[21]	646	$cidr->range);
[118]	647	printRow(\@row, 'color1') if ($count%2 == 0);
	648	printRow(\@row, 'color2') if ($count%2 != 0);
	649	$count++;
[4]	650	}
	651
	652	print "</table>\n";
	653	} # showRBlock
	654
	655
	656	# List the IPs used in a pool
	657	sub listPool {
	658	printHeader('');
	659
	660	my $cidr = new NetAddr::IP $webvar{pool};
	661
[157]	662	my ($pooltype,$poolcity);
	663
[4]	664	# Snag pool info for heading
[157]	665	$sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
[4]	666	$sth->execute;
[157]	667	$sth->bind_columns(\$pooltype, \$poolcity);
	668	$sth->fetch() \|\| carp $sth->errstr;
[4]	669
	670	print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
[157]	671	qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
	672	# Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
	673	if ($pooltype =~ /^.d$/) {
	674	print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
	675	print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
[4]	676	$cidr->addr."</td></tr>\n";
[157]	677	$cidr++;
	678	print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
	679	$cidr--; $cidr--;
	680	print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
[4]	681	"<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
	682	"</table></div></div>\n";
[157]	683	}
[4]	684
	685	# probably have to add an "edit IP allocation" link here somewhere.
	686
	687	startTable('IP','Customer ID','Available?','Description','');
[157]	688	$sth = $ip_dbh->prepare("select ip,custid,available,description,type".
	689	" from poolips where pool='$webvar{pool}' order by ip");
[4]	690	$sth->execute;
	691	my $count = 0;
	692	while (my @data = $sth->fetchrow_array) {
[74]	693	# pool,ip,custid,city,ptype,available,notes,description,circuitid
[157]	694	# ip,custid,available,description,type
	695	# If desc is "null", make it not null. <g>
	696	if ($data[3] eq '') {
	697	$data[3] = ' ';
[4]	698	}
	699	# Some nice hairy Perl to decide whether to allow unassigning each IP
[157]	700	# -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
[4]	701	# else we print a blank space
[157]	702	my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
	703	$data[1],$data[2],$data[3],
	704	( ($data[2] eq 'n') ?
	705	("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
	706	"alloctype=$data[4]\">Unassign this IP</a>") :
[4]	707	(" ") )
	708	);
	709	printRow(\@row, 'color1') if($count%2==0);
	710	printRow(\@row, 'color2') if($count%2!=0);
	711	$count++;
	712	}
	713	print "</table>\n";
	714
	715	} # end listPool
	716
	717
[106]	718	# Show "Add new allocation" page. Note that the actual page may
	719	# be one of two templates, and the lists come from the database.
[4]	720	sub assignBlock {
	721	printHeader('');
	722
[21]	723	my $html;
	724
	725	# New special case- block to assign is specified
	726	if ($webvar{block} ne '') {
	727	open HTML, "../fb-assign.html"
	728	or croak "Could not open fb-assign.html: $!";
	729	$html = join('',<HTML>);
	730	close HTML;
	731	my $block = new NetAddr::IP $webvar{block};
	732	$html =~ s\|\$\$BLOCK\$\$\|$block\|g;
	733	$html =~ s\|\$\$MASKBITS\$\$\|$block->masklen\|;
[106]	734	my $typelist = '';
	735	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 and type not like '_i' order by listorder");
	736	$sth->execute;
	737	my @data = $sth->fetchrow_array;
	738	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	739	while (my @data = $sth->fetchrow_array) {
	740	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	741	}
	742	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[21]	743	} else {
	744	open HTML, "../assign.html"
[4]	745	or croak "Could not open assign.html: $!";
[21]	746	$html = join('',<HTML>);
[92]	747	close HTML;
[31]	748	my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
	749	foreach my $master (@masterblocks) {
	750	$masterlist .= "<option>$master</option>\n";
	751	}
	752	$masterlist .= "</select>\n";
	753	$html =~ s\|\$\$MASTERLIST\$\$\|$masterlist\|g;
[92]	754	my $pops = '';
	755	foreach my $pop (@poplist) {
	756	$pops .= "<option>$pop</option>\n";
	757	}
	758	$html =~ s\|\$\$POPLIST\$\$\|$pops\|g;
[106]	759	my $typelist = '';
	760	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
	761	$sth->execute;
	762	my @data = $sth->fetchrow_array;
	763	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	764	while (my @data = $sth->fetchrow_array) {
	765	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	766	}
	767	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[21]	768	}
[92]	769	my $cities = '';
	770	foreach my $city (@citylist) {
	771	$cities .= "<option>$city</option>\n";
	772	}
	773	$html =~ s\|\$\$ALLCITIES\$\$\|$cities\|g;
[4]	774
	775	print $html;
	776
	777	} # assignBlock
	778
	779
	780	# Take info on requested IP assignment and see what we can provide.
	781	sub confirmAssign {
	782	printHeader('');
	783
	784	my $cidr;
	785	my $alloc_from;
	786
	787	# Going to manually validate some items.
	788	# custid and city are automagic.
[111]	789	return if !validateInput();
[4]	790
	791	# Several different cases here.
	792	# Static IP vs netblock
	793	# + Different flavours of static IP
	794	# + Different flavours of netblock
	795
[157]	796	if ($webvar{alloctype} =~ /^.i$/) {
[4]	797	my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
	798	my $sql;
	799	# Check for pools in Subury or North Bay if DSL or server pool. Anywhere else is
	800	# invalid and shouldn't be in the db in the first place.
	801	# ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
	802	# Note that we want to retain the requested city to relate to customer info.
[157]	803	##fixme This needs thought.
	804	##SELECT DISTINCT pool, Count(*) FROM poolips where available='y' GROUP BY pool;
[4]	805	if ($base =~ /^[ds]$/) {
	806	$sql = "select * from poolips where available='y' and".
[166]	807	" type='$webvar{alloctype}' and (city='Sudbury' or city='North Bay')";
[4]	808	} else {
	809	$sql = "select * from poolips where available='y' and".
[166]	810	" type='$webvar{alloctype}' and city='$webvar{pop}'";
[4]	811	}
	812
	813	# Now that we know where we're looking, we can list the pools with free IPs.
	814	$sth = $ip_dbh->prepare($sql);
	815	$sth->execute;
	816	my %ipcount;
	817	my $optionlist;
	818	while (my @data = $sth->fetchrow_array) {
	819	$ipcount{$data[0]}++;
	820	}
[87]	821	$sth = $ip_dbh->prepare("select city from allocations where cidr=?");
[4]	822	foreach my $key (keys %ipcount) {
[87]	823	$sth->execute($key);
	824	my @data = $sth->fetchrow_array;
	825	$optionlist .= "<option value='$key'>$key [$ipcount{$key} free IP(s)] in $data[0]</option>\n";
[4]	826	}
	827	$cidr = "Single static IP";
	828	$alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
	829
	830	} else { # end show pool options
[21]	831
	832	if ($webvar{fbassign} eq 'y') {
	833	$cidr = new NetAddr::IP $webvar{block};
	834	$webvar{maskbits} = $cidr->masklen;
	835	} else { # done with direct freeblocks assignment
	836
	837	if (!$webvar{maskbits}) {
[111]	838	printError("Please specify a CIDR mask length.");
	839	return;
[21]	840	}
	841	my $sql;
	842	my $city;
	843	my $failmsg;
	844	if ($webvar{alloctype} eq 'rr') {
[31]	845	if ($webvar{allocfrom} ne '-') {
	846	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
	847	" and cidr <<= '$webvar{allocfrom}' order by maskbits desc";
	848	} else {
	849	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
	850	" order by maskbits desc";
	851	}
[21]	852	$failmsg = "No suitable free block found.<br>\nWe do not have a free".
	853	" routeable block of that size.<br>\nYou will have to either route".
	854	" a set of smaller netblocks or a single smaller netblock.";
[4]	855	} else {
[118]	856	##fixme
	857	# This section needs serious Pondering.
[157]	858	if ($webvar{alloctype} =~ /^.[pd]$/) {
[21]	859	if (($webvar{city} !~ /^(Sudbury\|North Bay)$/) && ($webvar{alloctype} eq 'dp')) {
[111]	860	printError("You must chose Sudbury or North Bay for DSL pools.");
	861	return;
	862	}
[37]	863	$city = $webvar{city};
[21]	864	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[118]	865	" superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
[21]	866	" block size for the pool.";
	867	} else {
	868	$city = $webvar{pop};
	869	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[106]	870	" superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
[21]	871	" chose a smaller blocksize.";
	872	}
[31]	873	if ($webvar{allocfrom} ne '-') {
[157]	874	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[186]	875	" and cidr <<= '$webvar{allocfrom}' and routed='".
	876	(($webvar{alloctype} =~ /^l.$/) ? 'r' : 'y')."' order by cidr,maskbits desc";
[31]	877	} else {
[157]	878	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[186]	879	" and routed='".(($webvar{alloctype} =~ /^l.$/) ? 'r' : 'y').
	880	"' order by cidr,maskbits desc";
[31]	881	}
[4]	882	}
[21]	883	$sth = $ip_dbh->prepare($sql);
	884	$sth->execute;
	885	my @data = $sth->fetchrow_array();
	886	if ($data[0] eq "") {
[111]	887	printError($failmsg);
	888	return;
[21]	889	}
	890	$cidr = new NetAddr::IP $data[0];
	891	} # check for freeblocks assignment or IPDB-controlled assignment
[4]	892
	893	$alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
	894
	895	# If the block to be allocated is smaller than the one we found,
	896	# figure out the "real" block to be allocated.
	897	if ($cidr->masklen() ne $webvar{maskbits}) {
	898	my $maskbits = $cidr->masklen();
	899	my @subblocks;
	900	while ($maskbits++ < $webvar{maskbits}) {
	901	@subblocks = $cidr->split($maskbits);
	902	}
	903	$cidr = $subblocks[0];
	904	}
[157]	905	} # if ($webvar{alloctype} =~ /^.i$/)
[4]	906
	907	open HTML, "../confirm.html"
	908	or croak "Could not open confirm.html: $!";
	909	my $html = join '', <HTML>;
	910	close HTML;
	911
	912	### gotta fix this in final
	913	# Stick in customer info as necessary - if it's blank, it just ends
	914	# up as blank lines ignored in the rendering of the page
	915	my $custbits;
	916	$html =~ s\|\$\$CUSTBITS\$\$\|$custbits\|g;
	917	###
	918
	919	# Stick in the allocation data
	920	$html =~ s\|\$\$ALLOC_TYPE\$\$\|$webvar{alloctype}\|g;
[106]	921	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$webvar{alloctype}}\|g;
[4]	922	$html =~ s\|\$\$ALLOC_FROM\$\$\|$alloc_from\|g;
	923	$html =~ s\|\$\$CIDR\$\$\|$cidr\|g;
[87]	924	$webvar{city} = desanitize($webvar{city});
[4]	925	$html =~ s\|\$\$CITY\$\$\|$webvar{city}\|g;
	926	$html =~ s\|\$\$CUSTID\$\$\|$webvar{custid}\|g;
[87]	927	$webvar{circid} = desanitize($webvar{circid});
[74]	928	$html =~ s\|\$\$CIRCID\$\$\|$webvar{circid}\|g;
[4]	929	$webvar{desc} = desanitize($webvar{desc});
[92]	930	$html =~ s\|\$\$DESC\$\$\|$webvar{desc}\|g;
[4]	931	$webvar{notes} = desanitize($webvar{notes});
	932	$html =~ s\|\$\$NOTES\$\$\|$webvar{notes}\|g;
	933	$html =~ s\|\$\$ACTION\$\$\|insert\|g;
	934
	935	print $html;
	936
	937	} # end confirmAssign
	938
	939
	940	# Do the work of actually inserting a block in the database.
	941	sub insertAssign {
	942	# Some things are done more than once.
	943	printHeader('');
[111]	944	return if !validateInput();
[4]	945
[106]	946	# $code is "success" vs "failure", $msg contains OK for a
	947	# successful netblock allocation, the IP allocated for static
	948	# IP, or the error message if an error occurred.
	949	my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
	950	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
	951	$webvar{circid});
[4]	952
[111]	953	if ($code eq 'OK') {
[106]	954	if ($webvar{alloctype} =~ /^.i$/) {
	955	print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
	956	# Notify tech@example.com
	957	mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
[111]	958	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
	959	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[106]	960	} else {
	961	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
	962	"sucessfully added as type '$webvar{alloctype}' ".
	963	"($disp_alloctypes{$webvar{alloctype}})</div></div>";
[4]	964	}
[106]	965	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
	966	"'$webvar{alloctype}'";
[111]	967	} else {
	968	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	969	"'$webvar{alloctype}' by $authuser failed: '$msg'";
	970	printError("Allocation of $webvar{fullcidr} as $disp_alloctypes{$webvar{alloctype}}".
[157]	971	" failed:<br>\n$msg\n");
[106]	972	}
[4]	973
	974	} # end insertAssign()
	975
	976
	977	# Does some basic checks on common input data to make sure nothing
	978	# really weird gets in to the database through this script.
	979	# Does NOT do complete input validation!!!
	980	sub validateInput {
	981	if ($webvar{city} eq '-') {
[111]	982	printError("Please choose a city.");
	983	return;
[4]	984	}
[138]	985
	986	# Alloctype check.
[4]	987	chomp $webvar{alloctype};
[138]	988	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	989	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	990	# managing to call things in such a way as to cause this deserves a cryptic error.
	991	printError("Invalid alloctype");
	992	return;
	993	}
	994
	995	# CustID check
[4]	996	# We have different handling for customer allocations and "internal" or "our" allocations
[138]	997	if ($webvar{alloctype} =~ /^(cn\|.i)$/) {
[4]	998	if (!$webvar{custid}) {
[111]	999	printError("Please enter a customer ID.");
	1000	return;
[4]	1001	}
[87]	1002	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF\|TEMP)(?:-\d\d?)?$/) {
[111]	1003	printError("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
	1004	return;
[4]	1005	}
	1006	print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[138]	1007	} else {
[167]	1008	# New! Improved! And now Loaded From The Database!!
	1009	$webvar{custid} = $def_custids{$webvar{alloctype}};
[4]	1010	}
[111]	1011
	1012	# Check POP location
	1013	my $flag;
	1014	if ($webvar{alloctype} eq 'rr') {
	1015	$flag = 'for a routed netblock';
	1016	foreach (@poplist) {
	1017	if (/^$webvar{city}$/) {
	1018	$flag = 'n';
	1019	last;
	1020	}
	1021	}
	1022	} else {
	1023	$flag = 'n';
	1024	if ($webvar{pop} =~ /^-$/) {
	1025	$flag = 'to route the block from/through';
	1026	}
	1027	}
	1028	if ($flag ne 'n') {
	1029	printError("Please choose a valid POP location $flag. Valid ".
	1030	"POP locations are currently:<br>\n".join (" - ", @poplist));
	1031	return;
	1032	}
	1033
	1034	return 'OK';
[4]	1035	} # end validateInput
	1036
	1037
	1038	# Displays details of a specific allocation in a form
	1039	# Allows update/delete
	1040	# action=edit
	1041	sub edit {
	1042	printHeader('');
	1043
	1044	my $sql;
	1045
	1046	# Two cases: block is a netblock, or block is a static IP from a pool
	1047	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	1048	if ($webvar{block} =~ /\/32$/) {
[166]	1049	$sql = "select ip,custid,type,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
[4]	1050	} else {
[74]	1051	$sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
[4]	1052	}
	1053
	1054	# gotta snag block info from db
	1055	$sth = $ip_dbh->prepare($sql);
	1056	$sth->execute;
	1057	my @data = $sth->fetchrow_array;
	1058
	1059	# Clean up extra whitespace on alloc type
	1060	$data[2] =~ s/\s//;
	1061
[157]	1062	##fixme LEGACY CODE
[4]	1063	# Postfix "i" on pool IP types
[72]	1064	if ($data[2] =~ /^[cdsmw]$/) {
[4]	1065	$data[2] .= "i";
	1066	}
	1067
	1068	open (HTML, "../editDisplay.html")
	1069	or croak "Could not open editDisplay.html :$!";
	1070	my $html = join('', <HTML>);
	1071
	1072	# We can't let the city be changed here; this block is a part of
	1073	# a larger routed allocation and therefore by definition can't be moved.
	1074	# block and city are static.
	1075	##fixme
	1076	# Needs thinking. Have to allow changes to city to correct errors, no?
	1077	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1078	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1079
	1080	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1081	# with the much longer list of allocation types.
	1082	# We'll just show what type of block it is.
	1083
[33]	1084	# this has now been Requested, so here goes.
[4]	1085
[135]	1086	if ($data[2] =~ /^d[nyc]\|cn\|ee\|in$/) {
[33]	1087	# Block that can be changed
	1088	my $blockoptions = "<select name=alloctype><option".
	1089	(($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option".
	1090	(($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option".
	1091	(($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
	1092	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
	1093	(($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option".
[135]	1094	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[33]	1095	"</select>\n";
	1096	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1097	} else {
[106]	1098	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
[33]	1099	}
	1100
[4]	1101	# These can be modified, although CustID changes may get ignored.
	1102	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[74]	1103	$html =~ s/\$\$TYPE\$\$/$data[2]/g;
	1104	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1105	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1106	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[4]	1107
	1108	print $html;
	1109
	1110	} # edit()
	1111
	1112
	1113	# Stuff new info about a block into the db
	1114	# action=update
	1115	sub update {
	1116	printHeader('');
	1117
	1118	# Make sure incoming data is in correct format - custID among other things.
	1119	validateInput;
	1120
	1121	# SQL transaction wrapper
	1122	eval {
	1123	# Relatively simple SQL transaction here.
	1124	my $sql;
[157]	1125	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[73]	1126	# Note the hack ( available='n' ) to work around "update" additions
	1127	# to static IP space. Eww.
[74]	1128	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
	1129	"circuitid='$webvar{circid}',description='$webvar{desc}',available='n' ".
[4]	1130	"where ip='$webvar{block}'";
	1131	} else {
	1132	$sql = "update allocations set custid='$webvar{custid}',".
[33]	1133	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[74]	1134	"type='$webvar{alloctype}',circuitid='$webvar{circid}' where cidr='$webvar{block}'";
[4]	1135	}
[157]	1136	# Log the details of the change.
	1137	syslog "debug", $sql;
[4]	1138	$sth = $ip_dbh->prepare($sql);
	1139	$sth->execute;
	1140	$ip_dbh->commit;
	1141	};
	1142	if ($@) {
[166]	1143	my $msg = $@;
	1144	carp "Transaction aborted because $msg";
[4]	1145	eval { $ip_dbh->rollback; };
[166]	1146	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1147	printError("Could not update block/IP $webvar{block}: $msg");
[111]	1148	return;
[4]	1149	}
	1150
	1151	# If we get here, the operation succeeded.
	1152	syslog "notice", "$authuser updated $webvar{block}";
	1153	open (HTML, "../updated.html")
[111]	1154	or croak "Could not open updated.html :$!";
[4]	1155	my $html = join('', <HTML>);
	1156
	1157	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[92]	1158	$webvar{city} = desanitize($webvar{city});
[4]	1159	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1160	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[106]	1161	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1162	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[92]	1163	$webvar{circid} = desanitize($webvar{circid});
[74]	1164	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[92]	1165	$webvar{desc} = desanitize($webvar{desc});
[4]	1166	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[92]	1167	$webvar{notes} = desanitize($webvar{notes});
[4]	1168	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
	1169
	1170	print $html;
	1171
	1172	} # update()
	1173
	1174
	1175	# Delete an allocation.
[106]	1176	sub remove {
[4]	1177	printHeader('');
	1178	#show confirm screen.
	1179	open HTML, "../confirmRemove.html"
	1180	or croak "Could not open confirmRemove.html :$!";
	1181	my $html = join('', <HTML>);
	1182	close HTML;
	1183
	1184	# Serves'em right for getting here...
	1185	if (!defined($webvar{block})) {
[111]	1186	printError("Error 332");
	1187	return;
[4]	1188	}
	1189
[74]	1190	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype);
[4]	1191
	1192	if ($webvar{alloctype} eq 'rr') {
	1193	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1194	$sth->execute();
	1195
	1196	# This feels... extreme.
	1197	croak $sth->errstr() if($sth->errstr());
	1198
	1199	$sth->bind_columns(\$cidr,\$city);
	1200	$sth->execute();
	1201	$sth->fetch \|\| croak $sth->errstr();
	1202	$custid = "N/A";
	1203	$alloctype = $webvar{alloctype};
[74]	1204	$circid = "N/A";
[4]	1205	$desc = "N/A";
	1206	$notes = "N/A";
	1207
	1208	} elsif ($webvar{alloctype} eq 'mm') {
	1209	$cidr = $webvar{block};
	1210	$city = "N/A";
	1211	$custid = "N/A";
	1212	$alloctype = $webvar{alloctype};
[74]	1213	$circid = "N/A";
[4]	1214	$desc = "N/A";
	1215	$notes = "N/A";
[157]	1216	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=rr
[4]	1217
	1218	# Unassigning a static IP
[166]	1219	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid from poolips".
[4]	1220	" where ip='$webvar{block}'");
	1221	$sth->execute();
	1222	# croak $sth->errstr() if($sth->errstr());
	1223
[74]	1224	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid);
[4]	1225	$sth->fetch() \|\| croak $sth->errstr;
	1226
[157]	1227	} else { # done with alloctype=~ /^.i$/
[4]	1228
[74]	1229	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes from ".
[4]	1230	"allocations where cidr='$webvar{block}'");
	1231	$sth->execute();
	1232	# croak $sth->errstr() if($sth->errstr());
	1233
[74]	1234	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc, \$notes);
	1235	$sth->fetch() \|\| carp $sth->errstr;
[4]	1236	} # end cases for different alloctypes
	1237
	1238	# Munge everything into HTML
	1239	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1240	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[106]	1241	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1242	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1243	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1244	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[74]	1245	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1246	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1247	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1248
	1249	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1250
	1251	# Set the warning text.
[157]	1252	if ($alloctype =~ /^.[pd]$/) {
[4]	1253	$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>\|;
	1254	} else {
	1255	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1256	}
	1257
	1258	print $html;
	1259	} # end edit()
	1260
	1261
	1262	# Delete an allocation. Return it to the freeblocks table; munge
	1263	# data as necessary to keep as few records as possible in freeblocks
	1264	# to prevent weirdness when allocating blocks later.
	1265	# Remove IPs from pool listing if necessary
	1266	sub finalDelete {
	1267	printHeader('');
	1268
[106]	1269	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1270
[106]	1271	if ($code eq 'OK') {
[4]	1272	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[106]	1273	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
	1274	} else {
	1275	if ($webvar{alloctype} =~ /^.i$/) {
	1276	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
[111]	1277	printError("Could not deallocate static IP $webvar{block}: $msg");
[106]	1278	} else {
	1279	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
[111]	1280	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1281	}
[106]	1282	}
[4]	1283
	1284	} # finalDelete
	1285
	1286
	1287	# Just in case we manage to get here.
	1288	exit 0;

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

Download in other formats: