Context Navigation

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

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

/branches/stable

Update billing backlinks on static IP and dynamic-route DSL allocations

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

File size: 44.9 KB

Rev	Line
[4]	1	#!/usr/bin/perl
	2	# ipdb/cgi-bin/main.cgi
	3	# Started munging from noc.vianet's old IPDB 04/22/2004
[8]	4	###
	5	# SVN revision info
	6	# $Date: 2006-04-06 14:37:34 +0000 (Thu, 06 Apr 2006) $
	7	# SVN revision $Rev: 322 $
	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	}
[315]	756	if (defined $webvar{allocfrom} && $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	}
[315]	829	# We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
	830	$privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
	831	if $webvar{userid};
[286]	832	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	833
	834	$i = $i % 2;
	835	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	836
[4]	837	print $html;
	838
	839	} # end confirmAssign
	840
	841
	842	# Do the work of actually inserting a block in the database.
	843	sub insertAssign {
[242]	844	if ($IPDBacl{$authuser} !~ /a/) {
	845	printError("You shouldn't have been able to get here. Access denied.");
	846	return;
	847	}
[4]	848	# Some things are done more than once.
[125]	849	return if !validateInput();
[4]	850
[286]	851	if (!defined($webvar{privdata})) {
	852	$webvar{privdata} = '';
	853	}
[125]	854	# $code is "success" vs "failure", $msg contains OK for a
	855	# successful netblock allocation, the IP allocated for static
	856	# IP, or the error message if an error occurred.
	857	my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
	858	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
[286]	859	$webvar{circid}, $webvar{privdata});
[4]	860
[125]	861	if ($code eq 'OK') {
	862	if ($webvar{alloctype} =~ /^.i$/) {
[315]	863	$msg =~ s\|/32\|\|;
	864	print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
	865	( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
[322]	866	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	867	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	868	qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
	869	: "</div>");
[122]	870	# Notify tech@example.com
[203]	871	mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
[125]	872	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
[122]	873	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[125]	874	} else {
[315]	875	my $netblock = new NetAddr::IP $webvar{fullcidr};
[125]	876	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[315]	877	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
	878	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[322]	879	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	880	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	881	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
	882	"&include_routed_subnet=1&ipdb=1".
	883	qq(">Add this netblock to RADIUS user table</a></div>)
	884	: "</div>");
[122]	885	}
[125]	886	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[251]	887	"'$webvar{alloctype}' ($msg)";
[125]	888	} else {
	889	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	890	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[192]	891	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[159]	892	" failed:<br>\n$msg\n");
[125]	893	}
[122]	894
[4]	895	} # end insertAssign()
	896
	897
	898	# Does some basic checks on common input data to make sure nothing
	899	# really weird gets in to the database through this script.
	900	# Does NOT do complete input validation!!!
	901	sub validateInput {
	902	if ($webvar{city} eq '-') {
[125]	903	printError("Please choose a city.");
	904	return;
[4]	905	}
[140]	906
	907	# Alloctype check.
[4]	908	chomp $webvar{alloctype};
[140]	909	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	910	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	911	# managing to call things in such a way as to cause this deserves a cryptic error.
	912	printError("Invalid alloctype");
	913	return;
	914	}
	915
	916	# CustID check
[4]	917	# We have different handling for customer allocations and "internal" or "our" allocations
[209]	918	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	919	if (!$webvar{custid}) {
[125]	920	printError("Please enter a customer ID.");
	921	return;
[4]	922	}
[116]	923	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
[56]	924	# Force uppercase for now...
	925	$webvar{custid} =~ tr/a-z/A-Z/;
	926	# Crosscheck with ... er... something.
	927	my $status = CustIDCK->custid_exist($webvar{custid});
[125]	928	if ($CustIDCK::Error) {
	929	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	930	return;
	931	}
	932	if (!$status) {
	933	printError("Customer ID not valid. Make sure the Customer ID ".
	934	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	935	"non-customer assignments.");
	936	return;
	937	}
[56]	938	#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
	939	#static IPs for staff.");
[4]	940	}
[56]	941	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[140]	942	} else {
[168]	943	# New! Improved! And now Loaded From The Database!!
[56]	944	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
[168]	945	$webvar{custid} = $def_custids{$webvar{alloctype}};
[56]	946	}
[4]	947	}
[125]	948
	949	# Check POP location
	950	my $flag;
[192]	951	if ($webvar{alloctype} eq 'rm') {
[125]	952	$flag = 'for a routed netblock';
	953	foreach (@poplist) {
	954	if (/^$webvar{city}$/) {
	955	$flag = 'n';
	956	last;
	957	}
	958	}
	959	} else {
	960	$flag = 'n';
[315]	961	if ($webvar{alloctype} =~ /[wp][cr]\|[ds][pi]/) {
	962	# Set this forcibly rather than messing around elsewhere. Yes, this is a hack. PTHBTT!!
	963	$webvar{pop} = 'Sudbury';
	964	}
	965	if ($webvar{pop} =~ /^-$/) {
[125]	966	$flag = 'to route the block from/through';
	967	}
	968	}
	969	if ($flag ne 'n') {
	970	printError("Please choose a valid POP location $flag. Valid ".
	971	"POP locations are currently:<br>\n".join (" - ", @poplist));
	972	return;
	973	}
	974
	975	return 'OK';
[4]	976	} # end validateInput
	977
	978
	979	# Displays details of a specific allocation in a form
	980	# Allows update/delete
	981	# action=edit
	982	sub edit {
	983
	984	my $sql;
	985
	986	# Two cases: block is a netblock, or block is a static IP from a pool
	987	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	988	if ($webvar{block} =~ /\/32$/) {
[318]	989	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	990	} else {
[318]	991	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	992	}
	993
	994	# gotta snag block info from db
	995	$sth = $ip_dbh->prepare($sql);
	996	$sth->execute;
	997	my @data = $sth->fetchrow_array;
	998
	999	# Clean up extra whitespace on alloc type
	1000	$data[2] =~ s/\s//;
	1001
	1002	open (HTML, "../editDisplay.html")
	1003	or croak "Could not open editDisplay.html :$!";
	1004	my $html = join('', <HTML>);
	1005
	1006	# We can't let the city be changed here; this block is a part of
	1007	# a larger routed allocation and therefore by definition can't be moved.
	1008	# block and city are static.
	1009	##fixme
	1010	# Needs thinking. Have to allow changes to city to correct errors, no?
	1011	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1012
[242]	1013	if ($IPDBacl{$authuser} =~ /c/) {
	1014	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	1015
[4]	1016	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1017	# with the much longer list of allocation types.
	1018	# We'll just show what type of block it is.
	1019
[35]	1020	# this has now been Requested, so here goes.
[4]	1021
[192]	1022	##fixme The check here should be built from the database
[242]	1023	if ($data[2] =~ /^.[ne]$/) {
	1024	# Block that can be changed
	1025	my $blockoptions = "<select name=alloctype><option".
[192]	1026	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[224]	1027	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	1028	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	1029	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[35]	1030	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[192]	1031	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[133]	1032	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[35]	1033	"</select>\n";
[242]	1034	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1035	} else {
	1036	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1037	}
[318]	1038	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1039	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1040	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1041	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1042	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[35]	1043	} else {
[242]	1044	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[318]	1045	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1046	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1047	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1048	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1049	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1050	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[35]	1051	}
[245]	1052	my ($lastmod,undef) = split /\s+/, $data[7];
	1053	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[35]	1054
[244]	1055	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1056	if ($data[2] =~ /.i/) {
	1057	$html =~ s/\$\$SWIP\$\$/N\/A/;
	1058	} else {
[318]	1059	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
[244]	1060	'<input type=checkbox name=swip checked=yes>');
	1061	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1062	}
	1063
[245]	1064	# Allows us to "correctly" colour backgrounds in table
	1065	my $i=1;
	1066
[286]	1067	# Check to see if we can display sensitive data
	1068	my $privdata = '';
	1069	if ($IPDBacl{$authuser} =~ /s/) {
	1070	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1071	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1072	qq($data[8]</textarea></td></tr>\n);
	1073	$i++;
	1074	}
	1075	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1076
[242]	1077	# More ACL trickery - we can live with forms that don't submit,
	1078	# but we can't leave the extra table rows there, and we really
	1079	# can't leave the submit buttons there.
	1080	my $updok = '';
	1081	if ($IPDBacl{$authuser} =~ /c/) {
[286]	1082	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[242]	1083	qq(<input type="submit" value=" Update this block " class="regular">).
	1084	"</div></td></tr></form>\n";
[245]	1085	$i++;
[242]	1086	}
	1087	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1088
[242]	1089	my $delok = '';
	1090	if ($IPDBacl{$authuser} =~ /d/) {
	1091	$delok = qq(<form method="POST" action="main.cgi">
[286]	1092	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[242]	1093	<input type="hidden" name="action" value="delete">
	1094	<input type="hidden" name="block" value="$webvar{block}">
	1095	<input type="hidden" name="alloctype" value="$data[2]">
	1096	<input type=submit value=" Delete this block ">
	1097	</div></td></tr>);
	1098	}
	1099	$html =~ s/\$\$DELOK\$\$/$delok/;
	1100
[4]	1101	print $html;
	1102
	1103	} # edit()
	1104
	1105
	1106	# Stuff new info about a block into the db
	1107	# action=update
	1108	sub update {
[286]	1109	if ($IPDBacl{$authuser} !~ /c/) {
	1110	printError("You shouldn't have been able to get here. Access denied.");
	1111	return;
	1112	}
[4]	1113
[286]	1114	# Check to see if we can update restricted data
	1115	my $privdata = '';
	1116	if ($IPDBacl{$authuser} =~ /s/) {
	1117	$privdata = ",privdata='$webvar{privdata}'";
	1118	}
	1119
[4]	1120	# Make sure incoming data is in correct format - custID among other things.
[220]	1121	return if !validateInput;
[4]	1122
	1123	# SQL transaction wrapper
	1124	eval {
	1125	# Relatively simple SQL transaction here.
	1126	my $sql;
[159]	1127	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[75]	1128	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[286]	1129	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1130	"$privdata where ip='$webvar{block}'";
[4]	1131	} else {
	1132	$sql = "update allocations set custid='$webvar{custid}',".
[35]	1133	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[296]	1134	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
[244]	1135	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[286]	1136	"where cidr='$webvar{block}'";
[4]	1137	}
[159]	1138	# Log the details of the change.
	1139	syslog "debug", $sql;
[4]	1140	$sth = $ip_dbh->prepare($sql);
	1141	$sth->execute;
	1142	$ip_dbh->commit;
	1143	};
	1144	if ($@) {
[163]	1145	my $msg = $@;
	1146	carp "Transaction aborted because $msg";
[4]	1147	eval { $ip_dbh->rollback; };
[163]	1148	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1149	printError("Could not update block/IP $webvar{block}: $msg");
[125]	1150	return;
[4]	1151	}
	1152
	1153	# If we get here, the operation succeeded.
	1154	syslog "notice", "$authuser updated $webvar{block}";
	1155	open (HTML, "../updated.html")
[125]	1156	or croak "Could not open updated.html :$!";
[4]	1157	my $html = join('', <HTML>);
	1158
[244]	1159	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1160	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[89]	1161	$webvar{city} = desanitize($webvar{city});
[4]	1162	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1163	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[98]	1164	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1165	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[244]	1166	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[89]	1167	$webvar{circid} = desanitize($webvar{circid});
[75]	1168	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[89]	1169	$webvar{desc} = desanitize($webvar{desc});
[4]	1170	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[89]	1171	$webvar{notes} = desanitize($webvar{notes});
[4]	1172	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
	1173
[286]	1174	if ($IPDBacl{$authuser} =~ /s/) {
	1175	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1176	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1177	}
	1178	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1179
[4]	1180	print $html;
	1181
	1182	} # update()
	1183
	1184
	1185	# Delete an allocation.
[125]	1186	sub remove {
[242]	1187	if ($IPDBacl{$authuser} !~ /d/) {
	1188	printError("You shouldn't have been able to get here. Access denied.");
	1189	return;
	1190	}
	1191
[4]	1192	#show confirm screen.
	1193	open HTML, "../confirmRemove.html"
	1194	or croak "Could not open confirmRemove.html :$!";
	1195	my $html = join('', <HTML>);
	1196	close HTML;
	1197
	1198	# Serves'em right for getting here...
	1199	if (!defined($webvar{block})) {
[125]	1200	printError("Error 332");
	1201	return;
[4]	1202	}
	1203
[286]	1204	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1205
[192]	1206	if ($webvar{alloctype} eq 'rm') {
[4]	1207	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1208	$sth->execute();
	1209
	1210	# This feels... extreme.
	1211	croak $sth->errstr() if($sth->errstr());
	1212
	1213	$sth->bind_columns(\$cidr,\$city);
	1214	$sth->execute();
	1215	$sth->fetch \|\| croak $sth->errstr();
	1216	$custid = "N/A";
	1217	$alloctype = $webvar{alloctype};
[75]	1218	$circid = "N/A";
[4]	1219	$desc = "N/A";
	1220	$notes = "N/A";
	1221
	1222	} elsif ($webvar{alloctype} eq 'mm') {
	1223	$cidr = $webvar{block};
	1224	$city = "N/A";
	1225	$custid = "N/A";
	1226	$alloctype = $webvar{alloctype};
[75]	1227	$circid = "N/A";
[4]	1228	$desc = "N/A";
	1229	$notes = "N/A";
[192]	1230	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1231
	1232	# Unassigning a static IP
[286]	1233	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1234	" from poolips where ip='$webvar{block}'");
[4]	1235	$sth->execute();
	1236	# croak $sth->errstr() if($sth->errstr());
	1237
[286]	1238	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1239	\$privdata);
[4]	1240	$sth->fetch() \|\| croak $sth->errstr;
	1241
[159]	1242	} else { # done with alloctype=~ /^.i$/
[4]	1243
[286]	1244	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1245	" from allocations where cidr='$webvar{block}'");
[4]	1246	$sth->execute();
	1247	# croak $sth->errstr() if($sth->errstr());
	1248
[286]	1249	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1250	\$notes, \$privdata);
[75]	1251	$sth->fetch() \|\| carp $sth->errstr;
[4]	1252	} # end cases for different alloctypes
	1253
	1254	# Munge everything into HTML
	1255	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1256	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[98]	1257	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1258	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1259	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1260	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[75]	1261	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1262	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1263	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1264
	1265	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1266
	1267	# Set the warning text.
[159]	1268	if ($alloctype =~ /^.[pd]$/) {
[4]	1269	$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>\|;
	1270	} else {
	1271	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1272	}
	1273
[286]	1274	my $i = 1;
	1275	# Check to see if user is allowed to do anything with sensitive data
	1276	if ($IPDBacl{$authuser} =~ /s/) {
	1277	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1278	qq(<td class=regular>$privdata</td></tr>\n);
	1279	$i++;
	1280	}
	1281	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1282
	1283	$i = ++$i % 2;
	1284	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1285
[4]	1286	print $html;
	1287	} # end edit()
	1288
	1289
	1290	# Delete an allocation. Return it to the freeblocks table; munge
	1291	# data as necessary to keep as few records as possible in freeblocks
	1292	# to prevent weirdness when allocating blocks later.
	1293	# Remove IPs from pool listing if necessary
	1294	sub finalDelete {
[242]	1295	if ($IPDBacl{$authuser} !~ /d/) {
	1296	printError("You shouldn't have been able to get here. Access denied.");
	1297	return;
	1298	}
[4]	1299
[125]	1300	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1301
[125]	1302	if ($code eq 'OK') {
[4]	1303	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[125]	1304	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
[205]	1305	# Notify tech@ when a block/IP is deallocated
	1306	mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1307	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n");
[125]	1308	} else {
	1309	if ($webvar{alloctype} =~ /^.i$/) {
	1310	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
	1311	printError("Could not deallocate static IP $webvar{block}: $msg");
	1312	} else {
	1313	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
	1314	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1315	}
[102]	1316	}
	1317
[4]	1318	} # finalDelete
	1319
	1320
[242]	1321	sub exitError {
	1322	my $errStr = $_[0];
	1323	printHeader('','');
	1324	print qq(<center><p class="regular"> $errStr </p>
	1325	<input type="button" value="Back" onclick="history.go(-1)">
	1326	</center>
	1327	);
	1328	printFooter();
	1329	exit;
	1330	} # errorExit
	1331
	1332
[4]	1333	# Just in case we manage to get here.
	1334	exit 0;

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

Download in other formats: