Shlibs.pm 4.1 KB

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