Context Navigation

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

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

/branches/htmlform

Convert addmaster to template. See #3.

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

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

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

Download in other formats: