Context Navigation

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

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

/trunk

Merge bugfixes and enhancements from /branches/stable r360 through r369

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

File size: 43.9 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: 2007-11-27 17:27:45 +0000 (Tue, 27 Nov 2007) $
	7	# SVN revision $Rev: 371 $
	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
	402	my $count=0;
	403	while (my @data = $sth->fetchrow_array()) {
[320]	404	# cidr,city,type,custid,swip,description, as per the SELECT
[4]	405	my $cidr = new NetAddr::IP $data[0];
	406
	407	# Clean up extra spaces that are borking things.
[157]	408	# $data[2] =~ s/\s+//g;
[4]	409
[187]	410	# Prefix subblocks with "Sub "
	411	my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
[186]	412	qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
[320]	413	$data[1], $disp_alloctypes{$data[2]}, $data[3],
	414	($data[4] eq 'y' ? 'Yes' : 'No'), $data[5]);
[4]	415	# If the allocation is a pool, allow listing of the IPs in the pool.
[157]	416	if ($data[2] =~ /^.[pd]$/) {
[4]	417	$row[0] .= '   <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	418	"&pool=$data[0]\">List IPs</a>";
	419	}
	420
	421	printRow(\@row, 'color1') if ($count%2 == 0);
	422	printRow(\@row, 'color2') if ($count%2 != 0);
	423	$count++;
	424	}
	425
	426	print "</table>\n";
	427
	428	# If the routed block has no allocations, by definition it only has
	429	# one free block, and therefore may be deleted.
	430	if ($count == 0) {
	431	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	432	qq($master.</div></center>\n).
[233]	433	($IPDBacl{$authuser} =~ /d/ ?
	434	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	435	qq(<input type=hidden name=action value="delete">\n).
	436	qq(<input type=hidden name=block value="$master">\n).
	437	qq(<input type=hidden name=alloctype value="rm">\n).
	438	qq(<input type=submit value=" Remove this block ">\n).
	439	qq(</form>\n) :
	440	'');
[4]	441	}
	442
	443	print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
	444	qq(submaster $master</div></center>\n);
	445
	446	startTable('CIDR block','Range');
	447
	448	# Snag the free blocks. We don't really need to be pedantic about avoiding
	449	# unrouted free blocks, but it's better to let the database do the work if we can.
	450	$count = 0;
[186]	451	$sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
	452	" order by cidr");
[4]	453	$sth->execute();
	454	while (my @data = $sth->fetchrow_array()) {
[186]	455	# cidr,routed
[4]	456	my $cidr = new NetAddr::IP $data[0];
[187]	457	# Include some HairyPerl(TM) to prefix subblocks with "Sub "
	458	my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
[233]	459	($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
[21]	460	$cidr->range);
[118]	461	printRow(\@row, 'color1') if ($count%2 == 0);
	462	printRow(\@row, 'color2') if ($count%2 != 0);
	463	$count++;
[4]	464	}
	465
	466	print "</table>\n";
	467	} # showRBlock
	468
	469
	470	# List the IPs used in a pool
	471	sub listPool {
	472
	473	my $cidr = new NetAddr::IP $webvar{pool};
	474
[157]	475	my ($pooltype,$poolcity);
	476
[4]	477	# Snag pool info for heading
[157]	478	$sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
[4]	479	$sth->execute;
[157]	480	$sth->bind_columns(\$pooltype, \$poolcity);
	481	$sth->fetch() \|\| carp $sth->errstr;
[4]	482
	483	print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
[157]	484	qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
	485	# Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
	486	if ($pooltype =~ /^.d$/) {
	487	print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
	488	print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
[4]	489	$cidr->addr."</td></tr>\n";
[157]	490	$cidr++;
	491	print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
	492	$cidr--; $cidr--;
	493	print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
[4]	494	"<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
	495	"</table></div></div>\n";
[157]	496	}
[4]	497
	498	# probably have to add an "edit IP allocation" link here somewhere.
	499
	500	startTable('IP','Customer ID','Available?','Description','');
[157]	501	$sth = $ip_dbh->prepare("select ip,custid,available,description,type".
	502	" from poolips where pool='$webvar{pool}' order by ip");
[4]	503	$sth->execute;
	504	my $count = 0;
	505	while (my @data = $sth->fetchrow_array) {
[74]	506	# pool,ip,custid,city,ptype,available,notes,description,circuitid
[157]	507	# ip,custid,available,description,type
	508	# If desc is "null", make it not null. <g>
	509	if ($data[3] eq '') {
	510	$data[3] = ' ';
[4]	511	}
	512	# Some nice hairy Perl to decide whether to allow unassigning each IP
[157]	513	# -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
[4]	514	# else we print a blank space
[157]	515	my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
	516	$data[1],$data[2],$data[3],
[233]	517	( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
[157]	518	("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
	519	"alloctype=$data[4]\">Unassign this IP</a>") :
[4]	520	(" ") )
	521	);
	522	printRow(\@row, 'color1') if($count%2==0);
	523	printRow(\@row, 'color2') if($count%2!=0);
	524	$count++;
	525	}
	526	print "</table>\n";
	527
	528	} # end listPool
	529
	530
[106]	531	# Show "Add new allocation" page. Note that the actual page may
	532	# be one of two templates, and the lists come from the database.
[4]	533	sub assignBlock {
	534
[233]	535	if ($IPDBacl{$authuser} !~ /a/) {
	536	printError("You shouldn't have been able to get here. Access denied.");
	537	return;
	538	}
	539
[21]	540	my $html;
	541
	542	# New special case- block to assign is specified
	543	if ($webvar{block} ne '') {
	544	open HTML, "../fb-assign.html"
	545	or croak "Could not open fb-assign.html: $!";
	546	$html = join('',<HTML>);
	547	close HTML;
	548	my $block = new NetAddr::IP $webvar{block};
	549	$html =~ s\|\$\$BLOCK\$\$\|$block\|g;
	550	$html =~ s\|\$\$MASKBITS\$\$\|$block->masklen\|;
[106]	551	my $typelist = '';
[187]	552
	553	# This is a little dangerous, as it's theoretically possible to
	554	# get fbtype='n' (aka a non-routed freeblock). However, should
	555	# someone manage to get there, they get what they deserve.
	556	if ($webvar{fbtype} ne 'y') {
	557	# Snag the type of the block from the database. We have no
	558	# convenient way to pass this in from the calling location. :/
	559	$sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
	560	$sth->execute;
	561	my @data = $sth->fetchrow_array;
	562	$data[0] =~ s/c$/r/; # Munge the type into the correct form
[191]	563	$typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
[187]	564	} else {
	565	$typelist .= qq(<select name="alloctype">\n);
	566	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
[191]	567	"and type not like '_i' and type not like '_r' order by listorder");
[187]	568	$sth->execute;
	569	my @data = $sth->fetchrow_array;
	570	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	571	while (my @data = $sth->fetchrow_array) {
	572	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	573	}
	574	$typelist .= "</select>\n";
[106]	575	}
	576	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[21]	577	} else {
	578	open HTML, "../assign.html"
[4]	579	or croak "Could not open assign.html: $!";
[21]	580	$html = join('',<HTML>);
[92]	581	close HTML;
[31]	582	my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
	583	foreach my $master (@masterblocks) {
	584	$masterlist .= "<option>$master</option>\n";
	585	}
	586	$masterlist .= "</select>\n";
	587	$html =~ s\|\$\$MASTERLIST\$\$\|$masterlist\|g;
[92]	588	my $pops = '';
	589	foreach my $pop (@poplist) {
	590	$pops .= "<option>$pop</option>\n";
	591	}
	592	$html =~ s\|\$\$POPLIST\$\$\|$pops\|g;
[106]	593	my $typelist = '';
	594	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
	595	$sth->execute;
	596	my @data = $sth->fetchrow_array;
	597	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	598	while (my @data = $sth->fetchrow_array) {
	599	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	600	}
	601	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[21]	602	}
[92]	603	my $cities = '';
	604	foreach my $city (@citylist) {
	605	$cities .= "<option>$city</option>\n";
	606	}
	607	$html =~ s\|\$\$ALLCITIES\$\$\|$cities\|g;
[4]	608
[284]	609	my $i = 0;
	610	$i++ if $webvar{fbtype} eq 'y';
	611	# Check to see if user is allowed to do anything with sensitive data
	612	my $privdata = '';
	613	if ($IPDBacl{$authuser} =~ /s/) {
	614	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	615	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	616	qq(</textarea></td></tr>\n);
	617	$i++;
	618	}
	619	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	620
	621	$i = $i % 2;
	622	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	623
[4]	624	print $html;
	625
	626	} # assignBlock
	627
	628
	629	# Take info on requested IP assignment and see what we can provide.
	630	sub confirmAssign {
[233]	631	if ($IPDBacl{$authuser} !~ /a/) {
	632	printError("You shouldn't have been able to get here. Access denied.");
	633	return;
	634	}
[4]	635
	636	my $cidr;
	637	my $alloc_from;
	638
	639	# Going to manually validate some items.
	640	# custid and city are automagic.
[111]	641	return if !validateInput();
[4]	642
	643	# Several different cases here.
	644	# Static IP vs netblock
	645	# + Different flavours of static IP
	646	# + Different flavours of netblock
	647
[157]	648	if ($webvar{alloctype} =~ /^.i$/) {
[4]	649	my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
[214]	650	my ($sql,$city);
	651	# Check for pools in Subury, North Bay, or Toronto if DSL or server pool.
	652	# Anywhere else is invalid and shouldn't be in the db in the first place.
[4]	653	# ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
	654	# Note that we want to retain the requested city to relate to customer info.
	655	if ($base =~ /^[ds]$/) {
[214]	656	$city = "(allocations.city='Sudbury' or allocations.city='North Bay' or ".
	657	"allocations.city='Toronto')";
[4]	658	} else {
[214]	659	$city = "allocations.city='$webvar{pop}'";
[4]	660	}
	661
[214]	662	# Ewww. But it works.
	663	$sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
	664	"poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
	665	"poolips.pool=allocations.cidr AND $city AND poolips.type LIKE '".$base."_' ".
	666	"GROUP BY pool");
[4]	667	$sth->execute;
	668	my $optionlist;
	669	while (my @data = $sth->fetchrow_array) {
[214]	670	# city,pool cidr,free IP count
	671	if ($data[2] > 0) {
	672	$optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
	673	}
[4]	674	}
	675	$cidr = "Single static IP";
	676	$alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
	677
	678	} else { # end show pool options
[21]	679
	680	if ($webvar{fbassign} eq 'y') {
	681	$cidr = new NetAddr::IP $webvar{block};
	682	$webvar{maskbits} = $cidr->masklen;
	683	} else { # done with direct freeblocks assignment
	684
	685	if (!$webvar{maskbits}) {
[111]	686	printError("Please specify a CIDR mask length.");
	687	return;
[21]	688	}
	689	my $sql;
	690	my $city;
	691	my $failmsg;
[320]	692	my $extracond = '';
	693	if ($webvar{allocfrom} eq '-') {
	694	$extracond = ($webvar{allowpriv} eq 'on' ? '' :
	695	" and not (cidr <<= '192.168.0.0/16'".
	696	" or cidr <<= '10.0.0.0/8'".
	697	" or cidr <<= '172.16.0.0/12')");
	698	}
	699	my $sortorder;
[187]	700	if ($webvar{alloctype} eq 'rm') {
[31]	701	if ($webvar{allocfrom} ne '-') {
	702	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
[320]	703	" and cidr <<= '$webvar{allocfrom}'";
	704	$sortorder = "maskbits desc";
[31]	705	} else {
[320]	706	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
	707	$sortorder = "maskbits desc";
[31]	708	}
[21]	709	$failmsg = "No suitable free block found.<br>\nWe do not have a free".
	710	" routeable block of that size.<br>\nYou will have to either route".
	711	" a set of smaller netblocks or a single smaller netblock.";
[4]	712	} else {
[118]	713	##fixme
	714	# This section needs serious Pondering.
[214]	715	# Pools of most types get assigned to the POP they're "routed from"
[187]	716	# This includes WAN blocks and other netblock "containers"
[214]	717	# This does NOT include cable pools.
	718	if ($webvar{alloctype} =~ /^.[pc]$/) {
	719	if (($webvar{city} !~ /^(Sudbury\|North Bay\|Toronto)$/) && ($webvar{alloctype} eq 'dp')) {
	720	printError("You must chose Sudbury, North Bay, or Toronto for DSL pools.");
[111]	721	return;
	722	}
[37]	723	$city = $webvar{city};
[21]	724	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[118]	725	" superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
[21]	726	" block size for the pool.";
	727	} else {
	728	$city = $webvar{pop};
	729	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[106]	730	" superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
[21]	731	" chose a smaller blocksize.";
	732	}
[300]	733	if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
[157]	734	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[186]	735	" and cidr <<= '$webvar{allocfrom}' and routed='".
[320]	736	(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	737	$sortorder = "maskbits desc,cidr";
[31]	738	} else {
[157]	739	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[320]	740	" and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	741	$sortorder = "maskbits desc,cidr";
[31]	742	}
[4]	743	}
[320]	744	$sql = $sql.$extracond." order by ".$sortorder;
[21]	745	$sth = $ip_dbh->prepare($sql);
	746	$sth->execute;
	747	my @data = $sth->fetchrow_array();
	748	if ($data[0] eq "") {
[111]	749	printError($failmsg);
	750	return;
[21]	751	}
	752	$cidr = new NetAddr::IP $data[0];
	753	} # check for freeblocks assignment or IPDB-controlled assignment
[4]	754
	755	$alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
	756
	757	# If the block to be allocated is smaller than the one we found,
	758	# figure out the "real" block to be allocated.
	759	if ($cidr->masklen() ne $webvar{maskbits}) {
	760	my $maskbits = $cidr->masklen();
	761	my @subblocks;
	762	while ($maskbits++ < $webvar{maskbits}) {
	763	@subblocks = $cidr->split($maskbits);
	764	}
	765	$cidr = $subblocks[0];
	766	}
[157]	767	} # if ($webvar{alloctype} =~ /^.i$/)
[4]	768
	769	open HTML, "../confirm.html"
	770	or croak "Could not open confirm.html: $!";
	771	my $html = join '', <HTML>;
	772	close HTML;
	773
	774	### gotta fix this in final
	775	# Stick in customer info as necessary - if it's blank, it just ends
	776	# up as blank lines ignored in the rendering of the page
	777	my $custbits;
	778	$html =~ s\|\$\$CUSTBITS\$\$\|$custbits\|g;
	779	###
	780
	781	# Stick in the allocation data
	782	$html =~ s\|\$\$ALLOC_TYPE\$\$\|$webvar{alloctype}\|g;
[106]	783	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$webvar{alloctype}}\|g;
[4]	784	$html =~ s\|\$\$ALLOC_FROM\$\$\|$alloc_from\|g;
	785	$html =~ s\|\$\$CIDR\$\$\|$cidr\|g;
[87]	786	$webvar{city} = desanitize($webvar{city});
[4]	787	$html =~ s\|\$\$CITY\$\$\|$webvar{city}\|g;
	788	$html =~ s\|\$\$CUSTID\$\$\|$webvar{custid}\|g;
[87]	789	$webvar{circid} = desanitize($webvar{circid});
[74]	790	$html =~ s\|\$\$CIRCID\$\$\|$webvar{circid}\|g;
[4]	791	$webvar{desc} = desanitize($webvar{desc});
[92]	792	$html =~ s\|\$\$DESC\$\$\|$webvar{desc}\|g;
[4]	793	$webvar{notes} = desanitize($webvar{notes});
	794	$html =~ s\|\$\$NOTES\$\$\|$webvar{notes}\|g;
	795	$html =~ s\|\$\$ACTION\$\$\|insert\|g;
	796
[284]	797	my $i=1;
	798	# Check to see if user is allowed to do anything with sensitive data
	799	my $privdata = '';
	800	if ($IPDBacl{$authuser} =~ /s/) {
	801	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	802	qq(<td class=regular>$webvar{privdata}).
	803	qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
	804	$i++;
	805	}
[299]	806	# We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
	807	$privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
	808	if $webvar{userid};
[284]	809	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	810
	811	$i = $i % 2;
	812	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	813
[4]	814	print $html;
	815
	816	} # end confirmAssign
	817
	818
	819	# Do the work of actually inserting a block in the database.
	820	sub insertAssign {
[233]	821	if ($IPDBacl{$authuser} !~ /a/) {
	822	printError("You shouldn't have been able to get here. Access denied.");
	823	return;
	824	}
[4]	825	# Some things are done more than once.
[111]	826	return if !validateInput();
[4]	827
[284]	828	if (!defined($webvar{privdata})) {
	829	$webvar{privdata} = '';
	830	}
[106]	831	# $code is "success" vs "failure", $msg contains OK for a
	832	# successful netblock allocation, the IP allocated for static
	833	# IP, or the error message if an error occurred.
	834	my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
	835	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
[284]	836	$webvar{circid}, $webvar{privdata});
[4]	837
[111]	838	if ($code eq 'OK') {
[106]	839	if ($webvar{alloctype} =~ /^.i$/) {
[300]	840	$msg =~ s\|/32\|\|;
[297]	841	print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
[312]	842	( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
[301]	843	qq(<div><a href="https://billing.example.com/extserv.pl?).
[314]	844	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
[302]	845	qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
[297]	846	: "</div>");
[106]	847	# Notify tech@example.com
[247]	848	# mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	849	# "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
	850	# "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[106]	851	} else {
[301]	852	my $netblock = new NetAddr::IP $webvar{fullcidr};
[106]	853	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[301]	854	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
[313]	855	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[301]	856	qq(<div><a href="https://billing.example.com/extserv.pl?).
[314]	857	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
[301]	858	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
[302]	859	"&include_routed_subnet=1&ipdb=1".
[301]	860	qq(">Add this netblock to RADIUS user table</a></div>)
	861	: "</div>");
[4]	862	}
[106]	863	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[256]	864	"'$webvar{alloctype}' ($msg)";
[111]	865	} else {
	866	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	867	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[189]	868	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[157]	869	" failed:<br>\n$msg\n");
[106]	870	}
[4]	871
	872	} # end insertAssign()
	873
	874
	875	# Does some basic checks on common input data to make sure nothing
	876	# really weird gets in to the database through this script.
	877	# Does NOT do complete input validation!!!
	878	sub validateInput {
	879	if ($webvar{city} eq '-') {
[111]	880	printError("Please choose a city.");
	881	return;
[4]	882	}
[138]	883
	884	# Alloctype check.
[4]	885	chomp $webvar{alloctype};
[138]	886	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	887	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	888	# managing to call things in such a way as to cause this deserves a cryptic error.
	889	printError("Invalid alloctype");
	890	return;
	891	}
	892
	893	# CustID check
[4]	894	# We have different handling for customer allocations and "internal" or "our" allocations
[214]	895	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	896	if (!$webvar{custid}) {
[111]	897	printError("Please enter a customer ID.");
	898	return;
[4]	899	}
[301]	900	if ($webvar{custid} !~ /^(?:\d{5,10}\|STAFF\|TEMP)(?:-\d\d?)?$/) {
[111]	901	printError("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
	902	return;
[4]	903	}
	904	print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[138]	905	} else {
[167]	906	# New! Improved! And now Loaded From The Database!!
[320]	907	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
	908	$webvar{custid} = $def_custids{$webvar{alloctype}};
	909	}
[4]	910	}
[111]	911
	912	# Check POP location
	913	my $flag;
