Context Navigation

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

Last change on this file since 394 was 394, checked in by Kris Deugau, 14 years ago

/branches/stable

Basic support for network node references: Add, view, edit nodes and

referencess

Probably excludes a bunch of real use-cases for various reasons

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

File size: 49.0 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 18:10:34 +0000 (Fri, 19 Feb 2010) $
	7	# SVN revision $Rev: 394 $
	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	}
	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
[376]	403	# hack hack hack
	404	# set up to flag swip=y records if they don't actually have supporting data in the customers table
	405	my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
	406
[4]	407	my $count=0;
	408	while (my @data = $sth->fetchrow_array()) {
[244]	409	# cidr,city,type,custid,swip,description, as per the SELECT
[4]	410	my $cidr = new NetAddr::IP $data[0];
	411
	412	# Clean up extra spaces that are borking things.
[159]	413	# $data[2] =~ s/\s+//g;
[4]	414
[376]	415	$custsth->execute($data[3]);
	416	my ($ncust) = $custsth->fetchrow_array();
	417
[192]	418	# Prefix subblocks with "Sub "
	419	my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
	420	qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
[244]	421	$data[1], $disp_alloctypes{$data[2]}, $data[3],
[376]	422	($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), $data[5]);
[4]	423	# If the allocation is a pool, allow listing of the IPs in the pool.
[159]	424	if ($data[2] =~ /^.[pd]$/) {
[4]	425	$row[0] .= '   <a href="/ip/cgi-bin/main.cgi?action=listpool'.
	426	"&pool=$data[0]\">List IPs</a>";
	427	}
	428
	429	printRow(\@row, 'color1') if ($count%2 == 0);
	430	printRow(\@row, 'color2') if ($count%2 != 0);
	431	$count++;
	432	}
	433
	434	print "</table>\n";
	435
	436	# If the routed block has no allocations, by definition it only has
	437	# one free block, and therefore may be deleted.
	438	if ($count == 0) {
	439	print qq(<hr width="60%"><center><div class="heading">No allocations in ).
	440	qq($master.</div></center>\n).
[242]	441	($IPDBacl{$authuser} =~ /d/ ?
	442	qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
	443	qq(<input type=hidden name=action value="delete">\n).
	444	qq(<input type=hidden name=block value="$master">\n).
	445	qq(<input type=hidden name=alloctype value="rm">\n).
	446	qq(<input type=submit value=" Remove this block ">\n).
	447	qq(</form>\n) :
	448	'');
[4]	449	}
	450
	451	print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
	452	qq(submaster $master</div></center>\n);
	453
	454	startTable('CIDR block','Range');
	455
	456	# Snag the free blocks. We don't really need to be pedantic about avoiding
	457	# unrouted free blocks, but it's better to let the database do the work if we can.
	458	$count = 0;
[192]	459	$sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
	460	" order by cidr");
[4]	461	$sth->execute();
	462	while (my @data = $sth->fetchrow_array()) {
[192]	463	# cidr,routed
[4]	464	my $cidr = new NetAddr::IP $data[0];
[192]	465	# Include some HairyPerl(TM) to prefix subblocks with "Sub "
	466	my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
[242]	467	($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
[24]	468	$cidr->range);
[125]	469	printRow(\@row, 'color1') if ($count%2 == 0);
	470	printRow(\@row, 'color2') if ($count%2 != 0);
	471	$count++;
[4]	472	}
	473
	474	print "</table>\n";
	475	} # showRBlock
	476
	477
	478	# List the IPs used in a pool
	479	sub listPool {
	480
	481	my $cidr = new NetAddr::IP $webvar{pool};
	482
[159]	483	my ($pooltype,$poolcity);
	484
[4]	485	# Snag pool info for heading
[159]	486	$sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
[4]	487	$sth->execute;
[159]	488	$sth->bind_columns(\$pooltype, \$poolcity);
	489	$sth->fetch() \|\| carp $sth->errstr;
[4]	490
	491	print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
[159]	492	qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
	493	# Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
	494	if ($pooltype =~ /^.d$/) {
	495	print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
	496	print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
[4]	497	$cidr->addr."</td></tr>\n";
[159]	498	$cidr++;
	499	print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
	500	$cidr--; $cidr--;
	501	print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
[4]	502	"<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
	503	"</table></div></div>\n";
[159]	504	}
[4]	505
	506	# probably have to add an "edit IP allocation" link here somewhere.
	507
	508	startTable('IP','Customer ID','Available?','Description','');
[159]	509	$sth = $ip_dbh->prepare("select ip,custid,available,description,type".
	510	" from poolips where pool='$webvar{pool}' order by ip");
[4]	511	$sth->execute;
	512	my $count = 0;
	513	while (my @data = $sth->fetchrow_array) {
[75]	514	# pool,ip,custid,city,ptype,available,notes,description,circuitid
[159]	515	# ip,custid,available,description,type
	516	# If desc is "null", make it not null. <g>
	517	if ($data[3] eq '') {
	518	$data[3] = ' ';
[4]	519	}
	520	# Some nice hairy Perl to decide whether to allow unassigning each IP
[159]	521	# -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
[4]	522	# else we print a blank space
[159]	523	my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
	524	$data[1],$data[2],$data[3],
[242]	525	( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
[159]	526	("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
	527	"alloctype=$data[4]\">Unassign this IP</a>") :
[4]	528	(" ") )
	529	);
	530	printRow(\@row, 'color1') if($count%2==0);
	531	printRow(\@row, 'color2') if($count%2!=0);
	532	$count++;
	533	}
	534	print "</table>\n";
	535
	536	} # end listPool
	537
	538
[125]	539	# Show "Add new allocation" page. Note that the actual page may
	540	# be one of two templates, and the lists come from the database.
[4]	541	sub assignBlock {
	542
[242]	543	if ($IPDBacl{$authuser} !~ /a/) {
	544	printError("You shouldn't have been able to get here. Access denied.");
	545	return;
	546	}
	547
[24]	548	my $html;
	549
	550	# New special case- block to assign is specified
	551	if ($webvar{block} ne '') {
	552	open HTML, "../fb-assign.html"
	553	or croak "Could not open fb-assign.html: $!";
	554	$html = join('',<HTML>);
	555	close HTML;
	556	my $block = new NetAddr::IP $webvar{block};
	557	$html =~ s\|\$\$BLOCK\$\$\|$block\|g;
	558	$html =~ s\|\$\$MASKBITS\$\$\|$block->masklen\|;
[98]	559	my $typelist = '';
[192]	560
	561	# This is a little dangerous, as it's theoretically possible to
	562	# get fbtype='n' (aka a non-routed freeblock). However, should
	563	# someone manage to get there, they get what they deserve.
	564	if ($webvar{fbtype} ne 'y') {
	565	# Snag the type of the block from the database. We have no
	566	# convenient way to pass this in from the calling location. :/
	567	$sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
	568	$sth->execute;
	569	my @data = $sth->fetchrow_array;
	570	$data[0] =~ s/c$/r/; # Munge the type into the correct form
	571	$typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
	572	} else {
	573	$typelist .= qq(<select name="alloctype">\n);
	574	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
	575	"and type not like '_i' and type not like '_r' order by listorder");
	576	$sth->execute;
	577	my @data = $sth->fetchrow_array;
	578	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	579	while (my @data = $sth->fetchrow_array) {
	580	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	581	}
	582	$typelist .= "</select>\n";
[98]	583	}
	584	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[24]	585	} else {
	586	open HTML, "../assign.html"
[4]	587	or croak "Could not open assign.html: $!";
[24]	588	$html = join('',<HTML>);
[91]	589	close HTML;
[32]	590	my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
	591	foreach my $master (@masterblocks) {
	592	$masterlist .= "<option>$master</option>\n";
	593	}
	594	$masterlist .= "</select>\n";
	595	$html =~ s\|\$\$MASTERLIST\$\$\|$masterlist\|g;
[91]	596	my $pops = '';
	597	foreach my $pop (@poplist) {
	598	$pops .= "<option>$pop</option>\n";
	599	}
	600	$html =~ s\|\$\$POPLIST\$\$\|$pops\|g;
[98]	601	my $typelist = '';
	602	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
	603	$sth->execute;
	604	my @data = $sth->fetchrow_array;
	605	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	606	while (my @data = $sth->fetchrow_array) {
	607	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	608	}
	609	$html =~ s\|\$\$TYPELIST\$\$\|$typelist\|g;
[24]	610	}
[91]	611	my $cities = '';
	612	foreach my $city (@citylist) {
	613	$cities .= "<option>$city</option>\n";
	614	}
	615	$html =~ s\|\$\$ALLCITIES\$\$\|$cities\|g;
[4]	616
[394]	617	## node hack
	618	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	619	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	620	my $nodes = '';
	621	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	622	$nodes .= "<option value='$nid'>$nname</option>\n";
	623	}
	624	$html =~ s/\$\$NODELIST\$\$/$nodes/;
	625	## end node hack
	626
[286]	627	my $i = 0;
	628	$i++ if $webvar{fbtype} eq 'y';
	629	# Check to see if user is allowed to do anything with sensitive data
	630	my $privdata = '';
	631	if ($IPDBacl{$authuser} =~ /s/) {
	632	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	633	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	634	qq(</textarea></td></tr>\n);
	635	$i++;
	636	}
	637	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	638
	639	$i = $i % 2;
	640	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	641
[4]	642	print $html;
	643
	644	} # assignBlock
	645
	646
	647	# Take info on requested IP assignment and see what we can provide.
	648	sub confirmAssign {
[242]	649	if ($IPDBacl{$authuser} !~ /a/) {
	650	printError("You shouldn't have been able to get here. Access denied.");
	651	return;
	652	}
[4]	653
	654	my $cidr;
	655	my $alloc_from;
	656
	657	# Going to manually validate some items.
	658	# custid and city are automagic.
[125]	659	return if !validateInput();
[4]	660
	661	# Several different cases here.
	662	# Static IP vs netblock
	663	# + Different flavours of static IP
	664	# + Different flavours of netblock
	665
[159]	666	if ($webvar{alloctype} =~ /^.i$/) {
[4]	667	my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
[211]	668	my ($sql,$city);
	669	# Check for pools in Subury, North Bay, or Toronto if DSL or server pool.
	670	# Anywhere else is invalid and shouldn't be in the db in the first place.
[4]	671	# ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
	672	# Note that we want to retain the requested city to relate to customer info.
	673	if ($base =~ /^[ds]$/) {
[211]	674	$city = "(allocations.city='Sudbury' or allocations.city='North Bay' or ".
	675	"allocations.city='Toronto')";
[4]	676	} else {
[211]	677	$city = "allocations.city='$webvar{pop}'";
[4]	678	}
	679
[211]	680	# Ewww. But it works.
	681	$sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
	682	"poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
	683	"poolips.pool=allocations.cidr AND $city AND poolips.type LIKE '".$base."_' ".
	684	"GROUP BY pool");
[4]	685	$sth->execute;
	686	my $optionlist;
	687	while (my @data = $sth->fetchrow_array) {
[211]	688	# city,pool cidr,free IP count
	689	if ($data[2] > 0) {
	690	$optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
	691	}
[4]	692	}
	693	$cidr = "Single static IP";
	694	$alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
	695
	696	} else { # end show pool options
[24]	697
	698	if ($webvar{fbassign} eq 'y') {
	699	$cidr = new NetAddr::IP $webvar{block};
	700	$webvar{maskbits} = $cidr->masklen;
	701	} else { # done with direct freeblocks assignment
	702
	703	if (!$webvar{maskbits}) {
[125]	704	printError("Please specify a CIDR mask length.");
	705	return;
[24]	706	}
	707	my $sql;
	708	my $city;
	709	my $failmsg;
[267]	710	my $extracond = '';
	711	if ($webvar{allocfrom} eq '-') {
	712	$extracond = ($webvar{allowpriv} eq 'on' ? '' :
	713	" and not (cidr <<= '192.168.0.0/16'".
	714	" or cidr <<= '10.0.0.0/8'".
	715	" or cidr <<= '172.16.0.0/12')");
	716	}
	717	my $sortorder;
[192]	718	if ($webvar{alloctype} eq 'rm') {
[32]	719	if ($webvar{allocfrom} ne '-') {
	720	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
[267]	721	" and cidr <<= '$webvar{allocfrom}'";
	722	$sortorder = "maskbits desc";
[32]	723	} else {
[267]	724	$sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
	725	$sortorder = "maskbits desc";
[32]	726	}
[24]	727	$failmsg = "No suitable free block found.<br>\nWe do not have a free".
	728	" routeable block of that size.<br>\nYou will have to either route".
	729	" a set of smaller netblocks or a single smaller netblock.";
[4]	730	} else {
[125]	731	##fixme
	732	# This section needs serious Pondering.
[211]	733	# Pools of most types get assigned to the POP they're "routed from"
[192]	734	# This includes WAN blocks and other netblock "containers"
[211]	735	# This does NOT include cable pools.
	736	if ($webvar{alloctype} =~ /^.[pc]$/) {
[206]	737	if (($webvar{city} !~ /^(Sudbury\|North Bay\|Toronto)$/) && ($webvar{alloctype} eq 'dp')) {
	738	printError("You must chose Sudbury, North Bay, or Toronto for DSL pools.");
[125]	739	return;
	740	}
[39]	741	$city = $webvar{city};
[24]	742	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[125]	743	" superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
[24]	744	" block size for the pool.";
	745	} else {
	746	$city = $webvar{pop};
	747	$failmsg = "No suitable free block found.<br>\nYou will have to route another".
[101]	748	" superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
[24]	749	" chose a smaller blocksize.";
	750	}
[315]	751	if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
[159]	752	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[192]	753	" and cidr <<= '$webvar{allocfrom}' and routed='".
[267]	754	(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	755	$sortorder = "maskbits desc,cidr";
[32]	756	} else {
[159]	757	$sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
[267]	758	" and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
	759	$sortorder = "maskbits desc,cidr";
[32]	760	}
[4]	761	}
[267]	762	$sql = $sql.$extracond." order by ".$sortorder;
[24]	763	$sth = $ip_dbh->prepare($sql);
	764	$sth->execute;
	765	my @data = $sth->fetchrow_array();
	766	if ($data[0] eq "") {
[125]	767	printError($failmsg);
	768	return;
[24]	769	}
	770	$cidr = new NetAddr::IP $data[0];
	771	} # check for freeblocks assignment or IPDB-controlled assignment
[4]	772
	773	$alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
	774
	775	# If the block to be allocated is smaller than the one we found,
	776	# figure out the "real" block to be allocated.
	777	if ($cidr->masklen() ne $webvar{maskbits}) {
	778	my $maskbits = $cidr->masklen();
	779	my @subblocks;
	780	while ($maskbits++ < $webvar{maskbits}) {
	781	@subblocks = $cidr->split($maskbits);
	782	}
	783	$cidr = $subblocks[0];
	784	}
[159]	785	} # if ($webvar{alloctype} =~ /^.i$/)
[4]	786
	787	open HTML, "../confirm.html"
	788	or croak "Could not open confirm.html: $!";
	789	my $html = join '', <HTML>;
	790	close HTML;
	791
[394]	792	## node hack
	793	if ($webvar{node} && $webvar{node} ne '-') {
	794	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
	795	$sth->execute($webvar{node});
	796	my ($nodename) = $sth->fetchrow_array();
	797	$html =~ s/\$\$NODENAME\$\$/$nodename/;
	798	$html =~ s/\$\$NODEID\$\$/$webvar{node}/;
	799	} else {
	800	$html =~ s/\$\$NODENAME\$\$//;
	801	$html =~ s/\$\$NODEID\$\$//;
	802	}
	803	## end node hack
	804
[4]	805	### gotta fix this in final
	806	# Stick in customer info as necessary - if it's blank, it just ends
	807	# up as blank lines ignored in the rendering of the page
	808	my $custbits;
	809	$html =~ s\|\$\$CUSTBITS\$\$\|$custbits\|g;
	810	###
	811
	812	# Stick in the allocation data
	813	$html =~ s\|\$\$ALLOC_TYPE\$\$\|$webvar{alloctype}\|g;
[98]	814	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$webvar{alloctype}}\|g;
[4]	815	$html =~ s\|\$\$ALLOC_FROM\$\$\|$alloc_from\|g;
	816	$html =~ s\|\$\$CIDR\$\$\|$cidr\|g;
[82]	817	$webvar{city} = desanitize($webvar{city});
[4]	818	$html =~ s\|\$\$CITY\$\$\|$webvar{city}\|g;
	819	$html =~ s\|\$\$CUSTID\$\$\|$webvar{custid}\|g;
[83]	820	$webvar{circid} = desanitize($webvar{circid});
[75]	821	$html =~ s\|\$\$CIRCID\$\$\|$webvar{circid}\|g;
[4]	822	$webvar{desc} = desanitize($webvar{desc});
[89]	823	$html =~ s\|\$\$DESC\$\$\|$webvar{desc}\|g;
[4]	824	$webvar{notes} = desanitize($webvar{notes});
	825	$html =~ s\|\$\$NOTES\$\$\|$webvar{notes}\|g;
	826	$html =~ s\|\$\$ACTION\$\$\|insert\|g;
	827
[286]	828	my $i=1;
	829	# Check to see if user is allowed to do anything with sensitive data
	830	my $privdata = '';
	831	if ($IPDBacl{$authuser} =~ /s/) {
	832	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	833	qq(<td class=regular>$webvar{privdata}).
	834	qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
	835	$i++;
	836	}
[315]	837	# We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
	838	$privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
	839	if $webvar{userid};
[286]	840	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	841
	842	$i = $i % 2;
	843	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	844
[4]	845	print $html;
	846
	847	} # end confirmAssign
	848
	849
	850	# Do the work of actually inserting a block in the database.
	851	sub insertAssign {
[242]	852	if ($IPDBacl{$authuser} !~ /a/) {
	853	printError("You shouldn't have been able to get here. Access denied.");
	854	return;
	855	}
[4]	856	# Some things are done more than once.
[125]	857	return if !validateInput();
[4]	858
[390]	859	# 2009/12/1 kdeugau
	860	# Since we're using these for more than just NOC-ish things now, removing
	861	## Hack as per Jody. Force CustID of NOC-VPN on 192.168 assignments
	862	#if ($webvar{fullcidr} =~ /^192\.168/) {
	863	# $webvar{custid} = "NOC-VPN";
	864	#}
	865
[286]	866	if (!defined($webvar{privdata})) {
	867	$webvar{privdata} = '';
	868	}
[125]	869	# $code is "success" vs "failure", $msg contains OK for a
	870	# successful netblock allocation, the IP allocated for static
	871	# IP, or the error message if an error occurred.
	872	my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
	873	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
[394]	874	$webvar{circid}, $webvar{privdata}, $webvar{node});
[4]	875
[125]	876	if ($code eq 'OK') {
	877	if ($webvar{alloctype} =~ /^.i$/) {
[315]	878	$msg =~ s\|/32\|\|;
	879	print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
	880	( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
[322]	881	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	882	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	883	qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
	884	: "</div>");
[122]	885	# Notify tech@example.com
[203]	886	mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
[125]	887	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
[122]	888	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[125]	889	} else {
[315]	890	my $netblock = new NetAddr::IP $webvar{fullcidr};
[125]	891	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[315]	892	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
	893	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[322]	894	qq(<div><a href="https://billing.example.com/radius.pl?).
[315]	895	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
	896	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
	897	"&include_routed_subnet=1&ipdb=1".
	898	qq(">Add this netblock to RADIUS user table</a></div>)
	899	: "</div>");
[390]	900	mailNotify('nocmgr@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	901	"$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
	902	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[122]	903	}
[125]	904	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[251]	905	"'$webvar{alloctype}' ($msg)";
[125]	906	} else {
	907	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	908	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[192]	909	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[159]	910	" failed:<br>\n$msg\n");
[125]	911	}
[122]	912
[4]	913	} # end insertAssign()
	914
	915
	916	# Does some basic checks on common input data to make sure nothing
	917	# really weird gets in to the database through this script.
	918	# Does NOT do complete input validation!!!
	919	sub validateInput {
	920	if ($webvar{city} eq '-') {
[125]	921	printError("Please choose a city.");
	922	return;
[4]	923	}
[140]	924
	925	# Alloctype check.
[4]	926	chomp $webvar{alloctype};
[140]	927	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	928	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	929	# managing to call things in such a way as to cause this deserves a cryptic error.
	930	printError("Invalid alloctype");
	931	return;
	932	}
	933
	934	# CustID check
[4]	935	# We have different handling for customer allocations and "internal" or "our" allocations
[209]	936	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	937	if (!$webvar{custid}) {
[125]	938	printError("Please enter a customer ID.");
	939	return;
[4]	940	}
[116]	941	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
[56]	942	# Force uppercase for now...
	943	$webvar{custid} =~ tr/a-z/A-Z/;
[338]	944	# Crosscheck with billing.
[56]	945	my $status = CustIDCK->custid_exist($webvar{custid});
[125]	946	if ($CustIDCK::Error) {
	947	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	948	return;
	949	}
	950	if (!$status) {
	951	printError("Customer ID not valid. Make sure the Customer ID ".
	952	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	953	"non-customer assignments.");
	954	return;
	955	}
[56]	956	#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
	957	#static IPs for staff.");
[4]	958	}
[56]	959	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[140]	960	} else {
[168]	961	# New! Improved! And now Loaded From The Database!!
[56]	962	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
[168]	963	$webvar{custid} = $def_custids{$webvar{alloctype}};
[56]	964	}
[4]	965	}
[125]	966
	967	# Check POP location
	968	my $flag;
[192]	969	if ($webvar{alloctype} eq 'rm') {
[125]	970	$flag = 'for a routed netblock';
	971	foreach (@poplist) {
	972	if (/^$webvar{city}$/) {
	973	$flag = 'n';
	974	last;
	975	}
	976	}
	977	} else {
	978	$flag = 'n';
[315]	979	if ($webvar{alloctype} =~ /[wp][cr]\|[ds][pi]/) {
	980	# Set this forcibly rather than messing around elsewhere. Yes, this is a hack. PTHBTT!!
	981	$webvar{pop} = 'Sudbury';
	982	}
	983	if ($webvar{pop} =~ /^-$/) {
[125]	984	$flag = 'to route the block from/through';
	985	}
	986	}
	987	if ($flag ne 'n') {
	988	printError("Please choose a valid POP location $flag. Valid ".
	989	"POP locations are currently:<br>\n".join (" - ", @poplist));
	990	return;
	991	}
	992
	993	return 'OK';
[4]	994	} # end validateInput
	995
	996
	997	# Displays details of a specific allocation in a form
	998	# Allows update/delete
	999	# action=edit
	1000	sub edit {
	1001
	1002	my $sql;
	1003
	1004	# Two cases: block is a netblock, or block is a static IP from a pool
	1005	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	1006	if ($webvar{block} =~ /\/32$/) {
[318]	1007	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	1008	} else {
[318]	1009	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	1010	}
	1011
	1012	# gotta snag block info from db
	1013	$sth = $ip_dbh->prepare($sql);
	1014	$sth->execute;
	1015	my @data = $sth->fetchrow_array;
	1016
	1017	# Clean up extra whitespace on alloc type
	1018	$data[2] =~ s/\s//;
	1019
	1020	open (HTML, "../editDisplay.html")
	1021	or croak "Could not open editDisplay.html :$!";
	1022	my $html = join('', <HTML>);
	1023
	1024	# We can't let the city be changed here; this block is a part of
	1025	# a larger routed allocation and therefore by definition can't be moved.
	1026	# block and city are static.
	1027	##fixme
	1028	# Needs thinking. Have to allow changes to city to correct errors, no?
	1029	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1030
[242]	1031	if ($IPDBacl{$authuser} =~ /c/) {
	1032	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	1033
[4]	1034	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1035	# with the much longer list of allocation types.
	1036	# We'll just show what type of block it is.
	1037
[35]	1038	# this has now been Requested, so here goes.
[4]	1039
[192]	1040	##fixme The check here should be built from the database
[242]	1041	if ($data[2] =~ /^.[ne]$/) {
	1042	# Block that can be changed
	1043	my $blockoptions = "<select name=alloctype><option".
[192]	1044	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[224]	1045	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	1046	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	1047	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[35]	1048	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[192]	1049	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[133]	1050	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[35]	1051	"</select>\n";
[242]	1052	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1053	} else {
	1054	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1055	}
[394]	1056	## node hack
	1057	$sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
	1058	$sth->execute;
	1059	my ($nodeid) = $sth->fetchrow_array();
	1060	if ($nodeid) {
	1061	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1062	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1063	my $nodes = "<select name=node>\n";
	1064	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1065	$nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
	1066	}
	1067	$nodes .= "</select>\n";
	1068	$html =~ s/\$\$NODE\$\$/$nodes/;
	1069	} else {
	1070	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1071	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1072	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1073	my $nodes = "<select name=node>\n<option value=>--</option>\n";
	1074	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1075	$nodes .= "<option value='$nid'>$nname</option>\n";
	1076	}
	1077	$nodes .= "</select>\n";
	1078	$html =~ s/\$\$NODE\$\$/$nodes/;
	1079	} else {
	1080	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1081	}
	1082	}
	1083	## end node hack
[318]	1084	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1085	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1086	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1087	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1088	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[35]	1089	} else {
[394]	1090	## node hack
	1091	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1092	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
	1093	" ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
	1094	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1095	my ($node) = $sth->fetchrow_array;
	1096	$html =~ s/\$\$NODE\$\$/$node/;
	1097	} else {
	1098	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1099	}
	1100	## end node hack
[242]	1101	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[318]	1102	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[242]	1103	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1104	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1105	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1106	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1107	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[35]	1108	}
[245]	1109	my ($lastmod,undef) = split /\s+/, $data[7];
	1110	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[35]	1111
[244]	1112	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1113	if ($data[2] =~ /.i/) {
	1114	$html =~ s/\$\$SWIP\$\$/N\/A/;
	1115	} else {
[318]	1116	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
[244]	1117	'<input type=checkbox name=swip checked=yes>');
	1118	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1119	}
	1120
[245]	1121	# Allows us to "correctly" colour backgrounds in table
	1122	my $i=1;
	1123
[286]	1124	# Check to see if we can display sensitive data
	1125	my $privdata = '';
	1126	if ($IPDBacl{$authuser} =~ /s/) {
	1127	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1128	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1129	qq($data[8]</textarea></td></tr>\n);
	1130	$i++;
	1131	}
	1132	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1133
[242]	1134	# More ACL trickery - we can live with forms that don't submit,
	1135	# but we can't leave the extra table rows there, and we really
	1136	# can't leave the submit buttons there.
	1137	my $updok = '';
	1138	if ($IPDBacl{$authuser} =~ /c/) {
[286]	1139	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[242]	1140	qq(<input type="submit" value=" Update this block " class="regular">).
	1141	"</div></td></tr></form>\n";
[245]	1142	$i++;
[242]	1143	}
	1144	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1145
[242]	1146	my $delok = '';
	1147	if ($IPDBacl{$authuser} =~ /d/) {
	1148	$delok = qq(<form method="POST" action="main.cgi">
[286]	1149	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[242]	1150	<input type="hidden" name="action" value="delete">
	1151	<input type="hidden" name="block" value="$webvar{block}">
	1152	<input type="hidden" name="alloctype" value="$data[2]">
	1153	<input type=submit value=" Delete this block ">
	1154	</div></td></tr>);
	1155	}
	1156	$html =~ s/\$\$DELOK\$\$/$delok/;
	1157
[4]	1158	print $html;
	1159
	1160	} # edit()
	1161
	1162
	1163	# Stuff new info about a block into the db
	1164	# action=update
	1165	sub update {
[286]	1166	if ($IPDBacl{$authuser} !~ /c/) {
	1167	printError("You shouldn't have been able to get here. Access denied.");
	1168	return;
	1169	}
[4]	1170
[286]	1171	# Check to see if we can update restricted data
	1172	my $privdata = '';
	1173	if ($IPDBacl{$authuser} =~ /s/) {
	1174	$privdata = ",privdata='$webvar{privdata}'";
	1175	}
	1176
[4]	1177	# Make sure incoming data is in correct format - custID among other things.
[220]	1178	return if !validateInput;
[4]	1179
	1180	# SQL transaction wrapper
	1181	eval {
	1182	# Relatively simple SQL transaction here.
	1183	my $sql;
[159]	1184	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[75]	1185	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[286]	1186	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1187	"$privdata where ip='$webvar{block}'";
[4]	1188	} else {
	1189	$sql = "update allocations set custid='$webvar{custid}',".
[35]	1190	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[296]	1191	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
[244]	1192	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[286]	1193	"where cidr='$webvar{block}'";
[4]	1194	}
[159]	1195	# Log the details of the change.
	1196	syslog "debug", $sql;
[4]	1197	$sth = $ip_dbh->prepare($sql);
	1198	$sth->execute;
[394]	1199	## node hack
	1200	if ($webvar{node}) {
	1201	$ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
	1202	$sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	1203	$sth->execute($webvar{block},$webvar{node});
	1204	}
	1205	## end node hack
[4]	1206	$ip_dbh->commit;
	1207	};
	1208	if ($@) {
[163]	1209	my $msg = $@;
	1210	carp "Transaction aborted because $msg";
[4]	1211	eval { $ip_dbh->rollback; };
[163]	1212	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1213	printError("Could not update block/IP $webvar{block}: $msg");
[125]	1214	return;
[4]	1215	}
	1216
	1217	# If we get here, the operation succeeded.
	1218	syslog "notice", "$authuser updated $webvar{block}";
[390]	1219	mailNotify('nocmgr@example.com',"SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1220	"$webvar{block} had SWIP status changed to \"Yes\" by $authuser");
[4]	1221	open (HTML, "../updated.html")
[125]	1222	or croak "Could not open updated.html :$!";
[4]	1223	my $html = join('', <HTML>);
	1224
[378]	1225	# Link back to browse-routed or list-pool page on "Update complete" page.
	1226	my $backlink = "/ip/cgi-bin/main.cgi?action=";
	1227	my $cblock; # to contain the CIDR of the container block we're retrieving.
	1228	my $sql;
	1229	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
	1230	$sql = "select pool from poolips where ip='$webvar{block}'";
	1231	$backlink .= "listpool&pool=";
	1232	} else {
	1233	$sql = "select cidr from routed where cidr >>= '$webvar{block}'";
	1234	$backlink .= "showrouted&block=";
	1235	}
	1236	# I define there to be no errors on this operation... so we don't need to check for them.
	1237	$sth = $ip_dbh->prepare($sql);
	1238	$sth->execute;
	1239	$sth->bind_columns(\$cblock);
	1240	$sth->fetch();
	1241	$sth->finish;
	1242	$backlink .= $cblock;
	1243
[244]	1244	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1245	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[89]	1246	$webvar{city} = desanitize($webvar{city});
[4]	1247	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1248	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[98]	1249	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1250	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[244]	1251	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[89]	1252	$webvar{circid} = desanitize($webvar{circid});
[75]	1253	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[89]	1254	$webvar{desc} = desanitize($webvar{desc});
[4]	1255	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[89]	1256	$webvar{notes} = desanitize($webvar{notes});
[4]	1257	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
[378]	1258	$html =~ s/\$\$BACKLINK\$\$/$backlink/g;
	1259	$html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
[4]	1260
[286]	1261	if ($IPDBacl{$authuser} =~ /s/) {
	1262	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1263	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1264	}
	1265	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1266
[4]	1267	print $html;
	1268
	1269	} # update()
	1270
	1271
	1272	# Delete an allocation.
[125]	1273	sub remove {
[242]	1274	if ($IPDBacl{$authuser} !~ /d/) {
	1275	printError("You shouldn't have been able to get here. Access denied.");
	1276	return;
	1277	}
	1278
[4]	1279	#show confirm screen.
	1280	open HTML, "../confirmRemove.html"
	1281	or croak "Could not open confirmRemove.html :$!";
	1282	my $html = join('', <HTML>);
	1283	close HTML;
	1284
	1285	# Serves'em right for getting here...
	1286	if (!defined($webvar{block})) {
[125]	1287	printError("Error 332");
	1288	return;
[4]	1289	}
	1290
[286]	1291	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1292
[192]	1293	if ($webvar{alloctype} eq 'rm') {
[4]	1294	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1295	$sth->execute();
	1296
	1297	# This feels... extreme.
	1298	croak $sth->errstr() if($sth->errstr());
	1299
	1300	$sth->bind_columns(\$cidr,\$city);
	1301	$sth->execute();
	1302	$sth->fetch \|\| croak $sth->errstr();
	1303	$custid = "N/A";
	1304	$alloctype = $webvar{alloctype};
[75]	1305	$circid = "N/A";
[4]	1306	$desc = "N/A";
	1307	$notes = "N/A";
	1308
	1309	} elsif ($webvar{alloctype} eq 'mm') {
	1310	$cidr = $webvar{block};
	1311	$city = "N/A";
	1312	$custid = "N/A";
	1313	$alloctype = $webvar{alloctype};
[75]	1314	$circid = "N/A";
[4]	1315	$desc = "N/A";
	1316	$notes = "N/A";
[192]	1317	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1318
	1319	# Unassigning a static IP
[286]	1320	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1321	" from poolips where ip='$webvar{block}'");
[4]	1322	$sth->execute();
	1323	# croak $sth->errstr() if($sth->errstr());
	1324
[286]	1325	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1326	\$privdata);
[4]	1327	$sth->fetch() \|\| croak $sth->errstr;
	1328
[159]	1329	} else { # done with alloctype=~ /^.i$/
[4]	1330
[286]	1331	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1332	" from allocations where cidr='$webvar{block}'");
[4]	1333	$sth->execute();
	1334	# croak $sth->errstr() if($sth->errstr());
	1335
[286]	1336	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1337	\$notes, \$privdata);
[75]	1338	$sth->fetch() \|\| carp $sth->errstr;
[4]	1339	} # end cases for different alloctypes
	1340
	1341	# Munge everything into HTML
	1342	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1343	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[98]	1344	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1345	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1346	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1347	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[75]	1348	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1349	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1350	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1351
	1352	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1353
	1354	# Set the warning text.
[159]	1355	if ($alloctype =~ /^.[pd]$/) {
[4]	1356	$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>\|;
	1357	} else {
	1358	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1359	}
	1360
[286]	1361	my $i = 1;
	1362	# Check to see if user is allowed to do anything with sensitive data
	1363	if ($IPDBacl{$authuser} =~ /s/) {
	1364	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1365	qq(<td class=regular>$privdata</td></tr>\n);
	1366	$i++;
	1367	}
	1368	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1369
	1370	$i = ++$i % 2;
	1371	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1372
[4]	1373	print $html;
	1374	} # end edit()
	1375
	1376
	1377	# Delete an allocation. Return it to the freeblocks table; munge
	1378	# data as necessary to keep as few records as possible in freeblocks
	1379	# to prevent weirdness when allocating blocks later.
	1380	# Remove IPs from pool listing if necessary
	1381	sub finalDelete {
[242]	1382	if ($IPDBacl{$authuser} !~ /d/) {
	1383	printError("You shouldn't have been able to get here. Access denied.");
	1384	return;
	1385	}
[4]	1386
[356]	1387	# need to retrieve block data before deleting so we can notify on that
	1388	my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
	1389
[125]	1390	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1391
[125]	1392	if ($code eq 'OK') {
[4]	1393	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[356]	1394	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
	1395	" $custid, $city, desc='$description'";
[205]	1396	# Notify tech@ when a block/IP is deallocated
	1397	mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
[356]	1398	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1399	"CustID: $custid\nCity: $city\nDescription: $description\n");
[390]	1400	mailNotify('nocmgr@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1401	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1402	"CustID: $custid\nCity: $city\nDescription: $description\n");
[125]	1403	} else {
	1404	if ($webvar{alloctype} =~ /^.i$/) {
	1405	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
	1406	printError("Could not deallocate static IP $webvar{block}: $msg");
	1407	} else {
	1408	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
	1409	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1410	}
[102]	1411	}
	1412
[4]	1413	} # finalDelete
	1414
	1415
[242]	1416	sub exitError {
	1417	my $errStr = $_[0];
	1418	printHeader('','');
	1419	print qq(<center><p class="regular"> $errStr </p>
	1420	<input type="button" value="Back" onclick="history.go(-1)">
	1421	</center>
	1422	);
	1423	printFooter();
	1424	exit;
	1425	} # errorExit
	1426
	1427
[4]	1428	# Just in case we manage to get here.
	1429	exit 0;

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

Download in other formats: