Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

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

Merged
merged 5 commits into from
Mar 13, 2014
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
c9f833b
treat index line minimum as include, not exclusive
rjbs Mar 13, 2014
427440f
allow us to test starting with an empty PAUSE
rjbs Mar 13, 2014
e4570ae
make test pauses easy to spin up
rjbs Mar 13, 2014
d140910
test that we refuse new modules if there is any kind of permission
rjbs Mar 13, 2014
d3e76f3
treat any kind of permission grant as an auth
rjbs Mar 13, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion lib/PAUSE/mldistwatch.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
50 changes: 18 additions & 32 deletions lib/PAUSE/package.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions t/lib/PAUSE/TestPAUSE.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,

Expand Down
80 changes: 72 additions & 8 deletions t/mldistwatch.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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:
Expand Down