Context Navigation

source: branches/rpc/cgi-bin/main.cgi@ 409

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

/trunk

Add backlink to billing system on successful static DSL IP allocation

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

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

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

Download in other formats: