Context Navigation

main.cgi@ 862

Last change on this file since 862 was 277, checked in by Kris Deugau, 19 years ago

/branches/dns

Quick hack to properly pass in rDNS data in one use-case
Make sure to pass rDNS (whatever it may turn out as) to allocateBlock()

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

File size: 40.1 KB

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

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

Context Navigation

source: branches/dns/cgi-bin/main.cgi@ 862

Download in other formats: