Context Navigation

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

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

/trunk

Genericize and comment a lurking mailNotify() call. See #2.
Remove a couple of stale, legacy, irrelvant comments.
Genericize another email address reference. See #2 (sort of).
Remove a legacy sub that's never been used, from a module due
to be removed itself. See #15.

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

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

Download in other formats: