Context Navigation

source: branches/htmlform/cgi-bin/main.cgi@ 471

Last change on this file since 471 was 471, checked in by Kris Deugau, 14 years ago

/branches/htmlform

Convert listpool to template. See #3.

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

File size: 42.4 KB

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

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

Download in other formats: