admin/bcheck.pl

   1 #!/usr/bin/perl -w
   2
   3 use DB_File;
   4 use Fcntl ':flock';
   5
   6 if (!defined($ARGV[0])) {
   7     print "usage: requires .class dump as parameter!\n";
   8     exit;
   9 }
  10
  11 sub bailout
  12 {
  13     untie %bcheckdb if(defined(%bcheckdb));
  14
  15     if(defined(MYLOCK)) {
  16         flock MYLOCK, LOCK_UN;
  17         close(MYLOCK);
  18     }
  19
  20     print @_;
  21     exit 5;
  22 }
  23
  24 sub ask_user
  25 {
  26     my ($dbkey, $dbchunk) = @_;
  27
  28     if (defined($ENV{"BCHECK_UPDATE"})) {
  29         $bcheckdb{$dbkey} = $dbchunk;
  30         return;
  31     }
  32
  33     &bailout("BC problem detected") if (! -t STDIN);
  34
  35     print "(I)gnore / (Q)uit / (U)pdate: ";
  36
  37     my $key;
  38     while(defined(read STDIN, $key, 1)) {
  39         $key = lc($key);
  40
  41         print "got: >$key<\n";
  42
  43         return if ($key eq 'i');
  44
  45         &bailout("BC problem. aborted") if ($key eq 'q');
  46
  47         if ($key eq 'u') {
  48             $bcheckdb{$dbkey} = $dbchunk;
  49             return;
  50         }
  51         print "\n(I)gnore / (Q)uit / (U)pdate: ";
  52     }
  53 }
  54
  55 sub diff_chunk($$)
  56 {
  57     my ($oldl, $newl) = @_;
  58     my @old = split /^/m, $oldl;
  59     my @new = split /^/m, $newl;
  60     my $haschanges = 0;
  61     my $max = $#old > $#new ? $#old : $#new;
  62
  63     die "whoops. key different" if ($old[0] ne $new[0]);
  64
  65     if ($#old != $#new) {
  66         warn ("Structural difference.\n");
  67         print @old;
  68         print "-----------------------------------------------\n";
  69         print @new;
  70         $haschanges = 1;
  71         return $haschanges;
  72     }
  73
  74     print $old[0];
  75
  76     my ($class) = ($old[0] =~ /^(?:Class |Vtable for )(\S+)/);
  77
  78     my $c = 1;
  79     while ($c < $max) {
  80         my ($o, $n) = ($old[$c], $new[$c]);
  81         chomp $o;
  82         chomp $n;
  83         $c++;
  84         next if ($o eq $n);
  85
  86         if(defined($class) and $n =~ /^(\d+\s+)\w+(::\S+\s*.*)$/) {
  87             next if ($n eq "$1$class$2");
  88         }
  89
  90         $haschanges = 1;
  91
  92         print "-$o\n+$n\n\n";
  93     }
  94
  95     return $haschanges;
  96 }
  97
  98 local $dblock = $ENV{"HOME"} . "/bcheck.lock";
  99 my $dbfile = $ENV{"HOME"} . "/bcheck.db";
 100 my $cdump  = $ARGV[0];
 101
 102 die "file $cdump is not readable: $!" if (! -f $cdump);
 103
 104 # make sure the advisory lock exists
 105 open(MYLOCK, ">$dblock");
 106 print MYLOCK "";
 107
 108 flock MYLOCK, LOCK_EX;
 109
 110 tie %bcheckdb, 'DB_File', $dbfile;
 111
 112 my $chunk = "";
 113
 114 open (IN, "<$cdump") or die "cannot open $cdump: $!";
 115 while (<IN>) {
 116
 117     chop;
 118
 119     s/0x[0-9a-fA-F]+/0x......../g;
 120     s/base size=/size=/g;
 121     s/\(\)\s*$//g;
 122     s/base align=/align=/g;
 123
 124     $chunk .= $_ . "\n";
 125
 126     if(/^\s*$/) {
 127         my @lines = split /^/m, $chunk;
 128         my $key = $lines[0];
 129         chomp $key;
 130
 131         if($key !~ /<anonymous struct>/ &&
 132            $key !~ /<anonymous union>/) {
 133             if(defined($bcheckdb{$key})) {
 134                 my $dbversion = $bcheckdb{$key};
 135
 136                 if($dbversion ne $chunk) {
 137                      &ask_user($key, $chunk) if(&diff_chunk($dbversion, $chunk));
 138                 }
 139             }
 140             else {
 141                 $bcheckdb{$key} = $chunk;
 142                 print "NEW: $key\n";
 143             }
 144         }
 145
 146         $chunk = "";
 147         next;
 148     }
 149
 150 }
 151 close(IN);
 152
 153 untie %bcheckdb;
 154 flock MYLOCK, LOCK_UN;
 155 close(MYLOCK);
 156
 157 exit 0;