Context Navigation

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

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

/branches/htmlform

Convert newmaster to template. See #3.

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

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

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

Download in other formats: