diff --git a/lib/PAUSE/Indexer/Errors.pm b/lib/PAUSE/Indexer/Errors.pm index 1709fca56..623e4a623 100644 --- a/lib/PAUSE/Indexer/Errors.pm +++ b/lib/PAUSE/Indexer/Errors.pm @@ -300,6 +300,22 @@ pkg_error version_invalid => { } }; +pkg_error version_numeric_literal => { + header => 'Not indexed because version is a very small or large number.', + body => sub { + my ($arg) = @_; + + _assert_args_present(version_numeric_literal => $arg, [ qw(version) ]); + + return <<~"EOF"; + The version in the file is a bare number, not a string, and it is so + small or so large that perl turned it into "$arg->{version}", which is + not a valid version string. Quote the version in your source, like + \$VERSION = '0.000001', so that it is stored as a string. + EOF + }, +}; + pkg_error version_openerr => { header => 'Not indexed because of version handling error.', body => <<~'EOF', @@ -309,15 +325,25 @@ pkg_error version_openerr => { pkg_error version_parse => { header => 'Not indexed because of version parsing error.', - body => <<~'EOF', - The PAUSE indexer was not able to parse the file. + body => sub { + my ($arg) = @_; - Note: the indexer is running in a Safe compartment and cannot provide the - full functionality of perl in the VERSION line. It is trying hard, but - sometime it fails. As a workaround, please consider writing a META.yml - that contains a "provides" attribute, or contact the CPAN admins to - investigate (yet another) workaround against "Safe" limitations. - EOF + _assert_args_present(version_parse => $arg, [ qw(line) ]); + + my $text = "The PAUSE indexer was not able to parse the file."; + + if (length $arg->{line}) { + $text .= " The line it could not evaluate was: $arg->{line}"; + } + + return $text . "\n\n" . <<~'EOF'; + Note: the indexer is running in a Safe compartment and cannot provide the + full functionality of perl in the VERSION line. It is trying hard, but + sometime it fails. As a workaround, please consider writing a META.yml + that contains a "provides" attribute, or contact the CPAN admins to + investigate (yet another) workaround against "Safe" limitations. + EOF + }, }; pkg_error version_too_long => { diff --git a/lib/PAUSE/package.pm b/lib/PAUSE/package.pm index 9a081474d..212274c54 100644 --- a/lib/PAUSE/package.pm +++ b/lib/PAUSE/package.pm @@ -8,6 +8,7 @@ use PAUSE::Logger '$Logger'; use PAUSE::mldistwatch::Constants; use PAUSE::Indexer::Errors; use CPAN::DistnameInfo; +use JSON (); =comment @@ -252,6 +253,8 @@ sub examine_pkg { $ctx->abort_indexing_package($self, PKGERROR('bad_package_name')); } + my $version_error = $self->_extract_version_error; + # Query all users with perms for this package $self->assert_permissions_okay($ctx); @@ -274,15 +277,8 @@ sub examine_pkg { # Parser problem - if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error - my $err = JSON::jsonToObj($pp->{version}); - if ($err->{openerr}) { - # TODO: get $err->{openerr} back in here, I guess? - $ctx->abort_indexing_package($self, PKGERROR('version_openerr')); - } else { - # TODO: get $err->{line} back in here, I guess? - $ctx->abort_indexing_package($self, PKGERROR('version_parse')); - } + if ($version_error) { + $ctx->abort_indexing_package($self, $version_error); } # Sanity checks @@ -297,6 +293,43 @@ sub examine_pkg { delete $self->{FIO}; # circular reference } +# When the version could not be determined, the version parser leaves a JSON +# error blob where the version would be. Left alone, that blob shows up as +# the "version" in reports and alerts, including ones about other problems, +# like missing permissions. So we decode it here, replace it with something +# readable, and return the error to abort indexing with once the permissions +# check has had its say. +sub _extract_version_error { + my ($self) = @_; + + my $pp = $self->{PP}; + + return unless $pp->{version} && $pp->{version} =~ /^\{.*\}$/; + + my $err = JSON::from_json($pp->{version}); + + if ($err->{openerr}) { + # TODO: get $err->{openerr} back in here, I guess? + $pp->{version} = "(file could not be read)"; + return PKGERROR('version_openerr'); + } + + if (defined $err->{numeric_literal}) { + $pp->{version} = $err->{numeric_literal}; + return PKGERROR('version_numeric_literal', { + version => $err->{numeric_literal}, + }); + } + + $pp->{version} = "(could not be parsed)"; + + my $line = $err->{line} // q{}; + $line =~ s/\A\s+//; + $line =~ s/\s+\z//; + + return PKGERROR('version_parse', { line => $line }); +} + sub assert_version_ok { my ($self, $ctx) = @_; diff --git a/lib/PAUSE/pmfile.pm b/lib/PAUSE/pmfile.pm index 695efa1fa..8080b57b7 100644 --- a/lib/PAUSE/pmfile.pm +++ b/lib/PAUSE/pmfile.pm @@ -3,6 +3,7 @@ use warnings; package PAUSE::pmfile; use vars qw($AUTOLOAD); use version (); # to get $version::STRICT +use JSON (); use PAUSE::Logger '$Logger'; @@ -538,13 +539,13 @@ sub parse_version { } if ($@) { warn sprintf("reval failed: err[%s] for eval[%s]", - JSON::objToJson($err,{pretty => 1}), + JSON::to_json($err,{pretty => 1}), $eval, ); - $v = JSON::objToJson($err); + $v = JSON::to_json($err); } } else { - $v = JSON::objToJson({ openerr => $err }); + $v = JSON::to_json({ openerr => $err }); } } if (defined $v) { @@ -568,6 +569,29 @@ sub normalize_version { my $sdv = $dv->stringify($v,1); # second argument prevents ticks $Logger->log("result of normalize_version: $sdv"); + # If the author wrote + # + # $VERSION = 0.000001 + # + # ...instead of... + # + # $VERSION = '0.000001' + # + # ...then when we eval the version value, we get a number. That's bad, + # because we lose fidelity. Sometimes this only means that 1.100 becomes + # 1.1, but the worse case is when a version like 0.000001 becomes 1e-06, + # which can't be turned into a version object with version->new. + # + # When the stringified version looks like scientific notation, we return a + # JSON error blob, the same way parse_version does for other version + # problems, so that examine_pkg can report it to the author instead of + # silently skipping the file. + # + # -- rjbs, 2023-04-28 + if ($sdv =~ /\A[0-9](?:\.[0-9]+)?e[-+]?[0-9]+\z/a) { + return JSON::to_json({ numeric_literal => $sdv }); + } + return $v if $v eq "undef"; return $v if $v =~ /^\{.*\}$/; # JSON object $v =~ s/^\s+//; diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t index 7c4b49b7d..37b6e009a 100644 --- a/t/mldistwatch-misc.t +++ b/t/mldistwatch-misc.t @@ -725,6 +725,98 @@ subtest "indexer ran, but nothing indexed" => sub { ); }; +# Upload a dist where one package's version can't be determined, then check +# that the indexer report shows a readable version for it, not the JSON error +# blob the version parser leaves behind, and that it explains the problem. +sub bad_version_report_ok ($desc, $arg) { + subtest $desc => sub { + my $pause = PAUSE::TestPAUSE->init_new; + + $pause->add_first_come(@$_) for ($arg->{first_come} // [])->@*; + + $pause->upload_author_fake(PERSON => $arg->{dist}, { + packages => $arg->{packages}, + }); + + my $result = $pause->test_reindex; + + if ($arg->{index_updated}) { + $result->assert_index_updated; + } else { + $result->assert_index_not_updated; + } + + my %body_for = map {; + $_->{email}->get_header('Subject') => $_->{email}->object->body_str + } $result->deliveries; + + my ($report) = grep {; /PAUSE indexer report/ } keys %body_for; + my $body = $body_for{$report // ''} // ''; + + like( + $body, + qr/^ \s+ package:\ \Q$arg->{package}\E \r?\n + \s+ version:\ \Q$arg->{version}\E \r?$/xm, + "report shows a readable version for $arg->{package}", + ); + + unlike($body, qr/version: \{/, "no JSON blob as a version in the report"); + + like($body, $_, "report explains the problem") for $arg->{report_like}->@*; + + if (my $alert_like = $arg->{alert_like}) { + my $alert = $body_for{'PAUSE upload indexing error'} // ''; + like($alert, $alert_like, "alert shows a readable version"); + } + }; +} + +bad_version_report_ok("very small version number (as numeric literal)", { + dist => 'Tiny-Version-1.002.tar.gz', + packages => [ + 'Tiny::Version' => { + version => '0.000001', + layout => { version => 'our-literal' }, + }, + ], + package => 'Tiny::Version', + version => '1e-06', + report_like => [ qr/perl turned it into\s+"1e-06"/ ], +}); + +bad_version_report_ok("version that can't be evaluated", { + dist => 'Bad-Version-1.002.tar.gz', + packages => [ + 'Bad::Version' => { + version => 'die("no version for you")', + layout => { version => 'our-literal' }, + }, + ], + package => 'Bad::Version', + version => '(could not be parsed)', + report_like => [ + qr/version parsing error/, + qr/could not evaluate was:\s+our\s+\$VERSION\s+=\s+die\("no\s+version\s+for\s+you"\);/, + ], +}); + +bad_version_report_ok("unparseable version on a package owned by someone else", { + first_come => [ [ OTHER => 'Bad::Version::Theirs' ] ], + index_updated => 1, + dist => 'Bad-Version-1.002.tar.gz', + packages => [ + 'Bad::Version' => { version => '1.002' }, + 'Bad::Version::Theirs' => { + version => 'die("no version for you")', + layout => { version => 'our-literal' }, + }, + ], + package => 'Bad::Version::Theirs', + version => '(could not be parsed)', + report_like => [ qr/required permissions were missing/ ], + alert_like => qr/^\s*version\[\(could not be parsed\)\]\r?$/m, +}); + done_testing; # Local Variables: