From 5ca0755284c1b4ce1d673bbba8e43045cf13c92c Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Fri, 28 Apr 2023 10:10:41 +0200 Subject: [PATCH] mldistwatch: forbid tarbombs from being indexed Previously, you could upload a tarball with "Foo.pm" in the root and we would index that. From now on, dists must have a top-level directory, and only that one directory. --- corpus/tarbombs/Tarbomb-0.001.tar.gz | Bin 0 -> 157 bytes corpus/tarbombs/Xyzzy-1.000.tar.gz | Bin 0 -> 268 bytes lib/PAUSE/dist.pm | 30 +++++++++++++++++++++- lib/PAUSE/mldistwatch.pm | 19 +++++++------- lib/PAUSE/mldistwatch/Constants.pm | 4 +-- t/mldistwatch-misc.t | 36 +++++++++++++++++++++++++++ 6 files changed, 77 insertions(+), 12 deletions(-) create mode 100644 corpus/tarbombs/Tarbomb-0.001.tar.gz create mode 100644 corpus/tarbombs/Xyzzy-1.000.tar.gz diff --git a/corpus/tarbombs/Tarbomb-0.001.tar.gz b/corpus/tarbombs/Tarbomb-0.001.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..a7437d9f5f9c0e8f826f5e0b32df677b10f664dc GIT binary patch literal 157 zcmV;O0Al|iiwFSCdrM>h0}DwkO3Keo(ksYipcybQFfcPQQ2^2AW~N};zzD*J08=9c zLlYAtBQtYTa|2@q14Cm&LlXuC1KK$W0ZNNY5{rONDauMJ#-|RbEG-R>Jj5poaC(S< zg2d$P#Pn2!5J)<(=E^TEQcwwV4GQ-3_fxP{Fw_J3#+u8}nron4ItoU?C>RB!fSLdR L5Ty@%00;m8`_nm8 literal 0 HcmV?d00001 diff --git a/corpus/tarbombs/Xyzzy-1.000.tar.gz b/corpus/tarbombs/Xyzzy-1.000.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..c7f6268f4bafdad10e657e47806ea63241db37d0 GIT binary patch literal 268 zcmV+n0rUPJiwFP^d`n~i1MQYQZ^AGTKr`o8+`tTH=WI(vj0`MLwNk|z3ZZ-n6q+IV z^>s{C6)FWWIJD*7aziZTl6Stl`6?5=z%PhslmZv^DWarPtN}qJr8dfF1QZe@6@c=b zmm@!ZB$-VmThES7=j^dGZFpXP$5;F#%q#!XqAZKUA(0O%>7 zGalUkA$i**%LTX+h{JuJLFaY&{4$!1VF02lBZ|XN#NoXYWxQbTzx-AG-_-rzaQ|-u z=igm^e^qdUe{F|B)&C_D`)`A9{-3t_^4-T4aDDzq7yd~L!}Grl&gOr=?`q)Z8W8ga Sz%UH+&-euNXmFDN5&!_Rc!F&J literal 0 HcmV?d00001 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: