Context Navigation

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

Last change on this file since 402 was 395, checked in by Kris Deugau, 15 years ago

/branches/stable

Finish basic node tracking - add link in header, extend search tool to

handle the appropriate lookup

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

File size: 49.5 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: 2010-02-19 21:24:54 +0000 (Fri, 19 Feb 2010) $
	7	# SVN revision $Rev: 395 $
	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
[383]	34	syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
[4]	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	}
[395]	130	elsif ($webvar{action} eq 'nodesearch') {
	131	open HTML, "<../nodesearch.html";
	132	my $html = join('',<HTML>);
	133	close HTML;
[4]	134
[395]	135	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	136	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	137	my $nodes = '';
	138	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	139	$nodes .= "<option value='$nid'>$nname</option>\n";
	140	}
	141	$html =~ s/\$\$NODELIST\$\$/$nodes/;
	142
	143	print $html;
	144	}
	145
[4]	146	# Default is an error. It shouldn't be possible to easily get here.
	147	# The only way I can think of offhand is to just call main.cgi bare-
	148	# which is not in any way guaranteed to provide anything useful.
	149	else {
	150	my $rnd = rand 500;
	151	my $boing = sprintf("%.2f", rand 500);
	152	my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.",
	153	"Because one of it's legs are both the same", "wibble",
	154	"Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
	155	"8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
	156	printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
	157	}
[125]	158	## Finally! Done with that NASTY "case" emulation!
[4]	159
	160
	161
[125]	162	# Clean up IPDB globals, DB handle, etc.
	163	finish($ip_dbh);
[200]	164
	165	print qq(<div align=right style="position: absolute; right: 30px;">).
	166	qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
[242]	167	if $IPDBacl{$authuser} =~ /A/;
[200]	168
[125]	169	# We print the footer here, so we don't have to do it elsewhere.
	170	printFooter;
	171	# Just in case something waaaayyy down isn't in place
	172	# properly... we exit explicitly.
	173	exit;
[4]	174
	175
[125]	176
[4]	177	# args are: a reference to an array with the row to be printed and the
	178	# class(stylesheet) to use for formatting.
	179	# if ommitting the class - call the sub as &printRow(\@array)
	180	sub printRow {
	181	my ($rowRef,$class) = @_;
	182
	183	if (!$class) {
	184	print "<tr>\n";
	185	} else {
	186	print "<tr class=\"$class\">\n";
	187	}
	188
[134]	189	ELEMENT: foreach my $element (@$rowRef) {
	190	if (!defined($element)) {
	191	print "<td></td>\n";
	192	next ELEMENT;
	193	}
[4]	194	$element =~ s\|\n\|</br>\|g;
	195	print "<td>$element</td>\n";
	196	}
	197	print "</tr>";
	198	} # printRow
	199
	200
	201	# Prints table headings. Accepts any number of arguments;
	202	# each argument is a table heading.
	203	sub startTable {
	204	print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
	205
	206	foreach(@_) {
	207	print qq(<td class="heading">$_</td>);
	208	}
	209	print "</tr>\n";
	210	} # startTable
	211
	212
	213	# Initial display: Show master blocks with total allocated subnets, total free subnets
[125]	214	sub showSummary {
[4]	215
	216	startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
	217	'Free netblocks', 'Largest free block');
	218
[125]	219	my %allocated;
	220	my %free;
	221	my %routed;
	222	my %bigfree;
	223
	224	# Count the allocations.
	225	$sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
	226	foreach my $master (@masterblocks) {
	227	$sth->execute("$master");
	228	$sth->bind_columns(\$allocated{"$master"});
	229	$sth->fetch();
[4]	230	}
	231
[125]	232	# Count routed blocks
	233	$sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
	234	foreach my $master (@masterblocks) {
	235	$sth->execute("$master");
	236	$sth->bind_columns(\$routed{"$master"});
	237	$sth->fetch();
[4]	238	}
	239
[125]	240	# Count the free blocks.
[194]	241	$sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
	242	"(routed='y' or routed='n')");
[125]	243	foreach my $master (@masterblocks) {
	244	$sth->execute("$master");
	245	$sth->bind_columns(\$free{"$master"});
	246	$sth->fetch();
[4]	247	}
	248
[125]	249	# Find the largest free block in each master
[194]	250	$sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
	251	"(routed='y' or routed='n') order by maskbits limit 1");
[125]	252	foreach my $master (@masterblocks) {
	253	$sth->execute("$master");
	254	$sth->bind_columns(\$bigfree{"$master"});
	255	$sth->fetch();
	256	}
	257
	258	# Print the data.
[4]	259	my $count=0;
	260	foreach my $master (@masterblocks) {
	261	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
	262	$routed{"$master"}, $allocated{"$master"}, $free{"$master"},
[160]	263	( ($bigfree{"$master"} eq '') ? ("<NONE>") : ("/".$bigfree{"$master"}) )
[4]	264	);
	265
	266	printRow(\@row, 'color1' ) if($count%2==0);
	267	printRow(\@row, 'color2' ) if($count%2!=0);
	268	$count++;
	269	}
	270	print "</table>\n";
[242]	271	if ($IPDBacl{$authuser} =~ /a/) {
	272	print qq(<a href="/ip/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n);
	273	}
[4]	274	print "Note: Free blocks noted here include both routed and unrouted blocks.\n";
	275
	276	} # showSummary
	277
	278
	279	# Display detail on master
	280	# Alrighty then! We're showing routed blocks within a single master this time.
	281	# We should be able to steal code from showSummary(), and if I'm really smart
	282	# I'll figger a way to munge the two together. (Once I've done that, everything
	283	# else should follow. YMMV.)
	284	sub showMaster {
	285
	286	print qq(<center><div class="heading">Summarizing routed blocks for ).
	287	qq($webvar{block}:</div></center><br>\n);
	288
[125]	289	my %allocated;
	290	my %free;
	291	my %routed;
	292	my %bigfree;
	293
[4]	294	my $master = new NetAddr::IP $webvar{block};
	295	my @localmasters;
	296
[125]	297	# Fetch only the blocks relevant to this master
[159]	298	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr <<= '$master' order by cidr");
[4]	299	$sth->execute();
	300
	301	my $i=0;
	302	while (my @data = $sth->fetchrow_array()) {
	303	my $cidr = new NetAddr::IP $data[0];
[125]	304	$localmasters[$i++] = $cidr;
	305	$free{"$cidr"} = 0;
	306	$allocated{"$cidr"} = 0;
	307	$bigfree{"$cidr"} = 128;
[4]	308	# Retain the routing destination
[159]	309	$routed{"$cidr"} = $data[1];
[4]	310	}
	311
[125]	312	# Check if there were actually any blocks routed from this master
[4]	313	if ($i > 0) {
	314	startTable('Routed block','Routed to','Allocated blocks',
	315	'Free blocks','Largest free block');
	316
[125]	317	# Count the allocations
	318	$sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
	319	foreach my $master (@localmasters) {
	320	$sth->execute("$master");
	321	$sth->bind_columns(\$allocated{"$master"});
	322	$sth->fetch();
[4]	323	}
	324
[125]	325	# Count the free blocks.
[194]	326	$sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
	327	"(routed='y' or routed='n')");
[125]	328	foreach my $master (@localmasters) {
	329	$sth->execute("$master");
	330	$sth->bind_columns(\$free{"$master"});
	331	$sth->fetch();
[4]	332	}
	333
[125]	334	# Get the size of the largest free block
[194]	335	$sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
	336	"(routed='y' or routed='n') order by maskbits limit 1");
[125]	337	foreach my $master (@localmasters) {
	338	$sth->execute("$master");
	339	$sth->bind_columns(\$bigfree{"$master"});
	340	$sth->fetch();
[4]	341	}
	342
	343	# Print the data.
	344	my $count=0;
	345	foreach my $master (@localmasters) {
	346	my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
	347	$routed{"$master"}, $allocated{"$master"},
	348	$free{"$master"},
	349	( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) )
	350	);
	351	printRow(\@row, 'color1' ) if($count%2==0);
	352	printRow(\@row, 'color2' ) if($count%2!=0);
	353	$count++;
	354	}
	355	} else {
	356	# If a master block has no routed blocks, then by definition it has no
	357	# allocations, and can be deleted.
	358	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	359	qq($master.</div>\n).
[242]	360	($IPDBacl{$authuser} =~ /d/ ?
	361	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	362	qq(<input type=hidden name=action value="delete">\n).
	363	qq(<input type=hidden name=block value="$master">\n).
	364	qq(<input type=hidden name=alloctype value="mm">\n).
	365	qq(<input type=submit value=" Remove this master ">\n).
	366	qq(</form></center>\n) :
	367	'');
[4]	368
	369	} # end check for existence of routed blocks in master
	370
	371	print qq(</table>\n<hr width="60%">\n).
	372	qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
	373
	374	startTable('Netblock','Range');
	375
	376	# Snag the free blocks.
	377	my $count = 0;
[125]	378	$sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
	379	"routed='n' order by cidr");
[4]	380	$sth->execute();
	381	while (my @data = $sth->fetchrow_array()) {
	382	my $cidr = new NetAddr::IP $data[0];
[125]	383	my @row = ("$cidr", $cidr->range);
	384	printRow(\@row, 'color1' ) if($count%2==0);
	385	printRow(\@row, 'color2' ) if($count%2!=0);
	386	$count++;
[4]	387	}
	388
	389	print "</table>\n";
	390	} # showMaster
	391
	392
	393	# Display details of a routed block
	394	# Alrighty then! We're showing allocations within a routed block this time.
	395	# We should be able to steal code from showSummary() and showMaster(), and if
	396	# I'm really smart I'll figger a way to munge all three together. (Once I've
	397	# done that, everything else should follow. YMMV.
	398	# This time, we check the database before spewing, because we may
	399	# not have anything useful to spew.
	400	sub showRBlock {
	401
	402	my $master = new NetAddr::IP $webvar{block};
	403
[159]	404	$sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
[4]	405	$sth->execute;
	406	my @data = $sth->fetchrow_array;
	407
	408	print qq(<center><div class="heading">Summarizing allocated blocks for ).
[159]	409	qq($master ($data[0]):</div></center><br>\n);
[4]	410
[244]	411	startTable('CIDR allocation','Customer Location','Type','CustID','SWIPed?','Description/Name');
[125]	412
	413	# Snag the allocations for this block
[244]	414	$sth = $ip_dbh->prepare("select cidr,city,type,custid,swip,description".
[159]	415	" from allocations where cidr <<= '$master' order by cidr");
[4]	416	$sth->execute();
	417
[376]	418	# hack hack hack
	419	# set up to flag swip=y records if they don't actually have supporting data in the customers table
	420	my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
	421
[4]	422	my $count=0;
	423	while (my @data = $sth->fetchrow_array()) {
[244]	424	# cidr,city,type,custid,swip,description, as per the SELECT
[4]	425	my $cidr = new NetAddr::IP $data[0];
	426
	427	# Clean up extra spaces that are borking things.
[159]	428	# $data[2] =~ s/\s+//g;
[4]	429
[376]	430	$custsth->execute($data[3]);
	431	my ($ncust) = $custsth->fetchrow_array();
	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],
[376]	437	($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : '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
[394]	632	## node hack
	633	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	634	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	635	my $nodes = '';
	636	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	637	$nodes .= "<option value='$nid'>$nname</option>\n";
	638	}
	639	$html =~ s/\$\$NODELIST\$\$/$nodes/;
	640	## end node hack
	641
[286]	642	my $i = 0;
	643	$i++ if $webvar{fbtype} eq 'y';
	644	# Check to see if user is allowed to do anything with sensitive data
	645	my $privdata = '';
	646	if ($IPDBacl{$authuser} =~ /s/) {
	647	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	648	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	649	qq(</textarea></td></tr>\n);
	650	$i++;
	651	}
	652	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	653
	654	$i = $i % 2;
	655	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	656
[4]	657	print $html;
	658
	659	} # assignBlock
	660
	661
	662	# Take info on requested IP assignment and see what we can provide.
	663	sub confirmAssign {
[242]	664	if ($IPDBacl{$authuser} !~ /a/) {
	665	printError("You shouldn't have been able to get here. Access denied.");
	666	return;
	667	}
[4]	668
	669	my $cidr;
	670	my $alloc_from;
	671
	672	# Going to manually validate some items.
	673	# custid and city are automagic.
[125]	674	return if !validateInput();
[4]	675
	676	# Several different cases here.
	677	# Static IP vs netblock
	678	# + Different flavours of static IP
	679	# + Different flavours of netblock
	680
[159]	681	if ($webvar{alloctype} =~ /^.i$/) {
[4]	682	my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
[211]	683	my ($sql,$city);
	684	# Check for pools in Subury, North Bay, or Toronto if DSL or server pool.
	685	# Anywhere else is invalid and shouldn't be in the db in the first place.
[4]	686	# ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
	687	# Note that we want to retain the requested city to relate to customer info.
	688	if ($base =~ /^[ds]$/) {
[211]	689	$city = "(allocations.city='Sudbury' or allocations.city='North Bay' or ".
	690	"allocations.city='Toronto')";
[4]	691	} else {
[211]	692	$city = "allocations.city='$webvar{pop}'";
[4]	693	}
	694
[211]	695	# Ewww. But it works.
	696	$sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
	697	"poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
	698	"poolips.pool=allocations.cidr AND $city AND poolips.type LIKE '".$base."_' ".
	699	"GROUP BY pool");
[4]	700	$sth->execute;
	701	my $optionlist;
	702	while (my @data = $sth->fetchrow_array) {
[211]	703	# city,pool cidr,free IP count
	704	if ($data[2] > 0) {
	705	$optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
	706	}
[4]	707	}
	708	$cidr = "Single static IP";
	709	$alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
	710
	711	} else { # end show pool options
[24]	712
	713	if ($webvar{fbassign} eq 'y') {
	714	$cidr = new NetAddr::IP $webvar{block};
	715	$webvar{maskbits} = $cidr->masklen;
	716	} else { # done with direct freeblocks assignment
	717
	718	if (!$webvar{maskbits}) {
[125]	719	printError("Please specify a CIDR mask length.");
	720	return;
[24]	721	}
	722	my $sql;
	723	my $city;
	724	my $failmsg;
[267]	725	my $extracond = '';
	726	if ($webvar{allocfrom} eq '-') {
	727	$extracond = ($webvar{allowpriv} eq 'on' ? '' :
	728	" and not (cidr <<= '192.168.0.0/16'".
	729	" or cidr <<= '10.0.0.0/8'".
	730	" or cidr <<= '172.16.0.0/12')");
	731	}
	732	my $sortorder;
[192]	733	if ($webvar{alloctype} eq 'rm') {
[32]	734	if ($webvar{allocfrom} ne '-') {
	735	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
[267]	736	" and cidr <<= '$webvar{allocfrom}'";
	737	$sortorder = "maskbits desc";
[32]	738	} else {
[267]	739	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
	740	$sortorder = "maskbits desc";
[32]	741	}
[24]	742	$failmsg = "No suitable free block found.<br>\nWe do not have a free".
	743	" routeable block of that size.<br>\nYou will have to either route".
	744	" a set of smaller netblocks or a single smaller netblock.";
[4]	745	} else {
[125]	746	##fixme
	747	# This section needs serious Pondering.
[211]	748	# Pools of most types get assigned to the POP they're "routed from"
[192]	749	# This includes WAN blocks and other netblock "containers"
[211]	750	# This does NOT include cable pools.
	751	if ($webvar{alloctype} =~ /^.[pc]$/) {
[206]	752	if (($webvar{city} !~ /^(Sudbury\|North Bay\|Toronto)$/) && ($webvar{alloctype} eq 'dp')) {
	753	printError("You must chose Sudbury, North Bay, or Toronto for DSL pools.");
[125]	754	return;
	755	}
[39]	756	$city = $webvar{city};
[24]	757	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[125]	758	" superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
[24]	759	" block size for the pool.";
	760	} else {
	761	$city = $webvar{pop};
	762	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[101]	763	" superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
[24]	764	" chose a smaller blocksize.";
	765	}
[315]	766	if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
[159]	767	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[192]	768	" and cidr <<= '$webvar{allocfrom}' and routed='".
[267]	769	(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	770	$sortorder = "maskbits desc,cidr";
[32]	771	} else {
[159]	772	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[267]	773	" and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	774	$sortorder = "maskbits desc,cidr";
[32]	775	}
[4]	776	}
[267]	777	$sql = $sql.$extracond." order by ".$sortorder;
[24]	778	$sth = $ip_dbh->prepare($sql);
	779	$sth->execute;
	780	my @data = $sth->fetchrow_array();
	781	if ($data[0] eq "") {
[125]	782	printError($failmsg);
	783	return;
[24]	784	}
	785	$cidr = new NetAddr::IP $data[0];
	786	} # check for freeblocks assignment or IPDB-controlled assignment
[4]	787
	788	$alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
	789
	790	# If the block to be allocated is smaller than the one we found,
	791	# figure out the "real" block to be allocated.
	792	if ($cidr->masklen() ne $webvar{maskbits}) {
	793	my $maskbits = $cidr->masklen();
	794	my @subblocks;
	795	while ($maskbits++ < $webvar{maskbits}) {
	796	@subblocks = $cidr->split($maskbits);
	797	}
	798	$cidr = $subblocks[0];
	799	}
[159]	800	} # if ($webvar{alloctype} =~ /^.i$/)
[4]	801
	802	open HTML, "../confirm.html"
	803	or croak "Could not open confirm.html: $!";
	804	my $html = join '', <HTML>;
	805	close HTML;
	806
[394]	807	## node hack
	808	if ($webvar{node} && $webvar{node} ne '-') {
	809	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
	810	$sth->execute($webvar{node});
	811	my ($nodename) = $sth->fetchrow_array();
	812	$html =~ s/\$\$NODENAME\$\$/$nodename/;
	813	$html =~ s/\$\$NODEID\$\$/$webvar{node}/;
	814	} else {
	815	$html =~ s/\$\$NODENAME\$\$//;
	816	$html =~ s/\$\$NODEID\$\$//;
	817	}
	818	## end node hack
	819
[4]	820	### gotta fix this in final
	821	# Stick in customer info as necessary - if it's blank, it just ends
	822	# up as blank lines ignored in the rendering of the page
	823	my $custbits;
	824	$html =~ s\|\$\$CUSTBITS\$\$\|$custbits\|g;
	825	###
	826
	827	# Stick in the allocation data
	828	$html =~ s\|\$\$ALLOC_TYPE\$\$\|$webvar{alloctype}\|g;
[98]	829	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$webvar{alloctype}}\|g;
[4]	830	$html =~ s\|\$\$ALLOC_FROM\$\$\|$alloc_from\|g;
	831	$html =~ s\|\$\$CIDR\$\$\|$cidr\|g;
[82]	832	$webvar{city} = desanitize($webvar{city});
[4]	833	$html =~ s\|\$\$CITY\$\$\|$webvar{city}\|g;
	834	$html =~ s\|\$\$CUSTID\$\$\|$webvar{custid}\|g;
[83]	835	$webvar{circid} = desanitize($webvar{circid});
[75]	836	$html =~ s\|\$\$CIRCID\$\$\|$webvar{circid}\|g;
[4]	837	$webvar{desc} = desanitize($webvar{desc});
[89]	838	$html =~ s\|\$\$DESC\$\$\|$webvar{desc}\|g;
[4]	839	$webvar{notes} = desanitize($webvar{notes});
	840	$html =~ s\|\$\$NOTES\$\$\|$webvar{notes}\|g;
	841	$html =~ s\|\$\$ACTION\$\$\|insert\|g;
	842
[286]	843	my $i=1;
	844	# Check to see if user is allowed to do anything with sensitive data
	845	my $privdata = '';
	846	if ($IPDBacl{$authuser} =~ /s/) {
	847	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	848	qq(<td class=regular>$webvar{privdata}).
	849	qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
	850	$i++;
	851	}
[315]	852	# We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
	853	$privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
	854	if $webvar{userid};
[286]	855	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	856
	857	$i = $i % 2;
	858	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	859
[4]	860	print $html;
	861
	862	} # end confirmAssign
	863
	864
	865	# Do the work of actually inserting a block in the database.
	866	sub insertAssign {
[242]	867	if ($IPDBacl{$authuser} !~ /a/) {
	868	printError("You shouldn't have been able to get here. Access denied.");
	869	return;
	870	}
[4]	871	# Some things are done more than once.
[125]	872	return if !validateInput();
[4]	873
[390]	874	# 2009/12/1 kdeugau
	875	# Since we're using these for more than just NOC-ish things now, removing
	876	## Hack as per Jody. Force CustID of NOC-VPN on 192.168 assignments
	877	#if ($webvar{fullcidr} =~ /^192\.168/) {
	878	# $webvar{custid} = "NOC-VPN";
	879	#}
	880
[286]	881	if (!defined($webvar{privdata})) {
	882	$webvar{privdata} = '';
	883	}
[125]	884	# $code is "success" vs "failure", $msg contains OK for a
	885	# successful netblock allocation, the IP allocated for static
	886	# IP, or the error message if an error occurred.
	887	my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
	888	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
[394]	889	$webvar{circid}, $webvar{privdata}, $webvar{node});
[4]	890
[125]	891	if ($code eq 'OK') {
	892	if ($webvar{alloctype} =~ /^.i$/) {
[315]	893	$msg =~ s\|/32\|\|;
	894	print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
	895	( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
[322]	896	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	897	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	898	qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
	899	: "</div>");
[122]	900	# Notify tech@example.com
[203]	901	mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
[125]	902	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
[122]	903	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[125]	904	} else {
[315]	905	my $netblock = new NetAddr::IP $webvar{fullcidr};
[125]	906	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[315]	907	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
	908	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[322]	909	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	910	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	911	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
	912	"&include_routed_subnet=1&ipdb=1".
	913	qq(">Add this netblock to RADIUS user table</a></div>)
	914	: "</div>");
[390]	915	mailNotify('nocmgr@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	916	"$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
	917	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[122]	918	}
[125]	919	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[251]	920	"'$webvar{alloctype}' ($msg)";
[125]	921	} else {
	922	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	923	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[192]	924	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[159]	925	" failed:<br>\n$msg\n");
[125]	926	}
[122]	927
[4]	928	} # end insertAssign()
	929
	930
	931	# Does some basic checks on common input data to make sure nothing
	932	# really weird gets in to the database through this script.
	933	# Does NOT do complete input validation!!!
	934	sub validateInput {
	935	if ($webvar{city} eq '-') {
[125]	936	printError("Please choose a city.");
	937	return;
[4]	938	}
[140]	939
	940	# Alloctype check.
[4]	941	chomp $webvar{alloctype};
[140]	942	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	943	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	944	# managing to call things in such a way as to cause this deserves a cryptic error.
	945	printError("Invalid alloctype");
	946	return;
	947	}
	948
	949	# CustID check
[4]	950	# We have different handling for customer allocations and "internal" or "our" allocations
[209]	951	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	952	if (!$webvar{custid}) {
[125]	953	printError("Please enter a customer ID.");
	954	return;
[4]	955	}
[116]	956	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
[56]	957	# Force uppercase for now...
	958	$webvar{custid} =~ tr/a-z/A-Z/;
[338]	959	# Crosscheck with billing.
[56]	960	my $status = CustIDCK->custid_exist($webvar{custid});
[125]	961	if ($CustIDCK::Error) {
	962	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	963	return;
	964	}
	965	if (!$status) {
	966	printError("Customer ID not valid. Make sure the Customer ID ".
	967	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	968	"non-customer assignments.");
	969	return;
	970	}
[56]	971	#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
	972	#static IPs for staff.");
[4]	973	}
[56]	974	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[140]	975	} else {
[168]	976	# New! Improved! And now Loaded From The Database!!
[56]	977	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
[168]	978	$webvar{custid} = $def_custids{$webvar{alloctype}};
[56]	979	}
[4]	980	}
[125]	981
	982	# Check POP location
	983	my $flag;
[192]	984	if ($webvar{alloctype} eq 'rm') {
[125]	985	$flag = 'for a routed netblock';
	986	foreach (@poplist) {
	987	if (/^$webvar{city}$/) {
	988	$flag = 'n';
	989	last;
	990	}
	991	}
	992	} else {
	993	$flag = 'n';
[315]	994	if ($webvar{alloctype} =~ /[wp][cr]\|[ds][pi]/) {
	995	# Set this forcibly rather than messing around elsewhere. Yes, this is a hack. PTHBTT!!
	996	$webvar{pop} = 'Sudbury';
	997	}
	998	if ($webvar{pop} =~ /^-$/) {
[125]	999	$flag = 'to route the block from/through';
	1000	}
	1001	}
	1002	if ($flag ne 'n') {
	1003	printError("Please choose a valid POP location $flag. Valid ".
	1004	"POP locations are currently:<br>\n".join (" - ", @poplist));
	1005	return;
	1006	}
	1007
	1008	return 'OK';
[4]	1009	} # end validateInput
	1010
	1011
	1012	# Displays details of a specific allocation in a form
	1013	# Allows update/delete
	1014	# action=edit
	1015	sub edit {
	1016
	1017	my $sql;
	1018
	1019	# Two cases: block is a netblock, or block is a static IP from a pool
	1020	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	1021	if ($webvar{block} =~ /\/32$/) {
[318]	1022	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	1023	} else {
[318]	1024	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	1025	}
	1026
	1027	# gotta snag block info from db
	1028	$sth = $ip_dbh->prepare($sql);
	1029	$sth->execute;
	1030	my @data = $sth->fetchrow_array;
	1031
	1032	# Clean up extra whitespace on alloc type
	1033	$data[2] =~ s/\s//;
	1034
	1035	open (HTML, "../editDisplay.html")
	1036	or croak "Could not open editDisplay.html :$!";
	1037	my $html = join('', <HTML>);
	1038
	1039	# We can't let the city be changed here; this block is a part of
	1040	# a larger routed allocation and therefore by definition can't be moved.
	1041	# block and city are static.
	1042	##fixme
	1043	# Needs thinking. Have to allow changes to city to correct errors, no?
	1044	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1045
[242]	1046	if ($IPDBacl{$authuser} =~ /c/) {
	1047	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	1048
[4]	1049	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1050	# with the much longer list of allocation types.
	1051	# We'll just show what type of block it is.
	1052
[35]	1053	# this has now been Requested, so here goes.
[4]	1054
[192]	1055	##fixme The check here should be built from the database
[242]	1056	if ($data[2] =~ /^.[ne]$/) {
	1057	# Block that can be changed
	1058	my $blockoptions = "<select name=alloctype><option".
[192]	1059	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[224]	1060	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	1061	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	1062	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[35]	1063	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[192]	1064	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[133]	1065	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[35]	1066	"</select>\n";
[242]	1067	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1068	} else {
	1069	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1070	}
[394]	1071	## node hack
	1072	$sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
	1073	$sth->execute;
	1074	my ($nodeid) = $sth->fetchrow_array();
	1075	if ($nodeid) {
	1076	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1077	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1078	my $nodes = "<select name=node>\n";
	1079	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1080	$nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
	1081	}
	1082	$nodes .= "</select>\n";
	1083	$html =~ s/\$\$NODE\$\$/$nodes/;
	1084	} else {
	1085	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1086	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1087	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1088	my $nodes = "<select name=node>\n<option value=>--</option>\n";
	1089	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1090	$nodes .= "<option value='$nid'>$nname</option>\n";
	1091	}
	1092	$nodes .= "</select>\n";
	1093	$html =~ s/\$\$NODE\$\$/$nodes/;
	1094	} else {
	1095	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1096	}
	1097	}
	1098	## end node hack
[318]	1099	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1100	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1101	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1102	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1103	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[35]	1104	} else {
[394]	1105	## node hack
	1106	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1107	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
	1108	" ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
	1109	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1110	my ($node) = $sth->fetchrow_array;
	1111	$html =~ s/\$\$NODE\$\$/$node/;
	1112	} else {
	1113	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1114	}
	1115	## end node hack
[242]	1116	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[318]	1117	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1118	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1119	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1120	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1121	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1122	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[35]	1123	}
[245]	1124	my ($lastmod,undef) = split /\s+/, $data[7];
	1125	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[35]	1126
[244]	1127	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1128	if ($data[2] =~ /.i/) {
	1129	$html =~ s/\$\$SWIP\$\$/N\/A/;
	1130	} else {
[318]	1131	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
[244]	1132	'<input type=checkbox name=swip checked=yes>');
	1133	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1134	}
	1135
[245]	1136	# Allows us to "correctly" colour backgrounds in table
	1137	my $i=1;
	1138
[286]	1139	# Check to see if we can display sensitive data
	1140	my $privdata = '';
	1141	if ($IPDBacl{$authuser} =~ /s/) {
	1142	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1143	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1144	qq($data[8]</textarea></td></tr>\n);
	1145	$i++;
	1146	}
	1147	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1148
[242]	1149	# More ACL trickery - we can live with forms that don't submit,
	1150	# but we can't leave the extra table rows there, and we really
	1151	# can't leave the submit buttons there.
	1152	my $updok = '';
	1153	if ($IPDBacl{$authuser} =~ /c/) {
[286]	1154	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[242]	1155	qq(<input type="submit" value=" Update this block " class="regular">).
	1156	"</div></td></tr></form>\n";
[245]	1157	$i++;
[242]	1158	}
	1159	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1160
[242]	1161	my $delok = '';
	1162	if ($IPDBacl{$authuser} =~ /d/) {
	1163	$delok = qq(<form method="POST" action="main.cgi">
[286]	1164	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[242]	1165	<input type="hidden" name="action" value="delete">
	1166	<input type="hidden" name="block" value="$webvar{block}">
	1167	<input type="hidden" name="alloctype" value="$data[2]">
	1168	<input type=submit value=" Delete this block ">
	1169	</div></td></tr>);
	1170	}
	1171	$html =~ s/\$\$DELOK\$\$/$delok/;
	1172
[4]	1173	print $html;
	1174
	1175	} # edit()
	1176
	1177
	1178	# Stuff new info about a block into the db
	1179	# action=update
	1180	sub update {
[286]	1181	if ($IPDBacl{$authuser} !~ /c/) {
	1182	printError("You shouldn't have been able to get here. Access denied.");
	1183	return;
	1184	}
[4]	1185
[286]	1186	# Check to see if we can update restricted data
	1187	my $privdata = '';
	1188	if ($IPDBacl{$authuser} =~ /s/) {
	1189	$privdata = ",privdata='$webvar{privdata}'";
	1190	}
	1191
[4]	1192	# Make sure incoming data is in correct format - custID among other things.
[220]	1193	return if !validateInput;
[4]	1194
	1195	# SQL transaction wrapper
	1196	eval {
	1197	# Relatively simple SQL transaction here.
	1198	my $sql;
[159]	1199	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[75]	1200	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[286]	1201	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1202	"$privdata where ip='$webvar{block}'";
[4]	1203	} else {
	1204	$sql = "update allocations set custid='$webvar{custid}',".
[35]	1205	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[296]	1206	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
[244]	1207	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[286]	1208	"where cidr='$webvar{block}'";
[4]	1209	}
[159]	1210	# Log the details of the change.
	1211	syslog "debug", $sql;
[4]	1212	$sth = $ip_dbh->prepare($sql);
	1213	$sth->execute;
[394]	1214	## node hack
	1215	if ($webvar{node}) {
	1216	$ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
	1217	$sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	1218	$sth->execute($webvar{block},$webvar{node});
	1219	}
	1220	## end node hack
[4]	1221	$ip_dbh->commit;
	1222	};
	1223	if ($@) {
[163]	1224	my $msg = $@;
	1225	carp "Transaction aborted because $msg";
[4]	1226	eval { $ip_dbh->rollback; };
[163]	1227	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1228	printError("Could not update block/IP $webvar{block}: $msg");
[125]	1229	return;
[4]	1230	}
	1231
	1232	# If we get here, the operation succeeded.
	1233	syslog "notice", "$authuser updated $webvar{block}";
[390]	1234	mailNotify('nocmgr@example.com',"SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1235	"$webvar{block} had SWIP status changed to \"Yes\" by $authuser");
[4]	1236	open (HTML, "../updated.html")
[125]	1237	or croak "Could not open updated.html :$!";
[4]	1238	my $html = join('', <HTML>);
	1239
[378]	1240	# Link back to browse-routed or list-pool page on "Update complete" page.
	1241	my $backlink = "/ip/cgi-bin/main.cgi?action=";
	1242	my $cblock; # to contain the CIDR of the container block we're retrieving.
	1243	my $sql;
	1244	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
	1245	$sql = "select pool from poolips where ip='$webvar{block}'";
	1246	$backlink .= "listpool&pool=";
	1247	} else {
	1248	$sql = "select cidr from routed where cidr >>= '$webvar{block}'";
	1249	$backlink .= "showrouted&block=";
	1250	}
	1251	# I define there to be no errors on this operation... so we don't need to check for them.
	1252	$sth = $ip_dbh->prepare($sql);
	1253	$sth->execute;
	1254	$sth->bind_columns(\$cblock);
	1255	$sth->fetch();
	1256	$sth->finish;
	1257	$backlink .= $cblock;
	1258
[244]	1259	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1260	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[89]	1261	$webvar{city} = desanitize($webvar{city});
[4]	1262	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1263	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[98]	1264	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1265	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[244]	1266	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[89]	1267	$webvar{circid} = desanitize($webvar{circid});
[75]	1268	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[89]	1269	$webvar{desc} = desanitize($webvar{desc});
[4]	1270	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[89]	1271	$webvar{notes} = desanitize($webvar{notes});
[4]	1272	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
[378]	1273	$html =~ s/\$\$BACKLINK\$\$/$backlink/g;
	1274	$html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
[4]	1275
[286]	1276	if ($IPDBacl{$authuser} =~ /s/) {
	1277	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1278	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1279	}
	1280	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1281
[4]	1282	print $html;
	1283
	1284	} # update()
	1285
	1286
	1287	# Delete an allocation.
[125]	1288	sub remove {
[242]	1289	if ($IPDBacl{$authuser} !~ /d/) {
	1290	printError("You shouldn't have been able to get here. Access denied.");
	1291	return;
	1292	}
	1293
[4]	1294	#show confirm screen.
	1295	open HTML, "../confirmRemove.html"
	1296	or croak "Could not open confirmRemove.html :$!";
	1297	my $html = join('', <HTML>);
	1298	close HTML;
	1299
	1300	# Serves'em right for getting here...
	1301	if (!defined($webvar{block})) {
[125]	1302	printError("Error 332");
	1303	return;
[4]	1304	}
	1305
[286]	1306	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1307
[192]	1308	if ($webvar{alloctype} eq 'rm') {
[4]	1309	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1310	$sth->execute();
	1311
	1312	# This feels... extreme.
	1313	croak $sth->errstr() if($sth->errstr());
	1314
	1315	$sth->bind_columns(\$cidr,\$city);
	1316	$sth->execute();
	1317	$sth->fetch \|\| croak $sth->errstr();
	1318	$custid = "N/A";
	1319	$alloctype = $webvar{alloctype};
[75]	1320	$circid = "N/A";
[4]	1321	$desc = "N/A";
	1322	$notes = "N/A";
	1323
	1324	} elsif ($webvar{alloctype} eq 'mm') {
	1325	$cidr = $webvar{block};
	1326	$city = "N/A";
	1327	$custid = "N/A";
	1328	$alloctype = $webvar{alloctype};
[75]	1329	$circid = "N/A";
[4]	1330	$desc = "N/A";
	1331	$notes = "N/A";
[192]	1332	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1333
	1334	# Unassigning a static IP
[286]	1335	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1336	" from poolips where ip='$webvar{block}'");
[4]	1337	$sth->execute();
	1338	# croak $sth->errstr() if($sth->errstr());
	1339
[286]	1340	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1341	\$privdata);
[4]	1342	$sth->fetch() \|\| croak $sth->errstr;
	1343
[159]	1344	} else { # done with alloctype=~ /^.i$/
[4]	1345
[286]	1346	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1347	" from allocations where cidr='$webvar{block}'");
[4]	1348	$sth->execute();
	1349	# croak $sth->errstr() if($sth->errstr());
	1350
[286]	1351	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1352	\$notes, \$privdata);
[75]	1353	$sth->fetch() \|\| carp $sth->errstr;
[4]	1354	} # end cases for different alloctypes
	1355
	1356	# Munge everything into HTML
	1357	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1358	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[98]	1359	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1360	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1361	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1362	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[75]	1363	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1364	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1365	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1366
	1367	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1368
	1369	# Set the warning text.
[159]	1370	if ($alloctype =~ /^.[pd]$/) {
[4]	1371	$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>\|;
	1372	} else {
	1373	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1374	}
	1375
[286]	1376	my $i = 1;
	1377	# Check to see if user is allowed to do anything with sensitive data
	1378	if ($IPDBacl{$authuser} =~ /s/) {
	1379	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1380	qq(<td class=regular>$privdata</td></tr>\n);
	1381	$i++;
	1382	}
	1383	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1384
	1385	$i = ++$i % 2;
	1386	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1387
[4]	1388	print $html;
	1389	} # end edit()
	1390
	1391
	1392	# Delete an allocation. Return it to the freeblocks table; munge
	1393	# data as necessary to keep as few records as possible in freeblocks
	1394	# to prevent weirdness when allocating blocks later.
	1395	# Remove IPs from pool listing if necessary
	1396	sub finalDelete {
[242]	1397	if ($IPDBacl{$authuser} !~ /d/) {
	1398	printError("You shouldn't have been able to get here. Access denied.");
	1399	return;
	1400	}
[4]	1401
[356]	1402	# need to retrieve block data before deleting so we can notify on that
	1403	my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
	1404
[125]	1405	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1406
[125]	1407	if ($code eq 'OK') {
[4]	1408	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[356]	1409	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
	1410	" $custid, $city, desc='$description'";
[205]	1411	# Notify tech@ when a block/IP is deallocated
	1412	mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
[356]	1413	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1414	"CustID: $custid\nCity: $city\nDescription: $description\n");
[390]	1415	mailNotify('nocmgr@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1416	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1417	"CustID: $custid\nCity: $city\nDescription: $description\n");
[125]	1418	} else {
	1419	if ($webvar{alloctype} =~ /^.i$/) {
	1420	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
	1421	printError("Could not deallocate static IP $webvar{block}: $msg");
	1422	} else {
	1423	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
	1424	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1425	}
[102]	1426	}
	1427
[4]	1428	} # finalDelete
	1429
	1430
[242]	1431	sub exitError {
	1432	my $errStr = $_[0];
	1433	printHeader('','');
	1434	print qq(<center><p class="regular"> $errStr </p>
	1435	<input type="button" value="Back" onclick="history.go(-1)">
	1436	</center>
	1437	);
	1438	printFooter();
	1439	exit;
	1440	} # errorExit
	1441
	1442
[4]	1443	# Just in case we manage to get here.
	1444	exit 0;

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

Download in other formats: