Context Navigation

source: branches/stable/cgi-bin/main.cgi@ 507

Last change on this file since 507 was 507, checked in by Kris Deugau, 13 years ago

/branches/stable

Make the fixed web path at least configurable in one place rather
than completely hardcoded across many files.
Update initial database tabledef SQL
Bump version

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

File size: 48.8 KB

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

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

Download in other formats: