# debhelper format -- lintian check script -*- perl -*-

# Copyright (C) 1999 by Joey Hess
#
# 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 Maemian::debhelper;
use strict;

use lib "$ENV{'MAEMIAN_ROOT'}/lib";
use Tags;
use Util;
use Maemian::Data;

# If there is no debian/compat file present but cdbs is being used, cdbs will
# create one automatically.  Currently it always uses compatibility level 5.
# It may be better to look at what version of cdbs the package depends on and
# from that derive the compatibility level....
my $cdbscompat = 5;

my $maint_commands = Maemian::Data->new ('debhelper/maint_commands');
my $miscDeps_commands = Maemian::Data->new ('debhelper/miscDepends_commands');
my $dh_commands_depends = Maemian::Data->new ('debhelper/dh_commands', '=');
my $filename_configs = Maemian::Data->new ('debhelper/filename-config-files');

# The version at which debhelper commands were introduced.  Packages that use
# one of these commands must have a dependency on that version of debhelper or
# newer.
my %versions
    = (dh                 => '7',
       dh_auto_configure  => '7',
       dh_auto_build      => '7',
       dh_auto_clean      => '7',
       dh_auto_install    => '7',
       dh_bugfiles        => '7.2.3~',
       dh_icons           => '5.0.51~',
       dh_installifupdown => '5.0.44~',
       dh_lintian         => '6.0.7~',
       dh_prep            => '7');

sub run {

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

my $seencommand = '';
my $needbuilddepends = '';
my $needtomodifyscripts = '';
my $level;
my $seenversiondepends = '0';
my $compat = 0;
my $usescdbs = '';
my $seendhpython = '';
my $usescdbspython = '';
my $seendhcleank = '';
my $needmiscdepends = 0;
my %missingbdeps;

open(RULES, '<', "debfiles/rules") or fail("cannot read debian/rules: $!");
my $dhcompatvalue;
my @versioncheck;
while (<RULES>) {
    if (m/^\s+-?(dh_\w+)/) {
        my $dhcommand = $1;
	if ($dhcommand =~ /dh_testversion(?:\s+([^\s]+))?/) {
	    $level = $1 if ($1);
	    tag "dh_testversion-is-deprecated", "";
	}
	if ($dhcommand eq 'dh_dhelp') {
	    tag "dh_dhelp-is-deprecated", "";
	}
	if ($dhcommand eq 'dh_suidregister') {
	    tag "dh_suidregister-is-obsolete", "";
	}
	if ($dhcommand eq 'dh_clean' and m/\s+\-k(\s+.*)?$/) {
	    $seendhcleank = 1;
	}
	# if command is passed -n, it does not modify the scripts
	if ($maint_commands->known($dhcommand) and not m/\s+\-n\s+/) {
	    $needtomodifyscripts = 1;
	}
	if ($miscDeps_commands->known($dhcommand)) {
	    $needmiscdepends = 1;
	}
	if ($dh_commands_depends->known($dhcommand)) {
	    my $dep = $dh_commands_depends->value($dhcommand);

	    # Special-case default-jdk-builddep.  It appears to be a sort of
	    # build-essential for Java applications.
	    if ($dhcommand eq 'dh_nativejava') {
		$dep = "$dep | default-jdk | default-jdk-builddep";
	    }
	    $missingbdeps{$dep} = $dhcommand;
	}
	if ($versions{$dhcommand}) {
	    push (@versioncheck, $dhcommand);
	}
	$seencommand = 1;
	$needbuilddepends = 1;
    } elsif (m,^\s+dh\s+,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	$needtomodifyscripts = 1;
	$needmiscdepends = 1;
	push (@versioncheck, 'dh');
    } elsif (m,^include\s+/usr/share/cdbs/1/rules/debhelper.mk,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	$needtomodifyscripts = 1;
	$needmiscdepends = 1;

	# CDBS sets DH_COMPAT but doesn't export it.  It does, however, create
	# a debian/compat file if none was found; that logic is handled later.
	$dhcompatvalue = $cdbscompat;
	$usescdbs = 1;
    } elsif (/^\s*export\s+DH_COMPAT\s*:?=\s*([^\s]+)/) {
	$level = $1;
    } elsif (/^\s*export\s+DH_COMPAT/) {
	$level = $dhcompatvalue if $dhcompatvalue;
    } elsif (/^\s*DH_COMPAT\s*:?=\s*([^\s]+)/) {
	$dhcompatvalue = $1;
	# one can export and then set the value:
	$level = $1 if ($level);
    }
    if (/^\s+dh_python\s/) {
        $seendhpython = 1;
    } elsif (m,^include\s+/usr/share/cdbs/1/class/python-distutils.mk,) {
        $usescdbspython = 1;
    }
}
close RULES;

return unless $seencommand;

my $pkgs = $info->binaries;
my $single_pkg = keys(%$pkgs) == 1 ? $pkgs->{(keys(%$pkgs))[0]} : '';

for my $binpkg (keys %$pkgs) {
    my ($weak_depends, $strong_depends, $depends) = ('','','');

    foreach my $field (qw(pre-depends depends)) {
	$strong_depends .= $info->binary_field($binpkg, $field);
    }
    foreach my $field (qw(recommends suggests)) {
	$weak_depends .= $info->binary_field($binpkg, $field);
    }
    $depends = $weak_depends . $strong_depends;

    tag 'debhelper-but-no-misc-depends', $binpkg
	if $needmiscdepends and $depends !~ m/\$\{misc:Depends\}/
	   and $pkgs->{$binpkg} eq 'deb';

    tag 'weak-dependency-on-misc-depends', $binpkg
	if $weak_depends =~ m/\$\{misc:Depends\}/
	   and $pkgs->{$binpkg} eq 'deb';
}

my $compatnan = 0;
# Check the compat file.  Do this separately from looping over all of the
# other files since we use the compat value when checking for brace expansion.
if (-f 'debfiles/compat') {
    my $compat_file = slurp_entire_file('debfiles/compat');
    ($compat) = split(/\n/, $compat_file);
    $compat =~ s/^\s+$//;
    if ($compat) {
	chomp $compat;
	if ($compat !~ m/^\d+$/) {
	    tag 'debhelper-compat-not-a-number', $compat;
	    $compat =~ s/[^\d]//g;
	    $compatnan = 1;
	}
	if ($level) {
	    tag 'declares-possibly-conflicting-debhelper-compat-versions',
		"rules=$level compat=$compat";
	} else {
	    # this is not just to fill in the gap, but because debhelper
	    # prefers DH_COMPAT over debian/compat
	    $level = $compat;
	}
    } else {
	tag 'debhelper-compat-file-is-empty';
    }
}
if (defined($level) and $level !~ m/^\d+$/ and not $compatnan) {
    tag 'debhelper-compatibility-level-not-a-number', $level;
    $level =~ s/[^\d]//g;
    $compatnan = 1;
}

if ($usescdbs and not defined($level)) {
    $level = $cdbscompat;
}
$level ||= 1;
if ($level < 5) {
    tag "package-uses-deprecated-debhelper-compat-version", $level;
}

if ($seendhcleank and $level >= 7) {
    tag "dh-clean-k-is-deprecated";
}


# Check the files in the debian directory for various debhelper-related
# things.
opendir(DEBIAN, 'debfiles')
    or fail("Can't open debfiles directory.");
while (defined(my $file=readdir(DEBIAN))) {
    if ($file =~ m/^(?:(.*)\.)?(?:post|pre)(?:inst|rm)$/) {
	next unless $needtomodifyscripts;

	# They need to have #DEBHELPER# in their scripts.  Search for scripts
	# that look like maintainer scripts and make sure the token is there.
        my $binpkg = $1 || '';
	open(IN, '<', "debfiles/$file")
	    or fail("Can't open debfiles/$file: $!");
	my $seentag = '';
	while (<IN>) {
	    if (m/\#DEBHELPER\#/) {
		$seentag = 1;
		last;
	    }
	}
	close IN;
	if (!$seentag) {
	    unless (($binpkg && exists($pkgs->{$binpkg})
		     && ($pkgs->{$binpkg} eq 'udeb'))
		    or (!$binpkg && ($single_pkg eq 'udeb'))) {
		tag "maintainer-script-lacks-debhelper-token", "debian/$file";
	    }
	}
    } elsif ($file =~ m/^control$/) {
	my $bdepends_noarch = $info->relation_noarch('build-depends-all');
        my $bdepends = $info->relation('build-depends-all');
        if ($needbuilddepends && ! $bdepends->implies('debhelper')) {
	    tag "package-uses-debhelper-but-lacks-build-depends", "";
	}
	while (my ($dep, $command) = each %missingbdeps) {
	    next if $dep eq 'debhelper'; #handled above
	    tag 'missing-build-dependency-for-dh_-command', "$command=$dep"
		unless ($bdepends_noarch->implies($dep));
	}
	my $needed = "debhelper (>= $level)";
	if ($level > 5 && ! $bdepends->implies($needed)) {
	    tag "package-lacks-versioned-build-depends-on-debhelper", $level;
	} elsif (@versioncheck) {
	    my %seen;
	    @versioncheck = grep { !$seen{$_}++ } @versioncheck;
	    for my $program (@versioncheck) {
		my $required = $versions{$program};
		my $needed = "debhelper (>= $required)";
		unless ($bdepends->implies($needed)) {
		    tag 'debhelper-script-needs-versioned-build-depends',
			$program, "(>= $required)";
		}
	    }
	}
    } elsif ($file =~ m/^ex\.|\.ex$/i) {
        tag "dh-make-template-in-source", "debian/$file";
    } else {
	my $base = $file;
	$base =~ s/^[.]+\.//;

	# Check whether this is a debhelper config file that takes a list of
	# filenames.  If so, check it for brace expansions, which aren't
	# supported.
	if ($filename_configs->known($base)) {
	    next if $level < 3;
	    open (IN, '<', "debfiles/$file")
		or fail("Can't open debfiles/$file: $!");
	    local $_;
	    while (<IN>) {
		next if /^\s*$/;
		next if (/^\#/ and $level >= 5);
		if (m/(?<!\\)\{(?:[^\s\\\}]+?,)+[^\\\}\s]+\}/) {
		    tag 'brace-expansion-in-debhelper-config-file',
			"debian/$file";
		}
	    }
	    close IN;
	}
    }
}
closedir(DEBIAN);

# Check for Python policy usage and the required debhelper dependency for
# dh_python policy support.  Assume people who intentionally set pycompat to
# something earlier than 2 know what they're doing.  Skip CDBS packages since
# CDBS creates pycompat internally at build time.
if ($seendhpython && !$usescdbspython) {
    if (open(PYCOMPAT, '<', "debfiles/pycompat")) {
	local $/;
	my $pycompat = <PYCOMPAT>;
	close PYCOMPAT;
    } else {
	tag "uses-dh-python-with-no-pycompat", "";
    }
}

}

1;

# Local Variables:
# indent-tabs-mode: t
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 ts=8 noet shiftround