Shared admin folder
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

bcheck.pl 3.0KB

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