Context Navigation

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

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

/branches/stable

Commit live hacks for mail, updates to same

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

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

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

Download in other formats: