summaryrefslogtreecommitdiffstats
path: root/lib/Lintian/Check/Files
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-14 13:42:30 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-14 13:42:30 +0000
commit75808db17caf8b960b351e3408e74142f4c85aac (patch)
tree7989e9c09a4240248bf4658a22208a0a52d991c4 /lib/Lintian/Check/Files
parentInitial commit. (diff)
downloadlintian-75808db17caf8b960b351e3408e74142f4c85aac.tar.xz
lintian-75808db17caf8b960b351e3408e74142f4c85aac.zip
Adding upstream version 2.117.0.upstream/2.117.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'lib/Lintian/Check/Files')
-rw-r--r--lib/Lintian/Check/Files/Architecture.pm105
-rw-r--r--lib/Lintian/Check/Files/Artifact.pm140
-rw-r--r--lib/Lintian/Check/Files/Banned.pm113
-rw-r--r--lib/Lintian/Check/Files/Banned/CompiledHelp.pm58
-rw-r--r--lib/Lintian/Check/Files/Banned/Lenna.pm109
-rw-r--r--lib/Lintian/Check/Files/Bugs.pm50
-rw-r--r--lib/Lintian/Check/Files/BuildPath.pm55
-rw-r--r--lib/Lintian/Check/Files/Compressed.pm80
-rw-r--r--lib/Lintian/Check/Files/Compressed/Bz2.pm57
-rw-r--r--lib/Lintian/Check/Files/Compressed/Gz.pm113
-rw-r--r--lib/Lintian/Check/Files/Compressed/Lz.pm77
-rw-r--r--lib/Lintian/Check/Files/Compressed/Lzma.pm57
-rw-r--r--lib/Lintian/Check/Files/Compressed/Lzo.pm57
-rw-r--r--lib/Lintian/Check/Files/Compressed/Xz.pm57
-rw-r--r--lib/Lintian/Check/Files/Compressed/Zip.pm62
-rw-r--r--lib/Lintian/Check/Files/ConfigScripts.pm108
-rw-r--r--lib/Lintian/Check/Files/Contents.pm150
-rw-r--r--lib/Lintian/Check/Files/Contents/LineLength.pm140
-rw-r--r--lib/Lintian/Check/Files/Date.pm66
-rw-r--r--lib/Lintian/Check/Files/Debug.pm55
-rw-r--r--lib/Lintian/Check/Files/DebugPackages.pm50
-rw-r--r--lib/Lintian/Check/Files/Desktop.pm57
-rw-r--r--lib/Lintian/Check/Files/Duplicates.pm88
-rw-r--r--lib/Lintian/Check/Files/EmptyDirectories.pm67
-rw-r--r--lib/Lintian/Check/Files/EmptyPackage.pm159
-rw-r--r--lib/Lintian/Check/Files/Encoding.pm125
-rw-r--r--lib/Lintian/Check/Files/Generated.pm83
-rw-r--r--lib/Lintian/Check/Files/HardLinks.pm57
-rw-r--r--lib/Lintian/Check/Files/Hierarchy/Links.pm83
-rw-r--r--lib/Lintian/Check/Files/Hierarchy/MergedUsr.pm48
-rw-r--r--lib/Lintian/Check/Files/Hierarchy/PathSegments.pm57
-rw-r--r--lib/Lintian/Check/Files/Hierarchy/Standard.pm262
-rw-r--r--lib/Lintian/Check/Files/IeeeData.pm79
-rw-r--r--lib/Lintian/Check/Files/Includes.pm69
-rw-r--r--lib/Lintian/Check/Files/Init.pm79
-rw-r--r--lib/Lintian/Check/Files/LdSo.pm48
-rw-r--r--lib/Lintian/Check/Files/Licenses.pm112
-rw-r--r--lib/Lintian/Check/Files/Locales.pm204
-rw-r--r--lib/Lintian/Check/Files/Missing.pm50
-rw-r--r--lib/Lintian/Check/Files/MultiArch.pm111
-rw-r--r--lib/Lintian/Check/Files/Names.pm163
-rw-r--r--lib/Lintian/Check/Files/NonFree.pm142
-rw-r--r--lib/Lintian/Check/Files/ObsoletePaths.pm92
-rw-r--r--lib/Lintian/Check/Files/Openpgp.pm51
-rw-r--r--lib/Lintian/Check/Files/Ownership.pm74
-rw-r--r--lib/Lintian/Check/Files/P11Kit.pm54
-rw-r--r--lib/Lintian/Check/Files/Pam.pm50
-rw-r--r--lib/Lintian/Check/Files/Permissions.pm249
-rw-r--r--lib/Lintian/Check/Files/Permissions/UsrLib.pm54
-rw-r--r--lib/Lintian/Check/Files/Pkgconfig.pm121
-rw-r--r--lib/Lintian/Check/Files/PrivacyBreach.pm420
-rw-r--r--lib/Lintian/Check/Files/Scripts.pm57
-rw-r--r--lib/Lintian/Check/Files/Sgml.pm48
-rw-r--r--lib/Lintian/Check/Files/SourceMissing.pm286
-rw-r--r--lib/Lintian/Check/Files/Special.pm50
-rw-r--r--lib/Lintian/Check/Files/SymbolicLinks.pm229
-rw-r--r--lib/Lintian/Check/Files/SymbolicLinks/Broken.pm119
-rw-r--r--lib/Lintian/Check/Files/Unicode/Trojan.pm134
-rw-r--r--lib/Lintian/Check/Files/Unwanted.pm55
-rw-r--r--lib/Lintian/Check/Files/UsrMerge.pm53
-rw-r--r--lib/Lintian/Check/Files/Vcs.pm113
61 files changed, 6211 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Files/Architecture.pm b/lib/Lintian/Check/Files/Architecture.pm
new file mode 100644
index 0000000..70cab47
--- /dev/null
+++ b/lib/Lintian/Check/Files/Architecture.pm
@@ -0,0 +1,105 @@
+# files/architecture -- 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 https://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::Check::Files::Architecture;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has TRIPLETS => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $DEB_HOST_MULTIARCH= $self->data->architectures->deb_host_multiarch;
+ my %triplets = map { $DEB_HOST_MULTIARCH->{$_} => $_ }
+ keys %{$DEB_HOST_MULTIARCH};
+
+ return \%triplets;
+ }
+);
+
+has depends_on_architecture => (is => 'rw', default => 0);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # for directories
+ if ($item->name =~ m{^(?:usr/)?lib/([^/]+)/$}) {
+
+ my $potential_triplet = $1;
+
+ if (exists $self->TRIPLETS->{$potential_triplet}) {
+
+ my $from_triplet = $self->TRIPLETS->{$potential_triplet};
+ my $port = $self->processable->fields->value('Architecture');
+
+ $self->pointed_hint('triplet-dir-and-architecture-mismatch',
+ $item->pointer, "is for $from_triplet instead of $port")
+ unless $from_triplet eq $port;
+ }
+ }
+
+ # for files
+ if ($item->dirname =~ m{^(?:usr)?/lib/([^/]+)/$}) {
+
+ my $potential_triplet = $1;
+
+ $self->depends_on_architecture(1)
+ if exists $self->TRIPLETS->{$potential_triplet};
+ }
+
+ $self->depends_on_architecture(1)
+ if $item->is_file
+ && $item->size > 0
+ && $item->file_type !~ m/^very short file/
+ && $item->file_type !~ m/\bASCII text\b/
+ && $item->name !~ m{^usr/share/};
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ $self->hint('package-contains-no-arch-dependent-files')
+ if !$self->depends_on_architecture
+ && $self->processable->fields->value('Architecture') ne 'all'
+ && $self->processable->type ne 'udeb'
+ && !$self->processable->is_transitional
+ && !$self->processable->is_meta_package;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Artifact.pm b/lib/Lintian/Check/Files/Artifact.pm
new file mode 100644
index 0000000..5344cfc
--- /dev/null
+++ b/lib/Lintian/Check/Files/Artifact.pm
@@ -0,0 +1,140 @@
+# files/artifact -- lintian check script -*- perl -*-
+#
+# based on debhelper check,
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Artifact;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use List::SomeUtils qw(first_value);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# Directory checks. These regexes match a directory that shouldn't be in the
+# source package and associate it with a tag (minus the leading
+# source-contains or debian-adds). Note that only one of these regexes
+# should trigger for any single directory.
+my @directory_checks = (
+ [qr{^(.+/)?CVS/?$} => 'cvs-control-dir'],
+ [qr{^(.+/)?\.svn/?$} => 'svn-control-dir'],
+ [qr{^(.+/)?\.bzr/?$} => 'bzr-control-dir'],
+ [qr{^(.+/)?\{arch\}/?$} => 'arch-control-dir'],
+ [qr{^(.+/)?\.arch-ids/?$} => 'arch-control-dir'],
+ [qr{^(.+/)?,,.+/?$} => 'arch-control-dir'],
+ [qr{^(.+/)?\.git/?$} => 'git-control-dir'],
+ [qr{^(.+/)?\.hg/?$} => 'hg-control-dir'],
+ [qr{^(.+/)?\.be/?$} => 'bts-control-dir'],
+ [qr{^(.+/)?\.ditrack/?$} => 'bts-control-dir'],
+
+ # Special case (can only be triggered for diffs)
+ [qr{^(.+/)?\.pc/?$} => 'quilt-control-dir'],
+);
+
+# File checks. These regexes match files that shouldn't be in the source
+# package and associate them with a tag (minus the leading source-contains or
+# debian-adds). Note that only one of these regexes should trigger for any
+# given file.
+my @file_checks = (
+ [qr{^(.+/)?svn-commit\.(.+\.)?tmp$} => 'svn-commit-file'],
+ [qr{^(.+/)?svk-commit.+\.tmp$} => 'svk-commit-file'],
+ [qr{^(.+/)?\.arch-inventory$} => 'arch-inventory-file'],
+ [qr{^(.+/)?\.hgtags$} => 'hg-tags-file'],
+ [qr{^(.+/)?\.\#(.+?)\.\d+(\.\d+)*$} => 'cvs-conflict-copy'],
+ [qr{^(.+/)?(.+?)\.(r[1-9]\d*)$} => 'svn-conflict-file'],
+ [qr{\.(orig|rej)$} => 'patch-failure-file'],
+ [qr{((^|/)[^/]+\.swp|~)$} => 'editor-backup-file'],
+);
+
+sub source {
+ my ($self) = @_;
+
+ my @added_by_debian;
+ my $prefix;
+ if ($self->processable->native) {
+
+ @added_by_debian = @{$self->processable->patched->sorted_list};
+ $prefix = 'source-contains';
+
+ } else {
+ my $patched = $self->processable->patched;
+ my $orig = $self->processable->orig;
+
+ @added_by_debian
+ = grep { !defined $orig->lookup($_->name) } @{$patched->sorted_list};
+
+ # remove root quilt control folder and all paths in it
+ # created when 3.0 (quilt) source packages are unpacked
+ @added_by_debian = grep { $_->name !~ m{^.pc/} } @added_by_debian
+ if $self->processable->source_format eq '3.0 (quilt)';
+
+ my @common_items
+ = grep { defined $orig->lookup($_->name) } @{$patched->sorted_list};
+ my @touched_by_debian
+ = grep { $_->md5sum ne $orig->lookup($_->name)->md5sum }
+ @common_items;
+
+ $self->hint('no-debian-changes')
+ unless @added_by_debian || @touched_by_debian;
+
+ $prefix = 'debian-adds';
+ }
+
+ # ignore lintian test set; should use automatic loop in the future
+ @added_by_debian = grep { $_->name !~ m{^t/} } @added_by_debian
+ if $self->processable->source_name eq 'lintian';
+
+ my @directories = grep { $_->is_dir } @added_by_debian;
+ for my $directory (@directories) {
+
+ my $rule = first_value { $directory->name =~ /$_->[0]/s }
+ @directory_checks;
+ $self->pointed_hint("${prefix}-$rule->[1]", $directory->pointer)
+ if defined $rule;
+ }
+
+ my @files = grep { $_->is_file } @added_by_debian;
+ for my $item (@files) {
+
+ my $rule = first_value { $item->name =~ /$_->[0]/s } @file_checks;
+ $self->pointed_hint("${prefix}-$rule->[1]", $item->pointer)
+ if defined $rule;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Banned.pm b/lib/Lintian/Check/Files/Banned.pm
new file mode 100644
index 0000000..81b5ae7
--- /dev/null
+++ b/lib/Lintian/Check/Files/Banned.pm
@@ -0,0 +1,113 @@
+# files/banned -- lintian check script -*- perl -*-
+#
+# based on debhelper check,
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Banned;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw(any);
+use Unicode::UTF8 qw(encode_utf8);
+
+const my $MD5SUM_DATA_FIELDS => 5;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub _md5sum_based_lintian_data {
+ my ($self, $filename) = @_;
+
+ my $data = $self->data->load($filename,qr/\s*\~\~\s*/);
+
+ my %md5sum_data;
+
+ for my $md5sum ($data->all) {
+
+ my $value = $data->value($md5sum);
+
+ my ($sha1, $sha256, $name, $reason, $link)
+ = split(/ \s* ~~ \s* /msx, $value, $MD5SUM_DATA_FIELDS);
+
+ die encode_utf8("Syntax error in $filename $.")
+ if any { !defined } ($sha1, $sha256, $name, $reason, $link);
+
+ $md5sum_data{$md5sum} = {
+ 'sha1' => $sha1,
+ 'sha256' => $sha256,
+ 'name' => $name,
+ 'reason' => $reason,
+ 'link' => $link,
+ };
+ }
+
+ return \%md5sum_data;
+}
+
+has NON_DISTRIBUTABLE_FILES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->_md5sum_based_lintian_data(
+ 'cruft/non-distributable-files');
+ }
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ my $banned = $self->NON_DISTRIBUTABLE_FILES->{$item->md5sum};
+ if (defined $banned) {
+ my $usualname = $banned->{'name'};
+ my $reason = $banned->{'reason'};
+ my $link = $banned->{'link'};
+
+ $self->pointed_hint(
+ 'license-problem-md5sum-non-distributable-file',
+ $item->pointer, "usual name is $usualname.",
+ $reason, "See also $link."
+ );
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Banned/CompiledHelp.pm b/lib/Lintian/Check/Files/Banned/CompiledHelp.pm
new file mode 100644
index 0000000..efb5eee
--- /dev/null
+++ b/lib/Lintian/Check/Files/Banned/CompiledHelp.pm
@@ -0,0 +1,58 @@
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Banned::CompiledHelp;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ # .chm files are usually generated by non-free software
+ $self->pointed_hint('source-contains-prebuilt-ms-help-file',$item->pointer)
+ if $item->basename =~ /\.chm$/i
+ && $item->file_type eq 'MS Windows HtmlHelp Data'
+ && $item->bytes !~ / Halibut, /msx;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Banned/Lenna.pm b/lib/Lintian/Check/Files/Banned/Lenna.pm
new file mode 100644
index 0000000..3bfcb2c
--- /dev/null
+++ b/lib/Lintian/Check/Files/Banned/Lenna.pm
@@ -0,0 +1,109 @@
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Banned::Lenna;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# known bad files
+has LENNA_BLACKLIST => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %blacklist;
+
+ my $data = $self->data->load('files/banned/lenna/blacklist',
+ qr/ \s* ~~ \s* /x);
+
+ for my $md5sum ($data->all) {
+
+ my $value = $data->value($md5sum);
+
+ my ($sha1, $sha256, $name, $link)
+ = split(/ \s* ~~ \s* /msx, $value);
+
+ $blacklist{$md5sum} = {
+ 'sha1' => $sha1,
+ 'sha256' => $sha256,
+ 'name' => $name,
+ 'link' => $link,
+ };
+ }
+
+ return \%blacklist;
+ }
+);
+
+# known good files
+has LENNA_WHITELIST => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->data->load('files/banned/lenna/whitelist');
+ }
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ return
+ unless $item->file_type =~ /\bimage\b/i
+ || $item->file_type =~ /^Matlab v\d+ mat/i
+ || $item->file_type =~ /\bbitmap\b/i
+ || $item->file_type =~ /^PDF Document\b/i
+ || $item->file_type =~ /^Postscript Document\b/i;
+
+ return
+ if $self->LENNA_WHITELIST->recognizes($item->md5sum);
+
+ # Lena Soderberg image
+ $self->pointed_hint('license-problem-non-free-img-lenna', $item->pointer)
+ if $item->basename =~ / ( \b | _ ) lenn?a ( \b | _ ) /ix
+ || exists $self->LENNA_BLACKLIST->{$item->md5sum};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Bugs.pm b/lib/Lintian/Check/Files/Bugs.pm
new file mode 100644
index 0000000..69432de
--- /dev/null
+++ b/lib/Lintian/Check/Files/Bugs.pm
@@ -0,0 +1,50 @@
+# files/bugs -- 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 https://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::Check::Files::Bugs;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_dir;
+
+ $self->pointed_hint('package-contains-bts-control-dir', $item->pointer)
+ if $item->name =~ m{/\.(?:be|ditrack)/?$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/BuildPath.pm b/lib/Lintian/Check/Files/BuildPath.pm
new file mode 100644
index 0000000..e6c73af
--- /dev/null
+++ b/lib/Lintian/Check/Files/BuildPath.pm
@@ -0,0 +1,55 @@
+# files/build-path -- 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 https://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::Check::Files::BuildPath;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $BUILD_PATH_REGEX
+ = $self->data->load('files/build-path-regex', qr/~~~~~/);
+
+ for my $pattern ($BUILD_PATH_REGEX->all) {
+
+ $self->pointed_hint('dir-or-file-in-build-tree', $item->pointer)
+ if $item->name =~ m{$pattern}xms
+ && $self->processable->source_name ne 'sbuild'
+ && $self->processable->source_name ne 'pbuilder';
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed.pm b/lib/Lintian/Check/Files/Compressed.pm
new file mode 100644
index 0000000..d64807f
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed.pm
@@ -0,0 +1,80 @@
+# files/compressed -- 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 https://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::Check::Files::Compressed;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+const my $VERTICAL_BAR => q{|};
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# an OR (|) regex of all compressed extension
+has COMPRESS_FILE_EXTENSIONS_OR_ALL => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $COMPRESS_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my $text = join($VERTICAL_BAR,
+ map { quotemeta }$COMPRESS_FILE_EXTENSIONS->all);
+
+ return qr/$text/;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ my $regex = $self->COMPRESS_FILE_EXTENSIONS_OR_ALL;
+
+ # see tag duplicated-compressed-file
+ my $DUPLICATED_COMPRESSED_FILE_REGEX= qr/^(.+)\.$regex$/;
+
+ # both compressed and uncompressed present
+ if ($item->name =~ $DUPLICATED_COMPRESSED_FILE_REGEX) {
+
+ $self->pointed_hint('compressed-duplicate', $item->pointer)
+ if $self->processable->installed->lookup($1);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Bz2.pm b/lib/Lintian/Check/Files/Compressed/Bz2.pm
new file mode 100644
index 0000000..25c8bc1
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Bz2.pm
@@ -0,0 +1,57 @@
+# files/compressed/bz2 -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Bz2;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.bz2$/si) {
+
+ safe_qx('bzip2', '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-bz2', $item->pointer)
+ if $?;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Gz.pm b/lib/Lintian/Check/Files/Compressed/Gz.pm
new file mode 100644
index 0000000..6290247
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Gz.pm
@@ -0,0 +1,113 @@
+# files/compressed/gz -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Gz;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Time::Piece;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# get timestamp of first member; https://tools.ietf.org/html/rfc1952.html#page-5
+const my $GZIP_HEADER_SIZE => 8;
+
+has changelog_timestamp => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ # remains 0 if there is no timestamp
+ my $changelog = $self->processable->changelog;
+ if (defined $changelog) {
+
+ my ($entry) = @{$changelog->entries};
+ return $entry->Timestamp
+ if $entry && $entry->Timestamp;
+ }
+
+ return 0;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.gz$/si) {
+
+ safe_qx('gzip', '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-gz', $item->pointer)
+ if $?;
+ }
+
+ # gzip files
+ if ($item->file_type =~ /gzip compressed/) {
+
+ my $bytes = $item->magic($GZIP_HEADER_SIZE);
+ my (undef, $gziptime) = unpack('VV', $bytes);
+
+ if (defined $gziptime && $gziptime != 0) {
+
+ # see https://bugs.debian.org/762105
+ my $time_from_build = $gziptime - $self->changelog_timestamp;
+ if ($time_from_build > 0) {
+
+ my $architecture
+ = $self->processable->fields->value('Architecture');
+ my $multiarch
+ = $self->processable->fields->value('Multi-Arch') || 'no';
+
+ if ($multiarch eq 'same' && $item->name !~ /\Q$architecture\E/)
+ {
+ $self->pointed_hint(
+ 'gzip-file-is-not-multi-arch-same-safe',
+ $item->pointer);
+
+ } else {
+ $self->pointed_hint('package-contains-timestamped-gzip',
+ $item->pointer,gmtime($gziptime)->datetime);
+ }
+ }
+ }
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Lz.pm b/lib/Lintian/Check/Files/Compressed/Lz.pm
new file mode 100644
index 0000000..defed97
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Lz.pm
@@ -0,0 +1,77 @@
+# files/compressed/lz -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Chris Lamb
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Lz;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use List::SomeUtils qw(first_value);
+
+use Lintian::IPC::Run3 qw(safe_qx);
+use Lintian::Util qw(locate_executable);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has lzip_command => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $command = first_value { locate_executable($_) } qw(lzip clzip);
+
+ return $command;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ my $command = $self->lzip_command;
+ return
+ unless length $command;
+
+ if ($item->name =~ /\.lz$/si) {
+
+ safe_qx($command, '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-lz', $item->pointer)
+ if $?;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Lzma.pm b/lib/Lintian/Check/Files/Compressed/Lzma.pm
new file mode 100644
index 0000000..2f49853
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Lzma.pm
@@ -0,0 +1,57 @@
+# files/compressed/lzma -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Lzma;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.lzma$/si) {
+
+ safe_qx('lzma', '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-lzma', $item->pointer)
+ if $?;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Lzo.pm b/lib/Lintian/Check/Files/Compressed/Lzo.pm
new file mode 100644
index 0000000..5e6cdca
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Lzo.pm
@@ -0,0 +1,57 @@
+# files/compressed/lzo -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Lzo;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.lzo$/si) {
+
+ safe_qx('lzop', '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-lzo', $item->pointer)
+ if $?;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Xz.pm b/lib/Lintian/Check/Files/Compressed/Xz.pm
new file mode 100644
index 0000000..6f3c6a0
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Xz.pm
@@ -0,0 +1,57 @@
+# files/compressed/xz -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Xz;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.xz$/si) {
+
+ safe_qx('xz', '--test', $item->unpacked_path);
+
+ $self->pointed_hint('broken-xz', $item->pointer)
+ if $?;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Compressed/Zip.pm b/lib/Lintian/Check/Files/Compressed/Zip.pm
new file mode 100644
index 0000000..68b9395
--- /dev/null
+++ b/lib/Lintian/Check/Files/Compressed/Zip.pm
@@ -0,0 +1,62 @@
+# files/compressed/zip -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Compressed::Zip;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ if ($item->name =~ /\.zip$/si) {
+
+ # maybe rewrite with Archive::Zip
+
+ # may prompt for password with -t; piping yes '' does not work
+ safe_qx('unzip', '-l', $item->unpacked_path);
+
+ $self->pointed_hint('broken-zip', $item->pointer)
+ if $?;
+
+ # should issue a tag for encrypted members, see Bug#935292
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/ConfigScripts.pm b/lib/Lintian/Check/Files/ConfigScripts.pm
new file mode 100644
index 0000000..b5df56c
--- /dev/null
+++ b/lib/Lintian/Check/Files/ConfigScripts.pm
@@ -0,0 +1,108 @@
+# files/config-scripts -- 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 https://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::Check::Files::ConfigScripts;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Unicode::UTF8 qw(encode_utf8);
+
+use Lintian::SlidingWindow;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $architecture = $self->processable->fields->value('Architecture');
+ my $multiarch = $self->processable->fields->value('Multi-Arch') || 'no';
+
+ # check old style config scripts
+ if ( $item->name =~ m{^usr/bin/}
+ && $item->name =~ m/-config$/
+ && $item->is_script
+ && $item->is_regular_file) {
+
+ # try to find some indication of
+ # config file (read only one block)
+
+ open(my $fd, '<:raw', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $sfd = Lintian::SlidingWindow->new;
+ $sfd->handle($fd);
+
+ my $block = $sfd->readwindow;
+
+ # some common stuff found in config file
+ if (
+ $block
+ && ( $block =~ / flag /msx
+ || $block =~ m{ /include/ }msx
+ || $block =~ / pkg-config /msx)
+ ) {
+
+ $self->pointed_hint('old-style-config-script', $item->pointer);
+
+ # could be ok but only if multi-arch: no
+ if ($multiarch ne 'no' || $architecture eq 'all') {
+
+ # check multi-arch path
+ my $DEB_HOST_MULTIARCH
+ = $self->data->architectures->deb_host_multiarch;
+ for my $madir (values %{$DEB_HOST_MULTIARCH}) {
+
+ next
+ unless $block =~ m{\W\Q$madir\E(\W|$)}xms;
+
+ # allow files to begin with triplet if it matches arch
+ next
+ if $item->basename =~ m{^\Q$madir\E}xms;
+
+ my $tag_name = 'old-style-config-script-multiarch-path';
+ $tag_name .= '-arch-all'
+ if $architecture eq 'all';
+
+ $self->pointed_hint($tag_name, $item->pointer,
+ 'full text contains architecture specific dir',$madir);
+
+ last;
+ }
+ }
+ }
+
+ close $fd;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Contents.pm b/lib/Lintian/Check/Files/Contents.pm
new file mode 100644
index 0000000..472c419
--- /dev/null
+++ b/lib/Lintian/Check/Files/Contents.pm
@@ -0,0 +1,150 @@
+# files/contents -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2019 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Contents;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw(any);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+const my $SLASH => q{/};
+const my $ARROW => q{ -> };
+
+my $SENSIBLE_REGEX
+ = qr{(?<!-)(?:select-editor|sensible-(?:browser|editor|pager))\b};
+
+# with this Moo default, maintainer scripts are also checked
+has switched_locations => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my @files
+ = grep { $_->is_file } @{$self->processable->installed->sorted_list};
+
+ my @commands = grep { $_->name =~ m{^(?:usr/)?s?bin/} } @files;
+
+ my %switched_locations;
+ for my $command (@commands) {
+
+ my @variants = map { $_ . $SLASH . $command->basename }
+ qw(bin sbin usr/bin usr/sbin);
+ my @confused = grep { $_ ne $command->name } @variants;
+
+ $switched_locations{$_} = $command->name for @confused;
+ }
+
+ return \%switched_locations;
+ }
+);
+
+sub build_path {
+ my ($self) = @_;
+
+ my $buildinfo = $self->group->buildinfo;
+
+ return $EMPTY
+ unless $buildinfo;
+
+ return $buildinfo->fields->value('Build-Path');
+}
+
+sub check_item {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ unless ($self->processable->relation('all')->satisfies('sensible-utils')
+ || $self->processable->source_name eq 'sensible-utils') {
+
+ my $sensible = $item->mentions_in_operation($SENSIBLE_REGEX);
+ $self->pointed_hint('missing-depends-on-sensible-utils',
+ $item->pointer, $sensible)
+ if length $sensible;
+ }
+
+ unless ($self->processable->fields->value('Section') eq 'debian-installer'
+ || any { $_ eq $self->processable->source_name } qw(base-files dpkg)) {
+
+ $self->pointed_hint('uses-dpkg-database-directly', $item->pointer)
+ if length $item->mentions_in_operation(qr{/var/lib/dpkg});
+ }
+
+ # if we have a /usr/sbin/foo, check for references to /usr/bin/foo
+ my %switched_locations = %{$self->switched_locations};
+ for my $confused (keys %switched_locations) {
+
+ # may not work as expected on ELF due to ld's SHF_MERGE
+ # but word boundaries are also superior in strings spanning multiple commands
+ my $correct = $switched_locations{$confused};
+ $self->pointed_hint('bin-sbin-mismatch', $item->pointer,
+ $confused . $ARROW . $correct)
+ if length $item->mentions_in_operation(qr{ \B / \Q$confused\E \b }x);
+ }
+
+ if (length $self->build_path) {
+ my $escaped_path = quotemeta($self->build_path);
+ $self->pointed_hint('file-references-package-build-path',
+ $item->pointer)
+ if $item->bytes_match(qr{$escaped_path});
+ }
+
+ return;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->check_item($item);
+
+ return;
+}
+
+sub visit_control_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_maintainer_script;
+
+ $self->check_item($item);
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Contents/LineLength.pm b/lib/Lintian/Check/Files/Contents/LineLength.pm
new file mode 100644
index 0000000..63f38ca
--- /dev/null
+++ b/lib/Lintian/Check/Files/Contents/LineLength.pm
@@ -0,0 +1,140 @@
+# files/contents/line-length -- lintian check script -*- perl -*-
+
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Contents::LineLength;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::UtilsBy qw(max_by);
+use Unicode::UTF8 qw(encode_utf8 decode_utf8 valid_utf8);
+
+const my $GREATER_THAN => q{>};
+const my $VERTICAL_BAR => q{|};
+
+const my $VERY_LONG => 512;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# an OR (|) regex of all compressed extension
+has BINARY_FILE_EXTENSIONS_OR_ALL => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $BINARY_FILE_EXTENSIONS
+ = $self->data->load('files/binary-file-extensions',qr/\s+/);
+ my $COMPRESSED_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my $text = join(
+ $VERTICAL_BAR,
+ (
+ map { quotemeta } $BINARY_FILE_EXTENSIONS->all,
+ $COMPRESSED_FILE_EXTENSIONS->all
+ )
+ );
+
+ return qr/$text/i;
+ }
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ # Skip if no regular file
+ return
+ unless $item->is_regular_file;
+
+ # Skip if file has a known binary, XML or JSON suffix.
+ my $pattern = $self->BINARY_FILE_EXTENSIONS_OR_ALL;
+ return
+ if $item->basename
+ =~ qr{ [.] ($pattern | xml | sgml | svg | jsonl?) \s* $}x;
+
+ # Skip if we can't open it.
+ return
+ unless $item->is_open_ok;
+
+ # Skip if file is a REUSE license (LICENSES/**.txt), which are
+ # canonically provided with long lines rather than being hard-wrapped.
+ return
+ if $item->name =~ m{^ LICENSES/ .* [.] txt $}x;
+
+ # Skip if file is detected to be an image or JSON.
+ return
+ if $item->file_type =~ m{image|bitmap|JSON};
+
+ open(my $fd, '<', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my %line_lengths;
+
+ my $position = 1;
+ while (my $line = <$fd>) {
+ # Skip SQL insert and select statements
+ next if ($line =~ /^(INSERT|SELECT)\s/i
+ and $item->basename =~ /sql/i);
+
+ # count codepoints, if possible
+ $line = decode_utf8($line)
+ if valid_utf8($line);
+
+ $line_lengths{$position} = length $line;
+
+ } continue {
+ ++$position;
+ }
+
+ close $fd;
+
+ my $longest = max_by { $line_lengths{$_} } keys %line_lengths;
+
+ return
+ unless defined $longest;
+
+ my $pointer = $item->pointer($longest);
+
+ $self->pointed_hint('very-long-line-length-in-source-file',
+ $pointer, $line_lengths{$longest}, $GREATER_THAN, $VERY_LONG)
+ if $line_lengths{$longest} > $VERY_LONG;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Date.pm b/lib/Lintian/Check/Files/Date.pm
new file mode 100644
index 0000000..3b1f479
--- /dev/null
+++ b/lib/Lintian/Check/Files/Date.pm
@@ -0,0 +1,66 @@
+# files/date -- 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 https://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::Check::Files::Date;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# value from dak CVS: Dinstall::PastCutOffYear
+const my $DINSTALL_CUTOFF_YEAR => 1975;
+
+has ALLOWED_ANCIENT_FILES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->data->load('files/allowed-ancient-files');
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my ($year) = ($item->date =~ /^(\d{4})/);
+
+ $self->pointed_hint('package-contains-ancient-file',
+ $item->pointer, $item->date)
+ if $year <= $DINSTALL_CUTOFF_YEAR
+ && !$self->ALLOWED_ANCIENT_FILES->matches_any($item->name);
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Debug.pm b/lib/Lintian/Check/Files/Debug.pm
new file mode 100644
index 0000000..9eead27
--- /dev/null
+++ b/lib/Lintian/Check/Files/Debug.pm
@@ -0,0 +1,55 @@
+# files/debug -- 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 https://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::Check::Files::Debug;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has warned_already => (is => 'rw', default => 0);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if ($item->name =~ m{^usr/lib/debug/\S}) {
+
+ $self->pointed_hint('debug-suffix-not-dbg', $item->pointer)
+ if !$self->processable->is_debug_package
+ && !$self->warned_already;
+
+ $self->warned_already(1);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/DebugPackages.pm b/lib/Lintian/Check/Files/DebugPackages.pm
new file mode 100644
index 0000000..7f83816
--- /dev/null
+++ b/lib/Lintian/Check/Files/DebugPackages.pm
@@ -0,0 +1,50 @@
+# files/debug-packages -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Chris Lamb <lamby@debian.org>
+#
+# 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 https://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::Check::Files::DebugPackages;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('non-debug-file-in-debug-package', $item->pointer)
+ if $item->is_file
+ && $item->name !~ /\.debug$/
+ && $self->processable->is_debug_package
+ && $self->processable->is_auto_generated;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Desktop.pm b/lib/Lintian/Check/Files/Desktop.pm
new file mode 100644
index 0000000..fca3006
--- /dev/null
+++ b/lib/Lintian/Check/Files/Desktop.pm
@@ -0,0 +1,57 @@
+# files/desktop -- 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 https://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::Check::Files::Desktop;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # .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.
+
+ $self->pointed_hint('desktop-file-in-wrong-dir', $item->pointer)
+ if $item->name =~ m{^usr/share/gnome/apps/.*\.desktop$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Duplicates.pm b/lib/Lintian/Check/Files/Duplicates.pm
new file mode 100644
index 0000000..b1dc809
--- /dev/null
+++ b/lib/Lintian/Check/Files/Duplicates.pm
@@ -0,0 +1,88 @@
+# files/duplicates -- lintian check script -*- perl -*-
+
+# Copyright (C) 2011 Niels Thykier
+#
+# 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 https://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::Check::Files::Duplicates;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use List::SomeUtils qw(any);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has md5map => (is => 'rw', default => sub{ {} });
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_regular_file;
+
+ # Ignore empty files; in some cases (e.g. python) a file is
+ # required even if it is empty and we are never looking at a
+ # substantial gain in such a case. Also see #632789
+ return
+ unless $item->size;
+
+ my $calculated = $item->md5sum;
+ return
+ unless defined $calculated;
+
+ return
+ unless $item->name =~ m{\A usr/share/doc/}xsm;
+
+ $self->md5map->{$calculated} //= [];
+
+ push(@{$self->md5map->{$calculated}}, $item);
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ for my $md5 (keys %{$self->md5map}){
+ my @files = @{ $self->md5map->{$md5} };
+
+ next
+ if scalar @files < 2;
+
+ if (any { m/changelog/i} @files) {
+ $self->hint('duplicate-changelog-files', (sort @files));
+
+ } else {
+ $self->hint('duplicate-files', (sort @files));
+ }
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/EmptyDirectories.pm b/lib/Lintian/Check/Files/EmptyDirectories.pm
new file mode 100644
index 0000000..52079cb
--- /dev/null
+++ b/lib/Lintian/Check/Files/EmptyDirectories.pm
@@ -0,0 +1,67 @@
+# files/empty-directories -- 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 https://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::Check::Files::EmptyDirectories;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_dir;
+
+ # skip base-files, which is a very special case.
+ return
+ if $self->processable->name eq 'base-files';
+
+ # ignore /var, which may hold dynamic data packages create, and /etc,
+ # which may hold configuration files generated by maintainer scripts
+ return
+ if $item->name =~ m{^var/} || $item->name =~ m{^etc/};
+
+ # 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.
+ return
+ if $item->name =~ m{^usr/lib/(?:[^/]+/)?perl5/$}
+ || $item->name eq 'usr/share/perl5/';
+
+ # warn about empty directories
+ $self->pointed_hint('package-contains-empty-directory', $item->pointer)
+ if scalar $item->children == 0;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/EmptyPackage.pm b/lib/Lintian/Check/Files/EmptyPackage.pm
new file mode 100644
index 0000000..5b23846
--- /dev/null
+++ b/lib/Lintian/Check/Files/EmptyPackage.pm
@@ -0,0 +1,159 @@
+# files/empty-package -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2019 Chris Lamb <lamby@debian.org>
+#
+# 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 https://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::Check::Files::EmptyPackage;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# Common files stored in /usr/share/doc/$pkg that aren't sufficient to
+# consider the package non-empty.
+has STANDARD_FILES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->data->load('files/standard-files');
+ }
+);
+
+has is_empty => (is => 'rw', default => 1);
+has is_dummy => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ # check if package is empty
+ return 1
+ if $self->processable->is_transitional
+ || $self->processable->is_meta_package;
+
+ return 0;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $self->is_empty;
+
+ return
+ if $self->is_dummy;
+
+ # ignore directories
+ return
+ if $item->is_dir;
+
+ my $pkg = $self->processable->name;
+ my $ppkg = quotemeta($self->processable->name);
+
+ # skip if file is outside /usr/share/doc/$pkg directory
+ if ($item->name !~ m{^usr/share/doc/\Q$pkg\E}) {
+
+ # - except if it is a lintian override.
+ return
+ if $item->name =~ m{\A
+ # Except for:
+ usr/share/ (?:
+ # lintian overrides
+ lintian/overrides/$ppkg(?:\.gz)?
+ # reportbug scripts/utilities
+ | bug/$ppkg(?:/(?:control|presubj|script))?
+ )\Z}xsm;
+
+ $self->is_empty(0);
+
+ return;
+ }
+
+ # skip if /usr/share/doc/$pkg has files in a subdirectory
+ if ($item->name =~ m{^usr/share/doc/\Q$pkg\E/[^/]+/}) {
+
+ $self->is_empty(0);
+
+ return;
+ }
+
+ # skip /usr/share/doc/$pkg symlinks.
+ return
+ if $item->name 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.
+ return
+ if $self->STANDARD_FILES->recognizes($item->basename);
+
+ # ignore all READMEs
+ return
+ if $item->basename =~ m/^README(?:\..*)?$/i;
+
+ my $pkg_arch = $self->processable->architecture;
+ unless ($pkg_arch eq 'all') {
+
+ # binNMU changelog (debhelper)
+ return
+ if $item->basename eq "changelog.Debian.${pkg_arch}.gz";
+ }
+
+ # buildinfo file (dh-buildinfo)
+ return
+ if $item->basename eq "buildinfo_${pkg_arch}.gz";
+
+ $self->is_empty(0);
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ return
+ if $self->is_dummy;
+
+ if ($self->is_empty) {
+
+ $self->hint('empty-binary-package')
+ if $self->processable->type eq 'binary';
+
+ $self->hint('empty-udeb-package')
+ if $self->processable->type eq 'udeb';
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Encoding.pm b/lib/Lintian/Check/Files/Encoding.pm
new file mode 100644
index 0000000..f175401
--- /dev/null
+++ b/lib/Lintian/Check/Files/Encoding.pm
@@ -0,0 +1,125 @@
+# files/encoding -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Encoding;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use Unicode::UTF8 qw(valid_utf8 encode_utf8);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->name =~ m{^debian/};
+
+ return
+ unless $item->is_file;
+
+ return
+ unless $item->file_type =~ /text$/;
+
+ if ($item->name =~ m{^debian/patches/}) {
+
+ my $bytes = $item->bytes;
+ return
+ unless length $bytes;
+
+ my ($header)= split(/^---/m, $bytes, 2);
+
+ $self->pointed_hint('national-encoding', $item->pointer,'DEP-3 header')
+ unless valid_utf8($header);
+
+ } else {
+ $self->pointed_hint('national-encoding', $item->pointer)
+ unless $item->is_valid_utf8;
+ }
+
+ return;
+}
+
+sub visit_control_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ return
+ unless $item->file_type =~ /text$/ || $item->is_script;
+
+ $self->pointed_hint('national-encoding', $item->pointer)
+ unless $item->is_valid_utf8;
+
+ return;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ # this checks debs; most other nat'l encoding tags are for source
+ # Bug#796170 also suggests limiting paths and including gzip files
+
+ # return
+ # unless $item->name =~ m{^(?:usr/)?s?bin/}
+ # || $item->name =~ m{^usr/games/}
+ # || $item->name =~ m{\.(?:p[myl]|php|rb|tcl|sh|txt)(?:\.gz)?$}
+ # || $item->name =~ m{^usr/share/doc};
+
+ if ($item->file_type =~ /text$/) {
+
+ $self->pointed_hint('national-encoding', $item->pointer)
+ unless $item->is_valid_utf8;
+ }
+
+ # for man pages also look at compressed files
+ if ( $item->name =~ m{^usr/share/man/}
+ && $item->file_type =~ /gzip compressed/) {
+
+ my $bytes;
+
+ my $path = $item->unpacked_path;
+ gunzip($path => \$bytes)
+ or die encode_utf8("gunzip $path failed: $GunzipError");
+
+ $self->pointed_hint('national-encoding', $item->pointer)
+ unless valid_utf8($bytes);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Generated.pm b/lib/Lintian/Check/Files/Generated.pm
new file mode 100644
index 0000000..35c88d5
--- /dev/null
+++ b/lib/Lintian/Check/Files/Generated.pm
@@ -0,0 +1,83 @@
+# files/generated -- lintian check script -*- perl -*-
+
+# Copyright (C) 2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Generated;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Unicode::UTF8 qw(encode_utf8);
+
+use Moo;
+use namespace::clean;
+
+const my $DOUBLE_QUOTE => q{"};
+
+with 'Lintian::Check';
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ # check all patched source files except the Debian patches
+ return
+ if $item->name =~ m{^ debian/patches/ }x;
+
+ return
+ unless $item->is_open_ok;
+
+ open(my $fd, '<', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $position = 1;
+ while (my $line = <$fd>) {
+
+ if ($line
+ =~m{ ( This [ ] file [ ] (?: is | was ) [ ] autogenerated ) }xi
+ || $line
+ =~ m{ ( DO [ ] NOT [ ] EDIT [ ] (?: THIS [ ] FILE [ ] )? BY [ ] HAND ) }xi
+ ) {
+
+ my $marker = $1;
+
+ $self->pointed_hint(
+ 'generated-file',
+ $item->pointer($position),
+ $DOUBLE_QUOTE . $marker . $DOUBLE_QUOTE
+ );
+ }
+
+ } continue {
+ ++$position;
+ }
+
+ close $fd;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/HardLinks.pm b/lib/Lintian/Check/Files/HardLinks.pm
new file mode 100644
index 0000000..f115897
--- /dev/null
+++ b/lib/Lintian/Check/Files/HardLinks.pm
@@ -0,0 +1,57 @@
+# files/hard-links -- 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 https://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::Check::Files::HardLinks;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_hardlink;
+
+ my $target_dir = $item->link;
+ $target_dir =~ s{[^/]*$}{};
+
+ # link always sorts after target; hard links are calibrated
+ $self->pointed_hint('package-contains-hardlink', $item->pointer,
+ 'pointing to:', $item->link)
+ if $item->name =~ m{^etc/}
+ || $item->link =~ m{^etc/}
+ || $item->name !~ m{^\Q$target_dir\E[^/]*$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Hierarchy/Links.pm b/lib/Lintian/Check/Files/Hierarchy/Links.pm
new file mode 100644
index 0000000..2402b5d
--- /dev/null
+++ b/lib/Lintian/Check/Files/Hierarchy/Links.pm
@@ -0,0 +1,83 @@
+# files/symbolic-links/broken -- lintian check script -*- perl -*-
+#
+# Copyright (C) 2020 Felix Lechner
+# Copyright (C) 2020 Chris Lamb <lamby@debian.org>
+#
+# 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 https://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::Check::Files::Hierarchy::Links;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use File::Basename;
+use List::SomeUtils qw(any first_value);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+const my $SLASH => q{/};
+const my $ARROW => q{ -> };
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # symbolic links only
+ return
+ unless $item->is_symlink;
+
+ my $target = $item->link_normalized;
+ return
+ unless defined $target;
+
+ my @ldconfig_folders = @{$self->data->architectures->ldconfig_folders};
+
+ my $origin_dirname= first_value { $item->dirname eq $_ } @ldconfig_folders;
+
+ # look only at links originating in common ld.so load paths
+ return
+ unless length $origin_dirname;
+
+ my $target_dirname
+ = first_value { (dirname($target) . $SLASH) eq $_ } @ldconfig_folders;
+ $target_dirname //= $EMPTY;
+
+ # no subfolders
+ $self->pointed_hint('ldconfig-escape', $item->pointer, $target)
+ unless length $target_dirname;
+
+ my @multiarch= values %{$self->data->architectures->deb_host_multiarch};
+
+ $self->pointed_hint('architecture-escape', $item->pointer, $target)
+ if (any { basename($origin_dirname) eq $_ } @multiarch)
+ && (any { $target_dirname eq "$_/" } qw{lib usr/lib usr/local/lib});
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Hierarchy/MergedUsr.pm b/lib/Lintian/Check/Files/Hierarchy/MergedUsr.pm
new file mode 100644
index 0000000..ebd0d1c
--- /dev/null
+++ b/lib/Lintian/Check/Files/Hierarchy/MergedUsr.pm
@@ -0,0 +1,48 @@
+# files/hierarchy/merged-usr -- lintian check script -*- perl -*-
+#
+# Copyright (C) 2021 Felix Lechner
+#
+# 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 https://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::Check::Files::Hierarchy::MergedUsr;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('unmerged-usr', $item->pointer)
+ if $item->is_file
+ && $item->name =~ m{^(?:lib|bin|sbin)};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Hierarchy/PathSegments.pm b/lib/Lintian/Check/Files/Hierarchy/PathSegments.pm
new file mode 100644
index 0000000..b9e5535
--- /dev/null
+++ b/lib/Lintian/Check/Files/Hierarchy/PathSegments.pm
@@ -0,0 +1,57 @@
+# files/hierarchy/path-segments -- lintian check script -*- perl -*-
+#
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Hierarchy::PathSegments;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_dir;
+
+ my @segments = split(m{/}, $item->name);
+ return
+ unless @segments;
+
+ my $final = $segments[-1];
+ my $count = scalar grep { $final eq $_ } @segments;
+
+ $self->pointed_hint('repeated-path-segment', $item->pointer, $final)
+ if $count > 1;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Hierarchy/Standard.pm b/lib/Lintian/Check/Files/Hierarchy/Standard.pm
new file mode 100644
index 0000000..e00955b
--- /dev/null
+++ b/lib/Lintian/Check/Files/Hierarchy/Standard.pm
@@ -0,0 +1,262 @@
+# files/hierarchy/standard -- 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 https://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::Check::Files::Hierarchy::Standard;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub _is_tmp_path {
+ my ($path) = @_;
+
+ return 1
+ if $path =~ m{^tmp/.}
+ || $path =~ m{^(?:var|usr)/tmp/.}
+ || $path =~ m{^/dev/shm/};
+
+ return 0;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if ($item->name =~ m{^etc/opt/.}) {
+
+ # /etc/opt
+ $self->pointed_hint('dir-or-file-in-etc-opt', $item->pointer);
+
+ } elsif ($item->name =~ m{^usr/local/\S+}) {
+ # /usr/local
+ if ($item->is_dir) {
+ $self->pointed_hint('dir-in-usr-local', $item->pointer);
+ } else {
+ $self->pointed_hint('file-in-usr-local', $item->pointer);
+ }
+
+ } elsif ($item->name =~ m{^usr/share/[^/]+$}) {
+ # /usr/share
+ $self->pointed_hint('file-directly-in-usr-share', $item->pointer)
+ if $item->is_file;
+
+ } elsif ($item->name =~ m{^usr/bin/}) {
+ # /usr/bin
+ $self->pointed_hint('subdir-in-usr-bin', $item->pointer)
+ if $item->is_dir
+ && $item->name =~ m{^usr/bin/.}
+ && $item->name !~ m{^usr/bin/(?:X11|mh)/};
+
+ } elsif ($self->processable->type ne 'udeb'
+ && $item->name =~ m{^usr/[^/]+/$}) {
+
+ # /usr subdirs
+ if ($item->name=~ m{^usr/(?:dict|doc|etc|info|man|adm|preserve)/}) {
+ # FSSTND dirs
+ $self->pointed_hint('FSSTND-dir-in-usr', $item->pointer);
+ } elsif (
+ $item->name !~ m{^usr/(?:X11R6|X386|
+ bin|games|include|
+ lib|
+ local|sbin|share|
+ src|spool|tmp)/}x
+ ) {
+ # FHS dirs
+ if ($item->name =~ m{^usr/lib(?<libsuffix>64|x?32)/}) {
+ my $libsuffix = $+{libsuffix};
+ # eglibc exception is due to FHS. Other are
+ # transitional, waiting for full
+ # implementation of multi-arch. Note that we
+ # allow (e.g.) "lib64" packages to still use
+ # these dirs, since their use appears to be by
+ # intention.
+ unless ($self->processable->source_name =~ m/^e?glibc$/
+ or $self->processable->name =~ m/^lib$libsuffix/) {
+
+ $self->pointed_hint('non-multi-arch-lib-dir',
+ $item->pointer);
+ }
+ } else {
+ # see Bug#834607
+ $self->pointed_hint('non-standard-dir-in-usr', $item->pointer)
+ unless $item->name =~ m{^usr/libexec/};
+ }
+
+ }
+
+ # unless $item =~ 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.
+ }
+
+ # /var subdirs
+ elsif ($self->processable->type ne 'udeb'
+ && $item->name =~ m{^var/[^/]+/$}) {
+
+ if ($item->name =~ m{^var/(?:adm|catman|named|nis|preserve)/}) {
+ # FSSTND dirs
+ $self->pointed_hint('FSSTND-dir-in-var', $item->pointer);
+
+ } elsif ($self->processable->name eq 'base-files'
+ && $item->name =~ m{^var/(?:backups|local)/}) {
+ # base-files is special
+ # ignore
+
+ } elsif (
+ $item->name !~ m{\A var/
+ (?: account|lib|cache|crash|games
+ |lock|log|opt|run|spool|state
+ |tmp|www|yp)/
+ }xsm
+ ) {
+ # FHS dirs with exception in Debian policy
+ $self->pointed_hint('non-standard-dir-in-var', $item->pointer);
+ }
+
+ } elsif ($self->processable->type ne 'udeb'
+ && $item->name =~ m{^var/lib/games/.}) {
+ $self->pointed_hint('non-standard-dir-in-var', $item->pointer);
+
+ } elsif ($self->processable->type ne 'udeb'
+ && $item->name =~ m{^var/lock/.}) {
+ # /var/lock
+ $self->pointed_hint('dir-or-file-in-var-lock', $item->pointer);
+
+ } elsif ($self->processable->type ne 'udeb'
+ && $item->name =~ m{^var/run/.}) {
+ # /var/run
+ $self->pointed_hint('dir-or-file-in-var-run', $item->pointer);
+
+ } elsif ($self->processable->type ne 'udeb' && $item->name =~ m{^run/.}) {
+ $self->pointed_hint('dir-or-file-in-run', $item->pointer);
+
+ } elsif ($item->name =~ m{^var/www/\S+}) {
+ # /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.
+ $self->pointed_hint('dir-or-file-in-var-www', $item->pointer);
+
+ } elsif ($item->name =~ m{^opt/.}) {
+ # /opt
+ $self->pointed_hint('dir-or-file-in-opt', $item->pointer);
+
+ } elsif ($item->name =~ m{^hurd/}) {
+ return;
+
+ } elsif ($item->name =~ m{^servers/}) {
+ return;
+
+ } elsif ($item->name =~ m{^home/.}) {
+ # /home
+ $self->pointed_hint('dir-or-file-in-home', $item->pointer);
+
+ } elsif ($item->name =~ m{^root/.}) {
+ $self->pointed_hint('dir-or-file-in-home', $item->pointer);
+
+ } elsif (_is_tmp_path($item->name)) {
+ # /tmp, /var/tmp, /usr/tmp
+ $self->pointed_hint('dir-or-file-in-tmp', $item->pointer);
+
+ } elsif ($item->name =~ m{^mnt/.}) {
+ # /mnt
+ $self->pointed_hint('dir-or-file-in-mnt', $item->pointer);
+
+ } elsif ($item->name =~ m{^bin/}) {
+ # /bin
+ $self->pointed_hint('subdir-in-bin', $item->pointer)
+ if $item->is_dir && $item->name =~ m{^bin/.};
+
+ } elsif ($item->name =~ m{^srv/.}) {
+ # /srv
+ $self->pointed_hint('dir-or-file-in-srv', $item->pointer);
+
+ }elsif (
+ $item->name =~ m{^[^/]+/$}
+ && $item->name !~ m{\A (?:
+ bin|boot|dev|etc|home|lib
+ |mnt|opt|root|run|sbin|srv|sys
+ |tmp|usr|var) /
+ }xsm
+ ) {
+ # FHS directory?
+
+ # 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).
+ if ($item->name =~ m{^lib(?<libsuffix>64|x?32)/}) {
+ my $libsuffix = $+{libsuffix};
+
+ # see comments for ^usr/lib(?'libsuffix'64|x?32)
+ $self->pointed_hint('non-multi-arch-lib-dir', $item->pointer)
+ unless $self->processable->source_name =~ m/^e?glibc$/
+ || $self->processable->name =~ m/^lib$libsuffix/;
+
+ } else {
+ $self->pointed_hint('non-standard-toplevel-dir', $item->pointer)
+ unless $self->processable->name eq 'base-files'
+ || $self->processable->name eq 'hurd'
+ || $self->processable->name eq 'hurd-udeb'
+ || $self->processable->name =~ /^rootskel(?:-bootfloppy)?/;
+ }
+ }
+
+ # compatibility symlinks should not be used
+ $self->pointed_hint('use-of-compat-symlink', $item->pointer)
+ if $item->name =~ m{^usr/(?:spool|tmp)/}
+ || $item->name =~ m{^usr/(?:doc|bin)/X11/}
+ || $item->name =~ m{^var/adm/};
+
+ # any files
+ $self->pointed_hint('file-in-unusual-dir', $item->pointer)
+ unless $item->is_dir
+ || $self->processable->type eq 'udeb'
+ || $item->name =~ m{^usr/(?:bin|dict|doc|games|
+ include|info|lib(?:x?32|64)?|
+ man|sbin|share|src|X11R6)/}x
+ || $item->name =~ m{^lib(?:x?32|64)?/(?:modules/|libc5-compat/)?}
+ || $item->name =~ m{^var/(?:games|lib|www|named)/}
+ || $item->name =~ m{^(?:bin|boot|dev|etc|sbin)/}
+ # non-FHS, but still usual
+ || $item->name =~ m{^usr/[^/]+-linux[^/]*/}
+ || $item->name =~ m{^usr/libexec/} # FHS 3.0 / #834607
+ || $item->name =~ m{^usr/iraf/}
+ # not allowed, but tested individually
+ || $item->name =~ m{\A (?:
+ build|home|mnt|opt|root|run|srv
+ |(?:(?:usr|var)/)?tmp)|var/www/}xsm;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/IeeeData.pm b/lib/Lintian/Check/Files/IeeeData.pm
new file mode 100644
index 0000000..0c2ba68
--- /dev/null
+++ b/lib/Lintian/Check/Files/IeeeData.pm
@@ -0,0 +1,79 @@
+# files/ieee-data -- 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 https://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::Check::Files::IeeeData;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+const my $VERTICAL_BAR => q{|};
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# an OR (|) regex of all compressed extension
+has COMPRESS_FILE_EXTENSIONS_OR_ALL => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $COMPRESS_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my $text = join($VERTICAL_BAR,
+ map { quotemeta }$COMPRESS_FILE_EXTENSIONS->all);
+
+ return qr/$text/;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $regex = $self->COMPRESS_FILE_EXTENSIONS_OR_ALL;
+
+ if ( $item->is_regular_file
+ && $item->name
+ =~ m{/(?:[^/]-)?(?:oui|iab)(?:\.(txt|idx|db))?(?:\.$regex)?\Z}x) {
+
+ # see #785662
+ if ($item->name =~ / oui /msx || $item->name =~ / iab /msx) {
+
+ $self->pointed_hint('package-installs-ieee-data', $item->pointer)
+ unless $self->processable->source_name eq 'ieee-data';
+ }
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Includes.pm b/lib/Lintian/Check/Files/Includes.pm
new file mode 100644
index 0000000..ec10bb8
--- /dev/null
+++ b/lib/Lintian/Check/Files/Includes.pm
@@ -0,0 +1,69 @@
+# files/includes -- 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 https://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::Check::Files::Includes;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw{any};
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# case insensitive regular expressions for overly generic paths
+const my @GENERIC_PATHS => ('^ util[s]? [.]h $');
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ my $consumed = $item->name;
+ return
+ unless $consumed =~ s{^usr/include/}{};
+
+ my @multiarch_folders
+ = values %{$self->data->architectures->deb_host_multiarch};
+
+ for my $tuple (@multiarch_folders) {
+
+ last
+ if $consumed =~ s{^$tuple/}{};
+ }
+
+ $self->pointed_hint('header-has-overly-generic-name', $item->pointer)
+ if any { $consumed =~ m{ $_ }isx } @GENERIC_PATHS;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Init.pm b/lib/Lintian/Check/Files/Init.pm
new file mode 100644
index 0000000..25ff77d
--- /dev/null
+++ b/lib/Lintian/Check/Files/Init.pm
@@ -0,0 +1,79 @@
+# files/init -- 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 https://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::Check::Files::Init;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw(none);
+
+const my $NOT_EQUAL => q{!=};
+
+const my $EXECUTABLE_PERMISSIONS => oct(755);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # /etc/init
+ $self->pointed_hint('package-installs-deprecated-upstart-configuration',
+ $item->pointer)
+ if $item->name =~ m{^etc/init/\S};
+
+ # /etc/init.d
+ $self->pointed_hint(
+ 'non-standard-file-permissions-for-etc-init.d-script',
+ $item->pointer,
+ $item->octal_permissions,
+ $NOT_EQUAL,
+ sprintf('%04o', $EXECUTABLE_PERMISSIONS)
+ )
+ if $item->name =~ m{^etc/init\.d/\S}
+ && $item->name !~ m{^etc/init\.d/(?:README|skeleton)$}
+ && $item->operm != $EXECUTABLE_PERMISSIONS
+ && $item->is_file;
+
+ # /etc/rc.d && /etc/rc?.d
+ $self->pointed_hint('package-installs-into-etc-rc.d', $item->pointer)
+ if $item->name =~ m{^etc/rc(?:\d|S)?\.d/\S}
+ && (none { $self->processable->name eq $_ } qw(sysvinit file-rc))
+ && $self->processable->type ne 'udeb';
+
+ # /etc/rc.boot
+ $self->pointed_hint('package-installs-into-etc-rc.boot', $item->pointer)
+ if $item->name =~ m{^etc/rc\.boot/\S};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/LdSo.pm b/lib/Lintian/Check/Files/LdSo.pm
new file mode 100644
index 0000000..2f0b9c1
--- /dev/null
+++ b/lib/Lintian/Check/Files/LdSo.pm
@@ -0,0 +1,48 @@
+# files/ld-so -- 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 https://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::Check::Files::LdSo;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('package-modifies-ld.so-search-path', $item->pointer)
+ if $item->name =~ m{^etc/ld\.so\.conf\.d/.+$}
+ && $self->processable->name !~ /^libc/;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Licenses.pm b/lib/Lintian/Check/Files/Licenses.pm
new file mode 100644
index 0000000..5ca61e4
--- /dev/null
+++ b/lib/Lintian/Check/Files/Licenses.pm
@@ -0,0 +1,112 @@
+# files/licenses -- 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 https://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::Check::Files::Licenses;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # license files
+ if (
+ $item->basename =~ m{ \A
+ # Look for commonly used names for license files
+ (?: copying | licen[cs]e | l?gpl | bsd | artistic )
+ # ... possibly followed by a version
+ [v0-9._-]*
+ (?:\. .* )? \Z
+ }xsmi
+ # 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 an 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.
+ && !$item->is_executable
+ && $item->name !~ m{ \. (?:
+ # Common "non-license" file extensions...
+ el|[ch]|cc|p[ylmc]|[hu]i|p_hi|html|php|rb|xpm
+ |png|jpe?g|gif|svg|dtd|mk|lisp|yml|rs|ogg|xbm
+ ) \Z}xsm
+ && $item->name !~ m{^usr/share/zope/Products/.*\.(?:dtml|pt|cpt)$}
+ && $item->name !~ m{/under\S+License\.docbook$}
+ && $item->name !~ m{^usr/share/doc/[^/]+/examples/}
+ # liblicense has a manpage called license
+ && $item->name !~ m{^usr/share/man/(?:[^/]+/)?man\d/}
+ # liblicense (again)
+ && $item->name !~ m{^usr/share/pyshared-data/}
+ # Rust crate unmodified upstream sources
+ && $item->name !~ m{^usr/share/cargo/registry/}
+ # Some GNOME/GTK software uses these to show the "license
+ # header".
+ && $item->name !~ m{
+ ^usr/share/(?:gnome/)?help/[^/]+/[^/]+/license\.page$
+ }x
+ # base-files (which is required to ship them)
+ && $item->name !~ m{^usr/share/common-licenses/[^/]+$}
+ && !length($item->link)
+ # Sphinx includes various license files
+ && $item->name !~ m{/_sources/license(?:\.rst)?\.txt$}i
+ ) {
+
+ # 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)
+
+ $self->pointed_hint('extra-license-file', $item->pointer)
+ unless $item->file_type =~ m/^[^,]*\bELF\b/
+ || $item->file_type =~ m/\bcurrent ar archive\b/;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Locales.pm b/lib/Lintian/Check/Files/Locales.pm
new file mode 100644
index 0000000..e645a83
--- /dev/null
+++ b/lib/Lintian/Check/Files/Locales.pm
@@ -0,0 +1,204 @@
+# files/locales -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2013 Niels Thykier <niels@thykier.net>
+# Copyright (C) 2019 Adam D. Barratt <adam@adam-barratt.org.uk>
+# Copyright (C) 2021 Felix Lechner
+#
+# Based in part on a shell script that was:
+# Copyright (C) 2010 Raphael Geissert <atomo64@gmail.com>
+#
+# 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 https://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::Check::Files::Locales;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use JSON::MaybeXS;
+use List::SomeUtils qw(first_value);
+use Path::Tiny;
+
+const my $EMPTY => q{};
+
+const my $ARROW => q{->};
+
+const my $RESERVED => $EMPTY;
+const my $SPECIAL => q{S};
+
+const my %CONFUSING_LANGUAGES => (
+ # Albanian is sq, not al:
+ 'al' => 'sq',
+ # Chinese is zh, not cn:
+ 'cn' => 'zh',
+ # Czech is cs, not cz:
+ 'cz' => 'cs',
+ # Danish is da, not dk:
+ 'dk' => 'da',
+ # Greek is el, not gr:
+ 'gr' => 'el',
+ # Indonesian is id, not in:
+ 'in' => 'id',
+);
+
+const my %CONFUSING_COUNTRIES => (
+ # UK != GB
+ 'en_UK' => 'en_GB',
+);
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has ISO639_3_by_alpha3 => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ local $ENV{LC_ALL} = 'C';
+
+ my $bytes = path('/usr/share/iso-codes/json/iso_639-3.json')->slurp;
+ my $json = decode_json($bytes);
+
+ my %iso639_3;
+ for my $entry (@{$json->{'639-3'}}) {
+
+ my $alpha_3 = $entry->{alpha_3};
+
+ $iso639_3{$alpha_3} = $entry;
+ }
+
+ return \%iso639_3;
+ }
+);
+
+has LOCALE_CODES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ local $ENV{LC_ALL} = 'C';
+
+ my %CODES;
+ for my $entry (values %{$self->ISO639_3_by_alpha3}) {
+
+ my $type = $entry->{type};
+
+ # https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=692548#10
+ next
+ if $type eq $RESERVED || $type eq $SPECIAL;
+
+ # also have two letters, ISO 639-1
+ my $two_letters;
+ $two_letters = $entry->{alpha_2}
+ if exists $entry->{alpha_2};
+
+ $CODES{$two_letters} = $EMPTY
+ if length $two_letters;
+
+ # three letters, ISO 639-2
+ my $three_letters = $entry->{alpha_3};
+
+ # a value indicates that two letters are preferred
+ $CODES{$three_letters} = $two_letters || $EMPTY;
+ }
+
+ return \%CODES;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_dir;
+
+ return
+ unless $item->name =~ m{^ usr/share/locale/ ([^/]+) / $}x;
+
+ my $folder = $1;
+
+ # without encoding
+ my ($with_country) = split(m/[.@]/, $folder);
+
+ # special exception
+ return
+ if $with_country eq 'l10n';
+
+ # without country code
+ my ($two_or_three, $country) = split(m/_/, $with_country);
+
+ $country //= $EMPTY;
+
+ return
+ unless length $two_or_three;
+
+ # check some common language errors
+ if (exists $CONFUSING_LANGUAGES{$two_or_three}) {
+
+ my $fixed = $folder;
+ $fixed =~ s{^ $two_or_three }{$CONFUSING_LANGUAGES{$two_or_three}}x;
+
+ $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder,
+ $ARROW,$fixed);
+ return;
+ }
+
+ # check some common country errors
+ if (exists $CONFUSING_COUNTRIES{$with_country}) {
+
+ my $fixed = $folder;
+ $fixed =~ s{^ $with_country }{$CONFUSING_COUNTRIES{$with_country}}x;
+
+ $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder,
+ $ARROW,$fixed);
+ return;
+ }
+
+ # check known codes
+ if (exists $self->LOCALE_CODES->{$two_or_three}) {
+
+ my $replacement = $self->LOCALE_CODES->{$two_or_three};
+ return
+ unless length $replacement;
+
+ # a value indicates that two letters are preferred
+ my $fixed = $folder;
+ $fixed =~ s{^ $two_or_three }{$replacement}x;
+
+ $self->pointed_hint('incorrect-locale-code', $item->pointer, $folder,
+ $ARROW,$fixed);
+
+ return;
+ }
+
+ $self->pointed_hint('unknown-locale-code', $item->pointer, $folder);
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Missing.pm b/lib/Lintian/Check/Files/Missing.pm
new file mode 100644
index 0000000..4c6eda5
--- /dev/null
+++ b/lib/Lintian/Check/Files/Missing.pm
@@ -0,0 +1,50 @@
+# files/missing -- 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 https://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::Check::Files::Missing;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if ( $item->is_dir
+ && $item->faux) {
+
+ $self->pointed_hint('missing-intermediate-directory', $item->pointer);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/MultiArch.pm b/lib/Lintian/Check/Files/MultiArch.pm
new file mode 100644
index 0000000..5d6a2f0
--- /dev/null
+++ b/lib/Lintian/Check/Files/MultiArch.pm
@@ -0,0 +1,111 @@
+# files/multi-arch -- 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 https://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::Check::Files::MultiArch;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has TRIPLETS => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $DEB_HOST_MULTIARCH= $self->data->architectures->deb_host_multiarch;
+ my %triplets = map { $DEB_HOST_MULTIARCH->{$_} => $_ }
+ keys %{$DEB_HOST_MULTIARCH};
+
+ return \%triplets;
+ }
+);
+
+my %PATH_DIRECTORIES = map { $_ => 1 } qw(
+ bin/ sbin/ usr/bin/ usr/sbin/ usr/games/ );
+
+has has_public_executable => (is => 'rw', default => 0);
+has has_public_shared_library => (is => 'rw', default => 0);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $architecture = $self->processable->fields->value('Architecture');
+ my $multiarch = $self->processable->fields->value('Multi-Arch') || 'no';
+
+ my $DEB_HOST_MULTIARCH= $self->data->architectures->deb_host_multiarch;
+ my $multiarch_dir = $DEB_HOST_MULTIARCH->{$architecture};
+
+ if ( !$item->is_dir
+ && defined $multiarch_dir
+ && $multiarch eq 'foreign'
+ && $item->name =~ m{^usr/lib/\Q$multiarch_dir\E/(.*)$}) {
+
+ my $tail = $1;
+
+ $self->pointed_hint('multiarch-foreign-cmake-file', $item->pointer)
+ if $tail =~ m{^cmake/.+\.cmake$};
+
+ $self->pointed_hint('multiarch-foreign-pkgconfig', $item->pointer)
+ if $tail =~ m{^pkgconfig/[^/]+\.pc$};
+
+ $self->pointed_hint('multiarch-foreign-static-library', $item->pointer)
+ if $tail =~ m{^lib[^/]+\.a$};
+ }
+
+ if (exists($PATH_DIRECTORIES{$item->dirname})) {
+ $self->has_public_executable(1);
+ }
+
+ if ($item->name =~ m{^(?:usr/)?lib/(?:([^/]+)/)?lib[^/]*\.so$}) {
+ $self->has_public_shared_library(1)
+ if (!defined($1) || exists $self->TRIPLETS->{$1});
+ }
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ my $architecture = $self->processable->fields->value('Architecture');
+ my $multiarch = $self->processable->fields->value('Multi-Arch') || 'no';
+
+ $self->hint('multiarch-foreign-shared-library')
+ if $architecture ne 'all'
+ and $multiarch eq 'foreign'
+ and $self->has_public_shared_library
+ and not $self->has_public_executable;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Names.pm b/lib/Lintian/Check/Files/Names.pm
new file mode 100644
index 0000000..a6b022c
--- /dev/null
+++ b/lib/Lintian/Check/Files/Names.pm
@@ -0,0 +1,163 @@
+# files/names -- 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 https://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::Check::Files::Names;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use List::Compare;
+use Unicode::UTF8 qw(valid_utf8);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+my %PATH_DIRECTORIES = map { $_ => 1 } qw(
+ bin/ sbin/ usr/bin/ usr/sbin/ usr/games/ );
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # unusual characters
+ $self->pointed_hint('file-name-ends-in-whitespace', $item->pointer)
+ if $item->name =~ /\s+\z/;
+
+ $self->pointed_hint('star-file', $item->pointer)
+ if $item->name =~ m{/\*\z};
+
+ $self->pointed_hint('hyphen-file', $item->pointer)
+ if $item->name =~ m{/-\z};
+
+ $self->pointed_hint('file-name-contains-wildcard-character',$item->pointer)
+ if $item->name =~ m{[*?]};
+
+ $self->pointed_hint('package-contains-compiled-glib-schema',$item->pointer)
+ if $item->name
+ =~ m{^ usr/share/ glib-[^/]+ /schemas/ gschemas[.]compiled $}x;
+
+ $self->pointed_hint('package-contains-file-in-etc-skel', $item->pointer)
+ if $item->dirname =~ m{^etc/skel/}
+ && $item->basename
+ !~ m{^ [.]bashrc | [.]bash_logout | [.]m?kshrc | [.]profile $}x;
+
+ $self->pointed_hint('package-contains-file-in-usr-share-hal',
+ $item->pointer)
+ if $item->dirname =~ m{^usr/share/hal/};
+
+ $self->pointed_hint('package-contains-icon-cache-in-generic-dir',
+ $item->pointer)
+ if $item->name eq 'usr/share/icons/hicolor/icon-theme.cache';
+
+ $self->pointed_hint('package-contains-python-dot-directory',$item->pointer)
+ if $item->dirname
+ =~ m{^ usr/lib/python[^/]+ / (?:dist|site)-packages / }x
+ && $item->name =~ m{ / [.][^/]+ / }x;
+
+ $self->pointed_hint('package-contains-python-coverage-file',$item->pointer)
+ if $item->basename eq '.coverage';
+
+ $self->pointed_hint('package-contains-python-doctree-file', $item->pointer)
+ if $item->basename =~ m{ [.]doctree (?:[.]gz)? $}x;
+
+ $self->pointed_hint(
+ 'package-contains-python-header-in-incorrect-directory',
+ $item->pointer)
+ if $item->dirname =~ m{^ usr/include/python3[.][01234567]/ }x
+ && $item->name =~ m{ [.]h $}x;
+
+ $self->pointed_hint('package-contains-python-hypothesis-example',
+ $item->pointer)
+ if $item->dirname =~ m{ /[.]hypothesis/examples/ }x;
+
+ $self->pointed_hint('package-contains-python-tests-in-global-namespace',
+ $item->pointer)
+ if $item->name
+ =~ m{^ usr/lib/python[^\/]+ / (?:dist|site)-packages / test_.+[.]py $}x;
+
+ $self->pointed_hint('package-contains-sass-cache-directory',$item->pointer)
+ if $item->name =~ m{ / [.]sass-cache / }x;
+
+ $self->pointed_hint('package-contains-eslint-config-file', $item->pointer)
+ if $item->basename =~ m{^ [.]eslintrc }x;
+
+ $self->pointed_hint('package-contains-npm-ignore-file', $item->pointer)
+ if $item->basename eq '.npmignore';
+
+ if (exists($PATH_DIRECTORIES{$item->dirname})) {
+
+ $self->pointed_hint('file-name-in-PATH-is-not-ASCII', $item->pointer)
+ if $item->basename !~ m{\A [[:ascii:]]++ \Z}xsm;
+
+ $self->pointed_hint('zero-byte-executable-in-path', $item->pointer)
+ if $item->is_regular_file
+ and $item->is_executable
+ and $item->size == 0;
+
+ } elsif (!valid_utf8($item->name)) {
+ $self->pointed_hint('shipped-file-without-utf8-name', $item->pointer);
+ }
+
+ return;
+}
+
+sub source {
+ my ($self) = @_;
+
+ unless ($self->processable->native) {
+
+ my @orig_non_utf8 = grep { !valid_utf8($_->name) }
+ @{$self->processable->orig->sorted_list};
+
+ $self->pointed_hint('upstream-file-without-utf8-name', $_->pointer)
+ for @orig_non_utf8;
+ }
+
+ my @patched = map { $_->name } @{$self->processable->patched->sorted_list};
+ my @orig = map { $_->name } @{$self->processable->orig->sorted_list};
+
+ my $lc= List::Compare->new(\@patched, \@orig);
+ my @created = $lc->get_Lonly;
+
+ my @non_utf8 = grep { !valid_utf8($_) } @created;
+
+ # exclude quilt directory
+ my @maintainer_fault = grep { !m{^.pc/} } @non_utf8;
+
+ if ($self->processable->native) {
+ $self->hint('native-source-file-without-utf8-name', $_)
+ for @maintainer_fault;
+
+ } else {
+ $self->hint('patched-file-without-utf8-name', $_)for @maintainer_fault;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/NonFree.pm b/lib/Lintian/Check/Files/NonFree.pm
new file mode 100644
index 0000000..32e5e7f
--- /dev/null
+++ b/lib/Lintian/Check/Files/NonFree.pm
@@ -0,0 +1,142 @@
+# files/non-free -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::NonFree;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use List::SomeUtils qw(any);
+use Unicode::UTF8 qw(encode_utf8);
+
+const my $MD5SUM_DATA_FIELDS => 5;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub _md5sum_based_lintian_data {
+ my ($self, $filename) = @_;
+
+ my $data = $self->data->load($filename,qr/\s*\~\~\s*/);
+
+ my %md5sum_data;
+
+ for my $md5sum ($data->all) {
+
+ my $value = $data->value($md5sum);
+
+ my ($sha1, $sha256, $name, $reason, $link)
+ = split(/ \s* ~~ \s* /msx, $value, $MD5SUM_DATA_FIELDS);
+
+ die encode_utf8("Syntax error in $filename $.")
+ if any { !defined } ($sha1, $sha256, $name, $reason, $link);
+
+ $md5sum_data{$md5sum} = {
+ 'sha1' => $sha1,
+ 'sha256' => $sha256,
+ 'name' => $name,
+ 'reason' => $reason,
+ 'link' => $link,
+ };
+ }
+
+ return \%md5sum_data;
+}
+
+has NON_FREE_FILES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->_md5sum_based_lintian_data('cruft/non-free-files');
+ }
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ # skip packages that declare non-free contents
+ return
+ if $self->processable->is_non_free;
+
+ my $nonfree = $self->NON_FREE_FILES->{$item->md5sum};
+ if (defined $nonfree) {
+ my $usualname = $nonfree->{'name'};
+ my $reason = $nonfree->{'reason'};
+ my $link = $nonfree->{'link'};
+
+ $self->pointed_hint(
+ 'license-problem-md5sum-non-free-file',
+ $item->pointer, "usual name is $usualname.",
+ $reason, "See also $link."
+ );
+ }
+
+ return;
+}
+
+# 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$,
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ # skip packages that declare non-free contents
+ return
+ if $self->processable->is_non_free;
+
+ # non-free .swf files
+ $self->pointed_hint('non-free-flash', $item->pointer)
+ if any { $item->name =~ m{/$_} } @flash_nonfree;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/ObsoletePaths.pm b/lib/Lintian/Check/Files/ObsoletePaths.pm
new file mode 100644
index 0000000..b1d2ddd
--- /dev/null
+++ b/lib/Lintian/Check/Files/ObsoletePaths.pm
@@ -0,0 +1,92 @@
+# files/obsolete-paths -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2021 Felix Lechner
+#
+# 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 https://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::Check::Files::ObsoletePaths;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Unicode::UTF8 qw(encode_utf8);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has OBSOLETE_PATHS => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %obsolete;
+
+ my $data = $self->data->load('files/obsolete-paths',qr/\s*\->\s*/);
+
+ for my $key ($data->all) {
+
+ my $value = $data->value($key);
+
+ my ($newdir, $moreinfo) = split(/\s*\~\~\s*/, $value, 2);
+
+ $obsolete{$key} = {
+ 'newdir' => $newdir,
+ 'moreinfo' => $moreinfo,
+ 'match' => qr/$key/x,
+ 'olddir' => $key,
+ };
+ }
+
+ return \%obsolete;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # check for generic obsolete path
+ for my $obsolete_path (keys %{$self->OBSOLETE_PATHS}) {
+
+ my $obs_data = $self->OBSOLETE_PATHS->{$obsolete_path};
+ my $oldpathmatch = $obs_data->{'match'};
+
+ if ($item->name =~ m{$oldpathmatch}) {
+
+ my $oldpath = $obs_data->{'olddir'};
+ my $newpath = $obs_data->{'newdir'};
+ my $moreinfo = $obs_data->{'moreinfo'};
+
+ $self->pointed_hint('package-installs-into-obsolete-dir',
+ $item->pointer,": $oldpath -> $newpath", $moreinfo);
+ }
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Openpgp.pm b/lib/Lintian/Check/Files/Openpgp.pm
new file mode 100644
index 0000000..dc421df
--- /dev/null
+++ b/lib/Lintian/Check/Files/Openpgp.pm
@@ -0,0 +1,51 @@
+# files/openpgp -- lintian check script -*- perl -*-
+
+# Copyright (C) 2022 Guillem Jover <guillem@debian.org>
+#
+# 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 https://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::Check::Files::Openpgp;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ $self->pointed_hint('openpgp-file-has-implementation-specific-extension',
+ $item->pointer)
+ if $item->name =~ m{\.gpg$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Ownership.pm b/lib/Lintian/Check/Files/Ownership.pm
new file mode 100644
index 0000000..bbea4b9
--- /dev/null
+++ b/lib/Lintian/Check/Files/Ownership.pm
@@ -0,0 +1,74 @@
+# files/ownership -- 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 https://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::Check::Files::Ownership;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $SLASH => q{/};
+
+const my $MAXIMUM_LOW_RESERVED => 99;
+const my $MAXIMUM_HIGH_RESERVED => 64_999;
+const my $MINIMUM_HIGH_RESERVED => 60_000;
+const my $NOBODY => 65_534;
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->pointed_hint('wrong-file-owner-uid-or-gid', $item->pointer,
+ $item->uid . $SLASH . $item->gid)
+ if out_of_bounds($item->uid)
+ || out_of_bounds($item->gid);
+
+ return;
+}
+
+sub out_of_bounds {
+ my ($id) = @_;
+
+ return 0
+ if $id <= $MAXIMUM_LOW_RESERVED;
+
+ return 0
+ if $id == $NOBODY;
+
+ return 0
+ if $id >= $MINIMUM_HIGH_RESERVED
+ && $id <= $MAXIMUM_HIGH_RESERVED;
+
+ return 1;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/P11Kit.pm b/lib/Lintian/Check/Files/P11Kit.pm
new file mode 100644
index 0000000..a128fa0
--- /dev/null
+++ b/lib/Lintian/Check/Files/P11Kit.pm
@@ -0,0 +1,54 @@
+# files/p11-kit -- 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 https://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::Check::Files::P11Kit;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if (
+ $item->name =~ m{^usr/share/p11-kit/modules/.}
+ && $item->name !~ m{\A usr/share/p11-kit/modules/
+ [[:alnum:]][[:alnum:]_.-]*\.module\Z
+ }xsm
+ ) {
+ $self->pointed_hint('incorrect-naming-of-pkcs11-module',
+ $item->pointer);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Pam.pm b/lib/Lintian/Check/Files/Pam.pm
new file mode 100644
index 0000000..c02cd4b
--- /dev/null
+++ b/lib/Lintian/Check/Files/Pam.pm
@@ -0,0 +1,50 @@
+# files/pam -- 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 https://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::Check::Files::Pam;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # /etc/pam.conf
+ $self->pointed_hint('config-file-reserved', $item->pointer,
+ 'by libpam-runtime')
+ if $item->name =~ m{^etc/pam.conf$}
+ && $self->processable->name ne 'libpam-runtime';
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Permissions.pm b/lib/Lintian/Check/Files/Permissions.pm
new file mode 100644
index 0000000..30cff5b
--- /dev/null
+++ b/lib/Lintian/Check/Files/Permissions.pm
@@ -0,0 +1,249 @@
+# files/permissions -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Permissions;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Path::Tiny;
+
+const my $NOT_EQUAL => q{!=};
+
+const my $STANDARD_EXECUTABLE => oct(755);
+const my $SETGID_EXECUTABLE => oct(4754);
+const my $SET_USER_ID => oct(4000);
+const my $SET_GROUP_ID => oct(2000);
+
+const my $STANDARD_FILE => oct(644);
+const my $BACKUP_NINJA_FILE => oct(600);
+const my $SUDOERS_FILE => oct(440);
+const my $GAME_DATA => oct(664);
+
+const my $STANDARD_FOLDER => oct(755);
+const my $GAME_FOLDER => oct(2775);
+const my $VAR_LOCAL_FOLDER => oct(2775);
+const my $VAR_LOCK_FOLDER => oct(1777);
+const my $USR_SRC_FOLDER => oct(2775);
+
+const my $WORLD_READABLE => oct(444);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has component => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return path($self->processable->path)->basename;
+ }
+);
+
+has linked_against_libvga => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %linked_against_libvga;
+
+ for my $item (@{$self->processable->installed->sorted_list}) {
+
+ for my $library (@{$item->elf->{NEEDED} // []}){
+
+ $linked_against_libvga{$item->name} = 1
+ if $library =~ m{^ libvga[.]so[.] }x;
+ }
+ }
+
+ return \%linked_against_libvga;
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if ($item->is_file) {
+
+ if (
+ $item->is_executable
+ && $item->identity eq 'root/games'
+ && ( !$item->is_setgid
+ || !$item->all_bits_set($STANDARD_EXECUTABLE))
+ ) {
+
+ $self->pointed_hint(
+ 'non-standard-game-executable-perm',
+ $item->pointer,
+ $item->octal_permissions,
+ $NOT_EQUAL,
+ sprintf('%04o', $SET_GROUP_ID | $STANDARD_EXECUTABLE)
+ );
+
+ return;
+ }
+
+ $self->pointed_hint('executable-is-not-world-readable',
+ $item->pointer, $item->octal_permissions)
+ if $item->is_executable
+ && !$item->all_bits_set($WORLD_READABLE);
+
+ if ($item->is_setuid || $item->is_setgid) {
+
+ $self->pointed_hint('non-standard-setuid-executable-perm',
+ $item->pointer, $item->octal_permissions)
+ unless (($item->operm & ~($SET_USER_ID | $SET_GROUP_ID))
+ == $STANDARD_EXECUTABLE)
+ || $item->operm == $SETGID_EXECUTABLE;
+ }
+
+ # allow anything with suid in the name
+ return
+ if ($item->is_setuid || $item->is_setgid)
+ && $self->processable->name =~ / -suid /msx;
+
+ # program is using svgalib
+ return
+ if $item->is_setuid
+ && !$item->is_setgid
+ && $item->owner eq 'root'
+ && exists $self->linked_against_libvga->{$item->name};
+
+ # program is a setgid game
+ return
+ if $item->is_setgid
+ && !$item->is_setuid
+ && $item->group eq 'games'
+ && $item->name =~ m{^ usr/ (?:lib/)? games/ \S+ }msx;
+
+ if ($item->is_setuid || $item->is_setgid) {
+ $self->pointed_hint(
+ 'elevated-privileges', $item->pointer,
+ $item->octal_permissions, $item->identity
+ );
+
+ return;
+ }
+
+ if ( $item->is_executable
+ && $item->operm != $STANDARD_EXECUTABLE) {
+
+ $self->pointed_hint('non-standard-executable-perm',
+ $item->pointer, $item->octal_permissions, $NOT_EQUAL,
+ sprintf('%04o', $STANDARD_EXECUTABLE));
+
+ return;
+ }
+
+ if (!$item->is_executable) {
+
+ # game data
+ return
+ if $item->operm == $GAME_DATA
+ && $item->identity eq 'root/games'
+ && $item->name =~ m{^ var/ (?:lib/)? games/ \S+ }msx;
+
+ # GNAT compiler wants read-only Ada library information.
+ if ( $item->name =~ m{^ usr/lib/ .* [.]ali $}msx
+ && $item->operm != $WORLD_READABLE) {
+
+ $self->pointed_hint('bad-permissions-for-ali-file',
+ $item->pointer);
+
+ return;
+ }
+
+ # backupninja expects configurations files to be oct(600)
+ return
+ if $item->operm == $BACKUP_NINJA_FILE
+ && $item->name =~ m{^ etc/backup.d/ }msx;
+
+ if ($item->name =~ m{^ etc/sudoers.d/ }msx) {
+
+ # sudo requires sudoers files to be mode oct(440)
+ $self->pointed_hint(
+ 'bad-perm-for-file-in-etc-sudoers.d',$item->pointer,
+ $item->octal_permissions, $NOT_EQUAL,
+ sprintf('%04o', $SUDOERS_FILE)
+ )unless $item->operm == $SUDOERS_FILE;
+
+ return;
+ }
+
+ $self->pointed_hint(
+ 'non-standard-file-perm', $item->pointer,
+ $item->octal_permissions, $NOT_EQUAL,
+ sprintf('%04o', $STANDARD_FILE)
+ )unless $item->operm == $STANDARD_FILE;
+ }
+
+ }
+
+ if ($item->is_dir) {
+
+ # game directory with setgid bit
+ return
+ if $item->operm == $GAME_FOLDER
+ && $item->identity eq 'root/games'
+ && $item->name =~ m{^ var/ (?:lib/)? games/ \S+ }msx;
+
+ # shipping files here triggers warnings elsewhere
+ return
+ if $item->operm == $VAR_LOCK_FOLDER
+ && $item->identity eq 'root/root'
+ && ( $item->name =~ m{^ (?:var/)? tmp/ }msx
+ || $item->name eq 'var/lock/');
+
+ # shipping files here triggers warnings elsewhere
+ return
+ if $item->operm == $VAR_LOCAL_FOLDER
+ && $item->identity eq 'root/staff'
+ && $item->name eq 'var/local/';
+
+ # /usr/src created by base-files
+ return
+ if $item->operm == $USR_SRC_FOLDER
+ && $item->identity eq 'root/src'
+ && $item->name eq 'usr/src/';
+
+ $self->pointed_hint(
+ 'non-standard-dir-perm', $item->pointer,
+ $item->octal_permissions, $NOT_EQUAL,
+ sprintf('%04o', $STANDARD_FOLDER)
+ )unless $item->operm == $STANDARD_FOLDER;
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Permissions/UsrLib.pm b/lib/Lintian/Check/Files/Permissions/UsrLib.pm
new file mode 100644
index 0000000..e465310
--- /dev/null
+++ b/lib/Lintian/Check/Files/Permissions/UsrLib.pm
@@ -0,0 +1,54 @@
+# files/permissions/usr-lib -- lintian check script -*- perl -*-
+
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Permissions::UsrLib;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # see Bug#959037 for details
+ return
+ if $self->processable->type eq 'udeb';
+
+ return
+ unless $item->name =~ m{^usr/lib/};
+
+ $self->pointed_hint('executable-in-usr-lib', $item->pointer)
+ if $item->is_file && $item->is_executable;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Pkgconfig.pm b/lib/Lintian/Check/Files/Pkgconfig.pm
new file mode 100644
index 0000000..b2d555b
--- /dev/null
+++ b/lib/Lintian/Check/Files/Pkgconfig.pm
@@ -0,0 +1,121 @@
+# files/pkgconfig -- 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 https://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::Check::Files::Pkgconfig;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Unicode::UTF8 qw(encode_utf8);
+
+use Lintian::SlidingWindow;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+
+has PKG_CONFIG_BAD_REGEX => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ return $self->data->load('files/pkg-config-bad-regex',qr/~~~~~/);
+ }
+);
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $architecture = $self->processable->fields->value('Architecture');
+
+ # arch-indep pkgconfig
+ if ( $item->is_regular_file
+ && $item->name=~ m{^usr/(lib(/[^/]+)?|share)/pkgconfig/[^/]+\.pc$}){
+
+ my $prefix = $1;
+ my $pkg_config_arch = $2 // $EMPTY;
+ $pkg_config_arch =~ s{\A/}{}ms;
+
+ $self->pointed_hint('pkg-config-unavailable-for-cross-compilation',
+ $item->pointer)
+ if $prefix eq 'lib';
+
+ open(my $fd, '<:raw', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $sfd = Lintian::SlidingWindow->new;
+ $sfd->handle($fd);
+
+ BLOCK:
+ while (my $block = $sfd->readwindow) {
+ # remove comment line
+ $block =~ s/\#\V*//gsm;
+ # remove continuation line
+ $block =~ s/\\\n/ /gxsm;
+ # check if pkgconfig file include path point to
+ # arch specific dir
+
+ my $DEB_HOST_MULTIARCH
+ = $self->data->architectures->deb_host_multiarch;
+ for my $madir (values %{$DEB_HOST_MULTIARCH}) {
+
+ next
+ if $pkg_config_arch eq $madir;
+
+ if ($block =~ m{\W\Q$madir\E(\W|$)}xms) {
+
+ $self->pointed_hint('pkg-config-multi-arch-wrong-dir',
+ $item->pointer,
+ 'full text contains architecture specific dir',$madir);
+
+ last;
+ }
+ }
+
+ for my $pattern ($self->PKG_CONFIG_BAD_REGEX->all) {
+
+ while($block =~ m{$pattern}xmsg) {
+
+ my $context = $1;
+
+ $self->pointed_hint('pkg-config-bad-directive',
+ $item->pointer,$context);
+ }
+ }
+ }
+ close($fd);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/PrivacyBreach.pm b/lib/Lintian/Check/Files/PrivacyBreach.pm
new file mode 100644
index 0000000..8d75623
--- /dev/null
+++ b/lib/Lintian/Check/Files/PrivacyBreach.pm
@@ -0,0 +1,420 @@
+# files/privacy-breach -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2021 Felix Lechner
+#
+# 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 https://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::Check::Files::PrivacyBreach;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Unicode::UTF8 qw(encode_utf8);
+
+use Lintian::SlidingWindow;
+
+const my $BLOCKSIZE => 16_384;
+const my $EMPTY => q{};
+
+const my $PRIVACY_BREAKER_WEBSITES_FIELDS => 3;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+has PRIVACY_BREAKER_WEBSITES => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %website;
+
+ my $data
+ = $self->data->load('files/privacy-breaker-websites',qr/\s*\~\~/);
+
+ for my $key ($data->all) {
+
+ my $value = $data->value($key);
+
+ my ($pattern, $tag, $suggest)
+ = split(/ \s* ~~ \s* /msx,
+ $value,$PRIVACY_BREAKER_WEBSITES_FIELDS);
+
+ $tag //= $EMPTY;
+
+ # trim both ends
+ $tag =~ s/^\s+|\s+$//g;
+
+ $tag = $key
+ unless length $tag;
+
+ $website{$key} = {
+ 'tag' => $tag,
+ 'regexp' => qr/$pattern/xsm,
+ };
+
+ $website{$key}{'suggest'} = $suggest
+ if defined $suggest;
+ }
+
+ return \%website;
+ }
+);
+
+has PRIVACY_BREAKER_FRAGMENTS => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %fragment;
+
+ my $data
+ = $self->data->load('files/privacy-breaker-fragments',qr/\s*\~\~/);
+
+ for my $key ($data->all) {
+
+ my $value = $data->value($key);
+
+ my ($pattern, $tag) = split(/\s*\~\~\s*/, $value, 2);
+
+ $fragment{$key} = {
+ 'keyword' => $key,
+ 'regex' => qr/$pattern/xsm,
+ 'tag' => $tag,
+ };
+ }
+
+ return \%fragment;
+ }
+);
+
+has PRIVACY_BREAKER_TAG_ATTR => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my %attribute;
+
+ my $data
+ = $self->data->load('files/privacy-breaker-tag-attr',qr/\s*\~\~\s*/);
+
+ for my $key ($data->all) {
+
+ my $value = $data->value($key);
+
+ my ($keywords,$pattern) = split(/\s*\~\~\s*/, $value, 2);
+
+ $pattern =~ s/&URL/(?:(?:ht|f)tps?:)?\/\/[^"\r\n]*/g;
+
+ my @keywordlist;
+
+ my @keywordsorraw = split(/\s*\|\|\s*/,$keywords);
+
+ for my $keywordor (@keywordsorraw) {
+ my @keywordsandraw = split(/\s*&&\s*/,$keywordor);
+ push(@keywordlist, \@keywordsandraw);
+ }
+
+ $attribute{$key} = {
+ 'keywords' => \@keywordlist,
+ 'regex' => qr/$pattern/xsm,
+ };
+ }
+
+ return \%attribute;
+ }
+);
+
+sub detect_privacy_breach {
+ my ($self, $file) = @_;
+
+ my %privacybreachhash;
+
+ return
+ unless $file->is_regular_file;
+
+ open(my $fd, '<:raw', $file->unpacked_path)
+ or die encode_utf8('Cannot open ' . $file->unpacked_path);
+
+ my $sfd = Lintian::SlidingWindow->new;
+ $sfd->handle($fd);
+ $sfd->blocksize($BLOCKSIZE);
+ $sfd->blocksub(sub { $_ = lc; });
+
+ while (my $lowercase = $sfd->readwindow) {
+ # strip comments
+ for my $x (qw(<!--(?!\[if).*?--\s*> /\*(?!@cc_on).*?\*/)) {
+ $lowercase =~ s/$x//gs;
+ }
+
+ # keep sorted; otherwise 'exists' below produces inconsistent output
+ for my $keyword (sort keys %{$self->PRIVACY_BREAKER_FRAGMENTS}) {
+
+ if ($lowercase =~ / \Q$keyword\E /msx) {
+ my $keyvalue= $self->PRIVACY_BREAKER_FRAGMENTS->{$keyword};
+ my $regex = $keyvalue->{'regex'};
+
+ if ($lowercase =~ m{($regex)}) {
+ my $capture = $1;
+ my $breaker_tag = $keyvalue->{'tag'};
+
+ unless (exists $privacybreachhash{'tag-'.$breaker_tag}){
+
+ $privacybreachhash{'tag-'.$breaker_tag} = 1;
+
+ $self->pointed_hint($breaker_tag, $file->pointer,
+ "(choke on: $capture)");
+ }
+ }
+ }
+ }
+
+ for my $x (
+ qw(src="http src="ftp src="// data-href="http data-href="ftp
+ data-href="// codebase="http codebase="ftp codebase="// data="http
+ data="ftp data="// poster="http poster="ftp poster="// <link @import)
+ ) {
+ next
+ unless $lowercase =~ / \Q$x\E /msx;
+
+ $self->detect_generic_privacy_breach($lowercase,
+ \%privacybreachhash,$file);
+
+ last;
+ }
+ }
+
+ close($fd);
+ return;
+}
+
+# According to html norm src attribute is used by tags:
+#
+# audio(v5+), embed (v5+), iframe (v4), frame, img, input, script, source, track(v5), video (v5)
+# Add other tags with src due to some javascript code:
+# div due to div.js
+# div data-href due to jquery
+# css with @import
+sub detect_generic_privacy_breach {
+ my ($self, $block, $privacybreachhash, $file) = @_;
+ my %matchedkeyword;
+
+ # now check generic tag
+ TYPE:
+ for my $type (sort keys %{$self->PRIVACY_BREAKER_TAG_ATTR}) {
+ my $keyvalue = $self->PRIVACY_BREAKER_TAG_ATTR->{$type};
+ my $keywords = $keyvalue->{'keywords'};
+
+ my $orblockok = 0;
+ ORBLOCK:
+ for my $keywordor (@{$keywords}) {
+ ANDBLOCK:
+ for my $keyword (@{$keywordor}) {
+
+ my $thiskeyword = $matchedkeyword{$keyword};
+ if(!defined($thiskeyword)) {
+ if ($block =~ / \Q$keyword\E /msx) {
+ $matchedkeyword{$keyword} = 1;
+ $orblockok = 1;
+ }else {
+ $matchedkeyword{$keyword} = 0;
+ $orblockok = 0;
+ next ORBLOCK;
+ }
+ }
+ if($matchedkeyword{$keyword} == 0) {
+ $orblockok = 0;
+ next ORBLOCK;
+ }else {
+ $orblockok = 1;
+ }
+ }
+ if($orblockok == 1) {
+ last ORBLOCK;
+ }
+ }
+ if($orblockok == 0) {
+ next TYPE;
+ }
+
+ my $regex = $keyvalue->{'regex'};
+
+ while($block=~m{$regex}g){
+ $self->check_tag_url_privacy_breach($1, $2, $3,$privacybreachhash,
+ $file);
+ }
+ }
+ return;
+}
+
+sub is_localhost {
+ my ($urlshort) = @_;
+ if( $urlshort =~ m{^(?:[^/]+@)?localhost(?:[:][^/]+)?/}i
+ || $urlshort =~ m{^(?:[^/]+@)?::1(?:[:][^/]+)?/}i
+ || $urlshort =~ m{^(?:[^/]+@)?127(?:\.\d{1,3}){3}(?:[:][^/]+)?/}i) {
+ return 1;
+ }else {
+ return 0;
+ }
+}
+
+sub check_tag_url_privacy_breach {
+ my ($self, $fulltag, $tagattr, $url,$privacybreachhash, $file) = @_;
+
+ my $website = $url;
+ # detect also "^//" trick
+ $website =~ s{^"?(?:(?:ht|f)tps?:)?//}{};
+ $website =~ s/"?$//;
+
+ if (is_localhost($website)){
+ # do nothing ok
+ return;
+ }
+
+ # reparse fulltag for rel
+ if ($tagattr eq 'link') {
+
+ my $rel = $fulltag;
+ $rel =~ m{<link
+ (?:\s[^>]+)? \s+
+ rel="([^"\r\n]*)"
+ [^>]*
+ >}xismog;
+ my $relcontent = $1;
+
+ if (defined($relcontent)) {
+ # See, for example, https://www.w3schools.com/tags/att_link_rel.asp
+ my %allowed = (
+ 'alternate' => 1, # #891301
+ 'author' => 1, # #891301
+ 'bookmark' => 1, # #746656
+ 'canonical' => 1, # #762753
+ 'copyright' => 1, # #902919
+ 'edituri' => 1, # #902919
+ 'generator' => 1, # #891301
+ 'generator-home' => 1, # texinfo
+ 'help' => 1, # #891301
+ 'license' => 1, # #891301
+ 'next' => 1, # #891301
+ 'prev' => 1, # #891301
+ 'schema.dct' => 1, # #736992
+ 'search' => 1, # #891301
+ );
+
+ return
+ if ($allowed{$relcontent});
+
+ if ($relcontent eq 'alternate') {
+ my $type = $fulltag;
+ $type =~ m{<link
+ (?:\s[^>]+)? \s+
+ type="([^"\r\n]*)"
+ [^>]*
+ >}xismog;
+ my $typecontent = $1;
+ if($typecontent eq 'application/rdf+xml') {
+ # see #79991
+ return;
+ }
+ }
+ }
+ }
+
+ # False positive
+ # legal.xml file of gnome
+ # could be replaced by a link to local file but not really a privacy breach
+ if( $file->basename eq 'legal.xml'
+ && $tagattr eq 'link'
+ && $website =~ m{^creativecommons.org/licenses/}) {
+
+ return;
+ }
+
+ # In Mallard XML, <link> is a clickable anchor that will not be
+ # followed automatically.
+ if( $file->basename =~ '.xml$'
+ && $tagattr eq 'link'
+ && $file->bytes=~ qr{ xmlns="http://projectmallard\.org/1\.0/"}) {
+
+ return;
+ }
+
+ # track well known site
+ for my $breaker (sort keys %{$self->PRIVACY_BREAKER_WEBSITES}) {
+
+ my $value = $self->PRIVACY_BREAKER_WEBSITES->{$breaker};
+ my $regex = $value->{'regexp'};
+
+ if ($website =~ m{$regex}mxs) {
+
+ unless (exists $privacybreachhash->{'tag-'.$breaker}) {
+
+ my $tag = $value->{'tag'};
+ my $suggest = $value->{'suggest'} // $EMPTY;
+
+ $privacybreachhash->{'tag-'.$breaker}= 1;
+ $self->pointed_hint($tag, $file->pointer, $suggest, "($url)");
+ }
+
+ # do not go to generic case
+ return;
+ }
+ }
+
+ # generic case
+ unless (exists $privacybreachhash->{'tag-generic-'.$website}){
+
+ $self->pointed_hint('privacy-breach-generic', $file->pointer,
+ "[$fulltag]","($url)");
+ $privacybreachhash->{'tag-generic-'.$website} = 1;
+ }
+
+ return;
+}
+
+sub visit_installed_files {
+ my ($self, $file) = @_;
+
+ # html/javascript
+ if ( $file->is_file
+ && $file->name =~ m/\.(?:x?html?\d?|js|xht|xml|css)$/i) {
+
+ if( $self->processable->source_name eq 'josm'
+ and $file->basename eq 'defaultpresets.xml') {
+ # false positive
+
+ } else {
+ $self->detect_privacy_breach($file);
+ }
+ }
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Scripts.pm b/lib/Lintian/Check/Files/Scripts.pm
new file mode 100644
index 0000000..3dff34e
--- /dev/null
+++ b/lib/Lintian/Check/Files/Scripts.pm
@@ -0,0 +1,57 @@
+# files/scripts -- 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 https://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::Check::Files::Scripts;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ # language extensions
+ if (
+ $item->name =~ m{\A
+ (?:usr/)?(?:s?bin|games)/[^/]+\.
+ (?:p[ly]|php|rb|[bc]?sh|tcl)
+ \Z}xsm
+ ) {
+ $self->pointed_hint('script-with-language-extension', $item->pointer);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Sgml.pm b/lib/Lintian/Check/Files/Sgml.pm
new file mode 100644
index 0000000..fd4ace2
--- /dev/null
+++ b/lib/Lintian/Check/Files/Sgml.pm
@@ -0,0 +1,48 @@
+# files/sgml -- 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 https://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::Check::Files::Sgml;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ # /usr/lib/sgml
+ $self->pointed_hint('file-in-usr-lib-sgml', $item->pointer)
+ if $item->name =~ m{^usr/lib/sgml/\S};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/SourceMissing.pm b/lib/Lintian/Check/Files/SourceMissing.pm
new file mode 100644
index 0000000..6ae9f03
--- /dev/null
+++ b/lib/Lintian/Check/Files/SourceMissing.pm
@@ -0,0 +1,286 @@
+# files/source-missing -- lintian check script -*- perl -*-
+#
+# based on debhelper check,
+# Copyright (C) 1999 Joey Hess
+# Copyright (C) 2000 Sean 'Shaleh' Perry
+# Copyright (C) 2002 Josip Rodin
+# Copyright (C) 2007 Russ Allbery
+# Copyright (C) 2013-2018 Bastien ROUCARIES
+# Copyright (C) 2017-2020 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020-2021 Felix Lechner
+#
+# 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 https://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::Check::Files::SourceMissing;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use File::Basename qw(basename);
+use List::SomeUtils qw(first_value);
+use List::UtilsBy qw(max_by);
+
+# very long line lengths
+const my $VERY_LONG_LINE_LENGTH => 512;
+
+const my $EMPTY => q{};
+const my $DOLLAR => q{$};
+const my $DOT => q{.};
+const my $DOUBLE_DOT => q{..};
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ return
+ if $item->dirname =~ m{^debian/missing-sources/};
+
+ # prebuilt-file or forbidden file type
+ $self->pointed_hint('source-contains-prebuilt-wasm-binary', $item->pointer)
+ if $item->file_type =~ m{^WebAssembly \s \(wasm\) \s binary \s module}x;
+
+ $self->pointed_hint('source-contains-prebuilt-windows-binary',
+ $item->pointer)
+ if $item->file_type
+ =~ m{\b(?:PE(?:32|64)|(?:MS-DOS|COM)\s executable)\b}x;
+
+ $self->pointed_hint('source-contains-prebuilt-silverlight-object',
+ $item->pointer)
+ if $item->file_type =~ m{^Zip \s archive \s data}x
+ && $item->name =~ m{(?i)\.xac$}x;
+
+ if ($item->file_type =~ m{^python \s \d(\.\d+)? \s byte-compiled}x) {
+
+ $self->pointed_hint('source-contains-prebuilt-python-object',
+ $item->pointer);
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item,
+ {'.py' => '(?i)(?:\.cpython-\d{2}|\.pypy)?\.py[co]$'});
+ }
+
+ if ($item->file_type =~ m{\bELF\b}x) {
+ $self->pointed_hint('source-contains-prebuilt-binary', $item->pointer);
+
+ my %patterns = map {
+ $_ =>
+'(?i)(?:[\.-](?:bin|elf|e|hs|linux\d+|oo?|or|out|so(?:\.\d+)*)|static|_o\.golden)?$'
+ } qw(.asm .c .cc .cpp .cxx .f .F .i .ml .rc .S);
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item, \%patterns);
+ }
+
+ if ($item->file_type =~ m{^Macromedia \s Flash}x) {
+
+ $self->pointed_hint('source-contains-prebuilt-flash-object',
+ $item->pointer);
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item, {'.as' => '(?i)\.swf$'});
+ }
+
+ if ( $item->file_type =~ m{^Composite \s Document \s File}x
+ && $item->name =~ m{(?i)\.fla$}x) {
+
+ $self->pointed_hint('source-contains-prebuilt-flash-project',
+ $item->pointer);
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item, {'.as' => '(?i)\.fla$'});
+ }
+
+ # see #745152
+ # Be robust check also .js
+ if ($item->basename eq 'deployJava.js') {
+ if (
+ lc $item->decoded_utf8
+ =~ m/(?:\A|\v)\s*var\s+deployJava\s*=\s*function/xmsi) {
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item,
+ {'.txt' => '(?i)\.js$', $EMPTY => $EMPTY});
+
+ return;
+ }
+ }
+
+ # do not forget to change also $JS_EXT in file.pm
+ if ($item->name
+ =~ m{(?i)[-._](?:compiled|compressed|lite|min|pack(?:ed)?|prod|umd|yc)\.js$}x
+ ) {
+
+ $self->pointed_hint('source-contains-prebuilt-javascript-object',
+ $item->pointer);
+ my %patterns = map {
+ $_ =>
+'(?i)(?:[-._](?:compiled|compressed|lite|min|pack(?:ed)?|prod|umd|yc))?\.js$'
+ } qw(.js _orig.js .js.orig .src.js -src.js .debug.js -debug.js -nc.js);
+
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item, \%patterns);
+
+ return;
+ }
+
+ my @lines = split(/\n/, $item->bytes);
+ my %line_length;
+ my %semicolon_count;
+
+ my $position = 1;
+ for my $line (@lines) {
+
+ $line_length{$position} = length $line;
+ $semicolon_count{$position} = ($line =~ tr/;/;/);
+
+ } continue {
+ ++$position;
+ }
+
+ my $longest = max_by { $line_length{$_} } keys %line_length;
+ my $most = max_by { $semicolon_count{$_} } keys %semicolon_count;
+
+ return
+ if !defined $longest || $line_length{$longest} <= $VERY_LONG_LINE_LENGTH;
+
+ if ($item->basename =~ m{\.js$}i) {
+
+ $self->pointed_hint('source-contains-prebuilt-javascript-object',
+ $item->pointer);
+
+ # Check for missing source. It will check
+ # for the source file in well known directories
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source(
+ $item,
+ {
+ '.debug.js' => '(?i)\.js$',
+ '-debug.js' => '(?i)\.js$',
+ $EMPTY => $EMPTY
+ }
+ );
+ }
+
+ if ($item->basename =~ /\.(?:x?html?\d?|xht)$/i) {
+
+ # html file
+ $self->pointed_hint('source-is-missing', $item->pointer)
+ unless $self->find_source($item, {'.fragment.js' => $DOLLAR});
+ }
+
+ return;
+}
+
+sub find_source {
+ my ($self, $item, $patternref) = @_;
+
+ $patternref //= {};
+
+ return undef
+ unless $item->is_regular_file;
+
+ return undef
+ if $self->processable->is_non_free;
+
+ my %patterns = %{$patternref};
+
+ my @alternatives;
+ for my $replacement (keys %patterns) {
+
+ my $newname = $item->basename;
+
+ # empty pattern would repeat the last regex compiled
+ my $pattern = $patterns{$replacement};
+ $newname =~ s/$pattern/$replacement/
+ if length $pattern;
+
+ push(@alternatives, $newname)
+ if length $newname;
+ }
+
+ my $index = $self->processable->patched;
+ my @candidates;
+
+ # add standard locations
+ push(@candidates,
+ $index->resolve_path('debian/missing-sources/' . $item->name));
+ push(@candidates,
+ $index->resolve_path('debian/missing-sources/' . $item->basename));
+
+ my $dirname = $item->dirname;
+ my $parentname = basename($dirname);
+
+ my @absolute = (
+ # libtool
+ '.libs',
+ ".libs/$dirname",
+ # mathjax
+ 'unpacked',
+ # for missing source set in debian
+ 'debian',
+ 'debian/missing-sources',
+ "debian/missing-sources/$dirname"
+ );
+
+ for my $absolute (@absolute) {
+ push(@candidates, $index->resolve_path("$absolute/$_"))
+ for @alternatives;
+ }
+
+ my @relative = (
+ # likely in current dir
+ $DOT,
+ # for binary object built by libtool
+ $DOUBLE_DOT,
+ # maybe in src subdir
+ './src',
+ # maybe in ../src subdir
+ '../src',
+ "../../src/$parentname",
+ # emscripten
+ './flash-src/src/net/gimite/websocket',
+ );
+
+ for my $relative (@relative) {
+ push(@candidates, $item->resolve_path("$relative/$_"))
+ for @alternatives;
+ }
+
+ my @found = grep { defined } @candidates;
+
+ # careful with behavior around empty arrays
+ my $source = first_value { $_->name ne $item->name } @found;
+
+ return $source;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Special.pm b/lib/Lintian/Check/Files/Special.pm
new file mode 100644
index 0000000..7a59006
--- /dev/null
+++ b/lib/Lintian/Check/Files/Special.pm
@@ -0,0 +1,50 @@
+# files/special -- 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 https://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::Check::Files::Special;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ if $item->is_file || $item->is_dir || $item->is_symlink;
+
+ $self->pointed_hint('special-file', $item->pointer,
+ sprintf('%04o',$item->operm));
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/SymbolicLinks.pm b/lib/Lintian/Check/Files/SymbolicLinks.pm
new file mode 100644
index 0000000..0edcde2
--- /dev/null
+++ b/lib/Lintian/Check/Files/SymbolicLinks.pm
@@ -0,0 +1,229 @@
+# files/symbolic-links -- 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 https://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::Check::Files::SymbolicLinks;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $SLASH => q{/};
+const my $DOT => q{.};
+const my $DOUBLE_DOT => q{..};
+const my $VERTICAL_BAR => q{|};
+const my $ARROW => q{->};
+
+# an OR (|) regex of all compressed extension
+has COMPRESS_FILE_EXTENSIONS_OR_ALL => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my $COMPRESS_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my $text = join($VERTICAL_BAR,
+ (map { quotemeta } $COMPRESS_FILE_EXTENSIONS->all));
+
+ return qr/$text/;
+ }
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_symlink;
+
+ # absolute links cannot be resolved
+ if ($item->link =~ m{^/}) {
+
+ # allow /dev/null link target for masked systemd service files
+ $self->pointed_hint('absolute-symbolic-link-target-in-source',
+ $item->pointer, $item->link)
+ unless $item->link eq '/dev/null';
+ }
+
+ # some relative links cannot be resolved inside the source
+ $self->pointed_hint('wayward-symbolic-link-target-in-source',
+ $item->pointer, $item->link)
+ unless defined $_->link_normalized || $item->link =~ m{^/};
+
+ return;
+}
+
+sub is_tmp_path {
+ my ($path) = @_;
+
+ return 1
+ if $path =~ m{^tmp/.}
+ || $path =~ m{^(?:var|usr)/tmp/.}
+ || $path =~ m{^/dev/shm/};
+
+ return 0;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_symlink;
+
+ my $mylink = $item->link;
+ $self->pointed_hint('symlink-has-double-slash', $item->pointer,$item->link)
+ if $mylink =~ s{//+}{/}g;
+
+ $self->pointed_hint('symlink-ends-with-slash', $item->pointer, $item->link)
+ if $mylink =~ s{(.)/$}{$1};
+
+ # determine top-level directory of file
+ $item->name =~ m{^/?([^/]*)};
+ my $filetop = $1;
+
+ if ($mylink =~ m{^/([^/]*)}) {
+ my $flinkname = substr($mylink,1);
+ # absolute link, including link to /
+ # determine top-level directory of link
+ my $linktop = $1;
+
+ if ($self->processable->type ne 'udeb' and $filetop eq $linktop) {
+ # absolute links within one toplevel directory are _not_ ok!
+ $self->pointed_hint('absolute-symlink-in-top-level-folder',
+ $item->pointer, $item->link);
+ }
+
+ my $BUILD_PATH_REGEX
+ = $self->data->load('files/build-path-regex',qr/~~~~~/);
+
+ for my $pattern ($BUILD_PATH_REGEX->all) {
+
+ $self->pointed_hint('symlink-target-in-build-tree',
+ $item->pointer, $mylink)
+ if $flinkname =~ m{$pattern}xms;
+ }
+
+ $self->pointed_hint('symlink-target-in-tmp', $item->pointer,$mylink)
+ if is_tmp_path($flinkname);
+
+ # Any other case is already definitely non-recursive
+ $self->pointed_hint('symlink-is-self-recursive', $item->pointer,
+ $item->link)
+ if $mylink eq $SLASH;
+
+ } else {
+ # relative link, we can assume from here that the link
+ # starts nor ends with /
+
+ my @filecomponents = split(m{/}, $item->name);
+ # chop off the name of the symlink
+ pop @filecomponents;
+
+ my @linkcomponents = split(m{/}, $mylink);
+
+ # handle `../' at beginning of $item->link
+ my ($lastpop, $linkcomponent);
+ while ($linkcomponent = shift @linkcomponents) {
+ if ($linkcomponent eq $DOT) {
+ $self->pointed_hint('symlink-contains-spurious-segments',
+ $item->pointer, $item->link)
+ unless $mylink eq $DOT;
+ next;
+ }
+ last if $linkcomponent ne $DOUBLE_DOT;
+ if (@filecomponents) {
+ $lastpop = pop @filecomponents;
+ } else {
+ $self->pointed_hint('symlink-has-too-many-up-segments',
+ $item->pointer, $item->link);
+ goto NEXT_LINK;
+ }
+ }
+
+ if (!defined $linkcomponent) {
+ # After stripping all starting .. components, nothing left
+ $self->pointed_hint('symlink-is-self-recursive', $item->pointer,
+ $item->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) {
+ $self->pointed_hint('lengthy-symlink', $item->pointer,$item->link);
+ }
+
+ unless (@filecomponents) {
+ # we've reached the root directory
+ if ( ($self->processable->type ne 'udeb')
+ && (!defined $linkcomponent)
+ || ($filetop ne $linkcomponent)) {
+
+ # relative link into other toplevel directory.
+ # this hits a relative symbolic link in the root too.
+ $self->pointed_hint('relative-symlink', $item->pointer,
+ $item->link);
+ }
+ }
+
+ # check additional segments for mistakes like `foo/../bar/'
+ foreach (@linkcomponents) {
+ if ($_ eq $DOUBLE_DOT || $_ eq $DOT) {
+ $self->pointed_hint('symlink-contains-spurious-segments',
+ $item->pointer, $item->link);
+ last;
+ }
+ }
+ }
+ NEXT_LINK:
+
+ my $pattern = $self->COMPRESS_FILE_EXTENSIONS_OR_ALL;
+
+ # symlink pointing to a compressed file
+ if ($item->link =~ qr{ [.] ($pattern) \s* $}x) {
+
+ my $extension = $1;
+
+ # symlink has correct extension?
+ $self->pointed_hint('compressed-symlink-with-wrong-ext',
+ $item->pointer, $item->link)
+ unless $item->name =~ qr{[.]$extension\s*$};
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/SymbolicLinks/Broken.pm b/lib/Lintian/Check/Files/SymbolicLinks/Broken.pm
new file mode 100644
index 0000000..39ae2d2
--- /dev/null
+++ b/lib/Lintian/Check/Files/SymbolicLinks/Broken.pm
@@ -0,0 +1,119 @@
+# files/symbolic-links/broken -- lintian check script -*- perl -*-
+#
+# Copyright (C) 2011 Niels Thykier
+#
+# 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 https://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::Check::Files::SymbolicLinks::Broken;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use File::Basename qw(dirname);
+use List::SomeUtils qw(any);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $EMPTY => q{};
+const my $ASTERISK => q{*};
+
+has wildcard_links => (is => 'rw', default => sub{ [] });
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_symlink;
+
+ # target relative to the package root
+ my $path = $item->link_normalized;
+
+ # unresolvable link
+ unless (defined $path) {
+
+ $self->pointed_hint('package-contains-unsafe-symlink', $item->pointer);
+ return;
+ }
+
+ # will always have links to the package root (although
+ # self-recursive and possibly not very useful)
+ return
+ if $path eq $EMPTY;
+
+ # If it contains a "*" it probably a bad
+ # ln -s target/*.so link expansion. We do not bother looking
+ # for other broken symlinks as people keep adding new special
+ # cases and it is not worth it.
+ push(@{$self->wildcard_links}, $item)
+ if index($item->link, $ASTERISK) >= 0;
+
+ return;
+}
+
+sub installable {
+ my ($self) = @_;
+
+ return
+ unless @{$self->wildcard_links};
+
+ # get prerequisites from same source package
+ my @prerequisites
+ = @{$self->group->direct_dependencies($self->processable)};
+
+ for my $item (@{$self->wildcard_links}){
+
+ # target relative to the package root
+ my $path = $item->link_normalized;
+
+ # destination is in the package
+ next
+ if $self->processable->installed->lookup($path)
+ || $self->processable->installed->lookup("$path/");
+
+ # does the link point to any prerequisites in same source package
+ next
+ if
+ any {$_->installed->lookup($path) || $_->installed->lookup("$path/")}
+ @prerequisites;
+
+ # link target
+ my $target = $item->link;
+
+ # strip leading slashes for reporting
+ $target =~ s{^/+}{};
+
+ # nope - not found in any of our direct dependencies. Ergo it is
+ # a broken "ln -s target/*.so link" expansion.
+ $self->pointed_hint('package-contains-broken-symlink-wildcard',
+ $item->pointer, $target);
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Unicode/Trojan.pm b/lib/Lintian/Check/Files/Unicode/Trojan.pm
new file mode 100644
index 0000000..5c4f2e1
--- /dev/null
+++ b/lib/Lintian/Check/Files/Unicode/Trojan.pm
@@ -0,0 +1,134 @@
+# files/unicode/trojan -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2019 Chris Lamb <lamby@debian.org>
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://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::Check::Files::Unicode::Trojan;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Unicode::UTF8 qw(decode_utf8 encode_utf8 valid_utf8);
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+const my $DOUBLE_QUOTE => q{"};
+
+const my %NAMES_BY_CHARACTER => (
+ qq{\N{ARABIC LETTER MARK}} => 'ARABIC LETTER MARK', # U+061C
+ qq{\N{LEFT-TO-RIGHT MARK}} => 'LEFT-TO-RIGHT MARK', # U+200E
+ qq{\N{RIGHT-TO-LEFT MARK}} => 'RIGHT-TO-LEFT MARK', # U+200F
+ qq{\N{LEFT-TO-RIGHT EMBEDDING}} => 'LEFT-TO-RIGHT EMBEDDING', # U+202A
+ qq{\N{RIGHT-TO-LEFT EMBEDDING}} => 'RIGHT-TO-LEFT EMBEDDING', # U+202B
+ qq{\N{POP DIRECTIONAL FORMATTING}} =>'POP DIRECTIONAL FORMATTING', # U+202C
+ qq{\N{LEFT-TO-RIGHT OVERRIDE}} => 'LEFT-TO-RIGHT OVERRIDE', # U+202D
+ qq{\N{RIGHT-TO-LEFT OVERRIDE}} => 'RIGHT-TO-LEFT OVERRIDE', # U+202E
+ qq{\N{LEFT-TO-RIGHT ISOLATE}} => 'LEFT-TO-RIGHT ISOLATE', # U+2066
+ qq{\N{RIGHT-TO-LEFT ISOLATE}} => 'RIGHT-TO-LEFT ISOLATE', # U+2067
+ qq{\N{FIRST STRONG ISOLATE}} => 'FIRST STRONG ISOLATE', # U+2068
+ qq{\N{POP DIRECTIONAL ISOLATE}} => 'POP DIRECTIONAL ISOLATE', # U+2069
+);
+
+sub visit_patched_files {
+ my ($self, $item) = @_;
+
+ $self->check_for_trojan($item);
+
+ return;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ $self->check_for_trojan($item);
+
+ return;
+}
+
+sub check_for_trojan {
+ my ($self, $item) = @_;
+
+ if (valid_utf8($item->name)) {
+
+ my $decoded_name = decode_utf8($item->name);
+
+ # all file names
+ for my $character (keys %NAMES_BY_CHARACTER) {
+
+ $self->pointed_hint(
+ 'unicode-trojan',
+ $item->pointer,
+ 'File name',
+ sprintf('U+%vX', $character),
+ $DOUBLE_QUOTE. $NAMES_BY_CHARACTER{$character}. $DOUBLE_QUOTE
+ ) if $decoded_name =~ m{\Q$character\E};
+ }
+ }
+
+ return
+ unless $item->is_script;
+
+ open(my $fd, '<', $item->unpacked_path)
+ or die encode_utf8('Cannot open ' . $item->unpacked_path);
+
+ my $position = 1;
+ while (my $line = <$fd>) {
+
+ chomp $line;
+
+ next
+ unless valid_utf8($line);
+
+ my $decoded = decode_utf8($line);
+
+ my $pointer = $item->pointer($position);
+
+ for my $character (keys %NAMES_BY_CHARACTER) {
+
+ $self->pointed_hint(
+ 'unicode-trojan',
+ $pointer,
+ 'Contents',
+ sprintf('U+%vX', $character),
+ $DOUBLE_QUOTE. $NAMES_BY_CHARACTER{$character}. $DOUBLE_QUOTE
+ )if $decoded =~ m{\Q$character\E};
+ }
+
+ } continue {
+ ++$position;
+ }
+
+ close $fd;
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Unwanted.pm b/lib/Lintian/Check/Files/Unwanted.pm
new file mode 100644
index 0000000..779e4f5
--- /dev/null
+++ b/lib/Lintian/Check/Files/Unwanted.pm
@@ -0,0 +1,55 @@
+# files/unwanted -- 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 https://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::Check::Files::Unwanted;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ return
+ unless $item->is_file;
+
+ $self->pointed_hint('backup-file-in-package', $item->pointer)
+ if $item->name =~ /~$/
+ || $item->name =~ m{\#[^/]+\#$}
+ || $item->name =~ m{/\.[^/]+\.swp$};
+
+ $self->pointed_hint('nfs-temporary-file-in-package', $item->pointer)
+ if $item->name =~ m{/\.nfs[^/]+$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/UsrMerge.pm b/lib/Lintian/Check/Files/UsrMerge.pm
new file mode 100644
index 0000000..be5a06d
--- /dev/null
+++ b/lib/Lintian/Check/Files/UsrMerge.pm
@@ -0,0 +1,53 @@
+# files/usr-merge -- 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 https://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::Check::Files::UsrMerge;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ my $quotedpath = quotemeta($item->name);
+
+ $self->pointed_hint('package-contains-usr-unmerged-pathnames',
+ $item->pointer)
+ if $item->name =~ m{^(?:bin|sbin|lib.*)/.+$}
+ && !$item->is_symlink
+ && !$item->is_dir
+ && $item->link !~ m{^usr/$quotedpath$};
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/lib/Lintian/Check/Files/Vcs.pm b/lib/Lintian/Check/Files/Vcs.pm
new file mode 100644
index 0000000..2f5b8f5
--- /dev/null
+++ b/lib/Lintian/Check/Files/Vcs.pm
@@ -0,0 +1,113 @@
+# files/vcs -- 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 https://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::Check::Files::Vcs;
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+
+const my $VERTICAL_BAR => q{|};
+
+use Moo;
+use namespace::clean;
+
+with 'Lintian::Check';
+
+# an OR (|) regex of all vcs files
+has VCS_PATTERNS_ORED => (
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+
+ my @vcs_patterns;
+
+ my $COMPRESS_FILE_EXTENSIONS
+ = $self->data->load('files/compressed-file-extensions',qr/\s+/);
+
+ my @quoted_extension_patterns
+ = map { quotemeta } $COMPRESS_FILE_EXTENSIONS->all;
+ my $ored_extension_patterns= ored_patterns(@quoted_extension_patterns);
+
+ my $VCS_CONTROL_PATTERNS
+ = $self->data->load('files/vcs-control-files', qr/\s+/);
+
+ for my $pattern ($VCS_CONTROL_PATTERNS->all) {
+ $pattern =~ s/\$[{]COMPRESS_EXT[}]/(?:$ored_extension_patterns)/g;
+ push(@vcs_patterns, $pattern);
+ }
+
+ my $ored_vcs_patterns = ored_patterns(@vcs_patterns);
+
+ return $ored_vcs_patterns;
+ }
+);
+
+sub ored_patterns {
+ my (@patterns) = @_;
+
+ my @protected = map { "(?:$_)" } @patterns;
+
+ my $ored = join($VERTICAL_BAR, @protected);
+
+ return $ored;
+}
+
+sub visit_installed_files {
+ my ($self, $item) = @_;
+
+ if ($item->is_file) {
+
+ my $pattern = $self->VCS_PATTERNS_ORED;
+
+ $self->pointed_hint('package-contains-vcs-control-file',$item->pointer)
+ if $item->name =~ m{$pattern}x
+ && $item->name !~ m{^usr/share/cargo/registry/};
+
+ if ($item->name =~ m/svn-commit.*\.tmp$/) {
+ $self->pointed_hint('svn-commit-file-in-package', $item->pointer);
+ }
+
+ if ($item->name =~ m/svk-commit.+\.tmp$/) {
+ $self->pointed_hint('svk-commit-file-in-package', $item->pointer);
+ }
+
+ } elsif ($item->is_dir) {
+
+ $self->pointed_hint('package-contains-vcs-control-dir', $item->pointer)
+ if $item->name =~ m{/CVS/?$}
+ || $item->name =~ m{/\.(?:svn|bzr|git|hg)/?$}
+ || $item->name =~ m{/\.arch-ids/?$}
+ || $item->name =~ m{/\{arch\}/?$};
+ }
+
+ return;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et