Context Navigation

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

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

/branches/stable

Mildly embarrasing display microfix for the edge case where a
master has no free blocks - it *should* show "<NONE>".

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

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

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

Download in other formats: