Context Navigation

main.cgi@ 533

Last change on this file since 533 was 508, checked in by Kris Deugau, 13 years ago

/branches/stable

Prep-for-release cleanup of buglets found making sure the demo
install works

Clean up instructions for creating the database. Apparently the PL/pgSQL "language" module required for the last-modified triggers can't be installed by a regular user, and isn't available by default. O_o
Fix a missed $IPDB::webpath-in-single-quotes
Add a quick hack to allow automagical allocation from private net ranges. See #38.
Partially convert some critical bits to use bound parameters in SQL for new allocations. See #34, mostly cleaned up already on /trunk or /branches/htmlform
Set $privdata = internally so that an allocation via admin tools doesn't error out

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

File size: 49.1 KB

Rev	Line
[4]	1	#!/usr/bin/perl
	2	# ipdb/cgi-bin/main.cgi
[8]	3	###
	4	# SVN revision info
	5	# $Date: 2011-11-16 21:28:37 +0000 (Wed, 16 Nov 2011) $
	6	# SVN revision $Rev: 508 $
	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
[125]	890	if ($code eq 'OK') {
	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};
[125]	904	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[315]	905	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
	906	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[322]	907	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	908	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	909	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
	910	"&include_routed_subnet=1&ipdb=1".
	911	qq(">Add this netblock to RADIUS user table</a></div>)
	912	: "</div>");
[445]	913	mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	914	"$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
	915	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[122]	916	}
[125]	917	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[251]	918	"'$webvar{alloctype}' ($msg)";
[125]	919	} else {
	920	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	921	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[192]	922	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[159]	923	" failed:<br>\n$msg\n");
[125]	924	}
[122]	925
[4]	926	} # end insertAssign()
	927
	928
	929	# Does some basic checks on common input data to make sure nothing
	930	# really weird gets in to the database through this script.
	931	# Does NOT do complete input validation!!!
	932	sub validateInput {
	933	if ($webvar{city} eq '-') {
[125]	934	printError("Please choose a city.");
	935	return;
[4]	936	}
[140]	937
	938	# Alloctype check.
[4]	939	chomp $webvar{alloctype};
[140]	940	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	941	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	942	# managing to call things in such a way as to cause this deserves a cryptic error.
	943	printError("Invalid alloctype");
	944	return;
	945	}
	946
	947	# CustID check
[4]	948	# We have different handling for customer allocations and "internal" or "our" allocations
[209]	949	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	950	if (!$webvar{custid}) {
[125]	951	printError("Please enter a customer ID.");
	952	return;
[4]	953	}
[116]	954	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
[56]	955	# Force uppercase for now...
	956	$webvar{custid} =~ tr/a-z/A-Z/;
[338]	957	# Crosscheck with billing.
[56]	958	my $status = CustIDCK->custid_exist($webvar{custid});
[125]	959	if ($CustIDCK::Error) {
	960	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	961	return;
	962	}
	963	if (!$status) {
	964	printError("Customer ID not valid. Make sure the Customer ID ".
[445]	965	"is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
[125]	966	"non-customer assignments.");
	967	return;
	968	}
[4]	969	}
[56]	970	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[140]	971	} else {
[168]	972	# New! Improved! And now Loaded From The Database!!
[56]	973	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
[168]	974	$webvar{custid} = $def_custids{$webvar{alloctype}};
[56]	975	}
[4]	976	}
[125]	977
	978	# Check POP location
	979	my $flag;
[192]	980	if ($webvar{alloctype} eq 'rm') {
[125]	981	$flag = 'for a routed netblock';
	982	foreach (@poplist) {
	983	if (/^$webvar{city}$/) {
	984	$flag = 'n';
	985	last;
	986	}
	987	}
	988	} else {
	989	$flag = 'n';
[445]	990	##fixme: hook to force-set POP or city on certain alloctypes
	991	# if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
[315]	992	if ($webvar{pop} =~ /^-$/) {
[125]	993	$flag = 'to route the block from/through';
	994	}
	995	}
	996	if ($flag ne 'n') {
	997	printError("Please choose a valid POP location $flag. Valid ".
	998	"POP locations are currently:<br>\n".join (" - ", @poplist));
	999	return;
	1000	}
	1001
	1002	return 'OK';
