File: | Dpkg/Shlibs.pm |
Coverage: | 71.6% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | package Dpkg::Shlibs; | ||||||
18 | |||||||
19 | 2 2 2 | 4 2 24 | use strict; | ||||
20 | 2 2 2 | 4 0 48 | use warnings; | ||||
21 | 2 2 2 | 4 2 100 | use feature qw(state); | ||||
22 | |||||||
23 | our $VERSION = '0.03'; | ||||||
24 | our @EXPORT_OK = qw( | ||||||
25 | blank_library_paths | ||||||
26 | setup_library_paths | ||||||
27 | get_library_paths | ||||||
28 | add_library_dir | ||||||
29 | find_library | ||||||
30 | ); | ||||||
31 | |||||||
32 | 2 2 2 | 4 2 24 | use Exporter qw(import); | ||||
33 | 2 2 2 | 4 2 50 | use List::Util qw(none); | ||||
34 | 2 2 2 | 2 2 30 | use File::Spec; | ||||
35 | |||||||
36 | 2 2 2 | 1064 0 50 | use Dpkg::Gettext; | ||||
37 | 2 2 2 | 1140 2 62 | use Dpkg::ErrorHandling; | ||||
38 | 2 2 2 | 1136 2 74 | use Dpkg::Shlibs::Objdump; | ||||
39 | 2 2 2 | 8 2 66 | use Dpkg::Path qw(resolve_symlink canonpath); | ||||
40 | 2 2 2 | 6 2 166 | use Dpkg::Arch qw(get_build_arch get_host_arch :mappers); | ||||
41 | |||||||
42 | 2 | 70 | use constant DEFAULT_LIBRARY_PATH => | ||||
43 | 2 2 | 4 2 | qw(/lib /usr/lib); | ||||
44 | # XXX: Deprecated multilib paths. | ||||||
45 | 2 | 1114 | use constant DEFAULT_MULTILIB_PATH => | ||||
46 | 2 2 | 4 0 | qw(/lib32 /usr/lib32 /lib64 /usr/lib64); | ||||
47 | |||||||
48 | # Library paths set by the user. | ||||||
49 | my @custom_librarypaths; | ||||||
50 | # Library paths from the system. | ||||||
51 | my @system_librarypaths; | ||||||
52 | my $librarypaths_init; | ||||||
53 | |||||||
54 | sub parse_ldso_conf { | ||||||
55 | 20 | 0 | 8 | my $file = shift; | |||
56 | 20 | 14 | state %visited; | ||||
57 | 20 | 6 | local $_; | ||||
58 | |||||||
59 | 20 | 158 | open my $fh, '<', $file or syserr(g_('cannot open %s'), $file); | ||||
60 | 20 | 26 | $visited{$file}++; | ||||
61 | 20 | 76 | while (<$fh>) { | ||||
62 | 50 | 52 | next if /^\s*$/; | ||||
63 | 42 | 28 | chomp; | ||||
64 | 42 | 34 | s{/+$}{}; | ||||
65 | 42 | 58 | if (/^include\s+(\S.*\S)\s*$/) { | ||||
66 | 10 | 140 | foreach my $include (glob($1)) { | ||||
67 | parse_ldso_conf($include) if -e $include | ||||||
68 | 18 | 76 | && !$visited{$include}; | ||||
69 | } | ||||||
70 | } elsif (m{^\s*/}) { | ||||||
71 | 22 | 12 | s/^\s+//; | ||||
72 | 22 | 12 | my $libdir = $_; | ||||
73 | 22 96 | 30 48 | if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) { | ||||
74 | 22 | 70 | push @system_librarypaths, $libdir; | ||||
75 | } | ||||||
76 | } | ||||||
77 | } | ||||||
78 | 20 | 62 | close $fh; | ||||
79 | } | ||||||
80 | |||||||
81 | sub blank_library_paths { | ||||||
82 | 2 | 0 | 0 | @custom_librarypaths = (); | |||
83 | 2 | 2 | @system_librarypaths = (); | ||||
84 | 2 | 2 | $librarypaths_init = 1; | ||||
85 | } | ||||||
86 | |||||||
87 | sub setup_library_paths { | ||||||
88 | 2 | 0 | 2 | @custom_librarypaths = (); | |||
89 | 2 | 2 | @system_librarypaths = (); | ||||
90 | |||||||
91 | # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH. | ||||||
92 | 2 | 2 | if ($ENV{LD_LIBRARY_PATH}) { | ||||
93 | 2 | 4 | require Cwd; | ||||
94 | 2 | 10 | my $cwd = Cwd::getcwd; | ||||
95 | |||||||
96 | 2 | 2 | foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) { | ||||
97 | 2 | 4 | $path =~ s{/+$}{}; | ||||
98 | |||||||
99 | 2 | 28 | my $realpath = Cwd::realpath($path); | ||||
100 | 2 | 2 | next unless defined $realpath; | ||||
101 | 2 | 16 | if ($realpath =~ m/^\Q$cwd\E/) { | ||||
102 | 0 | 0 | warning(g_('deprecated use of LD_LIBRARY_PATH with private ' . | ||||
103 | 'library directory which interferes with ' . | ||||||
104 | 'cross-building, please use -l option instead')); | ||||||
105 | } | ||||||
106 | |||||||
107 | # XXX: This should be added to @custom_librarypaths, but as this | ||||||
108 | # is deprecated we do not care as the code will go away. | ||||||
109 | 2 | 2 | push @system_librarypaths, $path; | ||||
110 | } | ||||||
111 | } | ||||||
112 | |||||||
113 | # Adjust set of directories to consider when we're in a situation of a | ||||||
114 | # cross-build or a build of a cross-compiler. | ||||||
115 | 2 | 2 | my $multiarch; | ||||
116 | |||||||
117 | # Detect cross compiler builds. | ||||||
118 | 2 | 2 | if ($ENV{DEB_TARGET_GNU_TYPE} and | ||||
119 | ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE})) | ||||||
120 | { | ||||||
121 | 0 | 0 | $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE}); | ||||
122 | } | ||||||
123 | # Host for normal cross builds. | ||||||
124 | 2 | 4 | if (get_build_arch() ne get_host_arch()) { | ||||
125 | 0 | 0 | $multiarch = debarch_to_multiarch(get_host_arch()); | ||||
126 | } | ||||||
127 | # Define list of directories containing crossbuilt libraries. | ||||||
128 | 2 | 2 | if ($multiarch) { | ||||
129 | 0 | 0 | push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch"; | ||||
130 | } | ||||||
131 | |||||||
132 | 2 | 0 | push @system_librarypaths, DEFAULT_LIBRARY_PATH; | ||||
133 | |||||||
134 | # Update library paths with ld.so config. | ||||||
135 | 2 | 12 | parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf'; | ||||
136 | |||||||
137 | 2 | 4 | push @system_librarypaths, DEFAULT_MULTILIB_PATH; | ||||
138 | |||||||
139 | 2 | 2 | $librarypaths_init = 1; | ||||
140 | } | ||||||
141 | |||||||
142 | sub add_library_dir { | ||||||
143 | 4 | 0 | 0 | my $dir = shift; | |||
144 | |||||||
145 | 4 | 6 | setup_library_paths() if not $librarypaths_init; | ||||
146 | |||||||
147 | 4 | 4 | push @custom_librarypaths, $dir; | ||||
148 | } | ||||||
149 | |||||||
150 | sub get_library_paths { | ||||||
151 | 6 | 0 | 6 | setup_library_paths() if not $librarypaths_init; | |||
152 | |||||||
153 | 6 | 8 | return (@custom_librarypaths, @system_librarypaths); | ||||
154 | } | ||||||
155 | |||||||
156 | # find_library ($soname, \@rpath, $format, $root) | ||||||
157 | sub find_library { | ||||||
158 | 0 | 0 | my ($lib, $rpath, $format, $root) = @_; | ||||
159 | |||||||
160 | 0 | setup_library_paths() if not $librarypaths_init; | |||||
161 | |||||||
162 | 0 0 | my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths); | |||||
163 | 0 | my @libs; | |||||
164 | |||||||
165 | 0 | $root //= ''; | |||||
166 | 0 | $root =~ s{/+$}{}; | |||||
167 | 0 | foreach my $dir (@librarypaths) { | |||||
168 | 0 | my $checkdir = "$root$dir"; | |||||
169 | 0 | if (-e "$checkdir/$lib") { | |||||
170 | 0 | my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib"); | |||||
171 | 0 | if (not defined $libformat) { | |||||
172 | 0 | warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib"); | |||||
173 | } elsif ($format eq $libformat) { | ||||||
174 | 0 | push @libs, canonpath("$checkdir/$lib"); | |||||
175 | } else { | ||||||
176 | 0 | debug(1, "Skipping lib $checkdir/$lib, libabi=0x%s != objabi=0x%s", | |||||
177 | unpack('H*', $libformat), unpack('H*', $format)); | ||||||
178 | } | ||||||
179 | } | ||||||
180 | } | ||||||
181 | 0 | return @libs; | |||||
182 | } | ||||||
183 | |||||||
184 | 1; |