# Copyright (c) 2006-2008 - OpenSLX GmbH
#
# This program is free software distributed under the GPL version 2.
# See http://openslx.org/COPYING
#
# If you have any feedback please consult http://openslx.org/feedback and
# send your suggestions, praise, or complaints to feedback@openslx.org
#
# General information about OpenSLX can be found at http://openslx.org/
# -----------------------------------------------------------------------------
# LibScanner.pm
#    - module that recursively scans a given binary for library dependencies
# -----------------------------------------------------------------------------
package OpenSLX::LibScanner;

use strict;
use warnings;

use File::Find;
use File::Path;

use OpenSLX::Basics;
use OpenSLX::Utils;

################################################################################
### interface methods
################################################################################
sub new
{
    my $class  = shift;
    my $params = shift || {};

    checkParams($params, { 
        'root-path' => '!',
        'verbose'   => '?',
    } );

    my $self = {
        rootPath => $params->{'root-path'},
        verbose  => $params->{'verbose'} || 0,
    };

    return bless $self, $class;
}

sub determineRequiredLibs
{
    my $self     = shift;
    my @binaries = @_;

    $self->{filesToDo}  = [];
    $self->{libs}       = [];
    $self->{libInfo}    = {};

    $self->_fetchLoaderConfig();
    
    foreach my $binary (@binaries) {
        if (substr($binary, 0, 1) ne '/') {
            # force relative paths relative to $rootPath:
            $binary = "$self->{rootPath}/$binary";
        }
        if (!-e $binary) {
            warn _tr("$0: unable to find file '%s', skipping it\n", $binary);
            next;
        }
        push @{$self->{filesToDo}}, $binary;
    }
    
    foreach my $file (@{$self->{filesToDo}}) {
        $self->_addLibsForBinary($file);
    }

    return @{$self->{libs}};
}

sub _fetchLoaderConfig
{
    my $self = shift;

    my @libFolders;

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

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

    # add lib32-folders for 64-bit Debians, as they do not
    # refer those in ld.so.conf (which I find strange...)
    if (-e '/lib32' && !grep { m[^$self->{rootPath}/lib32$] } @libFolders) {
        push @libFolders, "$self->{rootPath}/lib32";
    }
    if (-e '/usr/lib32'
        && !grep { m[^$self->{rootPath}/usr/lib32$] } @libFolders)
    {
        push @libFolders, "$self->{rootPath}/usr/lib32";
    }

    push @{$self->{libFolders}}, @libFolders;

    return;
}

sub _fetchLoaderConfigFile
{
    my $self       = shift;
    my $ldConfFile = shift;

    return unless -e $ldConfFile;
    my $ldconfFH;
    if (!open($ldconfFH, '<', $ldConfFile)) {
        warn(_tr("unable to open file '%s' (%s)", $ldConfFile, $!));
        return;
    }
    while (<$ldconfFH>) {
        chomp;
        if (m{^\s*include\s+(.+?)\s*$}i) {
            my @incFiles = glob("$self->{rootPath}$1");
            foreach my $incFile (@incFiles) {
                if ($incFile) {
                    $self->_fetchLoaderConfigFile($incFile);
                }
            }
            next;
        }
        if (m{\S+}i) {
            s[=.+][];
            # remove any lib-type specifications (e.g. '=libc5')
            push @{$self->{libFolders}}, "$self->{rootPath}$_";
        }
    }
    close $ldconfFH
        or die(_tr("unable to close file '%s' (%s)", $ldConfFile, $!));
    return;
}

sub _addLibsForBinary
{
    my $self   = shift;
    my $binary = shift;

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

    # fetch file info again, this time without '--mime' in order to get the architecture
    # bitwidth:
    $fileInfo = `file --dereference --brief $binary 2>/dev/null`;
    if ($?) {
        die _tr("unable to fetch file info for '%s', giving up!\n", $binary);
    }
    chomp $fileInfo;
    warn _tr("\tinfo is: '%s'...\n", $fileInfo) if $self->{verbose};
    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...
    warn _tr("\ttrying objdump...\n") if $self->{verbose};
    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;
            warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose};
        }
        while ($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) {
            $self->_addLib($1, $bitwidth, $rpath);
        }
    } else {
        # ...objdump failed, so we try readelf instead:
        warn _tr("\ttrying readelf...\n") if $self->{verbose};
        $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;
            warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose};
        }
        while ($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) {
            $self->_addLib($1, $bitwidth, $rpath);
        }
    }
    return;
}

sub _addLib
{
    my $self     = shift;
    my $lib      = shift;
    my $bitwidth = shift;
    my $rpath    = shift;

    if (!exists $self->{libInfo}->{$lib}) {
        my $libPath;
        my @folders = @{$self->{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 --brief $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 $self->{verbose};
                    next;
                }
                $libPath = "$folder/$lib";
                last;
            }
        }
        if (!defined $libPath) {
            die _tr("unable to find lib %s!\n", $lib);
        }
        print "found $libPath\n" if $self->{verbose};
        push @{$self->{libs}}, $libPath;
        $self->{libInfo}->{$lib} = 1;
        push @{$self->{filesToDo}}, $libPath;
    }
    return;
}

1;