Context Navigation

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

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

/branches/stable

Tweak logging to include the actual IP allocated for static IP
allocations.

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

File size: 48.3 KB

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

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

Download in other formats: