# binaries -- lintian check script -*- perl -*-

# Copyright (C) 1998 Christian Schwarz and Richard Braakman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

package Lintian::binaries;
use strict;
use Tags;
use Util;

sub run {

my $pkg = shift;
my $type = shift;

my $arch;
my $dynsyms = 0;
my $needs_depends_line = 0;

my %COMMENT;
my %NOTE;
my %RPATH;
my %NEEDED;
my %CXXABI;
my %OCAML;
my %SONAME;
my %KLIBC;

# read architecture file
if (open(IN,"fields/architecture")) {
    chop($arch = <IN>);
    close(IN);
} else {
    # Don't display this tag, since `fields' check already checks for this!
    # -> no-architecture-field
    #tag "package-does-not-specify-architecture", "";
}

my $file;

# read data from objdump-info file
open(IN,"objdump-info")
    or fail("cannot find objdump-info for $type package $pkg");
while (<IN>) {
    chop;

    next if m/^\s*$/o;

    if (m/^-- (\S+)\s*$/o) {
	$file = $1;
	$dynsyms = 0;
    } elsif ($dynsyms) {
	# The .*? near the end is added because a number of optional fields
	# might be printed.  The symbol name should be the last word.
	if (m/^[0-9a-fA-F]+.{6}\w\w?\s+(\S+)\s+[0-9a-zA-Z]+\s+(\S+)\s+(\S+)$/){
	    my ($foo, $sec, $sym) = ($1, $2, $3);
	#    # Add more symbols here when needed.
	#    # We don't store them all, because the tables can be pretty large.
	#    if ($sym =~ m/^(__register_frame_info)$/) {
	#    	$DYNSYM{$file}{$sym} = $sec;
	#    }
	    if ($arch ne 'hppa') {
		if ($foo eq '.text' and $sec eq 'Base' and
		    $sym eq '__gmon_start__') {
		    tag "binary-compiled-with-profiling-enabled", "$file";
		}
	    } else {
		if ( ($sec =~ /^GLIBC_.*/) and ($sym eq '_mcount') ) {
		    tag "binary-compiled-with-profiling-enabled", "$file";
		}
	    }

	    if ($foo eq '.text' and $sec eq 'Base' and $sym eq 'caml_main') {
		$OCAML{$file} = 1;
	    }
	}
    } else {
	if (m/^\s*NEEDED\s*(\S+)/o) {
	    push @{$NEEDED{$file}}, $1;
	} elsif (m/^\s*RPATH\s*(\S+)/o) {
	    $RPATH{$file} = $1;
	} elsif (m/^\s*SONAME\s*(\S+)/o) {
	    $SONAME{$1} ||= [];
	    push @{$SONAME{$1}}, $file;
	} elsif (m/^\s*\d+\s+\.comment\s+/o) {
	    $COMMENT{$file} = 1;
	} elsif (m/^\s*\d+\s+\.note\s+/o) {
	    $NOTE{$file} = 1;
	} elsif (m/^DYNAMIC SYMBOL TABLE:/) {
	    $dynsyms = 1;
	} elsif (m/^objdump: (.*?): File format not recognized$/) {
            tag "apparently-corrupted-elf-binary", "$file";
	} elsif (m/^objdump: \.(.*?): Packed with UPX$/) {
	    tag "binary-file-compressed-with-upx", "$file";
	} elsif (m/^objdump: \.(.*?): Invalid operation$/) {
	    tag "binary-with-bad-dynamic-table", "$file" unless $file =~ m%^\./usr/lib/debug/%;
	} elsif (m/CXXABI/) {
	    $CXXABI{$file} = 1;
	} elsif (m%Requesting program interpreter:\s+/lib/klibc-\S+\.so%) {
	    $KLIBC{$file} = 1;
	}
    }
}
close(IN);

# For the package naming check, filter out SONAMEs where all the files are
# at paths other than /lib, /usr/lib, or /usr/X11R6/lib.  This avoids false
# positives with plugins like Apache modules, which may have their own
# SONAMEs but which don't matter for the purposes of this check.
sub lib_soname_path {
    my (@paths) = @_;
    foreach my $path (@paths) {
	return 1 if $path =~ m%^(\.?/)?lib/[^/]+$%;
	return 1 if $path =~ m%^(\.?/)?usr/lib/[^/]+$%;
	return 1 if $path =~ m%^(\.?/)?usr/X11R6/lib/[^/]+$%;
    }
    return 0;
}
my @sonames = grep { lib_soname_path (@{$SONAME{$_}}) } keys %SONAME;
tag "several-sonames-in-same-package", "@sonames" if @sonames > 1;

# try to identify transition strings
my $base_pkg = $pkg;
$base_pkg =~ s/c102\b//o;
$base_pkg =~ s/c2a?\b//o;
$base_pkg =~ s/\dg$//o;
$base_pkg =~ s/-udeb$//o;
$base_pkg =~ s/^lib64/lib/o;

my $match_found = 0;
foreach my $expected_name (@sonames) {
    $expected_name =~ s/([0-9])\.so\./$1-/;
    $expected_name =~ s/\.so(\.|$)//o;
    $expected_name =~ s/_/-/o;

    if ((lc($expected_name) eq $pkg)
	|| (lc($expected_name) eq $base_pkg)) {
	$match_found = 1;
	last;
    }
}

tag "package-name-doesnt-match-sonames", "@sonames"
    if @sonames && !$match_found;

# process all files in package
open(IN,"file-info") or fail("cannot find file-info for $type package $pkg");
while (<IN>) {
    chop;

    m/^(.+?):\s+(.*)$/o or fail("an error in the file pkg is preventing lintian from checking this package: $_");
    my ($file,$info) = ($1,$2);

    # binary or object file?
    next unless ($info =~ m/^[^,]*\bELF\b/) or ($info =~ m/\bcurrent ar archive\b/);

    if ($arch eq 'all') {
	# package is `Architecture: all' but contains libs!?
	tag "arch-independent-package-contains-binary-or-object", "$file";
    }

    # ELF?
    next unless $info =~ m/^[^,]*\bELF\b/o;

    if ($file =~ m,^etc/,) {
	tag "binary-in-etc", "$file";
    }

    if ($file =~ m,^usr/share/,) {
	tag "arch-dependent-file-in-usr-share", "$file";
    }

    # stripped?
    if ($info =~ m,not stripped\s*$,o) {
	# Is it an object file (which generally can not be stripped),
	# a kernel module, or perhaps a debugging package? 
	# Ocaml executables are exempted, see #252695
	unless ($file =~ m,\.k?o$, or $pkg =~ m/-dbg$/ or $pkg =~ m/debug/
		or exists $OCAML{$file}) {
	    tag "unstripped-binary-or-object", "$file";
	}
    } else {
	# stripped but a debug or profiling library?
	if (($file =~ m,lib/debug/,o) or ($file =~ m,lib/profile/,o)) {
	    tag "library-in-debug-or-profile-should-not-be-stripped", "$file";
	} else {
	    # appropriately stripped, but is it stripped enough?
	    if (exists $NOTE{$file}) {
		tag "binary-has-unneeded-section", "$file .note";
	    }
	    if (exists $COMMENT{$file}) {
		tag "binary-has-unneeded-section", "$file .comment";
	    }
	}
    }

    # rpath is disallowed, except in private directories
    if (exists $RPATH{$file} &&
        grep(!m#^/usr/lib/\Q$pkg\E(?:/|$)#, split(/:/, $RPATH{$file}))
       ) {
	tag "binary-or-shlib-defines-rpath", "$file $RPATH{$file}";
    }

    # binary or shared object?
    next unless ($info =~ m/executable/) or ($info =~ m/shared object/);
    next if $type eq 'udeb';

    # statically linked?
    my %libc5_binary;
    my @needed;
    if (!exists($NEEDED{$file}) && !defined($NEEDED{$file})) {
	if ($info =~ m/shared object/o) {
            # Some exceptions: detached debugging information and the dynamic
            # loader (which itself has no dependencies).
            next if ($file =~ m%^\./usr/lib/debug/%);
            next if ($file =~ m%^\./lib/(?:[\w/]+/)?ld-[\d.]+\.so$%);
	    tag "shared-lib-without-dependency-information", "$file";
	} else {
	    # Some exceptions: files in /boot, /usr/lib/debug/*, named *-static or
	    # *.static, or *-static as package-name.
	    next if ($file =~ m%^./boot/%);
	    # klibc binaries appear to be static.
	    next if ($KLIBC{$file});
	    # Location of debugging symbols:
	    next if ($file =~ m%^./usr/lib/debug/%);
	    next if ($file =~ /(\.|-)static$/);
	    next if ($pkg =~ /-static$/);

	    tag "statically-linked-binary", "$file";
	}
    } else {
	my $lib;
	my $no_libc = 1;
	$needs_depends_line = 1;
	@needed = @{$NEEDED{$file}};
	for $lib (@needed) {
	    # linked against libc5?
	    if ($lib =~ m/^libc\.so\.5/o) {
		# yes.
		# libc5-compat ?
		if (($file =~ m/libc5-compat/) or
		    ($file =~ m/i486-linuxlibc1/)) {
		    # ok, ignore it
		} else {
		    tag "libc5-binary", "$file" unless $libc5_binary{$file}++;
		}
	    }

	    # C++ ABI check
# removed for not being reliable enough
#	    if ($lib =~ /^libstdc\+\+/) {
#		unless ($CXXABI{$file}) {
#		    tag "binary-or-shlib-with-obsolete-c++-abi", "$file";
#		}
#	    }

	    if ($lib =~ m/^libc/o) {
		$no_libc = 0;
	    }
	}

	if ($no_libc and not $file =~ m,/libc\b,) {
	    if ($info =~ m/shared object/) {
		tag "library-not-linked-against-libc", "$file";
	    } else {
		tag "program-not-linked-against-libc", "$file";
	    }
	}
    }
}
close(IN);

if ($needs_depends_line) {
    if (not -e "fields/depends" and not -e "fields/pre-depends") {
	tag "missing-depends-line", ""
	    unless $pkg eq 'ldso';
    }
}

}

1;

# vim: syntax=perl ts=8 sw=4
