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