Shlibs.pm 3.7 KB

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