* moved functionality of slxldd into a module (LibScanner),

  such that it can be used by other programs, too
* slxldd is now just a wrapper for the LibScanner module


git-svn-id: http://svn.openslx.org/svn/openslx/trunk@1483 95ad53e4-c205-0410-b2fa-d234c58c8868

2 files changed, 269 insertions, 206 deletions

diff --git a/bin/slxldd b/bin/slxldd
index 5c59c093..62bd4752 100755
--- a/bin/slxldd
+++ b/bin/slxldd
@@ -35,6 +35,7 @@ use Getopt::Long;
 use Pod::Usage;
 
 use OpenSLX::Basics;
+use OpenSLX::LibScanner;
 
 my (
 	$helpReq,
@@ -44,11 +45,6 @@ my (
 	$rootPath,
 	$versionReq,
 
-	@filesToDo,
-
-	@libFolders,
-	@libs,
-	%libInfo,
 );
 
 $rootPath = '/';
@@ -82,208 +78,13 @@ if (!@ARGV) {
 	pod2usage(2);
 }
 
-fetchLoaderConfig();
-
-foreach my $file (@ARGV) {
-	if (substr($file, 0, 1) ne '/') {
-		# force relative paths 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;
-
-	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("$rootPath$1");
-			foreach my $incFile (@incFiles) {
-				if ($incFile) {
-					fetchLoaderConfigFile($incFile);
-				}
-			}
-			next;
-		}
-		if (m{\S+}i) {
-			s[=.+][];
-			# remove any lib-type specifications (e.g. '=libc5')
-			push @libFolders, "$rootPath$_";
-		}
-	}
-	close $ldconfFH
-		or die(_tr("unable to close file '%s' (%s)", $ldConfFile, $!));
-	return;
-}
+my $libScanner = OpenSLX::LibScanner->new({
+	'root-path' => $rootPath,
+	'verbose'   => $verbose,
+});
 
-sub fetchLoaderConfig
-{
-	if (!-e "$rootPath/etc") {
-		die _tr("'%s'-folder not found, maybe wrong root-path?\n",
-			"$rootPath/etc");
-	}
-	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";
-	}
-
-	# 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[^$rootPath/lib32$] } @libFolders) {
-		push @libFolders, "$rootPath/lib32";
-	}
-	if (-e '/usr/lib32'
-		&& !grep { m[^$rootPath/usr/lib32$] } @libFolders)
-	{
-		push @libFolders, "$rootPath/usr/lib32";
-	}
-	return;
-}
-
-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 --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 $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;
-	}
-	return;
-}
-
-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`;
-	if ($?) {
-		die _tr("unable to fetch file info for '%s', giving up!\n", $binary);
-	}
-	chomp $fileInfo;
-	print STDERR _tr("\tinfo is: '%s'...\n", $fileInfo) if $verbose;
-	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;
-	}
-
-	# 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;
-	print STDERR _tr("\tinfo is: '%s'...\n", $fileInfo) if $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...
-	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);
-		}
-	}
-	return;
-}
+my @libs = $libScanner->determineRequiredLibs(@ARGV);
+print join("\n", @libs), "\n";
 
 =head1 NAME
 
diff --git a/initramfs/OpenSLX/LibScanner.pm b/initramfs/OpenSLX/LibScanner.pm
new file mode 100644
index 00000000..c5cef34a
--- /dev/null
+++ b/initramfs/OpenSLX/LibScanner.pm
@@ -0,0 +1,262 @@
+# 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";
+	}
+
+	$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;