source: trunk/cgi-bin/main.cgi @ 4

Last change on this file since 4 was 4, checked in by Kris Deugau, 19 years ago

Import "new" IPDB development:

March 2004 through end of August 2004

Changes include:

-> Entirely new method of allocating IP space; which should

hopefully reduce the amount of messiness in allocations.

-> IP address processing provided by NetAddr::IP rather than

homebrew code

-> Change DB to PostgreSQL to eliminate some of the problems

caused by using MySQL, and to gain native RDBMS support for
IP addresses.

-> Using NetAddr::IP and Postgres allows (eventually, with

PG >= 7.4) IPV6 without any code changes. In theory.

-> Logging so that if someone makes a change that turns out

to have been wrong for some reason, Blame Can Be Assigned.

-> General code cleanups (split IPDB.pm from CommonWeb?.pm,

for instance)

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