Context Navigation

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

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

/branches/htmlform

Move Javascript from the header into its own file
Convert index page (master block summary) to template
Convert header to template, use template header in main.cgi
and search.cgi - going to leave admin.cgi out for now
Update HTML in header, index, footer to HTML 4.01 strict
See #3.

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

File size: 49.2 KB

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

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

Download in other formats: