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

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

/branches/acl

All access to change or "delete" (static IPs aren't actually
deleted unless the whole pool is) should be ACL-ified. Users
without the "c" ACL cannot make changes to existing allocations.
Users without the "d" ACL cannot delete netblocks, routing
allocations, or master netblocks; they also may not deallocate
static IPs. Checks are also done later in the processing to
make sure that a crafted URL can't get around the restrictions.

editDisplay.html required updates to remove form elements from
the static HTML; users that cannot modify content will still
receive a page with some hidden form elements but no submit
button(s) to change or delete content (as determined by their
ACL).
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 47.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: 2005-04-14 19:45:44 +0000 (Thu, 14 Apr 2005) $
7# SVN revision $Rev: 225 $
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 ($IPDBacl{$authuser} =~ /d/ ?
553 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
554 qq(<input type=hidden name=action value="delete">\n).
555 qq(<input type=hidden name=block value="$master">\n).
556 qq(<input type=hidden name=alloctype value="mm">\n).
557 qq(<input type=submit value=" Remove this master ">\n).
558 qq(</form></center>\n) :
559 '');
560
561 } # end check for existence of routed blocks in master
562
563 print qq(</table>\n<hr width="60%">\n).
564 qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
565
566 startTable('Netblock','Range');
567
568 # Snag the free blocks.
569 my $count = 0;
570 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
571 "routed='n' order by cidr");
572 $sth->execute();
573 while (my @data = $sth->fetchrow_array()) {
574 my $cidr = new NetAddr::IP $data[0];
575 my @row = ("$cidr", $cidr->range);
576 printRow(\@row, 'color1' ) if($count%2==0);
577 printRow(\@row, 'color2' ) if($count%2!=0);
578 $count++;
579 }
580
581 print "</table>\n";
582} # showMaster
583
584
585# Display details of a routed block
586# Alrighty then! We're showing allocations within a routed block this time.
587# We should be able to steal code from showSummary() and showMaster(), and if
588# I'm really smart I'll figger a way to munge all three together. (Once I've
589# done that, everything else should follow. YMMV.
590# This time, we check the database before spewing, because we may
591# not have anything useful to spew.
592sub showRBlock {
593
594 my $master = new NetAddr::IP $webvar{block};
595
596 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
597 $sth->execute;
598 my @data = $sth->fetchrow_array;
599
600 print qq(<center><div class="heading">Summarizing allocated blocks for ).
601 qq($master ($data[0]):</div></center><br>\n);
602
603 startTable('CIDR allocation','Customer Location','Type','CustID','Description/Name');
604
605 # Snag the allocations for this block
606 $sth = $ip_dbh->prepare("select cidr,city,type,custid,description".
607 " from allocations where cidr <<= '$master' order by cidr");
608 $sth->execute();
609
610 my $count=0;
611 while (my @data = $sth->fetchrow_array()) {
612 # cidr,city,type,custid,description, as per the SELECT
613 my $cidr = new NetAddr::IP $data[0];
614
615 # Clean up extra spaces that are borking things.
616# $data[2] =~ s/\s+//g;
617
618 # Prefix subblocks with "Sub "
619 my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
620 qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
621 $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
622 # If the allocation is a pool, allow listing of the IPs in the pool.
623 if ($data[2] =~ /^.[pd]$/) {
624 $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
625 "&pool=$data[0]\">List IPs</a>";
626 }
627
628 printRow(\@row, 'color1') if ($count%2 == 0);
629 printRow(\@row, 'color2') if ($count%2 != 0);
630 $count++;
631 }
632
633 print "</table>\n";
634
635 # If the routed block has no allocations, by definition it only has
636 # one free block, and therefore may be deleted.
637 if ($count == 0) {
638 print qq(<hr width="60%"><center><div class="heading">No allocations in ).
639 qq($master.</div></center>\n).
640 ($IPDBacl{$authuser} =~ /d/ ?
641 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
642 qq(<input type=hidden name=action value="delete">\n).
643 qq(<input type=hidden name=block value="$master">\n).
644 qq(<input type=hidden name=alloctype value="rm">\n).
645 qq(<input type=submit value=" Remove this block ">\n).
646 qq(</form>\n) :
647 '');
648 }
649
650 print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
651 qq(submaster $master</div></center>\n);
652
653 startTable('CIDR block','Range');
654
655 # Snag the free blocks. We don't really *need* to be pedantic about avoiding
656 # unrouted free blocks, but it's better to let the database do the work if we can.
657 $count = 0;
658 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
659 " order by cidr");
660 $sth->execute();
661 while (my @data = $sth->fetchrow_array()) {
662 # cidr,routed
663 my $cidr = new NetAddr::IP $data[0];
664 # Include some HairyPerl(TM) to prefix subblocks with "Sub "
665 my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
666 ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
667 $cidr->range);
668 printRow(\@row, 'color1') if ($count%2 == 0);
669 printRow(\@row, 'color2') if ($count%2 != 0);
670 $count++;
671 }
672
673 print "</table>\n";
674} # showRBlock
675
676
677# List the IPs used in a pool
678sub listPool {
679
680 my $cidr = new NetAddr::IP $webvar{pool};
681
682 my ($pooltype,$poolcity);
683
684 # Snag pool info for heading
685 $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
686 $sth->execute;
687 $sth->bind_columns(\$pooltype, \$poolcity);
688 $sth->fetch() || carp $sth->errstr;
689
690 print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
691 qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
692 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
693 if ($pooltype =~ /^.d$/) {
694 print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
695 print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
696 $cidr->addr."</td></tr>\n";
697 $cidr++;
698 print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
699 $cidr--; $cidr--;
700 print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
701 "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
702 "</table></div></div>\n";
703 }
704
705# probably have to add an "edit IP allocation" link here somewhere.
706
707 startTable('IP','Customer ID','Available?','Description','');
708 $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
709 " from poolips where pool='$webvar{pool}' order by ip");
710 $sth->execute;
711 my $count = 0;
712 while (my @data = $sth->fetchrow_array) {
713 # pool,ip,custid,city,ptype,available,notes,description,circuitid
714 # ip,custid,available,description,type
715 # If desc is "null", make it not null. <g>
716 if ($data[3] eq '') {
717 $data[3] = '&nbsp;';
718 }
719 # Some nice hairy Perl to decide whether to allow unassigning each IP
720 # -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
721 # else we print a blank space
722 my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
723 $data[1],$data[2],$data[3],
724 ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
725 ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
726 "alloctype=$data[4]\">Unassign this IP</a>") :
727 ("&nbsp;") )
728 );
729 printRow(\@row, 'color1') if($count%2==0);
730 printRow(\@row, 'color2') if($count%2!=0);
731 $count++;
732 }
733 print "</table>\n";
734
735} # end listPool
736
737
738# Show "Add new allocation" page. Note that the actual page may
739# be one of two templates, and the lists come from the database.
740sub assignBlock {
741
742 if ($IPDBacl{$authuser} !~ /a/) {
743 printError("You shouldn't have been able to get here. Access denied.");
744 return;
745 }
746
747 my $html;
748
749 # New special case- block to assign is specified
750 if ($webvar{block} ne '') {
751 open HTML, "../fb-assign.html"
752 or croak "Could not open fb-assign.html: $!";
753 $html = join('',<HTML>);
754 close HTML;
755 my $block = new NetAddr::IP $webvar{block};
756 $html =~ s|\$\$BLOCK\$\$|$block|g;
757 $html =~ s|\$\$MASKBITS\$\$|$block->masklen|;
758 my $typelist = '';
759
760 # This is a little dangerous, as it's *theoretically* possible to
761 # get fbtype='n' (aka a non-routed freeblock). However, should
762 # someone manage to get there, they get what they deserve.
763 if ($webvar{fbtype} ne 'y') {
764 # Snag the type of the block from the database. We have no
765 # convenient way to pass this in from the calling location. :/
766 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
767 $sth->execute;
768 my @data = $sth->fetchrow_array;
769 $data[0] =~ s/c$/r/; # Munge the type into the correct form
770 $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
771 } else {
772 $typelist .= qq(<select name="alloctype">\n);
773 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
774 "and type not like '_i' and type not like '_r' order by listorder");
775 $sth->execute;
776 my @data = $sth->fetchrow_array;
777 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
778 while (my @data = $sth->fetchrow_array) {
779 $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
780 }
781 $typelist .= "</select>\n";
782 }
783 $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
784 } else {
785 open HTML, "../assign.html"
786 or croak "Could not open assign.html: $!";
787 $html = join('',<HTML>);
788 close HTML;
789 my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
790 foreach my $master (@masterblocks) {
791 $masterlist .= "<option>$master</option>\n";
792 }
793 $masterlist .= "</select>\n";
794 $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g;
795 my $pops = '';
796 foreach my $pop (@poplist) {
797 $pops .= "<option>$pop</option>\n";
798 }
799 $html =~ s|\$\$POPLIST\$\$|$pops|g;
800 my $typelist = '';
801 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
802 $sth->execute;
803 my @data = $sth->fetchrow_array;
804 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
805 while (my @data = $sth->fetchrow_array) {
806 $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
807 }
808 $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
809 }
810 my $cities = '';
811 foreach my $city (@citylist) {
812 $cities .= "<option>$city</option>\n";
813 }
814 $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
815
816 print $html;
817
818} # assignBlock
819
820
821# Take info on requested IP assignment and see what we can provide.
822sub confirmAssign {
823 if ($IPDBacl{$authuser} !~ /a/) {
824 printError("You shouldn't have been able to get here. Access denied.");
825 return;
826 }
827
828 my $cidr;
829 my $alloc_from;
830
831 # Going to manually validate some items.
832 # custid and city are automagic.
833 return if !validateInput();
834
835# Several different cases here.
836# Static IP vs netblock
837# + Different flavours of static IP
838# + Different flavours of netblock
839
840 if ($webvar{alloctype} =~ /^.i$/) {
841 my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
842 my ($sql,$city);
843 # Check for pools in Subury, North Bay, or Toronto if DSL or server pool.
844 # Anywhere else is invalid and shouldn't be in the db in the first place.
845 # ... aside from #^%#$%#@#^%^^!!!! legacy data. GRRR.
846 # Note that we want to retain the requested city to relate to customer info.
847 if ($base =~ /^[ds]$/) {
848 $city = "(allocations.city='Sudbury' or allocations.city='North Bay' or ".
849 "allocations.city='Toronto')";
850 } else {
851 $city = "allocations.city='$webvar{pop}'";
852 }
853
854# Ewww. But it works.
855 $sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
856 "poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
857 "poolips.pool=allocations.cidr AND $city AND poolips.type LIKE '".$base."_' ".
858 "GROUP BY pool");
859 $sth->execute;
860 my $optionlist;
861 while (my @data = $sth->fetchrow_array) {
862 # city,pool cidr,free IP count
863 if ($data[2] > 0) {
864 $optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
865 }
866 }
867 $cidr = "Single static IP";
868 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
869
870 } else { # end show pool options
871
872 if ($webvar{fbassign} eq 'y') {
873 $cidr = new NetAddr::IP $webvar{block};
874 $webvar{maskbits} = $cidr->masklen;
875 } else { # done with direct freeblocks assignment
876
877 if (!$webvar{maskbits}) {
878 printError("Please specify a CIDR mask length.");
879 return;
880 }
881 my $sql;
882 my $city;
883 my $failmsg;
884 if ($webvar{alloctype} eq 'rm') {
885 if ($webvar{allocfrom} ne '-') {
886 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
887 " and cidr <<= '$webvar{allocfrom}' order by maskbits desc";
888 } else {
889 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
890 " order by maskbits desc";
891 }
892 $failmsg = "No suitable free block found.<br>\nWe do not have a free".
893 " routeable block of that size.<br>\nYou will have to either route".
894 " a set of smaller netblocks or a single smaller netblock.";
895 } else {
896##fixme
897# This section needs serious Pondering.
898 # Pools of most types get assigned to the POP they're "routed from"
899 # This includes WAN blocks and other netblock "containers"
900 # This does NOT include cable pools.
901 if ($webvar{alloctype} =~ /^.[pc]$/) {
902 if (($webvar{city} !~ /^(Sudbury|North Bay|Toronto)$/) && ($webvar{alloctype} eq 'dp')) {
903 printError("You must chose Sudbury, North Bay, or Toronto for DSL pools.");
904 return;
905 }
906 $city = $webvar{city};
907 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
908 " superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
909 " block size for the pool.";
910 } else {
911 $city = $webvar{pop};
912 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
913 " superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
914 " chose a smaller blocksize.";
915 }
916 if ($webvar{allocfrom} ne '-') {
917 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
918 " and cidr <<= '$webvar{allocfrom}' and routed='".
919 (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."' order by maskbits desc,cidr";
920 } else {
921 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
922 " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y').
923 "' order by maskbits desc,cidr";
924 }
925 }
926 $sth = $ip_dbh->prepare($sql);
927 $sth->execute;
928 my @data = $sth->fetchrow_array();
929 if ($data[0] eq "") {
930 printError($failmsg);
931 return;
932 }
933 $cidr = new NetAddr::IP $data[0];
934 } # check for freeblocks assignment or IPDB-controlled assignment
935
936 $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
937
938 # If the block to be allocated is smaller than the one we found,
939 # figure out the "real" block to be allocated.
940 if ($cidr->masklen() ne $webvar{maskbits}) {
941 my $maskbits = $cidr->masklen();
942 my @subblocks;
943 while ($maskbits++ < $webvar{maskbits}) {
944 @subblocks = $cidr->split($maskbits);
945 }
946 $cidr = $subblocks[0];
947 }
948 } # if ($webvar{alloctype} =~ /^.i$/)
949
950 open HTML, "../confirm.html"
951 or croak "Could not open confirm.html: $!";
952 my $html = join '', <HTML>;
953 close HTML;
954
955### gotta fix this in final
956 # Stick in customer info as necessary - if it's blank, it just ends
957 # up as blank lines ignored in the rendering of the page
958 my $custbits;
959 $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
960###
961
962 # Stick in the allocation data
963 $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
964 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
965 $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
966 $html =~ s|\$\$CIDR\$\$|$cidr|g;
967 $webvar{city} = desanitize($webvar{city});
968 $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
969 $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
970 $webvar{circid} = desanitize($webvar{circid});
971 $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
972 $webvar{desc} = desanitize($webvar{desc});
973 $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
974 $webvar{notes} = desanitize($webvar{notes});
975 $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
976 $html =~ s|\$\$ACTION\$\$|insert|g;
977
978 print $html;
979
980} # end confirmAssign
981
982
983# Do the work of actually inserting a block in the database.
984sub insertAssign {
985 if ($IPDBacl{$authuser} !~ /a/) {
986 printError("You shouldn't have been able to get here. Access denied.");
987 return;
988 }
989 # Some things are done more than once.
990 return if !validateInput();
991
992 # $code is "success" vs "failure", $msg contains OK for a
993 # successful netblock allocation, the IP allocated for static
994 # IP, or the error message if an error occurred.
995 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
996 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
997 $webvar{circid});
998
999 if ($code eq 'OK') {
1000 if ($webvar{alloctype} =~ /^.i$/) {
1001 print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
1002 # Notify tech@example.com
1003 mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
1004 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
1005 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
1006 } else {
1007 print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
1008 "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div></div>";
1009 }
1010 syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
1011 "'$webvar{alloctype}'";
1012 } else {
1013 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
1014 "'$webvar{alloctype}' by $authuser failed: '$msg'";
1015 printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
1016 " failed:<br>\n$msg\n");
1017 }
1018
1019} # end insertAssign()
1020
1021
1022# Does some basic checks on common input data to make sure nothing
1023# *really* weird gets in to the database through this script.
1024# Does NOT do complete input validation!!!
1025sub validateInput {
1026 if ($webvar{city} eq '-') {
1027 printError("Please choose a city.");
1028 return;
1029 }
1030
1031 # Alloctype check.
1032 chomp $webvar{alloctype};
1033 if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
1034 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
1035 # managing to call things in such a way as to cause this deserves a cryptic error.
1036 printError("Invalid alloctype");
1037 return;
1038 }
1039
1040 # CustID check
1041 # We have different handling for customer allocations and "internal" or "our" allocations
1042 if ($def_custids{$webvar{alloctype}} eq '') {
1043 if (!$webvar{custid}) {
1044 printError("Please enter a customer ID.");
1045 return;
1046 }
1047 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF|TEMP)(?:-\d\d?)?$/) {
1048 printError("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
1049 return;
1050 }
1051 print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
1052 } else {
1053 # New! Improved! And now Loaded From The Database!!
1054 $webvar{custid} = $def_custids{$webvar{alloctype}};
1055 }
1056
1057 # Check POP location
1058 my $flag;
1059 if ($webvar{alloctype} eq 'rm') {
1060 $flag = 'for a routed netblock';
1061 foreach (@poplist) {
1062 if (/^$webvar{city}$/) {
1063 $flag = 'n';
1064 last;
1065 }
1066 }
1067 } else {
1068 $flag = 'n';
1069 if ($webvar{pop} =~ /^-$/) {
1070 $flag = 'to route the block from/through';
1071 }
1072 }
1073 if ($flag ne 'n') {
1074 printError("Please choose a valid POP location $flag. Valid ".
1075 "POP locations are currently:<br>\n".join (" - ", @poplist));
1076 return;
1077 }
1078
1079 return 'OK';
1080} # end validateInput
1081
1082
1083# Displays details of a specific allocation in a form
1084# Allows update/delete
1085# action=edit
1086sub edit {
1087
1088 my $sql;
1089
1090 # Two cases: block is a netblock, or block is a static IP from a pool
1091 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
1092 if ($webvar{block} =~ /\/32$/) {
1093 $sql = "select ip,custid,type,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
1094 } else {
1095 $sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
1096 }
1097
1098 # gotta snag block info from db
1099 $sth = $ip_dbh->prepare($sql);
1100 $sth->execute;
1101 my @data = $sth->fetchrow_array;
1102
1103 # Clean up extra whitespace on alloc type
1104 $data[2] =~ s/\s//;
1105
1106 open (HTML, "../editDisplay.html")
1107 or croak "Could not open editDisplay.html :$!";
1108 my $html = join('', <HTML>);
1109
1110 # We can't let the city be changed here; this block is a part of
1111 # a larger routed allocation and therefore by definition can't be moved.
1112 # block and city are static.
1113##fixme
1114# Needs thinking. Have to allow changes to city to correct errors, no?
1115 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1116
1117 if ($IPDBacl{$authuser} =~ /c/) {
1118 $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
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 $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
1143 $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
1144 $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
1145 $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
1146 } else {
1147 $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
1148 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
1149 $html =~ s/\$\$CITY\$\$/$data[3]/g;
1150 $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
1151 $html =~ s/\$\$DESC\$\$/$data[5]/g;
1152 $html =~ s/\$\$NOTES\$\$/$data[6]/g;
1153 }
1154
1155 # More ACL trickery - we can live with forms that don't submit,
1156 # but we can't leave the extra table rows there, and we *really*
1157 # can't leave the submit buttons there.
1158 my $updok = '';
1159 my $i=2;
1160 if ($IPDBacl{$authuser} =~ /c/) {
1161 $updok = qq(<tr class="color$i"><td colspan=2 class=regular><div class="center">).
1162 qq(<input type="submit" value=" Update this block " class="regular">).
1163 "</div></td></tr></form>\n";
1164 $i--;
1165 }
1166 $html =~ s/\$\$UPDOK\$\$/$updok/g;
1167
1168 my $delok = '';
1169 if ($IPDBacl{$authuser} =~ /d/) {
1170 $delok = qq(<form method="POST" action="main.cgi">
1171 <tr class="color$i"><td colspan=2 class="regular"><div class=center>
1172 <input type="hidden" name="action" value="delete">
1173 <input type="hidden" name="block" value="$webvar{block}">
1174 <input type="hidden" name="alloctype" value="$data[2]">
1175 <input type=submit value=" Delete this block ">
1176 </div></td></tr>);
1177 }
1178 $html =~ s/\$\$DELOK\$\$/$delok/;
1179
1180 print $html;
1181
1182} # edit()
1183
1184
1185# Stuff new info about a block into the db
1186# action=update
1187sub update {
1188
1189 # Make sure incoming data is in correct format - custID among other things.
1190 validateInput;
1191
1192 # SQL transaction wrapper
1193 eval {
1194 # Relatively simple SQL transaction here.
1195 my $sql;
1196 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1197 # Note the hack ( available='n' ) to work around "update" additions
1198 # to static IP space. Eww.
1199 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
1200 "circuitid='$webvar{circid}',description='$webvar{desc}',available='n' ".
1201 "where ip='$webvar{block}'";
1202 } else {
1203 $sql = "update allocations set custid='$webvar{custid}',".
1204 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
1205 "type='$webvar{alloctype}',circuitid='$webvar{circid}' where cidr='$webvar{block}'";
1206 }
1207 # Log the details of the change.
1208 syslog "debug", $sql;
1209 $sth = $ip_dbh->prepare($sql);
1210 $sth->execute;
1211 $ip_dbh->commit;
1212 };
1213 if ($@) {
1214 my $msg = $@;
1215 carp "Transaction aborted because $msg";
1216 eval { $ip_dbh->rollback; };
1217 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
1218 printError("Could not update block/IP $webvar{block}: $msg");
1219 return;
1220 }
1221
1222 # If we get here, the operation succeeded.
1223 syslog "notice", "$authuser updated $webvar{block}";
1224 open (HTML, "../updated.html")
1225 or croak "Could not open updated.html :$!";
1226 my $html = join('', <HTML>);
1227
1228 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1229 $webvar{city} = desanitize($webvar{city});
1230 $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
1231 $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
1232 $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
1233 $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
1234 $webvar{circid} = desanitize($webvar{circid});
1235 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
1236 $webvar{desc} = desanitize($webvar{desc});
1237 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
1238 $webvar{notes} = desanitize($webvar{notes});
1239 $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
1240
1241 print $html;
1242
1243} # update()
1244
1245
1246# Delete an allocation.
1247sub remove {
1248 if ($IPDBacl{$authuser} !~ /d/) {
1249 printError("You shouldn't have been able to get here. Access denied.");
1250 return;
1251 }
1252
1253 #show confirm screen.
1254 open HTML, "../confirmRemove.html"
1255 or croak "Could not open confirmRemove.html :$!";
1256 my $html = join('', <HTML>);
1257 close HTML;
1258
1259 # Serves'em right for getting here...
1260 if (!defined($webvar{block})) {
1261 printError("Error 332");
1262 return;
1263 }
1264
1265 my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype);
1266
1267 if ($webvar{alloctype} eq 'rm') {
1268 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1269 $sth->execute();
1270
1271# This feels... extreme.
1272 croak $sth->errstr() if($sth->errstr());
1273
1274 $sth->bind_columns(\$cidr,\$city);
1275 $sth->execute();
1276 $sth->fetch || croak $sth->errstr();
1277 $custid = "N/A";
1278 $alloctype = $webvar{alloctype};
1279 $circid = "N/A";
1280 $desc = "N/A";
1281 $notes = "N/A";
1282
1283 } elsif ($webvar{alloctype} eq 'mm') {
1284 $cidr = $webvar{block};
1285 $city = "N/A";
1286 $custid = "N/A";
1287 $alloctype = $webvar{alloctype};
1288 $circid = "N/A";
1289 $desc = "N/A";
1290 $notes = "N/A";
1291 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
1292
1293 # Unassigning a static IP
1294 my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid from poolips".
1295 " where ip='$webvar{block}'");
1296 $sth->execute();
1297# croak $sth->errstr() if($sth->errstr());
1298
1299 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid);
1300 $sth->fetch() || croak $sth->errstr;
1301
1302 } else { # done with alloctype=~ /^.i$/
1303
1304 my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes from ".
1305 "allocations where cidr='$webvar{block}'");
1306 $sth->execute();
1307# croak $sth->errstr() if($sth->errstr());
1308
1309 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc, \$notes);
1310 $sth->fetch() || carp $sth->errstr;
1311 } # end cases for different alloctypes
1312
1313 # Munge everything into HTML
1314 $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
1315 $html =~ s|\$\$BLOCK\$\$|$cidr|g;
1316 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
1317 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
1318 $html =~ s|\$\$CITY\$\$|$city|g;
1319 $html =~ s|\$\$CUSTID\$\$|$custid|g;
1320 $html =~ s|\$\$CIRCID\$\$|$circid|g;
1321 $html =~ s|\$\$DESC\$\$|$desc|g;
1322 $html =~ s|\$\$NOTES\$\$|$notes|g;
1323
1324 $html =~ s|\$\$ACTION\$\$|finaldelete|g;
1325
1326 # Set the warning text.
1327 if ($alloctype =~ /^.[pd]$/) {
1328 $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>|;
1329 } else {
1330 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
1331 }
1332
1333 print $html;
1334} # end edit()
1335
1336
1337# Delete an allocation. Return it to the freeblocks table; munge
1338# data as necessary to keep as few records as possible in freeblocks
1339# to prevent weirdness when allocating blocks later.
1340# Remove IPs from pool listing if necessary
1341sub finalDelete {
1342 if ($IPDBacl{$authuser} !~ /d/) {
1343 printError("You shouldn't have been able to get here. Access denied.");
1344 return;
1345 }
1346
1347 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
1348
1349 if ($code eq 'OK') {
1350 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";
1351 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
1352 # Notify tech@ when a block/IP is deallocated
1353 mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1354 "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n");
1355 } else {
1356 if ($webvar{alloctype} =~ /^.i$/) {
1357 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
1358 printError("Could not deallocate static IP $webvar{block}: $msg");
1359 } else {
1360 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
1361 printError("Could not deallocate netblock $webvar{block}: $msg");
1362 }
1363 }
1364
1365} # finalDelete
1366
1367
1368sub exitError {
1369 my $errStr = $_[0];
1370 printHeader('','');
1371 print qq(<center><p class="regular"> $errStr </p>
1372<input type="button" value="Back" onclick="history.go(-1)">
1373</center>
1374);
1375 printFooter();
1376 exit;
1377} # errorExit
1378
1379
1380# Just in case we manage to get here.
1381exit 0;
Note: See TracBrowser for help on using the repository browser.