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

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

/branches/stable

Add support for checking CustIDs against an external agent

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