dpkg-shlibdeps.pl 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701
  1. #!/usr/bin/perl -w
  2. use strict;
  3. use warnings;
  4. use English;
  5. use POSIX qw(:errno_h :signal_h);
  6. use Cwd qw(realpath);
  7. use Dpkg;
  8. use Dpkg::Gettext;
  9. use Dpkg::ErrorHandling qw(warning error failure syserr usageerr);
  10. use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir
  11. check_files_are_the_same);
  12. use Dpkg::Version qw(compare_versions);
  13. use Dpkg::Shlibs qw(find_library);
  14. use Dpkg::Shlibs::Objdump;
  15. use Dpkg::Shlibs::SymbolFile;
  16. use Dpkg::Arch qw(get_host_arch);
  17. use Dpkg::Fields qw(capit);
  18. use Dpkg::Deps;
  19. use Dpkg::Control;
  20. # By increasing importance
  21. my @depfields = qw(Suggests Recommends Depends Pre-Depends);
  22. my $i = 0; my %depstrength = map { $_ => $i++ } @depfields;
  23. textdomain("dpkg-dev");
  24. my $shlibsoverride = '/etc/dpkg/shlibs.override';
  25. my $shlibsdefault = '/etc/dpkg/shlibs.default';
  26. my $shlibslocal = 'debian/shlibs.local';
  27. my $packagetype = 'deb';
  28. my $dependencyfield = 'Depends';
  29. my $varlistfile = 'debian/substvars';
  30. my $varnameprefix = 'shlibs';
  31. my $ignore_missing_info = 0;
  32. my $debug = 0;
  33. my @exclude = ();
  34. my @pkg_dir_to_search = ();
  35. my $host_arch = get_host_arch();
  36. my (@pkg_shlibs, @pkg_symbols, @pkg_root_dirs);
  37. if (-d "debian") {
  38. push @pkg_symbols, <debian/*/DEBIAN/symbols>;
  39. push @pkg_shlibs, <debian/*/DEBIAN/shlibs>;
  40. my %uniq = map { guess_pkg_root_dir($_) => 1 } (@pkg_symbols, @pkg_shlibs);
  41. push @pkg_root_dirs, keys %uniq;
  42. }
  43. my ($stdout, %exec);
  44. foreach (@ARGV) {
  45. if (m/^-T(.*)$/) {
  46. $varlistfile = $1;
  47. } elsif (m/^-p(\w[-:0-9A-Za-z]*)$/) {
  48. $varnameprefix = $1;
  49. } elsif (m/^-L(.*)$/) {
  50. $shlibslocal = $1;
  51. } elsif (m/^-S(.*)$/) {
  52. push @pkg_dir_to_search, $1;
  53. } elsif (m/^-O$/) {
  54. $stdout = 1;
  55. } elsif (m/^-(h|-help)$/) {
  56. usage(); exit(0);
  57. } elsif (m/^--version$/) {
  58. version(); exit(0);
  59. } elsif (m/^--admindir=(.*)$/) {
  60. $admindir = $1;
  61. -d $admindir ||
  62. error(_g("administrative directory '%s' does not exist"), $admindir);
  63. } elsif (m/^-d(.*)$/) {
  64. $dependencyfield = capit($1);
  65. defined($depstrength{$dependencyfield}) ||
  66. warning(_g("unrecognised dependency field \`%s'"), $dependencyfield);
  67. } elsif (m/^-e(.*)$/) {
  68. if (exists $exec{$1}) {
  69. # Affect the binary to the most important field
  70. if ($depstrength{$dependencyfield} > $depstrength{$exec{$1}}) {
  71. $exec{$1} = $dependencyfield;
  72. }
  73. } else {
  74. $exec{$1} = $dependencyfield;
  75. }
  76. } elsif (m/^--ignore-missing-info$/) {
  77. $ignore_missing_info = 1;
  78. } elsif (m/^-t(.*)$/) {
  79. $packagetype = $1;
  80. } elsif (m/^-v$/) {
  81. $debug = 1;
  82. } elsif (m/^-x(.*)$/) {
  83. push @exclude, $1;
  84. } elsif (m/^-/) {
  85. usageerr(_g("unknown option \`%s'"), $_);
  86. } else {
  87. if (exists $exec{$_}) {
  88. # Affect the binary to the most important field
  89. if ($depstrength{$dependencyfield} > $depstrength{$exec{$_}}) {
  90. $exec{$_} = $dependencyfield;
  91. }
  92. } else {
  93. $exec{$_} = $dependencyfield;
  94. }
  95. }
  96. }
  97. scalar keys %exec || usageerr(_g("need at least one executable"));
  98. my $control = Dpkg::Control->new();
  99. my $fields = $control->get_source();
  100. my $build_depends = defined($fields->{"Build-Depends"}) ?
  101. $fields->{"Build-Depends"} : "";
  102. my $build_deps = Dpkg::Deps::parse($build_depends, reduce_arch => 1);
  103. my %dependencies;
  104. my %shlibs;
  105. my $cur_field;
  106. foreach my $file (keys %exec) {
  107. $cur_field = $exec{$file};
  108. print "Scanning $file (for $cur_field field)\n" if $debug;
  109. my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
  110. my @sonames = $obj->get_needed_libraries;
  111. # Load symbols files for all needed libraries (identified by SONAME)
  112. my %libfiles;
  113. my %altlibfiles;
  114. my %soname_notfound;
  115. foreach my $soname (@sonames) {
  116. my $lib = my_find_library($soname, $obj->{RPATH}, $obj->{format}, $file);
  117. unless (defined $lib) {
  118. $soname_notfound{$soname} = 1;
  119. my $msg = _g("couldn't find library %s needed by %s (its RPATH is '%s').\n" .
  120. "Note: libraries are not searched in other binary packages " .
  121. "that do not have any shlibs or symbols file.\nTo help dpkg-shlibdeps " .
  122. "find private libraries, you might need to set LD_LIBRARY_PATH.");
  123. if (scalar(split_soname($soname))) {
  124. failure($msg, $soname, $file, join(":", @{$obj->{RPATH}}));
  125. } else {
  126. warning($msg, $soname, $file, join(":", @{$obj->{RPATH}}));
  127. }
  128. next;
  129. }
  130. $libfiles{$lib} = $soname;
  131. my $reallib = realpath($lib);
  132. if ($reallib ne $lib) {
  133. $altlibfiles{$reallib} = $soname;
  134. }
  135. print "Library $soname found in $lib\n" if $debug;
  136. }
  137. my $file2pkg = find_packages(keys %libfiles, keys %altlibfiles);
  138. my $symfile = Dpkg::Shlibs::SymbolFile->new();
  139. my $dumplibs_wo_symfile = Dpkg::Shlibs::Objdump->new();
  140. my @soname_wo_symfile;
  141. foreach my $lib (keys %libfiles) {
  142. my $soname = $libfiles{$lib};
  143. if (not scalar(grep { $_ ne '' } @{$file2pkg->{$lib}})) {
  144. # The path of the library as calculated is not the
  145. # official path of a packaged file, try to fallback on
  146. # on the realpath() first, maybe this one is part of a package
  147. my $reallib = realpath($lib);
  148. if (exists $file2pkg->{$reallib}) {
  149. $file2pkg->{$lib} = $file2pkg->{$reallib};
  150. }
  151. }
  152. if (not scalar(grep { $_ ne '' } @{$file2pkg->{$lib}})) {
  153. # If the library is really not available in an installed package,
  154. # it's because it's in the process of being built
  155. # Empty package name will lead to consideration of symbols
  156. # file from the package being built only
  157. $file2pkg->{$lib} = [""];
  158. print "No associated package found for $lib\n" if $debug;
  159. }
  160. # Load symbols/shlibs files from packages providing libraries
  161. foreach my $pkg (@{$file2pkg->{$lib}}) {
  162. my $dpkg_symfile;
  163. if ($packagetype eq "deb") {
  164. # Use fine-grained dependencies only on real deb
  165. $dpkg_symfile = find_symbols_file($pkg, $soname, $lib);
  166. if (defined $dpkg_symfile) {
  167. # Load symbol information
  168. print "Using symbols file $dpkg_symfile for $soname\n" if $debug;
  169. $symfile->load($dpkg_symfile);
  170. }
  171. }
  172. if (defined($dpkg_symfile) && $symfile->has_object($soname)) {
  173. # Initialize dependencies as an unversioned dependency
  174. my $dep = $symfile->get_dependency($soname);
  175. foreach my $subdep (split /\s*,\s*/, $dep) {
  176. if (not exists $dependencies{$cur_field}{$subdep}) {
  177. $dependencies{$cur_field}{$subdep} = '';
  178. }
  179. }
  180. } else {
  181. # No symbol file found, fall back to standard shlibs
  182. my $id = $dumplibs_wo_symfile->parse($lib);
  183. push @soname_wo_symfile, $soname;
  184. my $libobj = $dumplibs_wo_symfile->get_object($id);
  185. # Only try to generate a dependency for libraries with a SONAME
  186. if ($libobj->is_public_library() and not
  187. add_shlibs_dep($soname, $pkg, $lib)) {
  188. # This failure is fairly new, try to be kind by
  189. # ignoring as many cases that can be safely ignored
  190. my $ignore = 0;
  191. # 1/ when the lib and the binary are in the same
  192. # package
  193. my $root_file = guess_pkg_root_dir($file);
  194. my $root_lib = guess_pkg_root_dir($lib);
  195. $ignore++ if defined $root_file and defined $root_lib
  196. and check_files_are_the_same($root_file, $root_lib);
  197. # 2/ when the lib is not versioned and can't be
  198. # handled by shlibs
  199. $ignore++ unless scalar(split_soname($soname));
  200. # 3/ when we have been asked to do so
  201. $ignore++ if $ignore_missing_info;
  202. failure(_g("no dependency information found for %s " .
  203. "(used by %s)."), $lib, $file)
  204. unless $ignore;
  205. }
  206. }
  207. }
  208. }
  209. # Scan all undefined symbols of the binary and resolve to a
  210. # dependency
  211. my %used_sonames = map { $_ => 0 } @sonames;
  212. my $nb_warnings = 0;
  213. my $nb_skipped_warnings = 0;
  214. # Disable warnings about missing symbols when we have not been able to
  215. # find all libs
  216. my $disable_warnings = scalar(keys(%soname_notfound));
  217. foreach my $sym ($obj->get_undefined_dynamic_symbols()) {
  218. my $name = $sym->{name};
  219. if ($sym->{version}) {
  220. $name .= "\@$sym->{version}";
  221. } else {
  222. $name .= "\@Base";
  223. }
  224. my $symdep = $symfile->lookup_symbol($name, \@sonames);
  225. if (defined($symdep)) {
  226. $used_sonames{$symdep->{soname}}++;
  227. update_dependency_version($symdep->{depends},
  228. $symdep->{minver});
  229. } else {
  230. my $syminfo = $dumplibs_wo_symfile->locate_symbol($name);
  231. if (not defined($syminfo)) {
  232. next if $disable_warnings;
  233. # Complain about missing symbols only for executables
  234. # and public libraries
  235. if ($obj->is_executable() or $obj->is_public_library()) {
  236. my $print_name = $name;
  237. # Drop the default suffix for readability
  238. $print_name =~ s/\@Base$//;
  239. unless ($sym->{weak}) {
  240. if ($debug or $nb_warnings < 10) {
  241. warning(_g("symbol %s used by %s found in none of the " .
  242. "libraries."), $print_name, $file);
  243. $nb_warnings++;
  244. } else {
  245. $nb_skipped_warnings++;
  246. }
  247. }
  248. }
  249. } else {
  250. $used_sonames{$syminfo->{soname}}++;
  251. }
  252. }
  253. }
  254. warning(_g("%d other similar warnings have been skipped (use -v to see " .
  255. "them all)."), $nb_skipped_warnings) if $nb_skipped_warnings;
  256. foreach my $soname (@sonames) {
  257. # Adjust minimal version of dependencies with information
  258. # extracted from build-dependencies
  259. my $dev_pkg = $symfile->get_field($soname, 'Build-Depends-Package');
  260. if (defined $dev_pkg) {
  261. my $minver = get_min_version_from_deps($build_deps, $dev_pkg);
  262. if (defined $minver) {
  263. foreach my $dep ($symfile->get_dependencies($soname)) {
  264. update_dependency_version($dep, $minver);
  265. }
  266. }
  267. }
  268. # Warn about un-NEEDED libraries
  269. unless ($soname_notfound{$soname} or $used_sonames{$soname}) {
  270. # Ignore warning for libm.so.6 if also linked against libstdc++
  271. next if ($soname =~ /^libm\.so\.\d+$/ and
  272. scalar grep(/^libstdc\+\+\.so\.\d+/, @sonames));
  273. warning(_g("%s shouldn't be linked with %s (it uses none of its " .
  274. "symbols)."), $file, $soname);
  275. }
  276. }
  277. }
  278. # Open substvars file
  279. my $fh;
  280. if ($stdout) {
  281. $fh = \*STDOUT;
  282. } else {
  283. open(NEW, ">", "$varlistfile.new") ||
  284. syserr(_g("open new substvars file \`%s'"), "$varlistfile.new");
  285. if (-e $varlistfile) {
  286. open(OLD, "<", $varlistfile) ||
  287. syserr(_g("open old varlist file \`%s' for reading"), $varlistfile);
  288. foreach my $entry (grep { not m/^\Q$varnameprefix\E:/ } (<OLD>)) {
  289. print(NEW $entry) ||
  290. syserr(_g("copy old entry to new varlist file \`%s'"),
  291. "$varlistfile.new");
  292. }
  293. close(OLD);
  294. }
  295. $fh = \*NEW;
  296. }
  297. # Write out the shlibs substvars
  298. my %depseen;
  299. sub filter_deps {
  300. my ($dep, $field) = @_;
  301. # Skip dependencies on excluded packages
  302. foreach my $exc (@exclude) {
  303. return 0 if $dep =~ /^\s*\Q$exc\E\b/;
  304. }
  305. # Don't include dependencies if they are already
  306. # mentionned in a higher priority field
  307. if (not exists($depseen{$dep})) {
  308. $depseen{$dep} = $dependencies{$field}{$dep};
  309. return 1;
  310. } else {
  311. # Since dependencies can be versionned, we have to
  312. # verify if the dependency is stronger than the
  313. # previously seen one
  314. my $stronger;
  315. if ($depseen{$dep} eq $dependencies{$field}{$dep}) {
  316. # If both versions are the same (possibly unversionned)
  317. $stronger = 0;
  318. } elsif ($dependencies{$field}{$dep} eq '') {
  319. $stronger = 0; # If the dep is unversionned
  320. } elsif ($depseen{$dep} eq '') {
  321. $stronger = 1; # If the dep seen is unversionned
  322. } elsif (compare_versions($depseen{$dep}, '>>', $dependencies{$field}{$dep})) {
  323. # The version of the dep seen is stronger...
  324. $stronger = 0;
  325. } else {
  326. $stronger = 1;
  327. }
  328. $depseen{$dep} = $dependencies{$field}{$dep} if $stronger;
  329. return $stronger;
  330. }
  331. }
  332. foreach my $field (reverse @depfields) {
  333. my $dep = "";
  334. if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) {
  335. $dep = join ", ",
  336. map {
  337. # Translate dependency templates into real dependencies
  338. if ($dependencies{$field}{$_}) {
  339. s/#MINVER#/(>= $dependencies{$field}{$_})/g;
  340. } else {
  341. s/#MINVER#//g;
  342. }
  343. s/\s+/ /g;
  344. $_;
  345. } grep { filter_deps($_, $field) }
  346. keys %{$dependencies{$field}};
  347. }
  348. if ($dep) {
  349. print $fh "$varnameprefix:$field=$dep\n";
  350. }
  351. }
  352. # Replace old file by new one
  353. if (!$stdout) {
  354. close($fh);
  355. rename("$varlistfile.new",$varlistfile) ||
  356. syserr(_g("install new varlist file \`%s'"), $varlistfile);
  357. }
  358. ##
  359. ## Functions
  360. ##
  361. sub version {
  362. printf _g("Debian %s version %s.\n"), $progname, $version;
  363. printf _g("
  364. Copyright (C) 1996 Ian Jackson.
  365. Copyright (C) 2000 Wichert Akkerman.
  366. Copyright (C) 2006 Frank Lichtenheld.
  367. Copyright (C) 2007 Raphael Hertzog.
  368. ");
  369. printf _g("
  370. This is free software; see the GNU General Public Licence version 2 or
  371. later for copying conditions. There is NO warranty.
  372. ");
  373. }
  374. sub usage {
  375. printf _g(
  376. "Usage: %s [<option> ...] <executable>|-e<executable> [<option> ...]
  377. Positional options (order is significant):
  378. <executable> include dependencies for <executable>,
  379. -e<executable> (use -e if <executable> starts with \`-')
  380. -d<dependencyfield> next executable(s) set shlibs:<dependencyfield>.
  381. Options:
  382. -p<varnameprefix> set <varnameprefix>:* instead of shlibs:*.
  383. -O print variable settings to stdout.
  384. -L<localshlibsfile> shlibs override file, not debian/shlibs.local.
  385. -T<varlistfile> update variables here, not debian/substvars.
  386. -t<type> set package type (default is deb).
  387. -x<package> exclude package from the generated dependencies.
  388. -S<pkgbuilddir> search needed libraries in the given
  389. package build directory first.
  390. --admindir=<directory> change the administrative directory.
  391. -h, --help show this help message.
  392. --version show the version.
  393. Dependency fields recognised are:
  394. %s
  395. "), $progname, join("/",@depfields);
  396. }
  397. sub get_min_version_from_deps {
  398. my ($dep, $pkg) = @_;
  399. if ($dep->isa('Dpkg::Deps::Simple')) {
  400. if (($dep->{package} eq $pkg) &&
  401. defined($dep->{relation}) &&
  402. (($dep->{relation} eq ">=") ||
  403. ($dep->{relation} eq ">>")))
  404. {
  405. return $dep->{version};
  406. }
  407. return undef;
  408. } else {
  409. my $res;
  410. foreach my $subdep ($dep->get_deps()) {
  411. my $minver = get_min_version_from_deps($subdep, $pkg);
  412. next if not defined $minver;
  413. if (defined $res) {
  414. if (compare_versions($minver, '>>', $res)) {
  415. $res = $minver;
  416. }
  417. } else {
  418. $res = $minver;
  419. }
  420. }
  421. return $res;
  422. }
  423. }
  424. sub update_dependency_version {
  425. my ($dep, $minver) = @_;
  426. return if not defined($minver);
  427. foreach my $subdep (split /\s*,\s*/, $dep) {
  428. if (exists $dependencies{$cur_field}{$subdep} and
  429. defined($dependencies{$cur_field}{$subdep}))
  430. {
  431. if ($dependencies{$cur_field}{$subdep} eq '' or
  432. compare_versions($minver, '>>',
  433. $dependencies{$cur_field}{$subdep}))
  434. {
  435. $dependencies{$cur_field}{$subdep} = $minver;
  436. }
  437. } else {
  438. $dependencies{$cur_field}{$subdep} = $minver;
  439. }
  440. }
  441. }
  442. sub add_shlibs_dep {
  443. my ($soname, $pkg, $libfile) = @_;
  444. my @shlibs = ($shlibslocal, $shlibsoverride);
  445. if ($pkg eq "") {
  446. # If the file is not packaged, try to find out the shlibs file in
  447. # the package being built where the lib has been found
  448. my $pkg_root = guess_pkg_root_dir($libfile);
  449. if (defined $pkg_root) {
  450. push @shlibs, "$pkg_root/DEBIAN/shlibs";
  451. }
  452. # Fallback to other shlibs files but it shouldn't be necessary
  453. push @shlibs, @pkg_shlibs;
  454. } else {
  455. push @shlibs, "$admindir/info/$pkg.shlibs";
  456. }
  457. push @shlibs, $shlibsdefault;
  458. print "Looking up shlibs dependency of $soname provided by '$pkg'\n" if $debug;
  459. foreach my $file (@shlibs) {
  460. next if not -e $file;
  461. my $dep = extract_from_shlibs($soname, $file);
  462. if (defined($dep)) {
  463. print "Found $dep in $file\n" if $debug;
  464. foreach (split(/,\s*/, $dep)) {
  465. # Note: the value is empty for shlibs based dependency
  466. # symbol based dependency will put a version as value
  467. $dependencies{$cur_field}{$_} = '';
  468. }
  469. return 1;
  470. }
  471. }
  472. print "Found nothing\n" if $debug;
  473. return 0;
  474. }
  475. sub split_soname {
  476. my $soname = shift;
  477. if ($soname =~ /^(.*)\.so\.(.*)$/) {
  478. return wantarray ? ($1, $2) : 1;
  479. } elsif ($soname =~ /^(.*)-(\d.*)\.so$/) {
  480. return wantarray ? ($1, $2) : 1;
  481. } else {
  482. return wantarray ? () : 0;
  483. }
  484. }
  485. sub extract_from_shlibs {
  486. my ($soname, $shlibfile) = @_;
  487. # Split soname in name/version
  488. my ($libname, $libversion) = split_soname($soname);
  489. unless (defined $libname) {
  490. warning(_g("Can't extract name and version from library name \`%s'"),
  491. $soname);
  492. return;
  493. }
  494. # Open shlibs file
  495. $shlibfile = "./$shlibfile" if $shlibfile =~ m/^\s/;
  496. open(SHLIBS, "<", $shlibfile) ||
  497. syserr(_g("unable to open shared libs info file \`%s'"), $shlibfile);
  498. my $dep;
  499. while (<SHLIBS>) {
  500. s/\s*\n$//;
  501. next if m/^\#/;
  502. if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)(?:\s+(\S.*\S))?\s*$/) {
  503. warning(_g("shared libs info file \`%s' line %d: bad line \`%s'"),
  504. $shlibfile, $., $_);
  505. next;
  506. }
  507. my $depread = defined($4) ? $4 : '';
  508. if (($libname eq $2) && ($libversion eq $3)) {
  509. # Define dep and end here if the package type explicitely
  510. # matches. Otherwise if the packagetype is not specified, use
  511. # the dep only as a default that can be overriden by a later
  512. # line
  513. if (defined($1)) {
  514. if ($1 eq $packagetype) {
  515. $dep = $depread;
  516. last;
  517. }
  518. } else {
  519. $dep = $depread unless defined $dep;
  520. }
  521. }
  522. }
  523. close(SHLIBS);
  524. return $dep;
  525. }
  526. sub find_symbols_file {
  527. my ($pkg, $soname, $libfile) = @_;
  528. my @files;
  529. if ($pkg eq "") {
  530. # If the file is not packaged, try to find out the symbols file in
  531. # the package being built where the lib has been found
  532. my $pkg_root = guess_pkg_root_dir($libfile);
  533. if (defined $pkg_root) {
  534. push @files, "$pkg_root/DEBIAN/symbols";
  535. }
  536. # Fallback to other symbols files but it shouldn't be necessary
  537. push @files, @pkg_symbols;
  538. } else {
  539. push @files, "/etc/dpkg/symbols/$pkg.symbols.$host_arch",
  540. "/etc/dpkg/symbols/$pkg.symbols",
  541. "$admindir/info/$pkg.symbols";
  542. }
  543. foreach my $file (@files) {
  544. if (-e $file and symfile_has_soname($file, $soname)) {
  545. return $file;
  546. }
  547. }
  548. return undef;
  549. }
  550. sub symfile_has_soname {
  551. my ($file, $soname) = @_;
  552. open(SYM_FILE, "<", $file) ||
  553. syserr(_g("cannot open file %s"), $file);
  554. my $result = 0;
  555. while (<SYM_FILE>) {
  556. if (/^\Q$soname\E /) {
  557. $result = 1;
  558. last;
  559. }
  560. }
  561. close(SYM_FILE);
  562. return $result;
  563. }
  564. # find_library ($soname, \@rpath, $format)
  565. sub my_find_library {
  566. my ($lib, $rpath, $format, $execfile) = @_;
  567. my $file;
  568. # Create real RPATH in case $ORIGIN is used
  569. # Note: ld.so also supports $PLATFORM and $LIB but they are
  570. # used in real case (yet)
  571. my $libdir = relative_to_pkg_root($execfile);
  572. my $origin;
  573. if (defined $libdir) {
  574. $origin = "/$libdir";
  575. $origin =~ s{/+[^/]*$}{};
  576. }
  577. my @RPATH = ();
  578. foreach my $path (@{$rpath}) {
  579. if ($path =~ /\$ORIGIN|\$\{ORIGIN\}/) {
  580. if (defined $origin) {
  581. $path =~ s/\$ORIGIN/$origin/g;
  582. $path =~ s/\$\{ORIGIN\}/$origin/g;
  583. } else {
  584. warning(_g("\$ORIGIN is used in RPATH of %s and the corresponding " .
  585. "directory could not be identified due to lack of DEBIAN " .
  586. "sub-directory in the root of package's build tree"), $execfile);
  587. }
  588. }
  589. push @RPATH, $path;
  590. }
  591. # Look into the packages we're currently building in the following
  592. # order:
  593. # - package build tree of the binary which is analyzed
  594. # - package build tree given on the command line (option -S)
  595. # - other package build trees that contain either a shlibs or a
  596. # symbols file
  597. my @builddirs;
  598. my $pkg_root = guess_pkg_root_dir($execfile);
  599. push @builddirs, $pkg_root if defined $pkg_root;
  600. push @builddirs, @pkg_dir_to_search;
  601. push @builddirs, @pkg_root_dirs;
  602. my %dir_checked;
  603. foreach my $builddir (@builddirs) {
  604. next if defined($dir_checked{$builddir});
  605. $file = find_library($lib, \@RPATH, $format, $builddir);
  606. return $file if defined($file);
  607. $dir_checked{$builddir} = 1;
  608. }
  609. # Fallback in the root directory if we have not found what we were
  610. # looking for in the packages
  611. $file = find_library($lib, \@RPATH, $format, "");
  612. return $file if defined($file);
  613. return undef;
  614. }
  615. my %cached_pkgmatch = ();
  616. sub find_packages {
  617. my @files;
  618. my $pkgmatch = {};
  619. foreach (@_) {
  620. if (exists $cached_pkgmatch{$_}) {
  621. $pkgmatch->{$_} = $cached_pkgmatch{$_};
  622. } else {
  623. push @files, $_;
  624. $cached_pkgmatch{$_} = [""]; # placeholder to cache misses too.
  625. $pkgmatch->{$_} = [""]; # might be replaced later on
  626. }
  627. }
  628. return $pkgmatch unless scalar(@files);
  629. my $pid = open(DPKG, "-|");
  630. syserr(_g("cannot fork for dpkg --search")) unless defined($pid);
  631. if (!$pid) {
  632. # Child process running dpkg --search and discarding errors
  633. close STDERR;
  634. open STDERR, ">", "/dev/null";
  635. $ENV{LC_ALL} = "C";
  636. exec("dpkg", "--search", "--", @files)
  637. || syserr(_g("cannot exec dpkg"));
  638. }
  639. while(defined($_ = <DPKG>)) {
  640. chomp($_);
  641. if (m/^local diversion |^diversion by/) {
  642. warning(_g("diversions involved - output may be incorrect"));
  643. print(STDERR " $_\n")
  644. || syserr(_g("write diversion info to stderr"));
  645. } elsif (m/^([^:]+): (\S+)$/) {
  646. $cached_pkgmatch{$2} = $pkgmatch->{$2} = [ split(/, /, $1) ];
  647. } else {
  648. warning(_g("unknown output from dpkg --search: '%s'"), $_);
  649. }
  650. }
  651. close(DPKG);
  652. return $pkgmatch;
  653. }