Context Navigation

source: trunk/cgi-bin/main.cgi@ 114

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

/trunk

Cleanup of display and fallthrough logic:

printFooter is now called once, and once ONLY, at the end of execution of main.cgi.
All execution in main.cgi should terminate at a single point; this allows MUCH easier cleanup of global data, filehandles, database handle(s), etc and printing the footer.

validateInput() cleanup:

Fixed logic to check POP locations as necessary

General code cleanup

Removed useless legacy commented code fragments

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

File size: 43.2 KB

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

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

Download in other formats: