#!/usr/bin/perl

use strict;

my %result;

sgetopt( [ 'h', 'e:', 'c:', 'o:', 'n' ], \%result);

print_usage() if (exists $result{'h'});
print_usage("Missing -c <core file> option") if (! exists $result{'c'});
print_usage("Missing -e <exe file> option") if (! exists $result{'e'});
print_usage("Missing -o <out file> option") if (! exists $result{'o'});

my $exe_file = $result{'e'};
my $core_file = $result{'c'};
my $tar_file = $result{'o'};
my $copy_exe = ! defined $result{'n'};

if (! -f $exe_file ) {
  print_usage("<executable file path> file does not exist");
}

if (defined $core_file && ! -f $core_file) {
  print_usage("<core-file> file does not exist");
}

my $VERBOSE = 0;

my @libs = get_dependent_libs(  $exe_file );

my @dynlibs = get_dyn_libs($exe_file, $core_file);
make_tar();

sub make_tar
{
  my ($basedir,$tmp_dir,@dep_files,$f,$dir,@dynlibs);
 
  my $tmp_dir = "/tmp/tmp-dir-$$";

  @dep_files =get_dependent_libs($exe_file);
  @dynlibs = get_dyn_libs($exe_file, $core_file);

  run("mkdir -p $tmp_dir");
  
  foreach $f (@dep_files) {
     $dir = "$tmp_dir/".get_base_dir($f);
     run("mkdir -p $dir");
     run("cp -Lf $f $dir");
  }
  
  foreach $f (@dynlibs) {
     $dir = "$tmp_dir/".get_base_dir($f);
     run("mkdir -p $dir");
     run("cp -Lf $f $dir");
  }
  
  
  copy_core($tmp_dir);
 
  run("tar cvfj $tar_file -C $tmp_dir .");
  run("rm -rf $tmp_dir");
}


sub copy_core
{
  my $tmp_dir = shift;
  my ($cfile,$efile);

  if (defined $core_file) {
    run("cp -f $core_file $tmp_dir");
    $cfile = get_base_name($core_file);
  }

  if ($copy_exe) {
    run("cp -f $exe_file $tmp_dir");
    $efile = get_base_name($exe_file);
  }
  

  my $sf = "$tmp_dir/run.sh";
  open(OF,">$sf") || die "Can't create $sf";
  print OF <<EOFS
#!/bin/bash

EOFS
;

  print OF "CFILE=$cfile\n" if ($cfile ne "");
  print OF "EXE=$efile\n" if ($efile ne "");

  print OF <<EOFS

function usage()
{
  local \$optline

  optline = "\$0 "
  if ["x\$CFILE" != "x"]; then
    optline = "\$optline [-c <core-file> ] "
  else
    optline = "\$optline -c <core_file> "
  fi

  if ["x\$EXE" != "x"]; then
    optline = "\$optline [ -e <exe_file> ] "
  else 
    optline = "\$optline -e <exe_file> "
  fi

cat <<EOF
\$optline

Invokes gdb while it is looking at dependent shared libraries
of ${exe_file} copied from a remote machine.

  -c core file.
  -e exe file.
EOF

  if [ "x\$EXE" != "x" ]; then
     echo " default value of -e option is \$EXE"
  fi
  if [ "x\$CFILE" != "x" ]; then
     echo " default value of -c option is \$CFILE"
  fi

  exit 1
}

while getopts 'hc:e:' OPT
do
  case \$OPT in
    h) 
	usage
	;;
    e)
	EXE=\$OPTARG
	;;
    c)
	CFILE=\$OPTARG
	;;
   esac
done

if [ ! -f \$CFILE ]; then
  echo "Please provide core file as argument"
  exit 1
fi

if [ ! -f \$EXE ]; then
  echo "Please provide executable file as argument"
  exit 1
fi

has_dbg_info=`objdump --section-headers \$EXE | grep -F '.debug' | wc -l`
if [ "x\$has_dbg_info" = "x0" ]; then
  cat <<EOF
The executable \$EXE has no debug information.
Please replace the executable with the same version that includes debug info
EOF
  exit 1
fi

cat >gdb_script <<EOF
set solib-absolute-prefix .
core-file \$CFILE
EOF

