Context Navigation

source: trunk/cgi-bin/main.cgi@ 425

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

/trunk

Fix dangling $defcustid -> $IPDB::defcustid
Return quietly from mailNotify if there's no recipients
Move rWHOIS data path definition/default into MyIPDB.pm/IPDB.pm respectively

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

File size: 49.2 KB

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

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

Download in other formats: