Context Navigation

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

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

/branches/stable

Replace inline stub code to add new master with call to new addMaster()
sub in IPDB.pm.

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

File size: 44.3 KB

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

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

Download in other formats: