Context Navigation

source: branches/stable/cgi-bin/main.cgi@ 188

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

/branches/stable

Backport SQL/SQL-related bugfixes from /trunk r180 through 184

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

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

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

Download in other formats: