vcs.maemo.org Git - maemian/blob - nokia-lintian/checks/shared-libs

   1 # shared-libs -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 package Lintian::shared_libs;
  22 use strict;
  23
  24 use File::Basename;
  25
  26 use Lintian::Data;
  27 use Dep;
  28 use Tags;
  29 use Util;
  30
  31 sub run {
  32
  33 # Libraries that should only be used in the presence of certain capabilities
  34 # may be located in subdirectories of the standard ldconfig search path with
  35 # one of the following names.
  36 my %hwcap_dir = map { $_ => 1 }
  37     qw( i486 i586 i686 cmov tls );
  38
  39 # The following architectures should always have a STACK setting in shared
  40 # libraries to disable executable stack.  Other architectures don't always add
  41 # this section and therefore can't be checked.
  42 my %stack_arches = map { $_ => 1 }
  43     qw( alpha
  44         amd64
  45         i386
  46         m68k
  47         powerpc
  48         s390
  49         sparc
  50       );
  51
  52 my $ldconfig_dirs = Lintian::Data->new('shared-libs/ldconfig-dirs');
  53 my $file;
  54 my $must_call_ldconfig;
  55 my $postrm = "control/postrm";
  56 my $postinst = "control/postinst";
  57 my $preinst = "control/preinst";
  58 my $prerm = "control/prerm";
  59 my $shlibs_control_file = "control/shlibs";
  60 my $symbols_control_file = "control/symbols";
  61 my %SONAME;
  62 my %INTERP;
  63 my %STACK;
  64 my %TEXTREL;
  65 my %objsomething;
  66 my %sharedobject;
  67 my %index_info;
  68 my %link_info;
  69 my @shlibs;
  70 my @words;
  71
  72 # ---end-of-configuration-part---
  73
  74 my $pkg = shift;
  75 my $type = shift;
  76
  77 # 1st step: get info about shared libraries installed by this package
  78 open(IN, '<', "objdump-info")
  79     or fail("cannot find objdump-info for $type package $pkg");
  80 while (<IN>) {
  81     chop;
  82
  83     #skip blank lines
  84     next if m/^\s*$/o;
  85
  86     if (m/^-- (\S+)\s*$/o) {
  87         $file = $1;
  88         $file =~ s,^(\./)?,,;
  89     } elsif (m/^\s*SONAME\s+(\S+)/o) {
  90         $SONAME{$file} = $1;
  91     } elsif (m/^\s*TEXTREL\s/o) {
  92         $TEXTREL{$file} = 1;
  93     } elsif (m/^\s*INTERP\s/) {
  94         $INTERP{$file} = 1;
  95     } elsif (m/^\s*STACK\s/) {
  96         $STACK{$file} = 0;
  97     } else {
  98         if (defined $STACK{$file} and $STACK{$file} eq 0) {
  99             m/\sflags\s+(\S+)/o;
 100             $STACK{$file} = $1;
 101         }
 102         else {
 103             $objsomething{$file} = 1;
 104         }
 105     }
 106 }
 107 close(IN);
 108
 109 open (IN, '<', "file-info")
 110     or fail("cannot find file-info for $type package $pkg");
 111 while (<IN>) {
 112     chomp;
 113     # with file names containing colons and spaces, we're fucked.
 114     m/^(?:\.\/)?(.+?):\s+(.*)$/o or fail("unrecognized file(1) output: $_");
 115     my ($file,$info) = ($1,$2);
 116     if ($info =~ m/^[^,]*\bELF\b/ && $info =~ m/shared object/) {
 117         $sharedobject{$file} = 1;
 118     }
 119 }
 120 close(IN);
 121
 122 # 2nd step: read package contents
 123 my %files;
 124 open(IN, '<', "index") or fail("cannot open index file index: $!");
 125 while (<IN>) {
 126     chop;
 127     @words = split(/\s+/o, $_, 6);
 128     my $perm = $words[0];
 129     my $cur_file = $words[5];
 130     $cur_file =~ s,^(\./),,;
 131     $cur_file =~ s/ link to .*//;
 132
 133     if ($perm =~ m/^l/) {
 134         my $link;
 135         ($cur_file, $link) = split(' -> ', $cur_file);
 136         $link_info{$cur_file} = $link;
 137     }
 138     $index_info{$cur_file} = 1;
 139     $files{$cur_file} = $perm;
 140 }
 141
 142 for (keys %files) {
 143     my ($cur_file, $perm) = ($_, $files{$_});
 144
 145     # shared library?
 146     if (exists $SONAME{$cur_file} or
 147         ($link_info{$cur_file} and exists $SONAME{abs_path(dirname($cur_file)."/".$link_info{$cur_file})})) {
 148         # yes!!
 149
 150         my ($real_file, $real_perm);
 151         if ($SONAME{$cur_file}) {
 152             $real_file = $cur_file;
 153             $real_perm = $perm;
 154         } else {
 155             $real_file = abs_path(dirname($cur_file)."/".$link_info{$cur_file});
 156             $real_perm = $files{$real_file} || $perm;
 157         }
 158
 159         # Now that we're sure this is really a shared library, report on
 160         # non-PIC problems.
 161         if ($cur_file eq $real_file and $TEXTREL{$cur_file}) {
 162             tag "shlib-with-non-pic-code", "$cur_file";
 163         }
 164
 165         # don't apply the permission checks to links
 166         # since this only results in doubled messages
 167         if ($cur_file eq $real_file) {
 168             # executable?
 169             if ($real_perm =~ m/x/) {
 170                 # yes.  But if the library has an INTERP section, it's designed
 171                 # to do something useful when executed, so don't report an error.
 172                 tag "shlib-with-executable-bit", $cur_file, sprintf("%04o",perm2oct($real_perm))
 173                     unless $INTERP{$real_file};
 174             } elsif ($real_perm ne '-rw-r--r--') {
 175                 # bad permissions
 176                 tag "shlib-with-bad-permissions", $cur_file, sprintf("%04o",perm2oct($real_perm));
 177             }
 178         }
 179
 180         # Installed in a directory controlled by the dynamic linker?  We have
 181         # to strip off directories named for hardware capabilities.
 182         my $dirname = dirname($cur_file);
 183         my $last;
 184         do {
 185             $dirname =~ s%/([^/]+)$%%;
 186             $last = $1;
 187         } while ($last && $hwcap_dir{$last});
 188         $dirname .= "/$last" if $last;
 189         if ($ldconfig_dirs->known($dirname)) {
 190             # yes! so postinst must call ldconfig
 191             $must_call_ldconfig = $real_file;
 192         }
 193
 194         # executable stack.  We can only warn about a missing section on some
 195         # architectures.  Only warn if there's an Architecture field; if
 196         # that's missing, we'll already be complaining elsewhere.
 197         if (exists $objsomething{$cur_file}) {
 198             if (not defined $STACK{$cur_file}) {
 199                 if (open(FH, '<', "fields/architecture")) {
 200                     my $arch = <FH>;
 201                     close FH;
 202                     chomp $arch;
 203                     tag "shlib-without-PT_GNU_STACK-section", $cur_file
 204                         if $stack_arches{$arch};
 205                 }
 206             } elsif ($STACK{$cur_file} ne "rw-") {
 207                 tag "shlib-with-executable-stack", $cur_file;
 208             }
 209         }
 210     } elsif (exists $objsomething{$cur_file}
 211              && $ldconfig_dirs->known(dirname($cur_file))
 212              && exists $sharedobject{$cur_file}) {
 213         tag "sharedobject-in-library-directory-missing-soname", "$cur_file";
 214     }
 215 }
 216
 217 close(IN);
 218
 219 # 3rd step: check if shlib symlinks are present and in correct order
 220 for my $shlib_file (keys %SONAME) {
 221     # file found?
 222     if (not exists $index_info{$shlib_file}) {
 223         fail("shlib $shlib_file not found in package (should not happen!)");
 224     }
 225
 226     my ($dir, $shlib_name) = $shlib_file =~ m,(.*)/([^/]+)$,;
 227
 228     # not a public shared library, skip it
 229     next unless $ldconfig_dirs->known($dir);
 230
 231     # symlink found?
 232     my $link_file = "$dir/$SONAME{$shlib_file}";
 233     if (not exists $index_info{$link_file}) {
 234         tag "ldconfig-symlink-missing-for-shlib", "$link_file $shlib_file $SONAME{$shlib_file}";
 235     } else {
 236         # $link_file really another file?
 237         if ($link_file eq $shlib_file) {
 238             # the library file uses its SONAME, this is ok...
 239         } else {
 240             # $link_file really a symlink?
 241             if (exists $link_info{$link_file}) {
 242                 # yes.
 243
 244                 # $link_file pointing to correct file?
 245                 if ($link_info{$link_file} eq $shlib_name) {
 246                     # ok.
 247                 } else {
 248                     tag "ldconfig-symlink-referencing-wrong-file", "$link_file -> $link_info{$link_file} instead of $shlib_name";
 249                 }
 250             } else {
 251                 tag "ldconfig-symlink-is-not-a-symlink", "$shlib_file $link_file";
 252             }
 253
 254             # symlink after shlib?
 255             if ($index_info{$link_file} < $index_info{$shlib_file}) {
 256                 tag "ldconfig-symlink-before-shlib-in-deb", "$link_file";
 257             }
 258         }
 259     }
 260
 261     # determine shlib link name (w/o version)
 262     $link_file =~ s/\.so.*$/.so/o;
 263
 264     # -dev package?
 265     if ($pkg =~ m/\-dev$/o) {
 266         # yes!!
 267
 268         # need shlib symlink
 269         if (not exists $index_info{$link_file}) {
 270             tag "dev-pkg-without-shlib-symlink", "$shlib_file $link_file";
 271         }
 272     } else {
 273         # no.
 274
 275         # shlib symlink may not exist.
 276         # if shlib doesn't _have_ a version, then $link_file and $shlib_file will
 277         # be equal, and it's not a development link, so don't complain.
 278         if (exists $index_info{$link_file} and $link_file ne $shlib_file) {
 279             tag "non-dev-pkg-with-shlib-symlink", "$shlib_file $link_file";
 280         }
 281     }
 282 }
 283
 284 # 4th step: check shlibs control file
 285 my $version;
 286 if (open (VERSION, '<', 'fields/version')) {
 287     $version = <VERSION>;
 288     close VERSION;
 289     chomp $version;
 290 }
 291 my $provides = $pkg . "( = $version)";
 292 if (open (PROVIDES, '<', 'fields/provides')) {
 293     my $line = <PROVIDES>;
 294     close PROVIDES;
 295     chomp $line;
 296     $provides .= ", $line";
 297 }
 298 $provides = Dep::parse($provides);
 299
 300 my %shlibs_control;
 301 my %symbols_control;
 302
 303 @shlibs = grep { !m,^lib/libnss_[^.]+\.so(\.[0-9]+)$, } keys %SONAME;
 304 if ($#shlibs == -1) {
 305     # no shared libraries included in package, thus shlibs control file should
 306     # not be present
 307     if (-f $shlibs_control_file) {
 308         tag "pkg-has-shlibs-control-file-but-no-actual-shared-libs", "";
 309     }
 310 } else {
 311     # shared libraries included, thus shlibs control file has to exist
 312     if (not -f $shlibs_control_file) {
 313         if ($type ne 'udeb') {
 314             for my $shlib (@shlibs) {
 315                 # skip it if it's not a public shared library
 316                 next unless $ldconfig_dirs->known(dirname($shlib));
 317                 tag "no-shlibs-control-file", "$shlib";
 318             }
 319         }
 320     } else {
 321         my %shlibs_control_used;
 322         my @shlibs_depends;
 323         open(SHLIBS, '<', $shlibs_control_file)
 324             or fail("cannot open shlibs control file $shlibs_control_file for reading: $!");
 325         while (<SHLIBS>) {
 326             chop;
 327             next if m/^\s*$/ or /^#/;
 328
 329             # We exclude udebs from the checks for correct shared library
 330             # dependencies, since packages may contain dependencies on
 331             # other udeb packages.
 332             my $udeb="";
 333             $udeb = "udeb: " if s/^udeb:\s+//o;
 334             @words = split(/\s+/o,$_);
 335             my $shlibs_string = $udeb.$words[0].' '.$words[1];
 336             if ($shlibs_control{$shlibs_string}) {
 337                 tag "duplicate-entry-in-shlibs-control-file", $shlibs_string;
 338             } else {
 339                 $shlibs_control{$shlibs_string} = 1;
 340                 push (@shlibs_depends, join (' ', @words[2 .. $#words]))
 341                     unless $udeb;
 342             }
 343         }
 344         close(SHLIBS);
 345         my $shlib_name;
 346         for my $shlib (@shlibs) {
 347             $shlib_name = $SONAME{$shlib};
 348             $shlib_name = format_soname($shlib_name);
 349             $shlibs_control_used{$shlib_name} = 1;
 350             $shlibs_control_used{"udeb: ".$shlib_name} = 1;
 351             unless (exists $shlibs_control{$shlib_name}) {
 352                 # skip it if it's not a public shared library
 353                 next unless $ldconfig_dirs->known(dirname($shlib));
 354                 # no!!
 355                 tag "shlib-missing-in-control-file", $shlib_name, 'for', $shlib;
 356             }
 357         }
 358         for $shlib_name (keys %shlibs_control) {
 359             tag "unused-shlib-entry-in-control-file", $shlib_name
 360                 unless $shlibs_control_used{$shlib_name};
 361         }
 362
 363         # Check that all of the packages listed as dependencies in the shlibs
 364         # file are satisfied by the current package or its Provides.
 365         # Normally, packages should only declare dependencies in their shlibs
 366         # that they themselves can satisfy.
 367         #
 368         # Deduplicate the list of dependencies before warning so that we don't
 369         # dupliate warnings.
 370         my %seen;
 371         @shlibs_depends = grep { !$seen{$_}++ } @shlibs_depends;
 372         for my $depend (@shlibs_depends) {
 373             unless (Dep::implies($provides, Dep::parse($depend))) {
 374                 tag "shlibs-declares-dependency-on-other-package", $depend;
 375             }
 376         }
 377     }
 378 }
 379
 380 # 5th step: check symbols control file
 381 if ($#shlibs == -1) {
 382     # no shared libraries included in package, thus symbols control file should
 383     # not be present
 384     if (-f $symbols_control_file) {
 385         tag "pkg-has-symbols-control-file-but-no-shared-libs", "";
 386     }
 387 } elsif (not -f $symbols_control_file) {
 388     if ($type ne 'udeb') {
 389         for my $shlib (@shlibs) {
 390             # skip it if it's not a public shared library
 391             next unless $ldconfig_dirs->known(dirname($shlib));
 392             tag "no-symbols-control-file", "$shlib";
 393         }
 394     }
 395 } elsif (open(IN, '<', $symbols_control_file)) {
 396     my $version_wo_rev = $version;
 397     $version_wo_rev =~ s/^(.+)-([^-]+)$/$1/;
 398     my ($full_version_count, $full_version_sym) = (0, undef);
 399     my ($debian_revision_count, $debian_revision_sym) = (0, undef);
 400     my ($soname, $dep_package, $dep);
 401     my %symbols_control_used;
 402     my @symbols_depends;
 403     my $dep_templates = 0;
 404     my $meta_info_seen = 0;
 405
 406     while (<IN>) {
 407         chomp;
 408         next if m/^\s*$/ or /^#/;
 409
 410         if (m/^([^\s|*]\S+)\s(\S+)(?:\s(\S+))?/) {
 411             # soname, main dependency template
 412
 413             ($soname, $dep_package, $dep) = ($1, $2, $3);
 414             $dep ||= '';
 415             $soname = format_soname($soname);
 416
 417             if ($symbols_control{$soname}) {
 418                 tag "duplicate-entry-in-symbols-control-file", $soname;
 419             } else {
 420                 $symbols_control{$soname} = 1;
 421                 push @symbols_depends, $dep_package . ' ' . $dep;
 422             }
 423
 424             $dep_templates = 0;
 425             $meta_info_seen = 0;
 426         } elsif (m/^\|\s+(\S+)\s(\S+(\s\S+)?)$/) {
 427             # alternative dependency template
 428
 429             if ($meta_info_seen or not defined $soname) {
 430                 tag "syntax-error-in-symbols-file", $.;
 431             }
 432
 433             ($dep_package, $dep) = ($1, $2);
 434             push @symbols_depends, $dep_package . ' ' . $dep;
 435             $dep_templates++;
 436         } elsif (m/^\*\s(\S+):\s(\S+)/) {
 437             # meta-information
 438
 439             # This should probably be in a hash, but there's
 440             # only one supported value currently
 441             tag "unknown-meta-field-in-symbols-file", "$1, line $."
 442                 unless $1 eq 'Build-Depends-Package';
 443             tag "syntax-error-in-symbols-file", $.
 444                 if $dep_templates > 0;
 445
 446             $meta_info_seen = 1;
 447         } elsif (m/^\s+(\S+)\s(\S+)(?:\s(\S+(\s\S+)?))?$/) {
 448             # Symbol definition
 449
 450             tag "syntax-error-in-symbols-file", $.
 451                 unless defined $soname;
 452
 453             my ($sym, $v, $dep_order) = ($1, $2, $3);
 454             $dep_order ||= '';
 455
 456             if (($v eq $version) and ($version =~ /-/)) {
 457                 $full_version_sym ||= $sym;
 458                 $full_version_count++;
 459             }
 460             if (($v =~ /-/) and (not $v =~ /~$/) and ($v ne $version_wo_rev)) {
 461                 $debian_revision_sym ||= $sym;
 462                 $debian_revision_count++;
 463             }
 464
 465             if (length $dep_order) {
 466                 if ($dep_order !~ /^\d+$/ or $dep_order > $dep_templates) {
 467                     tag "invalid-template-id-in-symbols-file", $.;
 468                 }
 469             }
 470         } else {
 471             # Unparseable line
 472
 473             tag "syntax-error-in-symbols-file", $.;
 474         }
 475     }
 476     close IN;
 477     if ($full_version_count) {
 478         $full_version_count--;
 479         my $others = '';
 480         if ($full_version_count > 0) {
 481             $others = " and $full_version_count others";
 482         }
 483         tag "symbols-file-contains-current-version-with-debian-revision",
 484             "on symbol $full_version_sym$others";
 485     }
 486     if ($debian_revision_count) {
 487         $debian_revision_count--;
 488         my $others = '';
 489         if ($debian_revision_count > 0) {
 490             $others = " and $debian_revision_count others";
 491         }
 492         tag "symbols-file-contains-debian-revision",
 493             "on symbol $debian_revision_sym$others";
 494     }
 495     my $shlib_name;
 496     for my $shlib (@shlibs) {
 497         $shlib_name = $SONAME{$shlib};
 498         $shlib_name = format_soname($shlib_name);
 499         $symbols_control_used{$shlib_name} = 1;
 500         $symbols_control_used{"udeb: ".$shlib_name} = 1;
 501         unless (exists $symbols_control{$shlib_name}) {
 502             # skip it if it's not a public shared library
 503             next unless $ldconfig_dirs->known(dirname($shlib));
 504             tag "shlib-missing-in-symbols-control-file", $shlib_name, 'for', $shlib;
 505         }
 506     }
 507     for $shlib_name (keys %symbols_control) {
 508         tag "unused-shlib-entry-in-symbols-control-file", $shlib_name
 509             unless $symbols_control_used{$shlib_name};
 510     }
 511
 512     # Check that all of the packages listed as dependencies in the symbols
 513     # file are satisfied by the current package or its Provides.
 514     # Normally, packages should only declare dependencies in their symbols
 515     # files that they themselves can satisfy.
 516     #
 517     # Deduplicate the list of dependencies before warning so that we don't
 518     # dupliate warnings.
 519     my %seen;
 520     @symbols_depends = grep { !$seen{$_}++ } @symbols_depends;
 521     for my $depend (@symbols_depends) {
 522         unless (Dep::implies($provides, Dep::parse($depend))) {
 523             tag "symbols-declares-dependency-on-other-package", $depend;
 524         }
 525     }
 526 }
 527
 528 # Compare the contents of the shlibs and symbols control files
 529 if (keys %shlibs_control and keys %symbols_control) {
 530     for my $key (keys %symbols_control) {
 531         unless (exists $shlibs_control{$key}) {
 532             tag "symbols-declared-but-not-shlib", $key;
 533         }
 534     }
 535 }
 536
 537 # 6th step: check pre- and post- control files
 538 if (-f $preinst) {
 539     local $_ = slurp_entire_file($preinst);
 540     if (/^[^\#]*\bldconfig\b/m) {
 541         tag "preinst-calls-ldconfig", ""
 542     }
 543 }
 544
 545 my $we_call_postinst=0;
 546 if (-f $postinst) {
 547     local $_ = slurp_entire_file($postinst);
 548
 549     # Decide if we call ldconfig
 550     if (/^[^\#]*\bldconfig\b/m) {
 551         $we_call_postinst=1;
 552     }
 553 }
 554
 555 if ($type eq 'udeb') {
 556     tag "udeb-postinst-must-not-call-ldconfig"
 557         if $we_call_postinst;
 558 } else {
 559     tag "postinst-has-useless-call-to-ldconfig", ""
 560         if $we_call_postinst and not $must_call_ldconfig;
 561     tag "postinst-must-call-ldconfig", "$must_call_ldconfig"
 562         if not $we_call_postinst and $must_call_ldconfig;
 563 }
 564
 565 if (-f $prerm) {
 566     local $_ = slurp_entire_file($prerm);
 567     if (/^[^\#]*\bldconfig\b/m) {
 568         tag "prerm-calls-ldconfig", "";
 569     }
 570 }
 571
 572 if (-f $postrm) {
 573     local $_ = slurp_entire_file($postrm);
 574
 575     # Decide if we call ldconfig
 576     if (/^[^\#]*\bldconfig\b/m) {
 577         tag "postrm-has-useless-call-to-ldconfig", ""
 578             unless $must_call_ldconfig;
 579     } else {
 580         tag "postrm-should-call-ldconfig", "$must_call_ldconfig"
 581             if $must_call_ldconfig;
 582     }
 583
 584     # Decide if we do it safely
 585     s/\bldconfig\b/BldconfigB/g;
 586     s/[ \t]//g;
 587     # this one matches code from debhelper
 588     s/^if\["\$1"=.?remove.?\];?\n*then\n*BldconfigB//gm;
 589     # variations...
 590     s/^if\[.?remove.?="\$1"\];?\n*then\n*BldconfigB//gm;
 591     s/^\["\$1"=.?remove.?\]\&&BldconfigB//gm;
 592     s/^\[.?remove.?="\$1"\]&&BldconfigB//gm;
 593     s/remove(?:\|[^)]+)*\).*?BldconfigB.*?(;;|esac)//s;
 594
 595     if (/^[^\#]*BldconfigB/m) {
 596         tag "postrm-unsafe-ldconfig", "";
 597     }
 598 }
 599
 600 }
 601
 602 # make /tmp/baz/baz.txt from /tmp/foo/../bar/../baz/baz.txt
 603 sub abs_path {
 604     my $path = shift;
 605     while($path =~ s!/[^/]*/\.\./!/!g){1};
 606     return $path;
 607 }
 608
 609 sub format_soname {
 610     my $soname = shift;
 611
 612     # libfoo.so.X.X
 613     if ($soname =~ m/(.+)\.so\.(.*)$/) {
 614         $soname = "$1 $2";
 615     # libfoo-X.X.so
 616     } elsif ($soname =~ m/(.+)\-(\w[\w\.]*)\.so$/) {
 617         $soname = "$1 $2";
 618     }
 619
 620     return $soname
 621 }
 622
 623 1;
 624
 625 # Local Variables:
 626 # indent-tabs-mode: t
 627 # cperl-indent-level: 4
 628 # End:
 629 # vim: syntax=perl sw=4 ts=8