Shlibs.pm 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134
  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. package Dpkg::Shlibs;
  16. use strict;
  17. use warnings;
  18. our $VERSION = "0.01";
  19. use base qw(Exporter);
  20. our @EXPORT_OK = qw(@librarypaths find_library);
  21. use File::Spec;
  22. use Dpkg::Gettext;
  23. use Dpkg::ErrorHandling;
  24. use Dpkg::Shlibs::Objdump;
  25. use Dpkg::Path qw(resolve_symlink canonpath);
  26. use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch
  27. gnutriplet_to_multiarch debarch_to_multiarch);
  28. use constant DEFAULT_LIBRARY_PATH =>
  29. qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
  30. /emul/ia32-linux/lib /emul/ia32-linux/usr/lib);
  31. # Adjust set of directories to consider when we're in a situation of a
  32. # cross-build or a build of a cross-compiler
  33. my @crosslibrarypaths;
  34. my ($crossprefix, $multiarch);
  35. # Detect cross compiler builds
  36. if ($ENV{GCC_TARGET}) {
  37. $crossprefix = debarch_to_gnutriplet($ENV{GCC_TARGET});
  38. $multiarch = debarch_to_multiarch($ENV{GCC_TARGET});
  39. }
  40. if ($ENV{DEB_TARGET_GNU_TYPE} and
  41. ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
  42. {
  43. $crossprefix = $ENV{DEB_TARGET_GNU_TYPE};
  44. $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE});
  45. }
  46. # host for normal cross builds.
  47. if (get_build_arch() ne get_host_arch()) {
  48. $crossprefix = debarch_to_gnutriplet(get_host_arch());
  49. $multiarch = debarch_to_multiarch(get_host_arch());
  50. }
  51. # Define list of directories containing crossbuilt libraries
  52. if ($crossprefix) {
  53. push @crosslibrarypaths, "/lib/$multiarch", "/usr/lib/$multiarch",
  54. "/$crossprefix/lib", "/usr/$crossprefix/lib",
  55. "/$crossprefix/lib32", "/usr/$crossprefix/lib32",
  56. "/$crossprefix/lib64", "/usr/$crossprefix/lib64";
  57. }
  58. our @librarypaths = (DEFAULT_LIBRARY_PATH, @crosslibrarypaths);
  59. # Update library paths with LD_LIBRARY_PATH
  60. if ($ENV{LD_LIBRARY_PATH}) {
  61. foreach my $path (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) {
  62. $path =~ s{/+$}{};
  63. unshift @librarypaths, $path;
  64. }
  65. }
  66. # Update library paths with ld.so config
  67. parse_ldso_conf("/etc/ld.so.conf") if -e "/etc/ld.so.conf";
  68. my %visited;
  69. sub parse_ldso_conf {
  70. my $file = shift;
  71. open my $fh, "<", $file or syserr(_g("cannot open %s"), $file);
  72. $visited{$file}++;
  73. while (<$fh>) {
  74. next if /^\s*$/;
  75. chomp;
  76. s{/+$}{};
  77. if (/^include\s+(\S.*\S)\s*$/) {
  78. foreach my $include (glob($1)) {
  79. parse_ldso_conf($include) if -e $include
  80. && !$visited{$include};
  81. }
  82. } elsif (m{^\s*/}) {
  83. s/^\s+//;
  84. my $libdir = $_;
  85. unless (scalar grep { $_ eq $libdir } @librarypaths) {
  86. push @librarypaths, $libdir;
  87. }
  88. }
  89. }
  90. close $fh;
  91. }
  92. # find_library ($soname, \@rpath, $format, $root)
  93. sub find_library {
  94. my ($lib, $rpath, $format, $root) = @_;
  95. $root = "" if not defined($root);
  96. $root =~ s{/+$}{};
  97. my @rpath = @{$rpath};
  98. foreach my $dir (@rpath, @librarypaths) {
  99. my $checkdir = "$root$dir";
  100. # If the directory checked is a symlink, check if it doesn't
  101. # resolve to another public directory (which is then the canonical
  102. # directory to use instead of this one). Typical example
  103. # is /usr/lib64 -> /usr/lib on amd64.
  104. if (-l $checkdir) {
  105. my $newdir = resolve_symlink($checkdir);
  106. if (grep { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) {
  107. $checkdir = $newdir;
  108. }
  109. }
  110. if (-e "$checkdir/$lib") {
  111. my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
  112. if ($format eq $libformat) {
  113. return canonpath("$checkdir/$lib");
  114. }
  115. }
  116. }
  117. return undef;
  118. }
  119. 1;