Context Navigation

source: branches/stable/cgi-bin/main.cgi@ 266

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

/branches/stable

Tweak "new assignment" defaults to avoid private networks if
a "master" is not chosen. Automatic assignment can still pick
a private block if the appropriate option is checked.

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

File size: 48.5 KB

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

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

Download in other formats: