Commit | Line | Data |
---|---|---|
1479465f GJ |
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 | use strict; | |
20 | use warnings; | |
21 | 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 | use Exporter qw(import); | |
33 | use File::Spec; | |
34 | ||
35 | use Dpkg::Gettext; | |
36 | use Dpkg::ErrorHandling; | |
37 | use Dpkg::Shlibs::Objdump; | |
38 | use Dpkg::Util qw(:list); | |
39 | use Dpkg::Path qw(resolve_symlink canonpath); | |
40 | use Dpkg::Arch qw(get_build_arch get_host_arch :mappers); | |
41 | ||
42 | use constant DEFAULT_LIBRARY_PATH => | |
43 | qw(/lib /usr/lib); | |
44 | # XXX: Deprecated multilib paths. | |
45 | use constant DEFAULT_MULTILIB_PATH => | |
46 | 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 | my $file = shift; | |
56 | state %visited; | |
57 | local $_; | |
58 | ||
59 | open my $fh, '<', $file or syserr(g_('cannot open %s'), $file); | |
60 | $visited{$file}++; | |
61 | while (<$fh>) { | |
62 | next if /^\s*$/; | |
63 | chomp; | |
64 | s{/+$}{}; | |
65 | if (/^include\s+(\S.*\S)\s*$/) { | |
66 | foreach my $include (glob($1)) { | |
67 | parse_ldso_conf($include) if -e $include | |
68 | && !$visited{$include}; | |
69 | } | |
70 | } elsif (m{^\s*/}) { | |
71 | s/^\s+//; | |
72 | my $libdir = $_; | |
73 | if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) { | |
74 | push @system_librarypaths, $libdir; | |
75 | } | |
76 | } | |
77 | } | |
78 | close $fh; | |
79 | } | |
80 | ||
81 | sub blank_library_paths { | |
82 | @custom_librarypaths = (); | |
83 | @system_librarypaths = (); | |
84 | $librarypaths_init = 1; | |
85 | } | |
86 | ||
87 | sub setup_library_paths { | |
88 | @custom_librarypaths = (); | |
89 | @system_librarypaths = (); | |
90 | ||
91 | # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH. | |
92 | if ($ENV{LD_LIBRARY_PATH}) { | |
93 | foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) { | |
94 | $path =~ s{/+$}{}; | |
95 | # XXX: This should be added to @custom_librarypaths, but as this | |
96 | # is deprecated we do not care as the code will go away. | |
97 | push @system_librarypaths, $path; | |
98 | } | |
99 | } | |
100 | ||
101 | # Adjust set of directories to consider when we're in a situation of a | |
102 | # cross-build or a build of a cross-compiler. | |
103 | my $multiarch; | |
104 | ||
105 | # Detect cross compiler builds. | |
106 | if ($ENV{DEB_TARGET_GNU_TYPE} and | |
107 | ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE})) | |
108 | { | |
109 | $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE}); | |
110 | } | |
111 | # Host for normal cross builds. | |
112 | if (get_build_arch() ne get_host_arch()) { | |
113 | $multiarch = debarch_to_multiarch(get_host_arch()); | |
114 | } | |
115 | # Define list of directories containing crossbuilt libraries. | |
116 | if ($multiarch) { | |
117 | push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch"; | |
118 | } | |
119 | ||
120 | push @system_librarypaths, DEFAULT_LIBRARY_PATH; | |
121 | ||
122 | # Update library paths with ld.so config. | |
123 | parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf'; | |
124 | ||
125 | push @system_librarypaths, DEFAULT_MULTILIB_PATH; | |
126 | ||
127 | $librarypaths_init = 1; | |
128 | } | |
129 | ||
130 | sub add_library_dir { | |
131 | my $dir = shift; | |
132 | ||
133 | setup_library_paths() if not $librarypaths_init; | |
134 | ||
135 | push @custom_librarypaths, $dir; | |
136 | } | |
137 | ||
138 | sub get_library_paths { | |
139 | setup_library_paths() if not $librarypaths_init; | |
140 | ||
141 | return (@custom_librarypaths, @system_librarypaths); | |
142 | } | |
143 | ||
144 | # find_library ($soname, \@rpath, $format, $root) | |
145 | sub find_library { | |
146 | my ($lib, $rpath, $format, $root) = @_; | |
147 | ||
148 | setup_library_paths() if not $librarypaths_init; | |
149 | ||
150 | my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths); | |
151 | my @libs; | |
152 | ||
153 | $root //= ''; | |
154 | $root =~ s{/+$}{}; | |
155 | foreach my $dir (@librarypaths) { | |
156 | my $checkdir = "$root$dir"; | |
157 | if (-e "$checkdir/$lib") { | |
158 | my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib"); | |
159 | if ($format eq $libformat) { | |
160 | push @libs, canonpath("$checkdir/$lib"); | |
161 | } else { | |
162 | debug(1, "Skipping lib $checkdir/$lib, libabi=0x%s != objabi=0x%s", | |
163 | unpack('H*', $libformat), unpack('H*', $format)); | |
164 | } | |
165 | } | |
166 | } | |
167 | return @libs; | |
168 | } | |
169 | ||
170 | 1; |