# xdeb -- lintian check script  -*- perl -*-

# This started as a cut-down version of the Emdebian Lintian check script.
# Its copyright notice follows:
#
#  Copyright (C) 2008  Neil Williams <codehelp@debian.org>
#
#  If at all possible, this script should only use perl modules
#  that lintian itself would use - or functions that can be migrated
#  into such modules.
#
#  This package 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 3 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, see <http://www.gnu.org/licenses/>.

package Lintian::xdeb;
use strict;
use Lintian::Tags;
use Util;
use vars qw( %archdetecttable);

# debug
use Data::Dumper;

# need to make this table more accessible in Debian::DpkgCross
# and then do the comparison in that module (which can migrate into
# dpkg-dev).
%archdetecttable = (
	'i386' => 'ELF 32-bit LSB .* 80386',
	'sparc' => 'ELF 32-bit MSB .* SPARC',
	'sparc64' => 'ELF 64-bit MSB .* SPARC',
	'alpha' => 'ELF 64-bit LSB .* Alpha',
	'm68k' => 'ELF 32-bit MSB .* 680[02]0',
	'arm' => 'ELF 32-bit LSB .* ARM',
	'armeb' => 'ELF 32-bit MSB .* ARM',
	'armel' => 'ELF 32-bit LSB .* SYSV',
	'powerpc' => 'ELF 32-bit MSB .* PowerPC',
	'powerpc64' => 'ELF 64-bit MSB .* PowerPC',
	'mips' => 'ELF 32-bit MSB .* MIPS',
	'mipsel' => 'ELF 32-bit LSB .* MIPS',
	'hppa' => 'ELF 32-bit MSB .* PA-RISC',
	's390' => 'ELF 32-bit MSB .* S.390',
	's390x' => 'ELF 64-bit MSB .* S.390',
	'ia64' => 'ELF 64-bit LSB .* IA-64',
 	'm32r' => 'ELF 32-bit MSB .* M32R',
	'amd64' => 'ELF 64-bit LSB .* x86-64',
	'w32-i386' => '80386 COFF',
	'AR' => 'current ar archive');

# currently unused, pending changes in lintian.
sub set {
	our $arch;
	my $pkg = shift;
	my $type = shift;
	my $tdeb = 0;
	my $tags = $Lintian::Tags::GLOBAL;
	my $build = `dpkg-architecture -qDEB_BUILD_ARCH`;
	chomp($build);
	$tdeb = 1 if ($pkg =~ /locale/);
	# only use any of the following if this is an Emdebian package.
	my $version = "";
	open (VERSION, '<', 'fields/version') or return;
	$version = <VERSION>;
	close (VERSION);
	if ($type eq "source")
	{
		$tags->suppress ("debian-rules-missing-required-target");
		# might want to fix this one.
		$tags->suppress ("debian-files-list-in-source");
		$tags->suppress ("native-package-with-dash-version");
		$tags->suppress ("build-depends-indep-without-arch-indep");
		$tags->suppress ("source-nmu-has-incorrect-version-number");
		$tags->suppress ("changelog-should-mention-nmu");
		return;
	}
	if ($tdeb > 0)
	{
		$tags->suppress ("extended-description-is-empty");
		$tags->suppress ("no-md5sums-control-file");
		$tags->suppress ("no-copyright-file");
		# need TDeb checks here.
		$tags->suppress ("debian-rules-missing-required-target *");
		# might want to fix this one.
		$tags->suppress ("debian-files-list-in-source");
		$tags->suppress ("native-package-with-dash-version");
		return;
	}
	$tags->suppress ("no-copyright-file");
	$tags->suppress ("python-script-but-no-python-dep");
	$tags->suppress ("binary-without-manpage");
	$tags->suppress ("binary-or-shlib-defines-rpath");
	$tags->suppress ("build-depends-indep-without-arch-indep");
}

# there are problems with some of these tests - the number of results
# is higher than the number of detections because certain tests get
# repeated for unrelated files unpacked alongside problematic files.

sub run {

	our ($arch, %RPATH);
	my $pkg = shift;
	my $type = shift;
	my $info = shift;
	my $tdeb = 0;
	my $tags = $Lintian::Tags::GLOBAL;
	my $build = `dpkg-architecture -qDEB_BUILD_ARCH`;
	chomp($build);
	$tdeb = 1 if ($pkg =~ /locale/);
	my %seen=();
	# read architecture file
	if (open(IN, '<', "fields/architecture")) {
		chop($arch = <IN>);
		close(IN);
	}
	# only use any of the following if this is an Emdebian package.
	my $version = "";
	open (VERSION, '<', 'fields/version') or return;
	$version = <VERSION>;
	close (VERSION);
	if ($type eq "source")
	{
		$tags->suppress ("debian-rules-missing-required-target");
		# might want to fix this one.
		$tags->suppress ("debian-files-list-in-source");
		$tags->suppress ("native-package-with-dash-version");
		$tags->suppress ("build-depends-indep-without-arch-indep");
		$tags->suppress ("source-nmu-has-incorrect-version-number");
		$tags->suppress ("changelog-should-mention-nmu");
		return;
	}
	# process all files in package
	for my $file (sort keys %{$info->file_info})
	{
		my $fileinfo = $info->file_info->{$file};
		$tags->suppress ("no-copyright-file");
		$tags->suppress ("python-script-but-no-python-dep");
		$tags->suppress ("binary-without-manpage");
		# binary or object file?
		if ($fileinfo =~ m/^[^,]*\bELF\b/)
		{
			$tags->suppress ("binary-or-shlib-defines-rpath");
			$tags->suppress ("build-depends-indep-without-arch-indep");
			# rpath is mandatory when cross building.
			if (exists $RPATH{$file} and
				grep { !m,^/usr/lib/(games/)?\Q$pkg\E(?:/|\z), } split(/:/, $RPATH{$file}))
			{
				tag "binary-or-shlib-omits-rpath", "$file $RPATH{$file}";
			}
			if ($arch eq "armel")
			{
				tag "binary-is-wrong-architecture", "$file"
					unless ($fileinfo =~ /ARM, version 1 \(SYSV\)/);
			}
			elsif ($arch eq "i386")
			{
				tag "binary-is-wrong-architecture", "$file"
					unless ($fileinfo =~ /x86-64, version 1 \(SYSV\)/) or
					($fileinfo =~ /$archdetecttable{$arch}/);
			}
			else
			{
				tag "binary-is-wrong-architecture", "$file"
					unless ($fileinfo =~ /$archdetecttable{$arch}/);
			}
		}
	}
	close (IN);
}

1;
