diff --git a/corpus/tarbombs/Tarbomb-0.001.tar.gz b/corpus/tarbombs/Tarbomb-0.001.tar.gz new file mode 100644 index 000000000..a7437d9f5 Binary files /dev/null and b/corpus/tarbombs/Tarbomb-0.001.tar.gz differ diff --git a/corpus/tarbombs/Xyzzy-1.000.tar.gz b/corpus/tarbombs/Xyzzy-1.000.tar.gz new file mode 100644 index 000000000..c7f6268f4 Binary files /dev/null and b/corpus/tarbombs/Xyzzy-1.000.tar.gz differ diff --git a/lib/PAUSE/dist.pm b/lib/PAUSE/dist.pm index cb9e50cdc..5ec3143af 100644 --- a/lib/PAUSE/dist.pm +++ b/lib/PAUSE/dist.pm @@ -961,11 +961,33 @@ sub chown_unsafe { $self->{CHOWN_UNSAFE_DONE}++; } +sub has_consistent_prefix { + my ($self, $files) = @_; + my ($prefix) = split m{/}, $files->[0]; + + unless (-d $prefix) { + $Logger->log([ 'top level entry %s is not a directory', $prefix ]); + return undef; + } + + for my $file (@$files) { + my ($file_prefix) = split m{/}, $file; + + next if $file_prefix eq $prefix; + + $Logger->log([ 'inconsistent file prefix between %s and %s', $prefix, $file ]); + return undef; + } + + return 1; +} + sub read_dist { my $self = shift; my @manifind; my $ok = eval { @manifind = sort keys %{ExtUtils::Manifest::manifind()}; 1 }; + $self->{MANIFOUND} = \@manifind; unless ($ok) { my $error = $@; @@ -973,8 +995,14 @@ sub read_dist { return; } + unless ($self->has_consistent_prefix(\@manifind)) { + $self->{SKIP} = 1; + $self->{REASON_TO_SKIP} = PAUSE::mldistwatch::Constants::ETARBOMB; + return; + } + my $manifound = @manifind; - my $dist = $self->{DIST}; + unless (@manifind) { $Logger->log("!? no files in dist"); return; diff --git a/lib/PAUSE/mldistwatch.pm b/lib/PAUSE/mldistwatch.pm index b4c9ec472..e6a8e9319 100644 --- a/lib/PAUSE/mldistwatch.pm +++ b/lib/PAUSE/mldistwatch.pm @@ -457,19 +457,20 @@ sub maybe_index_dist { } } - $dio->examine_dist; # checks for perl, developer, version, etc. and untars + for my $step (qw( examine_dist read_dist )) { + $dio->$step; - if ($dio->skip) { - delete $self->{ALLlasttime}{$dist}; - delete $self->{ALLfound}{$dist}; + if ($dio->skip) { + delete $self->{ALLlasttime}{$dist}; + delete $self->{ALLfound}{$dist}; - if ($dio->{REASON_TO_SKIP}) { - $dio->mail_summary; - } - return; + if ($dio->{REASON_TO_SKIP}) { + $dio->mail_summary; + } + return; + } } - $dio->read_dist; $dio->extract_readme_and_meta; if ($dio->{META_CONTENT}{distribution_type} diff --git a/lib/PAUSE/mldistwatch/Constants.pm b/lib/PAUSE/mldistwatch/Constants.pm index 2d60fb39d..388bfd3c0 100644 --- a/lib/PAUSE/mldistwatch/Constants.pm +++ b/lib/PAUSE/mldistwatch/Constants.pm @@ -13,6 +13,7 @@ use constant EMISSPERM => 20; use constant ELONGVERSION => 13; use constant EBADVERSION => 12; use constant EPARSEVERSION => 10; +use constant ETARBOMB => 8; use constant E_DB_XACTFAIL => 7; use constant EMETAUNSTABLE => 6; use constant EBAREPMFILE => 5; @@ -37,6 +38,7 @@ our $heading = { EOPENFILE() => "Problem while reading the distribtion", EMETAUNSTABLE() => "META release_status is not stable, will not index", EPARSEVERSION() => "Version parsing problem", + ETARBOMB() => "Archive contents aren't all under a common top-level directory", EVERFALLING() => "Decreasing version number", OK() => "Successfully indexed", }; @@ -48,5 +50,3 @@ sub heading ($) { } 1; - - diff --git a/t/mldistwatch-misc.t b/t/mldistwatch-misc.t index bfc9a5d28..3c211b6d5 100644 --- a/t/mldistwatch-misc.t +++ b/t/mldistwatch-misc.t @@ -494,6 +494,42 @@ EOT }); }; +subtest "tarbombs" => sub { + my $pause = PAUSE::TestPAUSE->init_new; + + $pause->upload_author_file('WEIRDO', 'corpus/tarbombs/Tarbomb-0.001.tar.gz'); + $pause->upload_author_file('WEIRDO', 'corpus/tarbombs/Xyzzy-1.000.tar.gz'); + + my $result = $pause->test_reindex; + + $pause->file_not_updated_ok( + $result->tmpdir + ->file(qw(cpan modules 02packages.details.txt.gz)), + "there were no things to update", + ); + + my $tarbomb_message = sub { + like( + $_[0]{email}->object->body_str, + qr/common top-level directory/, + "email contains ETARBOMB string", + ); + }; + + $result->email_ok( + [ + { + subject => 'Failed: PAUSE indexer report WEIRDO/Tarbomb-0.001.tar.gz', + callbacks => [ $tarbomb_message ], + }, + { + subject => 'Failed: PAUSE indexer report WEIRDO/Xyzzy-1.000.tar.gz', + callbacks => [ $tarbomb_message ], + }, + ], + ); +}; + done_testing; # Local Variables: