Skip to content

Loading…

Make it harder (impossible?) to hijack a dist #82

Merged
merged 5 commits into from

3 participants

@rjbs
Collaborator

Right now, there are several cases where a user can get first-come on a dist where (a) the user has no permission and (b) other users do have some permissions.

This plugs that hole.

@andk andk merged commit d3e76f3 into andk:master
@rjbs rjbs deleted the rjbs:critical-security branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Showing with 93 additions and 43 deletions.
  1. +1 −1 lib/PAUSE/mldistwatch.pm
  2. +18 −32 lib/PAUSE/package.pm
  3. +2 −2 t/lib/PAUSE/TestPAUSE.pm
  4. +72 −8 t/mldistwatch.t
View
2 lib/PAUSE/mldistwatch.pm
@@ -547,7 +547,7 @@ sub rewrite02 {
my $numlines = @listing02;
die "Absurd small number of lines"
- unless $numlines > $PAUSE::Config->{ML_MIN_INDEX_LINES};
+ unless $numlines >= $PAUSE::Config->{ML_MIN_INDEX_LINES};
my $header = qq{File: 02packages.details.txt
URL: http://www.perl.com/CPAN/modules/02packages.details.txt
View
50 lib/PAUSE/package.pm
@@ -129,6 +129,24 @@ sub perm_check {
my $ins_perms = "INSERT INTO perms (package, userid) VALUES ".
"('$package', '$userid')";
+ # package has any authorized maintainers? --> case insensitive
+ my($auth_ids) = $dbh->selectall_arrayref(qq{
+ SELECT package, userid
+ FROM primeur
+ WHERE LOWER(package) = LOWER(?)
+ UNION
+ SELECT package, userid
+ FROM perms
+ WHERE LOWER(package) = LOWER(?)
+ UNION
+ SELECT modid, userid
+ FROM mods
+ WHERE LOWER(modid) = LOWER(?)
+ },
+ undef,
+ ($package) x 3,
+ );
+
if ($self->{FIO}{DIO} && $self->{FIO}{DIO}->isa_regular_perl($dist)) {
local($dbh->{RaiseError}) = 0;
local($dbh->{PrintError}) = 0;
@@ -161,38 +179,6 @@ sub perm_check {
return 1; # P2.1, P3.0
}
- # does this package already primary maintainer? -> case insensitive
- my($has_primeur) = $dbh->selectrow_hashref(qq{SELECT package
- FROM primeur
- WHERE LOWER(package) = LOWER(?)},
- undef,
- $package);
- if (! $has_primeur) {
- # does this package exist in mods? -> case insensitive
- my($has_owner) = $dbh->selectrow_hashref(qq{SELECT modid
- FROM mods
- WHERE modid = ?},
- undef,
- $package);
- if (! $has_owner) {
- # package has neither owner in mods nor maintainer in primeur
- local($dbh->{RaiseError}) = 0;
- my $ret = $dbh->do($ins_perms);
- my $err = "";
- $err = $dbh->errstr unless defined $ret;
- $ret ||= "";
- $self->verbose(1,"Got unowned package: insperms[$ins_perms]ret[$ret]err[$err]\n");
-
- return 1; # P2.2, P3.0
- }
- }
-
- # package has any authorized maintainers? --> case insensitive
- my($auth_ids) = $dbh->selectall_arrayref(qq{SELECT package, userid
- FROM perms
- WHERE LOWER(package) = LOWER(?)},
- undef,
- $package);
if (@$auth_ids) {
# we have a package that is already known
View
4 t/lib/PAUSE/TestPAUSE.pm
@@ -115,8 +115,8 @@ sub _build_pause_config_overrides {
MLROOT => File::Spec->catdir($ml_root),
ML_CHOWN_GROUP => +(getgrgid($)))[0],
ML_CHOWN_USER => +(getpwuid($>))[0],
- ML_MIN_FILES => 1,
- ML_MIN_INDEX_LINES => 1,
+ ML_MIN_FILES => 0,
+ ML_MIN_INDEX_LINES => 0,
MOD_DATA_SOURCE_NAME => "$dsnbase/mod.sqlite",
PID_DIR => $pid_dir,
View
80 t/mldistwatch.t
@@ -16,19 +16,26 @@ use PAUSE::TestPAUSE;
use Test::Deep qw(cmp_deeply superhashof methods);
use Test::More;
-my $pause = PAUSE::TestPAUSE->new;
+sub init_test_pause {
+ my $pause = PAUSE::TestPAUSE->new;
-$pause->import_author_root('corpus/mld/001/authors');
+ my $authors_dir = $pause->tmpdir->subdir(qw(cpan authors id));
+ make_path $authors_dir->stringify;
-my $modules_dir = $pause->tmpdir->subdir(qw(cpan modules));
-make_path $modules_dir->stringify;
-my $index_06 = $modules_dir->file(qw(06perms.txt.gz));
+ my $modules_dir = $pause->tmpdir->subdir(qw(cpan modules));
+ make_path $modules_dir->stringify;
+ my $index_06 = $modules_dir->file(qw(06perms.txt.gz));
-{
- File::Copy::copy('corpus/empty.txt.gz', $index_06->stringify)
- or die "couldn't set up bogus 06perms: $!";
+ {
+ File::Copy::copy('corpus/empty.txt.gz', $index_06->stringify)
+ or die "couldn't set up bogus 06perms: $!";
+ }
+ return $pause;
}
+my $pause = init_test_pause;
+$pause->import_author_root('corpus/mld/001/authors');
+
sub file_updated_ok {
my ($filename, $desc) = @_;
state %last_value;
@@ -374,6 +381,63 @@ subtest "perl-\\d should not get indexed" => sub {
);
};
+sub refused_upload_test {
+ my ($code) = @_;
+
+ sub {
+ my $pause = init_test_pause;
+
+ my $db_file = File::Spec->catfile($pause->db_root, 'mod.sqlite');
+ my $dbh = DBI->connect(
+ 'dbi:SQLite:dbname=' . $db_file,
+ undef,
+ undef,
+ ) or die "can't connect to db at $db_file: $DBI::errstr";
+
+ $code->($dbh);
+ $pause->import_author_root('corpus/mld/001/authors');
+ my $result = $pause->test_reindex;
+
+ package_list_ok(
+ $result,
+ [
+ { package => 'Hall::MtKing', version => '0.01' },
+ { package => 'XForm::Rollout', version => '1.00' },
+ { package => 'Y', version => 2 },
+ ],
+ );
+
+ my $file = $pause->tmpdir->subdir(qw(cpan modules))->file('06perms.txt');
+ system("cat $file");
+ };
+};
+
+subtest "cannot steal a library when primeur+perms exist" => refused_upload_test(sub {
+ my ($dbh) = @_;
+ $dbh->do("INSERT INTO primeur (package, userid) VALUES ('Bug::Gold','ATRION')")
+ or die "couldn't insert!";
+ $dbh->do("INSERT INTO perms (package, userid) VALUES ('Bug::Gold','ATRION')")
+ or die "couldn't insert!";
+});
+
+subtest "cannot steal a library when only primeur exists" => refused_upload_test(sub {
+ my ($dbh) = @_;
+ $dbh->do("INSERT INTO primeur (package, userid) VALUES ('Bug::Gold','ATRION')")
+ or die "couldn't insert!";
+});
+
+subtest "cannot steal a library when only perms exist" => refused_upload_test(sub {
+ my ($dbh) = @_;
+ $dbh->do("INSERT INTO perms (package, userid) VALUES ('Bug::Gold','ATRION')")
+ or die "couldn't insert!";
+});
+
+subtest "cannot steal a library when only mods exist" => refused_upload_test(sub {
+ my ($dbh) = @_;
+ $dbh->do("INSERT INTO mods (modid, userid) VALUES ('Bug::Gold','ATRION')")
+ or die "couldn't insert!";
+});
+
done_testing;
# Local Variables:
Something went wrong with that request. Please try again.