# 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 warnings;

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
use Lintian::Data;
use Lintian::Tags qw(tag);

# If compat is less than or equal to this, then a missing version
# for this level is only a pedantic issue.
use constant PEDANTIC_COMPAT => 7;

# 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 $dh_commands_depends = Lintian::Data->new ('debhelper/dh_commands', '=');
my $filename_configs = Lintian::Data->new ('debhelper/filename-config-files');
my $dh_alt_deps = Lintian::Data->new ('debhelper/alt-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_bugfiles        => '7.2.3~');

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 $overridetargets = 0;
my %missingbdeps;

my $maybe_skipping;
my $dhcompatvalue;
my @versioncheck;
my $inclcdbs = 0;

my $seenmaintscript = 0;
my $bdepends_noarch;
my $bdepends;

open(RULES, '<', 'debfiles/rules') or fail("cannot read debian/rules: $!");

while (<RULES>) {
    if (/^ifn?(?:eq|def)\s/) {
        $maybe_skipping++;
    } elsif (/^endif\s/) {
        $maybe_skipping--;
    }

    if (m/^\s+-?(dh_\w+)/) {
        my $dhcommand = $1;

	if ($dhcommand eq 'dh_dhelp') {
	    tag 'dh_dhelp-is-deprecated', "line $.";
	}
	if ($dhcommand eq 'dh_suidregister') {
	    tag 'dh_suidregister-is-obsolete', "line $.";
	}
	if ($dhcommand eq 'dh_undocumented') {
	    tag 'dh_undocumented-is-obsolete', "line $.";
	}

	# Don't warn about recently deprecated commands in code that may be
	# optional.  It may be there only for backports.
	unless ($maybe_skipping) {
	    if ($dhcommand eq 'dh_desktop') {
		tag 'dh_desktop-is-deprecated', "line $.";
	    }
	    if ($dhcommand eq 'dh_scrollkeeper') {
		tag 'dh_scrollkeeper-is-deprecated', "line $.";
	    }
	    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 debhelper commands are wrapped in make conditionals, assume the
	# maintainer knows what they're doing and don't check build
	# dependencies.
	unless ($maybe_skipping) {
	    if ($dh_commands_depends->known($dhcommand)) {
		my $dep = $dh_commands_depends->value($dhcommand);
		my $alt = $dh_alt_deps->value($dhcommand)//'';

		if ($alt) {
		    $dep = "$dep | $alt";
		}
		$missingbdeps{$dep} = $dhcommand;
	    }
	    if ($versions{$dhcommand}) {
		push (@versioncheck, $dhcommand);
	    }
	}
	$seencommand = 1;
	$needbuilddepends = 1;
    } elsif (m,^\s+dh\s+,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	$needtomodifyscripts = 1;
    } elsif (m,^include\s+/usr/share/cdbs/1/rules/debhelper.mk,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	$needtomodifyscripts = 1;
	$inclcdbs = 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);
    } elsif (/^override_dh_/) {
	$needbuilddepends = 1;
	$overridetargets = 1;
    } elsif (m,^include\s+/usr/share/cdbs/,){
	$inclcdbs = 1;
    }
    if (/^\s+dh_python\s/) {
        $seendhpython = 1;
    } elsif (m,^include\s+/usr/share/cdbs/1/class/python-distutils.mk,) {
        $usescdbspython = 1;
    }
}
close RULES;

unless ($inclcdbs){
    my $bdepends = $info->relation('build-depends-all');
    # Okay - d/rules does not include any file in /usr/share/cdbs/
    tag 'unused-build-dependency-on-cdbs' if ($bdepends->implies('cdbs'));
}

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 $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) {
	$compat =~ s/^\s+//;
	$compat =~ s/\s+$//;
	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.
my @indebfiles = ();
opendir(DEBIAN, 'debfiles')
    or fail("Can't open debfiles directory.");
foreach my $file (sort 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 eq 'control') {
	next; # ignore
    } elsif ($file =~ m/^ex\.|\.ex$/i) {
        tag 'dh-make-template-in-source', "debian/$file";
    } elsif ($file =~ m/^(?:.+\.)?debhelper(?:\.log)?$/){
	push(@indebfiles, $file);
    } elsif ($file =~ m/^(?:(.*)\.)?maintscript$/) {
	$seenmaintscript = 1;
    } 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);

$bdepends_noarch = $info->relation_noarch('build-depends-all');
$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));
}


unless ($bdepends->implies("debhelper (>= $level~)")){
    my $tagname = 'package-needs-versioned-debhelper-build-depends';
    $tagname = 'package-lacks-versioned-build-depends-on-debhelper'
	if ($level <= PEDANTIC_COMPAT);

    tag $tagname, $level;
}

if (@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)";
	}
    }
}

if ($overridetargets) {
    my $required = '7.0.50~';
    my $needed = "debhelper (>= $required)";
    unless ($bdepends->implies($needed)) {
	tag 'debhelper-overrides-need-versioned-build-depends',
	"(>= $required)";
    }
}

if ($seenmaintscript) {
    my $required = '8.1.0~';
    my $needed = "debhelper (>= $required)";
    unless ($bdepends->implies($needed)) {
	tag 'debhelper-maintscript-needs-versioned-build-depends',
	"(>= $required)";
    }
}


if(scalar(@indebfiles)){
    my $f = pop(@indebfiles);
    my $others = scalar(@indebfiles);
    my $otext = '';
    if($others > 1){
	$otext = " and $others others";
    } elsif($others == 1){
	$otext = ' and 1 other';
    }
    tag 'temporary-debhelper-file', "$f$otext";
}

# 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
