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