#!/usr/bin/perl
#
# Emulation of the linux 'ldd' on IRIX
# Ariel Faigon <ariel@engr.sgi.com>
#
# Linux output example
# % ldd /usr/local/netscape/netscape
#	libBrokenLocale.so.1 => /lib/libBrokenLocale.so.1 (0x40010000)
#	libXt.so.6 => /usr/X11R6/lib/libXt.so.6 (0x40012000)
#	libSM.so.6 => /usr/X11R6/lib/libSM.so.6 (0x4005a000)
#	libICE.so.6 => /usr/X11R6/lib/libICE.so.6 (0x40065000)
#	libXmu.so.6 => /usr/X11R6/lib/libXmu.so.6 (0x4007a000)
#	libXpm.so.4 => /usr/X11R6/lib/libXpm.so.4 (0x4008c000)
#	libXext.so.6 => /usr/X11R6/lib/libXext.so.6 (0x4009a000)
#	libX11.so.6 => /usr/X11R6/lib/libX11.so.6 (0x400a6000)
#	libdl.so.2 => /lib/libdl.so.2 (0x4014a000)
#	libc.so.6 => /lib/libc.so.6 (0x4014d000)
#	libg++.so.2.7.2 => /usr/lib/libg++.so.2.7.2 (0x401f2000)
#	libstdc++.so.2.7.2 => /usr/lib/libstdc++.so.2.7.2 (0x4022a000)
#	libm.so.6 => /lib/libm.so.6 (0x40267000)
#	/lib/ld-linux.so.2 => /lib/ld-linux.so.2 (0x40000000)
#
# From the IRIX 'man dso'
#
#    11) Where does the system look for shared objects at runtime?
#
#	The search path for shared objects is acquired in the following
#	order for the old 32bit ABI:
#
#	1) the path of the shared object if given in the liblist,
#
#	2) in any directories specified via the -rpath flag when the
#	   executable was built
#
#	3) in any directory specified by the LD_LIBRARY_PATH environment
#	     variable, if it is defined
#
#	4) in the directories in the default path
#	     (/usr/lib:/lib:/lib/cc:/usr/lib/cc)
#
#	If the _RLD_ROOT environment variable is defined, then its value is
#	appended to the front of any path specified by -rpath and the default
#	path.  _RLD_ROOT itself is also a colon(:) separated list.
#
#	For the new 32bit ABI the rules are similar, but the following
#	differences exist:  1)  the LD_LIBRARYN32_PATH is used if defined,
#	otherwise LD_LIBRARY_PATH is used 2) _RLDN32_ROOT is used for the
#	list of paths 3) The default path list is (/usr/lib32:/lib32).
#
#	For the 64bit ABI the rules are similar, but the following differences
#	exist:  1) The LD_LIBRARY64_PATH is used if defined, otherwise
#	LD_LIBRARY_PATH is used 2) _RLD64_ROOT is used for the list of paths
#	3) The default path list is (/usr/lib64:/lib64).
#
#	See the rld(1) manpage for details.
#	Also note: _RLD_LIST _RLDN32_LIST _RLD64_LIST
#
use Getopt::Std;

$ELFdump = '/bin/elfdump';

%rld_list_vars = (
	'o32' => '_RLD_LIST',
	'n32' => '_RLDN32_LIST',
	'n64' => '_RLD64_LIST',
);

%rld_root_vars = (
	'o32' => '_RLD_ROOT',
	'n32' => '_RLDN32_ROOT',
	'n64' => '_RLD64_ROOT',
);

%ld_library_path_vars = (
	'o32' => 'LD_LIBRARY_PATH',
	'n32' => 'LD_LIBRARYN32_PATH',
	'n64' => 'LD_LIBRARY64_PATH',
);

%default_rpath = (
	'o32' => [ '/usr/lib', '/lib', '/lib/cc', '/usr/lib/cc' ],
	'n32' => [ '/usr/lib32', '/lib32' ],
	'n64' => [ '/usr/lib64', '/lib64' ],
);

sub rld_roots($) {
    my ($ev, $val, @roots);

    $ev = $rld_root_vars{$abi};
    if ($val = $ENV{$ev}) {
	warn "$0: $ev='$val': affects the search path. See 'man dso'.\n";
	foreach $dir (split(':', $val)) {
	    if (-d $dir) {
		push(@roots, $dir);
	    } else {
		warn "\t$0 warning: $ev: $dir: no such dir.\n\n";
	    }
	}
    }
    @roots;
}

sub env_paths($$) {
    my ($abi, $arch) = @_;
    my ($oev, $ev, $oval, $val, @rpath, @tmp, $dir);

    $ev = $rld_list_vars{$abi};
    if ($val = $ENV{$ev}) {
	warn "$0: $ev='$val': affects the search path. See 'man dso'.\n";
	@tmp = split(':', $val);
    }

    $ev = $ld_library_path_vars{$abi};
    if ($val = $ENV{$ev}) {
	warn "$0: $ev='$val': affects the search path. See 'man dso'.\n";
	push(@tmp, split(':', $val));
    }

    #
    # special cases:
    #
    $oev = 'LD_LIBRARY_PATH';
    $ev = $ld_library_path_vars{$abi};
    if ($abi ne 'o32' && $ENV{$oev} && ! $ENV{$ev}) {
	$oval = $ENV{$oev};
	$val = $ENV{$ev};
	warn "\t$0 warning: $abi executable run with:\n",
		"\t\t$oev='$oval'\n",
		"\t\t$ev=(undef)\n",
		"\tThis is probably *not* what you want.  See 'man dso'.\n\n";
	push(@tmp, $val);
    }
    for $dir (@tmp) {
	if (-d $dir) {
	    if (-d "$dir/$arch") {
		push(@rpath, "$dir/$arch");
	    }
	    push(@rpath, $dir);
	} else {
	    warn "\t$0 warning: $dir: no such dir.\n\n";
	}
    }
    @rpath;
}