[4]	1003	} # end validateInput
	1004
	1005
	1006	# Displays details of a specific allocation in a form
	1007	# Allows update/delete
	1008	# action=edit
	1009	sub edit {
	1010
	1011	my $sql;
	1012
	1013	# Two cases: block is a netblock, or block is a static IP from a pool
	1014	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
[506]	1015	if ($webvar{block} =~ /\/32$/ && !$webvar{reallyblock}) {
[318]	1016	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	1017	} else {
[318]	1018	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	1019	}
	1020
	1021	# gotta snag block info from db
	1022	$sth = $ip_dbh->prepare($sql);
	1023	$sth->execute;
	1024	my @data = $sth->fetchrow_array;
	1025
	1026	# Clean up extra whitespace on alloc type
	1027	$data[2] =~ s/\s//;
	1028
	1029	open (HTML, "../editDisplay.html")
	1030	or croak "Could not open editDisplay.html :$!";
	1031	my $html = join('', <HTML>);
	1032
	1033	# We can't let the city be changed here; this block is a part of
	1034	# a larger routed allocation and therefore by definition can't be moved.
	1035	# block and city are static.
	1036	##fixme
	1037	# Needs thinking. Have to allow changes to city to correct errors, no?
	1038	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1039
[242]	1040	if ($IPDBacl{$authuser} =~ /c/) {
	1041	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	1042
[4]	1043	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1044	# with the much longer list of allocation types.
	1045	# We'll just show what type of block it is.
	1046
[35]	1047	# this has now been Requested, so here goes.
[4]	1048
[192]	1049	##fixme The check here should be built from the database
[242]	1050	if ($data[2] =~ /^.[ne]$/) {
	1051	# Block that can be changed
	1052	my $blockoptions = "<select name=alloctype><option".
[192]	1053	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[224]	1054	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	1055	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	1056	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[35]	1057	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[192]	1058	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[133]	1059	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[35]	1060	"</select>\n";
[242]	1061	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1062	} else {
	1063	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1064	}
[394]	1065	## node hack
	1066	$sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
	1067	$sth->execute;
	1068	my ($nodeid) = $sth->fetchrow_array();
	1069	if ($nodeid) {
	1070	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1071	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1072	my $nodes = "<select name=node>\n";
	1073	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1074	$nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
	1075	}
	1076	$nodes .= "</select>\n";
	1077	$html =~ s/\$\$NODE\$\$/$nodes/;
	1078	} else {
	1079	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1080	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1081	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1082	my $nodes = "<select name=node>\n<option value=>--</option>\n";
	1083	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1084	$nodes .= "<option value='$nid'>$nname</option>\n";
	1085	}
	1086	$nodes .= "</select>\n";
	1087	$html =~ s/\$\$NODE\$\$/$nodes/;
	1088	} else {
	1089	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1090	}
	1091	}
	1092	## end node hack
[318]	1093	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1094	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1095	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1096	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1097	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[35]	1098	} else {
[394]	1099	## node hack
	1100	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1101	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
	1102	" ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
	1103	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1104	my ($node) = $sth->fetchrow_array;
	1105	$html =~ s/\$\$NODE\$\$/$node/;
	1106	} else {
	1107	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1108	}
	1109	## end node hack
[242]	1110	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[318]	1111	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1112	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1113	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1114	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1115	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1116	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[35]	1117	}
[245]	1118	my ($lastmod,undef) = split /\s+/, $data[7];
	1119	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[35]	1120
[244]	1121	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1122	if ($data[2] =~ /.i/) {
	1123	$html =~ s/\$\$SWIP\$\$/N\/A/;
	1124	} else {
[318]	1125	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
[244]	1126	'<input type=checkbox name=swip checked=yes>');
	1127	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1128	}
	1129
[245]	1130	# Allows us to "correctly" colour backgrounds in table
	1131	my $i=1;
	1132
[286]	1133	# Check to see if we can display sensitive data
	1134	my $privdata = '';
	1135	if ($IPDBacl{$authuser} =~ /s/) {
	1136	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1137	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1138	qq($data[8]</textarea></td></tr>\n);
	1139	$i++;
	1140	}
	1141	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1142
[242]	1143	# More ACL trickery - we can live with forms that don't submit,
	1144	# but we can't leave the extra table rows there, and we really
	1145	# can't leave the submit buttons there.
	1146	my $updok = '';
	1147	if ($IPDBacl{$authuser} =~ /c/) {
[286]	1148	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[242]	1149	qq(<input type="submit" value=" Update this block " class="regular">).
	1150	"</div></td></tr></form>\n";
[245]	1151	$i++;
[242]	1152	}
	1153	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1154
[242]	1155	my $delok = '';
	1156	if ($IPDBacl{$authuser} =~ /d/) {
	1157	$delok = qq(<form method="POST" action="main.cgi">
[286]	1158	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[242]	1159	<input type="hidden" name="action" value="delete">
	1160	<input type="hidden" name="block" value="$webvar{block}">
	1161	<input type="hidden" name="alloctype" value="$data[2]">
	1162	<input type=submit value=" Delete this block ">
	1163	</div></td></tr>);
	1164	}
	1165	$html =~ s/\$\$DELOK\$\$/$delok/;
	1166
[4]	1167	print $html;
	1168
	1169	} # edit()
	1170
	1171
	1172	# Stuff new info about a block into the db
	1173	# action=update
	1174	sub update {
[286]	1175	if ($IPDBacl{$authuser} !~ /c/) {
	1176	printError("You shouldn't have been able to get here. Access denied.");
	1177	return;
	1178	}
[4]	1179
[286]	1180	# Check to see if we can update restricted data
	1181	my $privdata = '';
	1182	if ($IPDBacl{$authuser} =~ /s/) {
	1183	$privdata = ",privdata='$webvar{privdata}'";
	1184	}
	1185
[4]	1186	# Make sure incoming data is in correct format - custID among other things.
[220]	1187	return if !validateInput;
[4]	1188
	1189	# SQL transaction wrapper
	1190	eval {
	1191	# Relatively simple SQL transaction here.
	1192	my $sql;
[159]	1193	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[75]	1194	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[286]	1195	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1196	"$privdata where ip='$webvar{block}'";
[4]	1197	} else {
	1198	$sql = "update allocations set custid='$webvar{custid}',".
[35]	1199	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[296]	1200	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
[244]	1201	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[286]	1202	"where cidr='$webvar{block}'";
[4]	1203	}
[159]	1204	# Log the details of the change.
	1205	syslog "debug", $sql;
[4]	1206	$sth = $ip_dbh->prepare($sql);
	1207	$sth->execute;
[394]	1208	## node hack
	1209	if ($webvar{node}) {
	1210	$ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
	1211	$sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	1212	$sth->execute($webvar{block},$webvar{node});
	1213	}
	1214	## end node hack
[4]	1215	$ip_dbh->commit;
	1216	};
	1217	if ($@) {
[163]	1218	my $msg = $@;
	1219	carp "Transaction aborted because $msg";
[4]	1220	eval { $ip_dbh->rollback; };
[163]	1221	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1222	printError("Could not update block/IP $webvar{block}: $msg");
[125]	1223	return;
[4]	1224	}
	1225
	1226	# If we get here, the operation succeeded.
	1227	syslog "notice", "$authuser updated $webvar{block}";
[445]	1228	##fixme: need to wedge something in to allow "update:field" notifications
	1229	## hmm. how to tell what changed? O_o
	1230	mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1231	"$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
[4]	1232	open (HTML, "../updated.html")
[125]	1233	or croak "Could not open updated.html :$!";
[4]	1234	my $html = join('', <HTML>);
	1235
[378]	1236	# Link back to browse-routed or list-pool page on "Update complete" page.
[507]	1237	my $backlink = "$IPDB::webpath/cgi-bin/main.cgi?action=";
[378]	1238	my $cblock; # to contain the CIDR of the container block we're retrieving.
	1239	my $sql;
	1240	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
	1241	$sql = "select pool from poolips where ip='$webvar{block}'";
	1242	$backlink .= "listpool&pool=";
	1243	} else {
	1244	$sql = "select cidr from routed where cidr >>= '$webvar{block}'";
	1245	$backlink .= "showrouted&block=";
	1246	}
	1247	# I define there to be no errors on this operation... so we don't need to check for them.
	1248	$sth = $ip_dbh->prepare($sql);
	1249	$sth->execute;
	1250	$sth->bind_columns(\$cblock);
	1251	$sth->fetch();
	1252	$sth->finish;
	1253	$backlink .= $cblock;
	1254
[244]	1255	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1256	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[89]	1257	$webvar{city} = desanitize($webvar{city});
[4]	1258	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1259	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[98]	1260	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1261	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[244]	1262	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[89]	1263	$webvar{circid} = desanitize($webvar{circid});
[75]	1264	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[89]	1265	$webvar{desc} = desanitize($webvar{desc});
[4]	1266	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[89]	1267	$webvar{notes} = desanitize($webvar{notes});
[4]	1268	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
[378]	1269	$html =~ s/\$\$BACKLINK\$\$/$backlink/g;
	1270	$html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
[4]	1271
[286]	1272	if ($IPDBacl{$authuser} =~ /s/) {
	1273	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1274	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1275	}
	1276	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1277
[4]	1278	print $html;
	1279
	1280	} # update()
	1281
	1282
	1283	# Delete an allocation.
[125]	1284	sub remove {
[242]	1285	if ($IPDBacl{$authuser} !~ /d/) {
	1286	printError("You shouldn't have been able to get here. Access denied.");
	1287	return;
	1288	}
	1289
[4]	1290	#show confirm screen.
	1291	open HTML, "../confirmRemove.html"
	1292	or croak "Could not open confirmRemove.html :$!";
	1293	my $html = join('', <HTML>);
	1294	close HTML;
	1295
	1296	# Serves'em right for getting here...
	1297	if (!defined($webvar{block})) {
[125]	1298	printError("Error 332");
	1299	return;
[4]	1300	}
	1301
[286]	1302	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1303
[192]	1304	if ($webvar{alloctype} eq 'rm') {
[4]	1305	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1306	$sth->execute();
	1307
	1308	# This feels... extreme.
	1309	croak $sth->errstr() if($sth->errstr());
	1310
	1311	$sth->bind_columns(\$cidr,\$city);
	1312	$sth->execute();
	1313	$sth->fetch \|\| croak $sth->errstr();
	1314	$custid = "N/A";
	1315	$alloctype = $webvar{alloctype};
[75]	1316	$circid = "N/A";
[4]	1317	$desc = "N/A";
	1318	$notes = "N/A";
	1319
	1320	} elsif ($webvar{alloctype} eq 'mm') {
	1321	$cidr = $webvar{block};
	1322	$city = "N/A";
	1323	$custid = "N/A";
	1324	$alloctype = $webvar{alloctype};
[75]	1325	$circid = "N/A";
[4]	1326	$desc = "N/A";
	1327	$notes = "N/A";
[192]	1328	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1329
	1330	# Unassigning a static IP
[286]	1331	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1332	" from poolips where ip='$webvar{block}'");
[4]	1333	$sth->execute();
	1334	# croak $sth->errstr() if($sth->errstr());
	1335
[286]	1336	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1337	\$privdata);
[4]	1338	$sth->fetch() \|\| croak $sth->errstr;
	1339
[159]	1340	} else { # done with alloctype=~ /^.i$/
[4]	1341
[286]	1342	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1343	" from allocations where cidr='$webvar{block}'");
[4]	1344	$sth->execute();
	1345	# croak $sth->errstr() if($sth->errstr());
	1346
[286]	1347	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1348	\$notes, \$privdata);
[75]	1349	$sth->fetch() \|\| carp $sth->errstr;
[4]	1350	} # end cases for different alloctypes
	1351
	1352	# Munge everything into HTML
	1353	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1354	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[98]	1355	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1356	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1357	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1358	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[75]	1359	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1360	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1361	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1362
	1363	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1364
	1365	# Set the warning text.
[159]	1366	if ($alloctype =~ /^.[pd]$/) {
[4]	1367	$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>\|;
	1368	} else {
	1369	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1370	}
	1371
[286]	1372	my $i = 1;
	1373	# Check to see if user is allowed to do anything with sensitive data
	1374	if ($IPDBacl{$authuser} =~ /s/) {
	1375	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1376	qq(<td class=regular>$privdata</td></tr>\n);
	1377	$i++;
	1378	}
	1379	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1380
	1381	$i = ++$i % 2;
	1382	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1383
[4]	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
[356]	1398	# need to retrieve block data before deleting so we can notify on that
	1399	my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
	1400
[125]	1401	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1402
[125]	1403	if ($code eq 'OK') {
[4]	1404	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[356]	1405	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
	1406	" $custid, $city, desc='$description'";
[445]	1407	mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1408	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1409	"CustID: $custid\nCity: $city\nDescription: $description\n");
[125]	1410	} else {
	1411	if ($webvar{alloctype} =~ /^.i$/) {
	1412	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
	1413	printError("Could not deallocate static IP $webvar{block}: $msg");
	1414	} else {
	1415	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
	1416	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1417	}
[102]	1418	}
	1419
[4]	1420	} # finalDelete
	1421
	1422
[242]	1423	sub exitError {
	1424	my $errStr = $_[0];
[507]	1425	printHeader('', $IPDB::webpath, '');
[242]	1426	print qq(<center><p class="regular"> $errStr </p>
	1427	<input type="button" value="Back" onclick="history.go(-1)">
	1428	</center>
	1429	);
	1430	printFooter();
	1431	exit;
	1432	} # errorExit
	1433
	1434
[4]	1435	# Just in case we manage to get here.
	1436	exit 0;

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

Context Navigation

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

Download in other formats: