view release on metacpan or  search on metacpan

t/perms.t  view on Meta::CPAN

    my $parent = Test::MockFile->new_dir( '/perms/mdir', { mode => 0755, uid => 1000, gid => 1000 } );
    my $target = Test::MockFile->dir('/perms/mdir/newdir');

    with_user {
        ok( mkdir('/perms/mdir/newdir'), 'parent owner can mkdir' );
    } 1000, 1000;

    # Clean up and re-mock for next test
    my $parent2 = Test::MockFile->new_dir( '/perms/mdir2', { mode => 0555, uid => 1000, gid => 1000 } );
    my $target2 = Test::MockFile->dir('/perms/mdir2/newdir2');

    with_user {
        ok( !mkdir('/perms/mdir2/newdir2'), 'cannot mkdir in 0555 dir (no write)' );
        is( $! + 0, EACCES, 'mkdir errno is EACCES' );
    } 1000, 1000;
};

# =========================================================================
# rmdir permission checks (needs write+exec on parent)
# =========================================================================

subtest 'rmdir permission checks on parent directory' => sub {
    my $parent = Test::MockFile->new_dir( '/perms/rdir', { mode => 0755, uid => 1000, gid => 1000 } );
    my $target = Test::MockFile->new_dir('/perms/rdir/empty');

    with_user {
        ok( rmdir('/perms/rdir/empty'), 'parent owner can rmdir empty dir' );
    } 1000, 1000;

    my $parent2 = Test::MockFile->new_dir( '/perms/rdir2', { mode => 0555, uid => 1000, gid => 1000 } );
    my $target2 = Test::MockFile->new_dir('/perms/rdir2/empty2');

    with_user {
        ok( !rmdir('/perms/rdir2/empty2'), 'cannot rmdir in 0555 dir (no write)' );
        is( $! + 0, EACCES, 'rmdir errno is EACCES' );
    } 1000, 1000;
};

# =========================================================================
# chmod permission checks (only owner or root)
# =========================================================================

subtest 'chmod permission checks' => sub {
    my $f = Test::MockFile->file( '/perms/chm', 'data', { mode => 0644, uid => 1000, gid => 1000 } );

    with_user {
        is( chmod( 0600, '/perms/chm' ), 1, 'owner can chmod' );
    } 1000, 1000;

    with_user {
        is( chmod( 0777, '/perms/chm' ), 0, 'non-owner cannot chmod' );
        is( $! + 0, EPERM, 'chmod errno is EPERM' );
    } 2000, 2000;

    with_user {
        is( chmod( 0777, '/perms/chm' ), 1, 'root can chmod any file' );
    } 0, 0;
};

# =========================================================================
# chown with mock user
# =========================================================================

subtest 'chown uses mock user identity' => sub {
    my $f = Test::MockFile->file( '/perms/cho', 'data', { mode => 0644, uid => 1000, gid => 1000 } );

    # Non-root mock user cannot chown to a different user
    with_user {
        is( chown( 2000, 2000, '/perms/cho' ), 0, 'non-root mock user cannot chown to different user' );
        is( $! + 0, EPERM, 'chown errno is EPERM' );
    } 1000, 1000;

    # Root mock user can chown
    with_user {
        is( chown( 2000, 2000, '/perms/cho' ), 1, 'root mock user can chown' );
    } 0, 0;
};

# =========================================================================
# Non-existent file bypasses permission checks (ENOENT takes priority)
# =========================================================================

subtest 'non-existent file returns ENOENT not EACCES' => sub {
    my $f = Test::MockFile->file('/perms/noexist');

    with_user {
        ok( !open( my $fh, '<', '/perms/noexist' ), 'cannot open non-existent file' );
        # ENOENT should come before permission check
    } 1000, 1000;
};

# =========================================================================
# Multiple group membership
# =========================================================================

subtest 'user with multiple groups' => sub {
    skip_all 'umask strips group bits' if $restrictive_umask;
    my $f = Test::MockFile->file( '/perms/multigrp', 'data', { mode => 0040, uid => 1000, gid => 500 } );

    # User in secondary group 500
    with_user {
        ok( open( my $fh, '<', '/perms/multigrp' ), 'user in secondary group can read' );
        close $fh if $fh;
    } 2000, 100, 500, 600;

    # User NOT in group 500
    with_user {
        ok( !open( my $fh, '<', '/perms/multigrp' ), 'user not in any matching group cannot read' );
    } 2000, 100, 200, 300;
};

# =========================================================================
# open with write-creating modes checks parent perms
# =========================================================================

subtest 'open > on new file checks parent directory perms' => sub {
    my $parent = Test::MockFile->new_dir( '/perms/wdir', { mode => 0555, uid => 1000, gid => 1000 } );
    my $child  = Test::MockFile->file('/perms/wdir/newfile');

    with_user {
        ok( !open( my $fh, '>', '/perms/wdir/newfile' ), 'cannot create file in read-only parent dir' );
        is( $! + 0, EACCES, 'errno is EACCES' );
    } 1000, 1000;

    my $parent2 = Test::MockFile->new_dir( '/perms/wdir2', { mode => 0755, uid => 1000, gid => 1000 } );
    my $child2  = Test::MockFile->file('/perms/wdir2/newfile2');

    with_user {
        ok( open( my $fh, '>', '/perms/wdir2/newfile2' ), 'can create file in writable parent dir' );
        close $fh if $fh;
    } 1000, 1000;
};

done_testing();