[187]	914	if ($webvar{alloctype} eq 'rm') {
[111]	915	$flag = 'for a routed netblock';
	916	foreach (@poplist) {
	917	if (/^$webvar{city}$/) {
	918	$flag = 'n';
	919	last;
	920	}
	921	}
	922	} else {
	923	$flag = 'n';
[320]	924	if ($webvar{alloctype} =~ /[wp][cr]\|d[pi]/) {
[300]	925	# Set this forcibly rather than messing around elsewhere. Yes, this is a hack. PTHBTT!!
[320]	926	# Match CORE/WAN types (wc, wr, pc, pr), DSL pool and IP (dp, di).
	927	$webvar{pop} = "Sudbury";
	928	} elsif ($webvar{pop} =~ /^-$/) {
[111]	929	$flag = 'to route the block from/through';
	930	}
	931	}
	932	if ($flag ne 'n') {
	933	printError("Please choose a valid POP location $flag. Valid ".
	934	"POP locations are currently:<br>\n".join (" - ", @poplist));
	935	return;
	936	}
	937
	938	return 'OK';
[4]	939	} # end validateInput
	940
	941
	942	# Displays details of a specific allocation in a form
	943	# Allows update/delete
	944	# action=edit
	945	sub edit {
	946
	947	my $sql;
	948
	949	# Two cases: block is a netblock, or block is a static IP from a pool
	950	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	951	if ($webvar{block} =~ /\/32$/) {
[320]	952	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	953	} else {
[320]	954	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	955	}
	956
	957	# gotta snag block info from db
	958	$sth = $ip_dbh->prepare($sql);
	959	$sth->execute;
	960	my @data = $sth->fetchrow_array;
	961
	962	# Clean up extra whitespace on alloc type
	963	$data[2] =~ s/\s//;
	964
	965	open (HTML, "../editDisplay.html")
	966	or croak "Could not open editDisplay.html :$!";
	967	my $html = join('', <HTML>);
	968
	969	# We can't let the city be changed here; this block is a part of
	970	# a larger routed allocation and therefore by definition can't be moved.
	971	# block and city are static.
	972	##fixme
	973	# Needs thinking. Have to allow changes to city to correct errors, no?
	974	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	975
[233]	976	if ($IPDBacl{$authuser} =~ /c/) {
	977	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	978
[4]	979	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	980	# with the much longer list of allocation types.
	981	# We'll just show what type of block it is.
	982
[33]	983	# this has now been Requested, so here goes.
[4]	984
[187]	985	##fixme The check here should be built from the database
[233]	986	if ($data[2] =~ /^.[ne]$/) {
	987	# Block that can be changed
	988	my $blockoptions = "<select name=alloctype><option".
[187]	989	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[228]	990	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	991	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	992	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[33]	993	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[187]	994	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[135]	995	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[33]	996	"</select>\n";
[233]	997	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	998	} else {
	999	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1000	}
[320]	1001	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[233]	1002	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1003	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1004	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1005	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[33]	1006	} else {
[233]	1007	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[320]	1008	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[233]	1009	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1010	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1011	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1012	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1013	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[33]	1014	}
[255]	1015	my ($lastmod,undef) = split /\s+/, $data[7];
	1016	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[33]	1017
[320]	1018	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1019	if ($data[2] =~ /.i/) {
	1020	$html =~ s/\$\$SWIP\$\$/N\/A/;
	1021	} else {
	1022	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
	1023	'<input type=checkbox name=swip checked=yes>');
	1024	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1025	}
	1026
[255]	1027	# Allows us to "correctly" colour backgrounds in table
	1028	my $i=1;
	1029
[284]	1030	# Check to see if we can display sensitive data
	1031	my $privdata = '';
	1032	if ($IPDBacl{$authuser} =~ /s/) {
	1033	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1034	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1035	qq($data[8]</textarea></td></tr>\n);
	1036	$i++;
	1037	}
	1038	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1039
[233]	1040	# More ACL trickery - we can live with forms that don't submit,
	1041	# but we can't leave the extra table rows there, and we really
	1042	# can't leave the submit buttons there.
	1043	my $updok = '';
	1044	if ($IPDBacl{$authuser} =~ /c/) {
[284]	1045	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[233]	1046	qq(<input type="submit" value=" Update this block " class="regular">).
	1047	"</div></td></tr></form>\n";
[255]	1048	$i++;
[233]	1049	}
	1050	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1051
[233]	1052	my $delok = '';
	1053	if ($IPDBacl{$authuser} =~ /d/) {
	1054	$delok = qq(<form method="POST" action="main.cgi">
[284]	1055	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[233]	1056	<input type="hidden" name="action" value="delete">
	1057	<input type="hidden" name="block" value="$webvar{block}">
	1058	<input type="hidden" name="alloctype" value="$data[2]">
	1059	<input type=submit value=" Delete this block ">
	1060	</div></td></tr>);
	1061	}
	1062	$html =~ s/\$\$DELOK\$\$/$delok/;
	1063
[4]	1064	print $html;
	1065
	1066	} # edit()
	1067
	1068
	1069	# Stuff new info about a block into the db
	1070	# action=update
	1071	sub update {
[284]	1072	if ($IPDBacl{$authuser} !~ /c/) {
	1073	printError("You shouldn't have been able to get here. Access denied.");
	1074	return;
	1075	}
[4]	1076
[284]	1077	# Check to see if we can update restricted data
	1078	my $privdata = '';
	1079	if ($IPDBacl{$authuser} =~ /s/) {
	1080	$privdata = ",privdata='$webvar{privdata}'";
	1081	}
	1082
[4]	1083	# Make sure incoming data is in correct format - custID among other things.
[228]	1084	return if !validateInput;
[4]	1085
	1086	# SQL transaction wrapper
	1087	eval {
	1088	# Relatively simple SQL transaction here.
	1089	my $sql;
[157]	1090	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[74]	1091	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[284]	1092	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1093	"$privdata where ip='$webvar{block}'";
[4]	1094	} else {
	1095	$sql = "update allocations set custid='$webvar{custid}',".
[33]	1096	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[320]	1097	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
	1098	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[284]	1099	"where cidr='$webvar{block}'";
[4]	1100	}
[157]	1101	# Log the details of the change.
	1102	syslog "debug", $sql;
[4]	1103	$sth = $ip_dbh->prepare($sql);
	1104	$sth->execute;
	1105	$ip_dbh->commit;
	1106	};
	1107	if ($@) {
[166]	1108	my $msg = $@;
	1109	carp "Transaction aborted because $msg";
[4]	1110	eval { $ip_dbh->rollback; };
[166]	1111	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1112	printError("Could not update block/IP $webvar{block}: $msg");
[111]	1113	return;
[4]	1114	}
	1115
	1116	# If we get here, the operation succeeded.
	1117	syslog "notice", "$authuser updated $webvar{block}";
	1118	open (HTML, "../updated.html")
[111]	1119	or croak "Could not open updated.html :$!";
[4]	1120	my $html = join('', <HTML>);
	1121
[320]	1122	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1123	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[92]	1124	$webvar{city} = desanitize($webvar{city});
[4]	1125	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1126	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[106]	1127	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1128	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[320]	1129	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[92]	1130	$webvar{circid} = desanitize($webvar{circid});
[74]	1131	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[92]	1132	$webvar{desc} = desanitize($webvar{desc});
[4]	1133	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[92]	1134	$webvar{notes} = desanitize($webvar{notes});
[4]	1135	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
	1136
[284]	1137	if ($IPDBacl{$authuser} =~ /s/) {
	1138	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1139	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1140	}
	1141	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1142
[4]	1143	print $html;
	1144
	1145	} # update()
	1146
	1147
	1148	# Delete an allocation.