gdb -x gdb_script \$EXE
  
EOFS
;


  close(OF);
  run("chmod +x $sf");
}

sub get_dependent_libs
{
  my $exe_file = shift;
  my (@ret,$line,$txt);
   
  $txt = `ldd $exe_file`;
   
  foreach $line (split('\n',$txt)) {
  
    my $file;
    my @tokens = split(' ',$line);
    if (index($line,"=>") != -1) {
      $file = $tokens[2];
    } else {
      $file = $tokens[1];
    }
    if (-f $file) {
      push(@ret,$file);
    }
  }
  return @ret;
}

sub get_dyn_libs
{
  my $exe_file = shift;
  my $core_file = shift;
  my (@ret,$line,$txt, $start);
   
  $txt = `gdb --batch $exe_file $core_file -ex "info sharedlibrary"`;
  $start = 0;
  foreach $line (split('\n',$txt)) {
  
    my $file;
    if(!$start) {
      if (index($line,"From") != -1) {
        $start = 1;
      }
    }
    else {

      $line =~ s/^\s+//;
      $line =~ s/\s+$//;

      if (($line =~ /^No/)) {
        #ignore ..
      }
      else {
        my @tokens = split('  ',$line, 4);

        $tokens[3] =~ s/^\s+//;
        $tokens[3] =~ s/\s+$//;
        print "$tokens[3]\n";
          if (-f $tokens[3]) {
            push(@ret,$tokens[3]);
          }
      }
    }
  }
  return @ret;
  
}

sub run
{
  my $args = shift;

  print "Running: $args\n" if ($VERBOSE);

  my $f = `$args`;

  if ($? != 0) {
    print "Error: running $args failed.";
    exit(1);
  }

  return $f;

}
sub get_base_dir
{
  my $f = shift;
  my $idx = rindex($f,"/");
  return $idx != -1 ? substr($f,0,$idx) : $f;
}

sub get_base_name
{
  my $f = shift;
  my $idx = rindex($f,"/");
  return $idx != -1 ? substr($f,$idx+1) : $f;
}


sub print_usage
{
  my $msg = shift;

  if ($msg ne "") {
    print "Error: $msg\n\n";
  }
  print <<EOF
gather-libs -e <exe-path> [-c <core-file>] [-n] -o <output-tar-file>

Parameters
 -c <core-file>		- core file (optional)
 -e <exe-path>		- path of executable that produced core file
 -o <output-tar-file>	- output archive file.
 -n			- don't copy executable, only shared libs (optional)

the <output-tar-file> will contain following data
 - copy of <exe-path> (unless -n is specified)
 - copy of all dependent shared libraries of <exe-path>
 - copy of <core-file> (if specified by -c option)
 - script that runs gdb so that gdb is looking at 
   copied shared libraries + using the copied cores/executables.


The tar file is compressed with bz2 compression, so in order to extract the archive run

tar xvfj <output-tar-file>

This program is useful if we want to examine a core file of an executable on a remote machine.
It is assumed that the core file has been caused by running <executable-file-path>


EOF
;
exit(1);

}


# ----------------------------------------------------------------------------
sub sgetopt
{
   my $opts = shift;
   my $resref = shift;
   my ($i,$argval,$optval,$has_value);

   for($i=0; $i < scalar(@ARGV) ;  ) {
      $argval = $ARGV[ $i++ ];
      next if (! substr($argval,0,1) eq "-" && length($argval) == 2);
      $argval = substr($argval,1);
      $has_value = 0;
      foreach $optval (@{ $opts }) {
	   if ($argval eq substr($optval,0,1)) {
	      $has_value = 1;
	      if (index($optval,':') != -1) {
		 if ($i >=  scalar(@ARGV)) {
	           print "ERROR: option -$argval must have a value\n";
		   exit(1);
		 }
		 $has_value = 1;
	         ${ $resref } { $argval } = $ARGV[ $i ++ ];
	      } else {
                 ${ $resref } { $argval } = 1;
	      }
	   }
       }
       if (! $has_value) {
	 print "ERROR: Command line option -$argval is not defined\n";
	 exit(1);
       }
   }
}