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

Last change on this file since 53 was 53, checked in by Kris Deugau, 18 years ago

/branches/stable

Bugfix for search display - 2nd and further pages now return
the correct page instead of an error.

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