Context Navigation

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

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

/trunk

Update mailNotify to use new table notify to decide who to spam
with notices on various events. See #2.

existing notification calls updated. Still need to move calls into IPDB.pm's subs
IPDB.pm and MyIPDB.pm updated with new semiglobal vars for org name, SMTP host, domain. Will add others as needed so MyIPDB.pm can be moved to /etc/ipdb/ (see #17).

Internal allocation types will need to be rearranged somewhat to
make full use of the flexibility possible. See #20.

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

File size: 49.1 KB

Rev	Line
[4]	1	#!/usr/bin/perl
	2	# ipdb/cgi-bin/main.cgi
[8]	3	###
	4	# SVN revision info
	5	# $Date: 2010-05-18 22:08:12 +0000 (Tue, 18 May 2010) $
	6	# SVN revision $Rev: 416 $
	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>");
[416]	892	mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	893	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
	894	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[106]	895	} else {
[301]	896	my $netblock = new NetAddr::IP $webvar{fullcidr};
[106]	897	print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
[301]	898	"sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
[313]	899	( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
[380]	900	qq(<div><a href="https://billing.example.com/radius.pl?).
[314]	901	"action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
[301]	902	"&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
[302]	903	"&include_routed_subnet=1&ipdb=1".
[301]	904	qq(">Add this netblock to RADIUS user table</a></div>)
	905	: "</div>");
[416]	906	mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
	907	"$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
	908	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
[4]	909	}
[106]	910	syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
[256]	911	"'$webvar{alloctype}' ($msg)";
[111]	912	} else {
	913	syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
	914	"'$webvar{alloctype}' by $authuser failed: '$msg'";
[189]	915	printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
[157]	916	" failed:<br>\n$msg\n");
[106]	917	}
[4]	918
	919	} # end insertAssign()
	920
	921
	922	# Does some basic checks on common input data to make sure nothing
	923	# really weird gets in to the database through this script.
	924	# Does NOT do complete input validation!!!
	925	sub validateInput {
	926	if ($webvar{city} eq '-') {
[111]	927	printError("Please choose a city.");
	928	return;
[4]	929	}
[138]	930
	931	# Alloctype check.
[4]	932	chomp $webvar{alloctype};
[138]	933	if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
	934	# Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
	935	# managing to call things in such a way as to cause this deserves a cryptic error.
	936	printError("Invalid alloctype");
	937	return;
	938	}
	939
	940	# CustID check
[4]	941	# We have different handling for customer allocations and "internal" or "our" allocations
[214]	942	if ($def_custids{$webvar{alloctype}} eq '') {
[4]	943	if (!$webvar{custid}) {
[111]	944	printError("Please enter a customer ID.");
	945	return;
[4]	946	}
[400]	947	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
	948	# Force uppercase for now...
	949	$webvar{custid} =~ tr/a-z/A-Z/;
	950	# Crosscheck with billing.
	951	my $status = CustIDCK->custid_exist($webvar{custid});
	952	if ($CustIDCK::Error) {
	953	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	954	return;
	955	}
	956	if (!$status) {
	957	printError("Customer ID not valid. Make sure the Customer ID ".
	958	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	959	"non-customer assignments.");
	960	return;
	961	}
	962	#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
	963	#static IPs for staff.");
[4]	964	}
[400]	965	# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
[138]	966	} else {
[167]	967	# New! Improved! And now Loaded From The Database!!
[320]	968	if ((!$webvar{custid}) \|\| ($webvar{custid} ne 'STAFF')) {
	969	$webvar{custid} = $def_custids{$webvar{alloctype}};
	970	}
[4]	971	}
[111]	972
	973	# Check POP location
	974	my $flag;
[187]	975	if ($webvar{alloctype} eq 'rm') {
[111]	976	$flag = 'for a routed netblock';
	977	foreach (@poplist) {
	978	if (/^$webvar{city}$/) {
	979	$flag = 'n';
	980	last;
	981	}
	982	}
	983	} else {
	984	$flag = 'n';
[400]	985	if ($webvar{alloctype} =~ /[wp][cr]\|[ds][pi]/) {
[300]	986	# Set this forcibly rather than messing around elsewhere. Yes, this is a hack. PTHBTT!!
[400]	987	$webvar{pop} = 'Sudbury';
	988	}
	989	if ($webvar{pop} =~ /^-$/) {
[111]	990	$flag = 'to route the block from/through';
	991	}
	992	}
	993	if ($flag ne 'n') {
	994	printError("Please choose a valid POP location $flag. Valid ".
	995	"POP locations are currently:<br>\n".join (" - ", @poplist));
	996	return;
	997	}
	998
	999	return 'OK';
[4]	1000	} # end validateInput
	1001
	1002
	1003	# Displays details of a specific allocation in a form
	1004	# Allows update/delete
	1005	# action=edit
	1006	sub edit {
	1007
	1008	my $sql;
	1009
	1010	# Two cases: block is a netblock, or block is a static IP from a pool
	1011	# because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
	1012	if ($webvar{block} =~ /\/32$/) {
[320]	1013	$sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid from poolips where ip='$webvar{block}'";
[4]	1014	} else {
[320]	1015	$sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,oldcustid,swip from allocations where cidr='$webvar{block}'"
[4]	1016	}
	1017
	1018	# gotta snag block info from db
	1019	$sth = $ip_dbh->prepare($sql);
	1020	$sth->execute;
	1021	my @data = $sth->fetchrow_array;
	1022
	1023	# Clean up extra whitespace on alloc type
	1024	$data[2] =~ s/\s//;
	1025
	1026	open (HTML, "../editDisplay.html")
	1027	or croak "Could not open editDisplay.html :$!";
	1028	my $html = join('', <HTML>);
	1029
	1030	# We can't let the city be changed here; this block is a part of
	1031	# a larger routed allocation and therefore by definition can't be moved.
	1032	# block and city are static.
	1033	##fixme
	1034	# Needs thinking. Have to allow changes to city to correct errors, no?
	1035	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
	1036
[233]	1037	if ($IPDBacl{$authuser} =~ /c/) {
	1038	$html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
	1039
[4]	1040	# Screw it. Changing allocation types gets very ugly VERY quickly- especially
	1041	# with the much longer list of allocation types.
	1042	# We'll just show what type of block it is.
	1043
[33]	1044	# this has now been Requested, so here goes.
[4]	1045
[187]	1046	##fixme The check here should be built from the database
[233]	1047	if ($data[2] =~ /^.[ne]$/) {
	1048	# Block that can be changed
	1049	my $blockoptions = "<select name=alloctype><option".
[187]	1050	(($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
[228]	1051	(($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
	1052	(($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
	1053	(($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
[33]	1054	(($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
[187]	1055	(($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
[135]	1056	(($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
[33]	1057	"</select>\n";
[233]	1058	$html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
	1059	} else {
	1060	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
	1061	}
[397]	1062	## node hack
	1063	$sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
	1064	$sth->execute;
	1065	my ($nodeid) = $sth->fetchrow_array();
	1066	if ($nodeid) {
	1067	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1068	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1069	my $nodes = "<select name=node>\n";
	1070	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1071	$nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
	1072	}
	1073	$nodes .= "</select>\n";
	1074	$html =~ s/\$\$NODE\$\$/$nodes/;
	1075	} else {
	1076	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1077	$sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
	1078	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1079	my $nodes = "<select name=node>\n<option value=>--</option>\n";
	1080	while (my ($nid,$nname) = $sth->fetchrow_array()) {
	1081	$nodes .= "<option value='$nid'>$nname</option>\n";
	1082	}
	1083	$nodes .= "</select>\n";
	1084	$html =~ s/\$\$NODE\$\$/$nodes/;
	1085	} else {
	1086	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1087	}
	1088	}
	1089	## end node hack
[320]	1090	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[233]	1091	$html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
	1092	$html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
	1093	$html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
	1094	$html =~ s\|\$\$NOTES\$\$\|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>\|g;
[33]	1095	} else {
[397]	1096	## node hack
	1097	if ($data[2] eq 'fr' \|\| $data[2] eq 'bi') {
	1098	$sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
	1099	" ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
	1100	$sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
	1101	my ($node) = $sth->fetchrow_array;
	1102	$html =~ s/\$\$NODE\$\$/$node/;
	1103	} else {
	1104	$html =~ s\|\$\$NODE\$\$\|N/A\|;
	1105	}
	1106	## end node hack
[233]	1107	$html =~ s/\$\$CUSTID\$\$/$data[1]/g;
[320]	1108	$html =~ s/\$\$OLDCUSTID\$\$/$data[9]/g;
[233]	1109	$html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
	1110	$html =~ s/\$\$CITY\$\$/$data[3]/g;
	1111	$html =~ s/\$\$CIRCID\$\$/$data[4]/g;
	1112	$html =~ s/\$\$DESC\$\$/$data[5]/g;
	1113	$html =~ s/\$\$NOTES\$\$/$data[6]/g;
[33]	1114	}
[255]	1115	my ($lastmod,undef) = split /\s+/, $data[7];
	1116	$html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
[33]	1117
[320]	1118	## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
	1119	if ($data[2] =~ /.i/) {
	1120	$html =~ s/\$\$SWIP\$\$/N\/A/;
[406]	1121	} else {
[320]	1122	my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
	1123	'<input type=checkbox name=swip checked=yes>');
	1124	$html =~ s/\$\$SWIP\$\$/$tmp/;
	1125	}
	1126
[255]	1127	# Allows us to "correctly" colour backgrounds in table
	1128	my $i=1;
	1129
[284]	1130	# Check to see if we can display sensitive data
	1131	my $privdata = '';
	1132	if ($IPDBacl{$authuser} =~ /s/) {
	1133	$privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
	1134	qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
	1135	qq($data[8]</textarea></td></tr>\n);
	1136	$i++;
	1137	}
	1138	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1139
[233]	1140	# More ACL trickery - we can live with forms that don't submit,
	1141	# but we can't leave the extra table rows there, and we really
	1142	# can't leave the submit buttons there.
	1143	my $updok = '';
	1144	if ($IPDBacl{$authuser} =~ /c/) {
[284]	1145	$updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
[233]	1146	qq(<input type="submit" value=" Update this block " class="regular">).
	1147	"</div></td></tr></form>\n";
[255]	1148	$i++;
[233]	1149	}
	1150	$html =~ s/\$\$UPDOK\$\$/$updok/g;
[4]	1151
[233]	1152	my $delok = '';
	1153	if ($IPDBacl{$authuser} =~ /d/) {
	1154	$delok = qq(<form method="POST" action="main.cgi">
[284]	1155	<tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
[233]	1156	<input type="hidden" name="action" value="delete">
	1157	<input type="hidden" name="block" value="$webvar{block}">
	1158	<input type="hidden" name="alloctype" value="$data[2]">
	1159	<input type=submit value=" Delete this block ">
	1160	</div></td></tr>);
	1161	}
	1162	$html =~ s/\$\$DELOK\$\$/$delok/;
	1163
[4]	1164	print $html;
	1165
	1166	} # edit()
	1167
	1168
	1169	# Stuff new info about a block into the db
	1170	# action=update
	1171	sub update {
[284]	1172	if ($IPDBacl{$authuser} !~ /c/) {
	1173	printError("You shouldn't have been able to get here. Access denied.");
	1174	return;
	1175	}
[4]	1176
[284]	1177	# Check to see if we can update restricted data
	1178	my $privdata = '';
	1179	if ($IPDBacl{$authuser} =~ /s/) {
	1180	$privdata = ",privdata='$webvar{privdata}'";
	1181	}
	1182
[4]	1183	# Make sure incoming data is in correct format - custID among other things.
[228]	1184	return if !validateInput;
[4]	1185
	1186	# SQL transaction wrapper
	1187	eval {
	1188	# Relatively simple SQL transaction here.
	1189	my $sql;
[157]	1190	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
[74]	1191	$sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
[284]	1192	"circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
	1193	"$privdata where ip='$webvar{block}'";
[4]	1194	} else {
	1195	$sql = "update allocations set custid='$webvar{custid}',".
[33]	1196	"description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
[320]	1197	"type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
	1198	"swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
[284]	1199	"where cidr='$webvar{block}'";
[4]	1200	}
[157]	1201	# Log the details of the change.
	1202	syslog "debug", $sql;
[4]	1203	$sth = $ip_dbh->prepare($sql);
	1204	$sth->execute;
[397]	1205	## node hack
	1206	if ($webvar{node}) {
	1207	$ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
	1208	$sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
	1209	$sth->execute($webvar{block},$webvar{node});
	1210	}
	1211	## end node hack
[4]	1212	$ip_dbh->commit;
	1213	};
	1214	if ($@) {
[166]	1215	my $msg = $@;
	1216	carp "Transaction aborted because $msg";
[4]	1217	eval { $ip_dbh->rollback; };
[166]	1218	syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
	1219	printError("Could not update block/IP $webvar{block}: $msg");
[111]	1220	return;
[4]	1221	}
	1222
	1223	# If we get here, the operation succeeded.
	1224	syslog "notice", "$authuser updated $webvar{block}";
[416]	1225	##fixme: need to wedge something in to allow "update:field" notifications
	1226	## hmm. how to tell what changed? O_o
	1227	mailNotify($ip_dbh, 'ua', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1228	"$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
[4]	1229	open (HTML, "../updated.html")
[111]	1230	or croak "Could not open updated.html :$!";
[4]	1231	my $html = join('', <HTML>);
	1232
[380]	1233	# Link back to browse-routed or list-pool page on "Update complete" page.
	1234	my $backlink = "/ip/cgi-bin/main.cgi?action=";
	1235	my $cblock; # to contain the CIDR of the container block we're retrieving.
	1236	my $sql;
	1237	if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
	1238	$sql = "select pool from poolips where ip='$webvar{block}'";
	1239	$backlink .= "listpool&pool=";
	1240	} else {
	1241	$sql = "select cidr from routed where cidr >>= '$webvar{block}'";
	1242	$backlink .= "showrouted&block=";
	1243	}
	1244	# I define there to be no errors on this operation... so we don't need to check for them.
	1245	$sth = $ip_dbh->prepare($sql);
	1246	$sth->execute;
	1247	$sth->bind_columns(\$cblock);
	1248	$sth->fetch();
	1249	$sth->finish;
	1250	$backlink .= $cblock;
	1251
[320]	1252	my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
[4]	1253	$html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
[92]	1254	$webvar{city} = desanitize($webvar{city});
[4]	1255	$html =~ s/\$\$CITY\$\$/$webvar{city}/g;
	1256	$html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
[106]	1257	$html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
[4]	1258	$html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
[320]	1259	$html =~ s/\$\$SWIP\$\$/$swiptmp/g;
[92]	1260	$webvar{circid} = desanitize($webvar{circid});
[74]	1261	$html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
[92]	1262	$webvar{desc} = desanitize($webvar{desc});
[4]	1263	$html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
[92]	1264	$webvar{notes} = desanitize($webvar{notes});
[4]	1265	$html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
[380]	1266	$html =~ s/\$\$BACKLINK\$\$/$backlink/g;
	1267	$html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
[4]	1268
[284]	1269	if ($IPDBacl{$authuser} =~ /s/) {
	1270	$privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
	1271	qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
	1272	}
	1273	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1274
[4]	1275	print $html;
	1276
	1277	} # update()
	1278
	1279
	1280	# Delete an allocation.
[106]	1281	sub remove {
[233]	1282	if ($IPDBacl{$authuser} !~ /d/) {
	1283	printError("You shouldn't have been able to get here. Access denied.");
	1284	return;
	1285	}
	1286
[4]	1287	#show confirm screen.
	1288	open HTML, "../confirmRemove.html"
	1289	or croak "Could not open confirmRemove.html :$!";
	1290	my $html = join('', <HTML>);
	1291	close HTML;
	1292
	1293	# Serves'em right for getting here...
	1294	if (!defined($webvar{block})) {
[111]	1295	printError("Error 332");
	1296	return;
[4]	1297	}
	1298
[284]	1299	my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
[4]	1300
[187]	1301	if ($webvar{alloctype} eq 'rm') {
[4]	1302	$sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
	1303	$sth->execute();
	1304
	1305	# This feels... extreme.
	1306	croak $sth->errstr() if($sth->errstr());
	1307
	1308	$sth->bind_columns(\$cidr,\$city);
	1309	$sth->execute();
	1310	$sth->fetch \|\| croak $sth->errstr();
	1311	$custid = "N/A";
	1312	$alloctype = $webvar{alloctype};
[74]	1313	$circid = "N/A";
[4]	1314	$desc = "N/A";
	1315	$notes = "N/A";
	1316
	1317	} elsif ($webvar{alloctype} eq 'mm') {
	1318	$cidr = $webvar{block};
	1319	$city = "N/A";
	1320	$custid = "N/A";
	1321	$alloctype = $webvar{alloctype};
[74]	1322	$circid = "N/A";
[4]	1323	$desc = "N/A";
	1324	$notes = "N/A";
[189]	1325	} elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
[4]	1326
	1327	# Unassigning a static IP
[284]	1328	my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
	1329	" from poolips where ip='$webvar{block}'");
[4]	1330	$sth->execute();
	1331	# croak $sth->errstr() if($sth->errstr());
	1332
[284]	1333	$sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
	1334	\$privdata);
[4]	1335	$sth->fetch() \|\| croak $sth->errstr;
	1336
[157]	1337	} else { # done with alloctype=~ /^.i$/
[4]	1338
[284]	1339	my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
	1340	" from allocations where cidr='$webvar{block}'");
[4]	1341	$sth->execute();
	1342	# croak $sth->errstr() if($sth->errstr());
	1343
[284]	1344	$sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
	1345	\$notes, \$privdata);
[74]	1346	$sth->fetch() \|\| carp $sth->errstr;
[4]	1347	} # end cases for different alloctypes
	1348
	1349	# Munge everything into HTML
	1350	$html =~ s\|Please confirm\|Please confirm <b>removal</b> of\|;
	1351	$html =~ s\|\$\$BLOCK\$\$\|$cidr\|g;
[106]	1352	$html =~ s\|\$\$TYPEFULL\$\$\|$disp_alloctypes{$alloctype}\|g;
[4]	1353	$html =~ s\|\$\$ALLOCTYPE\$\$\|$alloctype\|g;
	1354	$html =~ s\|\$\$CITY\$\$\|$city\|g;
	1355	$html =~ s\|\$\$CUSTID\$\$\|$custid\|g;
[74]	1356	$html =~ s\|\$\$CIRCID\$\$\|$circid\|g;
[4]	1357	$html =~ s\|\$\$DESC\$\$\|$desc\|g;
	1358	$html =~ s\|\$\$NOTES\$\$\|$notes\|g;
	1359
	1360	$html =~ s\|\$\$ACTION\$\$\|finaldelete\|g;
	1361
	1362	# Set the warning text.
[157]	1363	if ($alloctype =~ /^.[pd]$/) {
[4]	1364	$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>\|;
	1365	} else {
	1366	$html =~ s\|<!--warn-->\|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>\|;
	1367	}
	1368
[284]	1369	my $i = 1;
	1370	# Check to see if user is allowed to do anything with sensitive data
	1371	if ($IPDBacl{$authuser} =~ /s/) {
	1372	$privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
	1373	qq(<td class=regular>$privdata</td></tr>\n);
	1374	$i++;
	1375	}
	1376	$html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
	1377
	1378	$i = ++$i % 2;
	1379	$html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
	1380
[4]	1381	print $html;
	1382	} # end edit()
	1383
	1384
	1385	# Delete an allocation. Return it to the freeblocks table; munge
	1386	# data as necessary to keep as few records as possible in freeblocks
	1387	# to prevent weirdness when allocating blocks later.
	1388	# Remove IPs from pool listing if necessary
	1389	sub finalDelete {
[233]	1390	if ($IPDBacl{$authuser} !~ /d/) {
	1391	printError("You shouldn't have been able to get here. Access denied.");
	1392	return;
	1393	}
[4]	1394
[370]	1395	# need to retrieve block data before deleting so we can notify on that
	1396	my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
	1397
[106]	1398	my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
[4]	1399
[106]	1400	if ($code eq 'OK') {
[4]	1401	print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
[370]	1402	syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
	1403	" $custid, $city, desc='$description'";
[416]	1404	mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
	1405	"$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
	1406	"CustID: $custid\nCity: $city\nDescription: $description\n");
[106]	1407	} else {
	1408	if ($webvar{alloctype} =~ /^.i$/) {
	1409	syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
[111]	1410	printError("Could not deallocate static IP $webvar{block}: $msg");
[106]	1411	} else {
	1412	syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
[111]	1413	printError("Could not deallocate netblock $webvar{block}: $msg");
[4]	1414	}
[106]	1415	}
[4]	1416
	1417	} # finalDelete
	1418
	1419
[233]	1420	sub exitError {
	1421	my $errStr = $_[0];
	1422	printHeader('','');
	1423	print qq(<center><p class="regular"> $errStr </p>
	1424	<input type="button" value="Back" onclick="history.go(-1)">
	1425	</center>
	1426	);
	1427	printFooter();
	1428	exit;
	1429	} # errorExit
	1430
	1431
[4]	1432	# Just in case we manage to get here.
	1433	exit 0;

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

Download in other formats: