Context Navigation

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

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

/branches/htmlform

Switch all scripts to use CGI::Simple for HTML form data munging
instead of legacy CommonWeb.pm sub. Remove parse_post() sub from
CommonWeb.pm. See #15.

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

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

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

Download in other formats: