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 |