joachim99@14: #!/usr/bin/perl -w
joachim99@14: 
joachim99@14: use DB_File;
joachim99@14: use Fcntl ':flock';
joachim99@14: 
joachim99@14: if (!defined($ARGV[0])) {
joachim99@14:     print "usage: requires .class dump as parameter!\n";
joachim99@14:     exit;
joachim99@14: }
joachim99@14: 
joachim99@14: sub bailout
joachim99@14: {
joachim99@14:     untie %bcheckdb if(defined(%bcheckdb));
joachim99@14: 
joachim99@14:     if(defined(MYLOCK)) {
joachim99@14:         flock MYLOCK, LOCK_UN;
joachim99@14:         close(MYLOCK);
joachim99@14:     }
joachim99@14: 
joachim99@14:     print @_;
joachim99@14:     exit 5;
joachim99@14: }
joachim99@14: 
joachim99@14: sub ask_user
joachim99@14: {
joachim99@14:     my ($dbkey, $dbchunk) = @_;
joachim99@14: 
joachim99@14:     if (defined($ENV{"BCHECK_UPDATE"})) {
joachim99@14:         $bcheckdb{$dbkey} = $dbchunk;
joachim99@14:         return;
joachim99@14:     }
joachim99@14: 
joachim99@14:     &bailout("BC problem detected") if (! -t STDIN);
joachim99@14: 
joachim99@14:     print "(I)gnore / (Q)uit / (U)pdate: ";
joachim99@14: 
joachim99@14:     my $key;
joachim99@14:     while(defined(read STDIN, $key, 1)) {
joachim99@14:         $key = lc($key);
joachim99@14: 
joachim99@14:         print "got: >$key<\n";
joachim99@14: 
joachim99@14:         return if ($key eq 'i');
joachim99@14: 
joachim99@14:         &bailout("BC problem. aborted") if ($key eq 'q');
joachim99@14: 
joachim99@14:         if ($key eq 'u') {
joachim99@14:             $bcheckdb{$dbkey} = $dbchunk;
joachim99@14:             return;
joachim99@14:         }
joachim99@14:         print "\n(I)gnore / (Q)uit / (U)pdate: ";
joachim99@14:     }
joachim99@14: }
joachim99@14: 
joachim99@14: sub diff_chunk($$)
joachim99@14: {
joachim99@14:     my ($oldl, $newl) = @_;
joachim99@14:     my @old = split /^/m, $oldl;
joachim99@14:     my @new = split /^/m, $newl;
joachim99@14:     my $haschanges = 0;
joachim99@14:     my $max = $#old > $#new ? $#old : $#new;
joachim99@14: 
joachim99@14:     die "whoops. key different" if ($old[0] ne $new[0]);
joachim99@14: 
joachim99@14:     if ($#old != $#new) {
joachim99@14:         warn ("Structural difference.\n");
joachim99@14:         print @old;
joachim99@14:         print "-----------------------------------------------\n";
joachim99@14:         print @new;
joachim99@14:         $haschanges = 1;
joachim99@14:         return;
joachim99@14:     }
joachim99@14: 
joachim99@14:     print $old[0];
joachim99@14: 
joachim99@14:     my ($class) = ($old[0] =~ /^(?:Class |Vtable for )(\S+)/);
joachim99@14: 
joachim99@14:     my $c = 1;
joachim99@14:     while ($c < $max) {
joachim99@14:         my ($o, $n) = ($old[$c], $new[$c]);
joachim99@14:         chomp $o;
joachim99@14:         chomp $n;
joachim99@14:         $c++;
joachim99@14:         next if ($o eq $n);
joachim99@14: 
joachim99@14:         if(defined($class) and $n =~ /^(\d+\s+)\w+(::\S+\s*.*)$/) {
joachim99@14:             print "comparing >$n< against >$1$class$2<\n";
joachim99@14:             next if ($n eq "$1$class$2");
joachim99@14:         }
joachim99@14: 
joachim99@14:         $haschanges = 1;
joachim99@14: 
joachim99@14:         print "-$o\n+$n\n\n";
joachim99@14:     }
joachim99@14: 
joachim99@14:     return $haschanges;
joachim99@14: }
joachim99@14: 
joachim99@14: local $dblock = $ENV{"HOME"} . "/bcheck.lock";
joachim99@14: my $dbfile = $ENV{"HOME"} . "/bcheck.db";
joachim99@14: my $cdump  = $ARGV[0];
joachim99@14: 
joachim99@14: die "file $cdump is not readable: $!" if (! -f $cdump);
joachim99@14: 
joachim99@14: # make sure the advisory lock exists
joachim99@14: open(MYLOCK, ">$dblock");
joachim99@14: print MYLOCK "";
joachim99@14: 
joachim99@14: flock MYLOCK, LOCK_EX;
joachim99@14: 
joachim99@14: tie %bcheckdb, 'DB_File', $dbfile;
joachim99@14: 
joachim99@14: my $chunk = "";
joachim99@14: 
joachim99@14: open (IN, "<$cdump") or die "cannot open $cdump: $!";
joachim99@14: while (<IN>) {
joachim99@14: 
joachim99@14:     chop;
joachim99@14: 
joachim99@14:     s/0x[0-9a-fA-F]+/0x......../g;
joachim99@14: 
joachim99@14:     $chunk .= $_ . "\n";
joachim99@14: 
joachim99@14:     if(/^\s*$/) {
joachim99@14:         my @lines = split /^/m, $chunk;
joachim99@14:         my $key = $lines[0];
joachim99@14:         chomp $key;
joachim99@14: 
joachim99@14:         if($key !~ /<anonymous struct>/ &&
joachim99@14:            $key !~ /<anonymous union>/) {
joachim99@14:             if(defined($bcheckdb{$key})) {
joachim99@14:                 my $dbversion = $bcheckdb{$key};
joachim99@14: 
joachim99@14:                 if($dbversion ne $chunk) {
joachim99@14:                      &ask_user($key, $chunk) if(&diff_chunk($dbversion, $chunk));
joachim99@14:                 }
joachim99@14:             }
joachim99@14:             else {
joachim99@14:                 $bcheckdb{$key} = $chunk;
joachim99@14:                 print "NEW: $key\n";
joachim99@14:             }
joachim99@14:         }
joachim99@14: 
joachim99@14:         $chunk = "";
joachim99@14:         next;
joachim99@14:     }
joachim99@14: 
joachim99@14: }
joachim99@14: close(IN);
joachim99@14: 
joachim99@14: untie %bcheckdb;
joachim99@14: flock MYLOCK, LOCK_UN;
joachim99@14: close(MYLOCK);
joachim99@14: 
joachim99@14: exit 0;