sub abi_arch($) {
    my ($file) = @_;
    my ($abi, $arch, $fileo);

    $fileo = `/bin/file $file`;
    $fileo =~ s,^[^:]+:\s*,,;
    chop($fileo);
    die "$0: $file is not an ELF object file ($fileo)\n" if ($fileo !~ /^ELF/);
    $abi = ($fileo =~ /N32/) ? 'n32' : ($fileo =~ /64/) ? 'n64' : 'o32';
    ($arch) = ($fileo =~ /(mips-\d+)/);
    $arch =~ tr,-,,d;
    ($abi, $arch, $fileo);
}

sub lib_list($) {
    my ($file) = @_;
    my (@liblist, $lib);

    open(ED, "$ELFdump -Dl $file |");
    while (<ED>) {
	next unless (/^\[\d+\]/);
	$lib = (split(" ", $_))[7];
	push(@liblist, $lib);
    }
    warn "\tliblist:\t@liblist\n" if ($opt_v);
    close(ED);
    @liblist;
}

sub file_rpath($$$@) {
    my ($file, $abi, $arch, @roots) = @_;
    my (@rpath, $rpath, $path, @paths, $dir);

    # elfdump -L /usr/freeware/bin/perl | grep  RPATH
    # [29]    RPATH       /usr/freeware/lib/perl5/5.00502/irix-n32/CORE

    @roots = ('') unless (@roots);
    open(ED, "$ELFdump -L $file |");
    while (<ED>) {
	# warn "file_rpath $_";
	next unless (/^\[\d+\]\s+RPATH\s+/);
	chop($rpath = $');
	# warn "file_rpath $rpath\n";
	@paths = split(':', $rpath);

	foreach $root (@roots) {
	    for $path (@paths) {
		if (-d "$root$path/$arch") {
		    push (@rpath, "$root$path/$arch");
		}

		if (-d "$root$path") {
		    push (@rpath, "$root$path");
		} else {
		    warn "\t$0 warning: $root$path: no such dir.\n\n";
		}
	    }
	}
    }
    close(ED);
    # warn "file_rpath returns: @rpath\n";
    @rpath;
}

sub default_rpath($$@) {
    my ($abi, $arch, @roots) = @_;
    my (@rpath, $root, $path);

    @roots = ('') unless (@roots);
    foreach $root (@roots) {
	foreach $path (@{$default_rpath{$abi}}) {
	    if (-d "$root$path/$arch") {
		push (@rpath, "$root$path/$arch");
	    }
	    if (-d "$root$path") {
		push (@rpath, "$root$path");
	    }
	}
    }
    @rpath;
}

sub ldd($$) {
    my ($pathlist_ref, $liblist_ref) = @_;
    my ($lib, $dir, $fullpath);

    die "$0 requires $ELFdump which is missing from your system\n"
	unless (-x $ELFdump);

    LIB:
    foreach $lib (@$liblist_ref) {
	next unless ($lib);
	printf "\t%s => ", $lib;
	foreach $dir (@$pathlist_ref) {
	    next unless ($dir);
	    $fullpath = "$dir/$lib";
	    if (-e $fullpath) {
		print "$fullpath\n";
		next LIB;
	    }
	}
	print "[not found!]\n";
    }
}


sub do_file($) {
    my ($file) = @_;
    my ($abi, $arch, $type,
	@roots, @env_paths, @liblist, @search_path, @file_rpath);

    warn "$file:\n" if ($opt_v);
    ($abi, $arch, $type) = abi_arch($file);

    warn "\tfile-type:\t$type\n" if ($opt_v);
    warn "\tabi/arch:\t$abi/$arch\n" if ($opt_v);

    @liblist	= lib_list($file);
    @roots	= rld_roots($abi);
    @env_paths	= env_paths($abi, $arch);
    @file_rpath	= file_rpath($file, $abi, $arch, @roots);

    push (@search_path, @env_paths) unless (-u $file);
    push (@search_path, @file_rpath);
    push (@search_path, default_rpath($abi, $arch, @roots));

    warn "\trpath:\t\t@file_rpath\n" if (@file_rpath && $opt_v);
    warn "\tsearch-path:\t@search_path\n\n" if ($opt_v);

    ldd(\@search_path, \@liblist);
}

# --- main ---
$0 =~ s,.*/,,;

getopts('v') || die "Usage: $0 [-v] object-file\n";
$ARGV[0] || die "Usage: $0 [-v] object-file\n";
(-e $ARGV[0]) || die "$0: $ARGV[0]: $!\n";

do_file($ARGV[0]);

__END__