Context Navigation

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

Last change on this file since 255 was 255, checked in by Kris Deugau, 20 years ago

/trunk

Merge "Last Modified" display from /branches/stable r245
main.cgi did not merge cleanly due to SWIP hack in /branches/stable r244

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

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

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

Download in other formats: