Context Navigation

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

Last change on this file since 592 was 592, checked in by Kris Deugau, 12 years ago

/branches/stable

Merge /trunk changes up to r516

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

File size: 50.6 KB

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

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

Download in other formats: