#! /usr/bin/perl
#
# slxldd - OpenSLX-rewrite of ldd that works on multiple architectures.
#
# (c) 2006 - OpenSLX.com
#
# Oliver Tappe <ot@openslx.com>
#
use strict;

my $abstract = q[
slxldd
    This script reimplements ldd in a way that should work for all
    binary formats supported by the binutils installed on the host system.

    An example: if you have a folder containing an ia64 system, you can
    invoke this script on a ia32-host in order to determine all the libraries
    required by a binary of the ia64 target system.
];

use File::Glob ':globally';
use Getopt::Long;
use Pod::Usage;

# add the lib-folder to perl's search path for modules:
use FindBin;
use lib "$FindBin::RealBin/../lib";

use OpenSLX::Basics;

my (
	$helpReq,
	$manReq,
	$verbose,

	$rootPath,
	$versionReq,

	@filesToDo,

	@libFolders,
	@libs,
	%libInfo,
);

$rootPath = '/';
GetOptions(
	'help|?' => \$helpReq,
	'man' => \$manReq,
	'root-path=s' => \$rootPath,
	'verbose' => \$verbose,
	'version' => \$versionReq,
) or pod2usage(2);
pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq;
pod2usage(-verbose => 2) if $manReq;
if ($versionReq) {
	system('slxversion');
	exit 1;
}

openslxInit();

if (!$rootPath) {
	print STDERR _tr("You need to specify the root-path!\n");
	pod2usage(2);
}

$rootPath =~ s[/+$][];
	# remove trailing slashes

if (!@ARGV) {
	print STDERR _tr("You need to specify at least one file!\n");
	pod2usage(2);
}

fetchLoaderConfig();

foreach my $file (@ARGV) {
	if ($file =~ m[^/]) {
		# force absolute path relative to $rootPath:
		$file = "$rootPath$file";
	}
	if (!-e $file) {
		print STDERR _tr("slxldd: unable to find file '%s', skipping it\n", $file);
		next;
	}
	push @filesToDo, $file;
}

foreach my $file (@filesToDo) {
	addLibsForBinary($file);
}

sub fetchLoaderConfigFile
{
	my $ldConfFile = shift;

	open(LDCONF, "< $ldConfFile");
	while(<LDCONF>) {
		chomp;
		if (/^\s*include\s+(.+?)\s*$/i) {
			foreach my $incFile (<$rootPath$1>) {
				fetchLoaderConfigFile($incFile);
			}
			next;
		}
		if (/\S+/i) {
			s[=.+][];
				# remove any lib-type specifications (e.g. '=libc5')
			push @libFolders, "$rootPath$_";
		}
	}
	close LDCONF;
}

sub fetchLoaderConfig
{
	if (!-e "$rootPath/etc/ld.so.conf") {
		die _tr("'%s' not found, maybe wrong root-path?\n", $rootPath/etc/ld.so.conf);
	}
	fetchLoaderConfigFile("$rootPath/etc/ld.so.conf");

	# add "trusted" folders /lib and /usr/lib if not already in place:
	if (!grep { m[^$rootPath/lib$]}  @libFolders) {
		push @libFolders, "$rootPath/lib";
	}
	if (!grep { m[^$rootPath/usr/lib$] } @libFolders) {
		push @libFolders, "$rootPath/usr/lib";
	}
}

sub addLib
{
	my $lib = shift;
	my $bitwidth = shift;
	my $rpath = shift;

	if (!exists $libInfo{$lib}) {
		push @libs, $lib;
		my $libPath;
		my @folders = @libFolders;
		if (defined $rpath) {
			# add rpath if given (explicit paths set during link stage)
			push @folders, split ':', $rpath;
		}
		foreach my $folder (@folders) {
			if (-e "$folder/$lib") {
				# have library matching name, now check if the platform is ok, too:
				my $libFileInfo = `file --dereference $folder/$lib 2>/dev/null`;
				if ($?) {
					die _tr("unable to fetch file info for '%s', giving up!\n",
							$folder/$lib);
				}
				my $libBitwidth = ($libFileInfo =~ m[64-bit]i) ? 64 : 32;
				if ($bitwidth != $libBitwidth) {
					vlog 0, _tr('%s has wrong bitwidth (%s instead of %s)',
						      "$folder/$lib", $libBitwidth, $bitwidth) if $verbose;
					next;
				}
				$libPath = "$folder/$lib";
				last;
			}
		}
		if (!defined $libPath) {
			die _tr("*** unable to find lib %s! ***\n", $lib);
		}
		print "$libPath\n";
		$libInfo{$lib} = $libPath;
		push @filesToDo, $libPath;
	}
}

sub addLibsForBinary
{
	my $binary = shift;

	# first do some checks:
	print STDERR _tr("analyzing '%s'...\n", $binary) if $verbose;
	my $fileInfo = `file --dereference --brief --mime $binary 2>/dev/null`;
	chomp $fileInfo;
	print STDERR _tr("\tinfo is: '%s'...\n", $fileInfo) if $verbose;
	if ($?) {
		die _tr("unable to fetch file info for $binary, giving up!\n");
	}
	if ($fileInfo !~ m[^application/(x-executable|x-shared)]i) {
		# ignore anything that's not an executable or a shared library
		print STDERR _tr("%s: ignored, as it isn't an executable or a shared library\n", $binary);
		next;
	}

	my $bitwidth = ($fileInfo =~ m[64-bit]i) ? 64 : 32;
		# determine whether binary is 32- or 64-bit platform

	# now find out about needed libs, we first try objdump...
	if ($verbose) {
		print STDERR _tr("\ttrying objdump...\n");
	}
	my $res = `objdump -p $binary 2>/dev/null`;
	if (!$?) {
		# find out if rpath is set for binary:
		my $rpath;
		if ($res =~ m[^\s*RPATH\s*(\S+)]im) {
			$rpath = $1;
			if ($verbose) {
				print STDERR _tr("\trpath='%s'\n", $rpath);
			}
		}
		while($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) {
			addLib($1, $bitwidth, $rpath);
		}
	} else {
		# ...objdump failed, so we try readelf instead:
		if ($verbose) {
			print STDERR _tr("\ttrying readelf...\n");
		}
		$res = `readelf -d $binary 2>/dev/null`;
		if ($?) {
			die _tr("neither objdump nor readelf seems to be installed, giving up!\n");
		}
		# find out if rpath is set for binary:
		my $rpath;
		if ($res =~ m/Library\s*rpath:\s*\[([^\]]+)/im) {
			$rpath = $1;
			if ($verbose) {
				print STDERR _tr("\trpath='%s'\n", $rpath);
			}
		}
		while($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) {
			addLib($1, $bitwidth, $rpath);
		}
	}
}


__END__

=head1 NAME

slxldd - OpenSLX-script to determine the libraries required by any given
binary file.

=head1 SYNOPSIS

slxldd [options] file [...more files]

  Options:
      --help                   brief help message
      --man                    show full documentation
      --root-path=<string>     path to the root folder for library search
      --verbose                show what's going on during execution
      --version                show version

=head1 OPTIONS

=over 8

=item B<--help>

Prints a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--root-path=<string>>

Sets the root folder that is used when searching for libraries. In order to
collect the loader-settings, etc/ld.so.conf is read relative to this path and
all libraries are sought relative to this path, too (a.k.a. a virtual chroot).

Defaults to '/'.

=item B<--verbose>

Prints info about the files as they are being scanned.

=item B<--version>

Prints the version and exits.

=back

=cut