Context Navigation

source: trunk/cgi-bin/main.cgi@ 388

Last change on this file since 388 was 380, checked in by Kris Deugau, 17 years ago

/trunk

Merge bugfixes/updates from /branches/stable r317 through r379

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

File size: 45.0 KB

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

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

Download in other formats: