Context Navigation

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

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

/trunk

Merge bugfixes and enhancements from /branches/stable r351 through r359

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

File size: 44.7 KB

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

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

Download in other formats: