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

   1 # binaries -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   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::binaries;
  22 use strict;
  23 use Tags;
  24 use Util;
  25
  26 use File::Spec;
  27
  28 sub run {
  29
  30 my $pkg = shift;
  31 my $type = shift;
  32
  33 my $arch;
  34 my $dynsyms = 0;
  35 my $needs_libc = '';
  36 my $needs_libc_file;
  37 my $needs_libc_count = 0;
  38 my $needs_depends_line = 0;
  39 my $has_perl_lib = 0;
  40
  41 my %COMMENT;
  42 my %NOTE;
  43 my %RPATH;
  44 my %NEEDED;
  45 my %CXXABI;
  46 my %OCAML;
  47 my %SONAME;
  48 my %KLIBC;
  49
  50 # read architecture file
  51 if (open(IN, '<', "fields/architecture")) {
  52     chop($arch = <IN>);
  53     close(IN);
  54 }
  55
  56 my $file;
  57
  58 # read data from objdump-info file
  59 open(IN, '<', "objdump-info")
  60     or fail("cannot find objdump-info for $type package $pkg");
  61 while (<IN>) {
  62     chop;
  63
  64     next if m/^\s*$/o;
  65
  66     if (m/^-- (\S+)\s*$/o) {
  67         $file = $1;
  68         $dynsyms = 0;
  69     } elsif ($dynsyms) {
  70         # The .*? near the end is added because a number of optional fields
  71         # might be printed.  The symbol name should be the last word.
  72         if (m/^[0-9a-fA-F]+.{6}\w\w?\s+(\S+)\s+[0-9a-zA-Z]+\s+(\S+)\s+(\S+)$/){
  73             my ($foo, $sec, $sym) = ($1, $2, $3);
  74             if ($arch ne 'hppa') {
  75                 if ($foo eq '.text' and $sec eq 'Base' and
  76                     $sym eq '__gmon_start__') {
  77                     tag "binary-compiled-with-profiling-enabled", "$file";
  78                 }
  79             } else {
  80                 if ( ($sec =~ /^GLIBC_.*/) and ($sym eq '_mcount') ) {
  81                     tag "binary-compiled-with-profiling-enabled", "$file";
  82                 }
  83             }
  84
  85             if ($foo eq '.text' and $sec eq 'Base' and $sym eq 'caml_main') {
  86                 $OCAML{$file} = 1;
  87             }
  88         }
  89     } else {
  90         if (m/^\s*NEEDED\s*(\S+)/o) {
  91             push @{$NEEDED{$file}}, $1;
  92         } elsif (m/^\s*RPATH\s*(\S+)/o) {
  93             foreach (split m/:/, $1) {
  94                 $RPATH{$file}{$_}++;
  95             }
  96         } elsif (m/^\s*SONAME\s*(\S+)/o) {
  97             $SONAME{$1} ||= [];
  98             push @{$SONAME{$1}}, $file;
  99         } elsif (m/^\s*\d+\s+\.comment\s+/o) {
 100             $COMMENT{$file} = 1;
 101         } elsif (m/^\s*\d+\s+\.note\s+/o) {
 102             $NOTE{$file} = 1;
 103         } elsif (m/^DYNAMIC SYMBOL TABLE:/) {
 104             $dynsyms = 1;
 105         } elsif (m/^objdump: (.*?): File format not recognized$/) {
 106             tag "apparently-corrupted-elf-binary", "$file";
 107         } elsif (m/^objdump: \.(.*?): Packed with UPX$/) {
 108             tag "binary-file-compressed-with-upx", "$file";
 109         } elsif (m/objdump: \.(.*?): Invalid operation$/) {
 110             # Don't anchor this regex since it can be interspersed with other
 111             # output and hence not on the beginning of a line.
 112             tag "binary-with-bad-dynamic-table", "$file" unless $file =~ m%^\./usr/lib/debug/%;
 113         } elsif (m/CXXABI/) {
 114             $CXXABI{$file} = 1;
 115         } elsif (m%Requesting program interpreter:\s+/lib/klibc-\S+\.so%) {
 116             $KLIBC{$file} = 1;
 117         }
 118     }
 119 }
 120 close(IN);
 121
 122 # For the package naming check, filter out SONAMEs where all the files are at
 123 # paths other than /lib, /usr/lib, or /usr/X11R6/lib.  This avoids false
 124 # positives with plugins like Apache modules, which may have their own SONAMEs
 125 # but which don't matter for the purposes of this check.  Also filter out
 126 # nsswitch modules
 127 sub lib_soname_path {
 128     my (@paths) = @_;
 129     foreach my $path (@paths) {
 130         next if $path =~ m%^(\.?/)?lib/libnss_[^.]+\.so(\.[0-9]+)$%;
 131         return 1 if $path =~ m%^(\.?/)?lib/[^/]+$%;
 132         return 1 if $path =~ m%^(\.?/)?usr/lib/[^/]+$%;
 133         return 1 if $path =~ m%^(\.?/)?usr/X11R6/lib/[^/]+$%;
 134     }
 135     return 0;
 136 }
 137 my @sonames = sort grep { lib_soname_path (@{$SONAME{$_}}) } keys %SONAME;
 138
 139 # try to identify transition strings
 140 my $base_pkg = $pkg;
 141 $base_pkg =~ s/c102\b//o;
 142 $base_pkg =~ s/c2a?\b//o;
 143 $base_pkg =~ s/\dg$//o;
 144 $base_pkg =~ s/gf$//o;
 145 $base_pkg =~ s/-udeb$//o;
 146 $base_pkg =~ s/^lib64/lib/o;
 147
 148 my $match_found = 0;
 149 foreach my $expected_name (@sonames) {
 150     $expected_name =~ s/([0-9])\.so\./$1-/;
 151     $expected_name =~ s/\.so(\.|\z)//;
 152     $expected_name =~ s/_/-/g;
 153
 154     if ((lc($expected_name) eq $pkg)
 155         || (lc($expected_name) eq $base_pkg)) {
 156         $match_found = 1;
 157         last;
 158     }
 159 }
 160
 161 tag "package-name-doesnt-match-sonames", "@sonames"
 162     if @sonames && !$match_found;
 163
 164 my %directories;
 165 open(IN, '<', "index") or fail("cannot open index file index: $!");
 166 while (<IN>) {
 167     chomp;
 168     next unless /^[dl]/;
 169     my $dir = (split(' ', $_, 6))[-1];
 170     $dir =~ s,^\./,/,;
 171     $dir =~ s,/+$,,;
 172     $dir =~ s/ link to .*//;
 173     $dir =~ s/ -> .*//;
 174
 175     $directories{$dir}++;
 176 }
 177 close IN;
 178
 179 # process all files in package
 180 open(IN,, '<', "file-info")
 181     or fail("cannot find file-info for $type package $pkg");
 182 while (<IN>) {
 183     chop;
 184
 185     m/^(.+?):\s+(.*)$/o or fail("an error in the file pkg is preventing lintian from checking this package: $_");
 186     my ($file,$info) = ($1,$2);
 187
 188     # binary or object file?
 189     next unless ($info =~ m/^[^,]*\bELF\b/) or ($info =~ m/\bcurrent ar archive\b/);
 190
 191     # Warn about Architecture: all packages that contain shared libraries, but
 192     # only if those libraries aren't installed in a multiarch directory.  The
 193     # package may be a support package for cross-compiles.
 194     if ($arch eq 'all') {
 195         my ($arch) = ($file =~ m,^\./(?:usr/)?lib/([^/]+)/,);
 196         my $multiarch = Lintian::Data->new('binaries/multiarch');
 197         unless ($arch and $multiarch->known($arch)) {
 198             tag "arch-independent-package-contains-binary-or-object", "$file";
 199         }
 200     }
 201
 202     # ELF?
 203     next unless $info =~ m/^[^,]*\bELF\b/o;
 204
 205     if ($file =~ m,^\./etc/,) {
 206         tag "binary-in-etc", "$file";
 207     }
 208
 209     if ($file =~ m,^\./usr/share/,) {
 210         tag "arch-dependent-file-in-usr-share", "$file";
 211     }
 212
 213     # stripped?
 214     if ($info =~ m,not stripped\s*$,o) {
 215         # Is it an object file (which generally can not be stripped),
 216         # a kernel module, debugging symbols, or perhaps a debugging package?
 217         # Ocaml executables are exempted, see #252695
 218         unless ($file =~ m,\.k?o$, or $pkg =~ m/-dbg$/ or $pkg =~ m/debug/
 219                 or $file =~ m,/lib/debug/, or exists $OCAML{$file}) {
 220             tag "unstripped-binary-or-object", "$file";
 221         }
 222     } else {
 223         # stripped but a debug or profiling library?
 224         if (($file =~ m,/lib/debug/,o) or ($file =~ m,/lib/profile/,o)) {
 225             tag "library-in-debug-or-profile-should-not-be-stripped", "$file";
 226         } else {
 227             # appropriately stripped, but is it stripped enough?
 228             if (exists $NOTE{$file}) {
 229                 tag "binary-has-unneeded-section", "$file .note";
 230             }
 231             if (exists $COMMENT{$file}) {
 232                 tag "binary-has-unneeded-section", "$file .comment";
 233             }
 234         }
 235     }
 236
 237     # rpath is disallowed, except in private directories
 238     if (exists $RPATH{$file}) {
 239         foreach my $rpath (map {File::Spec->canonpath($_)} keys %{$RPATH{$file}}) {
 240             next if $rpath =~ m,^/usr/lib/(games/)?\Q$pkg\E(?:/|\z),;
 241             next if $rpath =~ m,^\$ORIGIN$,;
 242             next if $directories{$rpath};
 243             tag "binary-or-shlib-defines-rpath", "$file $rpath";
 244         }
 245     }
 246
 247     # binary or shared object?
 248     next unless ($info =~ m/executable/) or ($info =~ m/shared object/);
 249     next if $type eq 'udeb';
 250
 251     # Perl library?
 252     if ($file =~ m,^\./usr/lib/perl5/.*\.so$,) {
 253         $has_perl_lib = 1;
 254     }
 255
 256     # Something other than detached debugging symbols in /usr/lib/debug paths.
 257     if ($file =~ m,^\./usr/lib/debug/(lib\d*|s?bin|usr|opt|dev|emul)/,) {
 258         if (exists($NEEDED{$file})) {
 259             tag "debug-file-should-use-detached-symbols", $file;
 260         }
 261     }
 262
 263     # statically linked?
 264     if (!exists($NEEDED{$file}) || !defined($NEEDED{$file})) {
 265         if ($info =~ m/shared object/o) {
 266             # Some exceptions: detached debugging information and the dynamic
 267             # loader (which itself has no dependencies).
 268             next if ($file =~ m%^\./usr/lib/debug/%);
 269             next if ($file =~ m%^\./lib/(?:[\w/]+/)?ld-[\d.]+\.so$%);
 270             tag "shared-lib-without-dependency-information", "$file";
 271         } else {
 272             # Some exceptions: files in /boot, /usr/lib/debug/*, named *-static or
 273             # *.static, or *-static as package-name.
 274             next if ($file =~ m%^./boot/%);
 275             # klibc binaries appear to be static.
 276             next if ($KLIBC{$file});
 277             # Location of debugging symbols:
 278             next if ($file =~ m%^./usr/lib/debug/%);
 279             next if ($file =~ /(\.|-)static$/);
 280             next if ($pkg =~ /-static$/);
 281             tag "statically-linked-binary", "$file";
 282         }
 283     } else {
 284         my $lib;
 285         my $no_libc = 1;
 286         $needs_depends_line = 1;
 287         for $lib (@{$NEEDED{$file}}) {
 288             if ($lib =~ /^libc\.so\.(\d+.*)/) {
 289                 $needs_libc = "libc$1";
 290                 $needs_libc_file = $file unless $needs_libc_file;
 291                 $needs_libc_count++;
 292                 $no_libc = 0;
 293             }
 294         }
 295         if ($no_libc and not $file =~ m,/libc\b,) {
 296             if ($info =~ m/shared object/) {
 297                 tag "library-not-linked-against-libc", "$file";
 298             } else {
 299                 tag "program-not-linked-against-libc", "$file";
 300             }
 301         }
 302     }
 303 }
 304 close(IN);
 305
 306 # Find the package dependencies, which is used by various checks.
 307 my $depends = '';
 308 if (-f 'fields/pre-depends') {
 309     $depends = slurp_entire_file('fields/pre-depends');
 310 }
 311 if (-f 'fields/depends') {
 312     $depends .= ', ' if $depends;
 313     $depends .= slurp_entire_file('fields/depends');
 314 }
 315 $depends =~ s/\n/ /g;
 316
 317 # Check for a libc dependency.
 318 if ($needs_depends_line) {
 319     if ($depends && $needs_libc && $pkg !~ /^libc[\d.]+(-|\z)/) {
 320         # Match libcXX or libcXX-*, but not libc3p0.
 321         my $re = qr/(?:^|,)\s*\Q$needs_libc\E\b/o;
 322         if ($depends !~ /$re/) {
 323             my $others = '';
 324             $needs_libc_count--;
 325             if ($needs_libc_count > 0) {
 326                 $others = " and $needs_libc_count others";
 327             }
 328             tag "missing-dependency-on-libc",
 329                 "needed by $needs_libc_file$others";
 330         }
 331     } elsif (!$depends) {
 332         tag "missing-depends-line";
 333     }
 334 }
 335
 336 # Check for a Perl dependency.
 337 if ($has_perl_lib) {
 338     my $re = qr/(?:^|,)\s*perlapi-[\d.]+(?:\s*\[[^\]]+\])?\s*(?:,|\z)/;
 339     unless ($depends =~ /$re/) {
 340         tag 'missing-dependency-on-perlapi';
 341     }
 342 }
 343
 344 }
 345
 346 1;
 347
 348 # Local Variables:
 349 # indent-tabs-mode: t
 350 # cperl-indent-level: 4
 351 # End:
 352 # vim: syntax=perl ts=8 sw=4