diff options
Diffstat (limited to 'lib/OpenSLX/LibScanner.pm')
-rw-r--r-- | lib/OpenSLX/LibScanner.pm | 262 |
1 files changed, 0 insertions, 262 deletions
diff --git a/lib/OpenSLX/LibScanner.pm b/lib/OpenSLX/LibScanner.pm deleted file mode 100644 index e1f42ba4..00000000 --- a/lib/OpenSLX/LibScanner.pm +++ /dev/null @@ -1,262 +0,0 @@ -# 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; |