home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Dpkg / Shlibs.pm < prev    next >
Encoding:
Perl POD Document  |  2012-09-17  |  3.7 KB  |  129 lines
  1. # Copyright ┬⌐ 2007 Rapha├½l Hertzog <hertzog@debian.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 2 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15.  
  16. package Dpkg::Shlibs;
  17.  
  18. use strict;
  19. use warnings;
  20.  
  21. our $VERSION = "0.01";
  22.  
  23. use base qw(Exporter);
  24. our @EXPORT_OK = qw(@librarypaths find_library);
  25.  
  26. use File::Spec;
  27.  
  28. use Dpkg::Gettext;
  29. use Dpkg::ErrorHandling;
  30. use Dpkg::Shlibs::Objdump;
  31. use Dpkg::Path qw(resolve_symlink canonpath);
  32. use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch);
  33.  
  34. use constant DEFAULT_LIBRARY_PATH =>
  35.     qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
  36.        /emul/ia32-linux/lib /emul/ia32-linux/usr/lib);
  37.  
  38. # Adjust set of directories to consider when we're in a situation of a
  39. # cross-build or a build of a cross-compiler
  40. my @crosslibrarypaths;
  41. my $crossprefix;
  42. # Detect cross compiler builds
  43. if ($ENV{GCC_TARGET}) {
  44.     $crossprefix = debarch_to_gnutriplet($ENV{GCC_TARGET});
  45. }
  46. if ($ENV{DEB_TARGET_GNU_TYPE} and
  47.     ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
  48. {
  49.     $crossprefix = $ENV{DEB_TARGET_GNU_TYPE};
  50. }
  51. # host for normal cross builds.
  52. if (get_build_arch() ne get_host_arch()) {
  53.     $crossprefix = debarch_to_gnutriplet(get_host_arch());
  54. }
  55. # Define list of directories containing crossbuilt libraries
  56. if ($crossprefix) {
  57.     push @crosslibrarypaths, "/$crossprefix/lib", "/usr/$crossprefix/lib",
  58.             "/$crossprefix/lib32", "/usr/$crossprefix/lib32",
  59.             "/$crossprefix/lib64", "/usr/$crossprefix/lib64";
  60. }
  61.  
  62. our @librarypaths = (DEFAULT_LIBRARY_PATH, @crosslibrarypaths);
  63.  
  64. # Update library paths with LD_LIBRARY_PATH
  65. if ($ENV{LD_LIBRARY_PATH}) {
  66.     foreach my $path (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) {
  67.     $path =~ s{/+$}{};
  68.     unshift @librarypaths, $path;
  69.     }
  70. }
  71.  
  72. # Update library paths with ld.so config
  73. parse_ldso_conf("/etc/ld.so.conf") if -e "/etc/ld.so.conf";
  74.  
  75. my %visited;
  76. sub parse_ldso_conf {
  77.     my $file = shift;
  78.     open my $fh, "<", $file or syserr(_g("cannot open %s"), $file);
  79.     $visited{$file}++;
  80.     while (<$fh>) {
  81.     next if /^\s*$/;
  82.     chomp;
  83.     s{/+$}{};
  84.     if (/^include\s+(\S.*\S)\s*$/) {
  85.         foreach my $include (glob($1)) {
  86.         parse_ldso_conf($include) if -e $include
  87.             && !$visited{$include};
  88.         }
  89.     } elsif (m{^\s*/}) {
  90.         s/^\s+//;
  91.         my $libdir = $_;
  92.         unless (scalar grep { $_ eq $libdir } @librarypaths) {
  93.         push @librarypaths, $libdir;
  94.         }
  95.     }
  96.     }
  97.     close $fh;
  98. }
  99.  
  100. # find_library ($soname, \@rpath, $format, $root)
  101. sub find_library {
  102.     my ($lib, $rpath, $format, $root) = @_;
  103.     $root = "" if not defined($root);
  104.     $root =~ s{/+$}{};
  105.     my @rpath = @{$rpath};
  106.     foreach my $dir (@rpath, @librarypaths) {
  107.     my $checkdir = "$root$dir";
  108.     # If the directory checked is a symlink, check if it doesn't
  109.     # resolve to another public directory (which is then the canonical
  110.     # directory to use instead of this one). Typical example
  111.     # is /usr/lib64 -> /usr/lib on amd64.
  112.     if (-l $checkdir) {
  113.         my $newdir = resolve_symlink($checkdir);
  114.         if (grep { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) {
  115.         $checkdir = $newdir;
  116.         }
  117.     }
  118.     if (-e "$checkdir/$lib") {
  119.         my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
  120.         if ($format eq $libformat) {
  121.         return canonpath("$checkdir/$lib");
  122.         }
  123.     }
  124.     }
  125.     return undef;
  126. }
  127.  
  128. 1;
  129.