diff options
Diffstat (limited to 'lib/Lintian/Check/Fields/StandardsVersion.pm')
| -rw-r--r-- | lib/Lintian/Check/Fields/StandardsVersion.pm | 164 |
1 files changed, 164 insertions, 0 deletions
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 |