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::Path qw(resolve_symlink canonpath);
  53 use Dpkg::Arch qw(get_build_arch get_host_arch :mappers);
  54
  55 use constant DEFAULT_LIBRARY_PATH =>
  56     qw(/lib /usr/lib);
  57 # XXX: Deprecated multilib paths.
  58 use constant DEFAULT_MULTILIB_PATH =>
  59     qw(/lib32 /usr/lib32 /lib64 /usr/lib64);
  60
  61 # Library paths set by the user.
  62 my @custom_librarypaths;
  63 # Library paths from the system.
  64 my @system_librarypaths;
  65 my $librarypaths_init;
  66
  67 sub parse_ldso_conf {
  68     my $file = shift;
  69     state %visited;
  70     local $_;
  71
  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 } (@custom_librarypaths, @system_librarypaths)) {
  87                 push @system_librarypaths, $libdir;
  88             }
  89         }
  90     }
  91     close $fh;
  92 }
  93
  94 sub blank_library_paths {
  95     @custom_librarypaths = ();
  96     @system_librarypaths = ();
  97     $librarypaths_init = 1;
  98 }
  99
 100 sub setup_library_paths {
 101     @custom_librarypaths = ();
 102     @system_librarypaths = ();
 103
 104     # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH.
 105     if ($ENV{LD_LIBRARY_PATH}) {
 106         require Cwd;
 107         my $cwd = Cwd::getcwd;
 108
 109         foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) {
 110             $path =~ s{/+$}{};
 111
 112             my $realpath = Cwd::realpath($path);
 113             next unless defined $realpath;
 114             if ($realpath =~ m/^\Q$cwd\E/) {
 115                 warning(g_('deprecated use of LD_LIBRARY_PATH with private ' .
 116                            'library directory which interferes with ' .
 117                            'cross-building, please use -l option instead'));
 118             }
 119
 120             # XXX: This should be added to @custom_librarypaths, but as this
 121             # is deprecated we do not care as the code will go away.
 122             push @system_librarypaths, $path;
 123         }
 124     }
 125
 126     # Adjust set of directories to consider when we're in a situation of a
 127     # cross-build or a build of a cross-compiler.
 128     my $multiarch;
 129
 130     # Detect cross compiler builds.
 131     if ($ENV{DEB_TARGET_GNU_TYPE} and
 132         ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
 133     {
 134         $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE});
 135     }
 136     # Host for normal cross builds.
 137     if (get_build_arch() ne get_host_arch()) {
 138         $multiarch = debarch_to_multiarch(get_host_arch());
 139     }
 140     # Define list of directories containing crossbuilt libraries.
 141     if ($multiarch) {
 142         push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch";
 143     }
 144
 145     push @system_librarypaths, DEFAULT_LIBRARY_PATH;
 146
 147     # Update library paths with ld.so config.
 148     parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf';
 149
 150     push @system_librarypaths, DEFAULT_MULTILIB_PATH;
 151
 152     $librarypaths_init = 1;
 153 }
 154
 155 sub add_library_dir {
 156     my $dir = shift;
 157
 158     setup_library_paths() if not $librarypaths_init;
 159
 160     push @custom_librarypaths, $dir;
 161 }
 162
 163 sub get_library_paths {
 164     setup_library_paths() if not $librarypaths_init;
 165
 166     return (@custom_librarypaths, @system_librarypaths);
 167 }
 168
 169 # find_library ($soname, \@rpath, $format, $root)
 170 sub find_library {
 171     my ($lib, $rpath, $format, $root) = @_;
 172
 173     setup_library_paths() if not $librarypaths_init;
 174
 175     my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths);
 176     my @libs;
 177
 178     $root //= '';
 179     $root =~ s{/+$}{};
 180     foreach my $dir (@librarypaths) {
 181         my $checkdir = "$root$dir";
 182         if (-e "$checkdir/$lib") {
 183             my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
 184             if (not defined $libformat) {
 185                 warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib");
 186             } elsif ($format eq $libformat) {
 187                 push @libs, canonpath("$checkdir/$lib");
 188             } else {
 189                 debug(1, "Skipping lib $checkdir/$lib, libabi=<%s> != objabi=<%s>",
 190                       $libformat, $format);
 191             }
 192         }
 193     }
 194     return @libs;
 195 }
 196
 197 =head1 CHANGES
 198
 199 =head2 Version 0.xx
 200
 201 This is a private module.
 202
 203 =cut
 204
 205 1;