source: branches/acl/cgi-bin/main.cgi@ 223

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

/branches/acl

All access to add new records should be ACL-ified. Users without
the "a" ACL option cannot add a new master block, or click the
"Add new assignment" link; the links aren't there to click.
They cannot assign existing free blocks; the link has been
removed. Checks are also done later in the processing to make
sure that a crafted URL can't get around the restrictions.

printHeader() in CommonWeb.pm has been updated to allow replacement
of arbitrary elements in the header.inc file. It is now called
*once* at the beginning of main.cgi to allow the "Add new assignment"
link to be disabled.

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