Context Navigation

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

Last change on this file since 549 was 549, checked in by Kris Deugau, 12 years ago

/branches/stable

Minimal server-meltdown-prevention patch for IPv6; create the
block but don't populate IP pools. See #22, sort of.

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

File size: 49.4 KB

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

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

Download in other formats: