scripts/Dpkg/Shlibs.pm

   1 # Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org>
   2 # Copyright © 2007-2008, 2012-2015 Guillem Jover <guillem@debian.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 =encoding utf8
  18
  19 =head1 NAME
  20
  21 Dpkg::Shlibs - shared library location handling
  22
  23 =head1 DESCRIPTION
  24
  25 This module provides functions to locate shared libraries.
  26
  27 B<Note>: This is a private module, its API can change at any time.
  28
  29 =cut
  30
  31 package Dpkg::Shlibs 0.03;
  32
  33 use strict;
  34 use warnings;
  35 use feature qw(state);
  36
  37 our @EXPORT_OK = qw(
  38     blank_library_paths
  39     setup_library_paths
  40     get_library_paths
  41     add_library_dir
  42     find_library
  43 );
  44
  45 use Exporter qw(import);
  46 use List::Util qw(none);
  47 use File::Spec;
  48
  49 use Dpkg::Gettext;
  50 use Dpkg::ErrorHandling;
  51 use Dpkg::Shlibs::Objdump;
  52 use Dpkg::BuildAPI qw(get_build_api);
  53 use Dpkg::Path qw(resolve_symlink canonpath);
  54 use Dpkg::Arch qw(get_build_arch get_host_arch :mappers);
  55
  56 use constant DEFAULT_LIBRARY_PATH =>
  57     qw(/lib /usr/lib);
  58 # XXX: Deprecated multilib paths.
  59 use constant DEFAULT_MULTILIB_PATH =>
  60     qw(/lib32 /usr/lib32 /lib64 /usr/lib64);
  61
  62 # Library paths set by the user.
  63 my @custom_librarypaths;
  64 # Library paths from the system.
  65 my @system_librarypaths;
  66 my $librarypaths_init;
  67
  68 sub parse_ldso_conf {
  69     my $file = shift;
  70     state %visited;
  71     local $_;
  72
  73     open my $fh, '<', $file or syserr(g_('cannot open %s'), $file);
  74     $visited{$file}++;
  75     while (<$fh>) {
  76         next if /^\s*$/;
  77         chomp;
  78         s{/+$}{};
  79         if (/^include\s+(\S.*\S)\s*$/) {
  80             foreach my $include (glob($1)) {
  81                 parse_ldso_conf($include) if -e $include
  82                     && !$visited{$include};
  83             }
  84         } elsif (m{^\s*/}) {
  85             s/^\s+//;
  86             my $libdir = $_;
  87             if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) {
  88                 push @system_librarypaths, $libdir;
  89             }
  90         }
  91     }
  92     close $fh;
  93 }
  94
  95 sub blank_library_paths {
  96     @custom_librarypaths = ();
  97     @system_librarypaths = ();
  98     $librarypaths_init = 1;
  99 }
 100
 101 sub setup_library_paths {
 102     @custom_librarypaths = ();
 103     @system_librarypaths = ();
 104
 105     # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH.
 106     if ($ENV{LD_LIBRARY_PATH}) {
 107         require Cwd;
 108         my $cwd = Cwd::getcwd;
 109
 110         foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) {
 111             $path =~ s{/+$}{};
 112
 113             my $realpath = Cwd::realpath($path);
 114             next unless defined $realpath;
 115             if ($realpath =~ m/^\Q$cwd\E/) {
 116                 if (get_build_api() >= 1) {
 117                     error(g_('use -l option instead of LD_LIBRARY_PATH'));
 118                 } else {
 119                     warning(g_('deprecated use of LD_LIBRARY_PATH with private ' .
 120                                'library directory which interferes with ' .
 121                                'cross-building, please use -l option instead'));
 122                 }
 123             }
 124
 125             next if get_build_api() >= 1;
 126
 127             # XXX: This should be added to @custom_librarypaths, but as this
 128             # is deprecated we do not care as the code will go away.
 129             push @system_librarypaths, $path;
 130         }
 131     }
 132
 133     # Adjust set of directories to consider when we're in a situation of a
 134     # cross-build or a build of a cross-compiler.
 135     my $multiarch;
 136
 137     # Detect cross compiler builds.
 138     if ($ENV{DEB_TARGET_GNU_TYPE} and
 139         ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
 140     {
 141         $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE});
 142     }
 143     # Host for normal cross builds.
 144     if (get_build_arch() ne get_host_arch()) {
 145         $multiarch = debarch_to_multiarch(get_host_arch());
 146     }
 147     # Define list of directories containing crossbuilt libraries.
 148     if ($multiarch) {
 149         push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch";
 150     }
 151
 152     push @system_librarypaths, DEFAULT_LIBRARY_PATH;
 153
 154     # Update library paths with ld.so config.
 155     parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf';
 156
 157     push @system_librarypaths, DEFAULT_MULTILIB_PATH;
 158
 159     $librarypaths_init = 1;
 160 }
 161
 162 sub add_library_dir {
 163     my $dir = shift;
 164
 165     setup_library_paths() if not $librarypaths_init;
 166
 167     push @custom_librarypaths, $dir;
 168 }
 169
 170 sub get_library_paths {
 171     setup_library_paths() if not $librarypaths_init;
 172
 173     return (@custom_librarypaths, @system_librarypaths);
 174 }
 175
 176 # find_library ($soname, \@rpath, $format, $root)
 177 sub find_library {
 178     my ($lib, $rpath, $format, $root) = @_;
 179
 180     setup_library_paths() if not $librarypaths_init;
 181
 182     my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths);
 183     my @libs;
 184
 185     $root //= '';
 186     $root =~ s{/+$}{};
 187     foreach my $dir (@librarypaths) {
 188         my $checkdir = "$root$dir";
 189         if (-e "$checkdir/$lib") {
 190             my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
 191             if (not defined $libformat) {
 192                 warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib");
 193             } elsif ($format eq $libformat) {
 194                 push @libs, canonpath("$checkdir/$lib");
 195             } else {
 196                 debug(1, "Skipping lib $checkdir/$lib, libabi=<%s> != objabi=<%s>",
 197                       $libformat, $format);
 198             }
 199         }
 200     }
 201     return @libs;
 202 }
 203
 204 =head1 CHANGES
 205
 206 =head2 Version 0.xx
 207
 208 This is a private module.
 209
 210 =cut
 211
 212 1;