[106]	1149	sub remove {
[233]	1150	if ($IPDBacl{$authuser} !~ /d/) {
	1151	printError("You shouldn't have been able to get here. Access denied.");
	1152	return;
	1153	}
	1154
[4]	1155	#show confirm screen.
	1156	open HTML, "../confirmRemove.html"
	1157	or croak "Could not open confirmRemove.html :$!";
	1158	my $html = join('', <HTML>);
	1159	close HTML;
	1160
	1161	# Serves'em right for getting here...
	1162	if (!defined($webvar{block})) {
[111]	1163	printError("Error 332");
	1164	return;
[4]	1165	}
	1166
[284]	1167	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1168
[187]	1169	if ($webvar{alloctype} eq 'rm') {
[4]	1170	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1171	$sth->execute();
	1172
	1173	# This feels... extreme.
	1174	croak $sth->errstr() if($sth->errstr());
	1175
	1176	$sth->bind_columns(\$cidr,\$city);
	1177	$sth->execute();
	1178	$sth->fetch \|\| croak $sth->errstr();
	1179	$custid = "N/A";
	1180	$alloctype = $webvar{alloctype};
[74]	1181	$circid = "N/A";
[4]	1182	$desc = "N/A";
	1183	$notes = "N/A";
	1184
	1185	} elsif ($webvar{alloctype} eq 'mm') {
	1186	$cidr = $webvar{block};
	1187	$city = "N/A";
	1188	$custid = "N/A";
	1189	$alloctype = $webvar{alloctype};
[74]	1190	$circid = "N/A";
[4]	1191	$desc = "N/A";
	1192	$notes = "N/A";
[189]	1193	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1194
	1195	# Unassigning a static IP
[284]	1196	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1197	" from poolips where ip='$webvar{block}'");
[4]	1198	$sth->execute();
	1199	# croak $sth->errstr() if($sth->errstr());
	1200
[284]	1201	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1202	\$privdata);
[4]	1203	$sth->fetch() \|\| croak $sth->errstr;
	1204
[157]	1205	} else { # done with alloctype=~ /^.i$/
[4]	1206
[284]	1207	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1208	" from allocations where cidr='$webvar{block}'");
[4]	1209	$sth->execute();
	1210	# croak $sth->errstr() if($sth->errstr());
	1211
[284]	1212	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1213	\$notes, \$privdata);
[74]	1214	$sth->fetch() \|\| carp $sth->errstr;
[4]	1215	} # end cases for different alloctypes
	1216
	1217	# Munge everything into HTML
	1218	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1219	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[106]	1220	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1221	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1222	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1223	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[74]	1224	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1225	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1226	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1227
	1228	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1229
	1230	# Set the warning text.
[157]	1231	if ($alloctype =~ /^.[pd]$/) {
[4]	1232	$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>\|;
	1233	} else {
	1234	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1235	}
	1236
[284]	1237	my $i = 1;
	1238	# Check to see if user is allowed to do anything with sensitive data
	1239	if ($IPDBacl{$authuser} =~ /s/) {
	1240	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1241	qq(<td class=regular>$privdata</td></tr>\n);
	1242	$i++;
	1243	}
	1244	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1245
	1246	$i = ++$i % 2;
	1247	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1248
[4]	1249	print $html;
	1250	} # end edit()
	1251
	1252
	1253	# Delete an allocation. Return it to the freeblocks table; munge
	1254	# data as necessary to keep as few records as possible in freeblocks
	1255	# to prevent weirdness when allocating blocks later.
	1256	# Remove IPs from pool listing if necessary
	1257	sub finalDelete {
[233]	1258	if ($IPDBacl{$authuser} !~ /d/) {
	1259	printError("You shouldn't have been able to get here. Access denied.");
	1260	return;
	1261	}
[4]	1262
[370]	1263	# need to retrieve block data before deleting so we can notify on that
	1264	my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
	1265
[106]	1266	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1267
[106]	1268	if ($code eq 'OK') {
[4]	1269	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[370]	1270	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
	1271	" $custid, $city, desc='$description'";
[214]	1272	# Notify tech@ when a block/IP is deallocated
[247]	1273	# mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
[370]	1274	# "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1275	# "CustID: $custid\nCity: $city\nDescription: $description\n");
[106]	1276	} else {
	1277	if ($webvar{alloctype} =~ /^.i$/) {
	1278	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
[111]	1279	printError("Could not deallocate static IP $webvar{block}: $msg");
[106]	1280	} else {
	1281	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
[111]	1282	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1283	}
[106]	1284	}
[4]	1285
	1286	} # finalDelete
	1287
	1288
[233]	1289	sub exitError {
	1290	my $errStr = $_[0];
	1291	printHeader('','');
	1292	print qq(<center><p class="regular"> $errStr </p>
	1293	<input type="button" value="Back" onclick="history.go(-1)">
	1294	</center>
	1295	);
	1296	printFooter();
	1297	exit;
	1298	} # errorExit
	1299
	1300
[4]	1301	# Just in case we manage to get here.
	1302	exit 0;

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

Download in other formats: