Context Navigation

source: branches/htmlform/cgi-bin/main.cgi@ 449

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

/branches/htmlform

Remove printFooter from CommonWeb.pm
Add HTML::Template to main.cgi, admin.cgi, and search.cgi
Convert footer.inc to templates/footer.tmpl, and normalize
output for three scripts above
See #3.

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

File size: 49.3 KB

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

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

Download in other formats: