Context Navigation

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

Last change on this file since 270 was 267, checked in by Kris Deugau, 19 years ago

/branches/stable

Oops, missed some possibilities in deliberatly ignoring private
IPs - need to allow for allocation types other than routing. >_<

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

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

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

Download in other formats: