lintian 2.5.6 / usr / share / lintian / checks / files

# 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::files;
use strict;
use warnings;

use File::Basename;

use Lintian::Data;
use Lintian::Tags qw(tag);
use Util;

my $FONT_PACKAGES;
my $TRIPLETS;
my $LOCALE_CODES;
my $INCORRECT_LOCALE_CODES;

# A list of known packaged Javascript libraries
# and the packages providing them
my @jslibraries = (
    [ qr,(?i)mochikit\.js(\.gz)?$, => qr'libjs-mochikit' ],
    [ qr,(?i)mootools((\.v|-)[\d\.]+)?(-((core(-server)?)|more)(-(yc|jm|nc))?)?\.js(\.gz)?$, => qr'libjs-mootools' ],
    [ qr,(?i)jquery(\.(min|lite|pack))?\.js(\.gz)?$, => qr'libjs-jquery' ],
    [ qr,(?i)prototype(-[\d\.]+)?\.js(\.gz)?$, => qr'libjs-prototype' ],
    [ qr,(?i)scriptaculous\.js(\.gz)?$, => qr'libjs-scriptaculous' ],
    [ qr,(?i)fckeditor\.js(\.gz)?$, => qr'fckeditor' ],
    [ qr,(?i)ckeditor\.js(\.gz)?$, => qr'ckeditor' ],
    [ qr,(?i)cropper(\.uncompressed)?\.js(\.gz)?$, => qr'libjs-cropper' ],
    [ qr,(?i)(yahoo|yui)-(dom-event|min)\.js(\.gz)?$, => qr'libjs-yui' ],
    [ qr,(?i)jquery\.cookie(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-cookie' ],
    [ qr,(?i)jquery\.form(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-form' ],
    [ qr,(?i)jquery\.mousewheel(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-mousewheel' ],
    [ qr,(?i)jquery\.easing(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-easing' ],
    [ qr,(?i)jquery\.event\.drag(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-event-drag' ],
    [ qr,(?i)jquery\.event\.drop(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-event-drop' ],
    [ qr,(?i)jquery\.fancybox(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-fancybox' ],
    [ qr,(?i)jquery\.galleriffic(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-galleriffic' ],
    [ qr,(?i)jquery\.jfeed(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-jfeed' ],
    [ qr,(?i)jquery\.history(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-history' ],
    [ qr,(?i)jquery\.jush(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-jush' ],
    [ qr,(?i)jquery\.meiomask(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-meiomask' ],
    [ qr,(?i)jquery\.opacityrollover(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-opacityrollover' ],
    [ qr,(?i)jquery\.tipsy(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-tipsy' ],
    [ qr,(?i)jquery\.metadata(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-metadata' ],
    [ qr,(?i)jquery\.tablesorter(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-tablesorter' ],
    [ qr,(?i)jquery\.livequery(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-livequery' ],
    [ qr,(?i)jquery\.treetable(\.min)?\.js(\.gz)?$, => qr'libjs-jquery-treetable' ],
# Disabled due to false positives.  Needs a content check adding to verify
# that the file being checked is /the/ yahoo.js
#    [ qr,(?i)yahoo\.js(\.gz)?$, => qr'libjs-yui' ],
    [ qr,(?i)jsjac(\.packed)?\.js(\.gz)?$, => qr'libjs-jac' ],
    [ qr,(?i)jsMath(-fallback-\w+)?\.js(\.gz)?$, => qr'jsmath' ],
    [ qr,(?i)tiny_mce(_(popup|src))?\.js(\.gz)?$, => qr'tinymce2?' ],
    [ qr,(?i)dojo\.js(\.uncompressed\.js)?(\.gz)?$, => qr'libjs-dojo-\w+' ],
    [ qr,(?i)dijit\.js(\.uncompressed\.js)?(\.gz)?$, => qr'libjs-dojo-\w+' ],
    [ qr,(?i)strophe(\.min)?\.js(\.gz)?$, => qr'libjs-strophe' ],
    [ qr,(?i)swfobject(?:\.min)?\.js(?:\.gz)?$, => qr'libjs-swfobject' ],
    [ qr,(?i)underscore(\.min)?\.js(\.gz)?$, => qr'libjs-underscore' ],
# not yet available in unstable:
#    [ qr,(?i)(htmlarea|Xinha(Loader|Core))\.js$, => qr'xinha' ],
);

# A list of known packaged PEAR modules
# and the packages providing them
my @pearmodules = (
    [ qr,(?<!Auth/)HTTP\.php$, => 'php-http' ],
    [ qr,Auth\.php$, => 'php-auth' ],
    [ qr,Auth/HTTP\.php$, => 'php-auth-http' ],
    [ qr,Benchmark/(Timer|Profiler|Iterate)\.php$, => 'php-benchmark' ],
    [ qr,Cache\.php$, => 'php-cache' ],
    [ qr,Cache/Lite\.php$, => 'php-cache-lite' ],
    [ qr,Compat\.php$, => 'php-compat' ],
    [ qr,Config\.php$, => 'php-config' ],
    [ qr,CBC\.php$, => 'php-crypt-cbc' ],
    [ qr,Date\.php$, => 'php-date' ],
    [ qr,(?<!Container)/DB\.php$, => 'php-db' ],
    [ qr,(?<!Container)/File\.php$, => 'php-file' ],
    [ qr,Log\.php$, => 'php-log' ],
    [ qr,Log/(file|error_log|null|syslog|sql\w*)\.php$, => 'php-log' ],
    [ qr,Mail\.php$, => 'php-mail' ],
    [ qr,(?i)mime(Part)?\.php$, => 'php-mail-mime' ],
    [ qr,mimeDecode\.php$, => 'php-mail-mimedecode' ],
    [ qr,FTP\.php$, => 'php-net-ftp' ],
    [ qr,(?<!Container/)IMAP\.php$, => 'php-net-imap' ],
    [ qr,SMTP\.php$, => 'php-net-smtp' ],
    [ qr,(?<!FTP/)Socket\.php$, => 'php-net-socket' ],
    [ qr,IPv4\.php$, => 'php-net-ipv4' ],
    [ qr,(?<!Container/)LDAP\.php$, => 'php-net-ldap' ],
);

# A list of known packaged php (!PEAR) libraries
# and the packages providing them
my @phplibraries = (
    [ qr,(?i)adodb\.inc\.php$, => 'libphp-adodb' ],
    [ qr,(?i)Smarty(_Compiler)?\.class\.php$, => 'smarty' ],
    [ qr,(?i)class\.phpmailer(\.(php|inc))+$, => 'libphp-phpmailer' ],
    [ qr,(?i)phpsysinfo\.dtd$, => 'phpsysinfo' ],
    [ qr,(?i)class\.(Linux|(Open|Net|Free|)BSD)\.inc\.php$, => 'phpsysinfo' ],
    [ qr,Auth/(OpenID|Yadis/Yadis)\.php$, => 'php-openid' ],
    [ qr,(?i)Snoopy\.class\.(php|inc)$, => 'libphp-snoopy' ],
    [ qr,(?i)markdown\.php$, => 'libmarkdown-php' ],
    [ qr,(?i)geshi\.php$, => 'php-geshi' ],
    [ qr,(?i)(class[.-])?pclzip\.(inc|lib)?\.php$, => 'libphp-pclzip' ],
    [ qr,(?i).*layersmenu.*/(lib/)?PHPLIB\.php$, => 'libphp-phplayersmenu' ],
    [ qr,(?i)phpSniff\.(class|core)\.php$, => 'libphp-phpsniff' ],
    [ qr,(?i)(class\.)?jabber\.php$, => 'libphp-jabber' ],
    [ qr,(?i)(class[\.-])?simplepie(\.(php|inc))+$, => 'libphp-simplepie' ],
    [ qr,(?i)jpgraph\.php$, => 'libphp-jpgraph' ],
    [ qr,(?i)fpdf\.php$, => 'php-fpdf' ],
    [ qr,(?i)getid3\.(lib\.)?(\.(php|inc))+$, => 'php-getid3' ],
    [ qr,(?i)streams\.php$, => 'php-gettext' ],
    [ qr,(?i)rss_parse\.(php|inc)$, => 'libphp-magpierss' ],
    [ qr,(?i)unit_tester\.php$, => 'php-simpletest' ],
    [ qr,(?i)Sparkline\.php$, => 'libsparkline-php' ],
    [ qr,(?i)(?:class\.)?nusoap\.(?:php|inc)$, => 'libnusoap-php' ],
    [ qr,(?i)HTMLPurifier\.php$, => 'php-htmlpurifier' ],
# not yet available in unstable:,
#    [ qr,(?i)IXR_Library(\.inc|\.php)+$, => 'libphp-ixr' ],
#    [ qr,(?i)(class\.)?kses\.php$, => 'libphp-kses' ],
);

# A list of known non-free flash executables
my @flash_nonfree = (
    qr<(?i)dewplayer(?:-\w+)?\.swf$>,
    qr<(?i)(?:mp3|flv)player\.swf$>,
# Situation needs to be clarified:
#    qr,(?i)multipleUpload\.swf$,
#    qr,(?i)xspf_jukebox\.swf$,
);

# Regexes to try against the package description to find metapackages or
# transitional packages.
my @METAPKG_REGEX =
    (qr/meta[ -]?package/, qr/dummy/,
     qr/(?:dependency|empty|virtual) package/);

# Common files stored in /usr/share/doc/$pkg that aren't sufficient to
# consider the package non-empty.
my $STANDARD_FILES = Lintian::Data->new('files/standard-files');

sub run {

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

my $file;
my $source_pkg;
my $pkg_section;
my $is_python;
my $is_perl;
my $has_binary_perl_file;
my @nonbinary_perl_files_in_lib;

my %linked_against_libvga;

my $py_support_nver = undef;

my $arch_dep_files = 0;
my $arch = $info->field ('architecture')//'';
my $isma_same = ($info->field ('multi-arch')//'') eq 'same';

# read data from objdump-info file
foreach my $file (sort keys %{$info->objdump_info}) {
    my $objdump = $info->objdump_info->{$file};

    if (defined $objdump->{NEEDED}) {
        for my $lib (@{$objdump->{NEEDED}}) {
            $linked_against_libvga{$file} = 1
                if $lib =~ /^libvga\.so\./;
        }
    }
}

# Get source package name, if possible.
#
# Note: $proc->pkg_src never includes the source version.
#
# Otherwise set it to the empty string to avoid "unitialized value"
# warnings if we end up using it a bit too carelessly.
$source_pkg = $proc->pkg_src()//'';

# Get section if available.
$pkg_section = $info->field('section')//'';

# find out which files are scripts
my %script = map {$_ => 1} (sort keys %{$info->scripts});

# We only want to warn about these once.
my $warned_debug_name = 0;

my @devhelp;
my @devhelp_links;

# X11 bitmapped font directories under /usr/share/fonts/X11 in which we've
# seen files.
my %x11_font_dirs;

# Check if package is empty
my $is_dummy = $info->is_transitional;
my $description = $info->field('description');
if (!$is_dummy && $description) {
    for my $regex (@METAPKG_REGEX) {
        if ($description =~ /$regex/) {
            $is_dummy = 1;
            last;
        }
    }
}
if (!$is_dummy) {
    my $is_empty = 1;
    for my $file (@{$info->sorted_index}) {
        # Ignore directories
        unless ($file =~ m,/$,) {
            # Skip if $file is an empty string
            next if not $file;
            # Skip if $file is outside /usr/share/doc/$pkg directory
            if ($file !~ m,^usr/share/doc/\Q$pkg\E,) {
                # - except if it is an lintian override.
                next if ($file =~ m,^usr/share/lintian/overrides/\Q$pkg\E$,);
                $is_empty = 0;
                last;
            }
            # Skip if /usr/share/doc/$pkg has files in a subdirectory
            if ($file =~ m,^usr/share/doc/\Q$pkg\E/[^/]++/,) {
                $is_empty = 0;
                last;
            }
            # Skip /usr/share/doc/$pkg symlinks.
            next if $file eq "usr/share/doc/$pkg";
            # For files directly in /usr/share/doc/$pkg, if the file isn't one
            # of the uninteresting ones, the package isn't empty.
            unless ($STANDARD_FILES->known(basename($file))) {
                $is_empty = 0;
                last;
            }
        }
    }
    tag 'empty-binary-package' if ($is_empty && $type ne 'udeb');
}

# Read package contents...
foreach my $file (@{$info->sorted_index}) {
    next if $file eq '';
    my $index_info = $info->index->{$file};
    my $owner = $index_info->{owner} . '/' . $index_info->{group};
    my $operm = $index_info->{operm};
    my $link = $index_info->{link};

    $arch_dep_files = 1 if $file !~ m,^usr/share/,o && $file ne 'usr/';

    if ($index_info->{type} eq 'h') {
        my $link_target_dir = $link;
        $link_target_dir =~ s,[^/]*$,,;

        # It may look weird to sort the file and link target here, but since
        # it's a hard link, both files are equal and either could be
        # legitimately reported first.  tar will generate different tar files
        # depending on the hashing of the directory, and this sort produces
        # stable lintian output despite that.
        #
        # TODO: actually, policy says 'conffile', not '/etc' -> extend!
        tag 'package-contains-hardlink', join (' -> ', sort ($file, $link))
            if $file =~ m,^etc/,
                or $link =~ m,^etc/,
                or $file !~ m,^\Q$link_target_dir\E[^/]*$,;
    }

    my ($year) = ($index_info->{date} =~ /^(\d{4})/);
    if ( $year <= 1984 ) { # value from dak CVS: Dinstall::PastCutOffYear
        tag 'package-contains-ancient-file', "$file " . $index_info->{date};
    }

    if (!($index_info->{uid} < 100 || $index_info->{uid} == 65_534
            || ($index_info->{uid} >= 60_000 && $index_info->{uid} < 65_000))
            || !($index_info->{gid} < 100 || $index_info->{gid} == 65_534
            || ($index_info->{gid} >= 60_000 && $index_info->{gid} < 65_000))) {
        tag 'wrong-file-owner-uid-or-gid', $file, $index_info->{uid} . '/' . $index_info->{gid};
    }

    # *.devhelp and *.devhelp2 files must be accessible from a directory in
    # the devhelp search path: /usr/share/devhelp/books and
    # /usr/share/gtk-doc/html.  We therefore look for any links in one of
    # those directories to another directory.  The presence of such a link
    # blesses any file below that other directory.
    if (defined $link and $file =~ m,usr/share/(?:devhelp/books|gtk-doc/html)/,) {
        my $blessed = $link;
        if ($blessed !~ m,^/,) {
            my $base = $file;
            $base =~ s,/+[^/]+$,,;
            while ($blessed =~ s,^\.\./,,) {
                $base =~ s,/+[^/]+$,,;
            }
            $blessed = "$base/$blessed";
        }
        push (@devhelp_links, $blessed);
    }

    # ---------------- /etc
    if ($file =~ m,^etc/,) {
        if ($file =~ m,^etc/nntpserver, ) {
            tag 'package-uses-obsolete-file', $file;
        }
        # ---------------- /etc/cron.daily, etc.
        elsif ($file =~ m,^etc/cron\.(?:daily|hourly|monthly|weekly|d)/[^\.].*\., ) {
            tag 'run-parts-cron-filename-contains-full-stop', $file;
        }
        # ---------------- /etc/cron.d
        elsif ($file =~ m,^etc/cron\.d/\S, and $operm != 0644) {
            tag 'bad-permissions-for-etc-cron.d-script', sprintf('%s %04o != 0644',$file,$operm);
        }
        # ---------------- /etc/emacs.*
        elsif ($file =~ m,^etc/emacs.*/\S, and $index_info->{type} =~ m,^[-h],
               and $operm != 0644) {
            tag 'bad-permissions-for-etc-emacs-script', sprintf('%s %04o != 0644',$file,$operm);
        }
        # ---------------- /etc/gconf/schemas
        elsif ($file =~ m,^etc/gconf/schemas/\S,) {
            tag 'package-installs-into-etc-gconf-schemas', $file;
        }
        # ---------------- /etc/init.d
        elsif ($file =~ m,^etc/init\.d/\S,
               and $file !~ m,^etc/init\.d/(?:README|skeleton)$,
               and $operm != 0755
               and $index_info->{type} =~ m,^[-h],) {
            tag 'non-standard-file-permissions-for-etc-init.d-script',
                sprintf('%s %04o != 0755',$file,$operm);
        }
        #----------------- /etc/ld.so.conf.d
        elsif ($file =~ m,^etc/ld\.so\.conf\.d/.+$, and $pkg !~ /^libc/) {
            tag 'package-modifies-ld.so-search-path', $file;
        }
        #----------------- /etc/modprobe.d
        elsif ($file =~ m,^etc/modprobe\.d/(.+)$, and $1 !~ m,\.conf$, and $index_info->{type} !~ m/^d/) {
            tag 'non-conf-file-in-modprobe.d', $file;
        }
        #----------------- /etc/pam.conf
        elsif ($file =~ m,^etc/pam.conf, and $pkg ne 'libpam-runtime' ) {
            tag 'config-file-reserved', "$file by libpam-runtime";
        }
        #----------------- /etc/php5/conf.d
        elsif ($file =~ m,^etc/php5/conf.d/.+\.ini$,) {
            if ($index_info->{type} =~ m/^[-h]/) {
                open (PHPINI, '<', $info->unpacked($file)) or fail("cannot open .ini file: $!");
                while (<PHPINI>) {
                    next unless (m/^\s*#/);
                    tag 'obsolete-comments-style-in-php-ini', $file;
                    # only warn once per file:
                    last;
                }
                close(PHPINI);
            }
        }
        # ---------------- /etc/rc.d && /etc/rc?.d
        elsif ($type ne 'udeb' and $file =~ m,^etc/rc(?:\d|S)?\.d/\S, and $pkg !~ /^(?:sysvinit|file-rc)$/) {
            tag 'package-installs-into-etc-rc.d', $file;
        }
        # ---------------- /etc/rc.boot
        elsif ($file =~ m,^etc/rc\.boot/\S,) {
            tag 'package-installs-into-etc-rc.boot', $file;
        }
        # ---------------- /etc/udev/rules.d
        elsif ($file =~ m,^etc/udev/rules\.d/\S,) {
            tag 'udev-rule-in-etc', $file;
        }
    }
    # ---------------- /usr
    elsif ($file =~ m,^usr/,) {
        # ---------------- /usr/share/doc
        if ($file =~ m,^usr/share/doc/\S,) {
            if ($type eq 'udeb') {
                tag 'udeb-contains-documentation-file', $file;
            } else {
                # file not owned by root?
                if ($owner ne 'root/root') {
                    tag 'bad-owner-for-doc-file', "$file $owner != root/root";
                }

                # file directly in /usr/share/doc ?
                if ($index_info->{type} =~ m/^[-h]/ and $file =~ m,^usr/share/doc/[^/]+$,) {
                    tag 'file-directly-in-usr-share-doc', $file;
                }

                # executable in /usr/share/doc ?
                if ($index_info->{type} =~ m/^[-h]/ and
                    $file !~ m,^usr/share/doc/(?:[^/]+/)?examples/, and
                    ($operm & 0111)) {
                    if ($script{$file}) {
                        tag 'script-in-usr-share-doc', $file;
                    } else {
                        tag 'executable-in-usr-share-doc', $file, (sprintf '%04o', $operm);
                    }
                }

                # zero byte file in /usr/share/doc/
                if ($index_info->{size} == 0 and $index_info->{type} =~ m,^-,) {
                    # Exceptions: examples may contain empty files for various
                    # reasons, Doxygen generates empty *.map files, and Python
                    # uses __init__.py to mark module directories.
                    unless ($file =~ m,^usr/share/doc/(?:[^/]+/)?examples/,
                            or $file =~ m,^usr/share/doc/(?:.+/)?html/.*\.map$,
                            or $file =~ m,^usr/share/doc/(?:.+/)?__init__\.py$,) {
                        tag 'zero-byte-file-in-doc-directory', $file;
                    }
                }
                # gzipped zero byte files:
                # 276 is 255 bytes (maximal length for a filename) + gzip overhead
                if ($file =~ m,.gz$, and $index_info->{size} <= 276
                    and $index_info->{type} =~ m,^[-h],
                    and $info->file_info->{$file} =~ m/gzip compressed/) {
                    my $f = quotemeta($info->unpacked($file));
                    unless (`gzip -dc $f`) {
                        tag 'zero-byte-file-in-doc-directory', $file;
                    }
                }

                # contains an INSTALL file?
                my $tmp = quotemeta($pkg);
                if ($file =~ m,^usr/share/doc/$tmp/INSTALL(?:\..+)*$,) {
                    tag 'package-contains-upstream-install-documentation', $file;
                }

                # contains a README for another distribution/platform?
                if ($file =~ m,^usr/share/doc/$tmp/readme\.(?:apple|aix|atari|be|beos|bsd|bsdi|
                                cygwin|darwin|irix|gentoo|freebsd|mac|macos|macosx|netbsd|
                                openbsd|osf|redhat|sco|sgi|solaris|suse|sun|vms|win32|win9x|
                                windows)(?:\.txt)?(?:\.gz)?$,xi){
                    tag 'package-contains-readme-for-other-platform-or-distro', $file;
                }

                # contains a compressed version of objects.inv in sphinx-generated documentation?
                if ($file =~ m,^usr/share/doc/$tmp/(?:[^/]+/)+objects\.inv\.gz$,
                    and $info->file_info->{$file} =~ m/gzip compressed/) {
                    tag 'compressed-objects.inv', $file;
                }

            }
        }
        # ---------------- /usr/doc
        elsif ($file =~ m,^usr/doc/\S,) {
            if ($file =~ m,^usr/doc/examples/\S+, and $index_info->{type} eq 'd') {
                tag 'old-style-example-dir', $file;
            }
        }
        # ---------------- /usr/X11R6/lib/X11/app-defaults
        elsif ($file =~ m,usr/X11R6/lib/X11/app-defaults,) {
            tag 'old-app-defaults-directory', $file;
        }

        #----------------- /usr/X11R6/
        elsif ($file =~ m,^usr/X11R6/bin, && $pkg ne 'x11-common') {
            tag 'package-installs-file-to-usr-x11r6-bin', $file;
        }
        elsif ($file =~ m,^usr/X11R6/lib/X11/fonts,) {
            tag 'package-installs-font-to-usr-x11r6', $file;
        }
        elsif ($file =~ m,^usr/X11R6/, and
               $index_info->{type} !~ m,^l,) { #links to FHS locations are allowed
            tag 'package-installs-file-to-usr-x11r6', $file;
        }

        # ---------------- /usr/lib/debug
        elsif ($file =~ m,^usr/lib/debug/\S,) {
            unless ($warned_debug_name) {
                tag 'debug-package-should-be-named-dbg', $file
                    unless ($pkg =~ /-dbg$/);
                $warned_debug_name = 1;
            }

            if ($index_info->{type} =~ m/^[-h]/o &&
                $file =~ m,^usr/lib/debug/usr/lib/pyshared/(python\d?(?:\.\d+))/(.++)$,o){
                my $correct = "usr/lib/debug/usr/lib/pymodules/$1/$2";
                tag 'python-debug-in-wrong-location', $file, $correct;
            }
        }

        # ---------------- /usr/lib/sgml
        elsif ($file =~ m,^usr/lib/sgml/\S,) {
            tag 'file-in-usr-lib-sgml', $file;
        }
        # ---------------- perllocal.pod
        elsif ($file =~ m,^usr/lib/perl.*/perllocal.pod$,) {
            tag 'package-installs-perllocal-pod', $file;
        }
        # ---------------- .packlist files
        elsif ($file =~ m,^usr/lib/perl.*/.packlist$,) {
            tag 'package-installs-packlist', $file;
        }
        elsif ($file =~ m,^usr/lib/perl5/.*\.(?:pl|pm)$,) {
            push @nonbinary_perl_files_in_lib, $file;
        }
        elsif ($file =~ m,^usr/lib/perl5/.*\.(?:bs|so)$,) {
            $has_binary_perl_file = 1;
        }
        # ---------------- /usr/lib -- needs to go after the other usr/lib/*
        elsif ($file =~ m,^usr/lib/,) {
            if ($type ne 'udeb' and $file =~ m,\.(?:bmp|gif|jpeg|jpg|png|tiff|xpm|xbm)$, and not defined $link) {
                tag 'image-file-in-usr-lib', $file
            }
        }
        # ---------------- /usr/local
        elsif ($file =~ m,^usr/local/\S+,) {
            if ($index_info->{type} =~ m/^d/) {
                tag 'dir-in-usr-local', $file;
            } else {
                tag 'file-in-usr-local', $file;
            }
        }
        # ---------------- /usr/share/applications
        elsif ($file =~ m,^usr/share/applications/mimeinfo.cache(?:\.gz)?$,) {
            tag 'package-contains-mimeinfo.cache-file', $file;
        }
        # ---------------- /usr/share/man and /usr/X11R6/man
        elsif ($file =~ m,^usr/X11R6/man/\S+, or $file =~ m,^usr/share/man/\S+,) {
            if ($type eq 'udeb') {
                tag 'udeb-contains-documentation-file', $file;
            }
            if ($index_info->{type} =~ m/^d/) {
                tag 'stray-directory-in-manpage-directory', $file
                    if ($file !~ m,^usr/(?:X11R6|share)/man/(?:[^/]+/)?(?:man\d/)?$,);
            } elsif ($index_info->{type} =~ m,^[-h], and ($operm & 0111)) {
                tag 'executable-manpage', $file;
            }
        }
        # ---------------- /usr/share/fonts/X11
        elsif ($file =~ m,^usr/share/fonts/X11/([^/]+)/\S+,) {
            my ($dir, $filename) = ($1, $2);
            if ($dir =~ /^(?:PEX|CID|Speedo|cyrillic)$/) {
                tag 'file-in-discouraged-x11-font-directory', $file;
            } elsif ($dir !~ /^(?:100dpi|75dpi|misc|Type1|encodings|util)$/) {
                tag 'file-in-unknown-x11-font-directory', $file;
            }
            if ($dir =~ /^(?:100dpi|75dpi|misc)$/) {
                $x11_font_dirs{$dir}++;
            }
        }
        # ---------------- /usr/share/info
        elsif ($file =~ m,^usr/share/info\S+,) {
            if ($type eq 'udeb') {
                tag 'udeb-contains-documentation-file', $file;
            }
            if ($file =~ m,^usr/share/info/dir(?:\.old)?(?:\.gz)?$,) {
                tag 'package-contains-info-dir-file', $file;
            }
        }
        # ---------------- /usr/share/linda/overrides
        elsif ($file =~ m,^usr/share/linda/overrides/\S+,) {
            tag 'package-contains-linda-override', $file;
        }
        # ---------------- /usr/share/mime
        elsif ($file =~ m,^usr/share/mime/[^/]+$,) {
            tag 'package-contains-mime-cache-file', $file;
        }
        # ---------------- /usr/share/vim
        elsif ($file =~ m,^usr/share/vim/vim(?:current|\d{2})/([^/]++),) {
            my $is_vimhelp = $1 eq 'doc' && $pkg =~ m,^vimhelp-\w++$,;
            my $is_vim = $source_pkg =~ m,vim,;
            tag 'vim-addon-within-vim-runtime-path', $file
                unless $is_vim or $is_vimhelp;
        }
        # ---------------- /usr/share
        elsif ($file =~ m,^usr/share/[^/]+$,) {
            if ($index_info->{type} =~ m/^[-h]/) {
                tag 'file-directly-in-usr-share', $file;
            }
        }
        # ---------------- /usr/bin
        elsif ($file =~ m,^usr/bin/,) {
            if ($index_info->{type} =~ m/^d/ and $file =~ m,^usr/bin/., and $file !~ m,^usr/bin/(?:X11|mh)/,) {
                tag 'subdir-in-usr-bin', $file;
            }
        }
        # ---------------- /usr subdirs
        elsif ($type ne 'udeb' and $file =~ m,^usr/[^/]+/$,) { # FSSTND dirs
            if ( $file =~ m,^usr/(?:dict|doc|etc|info|man|adm|preserve)/,) {
                tag 'FSSTND-dir-in-usr', $file;
            }
            # FHS dirs
            elsif ($file !~ m,^usr/(?:X11R6|X386|
                                    bin|games|include|
                                    lib|lib32|lib64|
                                    local|sbin|share|
                                    src|spool|tmp)/,x) {
                tag 'non-standard-dir-in-usr', $file;
            } elsif ($file =~ m,^usr/share/doc,) {
                tag 'uses-FHS-doc-dir', $file;
            }

            # unless $file =~ m,^usr/[^/]+-linuxlibc1/,; was tied into print
            # above...
            # Make an exception for the altdev dirs, which will go away
            # at some point and are not worth moving.
        }
        # ---------------- .desktop files
        # People have placed them everywhere, but nowadays the consensus seems
        # to be to stick to the fd.org standard drafts, which says that
        # .desktop files intended for menus should be placed in
        # $XDG_DATA_DIRS/applications.  The default for $XDG_DATA_DIRS is
        # /usr/local/share/:/usr/share/, according to the basedir-spec on
        # fd.org. As distributor, we should only allow /usr/share.
        #
        # KDE hasn't moved its files from /usr/share/applnk, so don't warn
        # about this yet until KDE adopts the new location.
        elsif ($file =~ m,^usr/share/gnome/apps/.*\.desktop$,) {
            tag 'desktop-file-in-wrong-dir', $file;
        }

        # ---------------- png files under /usr/share/apps/*/icons/*
        elsif ($file =~ m,^usr/share/apps/[^/]+/icons/[^/]+/(\d+x\d+)/.*\.png$,) {
            my ($dsize, $fsize) = ($1);
            $info->file_info->{$file} =~ m/,\s*(\d+)\s*x\s*(\d+)\s*,/;
            $fsize = $1.'x'.$2;
            tag 'icon-size-and-directory-name-mismatch', $file, $fsize
                unless ($dsize eq $fsize);
        }
        # ---------------- non-games-specific data in games subdirectory
        elsif ($file =~ m,^usr/share/games/(?:applications|mime|icons|pixmaps)/,
               and $index_info->{type} !~ m/^d/) {
            tag 'global-data-in-games-directory', $file;
        }
    }
    # ---------------- /var subdirs
    elsif ($type ne 'udeb' and $file =~ m,^var/[^/]+/$,) { # FSSTND dirs
        if ( $file =~ m,^var/(?:adm|catman|named|nis|preserve)/, ) {
            tag 'FSSTND-dir-in-var', $file;
        }
        # base-files is special
        elsif ($pkg eq 'base-files' && $file =~ m,^var/(?:backups|local)/,) {
            # ignore
        }
        # FHS dirs with exception in Debian policy
        elsif ( $file !~ m,^var/(?:account|lib|cache|crash|games|lock|log|opt|run|spool|state|tmp|www|yp)/,) {
            tag 'non-standard-dir-in-var', $file;
        }
    }
    elsif ($type ne 'udeb' and $file =~ m,^var/lib/games/.,) {
        tag 'non-standard-dir-in-var', $file;
    }
    # ---------------- /var/lock, /var/run
    elsif ($type ne 'udeb' and $file =~ m,^var/lock/.,) {
        tag 'dir-or-file-in-var-lock', $file;
    }
    elsif ($type ne 'udeb' and $file =~ m,^var/run/.,) {
        tag 'dir-or-file-in-var-run', $file;
    }
    elsif ($type ne 'udeb' and $file =~ m,^run/.,o) {
        tag 'dir-or-file-in-run', $file;
    }
    # ---------------- /var/www
    # Packages are allowed to create /var/www since it's historically been the
    # default document root, but they shouldn't be installing stuff under that
    # directory.
    elsif ($file =~ m,^var/www/\S+,) {
        tag 'dir-or-file-in-var-www', $file;
    }
    # ---------------- /opt
    elsif ($file =~ m,^opt/.,) {
        tag 'dir-or-file-in-opt', $file;
    }
    elsif ($file =~ m,^hurd/.,) {
        next;
    } elsif ($file =~ m,^servers/.,) {
        next;
    }
    # ---------------- /tmp, /var/tmp, /usr/tmp
    elsif ($file =~ m,^tmp/., or $file =~ m,^(?:var|usr)/tmp/.,) {
        tag 'dir-or-file-in-tmp', $file;
    }
    # ---------------- /mnt
    elsif ($file =~ m,^mnt/.,) {
        tag 'dir-or-file-in-mnt', $file;
    }
    # ---------------- /bin
    elsif ($file =~ m,^bin/,) {
        if ($index_info->{type} =~ m/^d/ and $file =~ m,^bin/.,) {
            tag 'subdir-in-bin', $file;
        }
    }
    # ---------------- /srv
    elsif ($file =~ m,^srv/.,) {
        tag 'dir-or-file-in-srv', $file;
    }
    # ---------------- FHS directory?
    elsif ($file =~ m,^[^/]+/$,o and
           $file !~ m,^(?:bin|boot|dev|etc|home|lib(?:64|32)?|mnt|opt|root|run|sbin|selinux|srv|sys|tmp|usr|var)/,o) {
        # Make an exception for the base-files package here and other similar
        # packages because they install a slew of top-level directories for
        # setting up the base system.  (Specifically, /cdrom, /floppy,
        # /initrd, and /proc are not mentioned in the FHS).
        #
        # Also make an exception for /emul, which is used for multiarch
        # support in Debian at the moment.
        tag 'non-standard-toplevel-dir', $file
            unless $pkg eq 'base-files'
                or $pkg eq 'hurd'
                or $pkg eq 'hurd-udeb'
                or $pkg =~ /^rootskel(?:-bootfloppy)?/
                or $file =~ m,^emul/,;
    }

    # ---------------- compatibility symlinks should not be used
    if ($file =~ m,^usr/(?:spool|tmp)/, or
        $file =~ m,^usr/(?:doc|bin)/X11/, or
        $file =~ m,^var/adm/,) {
        tag 'use-of-compat-symlink', $file;
    }

    # ---------------- .ali files (Ada Library Information)
    if ($file =~ m,^usr/lib/.*\.ali$, && $operm != 0444) {
        tag 'bad-permissions-for-ali-file', $file;
    }

    # ---------------- any files
    if ($index_info->{type} !~ m/^d/) {
        unless ($type eq 'udeb'
                or $file =~ m,^usr/(?:bin|dict|doc|games|
                                    include|info|lib(?:32|64)?|
                                    man|sbin|share|src|X11R6)/,x
                or $file =~ m,^lib(?:32|64)?/(?:modules/|libc5-compat/)?,
                or $file =~ m,^var/(?:games|lib|www|named)/,
                or $file =~ m,^(?:bin|boot|dev|etc|sbin)/,
                # non-FHS, but still usual
                or $file =~ m,^usr/[^/]+-linux[^/]*/,
                or $file =~ m,^usr/iraf/,
                # not allowed, but tested indivudually
                or $file =~ m,^(?:mnt|opt|run|srv|(?:(?:usr|var)/)?tmp)|var/www/,) {
            tag 'file-in-unusual-dir', $file;
        }
    }

    if ($file =~ m,^(?:usr/)?lib/([^/]+)/$,o) {
        my $subdir = $1;
        $TRIPLETS = Lintian::Data->new('files/triplets', '\s+')
            unless defined($TRIPLETS);
        if ($TRIPLETS->known($subdir)) {
            tag 'triplet-dir-and-architecture-mismatch', "$file is for", $TRIPLETS->value($subdir)
                unless ($arch eq $TRIPLETS->value($subdir));
        }
    }

    if ($type ne 'udeb' && $index_info->{type} ne 'l' && $pkg !~ m/^libc[0-9]/o &&
            $file =~ m,^(?:usr/)?lib/([^/]+)/lib[^/]+\.so(?:\.[^/]+)?$,o) {
        my $subdir = $1;
        # Skip if it not an ELF file (probably a .so script)
        next unless ($info->file_info->{$file}//'') =~ m/\bELF\b/o;
        $TRIPLETS = Lintian::Data->new('files/triplets', qr/\s++/o)
            unless defined($TRIPLETS);
        if ($TRIPLETS->known($subdir) && $arch eq $TRIPLETS->value($subdir)) {
            my $dep = $info->relation('pre-depends');
            tag 'missing-pre-dependency-on-multiarch-support' unless ($dep->implies('multiarch-support'));
        }
    }

    # ---------------- .pyc/.pyo (compiled python files)
    #  skip any file installed inside a __pycache__ directory
    #  - we have a separate check for that directory.
    if ($file =~ m,\.py[co]$,o && $file !~ m,/__pycache__/,o) {
        tag 'package-installs-python-bytecode', $file;
    }

    # ---------------- __pycache__ (directory for pyc/pyo files)
    if ($index_info->{type} =~ m/^d/o && $file =~ m,/__pycache__/,o){
        tag 'package-installs-python-pycache-dir', $file;
    }

    # ---------------- .egg (python egg files)
    if ($file =~ m,\.egg$,o && ($file =~ m,usr/lib/python\d+(?:\.\d+/),o ||
                                 $file =~ m,usr/lib/pyshared,o ||
                                 $file =~ m,usr/share/,o)){
        tag 'package-installs-python-egg', $file;
    }

    # ---------------- /usr/lib/site-python
    if ($file =~ m,^usr/lib/site-python/\S,) {
        tag 'file-in-usr-lib-site-python', $file;
    }

    # ---------------- pythonX.Y extensions
    if ($file =~ m,^usr/lib/python\d\.\d/\S,
        and not $file =~ m,^usr/lib/python\d\.\d/(?:site|dist)-packages/,) {
        # check if it's one of the Python proper packages
        unless (defined $is_python) {
            $is_python = 0;
            if ($source_pkg) {
                $is_python = 1 if $source_pkg =~ m/^python(?:\d\.\d)?$/
                    or $source_pkg =~ m/^python\d?-(?:stdlib-extensions|profiler|old-doctools)$/;
            }
        }
        tag 'third-party-package-in-python-dir', $file
            unless $is_python;
    }
    # ---------------- perl modules
    if ($file =~ m,^usr/(?:share|lib)/perl/\S,) {
       # check if it's the "perl" package itself
       unless (defined $is_perl) {
           $is_perl = 0;
           if ($source_pkg) {
               $is_perl = 1 if $source_pkg eq 'perl';
           }
       }
       tag 'perl-module-in-core-directory', $file
           unless $is_perl;
    }

    # ---------------- perl modules using old libraries
    # we do the same check on perl scripts in checks/scripts
    {
        my $dep = $info->relation('strong');
        if ($index_info->{type} =~ m/^[-h]/o && $file =~ m,\.pm$, && !$dep->implies ('libperl4-corelibs-perl | perl (<< 5.12.3-7)')) {
            open (PM, '<', $info->unpacked($file)) or fail("cannot open .pm file: $!");
            while (<PM>) {
                if (/(?:do|require)\s+(?:'|")(abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
                    tag 'perl-module-uses-perl4-libs-without-dep', "$file:$. ${1}.pl";
                }
            }
            close(PM);
        }
    }

    # ---------------- license files
    if ($file =~ m,(?:copying|licen[cs]e)(?:\.[^/]+)?$,i
        # Ignore some common extensions for source or compiled extension files.
        # There was at least one file named "license.el".  These are probably
        # license-displaying code, not license files.  Also ignore executable
        # files in general. This means we get false-negatives for licenses
        # files marked executable, but these will trigger a warning about being
        # executable. (See #608866)
        #
        # Another exception is made for .html and .php because preserving
        # working links is more important than saving some bytes, and
        # because a package had a HTML form for licenses called like that.
        # Another exception is made for various picture formats since
        # those are likely to just be simply pictures.
        #
        # DTD files are excluded at the request of the Mozilla suite
        # maintainers.  Zope products include license files for runtime
        # display.  underXXXlicense.docbook files are from KDE.
        #
        # Ignore extra license files in examples, since various package
        # building software includes example packages with licenses.
        and ($operm & 0111) == 0
        and not $file =~ m/\.(?:el|[ch]|py|cc|pl|pm|hi|p_hi|html|php|rb|xpm|png|jpe?g|gif|svg|dtd|ui|pc)$/
        and not $file =~ m,^usr/share/zope/Products/.*\.(?:dtml|pt|cpt)$,
        and not $file =~ m,/under\S+License\.docbook$,
        and not $file =~ m,^usr/share/doc/[^/]+/examples/,
        and not $file =~ m,^usr/share/man/(?:[^/]+/)?man\d/,o # liblicense has a manpage called license
        and not $file =~ m,^usr/share/pyshared-data/,o        # liblicense (again)
        and not defined $link) {

        # okay, we cannot rule it out based on file name; but if it is an elf or a static
        # library, we also skip it.  (In case you hadn't guessed; liblicense)
        my $fileinfo = $info->file_info->{$file};
        tag 'extra-license-file', $file
            unless $fileinfo && ($fileinfo =~ m/^[^,]*\bELF\b/) or ($fileinfo =~ m/\bcurrent ar archive\b/);
    }

    # ---------------- .devhelp2? files
    if ($file =~ m,\.devhelp2?(?:\.gz)?$,
        # If the file is located in a directory not searched by devhelp, we
        # check later to see if it's in a symlinked directory.
        and not $file =~ m,^usr/share/(?:devhelp/books|gtk-doc/html)/,
        and not $file =~ m,^usr/share/doc/[^/]+/examples/,) {
        push (@devhelp, $file);
    }

    # ---------------- weird file names
    if ($file =~ m,\s+\z,) {
        tag 'file-name-ends-in-whitespace', $file;
    }
    if ($file =~ m,/\*\z,) {
        tag 'star-file', $file;
    }

    # ---------------- misplaced lintian overrides
    my $tmp = quotemeta($pkg);
    if ($file =~ m,^usr/share/doc/$tmp/override\.[lL]intian(?:\.gz)?$, or
        $file =~ m,^usr/share/lintian/overrides/$tmp/.+,) {
        tag 'override-file-in-wrong-location', $file;
    }

    # ---------------- pyshared-data
    if ($file =~ m,^usr/share/pyshared-data/$tmp$,){
        my $dep = $info->relation('depends');
        tag 'missing-dependency-on-python-central' unless ($dep->implies('python-central (>= 0.6)'));
    }

    if ($file =~ m,^usr/share/python-support/$tmp\.(?:public|private)$,){
        $py_support_nver = '(>= 0.90)';
    } elsif ($file =~ m,^usr/share/python-support/\S+,o && !$py_support_nver){
        $py_support_nver = '';
    }

    # ---------------- python file locations
    #  - The python people kindly provided the following table.
    # good:
    # /usr/lib/python2.5/site-packages/
    # /usr/lib/python2.6/dist-packages/
    # /usr/lib/python2.7/dist-packages/
    # /usr/lib/python3/dist-packages/
    #
    # bad:
    # /usr/lib/python2.5/dist-packages/
    # /usr/lib/python2.6/site-packages/
    # /usr/lib/python2.7/site-packages/
    # /usr/lib/python3.*/*-packages/
    if ($file =~ m,^(usr/lib/debug/)?usr/lib/python(\d+(?:\.\d+)?)/(site|dist)-packages/(.++)$,o){
        my ($debug, $pyver, $loc, $rest) = ($1, $2, $3, $4);
        my ($pmaj, $pmin) = split(m/\./o, $pyver, 2);
        my @correction = ();
        $pmin = 0 unless (defined $pmin);
        $debug = '' unless (defined $debug);
        next if ($pmaj < 2 or $pmaj > 3); # Not python 2 or 3
        if ($pmaj == 2 and $pmin < 6){
            # 2.4 and 2.5
            if ($loc ne 'site') {
                @correction = ("${debug}usr/lib/python${pyver}/$loc-packages/$rest",
                               "${debug}usr/lib/python${pyver}/site-packages/$rest");
            }
        } elsif ($pmaj == 3){
            # python 3. Everything must be in python3/dist-... and not python3.X/<something>
            if ($pyver ne '3' or $loc ne 'dist'){
                # bad mojo
                @correction = ("${debug}usr/lib/python${pyver}/$loc-packages/$rest",
                               "${debug}usr/lib/python3/dist-packages/$rest");
            }
        } else {
            # python 2.6+
            if ($loc ne 'dist') {
                @correction = ("${debug}usr/lib/python${pyver}/$loc-packages/$rest",
                               "${debug}usr/lib/python${pyver}/dist-packages/$rest");
            }
        }
        tag 'python-module-in-wrong-location', @correction if (@correction);
    }

    # ---------------- plain files
    if ($index_info->{type} =~ m/^[-h]/) {
        # ---------------- backup files and autosave files
        if ($file =~ /~$/ or $file =~ m,\#[^/]+\#$, or $file =~ m,/\.[^/]+\.swp$,) {
            tag 'backup-file-in-package', $file;
        }
        if ($file =~ m,/\.nfs[^/]+$,) {
            tag 'nfs-temporary-file-in-package', $file;
        }

        # ---------------- vcs control files
        if ($file =~ m/\.(?:(?:cvs|git|hg)ignore|arch-inventory|hgtags|hg_archival\.txt)$/) {
            tag 'package-contains-vcs-control-file', $file;
        }

        # ---------------- subversion and svk commit message backups
        if ($file =~ m/svn-commit.*\.tmp$/) {
            tag 'svn-commit-file-in-package', $file;
        }
        if ($file =~ m/svk-commit.+\.tmp$/) {
            tag 'svk-commit-file-in-package', $file;
        }

        # ---------------- executables with language extensions
        if ($file =~ m,^(?:usr/)?(?:s?bin|games)/[^/]+\.(?:pl|sh|py|php|rb|tcl|bsh|csh|tcl)$,) {
            tag 'script-with-language-extension', $file;
        }

        # ---------------- Devel files for Windows
        if ($file =~ m,/.+\.(?:vcproj|sln|dsp|dsw)(?:\.gz)?$,
            and $file !~ m,^usr/share/doc/,) {
            tag 'windows-devel-file-in-package', $file;
        }

        # ---------------- Autogenerated databases from other OSes
        if ($file =~ m,/Thumbs\.db(?:\.gz)?$,i) {
            tag 'windows-thumbnail-database-in-package', $file;
        }
        if ($file =~ m,/\.DS_Store(?:\.gz)?$,) {
            tag 'macos-ds-store-file-in-package', $file;
        }
        if ($file =~ m,/\._[^_/][^/]*$, and $file !~ m/\.swp$/) {
            tag 'macos-resource-fork-file-in-package', $file;
        }

        # ---------------- embedded Javascript libraries
        foreach my $jslibrary (@jslibraries) {
            if ($file =~ m,/$jslibrary->[0], and $pkg !~ m,^$jslibrary->[1]$,) {
                tag 'embedded-javascript-library', $file;
            }
        }

        # ---------------- embedded Feedparser library
        if ($file =~ m,/feedparser\.py$, and $pkg ne 'python-feedparser') {
            open(FEEDPARSER, '<', $info->unpacked($file)) or fail("cannot open feedparser.py file: $!");
            while (<FEEDPARSER>) {
                if (m,Universal feed parser,) {
                    tag 'embedded-feedparser-library', $file;
                    last;
                }
            }
            close(FEEDPARSER);
        }

        # ---------------- embedded PEAR modules
        foreach my $pearmodule (@pearmodules) {
            if ($file =~ m,/$pearmodule->[0], and $pkg ne $pearmodule->[1]) {
                open (PEAR, '<', $info->unpacked($file)) or fail("cannot open PHP file: $!");
                while (<PEAR>) {
                    if (m,/pear[/.],i) {
                        tag 'embedded-pear-module', $file;
                        last;
                    }
                }
                close(PEAR);
            }
        }

        # ---------------- embedded php libraries
        foreach my $phplibrary (@phplibraries) {
            if ($file =~ m,/$phplibrary->[0], and $pkg ne $phplibrary->[1]) {
                tag 'embedded-php-library', $file;
            }
        }

        # ---------------- fonts
        if ($file =~ m,/([\w-]+\.(?:[to]tf|pfb))$,i) {
            my $font = lc $1;
            $FONT_PACKAGES = Lintian::Data->new('files/fonts', '\s+')
                unless defined($FONT_PACKAGES);
            if ($FONT_PACKAGES->known($font)) {
                tag 'duplicate-font-file', "$file also in", $FONT_PACKAGES->value($font)
                    if ($pkg ne $FONT_PACKAGES->value($font) and $type ne 'udeb');
            } elsif ($pkg !~ m/^(?:[ot]tf|t1|x?fonts)-/) {
                tag 'font-in-non-font-package', $file;
            }
        }

        # ---------------- non-free .swf files
        foreach my $flash (@flash_nonfree) {
            last if ($pkg_section =~ m,^non-free/,);
            if ($file =~ m,/$flash,) {
                tag 'non-free-flash', $file;
            }
        }

        # ---------------- .gz files
        if ($file =~ m/\.gz$/) {
            my $finfo = $info->file_info->{$file} || '';
            if ($finfo !~ m/gzip compressed/) {
                tag 'gz-file-not-gzip', $file;
            } elsif ($isma_same && $file !~ m/\Q$arch\E/o) {
                my $path = $info->unpacked ($file);
                open my $fd, '<', $path or fail "opening $file: $!";
                my $buff;
                # We need to read at least 8 bytes
                if (sysread($fd, $buff, 1024) >= 8) {
                    # Extract the flags and the mtime.
                    #  NN NN  NN NN, NN NN NN NN  - bytes read (in hex, network order)
                    #  __ __  __ __,    $mtime    - variables
                    my (undef, $mtime) = unpack ('NN', $buff);
                    if ($mtime){
                        tag 'gzip-file-is-not-multi-arch-same-safe', $file;
                    }
                } else {
                    fail "reading $file: $!";
                }
                close $fd;
            }
        }

        # --------------- compressed + uncompressed files
        if ($file =~ m,^(.+)\.(?:gz|bz2)$,) {
            tag 'duplicated-compressed-file', $file
                if exists $info->file_info->{$1};
        }

        # ---------------- general: setuid/setgid files!
        if ($operm & 06000) {
            my ($setuid, $setgid) = ('','');
            # get more info:
            $setuid = $index_info->{owner} if ($operm & 04000);
            $setgid = $index_info->{group} if ($operm & 02000);

            # 1st special case: program is using svgalib:
            if (exists $linked_against_libvga{$file}) {
                # setuid root is ok, so remove it
                if ($setuid eq 'root') {
                    undef $setuid;
                }
            }

            # 2nd special case: program is a setgid game
            if ($file =~ m,^usr/lib/games/\S+, or $file =~ m,^usr/games/\S+,) {
                # setgid games is ok, so remove it
                if ($setgid eq 'games') {
                    undef $setgid;
                }
            }

            # 3rd special case: allow anything with suid in the name
            if ($pkg =~ m,-suid,) {
                undef $setuid;
            }

            # Check for setuid and setgid that isn't expected.
            if ($setuid and $setgid) {
                tag 'setuid-gid-binary', $file, sprintf('%04o %s',$operm,$owner);
            } elsif ($setuid) {
                tag 'setuid-binary', $file, sprintf('%04o %s',$operm,$owner);
            } elsif ($setgid) {
                tag 'setgid-binary', $file, sprintf('%04o %s',$operm,$owner);
            }

            # Check for permission problems other than the setuid status.
            if (($operm & 0444) != 0444) {
                tag 'executable-is-not-world-readable', $file,
                    sprintf('%04o',$operm);
            } elsif ($operm != 04755 && $operm != 02755 && $operm != 06755 && $operm != 04754) {
                tag 'non-standard-setuid-executable-perm', $file,
                    sprintf('%04o',$operm);
            }
        }
        # ---------------- general: executable files
        elsif ($operm & 0111) {
            # executable
            if ($owner eq 'root/games') {
                if ($operm != 2755) {
                    tag 'non-standard-game-executable-perm', $file,
                        sprintf('%04o != 2755',$operm);
                }
            } else {
                if (($operm & 0444) != 0444) {
                    tag 'executable-is-not-world-readable', $file,
                        sprintf('%04o',$operm);
                } elsif ($operm != 0755) {
                    tag 'non-standard-executable-perm', $file,
                        sprintf('%04o != 0755',$operm);
                }
            }
        }
        # ---------------- general: normal (non-executable) files
        else {
            # not executable
            # special case first: game data
            if ($operm == 0664 and $owner eq 'root/games' and
                $file =~ m,^var/(lib/)?games/\S+,) {
                # everything is ok
            } elsif ($operm == 0444 and $file =~ m,^usr/lib/.*\.ali$,) {
                # Ada library information files should be read-only
                # since GNAT behaviour depends on that
                # everything is ok
            } elsif ($operm == 0600 and $file =~ m,^etc/backup.d/,) {
                # backupninja expects configurations files to be 0600
            } elsif ($file =~ m,^etc/sudoers.d/,) {
                # sudo requires sudoers files to be mode 0440
                tag 'bad-perm-for-file-in-etc-sudoers.d', $file,
                    sprintf('%04o != 0440', $operm) unless $operm == 0440;
            } elsif ($operm != 0644) {
                tag 'non-standard-file-perm', $file,
                    sprintf('%04o != 0644',$operm);
            }
        }
    }
    # ---------------- directories
    elsif ($index_info->{type} =~ m/^d/) {
        # special cases first:
        # game directory with setgid bit
        if ($file =~ m,^var/(?:lib/)?games/\S+, and $operm == 02775
            and $owner eq 'root/games') {
            # do nothing, this is allowed, but not mandatory
        }
        elsif (($file eq 'tmp/' or $file eq 'var/tmp/'
                or $file eq 'var/lock/')
               and $operm == 01777 and $owner eq 'root/root') {
            # actually shipping files here is warned about elsewhere
        }
        elsif ($file eq 'usr/src/' and $operm == 02775
               and $owner eq 'root/src') {
            # /usr/src as created by base-files is a special exception
        }
        elsif ($file eq 'var/local/' and $operm == 02775
               and $owner eq 'root/staff') {
            # actually shipping files here is warned about elsewhere
        }
        # otherwise, complain if it's not 0755.
        elsif ($operm != 0755) {
            tag 'non-standard-dir-perm', $file,
                sprintf('%04o != 0755', $operm);
        }
        if ($file =~ m,/CVS/?$,) {
            tag 'package-contains-vcs-control-dir', $file;
        }
        if ($file =~ m,/\.(?:svn|bzr|git|hg)/?$,) {
            tag 'package-contains-vcs-control-dir', $file;
        }
        if (($file =~ m,/\.arch-ids/?$,)
            || ($file =~ m,/\{arch\}/?$,)) {
            tag 'package-contains-vcs-control-dir', $file;
        }
        if ($file =~ m,/\.(?:be|ditrack)/?$,) {
            tag 'package-contains-bts-control-dir', $file;
        }
        if ($file =~ m,/\.xvpics/?$,) {
            tag 'package-contains-xvpics-dir', $file;
        }
        if ($file =~ m,usr/share/doc/[^/]+/examples/examples/?$,) {
            tag 'nested-examples-directory', $file;
        }
        if ($file =~ m,^usr/share/locale/([^/]+)/$,) {
            # Without encoding:
            my ($lwccode) = split(/[.@]/, $1);
            # Without country code:
            my ($lcode) = split(/_/, $lwccode);

            # special exception:
            if ($lwccode ne 'l10n') {
                $INCORRECT_LOCALE_CODES = Lintian::Data->new('files/incorrect-locale-codes', '\s+')
                    unless defined($INCORRECT_LOCALE_CODES);
                $LOCALE_CODES = Lintian::Data->new('files/locale-codes', '\s+')
                    unless defined($LOCALE_CODES);

                if ($INCORRECT_LOCALE_CODES->known($lwccode)) {
                    tag 'incorrect-locale-code',
                        "$lwccode ->", $INCORRECT_LOCALE_CODES->value($lwccode);
                } elsif ($INCORRECT_LOCALE_CODES->known($lcode)) {
                    tag 'incorrect-locale-code',
                        "$lcode ->", $INCORRECT_LOCALE_CODES->value($lcode);
                } elsif (!$LOCALE_CODES->known($lcode)) {
                    tag 'unknown-locale-code', $lcode;
                } elsif ($LOCALE_CODES->known($lcode) && defined($LOCALE_CODES->value($lcode))) {
                    # If there's a key-value pair in the codes list it
                    # means the ISO 639-2 code is being used instead of ISO 639-1's
                    tag 'incorrect-locale-code', "$lcode ->", $LOCALE_CODES->value($lcode);
                }
            }
        }
    }
    # ---------------- symbolic links
    elsif ($index_info->{type} =~ m/^l/) {
        # link

        my $mylink = $link;
        if ($mylink =~ s,//+,/,g) {
            tag 'symlink-has-double-slash', "$file $link";
        }
        if ($mylink =~ s,(.)/$,$1,) {
            tag 'symlink-ends-with-slash', "$file $link";
        }

        # determine top-level directory of file
        $file =~ m,^/?([^/]*),;
        my $filetop = $1;

        if ($mylink =~ m,^/([^/]*),) {
            # absolute link, including link to /
            # determine top-level directory of link
            my $linktop = $1;

            if ($type ne 'udeb' and $filetop eq $linktop) {
                # absolute links within one toplevel directory are _not_ ok!
                tag 'symlink-should-be-relative', "$file $link";
            }

            # Any other case is already definitely non-recursive
            tag 'symlink-is-self-recursive', "$file $link"
                if $mylink eq '/';

        } else {
            # relative link, we can assume from here that the link starts nor
            # ends with /

            my @filecomponents = split('/', $file);
            # chop off the name of the symlink
            pop @filecomponents;

            my @linkcomponents = split('/', $mylink);

            # handle `../' at beginning of $link
            my $lastpop = undef;
            my $linkcomponent = undef;
            while ($linkcomponent = shift @linkcomponents) {
                if ($linkcomponent eq '.') {
                    tag 'symlink-contains-spurious-segments', "$file $link"
                        unless $mylink eq '.';
                    next;
                }
                last if $linkcomponent ne '..';
                if (@filecomponents) {
                    $lastpop = pop @filecomponents;
                } else {
                    tag 'symlink-has-too-many-up-segments', "$file $link";
                    goto NEXT_LINK;
                }
            }

            if (!defined $linkcomponent) {
                # After stripping all starting .. components, nothing left
                tag 'symlink-is-self-recursive', "$file $link";
            }

            # does the link go up and then down into the same directory?
            # (lastpop indicates there was a backref at all, no linkcomponent
            # means the symlink doesn't get up anymore)
            if (defined $lastpop && defined $linkcomponent &&
                $linkcomponent eq $lastpop) {
                tag 'lengthy-symlink', "$file $link";
            }

            if ($#filecomponents == -1) {
                # we've reached the root directory
                if (($type ne 'udeb')
                    && (!defined $linkcomponent)
                    || ($filetop ne $linkcomponent)) {
                    # relative link into other toplevel directory.
                    # this hits a relative symbolic link in the root too.
                    tag 'symlink-should-be-absolute', "$file $link";
                }
            }

            # check additional segments for mistakes like `foo/../bar/'
            foreach (@linkcomponents) {
                if ($_ eq '..' || $_ eq '.') {
                    tag 'symlink-contains-spurious-segments', "$file $link";
                    last;
                }
            }
        }
    NEXT_LINK:

        if ($link =~ m,\.(gz|[zZ]|bz|bz2|tgz|zip)\s*$,) {
            # symlink is pointing to a compressed file

            # symlink has correct extension?
            unless ($file =~ m,\.$1\s*$,) {
                tag 'compressed-symlink-with-wrong-ext', "$file $link";
            }
        }
    }
    # ---------------- special files
    else {
        # special file
        tag 'special-file', $file, sprintf('%04o',$operm);
    }
}

if (!$is_dummy && !$arch_dep_files && $arch ne 'all') {
    tag 'package-contains-no-arch-dependent-files' unless $type eq 'udeb';
}

# python-support check
if (defined($py_support_nver) && $pkg ne 'python-support'){
    # Okay - package installs something to /usr/share/python-support/
    # $py_support_nver is either the empty string or a version
    # describing what we need.
    #
    # We also skip debug packages since they are okay as long as
    # foo-dbg depends on foo (= $version) and foo has its dependency
    # correct.
    my $dep = $info->relation('depends');
    tag 'missing-dependency-on-python-support', "python-support $py_support_nver"
        unless ($pkg =~ m/-dbg$/ || $dep->implies("python-support $py_support_nver"));
}

# Check for section games but nothing in /usr/games.  Check for any binary to
# save ourselves from game-data false positives:
my $games = dir_counts($info, 'usr/games/');
my $other = dir_counts($info, 'bin/') + dir_counts($info, 'usr/bin/');
if ($pkg_section =~ m,games$, and $games == 0 and $other > 0) {
    tag 'package-section-games-but-contains-no-game';
}
if ($pkg_section =~ m,games$, and $games > 0 and $other > 0) {
    tag 'package-section-games-but-has-usr-bin';
}
if ($pkg_section !~ m,games$, and $games > 0 and $other == 0) {
    tag 'games-package-should-be-section-games';
}

# Warn about empty directories, but ignore empty directories in /var (packages
# create directories to hold dynamically created data) or /etc (configuration
# files generated by maintainer scripts).  Also skip base-files, which is a
# very special case.
#
# Empty Perl directories are an ExtUtils::MakeMaker artifact that will be
# fixed in Perl 5.10, and people can cause more problems by trying to fix it,
# so just ignore them.
#
# python-support needs a directory for each package even it might be empty
if($pkg ne 'base-files'){
    foreach my $dir (@{$info->sorted_index}) {
        next if $dir eq '' or $info->index->{$dir}->{type} ne 'd';
        next if ($dir =~ m{^var/} or $dir =~ m{^etc/});
        if (dir_counts($info, $dir) == 0) {
            if ($dir ne 'usr/lib/perl5/'
                and $dir ne 'usr/share/perl5/'
                and $dir !~ m;^usr/share/python-support/;) {
                tag 'package-contains-empty-directory', $dir;
            }
        }
    }
}

if (!$has_binary_perl_file && @nonbinary_perl_files_in_lib) {
    foreach my $file (@nonbinary_perl_files_in_lib) {
        tag 'package-installs-nonbinary-perl-in-usr-lib-perl5', $file;
    }
}

# Check for .devhelp2? files that aren't symlinked into paths searched by
# devhelp.
for my $file (@devhelp) {
    my $found = 0;
    for my $link (@devhelp_links) {
        if ($file =~ m,^\Q$link,) {
            $found = 1;
            last;
        }
    }
    tag 'package-contains-devhelp-file-without-symlink', $file unless $found;
}

# Check for including multiple different DPIs of fonts in the same X11 bitmap
# font package.
if ($x11_font_dirs{'100dpi'} and $x11_font_dirs{'75dpi'}) {
    tag 'package-contains-multiple-dpi-fonts';
}
if ($x11_font_dirs{misc} and keys (%x11_font_dirs) > 1) {
    tag 'package-mixes-misc-and-dpi-fonts';
}

}

sub dir_counts {
    my ($info, $dir) = @_;

    if (defined $info->index->{$dir}) {
        return $info->index->{$dir}->{count} || 0;
    } else {
        return 0;
    }
}

1;

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et