# control-files -- lintian check script -*- perl -*-

# Copyright (C) 1998 Christian Schwarz and Richard Braakman
#
# 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::control_files;
use strict;
use Tags;
use Util;

sub run {

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

my %ctrl_deb =
    (
     'clilibs', 0644,
     'config', 0755,
     'control', 0644,
     'conffiles', 0644,
     'md5sums', 0644,
     'postinst', 0755,
     'preinst', 0755,
     'postrm', 0755,
     'prerm', 0755,
     'shlibs', 0644,
     'symbols', 0644,
     'templates', 0644,
     'triggers', 0644,
    );

my %ctrl_udeb =
    (
     'config', 0755,
     'control', 0644,
     'isinstallable', 0755,
     'menutest', 0755,
     'postinst', 0755,
     'shlibs', 0644,
     'symbols', 0644,
     'templates', 0644,
    );

my %ctrl = $type eq 'udeb' ? %ctrl_udeb : %ctrl_deb;
my %ctrl_alt = $type eq 'udeb' ? %ctrl_deb : %ctrl_udeb;

# process control-index file
open(IN, '<', "control-index") or fail("cannot open control-index file: $!");
while (<IN>) {
    chop;

    my ($perm,$owner,$size,$date,$time,$file) = split(' ', $_, 6);
    my $operm;

    next if $file eq './';

    $file =~ s,^(\./),,;
    $file =~ s/ link to .*//;
    $file =~ s/ -> .*//;

    next if $file eq './';

    # valid control file?
    unless ( exists $ctrl{$file} ) {
	if ( exists $ctrl_alt{$file} ) {
	    tag "not-allowed-control-file", "$file";
	    next;
	} else {
	    tag "unknown-control-file", "$file";
	    next;
	}
    }

    # I'm not sure about the udeb case
    if ($type ne 'udeb' and $size == 0) {
	tag "control-file-is-empty", "$file";
    }


    # skip `control' control file (that's an exception: dpkg doesn't care and
    # this file isn't installed on the systems anyways)
    next if $file eq 'control';

    $operm = perm2oct($perm);

    # correct permissions?
    unless ($operm == $ctrl{$file}) {
	tag "control-file-has-bad-permissions",
	    sprintf("$file %04o != %04o",$operm,$ctrl{$file});
    }

    # correct owner?
    unless ($owner eq 'root/root') {
	tag "control-file-has-bad-owner", "$file $owner != root/root";
    }

# for other maintainer scripts checks, see the scripts check
}
close IN;

} # </run>

1;

# vim: syntax=perl sw=4 ts=8