source: trunk/cgi-bin/consistency-check.pl@ 938

#!/usr/bin/perl
# ipdb/cgi-bin/consistency-check.pl
# Does full check to see if the data in the db is consistent and complete.
# Note this can't account for slightly squirrelly or pretzelly legacy data;
# that has to be hand-verified when this script chokes on it and spits up
# errors.
###
# SVN revision info
# $Date: 2017-08-15 17:53:23 +0000 (Tue, 15 Aug 2017) $
# SVN revision $Rev: 906 $
# Last update by $Author: kdeugau $
###
# Copyright (C) 2004-2010,2014,2017 - Kris Deugau

use strict;
use warnings;

use DBI;
use NetAddr::IP;
use Data::Dumper;

# don't remove!  required for GNU/FHS-ish install from tarball
##uselib##

# push "the directory the script is in" into @INC
use FindBin;
use lib "$FindBin::RealBin/";

use MyIPDB;

# Convenience for calling from admin tools
print "Content-type: text/plain\n\n";

my ($dbh,$errstr) = connectDB_My;
die $errstr if !$dbh;
# May as well.  We need a number of globals.
initIPDBGlobals($dbh);

my %idlist;
my $sth = $dbh->prepare("SELECT id FROM allocations WHERE type='mm' ORDER BY cidr");
$sth->execute;
while (my ($mid) = $sth->fetchrow_array) {
  checkcontainer($mid, \%idlist, 0);
}

print "\nChecking that all allocations are referenced:\n";
$sth = $dbh->prepare("SELECT id FROM allocations");
$sth->execute;
my $i = 0;
while (my ($id) = $sth->fetchrow_array) {
  delete $idlist{$id};
  $i++;
}
print "  $i allocations confirmed referenced\n";
$i = 0;
$sth = $dbh->prepare("SELECT id FROM freeblocks");
$sth->execute;
while (my ($id) = $sth->fetchrow_array) {
  delete $idlist{'fb'.$id};
  $i++;
}
print "  $i freeblocks confirmed referenced\n";
foreach (keys %idlist) {
  if (/^fb/) {
    print "  Unreferenced free block ID $_, $idlist{$_}\n";
  } else {
    print "  Unreferenced block ID $_, $idlist{$_}\n";
  }
}

print "\nChecking for correctness on 'defined' CustIDs:\n";
$sth = $dbh->prepare("SELECT cidr,type,custid FROM allocations WHERE NOT (type='cn' OR type LIKE '_r') ORDER BY cidr");
$sth->execute;
while (my($cidr,$type,$custid) = $sth->fetchrow_array) {
  print "$cidr ($disp_alloctypes{$type}) has incorrect CustID $custid\n"
        if $custid ne $def_custids{$type};
}
print "Done predefined CustID correctness check.\n\n";

print "Checking for customer blocks with 'bad' CustIDs:\n";
# Make sure cn-type ("customer netblock") blocks have "real" CustIDs.
$sth = $dbh->prepare("SELECT cidr,custid,description FROM allocations WHERE type='cn' AND (custid='$IPDB::defcustid' OR custid='STAFF') ORDER BY cidr");
$sth->execute;
while (my ($cidr,$custid,$desc) = $sth->fetchrow_array) {
  print "cn block $cidr ($desc) has incorrect CustID $custid\n";
}
print "Done checking customer blocks\n";

exit;


# All we need to check on is "do the allocations and free blocks within a container completely make up the container?"
sub checkcontainer {
  my $cid = shift;
  my $idlist = shift;
  my $depth = shift;

  # snarf the container's CIDR
  my $sth = $dbh->prepare("SELECT cidr,type FROM allocations WHERE id = ?");
  $sth->execute($cid);
  my ($ccidr,$ctype) = $sth->fetchrow_array();
  # note that we've "seen" the ID/CIDR
  $idlist->{$cid} = $ccidr;
  $ccidr = NetAddr::IP->new($ccidr);

  $depth++;
  print "error: gone too deep ($depth).  breaking off\n" if $depth > 6;
  my $indent = '  ' x $depth;
  print $indent."Checking $disp_alloctypes{$ctype} $ccidr ($cid)\n";

  $sth = $dbh->prepare(qq(
        SELECT id, cidr, type, network(cidr) AS net, broadcast(cidr) AS bcast FROM allocations WHERE parent_id = ?
        UNION
        SELECT id, cidr, 'f' AS type, network(cidr) AS net, broadcast(cidr) AS bcast FROM freeblocks WHERE parent_id = ?
        ORDER BY cidr
        ));
  $sth->execute($cid, $cid) or die $dbh->errstr;
  my $prev = $ccidr;
  while (my ($childid, $childcidr, $childtype, $childnet, $childbcast) = $sth->fetchrow_array) {
    # note that we've "seen" the ID/CIDR, flagging freeblocks
    $idlist->{$childid} = $childcidr if $childtype ne 'f';
    $idlist->{'fb'.$childid} = $childcidr if $childtype eq 'f';
    checkcontainer($childid, $idlist, $depth) if $childtype =~ /.[cm]/;
    my $prevn = $prev->broadcast->numeric + 1;
    my $cur = new NetAddr::IP $childnet;
    if ($cur->numeric == $prevn) {
      $prev = $cur;
      next;
    }
    if ($ccidr->numeric == $prev->numeric) {
      # check if cur starts with master
      if ($cur->numeric > $prev->numeric) {
        print $indent."  Gap from start of parent $ccidr to first block $cur\n";
      } elsif ($cur->numeric < $prev->numeric) {
        print $indent."  BIG problem!  Current block $cur begins before parent $ccidr!\n";
      }
    } else {
      if ($cur->numeric < ($prev->numeric + 1)) {
        print $indent."  Block ".$prev->network." overlaps block $cur\n";
      } elsif ($cur->numeric > ($prev->numeric + 1)) {
        print $indent."  Gap between end of block ".$prev->network." and block $cur\n";
      }
    }

    $prev = $cur;
    $prev--;
  }
}