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/Fields | |
| parent | Initial commit. (diff) | |
| download | lintian-75808db17caf8b960b351e3408e74142f4c85aac.tar.xz lintian-75808db17caf8b960b351e3408e74142f4c85aac.zip | |
Adding upstream version 2.117.0.upstream/2.117.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'lib/Lintian/Check/Fields')
46 files changed, 5198 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Fields/Architecture.pm b/lib/Lintian/Check/Fields/Architecture.pm new file mode 100644 index 0000000..caa5814 --- /dev/null +++ b/lib/Lintian/Check/Fields/Architecture.pm @@ -0,0 +1,132 @@ +# fields/architecture -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Architecture; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::Compare; +use List::SomeUtils qw(any); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +has installable_architecture => (is => 'rw', default => $EMPTY); + +sub installable { + my ($self) = @_; + + my @installable_architectures + = $self->processable->fields->trimmed_list('Architecture'); + return + unless @installable_architectures; + + for my $installable_architecture (@installable_architectures) { + $self->hint('arch-wildcard-in-binary-package', + $installable_architecture) + if $self->data->architectures->is_wildcard( + $installable_architecture); + } + + $self->hint('too-many-architectures', (sort @installable_architectures)) + if @installable_architectures > 1; + + my $installable_architecture = $installable_architectures[0]; + + $self->hint('aspell-package-not-arch-all') + if $self->processable->name =~ /^aspell-[a-z]{2}(?:-.*)?$/ + && $installable_architecture ne 'all'; + + $self->hint('documentation-package-not-architecture-independent') + if $self->processable->name =~ /-docs?$/ + && $installable_architecture ne 'all'; + + return; +} + +sub always { + my ($self) = @_; + + my @installable_architectures + = $self->processable->fields->trimmed_list('Architecture'); + for my $installable_architecture (@installable_architectures) { + + $self->hint('unknown-architecture', $installable_architecture) + unless $self->data->architectures->is_release_architecture( + $installable_architecture) + || $self->data->architectures->is_wildcard($installable_architecture) + || $installable_architecture eq 'all' + || ( + $installable_architecture eq 'source' + && ( $self->processable->type eq 'changes' + || $self->processable->type eq 'buildinfo') + ); + } + + # check for magic installable architecture combinations + if (@installable_architectures > 1) { + + my $magic_error = 0; + + if (any { $_ eq 'all' } @installable_architectures) { + $magic_error++ + unless any { $self->processable->type eq $_ } + qw(source changes buildinfo); + } + + my $anylc = List::Compare->new(\@installable_architectures, ['any']); + if ($anylc->get_intersection) { + + my @errorset = $anylc->get_Lonly; + + # Allow 'all' to be present in source packages as well + # (#626775) + @errorset = grep { $_ ne 'all' } @errorset + if any { $self->processable->type eq $_ } + qw(source changes buildinfo); + + $magic_error++ + if @errorset; + } + + $self->hint('magic-arch-in-arch-list') if $magic_error; + } + + 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/Fields/Bugs.pm b/lib/Lintian/Check/Fields/Bugs.pm new file mode 100644 index 0000000..6485650 --- /dev/null +++ b/lib/Lintian/Check/Fields/Bugs.pm @@ -0,0 +1,62 @@ +# fields/bugs -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Bugs; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Bugs'); + + my $bugs = $fields->unfolded_value('Bugs'); + + $self->hint('redundant-bugs-field') + if $bugs =~ m{^debbugs://bugs.debian.org/?$}i; + + $self->hint('bugs-field-does-not-refer-to-debian-infrastructure', $bugs) + unless $bugs =~ m{\.debian\.org} + || $self->processable->name =~ /[-]dbgsym$/; + + 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/Fields/BuiltUsing.pm b/lib/Lintian/Check/Fields/BuiltUsing.pm new file mode 100644 index 0000000..5da9475 --- /dev/null +++ b/lib/Lintian/Check/Fields/BuiltUsing.pm @@ -0,0 +1,72 @@ +# fields/built-using -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::BuiltUsing; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Relation; +use Lintian::Util qw($PKGNAME_REGEX $PKGVERSION_REGEX); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $processable = $self->processable; + + return + unless $processable->fields->declares('Built-Using'); + + my $built_using = $processable->fields->value('Built-Using'); + + my $built_using_rel = Lintian::Relation->new->load($built_using); + $built_using_rel->visit( + sub { + my ($package) = @_; + if ($package !~ /^$PKGNAME_REGEX \(= $PKGVERSION_REGEX\)$/) { + $self->hint('invalid-value-in-built-using-field', $package); + return 1; + } + return 0; + }, + Lintian::Relation::VISIT_OR_CLAUSE_FULL + | Lintian::Relation::VISIT_STOP_FIRST_MATCH + ); + + 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/Fields/ChangedBy.pm b/lib/Lintian/Check/Fields/ChangedBy.pm new file mode 100644 index 0000000..4f58b1b --- /dev/null +++ b/lib/Lintian/Check/Fields/ChangedBy.pm @@ -0,0 +1,66 @@ +# changed-by -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# Copyright (C) 2017-2019 Chris Lamb <lamby@debian.org> +# Copyright (C) 2020 Felix Lechner +# +# This program is free software. It is distributed 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::Fields::ChangedBy; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub changes { + my ($self) = @_; + + # Changed-By is optional in Policy, but if set, must be + # syntactically correct. It's also used by dak. + return + unless $self->processable->fields->declares('Changed-By'); + + my $changed_by = $self->processable->fields->value('Changed-By'); + + my $DERIVATIVE_CHANGED_BY + = $self->data->load('common/derivative-changed-by',qr/\s*~~\s*/); + + for my $regex ($DERIVATIVE_CHANGED_BY->all) { + + next + if $changed_by =~ /$regex/; + + my $explanation = $DERIVATIVE_CHANGED_BY->value($regex); + $self->hint('changed-by-invalid-for-derivative', + $changed_by, "($explanation)"); + } + + 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/Fields/Checksums.pm b/lib/Lintian/Check/Fields/Checksums.pm new file mode 100644 index 0000000..2ea745e --- /dev/null +++ b/lib/Lintian/Check/Fields/Checksums.pm @@ -0,0 +1,53 @@ +# fields/checksums -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Checksums; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $processable = $self->processable; + + $self->hint('no-strong-digests-in-dsc') + unless $processable->fields->declares('Checksums-Sha256'); + + 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/Fields/Deb822.pm b/lib/Lintian/Check/Fields/Deb822.pm new file mode 100644 index 0000000..d68fa6c --- /dev/null +++ b/lib/Lintian/Check/Fields/Deb822.pm @@ -0,0 +1,89 @@ +# fields/deb822 -- 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::Fields::Deb822; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Syntax::Keyword::Try; + +use Lintian::Deb822; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $SECTION => qq{\N{SECTION SIGN}}; + +my @SOURCE_DEB822 = qw(debian/control); + +sub source { + my ($self) = @_; + + for my $location (@SOURCE_DEB822) { + + my $item = $self->processable->patched->resolve_path($location); + return + unless defined $item; + + my $deb822 = Lintian::Deb822->new; + + my @sections; + try { + @sections = $deb822->read_file($item->unpacked_path) + + } catch { + next; + } + + my $count = 1; + for my $section (@sections) { + + for my $field_name ($section->names) { + + my $field_value = $section->value($field_name); + + my $position = $section->position($field_name); + my $pointer = $item->pointer($position); + + $self->pointed_hint('trimmed-deb822-field', $pointer, + $SECTION . $count, + $field_name, $field_value); + } + + } continue { + $count++; + } + } + + 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/Fields/Derivatives.pm b/lib/Lintian/Check/Fields/Derivatives.pm new file mode 100644 index 0000000..4f42765 --- /dev/null +++ b/lib/Lintian/Check/Fields/Derivatives.pm @@ -0,0 +1,88 @@ +# fields/derivatives -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Derivatives; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +const my $HYPHEN => q{-}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +has DERIVATIVE_FIELDS => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my %fields; + + my $data= $self->data->load('fields/derivative-fields',qr/\s*\~\~\s*/); + + for my $key ($data->all) { + + my $value = $data->value($key); + my ($regexp, $explanation) = split(/\s*\~\~\s*/, $value, 2); + $fields{$key} = { + 'regexp' => qr/$regexp/, + 'explanation' => $explanation, + }; + } + + return \%fields; + } +); + +sub source { + my ($self) = @_; + + my $processable = $self->processable; + + for my $field (keys %{$self->DERIVATIVE_FIELDS}) { + + my $val = $processable->fields->value($field) || $HYPHEN; + my $data = $self->DERIVATIVE_FIELDS->{$field}; + + $self->hint('invalid-field-for-derivative', + "$field: $val ($data->{'explanation'})") + if $val !~ m/$data->{'regexp'}/; + } + + 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/Fields/Description.pm b/lib/Lintian/Check/Fields/Description.pm new file mode 100644 index 0000000..9bfd5bc --- /dev/null +++ b/lib/Lintian/Check/Fields/Description.pm @@ -0,0 +1,323 @@ +# fields/description -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz +# +# 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::Fields::Description; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Lintian::Spelling qw(check_spelling check_spelling_picky); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +# Compared to a lower-case string, so it must be all lower-case +const my $DH_MAKE_PERL_TEMPLATE => +'this description was automagically extracted from the module by dh-make-perl'; + +const my $EMPTY => q{}; +const my $SLASH => q{/}; +const my $DOUBLE_COLON => q{::}; + +const my $MAXIMUM_WIDTH => 80; + +sub spelling_tag_emitter { + my ($self, @orig_args) = @_; + return sub { + return $self->hint(@orig_args, @_); + }; +} + +sub installable { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $type = $self->processable->type; + my $processable = $self->processable; + my $group = $self->group; + + my $tabs = 0; + my $template = 0; + my $unindented_list = 0; + + return + unless $processable->fields->declares('Description'); + + my $full_description= $processable->fields->untrimmed_value('Description'); + + $full_description =~ m/^([^\n]*)\n(.*)$/s; + my ($synopsis, $extended) = ($1, $2); + unless (defined $synopsis) { + # The first line will always be completely stripped but + # continuations may have leading whitespace. Therefore we + # have to strip $full_description to restore this property, + # when we use it as a fall-back value of the synopsis. + $synopsis = $full_description; + + # trim both ends + $synopsis =~ s/^\s+|\s+$//g; + + $extended = $EMPTY; + } + + $extended //= $EMPTY; + + if ($synopsis =~ m/^\s*$/) { + $self->hint('description-synopsis-is-empty'); + } else { + if ($synopsis =~ m/^\Q$pkg\E\b/i) { + $self->hint('description-starts-with-package-name'); + } + if ($synopsis =~ m/^(an?|the)\s/i) { + $self->hint('description-synopsis-starts-with-article'); + } + if ($synopsis =~ m/(.*\.)(?:\s*$|\s+\S+)/i) { + $self->hint('synopsis-is-a-sentence',"\"$synopsis\"") + unless $1 =~ m/\s+etc\.$/ + or $1 =~ m/\s+e\.?g\.$/ + or $1 =~ m/(?<!\.)\.\.\.$/; + } + if ($synopsis =~ m/\t/) { + $self->hint('description-contains-tabs') unless $tabs++; + } + + $self->hint('odd-mark-in-description', + 'comma not followed by whitespace (synopsis)') + if $synopsis =~ /,[^\s\d]/; + + if ($synopsis =~ m/^missing\s*$/i) { + $self->hint('description-is-debmake-template') unless $template++; + } elsif ($synopsis =~ m/<insert up to 60 chars description>/) { + $self->hint('description-is-dh_make-template') unless $template++; + } + if ($synopsis !~ m/\s/) { + $self->hint('description-too-short', $synopsis); + } + my $pkg_fmt = lc $pkg; + my $synopsis_fmt = lc $synopsis; + # made a fuzzy match + $pkg_fmt =~ s/[-_]/ /g; + $synopsis_fmt =~ s{[-_/\\]}{ }g; + $synopsis_fmt =~ s/\s+/ /g; + if ($pkg_fmt eq $synopsis_fmt) { + $self->hint('description-is-pkg-name', $synopsis); + } + + $self->hint('synopsis-too-long') + if length $synopsis > $MAXIMUM_WIDTH; + } + + my $PLANNED_FEATURES= $self->data->load('description/planned-features'); + + my $flagged_homepage; + my @lines = split(/\n/, $extended); + + # count starts for extended description + my $position = 1; + for my $line (@lines) { + next + if $line =~ /^ \.\s*$/; + + if ($position == 1) { + my $firstline = lc $line; + my $lsyn = lc $synopsis; + if ($firstline =~ /^\Q$lsyn\E$/) { + $self->hint('description-synopsis-is-duplicated', + "line $position"); + } else { + $firstline =~ s/[^a-zA-Z0-9]+//g; + $lsyn =~ s/[^a-zA-Z0-9]+//g; + if ($firstline eq $lsyn) { + $self->hint('description-synopsis-is-duplicated', + "line $position"); + } + } + } + + if ($line =~ /^ \.\s*\S/ || $line =~ /^ \s+\.\s*$/) { + $self->hint('description-contains-invalid-control-statement', + "line $position"); + } elsif ($line =~ /^ [\-\*]/) { + # Print it only the second time. Just one is not enough to be sure that + # it's a list, and after the second there's no need to repeat it. + $self->hint('possible-unindented-list-in-extended-description', + "line $position") + if $unindented_list++ == 2; + } + + if ($line =~ /\t/) { + $self->hint('description-contains-tabs', "line $position") + unless $tabs++; + } + + if ($line =~ m{^\s*Homepage: <?https?://}i) { + $self->hint('description-contains-homepage', "line $position"); + $flagged_homepage = 1; + } + + if ($PLANNED_FEATURES->matches_any($line, 'i')) { + $self->hint('description-mentions-planned-features', + "(line $position)"); + } + + $self->hint('odd-mark-in-description', + "comma not followed by whitespace (line $position)") + if $line =~ /,[^\s\d]/; + + $self->hint('description-contains-dh-make-perl-template', + "line $position") + if lc($line) =~ / \Q$DH_MAKE_PERL_TEMPLATE\E /msx; + + my $first_person = $line; + my %seen; + while ($first_person + =~ m/(?:^|\s)(I|[Mm]y|[Oo]urs?|mine|myself|me|us|[Ww]e)(?:$|\s)/) { + my $word = $1; + $first_person =~ s/\Q$word//; + $self->hint('using-first-person-in-description', + "line $position: $word") + unless $seen{$word}++; + } + + if ($position == 1) { + # checks for the first line of the extended description: + if ($line =~ /^ \s/) { + $self->hint('description-starts-with-leading-spaces', + "line $position"); + } + if ($line =~ /^\s*missing\s*$/i) { + $self->hint('description-is-debmake-template',"line $position") + unless $template++; + } elsif ( + $line =~ /<insert long description, indented with spaces>/) { + $self->hint('description-is-dh_make-template',"line $position") + unless $template++; + } + } + + $self->hint('extended-description-line-too-long', "line $position") + if length $line > $MAXIMUM_WIDTH; + + } continue { + ++$position; + } + + if ($type ne 'udeb') { + if (@lines == 0) { + # Ignore debug packages with empty "extended" description + # "debug symbols for pkg foo" is generally descriptive + # enough. + $self->hint('extended-description-is-empty') + unless $processable->is_debug_package; + + } elsif (@lines < 2 && $synopsis !~ /(?:dummy|transition)/i) { + $self->hint('extended-description-is-probably-too-short') + unless $processable->is_transitional + || $processable->is_meta_package + || $pkg =~ m{-dbg\Z}xsm; + + } elsif ($extended =~ /^ \.\s*\n|\n \.\s*\n \.\s*\n|\n \.\s*\n?$/) { + $self->hint('extended-description-contains-empty-paragraph'); + } + } + + # Check for a package homepage in the description and no Homepage + # field. This is less accurate and more of a guess than looking + # for the old Homepage: convention in the body. + unless ($processable->fields->declares('Homepage') or $flagged_homepage) { + if ( + $extended =~ m{homepage|webpage|website|url|upstream|web\s+site + |home\s+page|further\s+information|more\s+info + |official\s+site|project\s+home}xi + && $extended =~ m{\b(https?://[a-z0-9][^>\s]+)}i + ) { + $self->hint('description-possibly-contains-homepage', $1); + } elsif ($extended =~ m{\b(https?://[a-z0-9][^>\s]+)>?\.?\s*\z}i) { + $self->hint('description-possibly-contains-homepage', $1); + } + } + + if ($synopsis) { + check_spelling( + $self->data, + $synopsis, + $group->spelling_exceptions, + $self->spelling_tag_emitter( + 'spelling-error-in-description-synopsis') + ); + # Auto-generated dbgsym packages will use the package name in + # their synopsis. Unfortunately, some package names trigger a + # capitalization error, such as "dbus" -> "D-Bus". Therefore, + # we exempt auto-generated packages from this check. + check_spelling_picky( + $self->data, + $synopsis, + $self->spelling_tag_emitter( + 'capitalization-error-in-description-synopsis') + ) unless $processable->is_auto_generated; + } + + if ($extended) { + check_spelling( + $self->data,$extended, + $group->spelling_exceptions, + $self->spelling_tag_emitter('spelling-error-in-description') + ); + check_spelling_picky($self->data, $extended, + $self->spelling_tag_emitter('capitalization-error-in-description') + ); + } + + if ($pkg =~ /^lib(.+)-perl$/) { + my $mod = $1; + my @mod_path_elements = split(/-/, $mod); + $mod = join($DOUBLE_COLON, map {ucfirst} @mod_path_elements); + my $mod_lc = lc($mod); + + my $pm_found = 0; + my $pmpath = join($SLASH, @mod_path_elements).'.pm'; + my $pm = $mod_path_elements[-1].'.pm'; + + for my $filepath (@{$processable->installed->sorted_list}) { + if ($filepath =~ m{\Q$pmpath\E\z|/\Q$pm\E\z}i) { + $pm_found = 1; + last; + } + } + + $self->hint('perl-module-name-not-mentioned-in-description', $mod) + if (index(lc($extended), $mod_lc) < 0 and $pm_found); + } + + 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/Fields/Distribution.pm b/lib/Lintian/Check/Fields/Distribution.pm new file mode 100644 index 0000000..85390dc --- /dev/null +++ b/lib/Lintian/Check/Fields/Distribution.pm @@ -0,0 +1,167 @@ +# fields/distribution -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# Copyright (C) 2017-2019 Chris Lamb <lamby@debian.org> +# Copyright (C) 2020 Felix Lechner +# +# This program is free software. It is distributed 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::Fields::Distribution; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(any none); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; +const my $SPACE => q{ }; + +sub changes { + my ($self) = @_; + + my @distributions + = $self->processable->fields->trimmed_list('Distribution'); + + $self->hint('multiple-distributions-in-changes-file', + join($SPACE, @distributions)) + if @distributions > 1; + + my @targets = grep { $_ ne 'UNRELEASED' } @distributions; + + # Strip common "extensions" for distributions + # (except sid and experimental, where they would + # make no sense) + my %major; + for my $target (@targets) { + + my $reduced = $target; + $reduced =~ s{- (?:backports(?:-(?:sloppy|staging))? + |lts + |proposed(?:-updates)? + |updates + |security + |volatile + |fasttrack)$}{}xsm; + + $major{$target} = $reduced; + } + + my $KNOWN_DISTS = $self->data->load('changes-file/known-dists'); + + my @unknown = grep { !$KNOWN_DISTS->recognizes($major{$_}) } @targets; + $self->hint('bad-distribution-in-changes-file', $_) for @unknown; + + my @new_version = qw(sid unstable experimental); + my $upload_lc = List::Compare->new(\@targets, \@new_version); + + my @regular = $upload_lc->get_intersection; + my @special = $upload_lc->get_Lonly; + + # from Parse/DebianChangelog.pm + # the changelog entries in the changes file are in a + # different format than in the changelog, so the standard + # parsers don't work. We just need to know if there is + # info for more than 1 entry, so we just copy part of the + # parse code here + my $changes = $self->processable->fields->value('Changes'); + + # count occurrences + my @changes_versions + = ($changes =~/^(?: \.)?\s*\S+\s+\(([^\(\)]+)\)\s+\S+/mg); + + my $version = $self->processable->fields->value('Version'); + my $distnumber; + my $bpoversion; + if ($version=~ /~bpo(\d+)\+(\d+)(\+salsaci(\+\d+)*)?$/) { + $distnumber = $1; + $bpoversion = $2; + + $self->hint('upload-has-backports-version-number', $version, $_) + for @regular; + } + + my @backports = grep { /backports/ } @targets; + for my $target (@backports) { + + $self->hint('backports-upload-has-incorrect-version-number', + $version, $target) + if (!defined $distnumber || !defined $bpoversion) + || ($major{$target} eq 'squeeze' && $distnumber ne '60') + || ($target eq 'wheezy-backports' && $distnumber ne '70') + || ($target eq 'wheezy-backports-sloppy' && $distnumber ne '7') + || ($major{$target} eq 'jessie' && $distnumber ne '8'); + + # for a ~bpoXX+2 or greater version, there + # probably will be only a single changelog entry + $self->hint('backports-changes-missing') + if ($bpoversion // 0) < 2 && @changes_versions == 1; + } + + my $first_line = $changes; + + # advance to first non-empty line + $first_line =~ s/^\s+//s; + + my $multiple; + if ($first_line =~ /^\s*\S+\s+\([^\(\)]+\)([^;]+);/){ + $multiple = $1; + } + + my @changesdists = split($SPACE, $multiple // $EMPTY); + return + unless @changesdists; + + # issue only when not mentioned in the Distribution field + if ((any { $_ eq 'UNRELEASED' } @changesdists) + && none { $_ eq 'UNRELEASED' } @distributions) { + + $self->hint('unreleased-changes'); + return; + } + + my $mismatch_lc = List::Compare->new(\@distributions, \@changesdists); + my @from_distribution = $mismatch_lc->get_Lonly; + my @from_changes = $mismatch_lc->get_Ronly; + + if (@from_distribution || @from_changes) { + + if (any { $_ eq 'experimental' } @from_changes) { + $self->hint('distribution-and-experimental-mismatch'); + + } else { + $self->hint('distribution-and-changes-mismatch', + join($SPACE, @from_distribution, @from_changes)); + } + } + + 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/Fields/DmUploadAllowed.pm b/lib/Lintian/Check/Fields/DmUploadAllowed.pm new file mode 100644 index 0000000..6670587 --- /dev/null +++ b/lib/Lintian/Check/Fields/DmUploadAllowed.pm @@ -0,0 +1,60 @@ +# fields/dm-upload-allowed -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::DmUploadAllowed; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('DM-Upload-Allowed'); + + $self->hint('dm-upload-allowed-is-obsolete'); + + my $dmupload = $fields->unfolded_value('DM-Upload-Allowed'); + + $self->hint('malformed-dm-upload-allowed', $dmupload) + unless $dmupload eq 'yes'; + + 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/Fields/Empty.pm b/lib/Lintian/Check/Fields/Empty.pm new file mode 100644 index 0000000..184acd3 --- /dev/null +++ b/lib/Lintian/Check/Fields/Empty.pm @@ -0,0 +1,49 @@ +# fields/empty -- lintian check script (rewrite) -*- 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::Fields::Empty; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my @all = $self->processable->fields->names; + my @empty = grep { !length $self->processable->fields->value($_) } @all; + + $self->hint('empty-field', $_) for @empty; + + 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/Fields/Essential.pm b/lib/Lintian/Check/Fields/Essential.pm new file mode 100644 index 0000000..87d43c3 --- /dev/null +++ b/lib/Lintian/Check/Fields/Essential.pm @@ -0,0 +1,79 @@ +# fields/essential -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Essential; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + $self->hint('essential-in-source-package') + if $fields->declares('Essential'); + + return; +} + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Essential'); + + my $essential = $fields->unfolded_value('Essential'); + + unless ($essential eq 'yes' || $essential eq 'no') { + $self->hint('unknown-essential-value'); + return; + } + + $self->hint('essential-no-not-needed') if $essential eq 'no'; + + my $KNOWN_ESSENTIAL = $self->data->load('fields/essential'); + + $self->hint('new-essential-package') + if $essential eq 'yes' + && !$KNOWN_ESSENTIAL->recognizes($self->processable->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/Fields/Format.pm b/lib/Lintian/Check/Fields/Format.pm new file mode 100644 index 0000000..2d7494a --- /dev/null +++ b/lib/Lintian/Check/Fields/Format.pm @@ -0,0 +1,78 @@ +# fields/format -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Format; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +my @supported_source_formats = (qr/1\.0/, qr/3\.0\s*\((quilt|native)\)/); + +sub source { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Format'); + + my $format = $self->processable->fields->unfolded_value('Format'); + + my $supported = 0; + for my $f (@supported_source_formats){ + + $supported = 1 + if $format =~ /^\s*$f\s*\z/; + } + + $self->hint('unsupported-source-format', $format) unless $supported; + + return; +} + +sub changes { + my ($self) = @_; + + my $format = $self->processable->fields->unfolded_value('Format'); + + # without a Format field something is wrong + unless (length $format) { + $self->hint('malformed-changes-file'); + return; + } + + 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/Fields/Homepage.pm b/lib/Lintian/Check/Fields/Homepage.pm new file mode 100644 index 0000000..6e2ae87 --- /dev/null +++ b/lib/Lintian/Check/Fields/Homepage.pm @@ -0,0 +1,101 @@ +# fields/homepage -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Homepage; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + return + if $self->processable->native; + + my $debian_control = $self->processable->debian_control; + + my @binaries_with_homepage_field + = grep { $debian_control->installable_fields($_)->declares('Homepage') } + $debian_control->installables; + + if (!$self->processable->fields->declares('Homepage')) { + + $self->hint('homepage-in-binary-package', $_) + for @binaries_with_homepage_field; + } + + $self->hint('no-homepage-field') + unless @binaries_with_homepage_field + || $self->processable->fields->declares('Homepage'); + + return; +} + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Homepage'); + + my $homepage = $fields->unfolded_value('Homepage'); + + my $orig = $fields->value('Homepage'); + + if ($homepage =~ /^<(?:UR[LI]:)?.*>$/i) { + $self->hint('superfluous-clutter-in-homepage', $orig); + $homepage = substr($homepage, 1, length($homepage) - 2); + } + + require URI; + my $uri = URI->new($homepage); + + # not an absolute URI or (most likely) an invalid protocol + $self->hint('bad-homepage', $orig) + unless $uri->scheme && $uri->scheme =~ /^(?:ftp|https?|gopher)$/; + + my $BAD_HOMEPAGES = $self->data->load('fields/bad-homepages'); + + foreach my $line ($BAD_HOMEPAGES->all) { + my ($tag, $re) = split(/\s*~~\s*/, $line); + $self->hint($tag, $orig) if $homepage =~ m/$re/; + } + + 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/Fields/InstallerMenuItem.pm b/lib/Lintian/Check/Fields/InstallerMenuItem.pm new file mode 100644 index 0000000..2b799d3 --- /dev/null +++ b/lib/Lintian/Check/Fields/InstallerMenuItem.pm @@ -0,0 +1,59 @@ +# fields/installer-menu-item -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::InstallerMenuItem; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub udeb { + my ($self) = @_; + + my $fields = $self->processable->fields; + + #---- Installer-Menu-Item (udeb) + + return + unless $fields->declares('Installer-Menu-Item'); + + my $menu_item = $fields->unfolded_value('Installer-Menu-Item'); + + $self->hint('bad-menu-item', $menu_item) unless $menu_item =~ /^\d+$/; + + 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/Fields/Length.pm b/lib/Lintian/Check/Fields/Length.pm new file mode 100644 index 0000000..e9765bd --- /dev/null +++ b/lib/Lintian/Check/Fields/Length.pm @@ -0,0 +1,86 @@ +# fields/length -- lintian check script -*- perl -*- +# +# Copyright (C) 2019 Sylvestre Ledru +# Copyright (C) 2019-2020 Chris Lamb <lamby@debian.org> +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Length; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::Compare; +use List::SomeUtils qw(any); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $MAXIMUM_LENGTH => 5_000; + +my @ALLOWED_FIELDS = qw( + Build-Ids + Description + Package-List + Installed-Build-Depends + Checksums-Sha256 +); + +sub always { + my ($self) = @_; + + return + if any { $self->processable->type eq $_ } qw(changes buildinfo); + + # all fields + my @all = $self->processable->fields->names; + + # longer than maximum + my @long= grep { + length $self->processable->fields->untrimmed_value($_)> $MAXIMUM_LENGTH + }@all; + + # filter allowed fields + my $allowedlc = List::Compare->new(\@long, \@ALLOWED_FIELDS); + my @too_long = $allowedlc->get_Lonly; + + for my $name (@too_long) { + + my $length = length $self->processable->fields->value($name); + + $self->hint('field-too-long', $name, + "($length chars > $MAXIMUM_LENGTH)"); + } + + 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/Fields/MailAddress.pm b/lib/Lintian/Check/Fields/MailAddress.pm new file mode 100644 index 0000000..02fd5f1 --- /dev/null +++ b/lib/Lintian/Check/Fields/MailAddress.pm @@ -0,0 +1,150 @@ +# fields/mail-address -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2020 Felix Lechner +# Copyright (C) 2020 Chris Lamb <lamby@debian.org> +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::MailAddress; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Data::Validate::Domain; +use Email::Address::XS; +use List::SomeUtils qw(any all); +use List::UtilsBy qw(uniq_by); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $QA_GROUP_PHRASE => 'Debian QA Group'; +const my $QA_GROUP_ADDRESS => 'packages@qa.debian.org'; +const my $ARROW => q{ -> }; + +# list of addresses known to bounce messages from role accounts +my @KNOWN_BOUNCE_ADDRESSES = qw( + ubuntu-devel-discuss@lists.ubuntu.com +); + +sub always { + my ($self) = @_; + + my @singles = qw(Maintainer Changed-By); + my @groups = qw(Uploaders); + + my @singles_present + = grep { $self->processable->fields->declares($_) } @singles; + my @groups_present + = grep { $self->processable->fields->declares($_) } @groups; + + my %parsed; + for my $role (@singles_present, @groups_present) { + + my $value = $self->processable->fields->value($role); + $parsed{$role} = [Email::Address::XS->parse($value)]; + } + + for my $role (keys %parsed) { + + my @invalid = grep { !$_->is_valid } @{$parsed{$role}}; + $self->hint('malformed-contact', $role, $_->original)for @invalid; + + my @valid = grep { $_->is_valid } @{$parsed{$role}}; + my @unique = uniq_by { $_->format } @valid; + + $self->check_single_address($role, $_) for @unique; + } + + for my $role (@singles_present) { + $self->hint('too-many-contacts', $role, + $self->processable->fields->value($role)) + if @{$parsed{$role}} > 1; + } + + for my $role (@groups_present) { + my @valid = grep { $_->is_valid } @{$parsed{$role}}; + my @addresses = map { $_->address } @valid; + + my %count; + $count{$_}++ for @addresses; + my @duplicates = grep { $count{$_} > 1 } keys %count; + + $self->hint('duplicate-contact', $role, $_) for @duplicates; + } + + return; +} + +sub check_single_address { + my ($self, $role, $parsed) = @_; + + $self->hint('mail-contact', $role, $parsed->format); + + unless (all { length } ($parsed->address, $parsed->user, $parsed->host)) { + $self->hint('incomplete-mail-address', $role, $parsed->format); + return; + } + + $self->hint('bogus-mail-host', $role, $parsed->address) + unless is_domain($parsed->host, {domain_disable_tld_validation => 1}); + + $self->hint('mail-address-loops-or-bounces',$role, $parsed->address) + if any { $_ eq $parsed->address } @KNOWN_BOUNCE_ADDRESSES; + + unless (length $parsed->phrase) { + $self->hint('no-phrase', $role, $parsed->format); + return; + } + + $self->hint('root-in-contact', $role, $parsed->format) + if $parsed->user eq 'root' || $parsed->phrase eq 'root'; + + # Debian QA Group + $self->hint('faulty-debian-qa-group-phrase', + $role, $parsed->phrase . $ARROW . $QA_GROUP_PHRASE) + if $parsed->address eq $QA_GROUP_ADDRESS + && $parsed->phrase ne $QA_GROUP_PHRASE; + + $self->hint('faulty-debian-qa-group-address', + $role, $parsed->address . $ARROW . $QA_GROUP_ADDRESS) + if ( $parsed->phrase =~ /\bdebian\s+qa\b/i + && $parsed->address ne $QA_GROUP_ADDRESS) + || $parsed->address eq 'debian-qa@lists.debian.org'; + + $self->hint('mailing-list-on-alioth', $role, $parsed->address) + if $parsed->host eq 'lists.alioth.debian.org'; + + 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/Fields/Maintainer.pm b/lib/Lintian/Check/Fields/Maintainer.pm new file mode 100644 index 0000000..7267092 --- /dev/null +++ b/lib/Lintian/Check/Fields/Maintainer.pm @@ -0,0 +1,84 @@ +# fields/maintainer -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2020 Felix Lechner +# Copyright (C) 2020 Chris Lamb <lamby@debian.org> +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Maintainer; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Maintainer'); + + my $maintainer = $self->processable->fields->value('Maintainer'); + + my $is_list = $maintainer =~ /\@lists(?:\.alioth)?\.debian\.org\b/; + + $self->hint('no-human-maintainers') + if $is_list && !$self->processable->fields->declares('Uploaders'); + + return; +} + +sub changes { + my ($self) = @_; + + my $source = $self->group->source; + return + unless defined $source; + + my $changes_maintainer = $self->processable->fields->value('Maintainer'); + my $changes_distribution + = $self->processable->fields->value('Distribution'); + + my $source_maintainer = $source->fields->value('Maintainer'); + + my $KNOWN_DISTS = $self->data->load('changes-file/known-dists'); + + # not for derivatives; https://wiki.ubuntu.com/DebianMaintainerField + $self->hint('inconsistent-maintainer', + $changes_maintainer . ' (changes vs. source) ' .$source_maintainer) + if $changes_maintainer ne $source_maintainer + && $KNOWN_DISTS->recognizes($changes_distribution); + + 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/Fields/Maintainer/Team.pm b/lib/Lintian/Check/Fields/Maintainer/Team.pm new file mode 100644 index 0000000..b068d9f --- /dev/null +++ b/lib/Lintian/Check/Fields/Maintainer/Team.pm @@ -0,0 +1,90 @@ +# 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::Fields::Maintainer::Team; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Email::Address::XS; +use List::SomeUtils qw(uniq first_value); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $ARROW => qq{ \N{RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK} }; + +my %team_names = ( + 'debian-go@lists.debian.org' => 'golang', + 'debian-clojure@lists.debian.org' => 'clojure', + 'pkg-java-maintainers@lists.alioth.debian.org' => 'java', + 'pkg-javascript-maintainers@lists.alioth.debian.org' => 'javascript', + 'pkg-perl-maintainers@lists.alioth.debian.org' => 'perl', + 'team+python@tracker.debian.org' => 'python' +); + +sub source { + my ($self) = @_; + + my $maintainer = $self->processable->fields->value('Maintainer'); + return + unless length $maintainer; + + my $parsed = Email::Address::XS->parse($maintainer); + return + unless $parsed->is_valid; + + return + unless length $parsed->address; + + my $team = $team_names{$parsed->address}; + return + unless length $team; + + return + if $self->name_contains($team); + + my @other_teams = uniq grep { $_ ne $team } values %team_names; + + my $name_suggests = first_value { $self->name_contains($_) } @other_teams; + return + unless length $name_suggests; + + $self->hint('wrong-team', $team . $ARROW . $name_suggests) + unless $name_suggests eq $team; + + return; +} + +sub name_contains { + my ($self, $string) = @_; + + return $self->processable->name =~ m{ \b \Q$string\E \b }sx; +} + +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/Fields/MultiArch.pm b/lib/Lintian/Check/Fields/MultiArch.pm new file mode 100644 index 0000000..5b42f9f --- /dev/null +++ b/lib/Lintian/Check/Fields/MultiArch.pm @@ -0,0 +1,138 @@ +# fields/multi-arch -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::MultiArch; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(uniq any); +use Unicode::UTF8 qw(decode_utf8); + +use Lintian::IPC::Run3 qw(safe_qx); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $SPACE => q{ }; + +sub source { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $processable = $self->processable; + + for my $bin ($processable->debian_control->installables) { + + next + unless ($processable->debian_control->installable_fields($bin) + ->value('Multi-Arch')) eq 'same'; + + my $wildcard = $processable->debian_control->installable_fields($bin) + ->value('Architecture'); + my @arches = split( + $SPACE, + decode_utf8( + safe_qx( + 'dpkg-architecture', '--match-wildcard', + $wildcard, '--list-known' + ) + ) + ); + + # include original wildcard + push(@arches, $wildcard); + + for my $port (uniq @arches) { + + my $specific = $processable->patched->resolve_path( + "debian/$bin.lintian-overrides.$port"); + next + unless defined $specific; + + $self->pointed_hint( + 'multi-arch-same-package-has-arch-specific-overrides', + $specific->pointer); + } + } + + return; +} + +sub installable { + my ($self) = @_; + + my $fields = $self->processable->fields; + + if ($self->processable->name =~ /^x?fonts-/) { + + my $multi = $fields->value('Multi-Arch') || 'no'; + + $self->hint('font-package-not-multi-arch-foreign') + unless any { $multi eq $_ } qw(foreign allowed); + } + + return + unless $fields->declares('Multi-Arch'); + + my $multi = $fields->unfolded_value('Multi-Arch'); + + if ($fields->declares('Architecture')) { + + my $architecture = $fields->unfolded_value('Architecture'); + + $self->hint('illegal-multi-arch-value', $architecture, $multi) + if $architecture eq 'all' && $multi eq 'same'; + } + + return; +} + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Multi-Arch'); + + my $multi = $fields->unfolded_value('Multi-Arch'); + + $self->hint('unknown-multi-arch-value', $self->processable->name, $multi) + unless any { $multi eq $_ } qw(no foreign allowed same); + + 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/Fields/MultiLine.pm b/lib/Lintian/Check/Fields/MultiLine.pm new file mode 100644 index 0000000..ca31cd5 --- /dev/null +++ b/lib/Lintian/Check/Fields/MultiLine.pm @@ -0,0 +1,89 @@ +# fields/multi-line -- lintian check script -*- perl -*- +# +# Copyright (C) 2019 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::MultiLine; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::Compare; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $NEWLINE => qq{\n}; + +# based on policy 5.6 +my @always_single = ( + qw(Architecture Bugs Changed-By Closes Date Distribution Dm-Upload-Allowed), + qw(Essential Format Homepage Installed-Size Installer-Menu-Item Maintainer), + qw(Multi-Arch Origin Package Priority Section Source Standards-Version), + qw(Subarchitecture Urgency Version) +); + +my @package_relations + = ( + qw(Depends Pre-Depends Recommends Suggests Conflicts Provides Enhances Replaces Breaks) + ); + +sub always { + my ($self) = @_; + + my @banned = @always_single; + + # for package relations, multi-line only in source (policy 7.1) + push(@banned, @package_relations) + unless $self->processable->type eq 'source'; + + my @present = $self->processable->fields->names; + + my $single_lc = List::Compare->new(\@present, \@banned); + my @enforce = $single_lc->get_intersection; + + for my $name (@enforce) { + + my $value = $self->processable->fields->untrimmed_value($name); + + # remove a final newline, if any + $value =~ s/\n$//; + + # check if fields have newlines in them + $self->hint('multiline-field', $name) + if index($value, $NEWLINE) >= 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/Fields/Origin.pm b/lib/Lintian/Check/Fields/Origin.pm new file mode 100644 index 0000000..4d36793 --- /dev/null +++ b/lib/Lintian/Check/Fields/Origin.pm @@ -0,0 +1,57 @@ +# fields/origin -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Origin; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Origin'); + + my $origin = $fields->unfolded_value('Origin'); + + $self->hint('redundant-origin-field') if lc($origin) eq 'debian'; + + 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/Fields/Package.pm b/lib/Lintian/Check/Fields/Package.pm new file mode 100644 index 0000000..2ce436f --- /dev/null +++ b/lib/Lintian/Check/Fields/Package.pm @@ -0,0 +1,61 @@ +# fields/package -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Package; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Util qw($PKGNAME_REGEX); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub installable { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Package'); + + my $name = $self->processable->fields->unfolded_value('Package'); + + $self->hint('bad-package-name') unless $name =~ /^$PKGNAME_REGEX$/i; + + $self->hint('package-not-lowercase') if $name =~ /[A-Z]/; + + $self->hint('unusual-documentation-package-name') if $name =~ /-docs$/; + + 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/Fields/PackageRelations.pm b/lib/Lintian/Check/Fields/PackageRelations.pm new file mode 100644 index 0000000..eeb11c0 --- /dev/null +++ b/lib/Lintian/Check/Fields/PackageRelations.pm @@ -0,0 +1,794 @@ +# fields/package-relations -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2019-2020 Chris Lamb <lamby@debian.org> +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::PackageRelations; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Dpkg::Version qw(version_check); +use List::SomeUtils qw(any); + +use Lintian::Relation; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; +const my $EQUAL => q{=}; +const my $VERTICAL_BAR => q{|}; + +# Still in the archive but shouldn't be the primary Emacs dependency. +my @obsolete_emacs_versions = qw(21 22 23); +my @emacs_flavors = ($EMPTY, qw(-el -gtk -nox -lucid)); +my %known_obsolete_emacs; +for my $version (@obsolete_emacs_versions) { + for my $flavor (@emacs_flavors) { + + my $package = 'emacs' . $version . $flavor; + $known_obsolete_emacs{$package} = 1; + } +} + +my %known_libstdcs = map { $_ => 1 } qw( + libstdc++2.9-glibc2.1 + libstdc++2.10 + libstdc++2.10-glibc2.2 + libstdc++3 + libstdc++3.0 + libstdc++4 + libstdc++5 + libstdc++6 + lib64stdc++6 +); + +my %known_tcls = map { $_ => 1 } qw( + tcl74 + tcl8.0 + tcl8.2 + tcl8.3 + tcl8.4 + tcl8.5 +); + +my %known_tclxs = map { $_ => 1 } qw( + tclx76 + tclx8.0.4 + tclx8.2 + tclx8.3 + tclx8.4 +); + +my %known_tks = map { $_ => 1 } qw( + tk40 + tk8.0 + tk8.2 + tk8.3 + tk8.4 + tk8.5 +); + +my %known_libpngs = map { $_ => 1 } qw( + libpng12-0 + libpng2 + libpng3 +); + +my @known_java_pkg = map { qr/$_/ } ( + 'default-j(?:re|dk)(?:-headless)?', + # java-runtime and javaX-runtime alternatives (virtual) + 'java\d*-runtime(?:-headless)?', + # openjdk-X and sun-javaX + '(openjdk-|sun-java)\d+-j(?:re|dk)(?:-headless)?', + 'gcj-(?:\d+\.\d+-)?jre(?:-headless)?', 'gcj-(?:\d+\.\d+-)?jdk', # gcj + 'gij', + 'java-gcj-compat(?:-dev|-headless)?', # deprecated/transitional packages + 'kaffe', 'cacao', 'jamvm', + 'classpath', # deprecated packages (removed in Squeeze) +); + +# Python development packages that are used almost always just for building +# architecture-dependent modules. Used to check for unnecessary build +# dependencies for architecture-independent source packages. +our $PYTHON_DEV = join(' | ', + qw(python3-dev python3-all-dev), + map { "python$_-dev:any" } qw(2.7 3 3.7 3.8 3.9)); + +sub installable { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $type = $self->processable->type; + my $processable = $self->processable; + my $group = $self->group; + + my $KNOWN_ESSENTIAL = $self->data->load('fields/essential'); + my $KNOWN_TOOLCHAIN = $self->data->load('fields/toolchain'); + my $KNOWN_METAPACKAGES = $self->data->load('fields/metapackages'); + + my $DH_ADDONS = $self->data->debhelper_addons; + my %DH_ADDONS_VALUES + = map { $_ => 1 } map { $DH_ADDONS->installed_by($_) } $DH_ADDONS->all; + + my $OBSOLETE_PACKAGES + = $self->data->load('fields/obsolete-packages',qr/\s*=>\s*/); + + my $VIRTUAL_PACKAGES= $self->data->load('fields/virtual-packages'); + + my $javalib = 0; + my $replaces = $processable->relation('Replaces'); + my %nag_once; + $javalib = 1 if($pkg =~ m/^lib.*-java$/); + for my $field ( + qw(Depends Pre-Depends Recommends Suggests Conflicts Provides Enhances Replaces Breaks) + ) { + next + unless $processable->fields->declares($field); + + # get data and clean it + my $data = $processable->fields->unfolded_value($field); + my $javadep = 0; + + my (@seen_libstdcs, @seen_tcls, @seen_tclxs,@seen_tks, @seen_libpngs); + + my $is_dep_field + = any { $field eq $_ } qw(Depends Pre-Depends Recommends Suggests); + + $self->hint('alternates-not-allowed', $field) + if ($data =~ /\|/ && !$is_dep_field); + $self->check_field($field, $data) if $is_dep_field; + + for my $dep (split /\s*,\s*/, $data) { + my (@alternatives, @seen_obsolete_packages); + push @alternatives, [_split_dep($_), $_] + for (split /\s*\|\s*/, $dep); + + if ($is_dep_field) { + push @seen_libstdcs, $alternatives[0][0] + if defined $known_libstdcs{$alternatives[0][0]}; + push @seen_tcls, $alternatives[0][0] + if defined $known_tcls{$alternatives[0][0]}; + push @seen_tclxs, $alternatives[0][0] + if defined $known_tclxs{$alternatives[0][0]}; + push @seen_tks, $alternatives[0][0] + if defined $known_tks{$alternatives[0][0]}; + push @seen_libpngs, $alternatives[0][0] + if defined $known_libpngs{$alternatives[0][0]}; + } + + # Only for (Pre-)?Depends. + $self->hint('virtual-package-depends-without-real-package-depends', + "$field: $alternatives[0][0]") + if ( + $VIRTUAL_PACKAGES->recognizes($alternatives[0][0]) + && ($field eq 'Depends' || $field eq 'Pre-Depends') + && ($pkg ne 'base-files' || $alternatives[0][0] ne 'awk') + # ignore phpapi- dependencies as adding an + # alternative, real, package breaks its purpose + && $alternatives[0][0] !~ m/^phpapi-/ + ); + + # Check defaults for transitions. Here, we only care + # that the first alternative is current. + $self->hint('depends-on-old-emacs', "$field: $alternatives[0][0]") + if ( $is_dep_field + && $known_obsolete_emacs{$alternatives[0][0]}); + + for my $part_d (@alternatives) { + my ($d_pkg, $d_march, $d_version, undef, undef, $rest, + $part_d_orig) + = @{$part_d}; + + $self->hint('invalid-versioned-provides', $part_d_orig) + if ( $field eq 'Provides' + && $d_version->[0] + && $d_version->[0] ne $EQUAL); + + $self->hint('bad-provided-package-name', $d_pkg) + if $d_pkg !~ /^[a-z0-9][-+\.a-z0-9]+$/; + + $self->hint('breaks-without-version', $part_d_orig) + if ( $field eq 'Breaks' + && !$d_version->[0] + && !$VIRTUAL_PACKAGES->recognizes($d_pkg) + && !$replaces->satisfies($part_d_orig)); + + $self->hint('conflicts-with-version', $part_d_orig) + if ($field eq 'Conflicts' && $d_version->[0]); + + $self->hint('obsolete-relation-form', "$field: $part_d_orig") + if ($d_version && any { $d_version->[0] eq $_ }('<', '>')); + + $self->hint('bad-version-in-relation', "$field: $part_d_orig") + if ($d_version->[0] && !version_check($d_version->[1])); + + $self->hint('package-relation-with-self', + "$field: $part_d_orig") + if ($pkg eq $d_pkg) + && (!$d_march) + && ( $field ne 'Conflicts' + && $field ne 'Replaces' + && $field ne 'Provides'); + + $self->hint('bad-relation', "$field: $part_d_orig") if $rest; + + push @seen_obsolete_packages, [$part_d_orig, $d_pkg] + if ( $OBSOLETE_PACKAGES->recognizes($d_pkg) + && $is_dep_field); + + $self->hint('depends-on-metapackage', "$field: $part_d_orig") + if ( $KNOWN_METAPACKAGES->recognizes($d_pkg) + && !$KNOWN_METAPACKAGES->recognizes($pkg) + && !$processable->is_transitional + && !$processable->is_meta_package + && $is_dep_field); + + # diffutils is a special case since diff was + # renamed to diffutils, so a dependency on + # diffutils effectively is a versioned one. + $self->hint( + 'depends-on-essential-package-without-using-version', + "$field: $part_d_orig") + if ( $KNOWN_ESSENTIAL->recognizes($d_pkg) + && !$d_version->[0] + && $is_dep_field + && $d_pkg ne 'diffutils' + && $d_pkg ne 'dash'); + + $self->hint('package-depends-on-an-x-font-package', + "$field: $part_d_orig") + if ( $field =~ /^(?:Pre-)?Depends$/ + && $d_pkg =~ /^xfont.*/ + && $d_pkg ne 'xfonts-utils' + && $d_pkg ne 'xfonts-encodings'); + + $self->hint('depends-on-packaging-dev',$field) + if (($field =~ /^(?:Pre-)?Depends$/|| $field eq 'Recommends') + && $d_pkg eq 'packaging-dev' + && !$processable->is_transitional + && !$processable->is_meta_package); + + $self->hint('needless-suggest-recommend-libservlet-java', + "$d_pkg") + if (($field eq 'Recommends' || $field eq 'Suggests') + && $d_pkg =~ m/libservlet[\d\.]+-java/); + + $self->hint('needlessly-depends-on-awk', $field) + if ( $d_pkg eq 'awk' + && !$d_version->[0] + && $is_dep_field + && $pkg ne 'base-files'); + + $self->hint('depends-on-libdb1-compat', $field) + if ( $d_pkg eq 'libdb1-compat' + && $pkg !~ /^libc(?:6|6.1|0.3)/ + && $field =~ /^(?:Pre-)?Depends$/); + + $self->hint('depends-on-python-minimal', $field,) + if ( $d_pkg =~ /^python[\d.]*-minimal$/ + && $is_dep_field + && $pkg !~ /^python[\d.]*-minimal$/); + + $self->hint('doc-package-depends-on-main-package', $field) + if ("$d_pkg-doc" eq $pkg + && $field =~ /^(?:Pre-)?Depends$/); + + $self->hint( + 'package-relation-with-perl-modules', "$field: $d_pkg" + # matches "perl-modules" (<= 5.20) as well as + # perl-modules-5.xx (>> 5.20) + ) + if $d_pkg =~ /^perl-modules/ + && $field ne 'Replaces' + && $processable->source_name ne 'perl'; + + $self->hint('depends-exclusively-on-makedev', $field,) + if ( $field eq 'Depends' + && $d_pkg eq 'makedev' + && @alternatives == 1); + + $self->hint('lib-recommends-documentation', + "$field: $part_d_orig") + if ( $field eq 'Recommends' + && $pkg =~ m/^lib/ + && $pkg !~ m/-(?:dev|docs?|tools|bin)$/ + && $part_d_orig =~ m/-docs?$/); + + $self->hint('binary-package-depends-on-toolchain-package', + "$field: $part_d_orig") + if $KNOWN_TOOLCHAIN->recognizes($d_pkg) + && $is_dep_field + && $pkg !~ /^dh-/ + && $pkg !~ /-(?:source|src)$/ + && !$processable->is_transitional + && !$processable->is_meta_package + && !$DH_ADDONS_VALUES{$pkg}; + + # default-jdk-doc must depend on openjdk-X-doc (or + # classpath-doc) to be useful; other packages + # should depend on default-jdk-doc if they want + # the Java Core API. + $self->hint('depends-on-specific-java-doc-package',$field) + if ( + $is_dep_field + && $pkg ne 'default-jdk-doc' + && ( $d_pkg eq 'classpath-doc' + || $d_pkg =~ /openjdk-\d+-doc/) + ); + + if ($javalib && $field eq 'Depends'){ + foreach my $reg (@known_java_pkg){ + if($d_pkg =~ m/$reg/){ + $javadep++; + last; + } + + } + } + } + + for my $d (@seen_obsolete_packages) { + my ($dep, $pkg_name) = @{$d}; + my $replacement = $OBSOLETE_PACKAGES->value($pkg_name) + // $EMPTY; + $replacement = ' => ' . $replacement + if $replacement ne $EMPTY; + if ($pkg_name eq $alternatives[0][0] + or scalar @seen_obsolete_packages== scalar @alternatives) { + $self->hint( + 'depends-on-obsolete-package', + "$field: $dep${replacement}" + ); + } else { + $self->hint( + 'ored-depends-on-obsolete-package', + "$field: $dep${replacement}" + ); + } + } + + # Only emit the tag if all the alternatives are + # JVM/JRE/JDKs + # - assume that <some-lib> | openjdk-X-jre-headless + # makes sense for now. + if (scalar(@alternatives) == $javadep + && !exists $nag_once{'needless-dependency-on-jre'}){ + $nag_once{'needless-dependency-on-jre'} = 1; + $self->hint('needless-dependency-on-jre'); + } + } + $self->hint('package-depends-on-multiple-libstdc-versions', + @seen_libstdcs) + if (scalar @seen_libstdcs > 1); + $self->hint('package-depends-on-multiple-tcl-versions', @seen_tcls) + if (scalar @seen_tcls > 1); + $self->hint('package-depends-on-multiple-tclx-versions', @seen_tclxs) + if (scalar @seen_tclxs > 1); + $self->hint('package-depends-on-multiple-tk-versions', @seen_tks) + if (scalar @seen_tks > 1); + $self->hint('package-depends-on-multiple-libpng-versions', + @seen_libpngs) + if (scalar @seen_libpngs > 1); + } + + # If Conflicts or Breaks is set, make sure it's not inconsistent with + # the other dependency fields. + for my $conflict (qw/Conflicts Breaks/) { + next + unless $processable->fields->declares($conflict); + + for my $field (qw(Depends Pre-Depends Recommends Suggests)) { + next + unless $processable->fields->declares($field); + + my $relation = $processable->relation($field); + for my $package (split /\s*,\s*/, + $processable->fields->value($conflict)) { + + $self->hint('conflicts-with-dependency', $field, $package) + if $relation->satisfies($package); + } + } + } + + return; +} + +sub source { + my ($self) = @_; + + my $pkg = $self->processable->name; + my $type = $self->processable->type; + my $processable = $self->processable; + my $group = $self->group; + + my $KNOWN_ESSENTIAL = $self->data->load('fields/essential'); + my $KNOWN_METAPACKAGES = $self->data->load('fields/metapackages'); + my $NO_BUILD_DEPENDS= $self->data->load('fields/no-build-depends'); + my $known_build_essential + = $self->data->load('fields/build-essential-packages'); + my $KNOWN_BUILD_PROFILES= $self->data->load('fields/build-profiles'); + + my $OBSOLETE_PACKAGES + = $self->data->load('fields/obsolete-packages',qr/\s*=>\s*/); + + my $VIRTUAL_PACKAGES= $self->data->load('fields/virtual-packages'); + + my @binpkgs = $processable->debian_control->installables; + + #Get number of arch-indep packages: + my $arch_indep_packages = 0; + my $arch_dep_packages = 0; + + for my $binpkg (@binpkgs) { + my $arch = $processable->debian_control->installable_fields($binpkg) + ->value('Architecture'); + + if ($arch eq 'all') { + $arch_indep_packages++; + } else { + $arch_dep_packages++; + } + } + + $self->hint('build-depends-indep-without-arch-indep') + if ( $processable->fields->declares('Build-Depends-Indep') + && $arch_indep_packages == 0); + + $self->hint('build-depends-arch-without-arch-dependent-binary') + if ( $processable->fields->declares('Build-Depends-Arch') + && $arch_dep_packages == 0); + + my %depend; + for my $field ( + qw(Build-Depends Build-Depends-Indep Build-Depends-Arch Build-Conflicts Build-Conflicts-Indep Build-Conflicts-Arch) + ) { + if ($processable->fields->declares($field)) { + + my $is_dep_field = any { $field eq $_ } + qw(Build-Depends Build-Depends-Indep Build-Depends-Arch); + + # get data and clean it + my $data = $processable->fields->unfolded_value($field); + + $self->check_field($field, $data); + $depend{$field} = $data; + + for my $dep (split /\s*,\s*/, $data) { + my (@alternatives, @seen_obsolete_packages); + push @alternatives, [_split_dep($_), $_] + for (split /\s*\|\s*/, $dep); + + $self->hint( + 'virtual-package-depends-without-real-package-depends', + "$field: $alternatives[0][0]") + if ( $VIRTUAL_PACKAGES->recognizes($alternatives[0][0]) + && $is_dep_field); + + for my $part_d (@alternatives) { + my ($d_pkg, undef, $d_version, $d_arch, $d_restr, + $rest,$part_d_orig) + = @{$part_d}; + + for my $arch (@{$d_arch->[0]}) { + $self->hint('invalid-arch-string-in-source-relation', + $arch, "[$field: $part_d_orig]") + if $arch eq 'all' + || ( + !$self->data->architectures + ->is_release_architecture( + $arch) + && !$self->data->architectures->is_wildcard($arch) + ); + } + + for my $restrlist (@{$d_restr}) { + for my $prof (@{$restrlist}) { + $prof =~ s/^!//; + $self->hint( + 'invalid-profile-name-in-source-relation', + "$prof [$field: $part_d_orig]" + ) + unless $KNOWN_BUILD_PROFILES->recognizes($prof) + or $prof =~ /^pkg\.[a-z0-9][a-z0-9+.-]+\../; + } + } + + if ( $d_pkg =~ /^openjdk-\d+-doc$/ + or $d_pkg eq 'classpath-doc'){ + $self->hint( + 'build-depends-on-specific-java-doc-package', + $d_pkg); + } + + if ($d_pkg eq 'java-compiler'){ + $self->hint( + 'build-depends-on-an-obsolete-java-package', + $d_pkg); + } + + if ( $d_pkg =~ /^libdb\d+\.\d+.*-dev$/ + and $is_dep_field) { + $self->hint('build-depends-on-versioned-berkeley-db', + "$field:$d_pkg"); + } + + $self->hint('conflicting-negation-in-source-relation', + "$field: $part_d_orig") + if ( $d_arch + && $d_arch->[1] != 0 + && $d_arch->[1] ne @{ $d_arch->[0] }); + + $self->hint('depends-on-packaging-dev', $field) + if ($d_pkg eq 'packaging-dev'); + + $self->hint('build-depends-on-build-essential', $field) + if ($d_pkg eq 'build-essential'); + + $self->hint( +'build-depends-on-build-essential-package-without-using-version', + "$d_pkg [$field: $part_d_orig]" + ) + if ($known_build_essential->recognizes($d_pkg) + && !$d_version->[1]); + + $self->hint( +'build-depends-on-essential-package-without-using-version', + "$field: $part_d_orig" + ) + if ( $KNOWN_ESSENTIAL->recognizes($d_pkg) + && !$d_version->[0] + && $d_pkg ne 'dash'); + push @seen_obsolete_packages, [$part_d_orig, $d_pkg] + if ( $OBSOLETE_PACKAGES->recognizes($d_pkg) + && $is_dep_field); + + $self->hint('build-depends-on-metapackage', + "$field: $part_d_orig") + if ( $KNOWN_METAPACKAGES->recognizes($d_pkg) + and $is_dep_field); + + $self->hint('build-depends-on-non-build-package', + "$field: $part_d_orig") + if ( $NO_BUILD_DEPENDS->recognizes($d_pkg) + and $is_dep_field); + + $self->hint('build-depends-on-1-revision', + "$field: $part_d_orig") + if ( $d_version->[0] eq '>=' + && $d_version->[1] =~ /-1$/ + && $is_dep_field); + + $self->hint('bad-relation', "$field: $part_d_orig") + if $rest; + + $self->hint('bad-version-in-relation', + "$field: $part_d_orig") + if ($d_version->[0] + && !version_check($d_version->[1])); + + $self->hint( + 'package-relation-with-perl-modules', + "$field: $part_d_orig" + # matches "perl-modules" (<= 5.20) as well as + # perl-modules-5.xx (>> 5.20) + ) + if $d_pkg =~ /^perl-modules/ + && $processable->source_name ne 'perl'; + } + + my $all_obsolete = 0; + $all_obsolete = 1 + if scalar @seen_obsolete_packages == @alternatives; + for my $d (@seen_obsolete_packages) { + my ($dep, $pkg_name) = @{$d}; + my $replacement = $OBSOLETE_PACKAGES->value($pkg_name) + // $EMPTY; + + $replacement = ' => ' . $replacement + if $replacement ne $EMPTY; + if ( $pkg_name eq $alternatives[0][0] + or $all_obsolete) { + $self->hint('build-depends-on-obsolete-package', + "$field: $dep${replacement}"); + } else { + $self->hint('ored-build-depends-on-obsolete-package', + "$field: $dep${replacement}"); + } + } + } + } + } + + # Check for redundancies. + my @to_check = ( + ['Build-Depends'], + ['Build-Depends', 'Build-Depends-Indep'], + ['Build-Depends', 'Build-Depends-Arch'] + ); + + for my $fields (@to_check) { + my $relation = Lintian::Relation->new->logical_and( + map { $processable->relation($_) }@{$fields}); + + for my $redundant_set ($relation->redundancies) { + + $self->hint( + 'redundant-build-prerequisites', + join(', ', sort @{$redundant_set}) + ); + } + } + + # Make sure build dependencies and conflicts are consistent. + my $build_all = $processable->relation('Build-Depends-All'); + + for my $field ( + qw{Build-Conflicts Build-Conflicts-Indep Build-Conflicts-Arch}) { + + my @conflicts= $processable->fields->trimmed_list($field, qr{\s*,\s*}); + my @contradictions = grep { $build_all->satisfies($_) } @conflicts; + + my $position = $processable->fields->position($field); + my $pointer = $processable->debian_control->item->pointer($position); + + $self->pointed_hint('build-conflicts-with-build-dependency', + $pointer, $field, $_) + for @contradictions; + } + + my (@arch_dep_pkgs, @dbg_pkgs); + for my $installable ($group->get_installables) { + + if ($installable->name =~ m/-dbg$/) { + push(@dbg_pkgs, $installable); + + } elsif ($installable->fields->value('Architecture') ne 'all'){ + push(@arch_dep_pkgs, $installable); + } + } + + my $dstr = join($VERTICAL_BAR, map { quotemeta($_->name) } @arch_dep_pkgs); + my $depregex = qr/^(?:$dstr)$/; + for my $dbg_proc (@dbg_pkgs) { + my $deps = $processable->binary_relation($dbg_proc->name, 'strong'); + my $missing = 1; + $missing = 0 + if $deps->matches($depregex, Lintian::Relation::VISIT_PRED_NAME); + if ($missing && $dbg_proc->is_transitional) { + # If it is a transitional package, allow it to depend + # on another -dbg instead. + $missing = 0 + if $deps->matches(qr/-dbg \Z/xsm, + Lintian::Relation::VISIT_PRED_NAME); + } + $self->hint('dbg-package-missing-depends', $dbg_proc->name) + if $missing; + } + + # Check for a python*-dev build dependency in source packages that + # build only arch: all packages. + if ($arch_dep_packages == 0 and $build_all->satisfies($PYTHON_DEV)) { + $self->hint('build-depends-on-python-dev-with-no-arch-any'); + } + + my $bdepends = $processable->relation('Build-Depends'); + + # libmodule-build-perl + # matches() instead of satisfies() because of possible OR relation + $self->hint('libmodule-build-perl-needs-to-be-in-build-depends') + if $processable->relation('Build-Depends-Indep') + ->equals('libmodule-build-perl', Lintian::Relation::VISIT_PRED_NAME) + && !$bdepends->equals('libmodule-build-perl', + Lintian::Relation::VISIT_PRED_NAME); + + # libmodule-build-tiny-perl + $self->hint('libmodule-build-tiny-perl-needs-to-be-in-build-depends') + if $processable->relation('Build-Depends-Indep') + ->satisfies('libmodule-build-tiny-perl') + && !$bdepends->satisfies('libmodule-build-tiny-perl:any'); + + return; +} + +# splits "foo:bar (>= 1.2.3) [!i386 ia64] <stage1 !nocheck> <cross>" into +# ( "foo", "bar", [ ">=", "1.2.3" ], [ [ "i386", "ia64" ], 1 ], [ [ "stage1", "!nocheck" ] , [ "cross" ] ], "" ) +# ^^^ ^^ +# count of negated arches, if ! was given || +# rest (should always be "" for valid dependencies) +sub _split_dep { + my $dep = shift; + my ($pkg, $dmarch, $version, $darch, $restr) + = ($EMPTY, $EMPTY, [$EMPTY,$EMPTY], [[], 0], []); + + if ($dep =~ s/^\s*([^<\s\[\(]+)\s*//) { + ($pkg, $dmarch) = split(/:/, $1, 2); + $dmarch //= $EMPTY; # Ensure it is defined (in case there is no ":") + } + + if (length $dep) { + if ($dep + =~ s/\s* \( \s* (<<|<=|>=|>>|[=<>]) \s* ([^\s(]+) \s* \) \s*//x) { + @{$version} = ($1, $2); + } + if ($dep && $dep =~ s/\s*\[([^\]]+)\]\s*//) { + my $t = $1; + $darch->[0] = [split /\s+/, $t]; + my $negated = 0; + for my $arch (@{ $darch->[0] }) { + $negated++ if $arch =~ s/^!//; + } + $darch->[1] = $negated; + } + while ($dep && $dep =~ s/\s*<([^>]+)>\s*//) { + my $t = $1; + push(@{$restr}, [split /\s+/, $t]); + } + } + + return ($pkg, $dmarch, $version, $darch, $restr, $dep); +} + +sub check_field { + my ($self, $field, $data) = @_; + + my $processable = $self->processable; + + my $has_default_mta + = $processable->relation($field) + ->equals('default-mta', Lintian::Relation::VISIT_PRED_NAME); + my $has_mail_transport_agent = $processable->relation($field) + ->equals('mail-transport-agent', Lintian::Relation::VISIT_PRED_NAME); + + $self->hint('default-mta-dependency-not-listed-first',"$field: $data") + if $processable->relation($field) + ->matches(qr/\|\s+default-mta/, Lintian::Relation::VISIT_OR_CLAUSE_FULL); + + if ($has_default_mta) { + $self->hint( + 'default-mta-dependency-does-not-specify-mail-transport-agent', + "$field: $data") + unless $has_mail_transport_agent; + } elsif ($has_mail_transport_agent) { + $self->hint( + 'mail-transport-agent-dependency-does-not-specify-default-mta', + "$field: $data") + unless $has_default_mta; + } + + 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/Fields/PackageType.pm b/lib/Lintian/Check/Fields/PackageType.pm new file mode 100644 index 0000000..a8defcd --- /dev/null +++ b/lib/Lintian/Check/Fields/PackageType.pm @@ -0,0 +1,58 @@ +# fields/package_type -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::PackageType; + +use v5.20; +use warnings; +use utf8; + +use Lintian::Util qw($PKGNAME_REGEX); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub installable { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Package-Type'); + + my $type = $self->processable->fields->value('Package-Type'); + + $self->hint('explicit-default-in-package-type') + if $type eq 'deb'; + + 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/Fields/Priority.pm b/lib/Lintian/Check/Fields/Priority.pm new file mode 100644 index 0000000..91fa6bb --- /dev/null +++ b/lib/Lintian/Check/Fields/Priority.pm @@ -0,0 +1,82 @@ +# fields/priority -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Priority; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(any); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Priority'); + + my $priority = $fields->unfolded_value('Priority'); + + if ($self->processable->type eq 'source' + || !$self->processable->is_auto_generated) { + + $self->hint('priority-extra-is-replaced-by-priority-optional') + if $priority eq 'extra'; + + # Re-map to optional to avoid an additional warning from + # lintian + $priority = 'optional' + if $priority eq 'extra'; + } + + my $KNOWN_PRIOS = $self->data->load('fields/priorities'); + + $self->hint('unknown-priority', $priority) + unless $KNOWN_PRIOS->recognizes($priority); + + $self->hint('excessive-priority-for-library-package', $priority) + if $self->processable->name =~ /^lib/ + && $self->processable->name !~ /-bin$/ + && $self->processable->name !~ /^libc[0-9.]+$/ + && (any { $_ eq $self->processable->fields->value('Section') } + qw(libdevel libs)) + && (any { $_ eq $priority } qw(required important standard)); + + 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/Fields/Recommended.pm b/lib/Lintian/Check/Fields/Recommended.pm new file mode 100644 index 0000000..2c780b8 --- /dev/null +++ b/lib/Lintian/Check/Fields/Recommended.pm @@ -0,0 +1,142 @@ +# fields/recommended -- lintian check script -*- perl -*- +# +# 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::Fields::Recommended; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Path::Tiny; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $AT => q{@}; + +# policy section 5.2 states unequivocally that the two fields Section +# and Priority are recommended not only in the source paragraph, but +# also in the binary paragraphs. + +# in the author's opinion, however, it does not make sense to flag them +# there because the same two fields in the source paragraph provide the +# default for the fields in the binary package paragraph. + +# moreover, such duplicate tags would then trigger the tag +# binary-control-field-duplicates-source elsewhere, which would be +# super confusing + +# policy 5.2 +my @DEBIAN_CONTROL_SOURCE = qw(Section Priority); +my @DEBIAN_CONTROL_INSTALLABLE = qw(); # Section Priority + +# policy 5.3 +my @INSTALLATION_CONTROL = qw(Section Priority); + +# policy 5.4 +my @DSC = qw(Package-List); + +# policy 5.5 +my @CHANGES = qw(Urgency); + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + my @missing_dsc = grep { !$fields->declares($_) } @DSC; + + my $dscfile = path($self->processable->path)->basename; + $self->hint('recommended-field', $dscfile, $_) for @missing_dsc; + + my $debian_control = $self->processable->debian_control; + my $control_item = $debian_control->item; + + # look at d/control source paragraph + my $source_fields = $debian_control->source_fields; + + my @missing_control_source + = grep { !$source_fields->declares($_) }@DEBIAN_CONTROL_SOURCE; + + my $source_position = $source_fields->position; + my $source_pointer = $control_item->pointer($source_position); + + $self->pointed_hint('recommended-field', $source_pointer, + '(in section for source)', $_) + for @missing_control_source; + + # look at d/control installable paragraphs + for my $installable ($debian_control->installables) { + + my $installable_fields + = $debian_control->installable_fields($installable); + + my @missing_control_installable + = grep {!$installable_fields->declares($_)} + @DEBIAN_CONTROL_INSTALLABLE; + + my $installable_position = $installable_fields->position; + my $installable_pointer= $control_item->pointer($installable_position); + + $self->pointed_hint('recommended-field', $installable_pointer, + "(in section for $installable)", $_) + for @missing_control_installable; + } + + return; +} + +sub installable { + my ($self) = @_; + + my $fields = $self->processable->fields; + + my @missing_installation_control + = grep { !$fields->declares($_) } @INSTALLATION_CONTROL; + + my $debfile = path($self->processable->path)->basename; + $self->hint('recommended-field', $debfile, $_) + for @missing_installation_control; + + return; +} + +sub changes { + my ($self) = @_; + + my $fields = $self->processable->fields; + + my @missing_changes = grep { !$fields->declares($_) } @CHANGES; + + my $changesfile = path($self->processable->path)->basename; + $self->hint('recommended-field', $changesfile, $_) for @missing_changes; + + 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/Fields/Required.pm b/lib/Lintian/Check/Fields/Required.pm new file mode 100644 index 0000000..3b5213f --- /dev/null +++ b/lib/Lintian/Check/Fields/Required.pm @@ -0,0 +1,144 @@ +# fields/required -- 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::Fields::Required; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(all); +use Path::Tiny; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $AT => q{@}; + +# policy 5.2 +my @DEBIAN_CONTROL_SOURCE = qw(Source Maintainer Standards-Version); +my @DEBIAN_CONTROL_INSTALLABLE = qw(Package Architecture Description); + +# policy 5.3 +my @INSTALLATION_CONTROL + = qw(Package Version Architecture Maintainer Description); + +# policy 5.4 +my @DSC = qw(Format Source Version Maintainer Standards-Version + Checksums-Sha1 Checksums-Sha256 Files); + +# policy 5.5 +# Binary and Description were removed, see Bug#963524 +my @CHANGES = qw(Format Date Source Architecture Version Distribution + Maintainer Changes Checksums-Sha1 Checksums-Sha256 Files); + +sub source { + my ($self) = @_; + + my $debian_control = $self->processable->debian_control; + + # policy 5.6.11 + if (all { $debian_control->installable_package_type($_) eq 'udeb' } + $debian_control->installables) { + @DEBIAN_CONTROL_SOURCE + = grep { $_ ne 'Standards-Version' } @DEBIAN_CONTROL_SOURCE; + @DSC = grep { $_ ne 'Standards-Version' } @DSC; + } + + my $fields = $self->processable->fields; + my @missing_dsc = grep { !$fields->declares($_) } @DSC; + + my $dscfile = path($self->processable->path)->basename; + $self->hint('required-field', $dscfile, $_) for @missing_dsc; + + my $control_item = $debian_control->item; + + # look at d/control source paragraph + my $source_fields = $debian_control->source_fields; + + my @missing_control_source + = grep { !$source_fields->declares($_) }@DEBIAN_CONTROL_SOURCE; + + my $source_position = $source_fields->position; + my $source_pointer = $control_item->pointer($source_position); + + $self->pointed_hint('required-field', $source_pointer, + '(in section for source)', $_) + for @missing_control_source; + + # look at d/control installable paragraphs + for my $installable ($debian_control->installables) { + + my $installable_fields + = $debian_control->installable_fields($installable); + + my @missing_control_installable + = grep {!$installable_fields->declares($_)} + @DEBIAN_CONTROL_INSTALLABLE; + + my $installable_position = $installable_fields->position; + my $installable_pointer= $control_item->pointer($installable_position); + + $self->pointed_hint('required-field', $installable_pointer, + "(in section for $installable)", $_) + for @missing_control_installable; + } + + return; +} + +sub installable { + my ($self) = @_; + + my $fields = $self->processable->fields; + + my @missing_installation_control + = grep { !$fields->declares($_) } @INSTALLATION_CONTROL; + + my $debfile = path($self->processable->path)->basename; + $self->hint('required-field', $debfile, $_) + for @missing_installation_control; + + return; +} + +sub changes { + my ($self) = @_; + + my $fields = $self->processable->fields; + + my @missing_changes = grep { !$fields->declares($_) } @CHANGES; + + my $changesfile = path($self->processable->path)->basename; + $self->hint('required-field', $changesfile, $_) for @missing_changes; + + 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/Fields/Section.pm b/lib/Lintian/Check/Fields/Section.pm new file mode 100644 index 0000000..f0373a9 --- /dev/null +++ b/lib/Lintian/Check/Fields/Section.pm @@ -0,0 +1,140 @@ +# fields/section -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Section; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; + +our %KNOWN_ARCHIVE_PARTS + = map { $_ => 1 } qw(non-free contrib non-free-firmware); + +sub udeb { + my ($self) = @_; + + my $section = $self->processable->fields->unfolded_value('Section'); + + $self->hint('wrong-section-for-udeb', $section) + unless $section eq 'debian-installer'; + + return; +} + +sub always { + my ($self) = @_; + + my $pkg = $self->processable->name; + + return + unless $self->processable->fields->declares('Section'); + + my $KNOWN_SECTIONS = $self->data->sections; + + # Mapping of package names to section names + my $NAME_SECTION_MAPPINGS + = $self->data->load('fields/name_section_mappings',qr/\s*=>\s*/); + + my $section = $self->processable->fields->unfolded_value('Section'); + + return + if $self->processable->type eq 'udeb'; + + my @parts = split(m{/}, $section, 2); + + my $division; + $division = $parts[0] + if @parts > 1; + + my $fraction = $parts[-1]; + + if (defined $division) { + $self->hint('unknown-section', $section) + unless $KNOWN_ARCHIVE_PARTS{$division}; + } + + if ($fraction eq 'unknown' && !length $division) { + $self->hint('section-is-dh_make-template'); + } else { + $self->hint('unknown-section', $section) + unless $KNOWN_SECTIONS->recognizes($fraction); + } + + # Check package name <-> section. oldlibs is a special case; let + # anything go there. + if ($fraction ne 'oldlibs') { + + for my $pattern ($NAME_SECTION_MAPPINGS->all()) { + + my $want = $NAME_SECTION_MAPPINGS->value($pattern); + + next + unless $pkg =~ m{$pattern}x; + + unless ($fraction eq $want) { + + my $better + = (defined $division ? "$division/" : $EMPTY) . $want; + $self->hint('wrong-section-according-to-package-name', + "$section => $better"); + } + + last; + } + } + + if ($fraction eq 'debug') { + + $self->hint('wrong-section-according-to-package-name', $section) + if $pkg !~ /-dbg(?:sym)?$/; + } + + if ($self->processable->is_transitional) { + + my $priority = $self->processable->fields->unfolded_value('Priority'); + + $self->hint('transitional-package-not-oldlibs-optional', + "$fraction/$priority") + unless $priority eq 'optional' && $fraction eq 'oldlibs'; + } + + 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/Fields/Source.pm b/lib/Lintian/Check/Fields/Source.pm new file mode 100644 index 0000000..455bba3 --- /dev/null +++ b/lib/Lintian/Check/Fields/Source.pm @@ -0,0 +1,99 @@ +# fields/source -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Source; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Util qw($PKGNAME_REGEX); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $UNDERSCORE => q{_}; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + # required in source packages, but dpkg-source already refuses to unpack + # without this field (and fields depends on unpacked) + return + unless $fields->declares('Source'); + + my $source = $fields->unfolded_value('Source'); + + my $basename = path($self->processable->path)->basename; + my ($stem) = split($UNDERSCORE, $basename, 2); + + die encode_utf8( + "Source field does not match package name $source != $stem") + if $source ne $stem; + + $self->hint('source-field-malformed', $source) + if $source !~ /^[a-z0-9][-+\.a-z0-9]+\z/; + + return; +} + +sub always { + my ($self) = @_; + + # treated separately above + return + if $self->processable->type eq 'source'; + + my $fields = $self->processable->fields; + + # optional in binary packages + return + unless $fields->declares('Source'); + + my $source = $fields->unfolded_value('Source'); + + $self->hint('source-field-malformed', $source) + unless $source =~ m{^ $PKGNAME_REGEX + \s* + # Optional Version e.g. (1.0) + (?:\((?:\d+:)?(?:[-\.+:a-zA-Z0-9~]+?)(?:-[\.+a-zA-Z0-9~]+)?\))?\s*$}x; + + 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/Fields/StandardsVersion.pm b/lib/Lintian/Check/Fields/StandardsVersion.pm new file mode 100644 index 0000000..482dd74 --- /dev/null +++ b/lib/Lintian/Check/Fields/StandardsVersion.pm @@ -0,0 +1,164 @@ +# fields/standards-version -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz and Richard Braakman +# Copyright (C) 2008-2009 Russ Allbery +# 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::Fields::StandardsVersion; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use Date::Parse qw(str2time); +use List::SomeUtils qw(any first_value); +use POSIX qw(strftime); +use Sort::Versions; +use Unicode::UTF8 qw(encode_utf8); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $EMPTY => q{}; +const my $DOT => q{.}; + +const my $MAXIMUM_COMPONENTS_ANALYZED => 3; + +const my $DATE_ONLY => '%Y-%m-%d'; +const my $DATE_AND_TIME => '%Y-%m-%d %H:%M:%S UTC'; + +sub source { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Standards-Version'); + + my $compliance_standard + = $self->processable->fields->value('Standards-Version'); + + my @compliance_components = split(/[.]/, $compliance_standard); + if (@compliance_components < $MAXIMUM_COMPONENTS_ANALYZED + || any { !/^\d+$/ } @compliance_components) { + + $self->hint('invalid-standards-version', $compliance_standard); + return; + } + + $self->hint('standards-version', $compliance_standard); + + my ($compliance_major, $compliance_minor, $compliance_patch) + = @compliance_components; + my $compliance_normalized + = $compliance_major. $DOT. $compliance_minor. $DOT. $compliance_patch; + + my $policy_releases = $self->data->policy_releases; + my $latest_standard = $policy_releases->latest_version; + + my ($latest_major, $latest_minor, $latest_patch) + = ((split(/[.]/, $latest_standard))[0..$MAXIMUM_COMPONENTS_ANALYZED]); + + # a fourth digit is a non-normative change in policy + my $latest_normalized + = $latest_major . $DOT . $latest_minor . $DOT . $latest_patch; + + my $changelog_epoch; + my $distribution; + + my ($entry) = @{$self->processable->changelog->entries}; + if (defined $entry) { + $changelog_epoch = $entry->Timestamp; + $distribution = $entry->Distribution; + } + + # assume recent date if there is no changelog; activates most tags + $changelog_epoch //= $policy_releases->epoch($latest_standard); + $distribution //= $EMPTY; + + unless ($policy_releases->is_known($compliance_standard)) { + + # could be newer + if (versioncmp($compliance_standard, $latest_standard) == 1) { + + $self->hint('newer-standards-version', + "$compliance_standard (current is $latest_normalized)") + unless $distribution =~ /backports/; + + } else { + $self->hint('invalid-standards-version', $compliance_standard); + } + + return; + } + + my $compliance_epoch = $policy_releases->epoch($compliance_standard); + + my $changelog_date = strftime($DATE_ONLY, gmtime $changelog_epoch); + my $compliance_date = strftime($DATE_ONLY, gmtime $compliance_epoch); + + my $changelog_timestamp= strftime($DATE_AND_TIME, gmtime $changelog_epoch); + my $compliance_timestamp + = strftime($DATE_AND_TIME, gmtime $compliance_epoch); + + # catch packages dated prior to release of their standard + if ($compliance_epoch > $changelog_epoch) { + + # show precision if needed + my $warp_illustration = "($changelog_date < $compliance_date)"; + $warp_illustration = "($changelog_timestamp < $compliance_timestamp)" + if $changelog_date eq $compliance_date; + + $self->hint('timewarp-standards-version', $warp_illustration) + unless $distribution eq 'UNRELEASED'; + } + + my @newer_versions = List::SomeUtils::before { + $policy_releases->epoch($_) <= $compliance_epoch + } + @{$policy_releases->ordered_versions}; + + # a fourth digit is a non-normative change in policy + my @newer_normative_versions + = grep { /^ \d+ [.] \d+ [.] \d+ (?:[.] 0)? $/sx } @newer_versions; + + my @newer_normative_epochs + = map { $policy_releases->epoch($_) } @newer_normative_versions; + + my @normative_epochs_then_known + = grep { $_ <= $changelog_epoch } @newer_normative_epochs; + + my $outdated_illustration + = "$compliance_standard (released $compliance_date) (current is $latest_normalized)"; + + # use normative to prevent tag changes on minor new policy edits + $self->hint('out-of-date-standards-version', $outdated_illustration) + if @normative_epochs_then_known; + + 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/Fields/Style.pm b/lib/Lintian/Check/Fields/Style.pm new file mode 100644 index 0000000..fe82d22 --- /dev/null +++ b/lib/Lintian/Check/Fields/Style.pm @@ -0,0 +1,84 @@ +# fields/style -- lintian check script -*- perl -*- +# +# 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::Fields::Style; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +# the fields in d/control provide the values for many fields elsewhere +sub source { + my ($self) = @_; + + my $debian_control = $self->processable->debian_control; + my $control_item = $debian_control->item; + + # look at d/control source paragraph + my $source_fields = $debian_control->source_fields; + + $self->check_style($source_fields, $control_item); + + for my $installable ($debian_control->installables) { + + # look at d/control installable paragraphs + my $installable_fields + = $debian_control->installable_fields($installable); + + $self->check_style($installable_fields, $control_item); + } + + return; +} + +sub check_style { + my ($self, $fields, $item) = @_; + + for my $name ($fields->names) { + + # title-case the field name + my $standard = lc $name; + $standard =~ s/\b(\w)/\U$1/g; + + # capitalize up to three letters after an X, if followed by hyphen + $standard =~ s/^(X[SBC]{1,3})-/\U$1-/i; + + my $position = $fields->position($name); + my $pointer = $item->pointer($position); + + $self->pointed_hint('cute-field', $pointer, "$name vs $standard") + unless $name eq $standard; + } + + 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/Fields/Subarchitecture.pm b/lib/Lintian/Check/Fields/Subarchitecture.pm new file mode 100644 index 0000000..185f601 --- /dev/null +++ b/lib/Lintian/Check/Fields/Subarchitecture.pm @@ -0,0 +1,55 @@ +# fields/subarchitecture -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Subarchitecture; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + #---- Subarchitecture (udeb) + + # may trigger unfolding tag + my $subarch = $fields->unfolded_value('Subarchitecture'); + + 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/Fields/TerminalControl.pm b/lib/Lintian/Check/Fields/TerminalControl.pm new file mode 100644 index 0000000..0d2b02b --- /dev/null +++ b/lib/Lintian/Check/Fields/TerminalControl.pm @@ -0,0 +1,62 @@ +# fields/terminal-control -- lintian check script -*- perl -*- +# +# Copyright (C) 2020 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::TerminalControl; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $ESCAPE => qq{\033}; + +sub always { + my ($self) = @_; + + my @names = $self->processable->fields->names; + + # fields that contain ESC characters + my @escaped + = grep { index($self->processable->fields->value($_), $ESCAPE) >= 0 } + @names; + + $self->hint('ansi-escape', $_, $self->processable->fields->value($_)) + for @escaped; + + 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/Fields/Trimmed.pm b/lib/Lintian/Check/Fields/Trimmed.pm new file mode 100644 index 0000000..24777f7 --- /dev/null +++ b/lib/Lintian/Check/Fields/Trimmed.pm @@ -0,0 +1,52 @@ +# fields/trimmed -- 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::Fields::Trimmed; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my @all = $self->processable->fields->names; + + for my $name (@all) { + + my $value = $self->processable->fields->value($name); + $self->hint('trimmed-field', $name, $value); + } + + 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/Fields/Unknown.pm b/lib/Lintian/Check/Fields/Unknown.pm new file mode 100644 index 0000000..79a0ddd --- /dev/null +++ b/lib/Lintian/Check/Fields/Unknown.pm @@ -0,0 +1,86 @@ +# fields/unknown -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Unknown; + +use v5.20; +use warnings; +use utf8; + +use Path::Tiny; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +# Whitelist of XS-* source fields +my %source_field_whitelist = ( + 'Autobuild' => 1, + 'Go-Import-Path' => 1, + 'Ruby-Versions' => 1, +); + +sub source { + my ($self) = @_; + + my $KNOWN_SOURCE_FIELDS= $self->data->load('common/source-fields'); + my @unknown= $self->processable->fields->extra($KNOWN_SOURCE_FIELDS->all); + + # The grep filter is a workaround for #1014885 and #1029471 + $self->hint('unknown-field', $_) + for grep { !exists($source_field_whitelist{$_}) } @unknown; + + return; +} + +sub binary { + my ($self) = @_; + + my $KNOWN_BINARY_FIELDS= $self->data->load('fields/binary-fields'); + my @unknown= $self->processable->fields->extra($KNOWN_BINARY_FIELDS->all); + + $self->hint('unknown-field', $_)for @unknown; + + return; +} + +sub udeb { + my ($self) = @_; + + my $KNOWN_UDEB_FIELDS = $self->data->load('fields/udeb-fields'); + my @unknown = $self->processable->fields->extra($KNOWN_UDEB_FIELDS->all); + + $self->hint('unknown-field', $_)for @unknown; + + 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/Fields/Uploaders.pm b/lib/Lintian/Check/Fields/Uploaders.pm new file mode 100644 index 0000000..bfad0c4 --- /dev/null +++ b/lib/Lintian/Check/Fields/Uploaders.pm @@ -0,0 +1,71 @@ +# fields/uploaders -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Uploaders; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Uploaders'); + + my $uploaders = $self->processable->fields->value('Uploaders'); + + # Note, not expected to hit on uploaders anymore, as dpkg + # now strips newlines for the .dsc, and the newlines don't + # hurt in debian/control + + # check for empty field see #783628 + if ($uploaders =~ /,\s*,/) { + $self->hint('uploader-name-missing','you have used a double comma'); + $uploaders =~ s/,\s*,/,/g; + } + + if ($self->processable->fields->declares('Maintainer')) { + + my $maintainer = $self->processable->fields->value('Maintainer'); + + $self->hint('maintainer-also-in-uploaders') + if $uploaders =~ m/\Q$maintainer/; + } + + 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/Fields/Urgency.pm b/lib/Lintian/Check/Fields/Urgency.pm new file mode 100644 index 0000000..7e87309 --- /dev/null +++ b/lib/Lintian/Check/Fields/Urgency.pm @@ -0,0 +1,60 @@ +# fields/urgency -- lintian check script -*- perl -*- + +# Copyright (C) 2020 Felix Lechner +# +# This program is free software. It is distributed 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::Fields::Urgency; + +use v5.20; +use warnings; +use utf8; + +use List::SomeUtils qw(any); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub changes { + my ($self) = @_; + + return + unless $self->processable->fields->declares('Urgency'); + + my $urgency = $self->processable->fields->value('Urgency'); + + # translate to lowercase + my $lowercase = lc $urgency; + + # discard anything after the first word + $lowercase =~ s/ .*//; + + $self->hint('bad-urgency-in-changes-file', $urgency) + unless any { $lowercase =~ $_ } qw(low medium high critical emergency); + + 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/Fields/Vcs.pm b/lib/Lintian/Check/Fields/Vcs.pm new file mode 100644 index 0000000..8bf7858 --- /dev/null +++ b/lib/Lintian/Check/Fields/Vcs.pm @@ -0,0 +1,378 @@ +# fields/vcs -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2019 Chris Lamb <lamby@debian.org> +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Vcs; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(any); + +const my $EMPTY => q{}; +const my $QUESTION_MARK => q{?}; + +const my $NOT_EQUALS => q{!=}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +my %VCS_EXTRACT = ( + Browser => sub { return @_;}, + Arch => sub { return @_;}, + Bzr => sub { return @_;}, + # cvs rootdir followed by optional module name: + Cvs => sub { return shift =~ /^(.+?)(?:\s+(\S*))?$/;}, + Darcs => sub { return @_;}, + # hg uri followed by optional -b branchname + Hg => sub { return shift =~ /^(.+?)(?:\s+-b\s+(\S*))?$/;}, + # git uri followed by optional "[subdir]", "-b branchname" etc. + Git => sub { + return shift =~ /^(.+?)(?:(?:\s+\[(\S*)\])?(?:\s+-b\s+(\S*))?){0,2}$/; + }, + Svn => sub { return @_;}, + # New "mtn://host?branch" uri or deprecated "host branch". + Mtn => sub { return shift =~ /^(.+?)(?:\s+\S+)?$/;}, +); + +my %VCS_CANONIFY = ( + Browser => sub { + $_[0] =~ s{https?://svn\.debian\.org/wsvn/} + {https://anonscm.debian.org/viewvc/}; + $_[0] =~ s{https?\Q://git.debian.org/?p=\E} + {https://anonscm.debian.org/git/}; + $_[0] =~ s{https?\Q://bzr.debian.org/loggerhead/\E} + {https://anonscm.debian.org/loggerhead/}; + $_[0] =~ s{https?\Q://salsa.debian.org/\E([^/]+/[^/]+)\.git/?$} + {https://salsa.debian.org/$1}; + + if ($_[0] =~ m{https?\Q://anonscm.debian.org/viewvc/\E}xsm) { + if ($_[0] =~ s{\?(.*[;\&])?op=log(?:[;\&](.*))?\Z}{}xsm) { + my (@keep) = ($1, $2, $3); + my $final = join($EMPTY, grep {defined} @keep); + + $_[0] .= $QUESTION_MARK . $final + if $final ne $EMPTY; + + $_[1] = 'vcs-field-bitrotted'; + } + } + }, + Cvs => sub { + if ( + $_[0] =~ s{\@(?:cvs\.alioth|anonscm)\.debian\.org:/cvsroot/} + {\@anonscm.debian.org:/cvs/} + ) { + $_[1] = 'vcs-field-bitrotted'; + } + $_[0]=~ s{\@\Qcvs.alioth.debian.org:/cvs/}{\@anonscm.debian.org:/cvs/}; + }, + Arch => sub { + $_[0] =~ s{https?\Q://arch.debian.org/arch/\E} + {https://anonscm.debian.org/arch/}; + }, + Bzr => sub { + $_[0] =~ s{https?\Q://bzr.debian.org/\E} + {https://anonscm.debian.org/bzr/}; + $_[0] =~ s{https?\Q://anonscm.debian.org/bzr/bzr/\E} + {https://anonscm.debian.org/bzr/}; + }, + Git => sub { + if ( + $_[0] =~ s{git://(?:git|anonscm)\.debian\.org/~} + {https://anonscm.debian.org/git/users/} + ) { + $_[1] = 'vcs-git-uses-invalid-user-uri'; + } + $_[0] =~ s{(https?://.*?\.git)(?:\.git)+$}{$1}; + $_[0] =~ s{https?\Q://git.debian.org/\E(?:git/?)?} + {https://anonscm.debian.org/git/}; + $_[0] =~ s{https?\Q://anonscm.debian.org/git/git/\E} + {https://anonscm.debian.org/git/}; + $_[0] =~ s{\Qgit://git.debian.org/\E(?:git/?)?} + {https://anonscm.debian.org/git/}; + $_[0] =~ s{\Qgit://anonscm.debian.org/git/\E} + {https://anonscm.debian.org/git/}; + $_[0] =~ s{https?\Q://salsa.debian.org/\E([^/]+/[^/\.]+)(?!\.git)$} + {https://salsa.debian.org/$1.git}; + }, + Hg => sub { + $_[0] =~ s{https?\Q://hg.debian.org/\E} + {https://anonscm.debian.org/hg/}; + $_[0] =~ s{https?\Q://anonscm.debian.org/hg/hg/\E} + {https://anonscm.debian.org/hg/}; + }, + Svn => sub { + $_[0] =~ s{\Qsvn://cvs.alioth.debian.org/\E} + {svn://anonscm.debian.org/}; + $_[0] =~ s{\Qsvn://svn.debian.org/\E} + {svn://anonscm.debian.org/}; + $_[0] =~ s{\Qsvn://anonscm.debian.org/svn/\E} + {svn://anonscm.debian.org/}; + }, +); + +# Valid URI formats for the Vcs-* fields +# currently only checks the protocol, not the actual format of the URI +my %VCS_RECOMMENDED_URIS = ( + Browser => qr{^https?://}, + Arch => qr{^https?://}, + Bzr => qr{^(?:lp:|(?:nosmart\+)?https?://)}, + Cvs => qr{^:(?:pserver:|ext:_?anoncvs)}, + Darcs => qr{^https?://}, + Hg => qr{^https?://}, + Git => qr{^(?:git|https?|rsync)://}, + Svn => qr{^(?:svn|(?:svn\+)?https?)://}, + Mtn => qr{^mtn://}, +); + +my %VCS_VALID_URIS = ( + Arch => qr{^https?://}, + Bzr => qr{^(?:sftp|(?:bzr\+)?ssh)://}, + Cvs => qr{^(?:-d\s*)?:(?:ext|pserver):}, + Hg => qr{^ssh://}, + Git => qr{^(?:git\+)?ssh://|^[\w.]+@[a-zA-Z0-9.]+:[/a-zA-Z0-9.]}, + Svn => qr{^(?:svn\+)?ssh://}, + Mtn => qr{^[\w.-]+$}, +); + +has VCS_HOSTERS_BY_PATTERN => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my %vcs_hosters_by_pattern; + + my $KNOWN_VCS_HOSTERS + = $self->data->load('fields/vcs-hosters',qr/\s*~~\s*/); + + for my $pattern ($KNOWN_VCS_HOSTERS->all) { + + my @known_hosters + = split(m{,}, $KNOWN_VCS_HOSTERS->value($pattern)); + $vcs_hosters_by_pattern{$pattern} = \@known_hosters; + } + + return \%vcs_hosters_by_pattern; + } +); + +sub always { + my ($self) = @_; + + my $type = $self->processable->type; + my $processable = $self->processable; + + # team-maintained = maintainer or uploaders field contains a mailing list + my $is_teammaintained = 0; + my $team_email = $EMPTY; + # co-maintained = maintained by an informal group of people, + # i. e. >= 1 uploader and not team-maintained + my $is_comaintained = 0; + my $is_maintained_by_individual = 1; + my $num_uploaders = 0; + for my $field (qw(Maintainer Uploaders)) { + + next + unless $processable->fields->declares($field); + + my $maintainer = $processable->fields->unfolded_value($field); + + if ($maintainer =~ /\b(\S+\@lists(?:\.alioth)?\.debian\.org)\b/ + || $maintainer =~ /\b(\S+\@tracker\.debian\.org)\b/) { + $is_teammaintained = 1; + $team_email = $1; + $is_maintained_by_individual = 0; + } + + if ($field eq 'Uploaders') { + + # check for empty field see #783628 + $maintainer =~ s/,\s*,/,/g + if $maintainer =~ m/,\s*,/; + + my @uploaders = map { split /\@\S+\K\s*,\s*/ } + split />\K\s*,\s*/, $maintainer; + + $num_uploaders = scalar @uploaders; + + if (@uploaders) { + $is_comaintained = 1 + unless $is_teammaintained; + $is_maintained_by_individual = 0; + } + + } + } + + $self->hint('package-is-team-maintained', $team_email, + "(with $num_uploaders uploaders)") + if $is_teammaintained; + $self->hint('package-is-co-maintained', "(with $num_uploaders uploaders)") + if $is_comaintained; + $self->hint('package-is-maintained-by-individual') + if $is_maintained_by_individual; + + my %seen_vcs; + for my $platform (keys %VCS_EXTRACT) { + + my $splitter = $VCS_EXTRACT{$platform}; + + my $fieldname = "Vcs-$platform"; + my $maintainer = $processable->fields->value('Maintainer'); + + next + unless $processable->fields->declares($fieldname); + + my $uri = $processable->fields->unfolded_value($fieldname); + + my @parts = $splitter->($uri); + if (not @parts or not $parts[0]) { + $self->hint('vcs-field-uses-unknown-uri-format', $platform, $uri); + } else { + if ( $VCS_RECOMMENDED_URIS{$platform} + and $parts[0] !~ $VCS_RECOMMENDED_URIS{$platform}) { + if ( $VCS_VALID_URIS{$platform} + and $parts[0] =~ $VCS_VALID_URIS{$platform}) { + $self->hint('vcs-field-uses-not-recommended-uri-format', + $platform, $uri); + } else { + $self->hint('vcs-field-uses-unknown-uri-format', + $platform,$uri); + } + } + + $self->hint('vcs-field-has-unexpected-spaces', $platform, $uri) + if (any { $_ and /\s/} @parts); + + $self->hint('vcs-field-uses-insecure-uri', $platform, $uri) + if $parts[0] =~ m{^(?:git|(?:nosmart\+)?http|svn)://} + || $parts[0] =~ m{^(?:lp|:pserver):}; + } + + if ($VCS_CANONIFY{$platform}) { + + my $canonicalized = $parts[0]; + my $tag = 'vcs-field-not-canonical'; + + foreach my $canonify ($VCS_CANONIFY{$platform}) { + $canonify->($canonicalized, $tag); + } + + $self->hint($tag, $platform, $parts[0], $canonicalized) + unless $canonicalized eq $parts[0]; + } + + if ($platform eq 'Browser') { + + $self->hint('vcs-browser-links-to-empty-view', $uri) + if $uri =~ /rev=0&sc=0/; + + } else { + $self->hint('vcs', lc $platform); + $self->hint('vcs-uri', $platform, $uri); + $seen_vcs{$platform}++; + + for my $pattern (keys %{$self->VCS_HOSTERS_BY_PATTERN}) { + + # warn once + my $known_hoster + = @{$self->VCS_HOSTERS_BY_PATTERN->{$pattern}}[0]; + + $self->hint('vcs-field-mismatch', + "Vcs-$platform", $NOT_EQUALS, "Vcs-$known_hoster",$uri) + if $uri =~ m/^ $pattern /xi + && $platform ne $known_hoster + && $platform ne 'Browser'; + } + } + + if ($uri =~ m{//(.+)\.debian\.org/}) { + + $self->hint('vcs-obsolete-in-debian-infrastructure', + $platform, $uri) + unless $1 =~ m{^(?:salsa|.*\.dgit)$}; + + } + + # orphaned + if ($maintainer =~ /packages\@qa.debian.org/ && $platform ne 'Browser') + { + if ($uri =~ m{//(?:.+)\.debian\.org/}) { + + $self->hint('orphaned-package-maintained-in-private-space', + $fieldname, $uri) + unless $uri =~ m{//salsa\.debian\.org/debian/} + || $uri =~ m{//git\.dgit\.debian\.org/}; + + } else { + + $self->hint( + 'orphaned-package-not-maintained-in-debian-infrastructure', + $fieldname, $uri + ); + } + } + } + + $self->hint('vcs-fields-use-more-than-one-vcs', + (sort map { lc } keys %seen_vcs)) + if keys %seen_vcs > 1; + + $self->hint('co-maintained-package-with-no-vcs-fields') + if $type eq 'source' + and ($is_comaintained or $is_teammaintained) + and not %seen_vcs; + + # Check for missing Vcs-Browser headers + unless ($processable->fields->declares('Vcs-Browser')) { + + for my $pattern (keys %{$self->VCS_HOSTERS_BY_PATTERN}) { + + # warn once + my $platform = @{$self->VCS_HOSTERS_BY_PATTERN->{$pattern}}[0]; + + my $fieldname = "Vcs-$platform"; + my $url = $processable->fields->value($fieldname); + + $self->hint('missing-vcs-browser-field', $fieldname, $url) + if $url =~ m/^ $pattern /xi; + } + } + + 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/Fields/Version.pm b/lib/Lintian/Check/Fields/Version.pm new file mode 100644 index 0000000..77ee0f9 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version.pm @@ -0,0 +1,100 @@ +# fields/version -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version; + +use v5.20; +use warnings; +use utf8; + +use Dpkg::Version; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub always { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + my $dversion = Dpkg::Version->new($version); + unless ($dversion->is_valid) { + $self->hint('bad-version-number', $version); + return; + } + + my ($epoch, $upstream, $debian) + = ($dversion->epoch, $dversion->version, $dversion->revision); + + # Dpkg::Version sets the debian revision to 0 if there is + # no revision. So we need to check if the raw version + # ends with "-0". + $self->hint('debian-revision-is-zero', $version) + if $version =~ /-0$/; + + my $ubuntu; + if($debian =~ /^(?:[^.]+)(?:\.[^.]+)?(?:\.[^.]+)?(\..*)?$/){ + my $extra = $1; + if ( + defined $extra + && $debian =~ m{\A + (?:[^.]+ubuntu[^.]+)(?:\.\d+){1,3}(\..*)? + \Z}xsm + ) { + $ubuntu = 1; + $extra = $1; + } + + $self->hint('debian-revision-not-well-formed', $version) + if defined $extra; + + } else { + $self->hint('debian-revision-not-well-formed', $version); + } + + if ($self->processable->type eq 'source') { + + $self->hint('binary-nmu-debian-revision-in-source', $version) + if ($debian =~ /^[^.-]+\.[^.-]+\./ && !$ubuntu) + || $version =~ /\+b\d+$/; + } + + 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/Fields/Version/Derivative.pm b/lib/Lintian/Check/Fields/Version/Derivative.pm new file mode 100644 index 0000000..9385fa4 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Derivative.pm @@ -0,0 +1,82 @@ +# fields/version/derivative -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Derivative; + +use v5.20; +use warnings; +use utf8; + +use Dpkg::Version; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + my $dversion = Dpkg::Version->new($version); + return + unless $dversion->is_valid; + + my ($epoch, $upstream, $debian) + = ($dversion->epoch, $dversion->version, $dversion->revision); + + my $DERIVATIVE_VERSIONS + = $self->data->load('fields/derivative-versions',qr/\s*~~\s*/); + + unless ($self->processable->native) { + + for my $pattern ($DERIVATIVE_VERSIONS->all) { + + next + if $version =~ m/$pattern/; + + my $explanation = $DERIVATIVE_VERSIONS->value($pattern); + + $self->hint('invalid-version-number-for-derivative', + $version,"($explanation)"); + } + } + + 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/Fields/Version/Repack/Count.pm b/lib/Lintian/Check/Fields/Version/Repack/Count.pm new file mode 100644 index 0000000..c793385 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Repack/Count.pm @@ -0,0 +1,65 @@ +# fields/version/repack/count -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2021 Kentaro Hayashi +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Repack::Count; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + # repack counts in native packages are dealt with elsewhere + return + if $self->processable->native; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + $self->hint('anticipated-repack-count', $version) + if $version =~ m{ dfsg [01] - }x; + + $self->hint('dot-before-repack-count', $version) + if $version =~ / dfsg [.] \d+ /x; + + 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/Fields/Version/Repack/Native.pm b/lib/Lintian/Check/Fields/Version/Repack/Native.pm new file mode 100644 index 0000000..6ca1602 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Repack/Native.pm @@ -0,0 +1,63 @@ +# fields/version/repack/native -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Repack::Native; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + # Checks for the dfsg convention for repackaged upstream + # source. Only check these against the source package to not + # repeat ourselves too much. + $self->hint('dfsg-version-in-native-package', $version) + if $version =~ /dfsg/ + && $self->processable->native; + + 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/Fields/Version/Repack/Period.pm b/lib/Lintian/Check/Fields/Version/Repack/Period.pm new file mode 100644 index 0000000..12e8928 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Repack/Period.pm @@ -0,0 +1,60 @@ +# fields/version/repack/period -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Repack::Period; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + $self->hint('dfsg-version-with-period', $version) + if $version =~ m{ [.] dfsg }x + && !$self->processable->native; + + 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/Fields/Version/Repack/Tilde.pm b/lib/Lintian/Check/Fields/Version/Repack/Tilde.pm new file mode 100644 index 0000000..206b288 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Repack/Tilde.pm @@ -0,0 +1,60 @@ +# fields/version/repack/tilde -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Kentaro Hayashi +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Repack::Tilde; + +use v5.20; +use warnings; +use utf8; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + $self->hint('dfsg-version-with-tilde', $version) + if $version =~ /~dfsg/ + && !$self->processable->native; + + 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/Fields/Version/Repack/Typo.pm b/lib/Lintian/Check/Fields/Version/Repack/Typo.pm new file mode 100644 index 0000000..c466df2 --- /dev/null +++ b/lib/Lintian/Check/Fields/Version/Repack/Typo.pm @@ -0,0 +1,64 @@ +# fields/version/repack/typo -- lintian check script (rewrite) -*- perl -*- +# +# Copyright (C) 2004 Marc Brockschmidt +# Copyright (C) 2021 Felix Lechner +# +# Parts of the code were taken from the old check script, which +# was Copyright (C) 1998 Richard Braakman (also licensed under the +# GPL 2 or higher) +# +# 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::Fields::Version::Repack::Typo; + +use v5.20; +use warnings; +use utf8; + +use Dpkg::Version qw(version_check); + +use Lintian::Relation::Version qw(versions_compare); + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +sub source { + my ($self) = @_; + + my $fields = $self->processable->fields; + + return + unless $fields->declares('Version'); + + my $version = $fields->unfolded_value('Version'); + + $self->hint('dfsg-version-misspelled', $version) + if $version =~ /dsfg/ + && !$self->processable->native; + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |