Context Navigation

source: branches/sql-cleanup/cgi-bin/main.cgi@ 149

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

/branches/sql-cleanup

Fixed a bunch of general problems with pool allocations, and
rearranged some code, alloctypes, and the poolips table (ugh)
to more cleanly support different types of IP pool.

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