Context Navigation

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

Last change on this file since 286 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.

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

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

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

Download in other formats: