Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | #!/usr/bin/perl |
2 | # | |
3 | # dpkg-shlibdeps | |
4 | # | |
5 | # Copyright © 1996 Ian Jackson | |
6 | # Copyright © 2000 Wichert Akkerman | |
7 | # Copyright © 2006 Frank Lichtenheld | |
8 | # Copyright © 2006-2010,2012-2015 Guillem Jover <guillem@debian.org> | |
9 | # Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org> | |
10 | # | |
11 | # This program is free software; you can redistribute it and/or modify | |
12 | # it under the terms of the GNU General Public License as published by | |
13 | # the Free Software Foundation; either version 2 of the License, or | |
14 | # (at your option) any later version. | |
15 | # | |
16 | # This program is distributed in the hope that it will be useful, | |
17 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | # GNU General Public License for more details. | |
20 | # | |
21 | # You should have received a copy of the GNU General Public License | |
22 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
23 | ||
24 | use strict; | |
25 | use warnings; | |
26 | ||
27 | use POSIX qw(:errno_h); | |
28 | use Cwd qw(realpath); | |
29 | use File::Basename qw(dirname); | |
30 | ||
31 | use Dpkg (); | |
32 | use Dpkg::Gettext; | |
33 | use Dpkg::ErrorHandling; | |
34 | use Dpkg::Util qw(:list); | |
35 | use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir | |
36 | check_files_are_the_same get_control_path); | |
37 | use Dpkg::Version; | |
38 | use Dpkg::Shlibs qw(find_library get_library_paths); | |
39 | use Dpkg::Shlibs::Objdump; | |
40 | use Dpkg::Shlibs::SymbolFile; | |
41 | use Dpkg::Substvars; | |
42 | use Dpkg::Arch qw(get_host_arch); | |
43 | use Dpkg::Deps; | |
44 | use Dpkg::Control::Info; | |
45 | use Dpkg::Control::Fields; | |
46 | ||
47 | ||
48 | use constant { | |
49 | WARN_SYM_NOT_FOUND => 1, | |
50 | WARN_DEP_AVOIDABLE => 2, | |
51 | WARN_NOT_NEEDED => 4, | |
52 | }; | |
53 | ||
54 | # By increasing importance | |
55 | my @depfields = qw(Suggests Recommends Depends Pre-Depends); | |
56 | my $i = 0; my %depstrength = map { $_ => $i++ } @depfields; | |
57 | ||
58 | textdomain('dpkg-dev'); | |
59 | ||
60 | my $admindir = $Dpkg::ADMINDIR; | |
61 | my $shlibsoverride = "$Dpkg::CONFDIR/shlibs.override"; | |
62 | my $shlibsdefault = "$Dpkg::CONFDIR/shlibs.default"; | |
63 | my $shlibslocal = 'debian/shlibs.local'; | |
64 | my $packagetype = 'deb'; | |
65 | my $dependencyfield = 'Depends'; | |
66 | my $varlistfile = 'debian/substvars'; | |
67 | my $varlistfilenew; | |
68 | my $varnameprefix = 'shlibs'; | |
69 | my $ignore_missing_info = 0; | |
70 | my $warnings = WARN_SYM_NOT_FOUND | WARN_DEP_AVOIDABLE; | |
71 | my $debug = 0; | |
72 | my @exclude = (); | |
73 | my @pkg_dir_to_search = (); | |
74 | my @pkg_dir_to_ignore = (); | |
75 | my $host_arch = get_host_arch(); | |
76 | ||
77 | my (@pkg_shlibs, @pkg_symbols, @pkg_root_dirs); | |
78 | ||
79 | my ($stdout, %exec); | |
80 | foreach (@ARGV) { | |
81 | if (m/^-T(.*)$/) { | |
82 | $varlistfile = $1; | |
83 | } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) { | |
84 | $varnameprefix = $1; | |
85 | } elsif (m/^-L(.*)$/) { | |
86 | $shlibslocal = $1; | |
87 | } elsif (m/^-l(.*)$/) { | |
88 | Dpkg::Shlibs::add_library_dir($1); | |
89 | } elsif (m/^-S(.*)$/) { | |
90 | push @pkg_dir_to_search, $1; | |
91 | } elsif (m/^-I(.*)$/) { | |
92 | push @pkg_dir_to_ignore, $1; | |
93 | } elsif (m/^-O$/) { | |
94 | $stdout = 1; | |
95 | } elsif (m/^-O(.+)$/) { | |
96 | $varlistfile = $1; | |
97 | } elsif (m/^-(?:\?|-help)$/) { | |
98 | usage(); exit(0); | |
99 | } elsif (m/^--version$/) { | |
100 | version(); exit(0); | |
101 | } elsif (m/^--admindir=(.*)$/) { | |
102 | $admindir = $1; | |
103 | if (not -d $admindir) { | |
104 | error(g_("administrative directory '%s' does not exist"), $admindir); | |
105 | } | |
106 | $ENV{DPKG_ADMINDIR} = $admindir; | |
107 | } elsif (m/^-d(.*)$/) { | |
108 | $dependencyfield = field_capitalize($1); | |
109 | if (not defined $depstrength{$dependencyfield}) { | |
110 | warning(g_("unrecognized dependency field '%s'"), $dependencyfield); | |
111 | } | |
112 | } elsif (m/^-e(.*)$/) { | |
113 | if (exists $exec{$1}) { | |
114 | # Affect the binary to the most important field | |
115 | if ($depstrength{$dependencyfield} > $depstrength{$exec{$1}}) { | |
116 | $exec{$1} = $dependencyfield; | |
117 | } | |
118 | } else { | |
119 | $exec{$1} = $dependencyfield; | |
120 | } | |
121 | } elsif (m/^--ignore-missing-info$/) { | |
122 | $ignore_missing_info = 1; | |
123 | } elsif (m/^--warnings=(\d+)$/) { | |
124 | $warnings = $1; | |
125 | } elsif (m/^-t(.*)$/) { | |
126 | $packagetype = $1; | |
127 | } elsif (m/^-v$/) { | |
128 | $debug++; | |
129 | } elsif (m/^-x(.*)$/) { | |
130 | push @exclude, $1; | |
131 | } elsif (m/^-/) { | |
132 | usageerr(g_("unknown option '%s'"), $_); | |
133 | } else { | |
134 | if (exists $exec{$_}) { | |
135 | # Affect the binary to the most important field | |
136 | if ($depstrength{$dependencyfield} > $depstrength{$exec{$_}}) { | |
137 | $exec{$_} = $dependencyfield; | |
138 | } | |
139 | } else { | |
140 | $exec{$_} = $dependencyfield; | |
141 | } | |
142 | } | |
143 | } | |
144 | usageerr(g_('need at least one executable')) unless scalar keys %exec; | |
145 | ||
146 | report_options(debug_level => $debug); | |
147 | ||
148 | sub ignore_pkgdir { | |
149 | my $path = shift; | |
150 | return any { $path =~ /^\Q$_\E/ } @pkg_dir_to_ignore; | |
151 | } | |
152 | ||
153 | if (-d 'debian') { | |
154 | push @pkg_symbols, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/symbols'; | |
155 | push @pkg_shlibs, grep { !ignore_pkgdir($_) } glob 'debian/*/DEBIAN/shlibs'; | |
156 | my %uniq = map { guess_pkg_root_dir($_) => 1 } (@pkg_symbols, @pkg_shlibs); | |
157 | push @pkg_root_dirs, keys %uniq; | |
158 | } | |
159 | ||
160 | my $control = Dpkg::Control::Info->new(); | |
161 | my $fields = $control->get_source(); | |
162 | my $bd_value = deps_concat($fields->{'Build-Depends'}, $fields->{'Build-Depends-Arch'}); | |
163 | my $build_deps = deps_parse($bd_value, build_dep => 1, reduce_restrictions => 1); | |
164 | error(g_('error occurred while parsing %s'), 'Build-Depends/Build-Depends-Arch') | |
165 | unless defined $build_deps; | |
166 | ||
167 | my %dependencies; | |
168 | ||
169 | # Statistics on soname seen in the whole run (with multiple analysis of | |
170 | # binaries) | |
171 | my %global_soname_notfound; | |
172 | my %global_soname_used; | |
173 | my %global_soname_needed; | |
174 | ||
175 | # Symfile and objdump caches | |
176 | my %symfile_cache; | |
177 | my %objdump_cache; | |
178 | my %symfile_has_soname_cache; | |
179 | ||
180 | # Used to count errors due to missing libraries | |
181 | my $error_count = 0; | |
182 | ||
183 | my $cur_field; | |
184 | foreach my $file (keys %exec) { | |
185 | $cur_field = $exec{$file}; | |
186 | debug(1, ">> Scanning $file (for $cur_field field)"); | |
187 | ||
188 | my $obj = Dpkg::Shlibs::Objdump::Object->new($file); | |
189 | my @sonames = $obj->get_needed_libraries; | |
190 | ||
191 | # Load symbols files for all needed libraries (identified by SONAME) | |
192 | my %libfiles; | |
193 | my %altlibfiles; | |
194 | my %soname_libs; | |
195 | my %soname_notfound; | |
196 | my %alt_soname; | |
197 | foreach my $soname (@sonames) { | |
198 | my @libs = my_find_library($soname, $obj->{RPATH}, $obj->{exec_abi}, $file); | |
199 | unless (scalar @libs) { | |
200 | $soname_notfound{$soname} = 1; | |
201 | $global_soname_notfound{$soname} = 1; | |
202 | my $msg = g_('cannot find library %s needed by %s (ELF ' . | |
203 | "format: '%s' abi: '%s'; RPATH: '%s')"); | |
204 | my $exec_abi = unpack 'H*', $obj->{exec_abi}; | |
205 | if (scalar(split_soname($soname))) { | |
206 | errormsg($msg, $soname, $file, $obj->{format}, $exec_abi, join(':', @{$obj->{RPATH}})); | |
207 | $error_count++; | |
208 | } else { | |
209 | warning($msg, $soname, $file, $obj->{format}, $exec_abi, join(':', @{$obj->{RPATH}})); | |
210 | } | |
211 | next; | |
212 | } | |
213 | ||
214 | # Track shared libraries for a given SONAME. | |
215 | push @{$soname_libs{$soname}}, @libs; | |
216 | ||
217 | # Track shared libraries for package mapping. | |
218 | foreach my $lib (@libs) { | |
219 | $libfiles{$lib} = $soname; | |
220 | my $reallib = realpath($lib); | |
221 | if ($reallib ne $lib) { | |
222 | $altlibfiles{$reallib} = $soname; | |
223 | } | |
224 | debug(1, "Library $soname found in $lib"); | |
225 | } | |
226 | } | |
227 | my $file2pkg = find_packages(keys %libfiles, keys %altlibfiles); | |
228 | my $symfile = Dpkg::Shlibs::SymbolFile->new(); | |
229 | my $dumplibs_wo_symfile = Dpkg::Shlibs::Objdump->new(); | |
230 | my @soname_wo_symfile; | |
231 | SONAME: foreach my $soname (@sonames) { | |
232 | # Select the first good entry from the ordered list that we got from | |
233 | # find_library(), and skip to the next SONAME. | |
234 | ||
235 | foreach my $lib (@{$soname_libs{$soname}}) { | |
236 | if (none { $_ ne '' } @{$file2pkg->{$lib}}) { | |
237 | # The path of the library as calculated is not the | |
238 | # official path of a packaged file, try to fallback on | |
239 | # on the realpath() first, maybe this one is part of a package | |
240 | my $reallib = realpath($lib); | |
241 | if (exists $file2pkg->{$reallib}) { | |
242 | $file2pkg->{$lib} = $file2pkg->{$reallib}; | |
243 | } | |
244 | } | |
245 | if (none { $_ ne '' } @{$file2pkg->{$lib}}) { | |
246 | # If the library is really not available in an installed package, | |
247 | # it's because it's in the process of being built | |
248 | # Empty package name will lead to consideration of symbols | |
249 | # file from the package being built only | |
250 | $file2pkg->{$lib} = ['']; | |
251 | debug(1, "No associated package found for $lib"); | |
252 | } | |
253 | ||
254 | # Load symbols/shlibs files from packages providing libraries | |
255 | my $missing_wanted_shlibs_info = 0; | |
256 | foreach my $pkg (@{$file2pkg->{$lib}}) { | |
257 | my $symfile_path; | |
258 | my $haslocaldep = 0; | |
259 | if (-e $shlibslocal and | |
260 | defined(extract_from_shlibs($soname, $shlibslocal))) | |
261 | { | |
262 | $haslocaldep = 1; | |
263 | } | |
264 | if ($packagetype eq 'deb' and not $haslocaldep) { | |
265 | # Use fine-grained dependencies only on real deb | |
266 | # and only if the dependency is not provided by shlibs.local | |
267 | $symfile_path = find_symbols_file($pkg, $soname, $lib); | |
268 | } | |
269 | if (defined($symfile_path)) { | |
270 | # Load symbol information | |
271 | debug(1, "Using symbols file $symfile_path for $soname"); | |
272 | $symfile_cache{$symfile_path} //= | |
273 | Dpkg::Shlibs::SymbolFile->new(file => $symfile_path); | |
274 | $symfile->merge_object_from_symfile($symfile_cache{$symfile_path}, $soname); | |
275 | } | |
276 | if (defined($symfile_path) && $symfile->has_object($soname)) { | |
277 | # Initialize dependencies with the smallest minimal version | |
278 | # of all symbols (unversioned dependency is not ok as the | |
279 | # library might not have always been available in the | |
280 | # package and we really need it) | |
281 | my $dep = $symfile->get_dependency($soname); | |
282 | my $minver = $symfile->get_smallest_version($soname) || ''; | |
283 | update_dependency_version($dep, $minver); | |
284 | debug(2, " Minimal version of ($dep) initialized with ($minver)"); | |
285 | ||
286 | # Found a symbols file for the SONAME. | |
287 | next SONAME; | |
288 | } else { | |
289 | # No symbol file found, fall back to standard shlibs | |
290 | debug(1, "Using shlibs+objdump for $soname (file $lib)"); | |
291 | $objdump_cache{$lib} //= Dpkg::Shlibs::Objdump::Object->new($lib); | |
292 | my $libobj = $objdump_cache{$lib}; | |
293 | my $id = $dumplibs_wo_symfile->add_object($libobj); | |
294 | if (($id ne $soname) and ($id ne $lib)) { | |
295 | warning(g_('%s has an unexpected SONAME (%s)'), $lib, $id); | |
296 | $alt_soname{$id} = $soname; | |
297 | } | |
298 | push @soname_wo_symfile, $soname; | |
299 | ||
300 | # Only try to generate a dependency for libraries with a SONAME | |
301 | if (not $libobj->is_public_library()) { | |
302 | debug(1, "Skipping shlibs+objdump info for private library $lib"); | |
303 | next; | |
304 | } | |
305 | ||
306 | # If we found a shlibs file for the SONAME, skip to the next. | |
307 | next SONAME if add_shlibs_dep($soname, $pkg, $lib); | |
308 | ||
309 | $missing_wanted_shlibs_info = 1; | |
310 | ||
311 | debug(1, "No shlibs+objdump info available, trying next package for $lib"); | |
312 | } | |
313 | } | |
314 | ||
315 | next if not $missing_wanted_shlibs_info; | |
316 | ||
317 | # We will only reach this point, if we have found no symbols nor | |
318 | # shlibs files for the given SONAME. | |
319 | ||
320 | # This failure is fairly new, try to be kind by | |
321 | # ignoring as many cases that can be safely ignored | |
322 | my $ignore = 0; | |
323 | # 1/ when the lib and the binary are in the same | |
324 | # package | |
325 | my $root_file = guess_pkg_root_dir($file); | |
326 | my $root_lib = guess_pkg_root_dir($lib); | |
327 | $ignore++ if defined $root_file and defined $root_lib | |
328 | and check_files_are_the_same($root_file, $root_lib); | |
329 | # 2/ when the lib is not versioned and can't be | |
330 | # handled by shlibs | |
331 | $ignore++ unless scalar split_soname($soname); | |
332 | # 3/ when we have been asked to do so | |
333 | $ignore++ if $ignore_missing_info; | |
334 | error(g_('no dependency information found for %s ' . | |
335 | "(used by %s)\n" . | |
336 | 'Hint: check if the library actually comes ' . | |
337 | 'from a package.'), $lib, $file) | |
338 | unless $ignore; | |
339 | } | |
340 | } | |
341 | ||
342 | # Scan all undefined symbols of the binary and resolve to a | |
343 | # dependency | |
344 | my %soname_used; | |
345 | foreach my $soname (@sonames) { | |
346 | # Initialize statistics | |
347 | $soname_used{$soname} = 0; | |
348 | $global_soname_used{$soname} //= 0; | |
349 | if (exists $global_soname_needed{$soname}) { | |
350 | push @{$global_soname_needed{$soname}}, $file; | |
351 | } else { | |
352 | $global_soname_needed{$soname} = [ $file ]; | |
353 | } | |
354 | } | |
355 | my $nb_warnings = 0; | |
356 | my $nb_skipped_warnings = 0; | |
357 | # Disable warnings about missing symbols when we have not been able to | |
358 | # find all libs | |
359 | my $disable_warnings = scalar(keys(%soname_notfound)); | |
360 | my $in_public_dir = 1; | |
361 | if (my $relname = relative_to_pkg_root($file)) { | |
362 | my $parent_dir = '/' . dirname($relname); | |
363 | $in_public_dir = any { $parent_dir eq $_ } get_library_paths(); | |
364 | } else { | |
365 | warning(g_('binaries to analyze should already be ' . | |
366 | "installed in their package's directory")); | |
367 | } | |
368 | debug(2, 'Analyzing all undefined symbols'); | |
369 | foreach my $sym ($obj->get_undefined_dynamic_symbols()) { | |
370 | my $name = $sym->{name}; | |
371 | if ($sym->{version}) { | |
372 | $name .= '@' . "$sym->{version}"; | |
373 | } else { | |
374 | $name .= '@' . 'Base'; | |
375 | } | |
376 | debug(2, " Looking up symbol $name"); | |
377 | my %symdep = $symfile->lookup_symbol($name, \@sonames); | |
378 | if (keys %symdep) { | |
379 | my $depends = $symfile->get_dependency($symdep{soname}, | |
380 | $symdep{symbol}{dep_id}); | |
381 | debug(2, " Found in symbols file of $symdep{soname} (minver: " . | |
382 | "$symdep{symbol}{minver}, dep: $depends)"); | |
383 | $soname_used{$symdep{soname}}++; | |
384 | $global_soname_used{$symdep{soname}}++; | |
385 | if (exists $alt_soname{$symdep{soname}}) { | |
386 | # Also count usage on alternate soname | |
387 | $soname_used{$alt_soname{$symdep{soname}}}++; | |
388 | $global_soname_used{$alt_soname{$symdep{soname}}}++; | |
389 | } | |
390 | update_dependency_version($depends, $symdep{symbol}{minver}); | |
391 | } else { | |
392 | my $syminfo = $dumplibs_wo_symfile->locate_symbol($name); | |
393 | if (not defined($syminfo)) { | |
394 | debug(2, ' Not found'); | |
395 | next unless ($warnings & WARN_SYM_NOT_FOUND); | |
396 | next if $disable_warnings; | |
397 | # Complain about missing symbols only for executables | |
398 | # and public libraries | |
399 | if ($obj->is_executable() or $obj->is_public_library()) { | |
400 | my $print_name = $name; | |
401 | # Drop the default suffix for readability | |
402 | $print_name =~ s/\@Base$//; | |
403 | unless ($sym->{weak}) { | |
404 | if ($debug or ($in_public_dir and $nb_warnings < 10) | |
405 | or (not $in_public_dir and $nb_warnings < 1)) | |
406 | { | |
407 | if ($in_public_dir) { | |
408 | warning(g_('symbol %s used by %s found in none of the ' . | |
409 | 'libraries'), $print_name, $file); | |
410 | } else { | |
411 | warning(g_('%s contains an unresolvable reference to ' . | |
412 | "symbol %s: it's probably a plugin"), | |
413 | $file, $print_name); | |
414 | } | |
415 | $nb_warnings++; | |
416 | } else { | |
417 | $nb_skipped_warnings++; | |
418 | } | |
419 | } | |
420 | } | |
421 | } else { | |
422 | debug(2, " Found in $syminfo->{soname} ($syminfo->{objid})"); | |
423 | if (exists $alt_soname{$syminfo->{soname}}) { | |
424 | # Also count usage on alternate soname | |
425 | $soname_used{$alt_soname{$syminfo->{soname}}}++; | |
426 | $global_soname_used{$alt_soname{$syminfo->{soname}}}++; | |
427 | } | |
428 | $soname_used{$syminfo->{soname}}++; | |
429 | $global_soname_used{$syminfo->{soname}}++; | |
430 | } | |
431 | } | |
432 | } | |
433 | warning(P_('%d similar warning has been skipped (use -v to see it)', | |
434 | '%d other similar warnings have been skipped (use -v to see ' . | |
435 | 'them all)', $nb_skipped_warnings), $nb_skipped_warnings) | |
436 | if $nb_skipped_warnings; | |
437 | foreach my $soname (@sonames) { | |
438 | # Adjust minimal version of dependencies with information | |
439 | # extracted from build-dependencies | |
440 | my $dev_pkg = $symfile->get_field($soname, 'Build-Depends-Package'); | |
441 | if (defined $dev_pkg) { | |
442 | debug(1, "Updating dependencies of $soname with build-dependencies"); | |
443 | my $minver = get_min_version_from_deps($build_deps, $dev_pkg); | |
444 | if (defined $minver) { | |
445 | foreach my $dep ($symfile->get_dependencies($soname)) { | |
446 | update_dependency_version($dep, $minver, 1); | |
447 | debug(1, " Minimal version of $dep updated with $minver"); | |
448 | } | |
449 | } else { | |
450 | debug(1, " No minimal version found in $dev_pkg build-dependency"); | |
451 | } | |
452 | } | |
453 | ||
454 | # Warn about un-NEEDED libraries | |
455 | unless ($soname_notfound{$soname} or $soname_used{$soname}) { | |
456 | # Ignore warning for libm.so.6 if also linked against libstdc++ | |
457 | next if ($soname =~ /^libm\.so\.\d+$/ and | |
458 | any { m/^libstdc\+\+\.so\.\d+/ } @sonames); | |
459 | next unless ($warnings & WARN_NOT_NEEDED); | |
460 | warning(g_('%s should not be linked against %s (it uses none of ' . | |
461 | "the library's symbols)"), $file, $soname); | |
462 | } | |
463 | } | |
464 | } | |
465 | ||
466 | # Warn of unneeded libraries at the "package" level (i.e. over all | |
467 | # binaries that we have inspected) | |
468 | foreach my $soname (keys %global_soname_needed) { | |
469 | unless ($global_soname_notfound{$soname} or $global_soname_used{$soname}) { | |
470 | next if ($soname =~ /^libm\.so\.\d+$/ and | |
471 | any { m/^libstdc\+\+\.so\.\d+/ } keys %global_soname_needed); | |
472 | next unless ($warnings & WARN_DEP_AVOIDABLE); | |
473 | warning(P_('package could avoid a useless dependency if %s was not ' . | |
474 | "linked against %s (it uses none of the library's symbols)", | |
475 | 'package could avoid a useless dependency if %s were not ' . | |
476 | "linked against %s (they use none of the library's symbols)", | |
477 | scalar @{$global_soname_needed{$soname}}), | |
478 | join(' ', @{$global_soname_needed{$soname}}), $soname); | |
479 | } | |
480 | } | |
481 | ||
482 | # Quit now if any missing libraries | |
483 | if ($error_count >= 1) { | |
484 | my $note = g_('Note: libraries are not searched in other binary packages ' . | |
485 | "that do not have any shlibs or symbols file.\nTo help dpkg-shlibdeps " . | |
486 | 'find private libraries, you might need to use -l.'); | |
487 | error(P_('cannot continue due to the error above', | |
488 | 'cannot continue due to the errors listed above', | |
489 | $error_count) . "\n" . $note); | |
490 | } | |
491 | ||
492 | # Open substvars file | |
493 | ||
494 | my $substvars = Dpkg::Substvars->new(); | |
495 | if ($stdout) { | |
496 | $varlistfilenew = '-'; | |
497 | } else { | |
498 | $substvars->load($varlistfile) if -e $varlistfile; | |
499 | $substvars->filter(remove => sub { $_[0] =~ m/^\Q$varnameprefix\E:/ }); | |
500 | ||
501 | $varlistfilenew = "$varlistfile.new"; | |
502 | } | |
503 | ||
504 | # Write out the shlibs substvars | |
505 | my %depseen; | |
506 | ||
507 | sub filter_deps { | |
508 | my ($dep, $field) = @_; | |
509 | # Skip dependencies on excluded packages | |
510 | foreach my $exc (@exclude) { | |
511 | return 0 if $dep =~ /^\s*\Q$exc\E\b/; | |
512 | } | |
513 | # Don't include dependencies if they are already | |
514 | # mentioned in a higher priority field | |
515 | if (not exists($depseen{$dep})) { | |
516 | $depseen{$dep} = $dependencies{$field}{$dep}; | |
517 | return 1; | |
518 | } else { | |
519 | # Since dependencies can be versioned, we have to | |
520 | # verify if the dependency is stronger than the | |
521 | # previously seen one | |
522 | my $stronger; | |
523 | if ($depseen{$dep} eq $dependencies{$field}{$dep}) { | |
524 | # If both versions are the same (possibly unversioned) | |
525 | $stronger = 0; | |
526 | } elsif ($dependencies{$field}{$dep} eq '') { | |
527 | $stronger = 0; # If the dep is unversioned | |
528 | } elsif ($depseen{$dep} eq '') { | |
529 | $stronger = 1; # If the dep seen is unversioned | |
530 | } elsif (version_compare_relation($depseen{$dep}, REL_GT, | |
531 | $dependencies{$field}{$dep})) { | |
532 | # The version of the dep seen is stronger... | |
533 | $stronger = 0; | |
534 | } else { | |
535 | $stronger = 1; | |
536 | } | |
537 | $depseen{$dep} = $dependencies{$field}{$dep} if $stronger; | |
538 | return $stronger; | |
539 | } | |
540 | } | |
541 | ||
542 | foreach my $field (reverse @depfields) { | |
543 | my $dep = ''; | |
544 | if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) { | |
545 | $dep = join ', ', | |
546 | map { | |
547 | # Translate dependency templates into real dependencies | |
548 | my $templ = $_; | |
549 | if ($dependencies{$field}{$templ}) { | |
550 | $templ =~ s/#MINVER#/(>= $dependencies{$field}{$templ})/g; | |
551 | } else { | |
552 | $templ =~ s/#MINVER#//g; | |
553 | } | |
554 | $templ =~ s/\s+/ /g; | |
555 | $templ; | |
556 | } grep { | |
557 | filter_deps($_, $field) | |
558 | } keys %{$dependencies{$field}}; | |
559 | } | |
560 | if ($dep) { | |
561 | my $obj = deps_parse($dep); | |
562 | error(g_('invalid dependency got generated: %s'), $dep) unless defined $obj; | |
563 | $obj->sort(); | |
564 | $substvars->set_as_used("$varnameprefix:$field", "$obj"); | |
565 | } | |
566 | } | |
567 | ||
568 | $substvars->save($varlistfilenew); | |
569 | ||
570 | # Replace old file by new one | |
571 | if (!$stdout) { | |
572 | rename $varlistfilenew, $varlistfile | |
573 | or syserr(g_("install new varlist file '%s'"), $varlistfile); | |
574 | } | |
575 | ||
576 | ## | |
577 | ## Functions | |
578 | ## | |
579 | ||
580 | sub version { | |
581 | printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; | |
582 | ||
583 | printf g_(' | |
584 | This is free software; see the GNU General Public License version 2 or | |
585 | later for copying conditions. There is NO warranty. | |
586 | '); | |
587 | } | |
588 | ||
589 | sub usage { | |
590 | printf g_( | |
591 | 'Usage: %s [<option>...] <executable>|-e<executable> [<option>...]') | |
592 | . "\n\n" . g_( | |
593 | "Positional options (order is significant): | |
594 | <executable> include dependencies for <executable>, | |
595 | -e<executable> (use -e if <executable> starts with '-') | |
596 | -d<dependency-field> next executable(s) set shlibs:<dependency-field>.") | |
597 | . "\n\n" . g_( | |
598 | "Options: | |
599 | -l<library-dir> add directory to private shared library search list. | |
600 | -p<varname-prefix> set <varname-prefix>:* instead of shlibs:*. | |
601 | -O[<file>] write variable settings to stdout (or <file>). | |
602 | -L<local-shlibs-file> shlibs override file, not debian/shlibs.local. | |
603 | -T<substvars-file> update variables here, not debian/substvars. | |
604 | -t<type> set package type (default is deb). | |
605 | -x<package> exclude package from the generated dependencies. | |
606 | -S<package-build-dir> search needed libraries in the given | |
607 | package build directory first. | |
608 | -I<package-build-dir> ignore needed libraries, shlibs and symbols files | |
609 | in the given build directory. | |
610 | -v enable verbose mode (can be used multiple times). | |
611 | --ignore-missing-info don't fail if dependency information can't be found. | |
612 | --warnings=<value> define set of active warnings (see manual page). | |
613 | --admindir=<directory> change the administrative directory. | |
614 | -?, --help show this help message. | |
615 | --version show the version.") | |
616 | . "\n\n" . g_( | |
617 | 'Dependency fields recognized are: | |
618 | %s | |
619 | '), $Dpkg::PROGNAME, join('/', @depfields); | |
620 | } | |
621 | ||
622 | sub get_min_version_from_deps { | |
623 | my ($dep, $pkg) = @_; | |
624 | if ($dep->isa('Dpkg::Deps::Simple')) { | |
625 | if (($dep->{package} eq $pkg) && | |
626 | defined($dep->{relation}) && | |
627 | (($dep->{relation} eq REL_GE) || | |
628 | ($dep->{relation} eq REL_GT))) | |
629 | { | |
630 | return $dep->{version}; | |
631 | } | |
632 | return; | |
633 | } else { | |
634 | my $res; | |
635 | foreach my $subdep ($dep->get_deps()) { | |
636 | my $minver = get_min_version_from_deps($subdep, $pkg); | |
637 | next if not defined $minver; | |
638 | if (defined $res) { | |
639 | if (version_compare_relation($minver, REL_GT, $res)) { | |
640 | $res = $minver; | |
641 | } | |
642 | } else { | |
643 | $res = $minver; | |
644 | } | |
645 | } | |
646 | return $res; | |
647 | } | |
648 | } | |
649 | ||
650 | sub update_dependency_version { | |
651 | my ($dep, $minver, $existing_only) = @_; | |
652 | return if not defined($minver); | |
653 | $minver = Dpkg::Version->new($minver); | |
654 | foreach my $subdep (split /\s*,\s*/, $dep) { | |
655 | if (exists $dependencies{$cur_field}{$subdep} and | |
656 | defined($dependencies{$cur_field}{$subdep})) | |
657 | { | |
658 | if ($dependencies{$cur_field}{$subdep} eq '' or $minver ne '' and | |
659 | version_compare_relation($minver, REL_GT, | |
660 | $dependencies{$cur_field}{$subdep})) | |
661 | { | |
662 | $dependencies{$cur_field}{$subdep} = $minver; | |
663 | } | |
664 | } elsif (!$existing_only) { | |
665 | $dependencies{$cur_field}{$subdep} = $minver; | |
666 | } | |
667 | } | |
668 | } | |
669 | ||
670 | sub add_shlibs_dep { | |
671 | my ($soname, $pkg, $libfile) = @_; | |
672 | my @shlibs = ($shlibslocal, $shlibsoverride); | |
673 | if ($pkg eq '') { | |
674 | # If the file is not packaged, try to find out the shlibs file in | |
675 | # the package being built where the lib has been found | |
676 | my $pkg_root = guess_pkg_root_dir($libfile); | |
677 | if (defined $pkg_root) { | |
678 | push @shlibs, "$pkg_root/DEBIAN/shlibs"; | |
679 | } | |
680 | # Fallback to other shlibs files but it shouldn't be necessary | |
681 | push @shlibs, @pkg_shlibs; | |
682 | } else { | |
683 | my $control_file = get_control_path($pkg, 'shlibs'); | |
684 | push @shlibs, $control_file if defined $control_file; | |
685 | } | |
686 | push @shlibs, $shlibsdefault; | |
687 | debug(1, " Looking up shlibs dependency of $soname provided by '$pkg'"); | |
688 | foreach my $file (@shlibs) { | |
689 | next if not -e $file; | |
690 | my $dep = extract_from_shlibs($soname, $file); | |
691 | if (defined($dep)) { | |
692 | debug(1, " Found $dep in $file"); | |
693 | foreach (split(/,\s*/, $dep)) { | |
694 | # Note: the value is empty for shlibs based dependency | |
695 | # symbol based dependency will put a valid version as value | |
696 | $dependencies{$cur_field}{$_} = Dpkg::Version->new(''); | |
697 | } | |
698 | return 1; | |
699 | } | |
700 | } | |
701 | debug(1, ' Found nothing'); | |
702 | return 0; | |
703 | } | |
704 | ||
705 | sub split_soname { | |
706 | my $soname = shift; | |
707 | if ($soname =~ /^(.*)\.so\.(.*)$/) { | |
708 | return wantarray ? ($1, $2) : 1; | |
709 | } elsif ($soname =~ /^(.*)-(\d.*)\.so$/) { | |
710 | return wantarray ? ($1, $2) : 1; | |
711 | } else { | |
712 | return wantarray ? () : 0; | |
713 | } | |
714 | } | |
715 | ||
716 | sub extract_from_shlibs { | |
717 | my ($soname, $shlibfile) = @_; | |
718 | ||
719 | my $shlibs_re = qr{ | |
720 | ^\s* | |
721 | (?:(\S+):\s+)? # Optional type | |
722 | (\S+)\s+ # Library | |
723 | (\S+) # Version | |
724 | (?: | |
725 | \s+ | |
726 | (\S.*\S) # Dependencies | |
727 | )? | |
728 | \s*$ | |
729 | }x; | |
730 | ||
731 | # Split soname in name/version | |
732 | my ($libname, $libversion) = split_soname($soname); | |
733 | unless (defined $libname) { | |
734 | warning(g_("can't extract name and version from library name '%s'"), | |
735 | $soname); | |
736 | return; | |
737 | } | |
738 | # Open shlibs file | |
739 | open(my $shlibs_fh, '<', $shlibfile) | |
740 | or syserr(g_("unable to open shared libs info file '%s'"), $shlibfile); | |
741 | my $dep; | |
742 | while (<$shlibs_fh>) { | |
743 | s/\s*\n$//; | |
744 | next if m/^\#/; | |
745 | if (!m/$shlibs_re/) { | |
746 | warning(g_("shared libs info file '%s' line %d: bad line '%s'"), | |
747 | $shlibfile, $., $_); | |
748 | next; | |
749 | } | |
750 | my $depread = $4 // ''; | |
751 | if (($libname eq $2) && ($libversion eq $3)) { | |
752 | # Define dep and end here if the package type explicitly | |
753 | # matches. Otherwise if the packagetype is not specified, use | |
754 | # the dep only as a default that can be overridden by a later | |
755 | # line | |
756 | if (defined($1)) { | |
757 | if ($1 eq $packagetype) { | |
758 | $dep = $depread; | |
759 | last; | |
760 | } | |
761 | } else { | |
762 | $dep //= $depread; | |
763 | } | |
764 | } | |
765 | } | |
766 | close($shlibs_fh); | |
767 | return $dep; | |
768 | } | |
769 | ||
770 | sub find_symbols_file { | |
771 | my ($pkg, $soname, $libfile) = @_; | |
772 | my @files; | |
773 | if ($pkg eq '') { | |
774 | # If the file is not packaged, try to find out the symbols file in | |
775 | # the package being built where the lib has been found | |
776 | my $pkg_root = guess_pkg_root_dir($libfile); | |
777 | if (defined $pkg_root) { | |
778 | push @files, "$pkg_root/DEBIAN/symbols"; | |
779 | } | |
780 | # Fallback to other symbols files but it shouldn't be necessary | |
781 | push @files, @pkg_symbols; | |
782 | } else { | |
783 | push @files, "$Dpkg::CONFDIR/symbols/$pkg.symbols.$host_arch", | |
784 | "$Dpkg::CONFDIR/symbols/$pkg.symbols"; | |
785 | my $control_file = get_control_path($pkg, 'symbols'); | |
786 | push @files, $control_file if defined $control_file; | |
787 | } | |
788 | ||
789 | foreach my $file (@files) { | |
790 | if (-e $file and symfile_has_soname($file, $soname)) { | |
791 | return $file; | |
792 | } | |
793 | } | |
794 | return; | |
795 | } | |
796 | ||
797 | sub symfile_has_soname { | |
798 | my ($file, $soname) = @_; | |
799 | ||
800 | if (exists $symfile_has_soname_cache{$file}{$soname}) { | |
801 | return $symfile_has_soname_cache{$file}{$soname}; | |
802 | } | |
803 | ||
804 | open(my $symfile_fh, '<', $file) | |
805 | or syserr(g_('cannot open file %s'), $file); | |
806 | my $result = 0; | |
807 | while (<$symfile_fh>) { | |
808 | if (/^\Q$soname\E /) { | |
809 | $result = 1; | |
810 | last; | |
811 | } | |
812 | } | |
813 | close($symfile_fh); | |
814 | $symfile_has_soname_cache{$file}{$soname} = $result; | |
815 | return $result; | |
816 | } | |
817 | ||
818 | # find_library ($soname, \@rpath, $format) | |
819 | sub my_find_library { | |
820 | my ($lib, $rpath, $format, $execfile) = @_; | |
821 | my $file; | |
822 | ||
823 | # Create real RPATH in case $ORIGIN is used | |
824 | # Note: ld.so also supports $PLATFORM and $LIB but they are | |
825 | # used in real case (yet) | |
826 | my $libdir = relative_to_pkg_root($execfile); | |
827 | my $origin; | |
828 | if (defined $libdir) { | |
829 | $origin = "/$libdir"; | |
830 | $origin =~ s{/+[^/]*$}{}; | |
831 | } | |
832 | my @RPATH = (); | |
833 | foreach my $path (@{$rpath}) { | |
834 | if ($path =~ /\$ORIGIN|\$\{ORIGIN\}/) { | |
835 | if (defined $origin) { | |
836 | $path =~ s/\$ORIGIN/$origin/g; | |
837 | $path =~ s/\$\{ORIGIN\}/$origin/g; | |
838 | } else { | |
839 | warning(g_('$ORIGIN is used in RPATH of %s and the corresponding ' . | |
840 | 'directory could not be identified due to lack of DEBIAN ' . | |
841 | "sub-directory in the root of package's build tree"), $execfile); | |
842 | } | |
843 | } | |
844 | push @RPATH, $path; | |
845 | } | |
846 | ||
847 | # Look into the packages we're currently building in the following | |
848 | # order: | |
849 | # - package build tree of the binary which is analyzed | |
850 | # - package build tree given on the command line (option -S) | |
851 | # - other package build trees that contain either a shlibs or a | |
852 | # symbols file | |
853 | # But ignore: | |
854 | # - package build tree given on the command line (option -I) | |
855 | ||
856 | my @builddirs; | |
857 | my $pkg_root = guess_pkg_root_dir($execfile); | |
858 | push @builddirs, $pkg_root if defined $pkg_root; | |
859 | push @builddirs, @pkg_dir_to_search; | |
860 | push @builddirs, @pkg_root_dirs; | |
861 | my %dir_checked; | |
862 | foreach my $builddir (@builddirs) { | |
863 | next if defined($dir_checked{$builddir}); | |
864 | next if ignore_pkgdir($builddir); | |
865 | my @libs = find_library($lib, \@RPATH, $format, $builddir); | |
866 | return @libs if scalar @libs; | |
867 | $dir_checked{$builddir} = 1; | |
868 | } | |
869 | ||
870 | # Fallback in the root directory if we have not found what we were | |
871 | # looking for in the packages | |
872 | return find_library($lib, \@RPATH, $format, ''); | |
873 | } | |
874 | ||
875 | my %cached_pkgmatch = (); | |
876 | ||
877 | sub find_packages { | |
878 | my @files; | |
879 | my $pkgmatch = {}; | |
880 | ||
881 | foreach my $path (@_) { | |
882 | if (exists $cached_pkgmatch{$path}) { | |
883 | $pkgmatch->{$path} = $cached_pkgmatch{$path}; | |
884 | } else { | |
885 | push @files, $path; | |
886 | $cached_pkgmatch{$path} = ['']; # placeholder to cache misses too. | |
887 | $pkgmatch->{$path} = ['']; # might be replaced later on | |
888 | } | |
889 | } | |
890 | return $pkgmatch unless scalar(@files); | |
891 | ||
892 | my $pid = open(my $dpkg_fh, '-|'); | |
893 | syserr(g_('cannot fork for %s'), 'dpkg-query --search') unless defined $pid; | |
894 | if (!$pid) { | |
895 | # Child process running dpkg --search and discarding errors | |
896 | close STDERR; | |
897 | open STDERR, '>', '/dev/null' | |
898 | or syserr(g_('cannot open file %s'), '/dev/null'); | |
899 | $ENV{LC_ALL} = 'C'; | |
900 | exec 'dpkg-query', '--search', '--', @files | |
901 | or syserr(g_('unable to execute %s'), 'dpkg'); | |
902 | } | |
903 | while (<$dpkg_fh>) { | |
904 | chomp; | |
905 | if (m/^local diversion |^diversion by/) { | |
906 | warning(g_('diversions involved - output may be incorrect')); | |
907 | print { *STDERR } " $_\n" | |
908 | or syserr(g_('write diversion info to stderr')); | |
909 | } elsif (m/^([-a-z0-9+.:, ]+): (\/.*)$/) { | |
910 | my ($pkgs, $path) = ($1, $2); | |
911 | my $realpath = realpath($path); | |
912 | $cached_pkgmatch{$path} = $pkgmatch->{$path} = [ split /, /, $pkgs ]; | |
913 | $cached_pkgmatch{$realpath} = $pkgmatch->{$realpath} = [ split /, /, $pkgs ]; | |
914 | } else { | |
915 | warning(g_("unknown output from dpkg --search: '%s'"), $_); | |
916 | } | |
917 | } | |
918 | close($dpkg_fh); | |
919 | return $pkgmatch; | |
920 | } |