#!/usr/bin/perl

# a perl implemenation of ldd.
# usage:  ldd [-v] file ...
# where 'file' can be an executable or DSO.
# where -v gives the pathname of the file causing a given DSO to be 
# 'loaded', turning the output into line pairs.
# The format is an attempt to follow the Solaris ldd format.

#Script by Bob Mende, mende@sgi.com
#Significant modifications by David Anderson, 
# davea@sgi.com, so don't blame
# Bob for the not-so-great perl code I added.
#
#This script is completely unsupported.
#This script is only an approximation of what rld(1) does
#(for most cases it seems to be an adequate approximation).
#This script is provided in hopes it is useful.
#
# Fixed to work on IRIX 5.3 by Dave Erickson
#
# $Id: pldd.txt,v 1.11 1998/11/17 19:00:07 davea Exp $


#     The search path for shared objects is acquired in the following order:
#
#     1.   The path of the shared object if given in the liblist,
#          (i.e., if the soname of the shared object has a path (see ld(1));
#
#     2.   RPATH if it is defined in the main executable,
#          (via the -rpath switch to ld(1) when the executable is created);
#
#     3.   Use LD_LIBRARY_PATH if defined in the environment at
#          the time of execution;
#
#   Security also dictates that rld should not allow library replacement for
#     setuid and setgid programs unless the user is root.
#
#     4.   The default library search path.

# comment by davea@sgi.com
# The MIPS ABI says that RPATH directories accumulate (add to the
# list of directories) rather than just saying to take the
# executable RPATH.   The MIPS ABI is available from 
# http://www.mipsabi.org till March 1, 1999
#
# For  n32 and 64 there is a primary env var,
# LD_LIBRARYN32_PATH LD_LIBRARY64_PATH to use which
# overrides LD_LIBRARY_PATH (done, see below)
#
# To determine which ABI the base executable or base named DSO is,
# use elfdump -f: 64-bit in the output means is -64.
# 32-bit in the output means n32 or o32.
# MIPS3 or MIPS4 means n32 (else, if 32-bit is o32).
# (done, see below).
# 
# This should obey _RLD*_ROOT environment variables too.
#


sub ldd {
    my ($file) = @_;
#
#	we build and use @libs1 and @libs2 arrays in parallel.
    my (@DEF_PATH, @libs1,@libs2, @LD_PATH, $lib,$libpath, $libdir);
    my ($OLIB, $TLIB);
    my (%libs);
    
    $ABI = 1 ;
    $MIPS = 1;
    if (-e $file && open (ELF, "elfdump -f $file 2>&1|")) {
	while (<ELF>) {
	    if (/MIPS3/) {
		$MIPS = 3;
	    } elsif (/MIPS4/) {
		$MIPS = 4;
	    } elsif (/32-bit/) {
		$ABI = 1
	    } elsif (/64-bit/) {
		$ABI = 3
	    }
        }
	close (ELF);
    }
    if( $ABI == 1 && ( $MIPS == 3 || $MIPS == 4 ) ) {
	$ABI = 2;
    }
    if ($ABI == 1) {
       @DEFAULT_LD_PATH=("/usr/lib", "/usr/lib/internal", 
		"/lib", "/lib/cmplrs/cc", "/usr/lib/cmplrs/cc", "/opt/lib");

    } elsif ( $ABI == 2) {
       @DEFAULT_LD_PATH=("/usr/lib32","/usr/lib32/internal",
			"/lib32","/opt/lib32");
    } else {
       @DEFAULT_LD_PATH=("/usr/lib64","/usr/lib64/internal",
			"/lib64","/opt/lib64");
    }
    @DEF_PATH=@DEFAULT_LD_PATH;
    $ELFDUMP = "elfdump -i -L";
    $index = 2;
    $sysstat = system ("$ELFDUMP $file > /dev/null");
    if ($sysstat) {
#       didn't work with -i try 5.3, with has no -i option
        $ELFDUMP = "elfdump -L";
        $index = 1;
    }

    if (-e $file && open (ELF, "$ELFDUMP $file 2>&1|")) {
	while (<ELF>) {
	    if (/NEEDED/) {
		push(@libs1,$file);
		push(@libs2,(split)[$index]);
		$libs{(split)[$index]}=1;
	    } elsif (/RPATH/) {
		push(@LD_PATH,(split)[$index]);
	    }
	}
	close (ELF);

	if (!((-u _ || -g _) && $> != 0)) {
    	  if ($ABI == 1) {
	    push(@LD_PATH,split(":",$ENV{LD_LIBRARY_PATH}));
	  
    	  } elsif ( $ABI == 2) {
	    if ( $ENV{LD_LIBRARYN32_PATH} ) {
	     push(@LD_PATH,split(":",$ENV{LD_LIBRARYN32_PATH}));
	    }  else {
	     push(@LD_PATH,split(":",$ENV{LD_LIBRARY_PATH}));
	    }
    	  } else {
	    if ( $ENV{LD_LIBRARY64_PATH} ) {
	     push(@LD_PATH,split(":",$ENV{LD_LIBRARY64_PATH}));
	    }  else {
	     push(@LD_PATH,split(":",$ENV{LD_LIBRARY_PATH}));
	    }
    	  }

	    
	}

	push (@LD_PATH,@DEF_PATH);
	for( $i = 0; $i < @libs2; $i++) {
	    $OLIB = @libs1[$i];
	    $TLIB = @libs2[$i];
	    @LDPATH = @LD_PATH;
	    if ($reqlibs{$TLIB}) {
		($junk, @libpaths) = split(':',$LD_REQ{$TLIB});
		foreach $libpaths (@libpaths) {
		    if ($RPATH{$libpaths}) {
			($junk, @rpaths) = split(':', $RPATH{$libpaths});
			push(@LDPATH,@rpaths);
		    }
		}
	    }
	    if ($TLIB =~ /^\//) {
		$libpath=$TLIB;
		$TLIB =~ s/^.*\/([^\/]*)/$1/;
	    } else {
		$libpath = "can not find $TLIB in " . join(":",@LD_PATH);
		foreach $libdir (@LDPATH) {
		    @libpath=glob("${libdir}/${TLIB}*");
		    if (@libpath) {
			$libpath=$libpath[0];
			open (ELF, "elfdump -L $libpath 2>&1|");
			while(<ELF>) {
			    if (/NEEDED/) {
				if (!$libs{(split)[$index]}) {
				    push(@libs1,$libpath);
				    push(@libs2,(split)[$index]);
				    $libs{(split)[$index]}=1;
				    $reqlibs{(split)[$index]} .= ":" . $libpath;
				}
			    } elsif (/RPATH/) {
				$RPATH{$libpath} .= ":" . (split)[$index];
			    }
			}
			close (ELF);
			last;
		    }
		}
	    }
	    # First is the more useful form
	    #print "\t$OLIB =>\t $libpath\n";
	    # second is the more standard form
            if ($verbose eq "Y") {
	      print "   find $TLIB; required by $OLIB \n";
	    }
	    print "\t$TLIB =>\t $libpath\n";
	}
    } else {
	print "\tFailed read elf header.\n";
	$exit++;
    }
}

$verbose= "N";
$ct = 0;
foreach $file (@ARGV) {
    if ($file eq "-v") {
	$verbose = "Y";
	next;
    }
    if ($ARGV[1]) {
	$ct++;
    }
}
foreach $file (@ARGV) {
    if ($file eq "-v") {
	$verbose = "Y";
	next;
    }
    if ($ct > 1) {
	print "$file:\n";
    }
    ldd ($file);
}
exit ($exit);