# 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 Lintian::debhelper;
use strict;

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Dep;
use Tags;
use Util;
use Lintian::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 = Lintian::Data->new ('debhelper/maint_commands');
my $miscDeps_commands = Lintian::Data->new ('debhelper/miscDepends_commands');
my $dh_commands_depends = Lintian::Data->new ('debhelper/dh_commands', '=');

# 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_icons           => '5.0.51~',
       dh_installifupdown => '5.0.44~',
       dh_lintian         => '6.0.7~',
       dh                 => '7');


sub run {

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

my $seencommand = '';
my $needbuilddepends = '';
my $needtomodifyscripts = '';
my $needversiondepends = '';
my $seenversiondepends = '0';
my $compat = '';
my $usescdbs = '';
my $seendhpython = '';
my $usescdbspython = '';
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+(.+))?/) {
	    $needversiondepends = $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 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);
	    $missingbdeps{$dep} = $dhcommand;
	}
	if ($versions{$dhcommand}) {
	    push (@versioncheck, $dhcommand);
	}
	$seencommand = 1;
	$needbuilddepends = 1;
    } elsif (m,^\s+dh\s+,) {
	$seencommand = 1;
	$needbuilddepends = 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*(\d+)/) {
	$needversiondepends = $1;
    } elsif (/^\s*export\s+DH_COMPAT/) {
	$needversiondepends = $dhcompatvalue if $dhcompatvalue;
    } elsif (/^\s*DH_COMPAT\s*:?=\s*(\d+)/) {
	$dhcompatvalue = $1;
    }
    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 $depends = '';
    local $/;

    foreach my $field (qw(depends recommends suggests)) {
	if (open DEPENDS, '<', "control/$binpkg/$field") {
	    chomp ($depends .= <DEPENDS>);
	    close(DEPENDS);
	}
    }

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

# If we got this far, they need to have #DEBHELPER# in their scripts.  Search
# for scripts that look like maintainer scripts.  Also collect dependency
# information from debian/control and check compatibility level.
my $bdepends;
opendir(DEBIAN, 'debfiles')
    or fail("Can't open debfiles directory.");
while (defined(my $file=readdir(DEBIAN))) {
    if ($file =~ m/^(?:(.*)\.)?(?:post|pre)(?:inst|rm)$/) {
        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) and $needtomodifyscripts) {
	    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/^compat$/) {
	open (IN, '<', "debfiles/$file")
	    or fail("Can't open debfiles/$file: $!");
	$compat = <IN>;
	close IN;
	if ($compat) {
	    chomp $compat;
	    if ($needversiondepends) {
		tag "declares-possibly-conflicting-debhelper-compat-versions", "rules=$needversiondepends compat=$compat";
	    } else {
		$needversiondepends = $compat;
	    }
	} else {
	    tag "debhelper-compat-file-is-empty", "";
	}
    } elsif ($file =~ m/^control$/) {
        my ($control) = read_dpkg_control("debfiles/$file");
        $bdepends = '';
        for my $field ('build-depends', 'build-depends-indep') {
            next unless $control->{$field};
            $bdepends .= ', ' if $bdepends;
            $bdepends .= $control->{$field};
        }
        $bdepends = Dep::parse($bdepends);
        if ($needbuilddepends && ! Dep::implies($bdepends, Dep::parse('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 (Dep::implies($bdepends, Dep::parse($dep)));
	}
    } elsif ($file =~ m/^ex\.|\.ex$/i) {
        tag "dh-make-template-in-source", "debian/$file";
    }
}
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", "";
    }
}

if ($usescdbs and not $needversiondepends) {
    $needversiondepends = $cdbscompat;
}
$needversiondepends ||= 1;
if ($needversiondepends < 4) {
    tag "package-uses-deprecated-debhelper-compat-version", $needversiondepends;
} elsif ($needversiondepends > 5 and ! Dep::implies($bdepends, Dep::parse("debhelper (>= $needversiondepends)"))) {
    tag "package-lacks-versioned-build-depends-on-debhelper", $needversiondepends;
} elsif (@versioncheck) {
    for my $program (@versioncheck) {
        my $required = $versions{$program};
        tag 'debhelper-script-needs-versioned-build-depends', $program, "(>= $required)"
            unless Dep::implies($bdepends, Dep::parse("debhelper (>= $required)"));
    }
}

}

1;

# vim: syntax=perl
