#!/usr/bin/perl -w

# elfgrep_fixup : Fixes output from multiple runs of elfgrep
# Copyright (C) 2002 Dion Mendel
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program 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 program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

# elfgrep determines the position (if any) of object files inside a
# target elf binary file.  When run multiple times over many object
# files, there may be collisions.  (A collision is when multiple
# object files overlap each other in the target file).  This program
# searches for these collisions, resolves any if possible, and
# marks unresolveable collisions for manual resolution.
#
# Sample usage:
# % for i in obj/*.o ; do
#      elfgrep -t $i the-binary
#   done | elfgrep_fixup -
# %

use Getopt::Long "GetOptions";
use FileHandle;
use strict 'vars';
use vars '$VERSION',  '$Verbose';

$VERSION = "1.0";                            # version of this program
$Verbose = 1;


my @no_conflicts = ();
my @multiples = ();
my @conflicts = ();

&parse_command_line_for_options();
&usage if (scalar @ARGV != 1);

my $filename = $ARGV[0];

# read data and sort into the three lists
&read_data($filename, \@conflicts, \@no_conflicts, \@multiples);

# add all non intersecting multi object to the conflicts list.
foreach my $obj (@multiples) {
   unless (&intersects($obj, \@no_conflicts)) {
      &add_obj_to_conflicts($obj, \@conflicts);
   }
}

# attempt to resolve conflicts
&resolve_conflicts(\@conflicts, \@no_conflicts);

my $fh = STDOUT;
&display_output($fh, \@conflicts, \@no_conflicts);

exit 0;

############################### Output Functions ##############################

# -----------------------------------------------------------------------------
# Displays the results of this program.
# Params: $fh - file handle to display output to.
#         \@conflicts - list of objects which conflict and need resolution
#         \@no_conflicts - list of objects which do not conflict
# Returns: none

sub display_output($\@\@)
{
   my ($fh, $ref_conflicts, $ref_no_conflicts) = @_;
   my ($obj, $listref, @sorted);

   print $fh <<"_HERE";
#
#              -- This is an automatically generated file. --
#
# This file contains the results of using elfgrep to search a binary file
# for contained object file.  Manual resolution of the conflicts at the
# end of this file may be necessary.
#
_HERE

   # sort no conflicts list according to starting offset
   @sorted = sort { $a->{start} <=> $b->{start} } @$ref_no_conflicts;

   # display non conflicting matches
   foreach $obj (@sorted) {
      printf $fh ("%s - match at 0x%08x (0x%08x bytes)\n",
                  $obj->{name}, $obj->{start}, $obj->{size});
   }

   # display conflicting matches
   foreach $listref (@conflicts) {
      printf $fh ("\n# Possible conflict below requiring manual resolution:\n");
      printf $fh ("# ----------------------------------------------------\n");
      foreach $obj (@$listref) {
         printf $fh ("# %s - match at 0x%08x (0x%08x bytes)\n",
                     $obj->{name}, $obj->{start}, $obj->{size});
      }
   }
}

################################ Obj Functions ################################

# -----------------------------------------------------------------------------
# Creates a new object.  An object is a representation of an object file
# (.o file).
# an object in the list which intersects with the given object.
# Params: $name  - name of object file
#         $start - starting offset of the object file
#         $size  - size of the object file
# Returns: reference to an object

sub new_obj($$$)
{
   my ($name, $start, $size) = @_;
   return { name => $name, start => $start, size => $size };
}

# -----------------------------------------------------------------------------
# Returns whether the two given objects intersect with each other or not.
# Params: $obj1, $obj2 objects to test
# Returns: 1 if the objects intersect, 0 otherwise.

sub objs_intersect($$)
{
   my ($r1, $r2) = @_;
   my ($a, $b);

   # order so that the start of $a is before the start of $b
   if ($r1->{start} < $r2->{start}) {
      ($a, $b) = ($r1, $r2);
   }
   else {
      ($a, $b) = ($r2, $r1);
   }

   # intersection occurs if the start of $b is before the end of $a
   return ($b->{start} < ($a->{start} + $a->{size}));
}

# -----------------------------------------------------------------------------
# For the given object and a list of objects, return the first index of
# an object in the list which intersects with the given object.
# Params: $obj - object to check
#         \@list - list of objects
# Returns: index of intersecting object, or -1 if there are no intersections.

sub intersection_index($\@)
{
   my ($obj, $ref_list) = @_;
   my ($i, $index);

   $index = -1;
   for ($i = 0; $i < scalar @$ref_list; $i++) {
      if (&objs_intersect($obj, $ref_list->[$i])) {
         $index = $i;
         last;
      }
   }

   return $index;
}

# -----------------------------------------------------------------------------
# For the given object and a list of objects, returns whether the given object
# intersects with any of the objects in the list.
# Params: $obj - object to check
#         \@list - list of objects
# Returns: 0 if no intersections, 1 if there exists an intersection.

sub intersects($\@)
{
   my ($obj, $ref_list) = @_;

   return (&intersection_index($obj, $ref_list) != -1);
}

############################## Conflicts Functions ############################

# Note: The conflicts list is not a flat list.  It is an fact a list of lists,
#        where the inner lists contain objects which conflict with each other.

# -----------------------------------------------------------------------------
# Counts the number of occurances of objects with the given name, in the
# conflicts list.
# Params: $name - name to search for
#         \@conflicts - list of objects which conflict and need resolution
# Returns: number of occurances of $name in the conflicts list

sub count_name_in_conflicts($\@)
{
   my ($name, $ref_conflicts) = @_;
   my ($count, $listref, $obj);

   $count = 0;
   foreach $listref (@$ref_conflicts) {
      foreach $obj (@$listref) {
         if ($obj->{name} eq $name) {
            $count++;
         }
      }
   }

   return $count;
}

# -----------------------------------------------------------------------------
# Attempts to automatically resolve conflicts.  If any single objects in
# the conflicts list to not interfere with any in the no_conflicts list,
# then the single object can be moved to the no_conflicts list.  A single
# object is one that only occurs once in the conflicts list, and doesn't
# intersect with any other objects in the conflicts list.
# Params: \@conflicts - list of objects which conflict and need resolution
#         \@no_conflicts - list of objects which do not conflict
# Returns: none

sub resolve_conflicts(\@\@)
{
   my ($ref_conflicts, $ref_no_conflicts) = @_;
   my ($i, $index, $listref, $name, $obj, @pending);

   # for each inner list in the conflicts list
   for ($i = 0; $i < scalar @$ref_conflicts; $i++) {
      $listref = $ref_conflicts->[$i];
      # if the inner list contains just one object ..
      if (scalar @$listref == 1) {
         # .. and the object name only occurs once in the conflicts list ..
         $name = $listref->[0]->{name};
         if (&count_name_in_conflicts($name, $ref_conflicts) == 1) {
            # .. then that object is a candidate for the no conflicts list.
            # unshift so that pending list contain indexes in descending order
            unshift @pending, $i;
         }
      }
   }

   # now attempt to resolve conflicts
   foreach $index (@pending) {
      # delete an inner list (which contains just the one object to resolve)
      $listref = splice(@$ref_conflicts, $index, 1);
      $obj = $listref->[0];
      # add the single object to the no conflicts list
      &add_obj_to_no_conflicts($obj, $ref_conflicts, $ref_no_conflicts);
   }
}

# -----------------------------------------------------------------------------
# Returns whether the given object intersects an object in the conflicts list.
# Params: $obj - object to test
#         \@conflicts - list of objects which conflict and need resolution
# Returns: 0 if no intersections, 1 if there exists an intersection.

sub obj_intersects_conflicts($\@)
{
   my ($obj, $ref_conflicts) = @_;
   my ($i, $intersects, $collection_ref);

   $intersects = 0;
   $collection_ref = ();
   for ($i = 0; $i < scalar @$ref_conflicts; $i++) {
      $collection_ref = $ref_conflicts->[$i];
      if (&intersects($obj, $collection_ref)) {
         $intersects = 1;
         last;
      }
   }

   return $intersects;
}

# -----------------------------------------------------------------------------
# Adds the given object to the conflicts list.
# Params: $obj - object to add
#         \@conflicts - list of objects which conflict and need resolution
# Returns: none

sub add_obj_to_conflicts($\@)
{
   my ($obj) = shift @_;
   my ($ref_conflicts) = @_;
   my ($i, $collection_ref, $intersects);

   # search for an inner list that the object intersects with.
   $intersects = 0;
   $collection_ref = ();
   for ($i = 0; $i < scalar @$ref_conflicts; $i++) {
      $collection_ref = $ref_conflicts->[$i];
      if (&intersects($obj, $collection_ref)) {
         $intersects = 1;
         last;
      }
   }

   if ($intersects) {
      # add object to this inner list
      push @$collection_ref, $obj;
   }
   else {
      # create a new inner list containing the object
      push @$ref_conflicts, [$obj];
   }
}

############################ No Conflicts Functions ###########################

# -----------------------------------------------------------------------------
# Request to add the given object to the no conflict list.  If the object
# can not be added to the no conflict list without causing a conflict, then
# it is added to the conflict list instead.
# Params: $obj - object to add
#         \@conflicts - list of objects which conflict and need resolution
#         \@no_conflicts - list of objects which do not conflict
# Returns: none

sub add_obj_to_no_conflicts($\@\@)
{
   my ($obj) = shift @_;
   my ($ref_conflicts, $ref_no_conflicts) = @_;
   my ($intersection_index, $existing_obj);

   # determine if the object intersects with an object in the no conflict list
   $intersection_index = &intersection_index($obj, $ref_no_conflicts);

   if ($intersection_index != -1) {
         # add the two conflicting objects to the conflicts list
         $existing_obj = $ref_no_conflicts->[$intersection_index];
         &add_obj_to_conflicts($existing_obj, $ref_conflicts);
         &add_obj_to_conflicts($obj, $ref_conflicts);

         # remove offending object from no conflict list
         splice(@$ref_no_conflicts, $intersection_index, 1);
   }
   else {   # no intersection with any objects in no conflicts list
      # if object intersects with an object in the conflict list,
      # then add it to the conflict list as well (to be resolved later).
      if (&obj_intersects_conflicts($obj, $ref_conflicts)) {
         &add_obj_to_conflicts($obj, $ref_conflicts);
      }
      else {
         # no conflicts anywhere, so safe to add to the no conflicts list
         push @$ref_no_conflicts, $obj;
      }
   }
}

############################# Read Data Functions #############################

# -----------------------------------------------------------------------------
# Reads data regarding matching object files, and sorts the data into
# three lists.
# Params: $filename - filename containing data to read or '-' for stdin
#         \@conflicts - list to store objects which conflict and need resolution
#         \@no_conflicts - list to store objects which do not conflict
#         \@multiples - list to store objects with multiple matches
# Returns: none

sub read_data($\@\@\@)
{
   my ($filename) = shift @_;
   my ($ref_conflicts, $ref_no_conflicts, $ref_multiples) = @_;
   my ($fh, $line, $obj);

   # open file, or just use stdin if filename is '-'
   if ($filename eq "-") {
      $fh = STDIN;
   }
   else {
      $fh = new FileHandle();
      open $fh, "< $filename" or die "could not open file `$filename': $!";
   }

   # for each line
   while ($line = <$fh>) {
      next if $line =~ /no matches/;         # skip lines with no matches

      if ($line =~ /(.*) - match at (0x.*) \((0x.*) bytes\)/) {
         # add single object to no conflicts list
         $obj = { name => $1, start => oct($2), size => oct($3) };
         &add_obj_to_no_conflicts($obj, $ref_conflicts, $ref_no_conflicts);
      }
      elsif ($line =~ /(.*) - match \d+ at (0x.*) \((0x.*) bytes\)/) {
         # add multiple objects to multiples list
         $obj = { name => $1, start => oct($2), size => oct($3) };
         push @$ref_multiples, $obj;
      }
      else {
         die "bad input `$line'";
      }
   }

   # close file handle unless reading from stdin
   close $fh unless ($filename eq "-");
}

############################### Usage Functions ###############################

# -----------------------------------------------------------------------------
# Parses the command line for any specified options.  Sets the appropriate
# option flags if options are specified.  Prints usage info if invalid options
# are given.
# Returns: nothing

sub parse_command_line_for_options()
{
   my ($want_quiet)   = 0;
   my ($want_version) = 0;
   my ($want_help)    = 0;

   &GetOptions("q|quiet"   => \$want_quiet,
               "V|version" => \$want_version,
               "h|help"    => \$want_help,
              );

   if ($want_version) {
      print "$0 $VERSION\n";
      exit 0;
   }

   if ($want_help) {
      &usage();
   }

   $Verbose = !$want_quiet;
}

# -----------------------------------------------------------------------------
# Prints a nice usage message to stdout, and then exits.

sub usage()
{
   print <<"_END";

$0 v${VERSION}
A filter to process the output of multiple runs of elfgrep.  All data chunks
are checked for intersections, and any intersecting chunks are commented out
for manual resolution.

Usage: $0 [options] [file_name]
   filename is the name of the file containing data to process, or - for stdin
Options:
    -V, --version         outputs version information and exits
    -h, --help            displays this help and exits

_END

   exit 1;
}