Context Navigation

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

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

/branches/htmlform

Convert showmaster page to template.
See #3.

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

File size: 47.2 KB

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

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

Download in other formats: