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

Last change on this file since 937 was 906, checked in by Kris Deugau, 7 years ago

/trunk

Bulk addition of "add 'the directory the script is in' to @INC" for Perls
that have dropped '.' from @INC

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 4.7 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/consistency-check.pl
3# Does full check to see if the data in the db is consistent and complete.
4# Note this can't account for slightly squirrelly or pretzelly legacy data;
5# that has to be hand-verified when this script chokes on it and spits up
6# errors.
7###
8# SVN revision info
9# $Date: 2017-08-15 17:53:23 +0000 (Tue, 15 Aug 2017) $
10# SVN revision $Rev: 906 $
11# Last update by $Author: kdeugau $
12###
13# Copyright (C) 2004-2010,2014,2017 - Kris Deugau
14
15use strict;
16use warnings;
17
18use DBI;
19use NetAddr::IP;
20use Data::Dumper;
21
22# don't remove! required for GNU/FHS-ish install from tarball
23##uselib##
24
25# push "the directory the script is in" into @INC
26use FindBin;
27use lib "$FindBin::RealBin/";
28
29use MyIPDB;
30
31# Convenience for calling from admin tools
32print "Content-type: text/plain\n\n";
33
34my ($dbh,$errstr) = connectDB_My;
35die $errstr if !$dbh;
36# May as well. We need a number of globals.
37initIPDBGlobals($dbh);
38
39my %idlist;
40my $sth = $dbh->prepare("SELECT id FROM allocations WHERE type='mm' ORDER BY cidr");
41$sth->execute;
42while (my ($mid) = $sth->fetchrow_array) {
43 checkcontainer($mid, \%idlist, 0);
44}
45
46print "\nChecking that all allocations are referenced:\n";
47$sth = $dbh->prepare("SELECT id FROM allocations");
48$sth->execute;
49my $i = 0;
50while (my ($id) = $sth->fetchrow_array) {
51 delete $idlist{$id};
52 $i++;
53}
54print " $i allocations confirmed referenced\n";
55$i = 0;
56$sth = $dbh->prepare("SELECT id FROM freeblocks");
57$sth->execute;
58while (my ($id) = $sth->fetchrow_array) {
59 delete $idlist{'fb'.$id};
60 $i++;
61}
62print " $i freeblocks confirmed referenced\n";
63foreach (keys %idlist) {
64 if (/^fb/) {
65 print " Unreferenced free block ID $_, $idlist{$_}\n";
66 } else {
67 print " Unreferenced block ID $_, $idlist{$_}\n";
68 }
69}
70
71print "\nChecking for correctness on 'defined' CustIDs:\n";
72$sth = $dbh->prepare("SELECT cidr,type,custid FROM allocations WHERE NOT (type='cn' OR type LIKE '_r') ORDER BY cidr");
73$sth->execute;
74while (my($cidr,$type,$custid) = $sth->fetchrow_array) {
75 print "$cidr ($disp_alloctypes{$type}) has incorrect CustID $custid\n"
76 if $custid ne $def_custids{$type};
77}
78print "Done predefined CustID correctness check.\n\n";
79
80print "Checking for customer blocks with 'bad' CustIDs:\n";
81# Make sure cn-type ("customer netblock") blocks have "real" CustIDs.
82$sth = $dbh->prepare("SELECT cidr,custid,description FROM allocations WHERE type='cn' AND (custid='$IPDB::defcustid' OR custid='STAFF') ORDER BY cidr");
83$sth->execute;
84while (my ($cidr,$custid,$desc) = $sth->fetchrow_array) {
85 print "cn block $cidr ($desc) has incorrect CustID $custid\n";
86}
87print "Done checking customer blocks\n";
88
89exit;
90
91
92# All we need to check on is "do the allocations and free blocks within a container completely make up the container?"
93sub checkcontainer {
94 my $cid = shift;
95 my $idlist = shift;
96 my $depth = shift;
97
98 # snarf the container's CIDR
99 my $sth = $dbh->prepare("SELECT cidr,type FROM allocations WHERE id = ?");
100 $sth->execute($cid);
101 my ($ccidr,$ctype) = $sth->fetchrow_array();
102 # note that we've "seen" the ID/CIDR
103 $idlist->{$cid} = $ccidr;
104 $ccidr = NetAddr::IP->new($ccidr);
105
106 $depth++;
107 print "error: gone too deep ($depth). breaking off\n" if $depth > 6;
108 my $indent = ' ' x $depth;
109 print $indent."Checking $disp_alloctypes{$ctype} $ccidr ($cid)\n";
110
111 $sth = $dbh->prepare(qq(
112 SELECT id, cidr, type, network(cidr) AS net, broadcast(cidr) AS bcast FROM allocations WHERE parent_id = ?
113 UNION
114 SELECT id, cidr, 'f' AS type, network(cidr) AS net, broadcast(cidr) AS bcast FROM freeblocks WHERE parent_id = ?
115 ORDER BY cidr
116 ));
117 $sth->execute($cid, $cid) or die $dbh->errstr;
118 my $prev = $ccidr;
119 while (my ($childid, $childcidr, $childtype, $childnet, $childbcast) = $sth->fetchrow_array) {
120 # note that we've "seen" the ID/CIDR, flagging freeblocks
121 $idlist->{$childid} = $childcidr if $childtype ne 'f';
122 $idlist->{'fb'.$childid} = $childcidr if $childtype eq 'f';
123 checkcontainer($childid, $idlist, $depth) if $childtype =~ /.[cm]/;
124 my $prevn = $prev->broadcast->numeric + 1;
125 my $cur = new NetAddr::IP $childnet;
126 if ($cur->numeric == $prevn) {
127 $prev = $cur;
128 next;
129 }
130 if ($ccidr->numeric == $prev->numeric) {
131 # check if cur starts with master
132 if ($cur->numeric > $prev->numeric) {
133 print $indent." Gap from start of parent $ccidr to first block $cur\n";
134 } elsif ($cur->numeric < $prev->numeric) {
135 print $indent." BIG problem! Current block $cur begins before parent $ccidr!\n";
136 }
137 } else {
138 if ($cur->numeric < ($prev->numeric + 1)) {
139 print $indent." Block ".$prev->network." overlaps block $cur\n";
140 } elsif ($cur->numeric > ($prev->numeric + 1)) {
141 print $indent." Gap between end of block ".$prev->network." and block $cur\n";
142 }
143 }
144
145 $prev = $cur;
146 $prev--;
147 }
148}
Note: See TracBrowser for help on using the repository browser.