Context Navigation

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

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

/branches/htmlform

Validation nitpick fix in assign.tmpl - also fixes missing field
name on alloctype list. <headdesk>
Convert new assignment result page to template.
Add missing error handling, missing IP pool selection on confirm.tmpl
Create footer template object earlier to allow pushing bits into
it during processing
Prepare to move initial output further down execution to prepare for
proper error handling in subs
Fix probable bug introduced with r456 where the "Routing" type isn't
available when it should be. Maybe. Probably.
Error messages for sub insertAssign() and confirmAssign could arguably
be further moved into the templates, but the complexity of the template
would go *way* up with little or no benefit.
See #3.

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

File size: 48.0 KB

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

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

Download in other formats: