# 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 Tags;
use Util;

sub run {

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

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Dep;

my %commands;

my $seencommand = '';
my $needbuilddepends = '';
my $needtomodifyscripts = '';
my $needversiondepends = '';
my $seenversiondepends = '0';
my $compat = '';
my $usescdbs = '';
my $seendhpython = '';
my $usescdbspython = '';

# If there is no debian/compat file present but cdbs is being used, cdbs will
# create one automatically.  Currently it always uses compatibility level 4.
# 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;

# Parse the debian/rules file, and try to figure out if debhelper commands
# are run in it that like to modify maintainer scripts. Those debhelper
# commands can be found by "grep -l autoscript /usr/bin/dh_*", but I'll
# hardcode them here.

map { $commands{$_}=1 } qw(dh_desktop
			   dh_gconf
			   dh_icons
			   dh_installcatalogs
			   dh_installdebconf
                           dh_installdefoma
                           dh_installdocs
			   dh_installemacsen
			   dh_installinfo
			   dh_installinit
			   dh_installmenu
			   dh_installmime
			   dh_installmodules
			   dh_installtex
			   dh_installudev
			   dh_installwm
			   dh_installxfonts
			   dh_installxmlcatalogs
			   dh_makeshlibs
			   dh_pycentral
			   dh_pysupport
			   dh_python
			   dh_scrollkeeper
			   dh_suidregister
			   dh_usrlocal
			   );

# 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');

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 ($commands{$dhcommand} and not m/\s+\-n\s+/) {
	    $needtomodifyscripts = 1;
	}
        if ($versions{$dhcommand}) {
            push (@versioncheck, $dhcommand);
        }
	$seencommand = 1;
	$needbuilddepends = 1;
    } elsif (m,^\s+dh\s+,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	push (@versioncheck, 'dh');
    } elsif (m,^include\s+/usr/share/cdbs/1/rules/debhelper.mk,) {
	$seencommand = 1;
	$needbuilddepends = 1;
	$needtomodifyscripts = 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;

# We may need to make a difference between deb and udeb packages
# so try to find out
my (%pkgs, $single_pkg);
opendir(BINPKGS, 'control')
    or fail("Can't open control directory.");
while(my $binpkg = readdir(BINPKGS)) {
    next if $binpkg =~ /^\.\.?$/;
    if (-d "control/$binpkg") {
        if (open TYPE, "<", "control/$binpkg/xc-package-type") {
            $pkgs{$binpkg} = <TYPE> || 'deb';
        } else {
            $pkgs{$binpkg} = 'deb';
        }
	$single_pkg = $pkgs{$binpkg};
    }
}
$single_pkg = undef unless keys(%pkgs) == 1;

# 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 $depends;
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 && $pkgs{$binpkg} && ($pkgs{$binpkg} =~ /udeb/i))
		    or (!$binpkg && $single_pkg && ($single_pkg =~ /udeb/i))) {
		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");
        $depends = '';
        for my $field ('build-depends', 'build-depends-indep') {
            next unless $control->{$field};
            $depends .= ', ' if $depends;
            $depends .= $control->{$field};
        }
        $depends = Dep::parse($depends);
        if ($needbuilddepends && ! Dep::implies($depends, Dep::parse('debhelper'))) {
	    tag "package-uses-debhelper-but-lacks-build-depends", "";
	}
    } 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;
	if ($pycompat >= 2 && ! Dep::implies($depends, Dep::parse('debhelper (>= 5.0.37.2)'))) {
	    tag "package-needs-python-policy-debhelper", "";
	}
    } 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 > 4 and ! Dep::implies($depends, 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($depends, Dep::parse("debhelper (>= $required)"));
    }
}

}

1;

# vim: syntax=perl