diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-14 13:42:30 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-14 13:42:30 +0000 |
| commit | 75808db17caf8b960b351e3408e74142f4c85aac (patch) | |
| tree | 7989e9c09a4240248bf4658a22208a0a52d991c4 /lib/Lintian/Check/Files | |
| parent | Initial commit. (diff) | |
| download | lintian-upstream.tar.xz lintian-upstream.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')
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 |