#!/usr/bin/perl

#      Copyright (C) Philipp 'ph3-der-loewe' Schafft - 2010-2011
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License version 3
#    as published by the Free Software Foundation.
#
#    It is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this software; see the file COPYING.gplv3. If not, write to
#    the Free Software Foundation, 51 Franklin Street, Fifth Floor,
#    Boston, MA 02110-1301, USA.

use strict;
use vars qw(%objs %sum %unknown_funcs %warn %pt2msg @ignores $editvim %conf %ignored_targets %call_counts %use_counts);

%conf = (
 'objdump'    => 'objdump',
 'print-mode' => 'default',
 'header'     => 1,
);

%pt2msg = (
 'internal' => 'bad: for internal use only',
 'ignore'   => 'ignored',
 'ok'       => 'no problem',
 'maybe'    => 'maybe a problem',
 'likely'   => 'likely a problem',
 'critical' => 'critical',
 'fail'     => 'fatal',
 'removed'  => 'is removed from specs',
 'legacy'   => 'is marked LEGACY',
 'wip'      => 'is work in process',
 'broken'   => 'bad: function is broken',
);

%warn = map{$_ => 1}(qw(internal likely critical fail removed legacy broken));

$editvim = 0;

my $summery = 1;

foreach (('/usr/lib/ckport/db/', '/usr/local/lib//ckport/db/', $ENV{'HOME'}.'/.ckport/db/')) {
 read_db_dir($_) if -d $_;
}

while (($_ = shift(@ARGV))) {
 if ( $_ eq '--db' ) {
  read_db(shift(@ARGV));
 } elsif ( $_ eq '--db-dir' ) {
  read_db_dir(shift(@ARGV));
 } elsif ( $_ eq '--edit-vim' ) {
  $editvim = 1;
 } elsif ( $_ eq '--conf' ) {
  $_ = shift(@ARGV);
  /^([^=]+)=(.+)$/ or die;
  $conf{$1} = $2;
 } elsif ( $_ eq '--warn' ) {
  $warn{shift(@ARGV)} = 1;
 } elsif ( $_ eq '--nowarn' ) {
  $warn{shift(@ARGV)} = 0;
 } elsif ( $_ eq '--nowarns' ) {
  %warn = ();
 } elsif ( $_ eq '--nosummery' ) {
  $summery = 0;
 } elsif ( $_ eq '--noheader' ) {
  $conf{'header'} = 0;
 } elsif ( $_ eq '--ignore' ) {
  push(@ignores, shift(@ARGV));
 } elsif ( $_ eq '--ignore-target' ) {
  $ignored_targets{shift(@ARGV)} = 1;
 } elsif ( $_ eq '--print-mode' ) {
  $conf{'print-mode'} = shift(@ARGV);
 } elsif ( $_ eq '--print-unknown' ) {
  if ( $conf{'header'} ) {
   print "\n";
   print "Unknown functions:\n";
  }
  print_syms([grep{$unknown_funcs{$_} != 2}(keys(%unknown_funcs))]);
 } elsif ( $_ eq '--print-unknown-defined' ) {
  if ( $conf{'header'} ) {
   print "\n";
   print "Unknown defined functions:\n";
  }
  print_syms([grep{$unknown_funcs{$_} == 2 && !defined(lookup_func($_))}(keys(%unknown_funcs))]);
 } elsif ( $_ eq '--print-unused' ) {
  print_syms([grep{defined($unknown_funcs{$_}) && !exists($call_counts{$_}) && !exists($use_counts{$_})}(keys(%unknown_funcs))]);
 } elsif ( $_ eq '--print-known' ) {
  if ( $conf{'header'} ) {
   print "\n";
   print "Known objects:\n";
  }
  print_syms([keys(%objs)]);
 } elsif ( $_ eq '--print-pt' ) {
  if ( $conf{'header'} ) {
   print "\n";
   print "Known pts:\n";
  }
  { local $, = ' ';
    print keys(%pt2msg), "\n";
  }
 } elsif ( $_ eq '--' ) {
  last;
 } elsif ( $_ eq '-h' || $_ eq '--help' ) {
  usage();
  exit(0);
 } elsif ( /^-/ ) {
  die 'Unknown option';
 } else {
  read_object($_);
 }
}

foreach (@ARGV) {
 read_object($_);
}

if ( $summery ) {
 if ( $conf{'header'} ) {
  print "\n";
  print "Summery:\n";
 }
 my $s = 0;
 $s += $sum{$_} foreach keys %sum;

 printf("calls with pt %s happend %i(%2.2f%%) times\n", $_, $sum{$_}, $sum{$_}*100/$s) foreach keys %sum;
}

#use Data::Dumper;
#print Dumper(\%objs);

exit(0);

#---------

sub usage {
 print "Usage: $0 [OPTIONS]... file [file,...]\n";
 print "\n";
 print <<'__EOH__';
Options:
  --help      -h              - Show this help
  --                          - End of options, only filenames follow
  --db DBFILE                 - Load database DBFILE
  --db-dir DBDIR              - Load databases from directory DBDIR
  --edit-vim                  - Show vim command pointing to location of problem
  --conf KEY=VAL              - Set config key KEY to value VAL
  --warn PT                   - Warn about problems of type PT
  --nowarn PT                 - Ignore warnings about problems of type PT
  --nosummery                 - Disable summery
  --noheader                  - Disable printing of headers
  --ignore PATTERN            - Ignore symbols matching this Perl regex pattern
  --ignore-target TARGET      - Ignore warnings for target TARGET
  --print-mode MODE           - Set mode of symbol printing to MODE
  --print-unknown             - Print unknown symbols found
  --print-unknown-defined     - Print list of unknown but defined (internal) symbols
  --print-unused              - Print list of defined (internal) but unused symbols
  --print-known               - Print list of known symbols
  --print-pt                  - Print list of known problem types
__EOH__
}

sub print_syms {
 my ($syms, $mode) = @_;

 $mode ||= $conf{'print-mode'};

 if ( $mode eq 'default' ) {
  { local $, = ' ';
    local $\ = "\n";
    print @{$syms};
  }
 } elsif ( $mode eq 'internal' ) {
  { local $_;
    foreach (@{$syms}) {
     print "$_\tinternal\n";
    }
  }
 } else {
  die 'unknown print mode';
 }
}

sub read_db_dir($) {
 my ($dir) = @_;
 local $_;

 opendir(my $in, $dir) or die;
 while (($_ = readdir($in))) {
  $_ = $dir.'/'.$_;
  read_db($_) if -f $_;
 }
 closedir($in);

}

sub read_db($) {
 my ($file) = @_;
 my %defs = ('TYPE' => 'unknown', 'NAME' => 'unnamed database', 'TARGET' => '$DEFAULT');
 my @data;
 my $e;
 local $_;

 open(my $in, '<', $file) or die;
 while (<$in>) {
  s/\r?\n//;
  s/\s*#.*$//;

  if ( $_ eq '' ) {
   next;
  } elsif ( /^\!([a-zA-Z0-9]+):\s*(.+)$/ ) {
   $defs{uc($1)} = $2;
  } else {
   @data = split(/\t+/, $_);

   next unless $data[1];

   $e = [$data[1], $data[2]];

   $objs{$data[0]} ||= {};
   $objs{$data[0]}->{$defs{'TYPE'}} ||= {};
   $objs{$data[0]}->{$defs{'TYPE'}}->{$defs{'TARGET'}} = $e;
  }
 }
 close($in);
}

sub read_object($) {
 my ($file) = @_;
 my ($sfile, $ssym, $sline) = ($file, undef, undef);
 my $tfunc;
 my $ckinfo;
 my ($k, $v);
 my $pt;
 my $ignoreit;
 my $cmd;
 local $_;

 open(my $in, '-|', $conf{'objdump'}, '-l', '-d', $file) or die;
 while (<$in>) {
  s/\r?\n//;

  if ( m#^(.+\..+):(\d+)$# ) {
   ($sfile, $sline) = ($1, int($2));
  } elsif ( m#^[0-9a-fA-F]+ \<([^\>]+)\>:$# ) {
   $ssym = $1;
   $ssym =~ s/\@.+$//;
   $ignoreit = 0;

   foreach (@ignores) {
    if ( $ssym =~ /$_/ ) {
     $ignoreit = 1;
     last;
    }
   }

   $unknown_funcs{$ssym} = 2 unless $ignoreit;
  } elsif ( m#^\s*[0-9a-fA-F]+:\s*.+?\s+[r]?(call|jmp)\s+(?:\.\+\d+\s+;\s+)?(?:0x)?[0-9a-fA-F]+\s+\<([^\>]+)\>$# ) {
   ($cmd, $tfunc) = ($1, $2);
   $tfunc =~ s/\@.+$//;
   $tfunc =~ s/\+0x[a-fA-F0-9]+$//;

   $ignoreit = 0;
   foreach (@ignores) {
    if ( $tfunc =~ /$_/ ) {
     $ignoreit = 1;
     last;
    }
   }

   next if $ignoreit;

   $call_counts{$tfunc}++;

   $ckinfo = lookup_func($tfunc);

   unless (defined($ckinfo)) {
    $sum{'unknown'}++;
    $unknown_funcs{$tfunc} ||= 1;
    next;
   }

   foreach $k (keys(%{$ckinfo})) {
    next if $ignored_targets{$k};

    $v = $ckinfo->{$k};
    $pt = $v->[0];
    $sum{$pt}++;
    next if $pt eq 'ok' || $pt eq 'ignore';

    foreach (keys %warn) {
     next unless $warn{$_};

     if ( $pt eq $_ ) {
      print_report('sfile' => $sfile, 'ssym' => $ssym, 'sline' => $sline,
                   'target' => $k,
                   'tfunc'  => $tfunc,
                   'pt' => $pt, 'desc' => $v->[1],
                  );
     }
    }
   }

   #printf("Call to %s from %s at %s:%i\n", $tfunc, $ssym, $sfile, $sline);
  }
 }
 close($in);
}

sub lookup_func ($) {
 my ($f) = @_;
 my $r   = $objs{$f};

 return undef unless defined $r;

 $r = $r->{'func'};

 return undef unless defined $r;

 return $r;
}

sub print_report {
 my $info = {@_};
 my $pt   = $info->{'pt'};

 $pt = $pt2msg{$pt} || $pt;

 printf("Call to %s() is %s for target %s:\n", $info->{'tfunc'}, $pt, $info->{'target'});
 printf("  Problem: %s\n", $info->{'desc'}) if $info->{'desc'};
 printf("  in function %s()\n", $info->{'ssym'});
 printf("  at %s line %i\n", $info->{'sfile'}, $info->{'sline'});
 printf("  edit with: vim +%i %s\n", $info->{'sline'}, $info->{'sfile'}) if $editvim;
 printf("\n");
}

#ll
