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