diff --git a/MANIFEST b/MANIFEST index 4e177ca..b1dde04 100644 --- a/MANIFEST +++ b/MANIFEST @@ -34,6 +34,7 @@ t/open.t t/open_strict.t t/opendir.t t/path.t +t/perms.t t/plugin-filetemp.t t/plugin.t t/pod-coverage.t diff --git a/lib/Test/MockFile.pm b/lib/Test/MockFile.pm index 86e3781..227ab2d 100644 --- a/lib/Test/MockFile.pm +++ b/lib/Test/MockFile.pm @@ -37,7 +37,7 @@ use Symbol; use Overload::FileCheck '-from-stat' => \&_mock_stat, q{:check}; -use Errno qw/EPERM ENOENT EBADF ELOOP ENOTEMPTY EEXIST EISDIR ENOTDIR EINVAL EXDEV/; +use Errno qw/EPERM EACCES ENOENT EBADF ELOOP ENOTEMPTY EEXIST EISDIR ENOTDIR EINVAL EXDEV/; use constant FOLLOW_LINK_MAX_DEPTH => 10; @@ -668,6 +668,112 @@ sub _validate_strict_rules { } my @plugins; + +# Mock user identity for permission checks (GH #3) +# When set, file operations check Unix permissions against this identity. +# When undef, no permission checks are performed (backward compatible). +my $_mock_uid; +my @_mock_gids; + +=head2 set_user + +Args: ($uid, @gids) + +Sets a mock user identity for permission checking. When set, all +mocked file operations will check Unix permissions (owner/group/other) +against this identity instead of the real process credentials. + +The first gid in C<@gids> is the primary group. If no gids are provided, +the primary group defaults to 0. + + Test::MockFile->set_user(1000, 1000); # uid=1000, gid=1000 + my $f = Test::MockFile->file('/foo', 'bar', { mode => 0600, uid => 0 }); + open(my $fh, '<', '/foo') or die; # dies: EACCES (not owner) + + Test::MockFile->set_user(0, 0); # root can read anything + open(my $fh, '<', '/foo') or die; # succeeds + +=cut + +sub set_user { + my ( $class, $uid, @gids ) = @_; + + defined $uid or croak("set_user() requires a uid argument"); + + $_mock_uid = int $uid; + @_mock_gids = @gids ? map { int $_ } @gids : (0); + + return; +} + +=head2 clear_user + +Clears the mock user identity, disabling permission checks. +File operations will succeed regardless of mode bits (the default +behavior). + + Test::MockFile->clear_user(); + +=cut + +sub clear_user { + $_mock_uid = undef; + @_mock_gids = (); + + return; +} + +# _check_perms($mock, $access) +# Checks Unix permission bits on a mock file object. +# $access is a bitmask: 4=read, 2=write, 1=execute (same as R_OK/W_OK/X_OK) +# Returns 1 if access is allowed, 0 if denied. +# When no mock user is set ($_mock_uid is undef), always returns 1. +sub _check_perms { + my ( $mock, $access ) = @_; + + return 1 unless defined $_mock_uid; + + my $mode = $mock->{'mode'} & S_IFPERMS; + + # Root bypass: root can read/write anything. + # For execute, root needs at least one x bit set. + if ( $_mock_uid == 0 ) { + return ( $access & 1 ) ? ( $mode & 0111 ? 1 : 0 ) : 1; + } + + # Determine which permission triad applies + my $bits; + if ( $_mock_uid == $mock->{'uid'} ) { + $bits = ( $mode >> 6 ) & 07; + } + elsif ( grep { $_ == $mock->{'gid'} } @_mock_gids ) { + $bits = ( $mode >> 3 ) & 07; + } + else { + $bits = $mode & 07; + } + + return ( $bits & $access ) == $access ? 1 : 0; +} + +# _check_parent_perms($path, $access) +# Checks permissions on the parent directory of $path. +# Used for operations that modify directory contents (unlink, mkdir, rmdir). +# Returns 1 if allowed, 0 if denied. +sub _check_parent_perms { + my ( $path, $access ) = @_; + + return 1 unless defined $_mock_uid; + + ( my $parent = $path ) =~ s{ / [^/]+ $ }{}xms; + $parent = '/' if $parent eq ''; + + my $parent_mock = _get_file_object($parent); + return 1 unless $parent_mock; # Parent not mocked, skip check + + return _check_perms( $parent_mock, $access ); +} + my @_tmf_callers; # Packages where autodie was active when T::MF was imported. @@ -2506,6 +2612,29 @@ sub _io_file_mock_open { $rw .= 'w' if grep { $_ eq $mode } qw/+< +> +>> > >>/; $rw .= 'a' if grep { $_ eq $mode } qw/>> +>>/; + # Permission check (GH #3) + if ( defined $_mock_uid ) { + if ( defined $mock_file->contents() ) { + # Existing file: check file permissions + my $need = 0; + $need |= 4 if $rw =~ /r/; + $need |= 2 if $rw =~ /w/; + if ( !_check_perms( $mock_file, $need ) ) { + $! = EACCES; + _throw_autodie( 'open', @_ ) if _caller_has_autodie_for('open'); + return undef; + } + } + elsif ( $rw =~ /w/ ) { + # Creating new file: check parent dir write+execute + if ( !_check_parent_perms( $abs_path, 2 | 1 ) ) { + $! = EACCES; + _throw_autodie( 'open', @_ ) if _caller_has_autodie_for('open'); + return undef; + } + } + } + # Tie the existing IO::File glob directly (don't create a new one) tie *{$fh}, 'Test::MockFile::FileHandle', $abs_path, $rw; @@ -2820,6 +2949,27 @@ sub __open (*;$@) { $rw .= 'w' if grep { $_ eq $mode } qw/+< +> +>> > >>/; $rw .= 'a' if grep { $_ eq $mode } qw/>> +>>/; + # Permission check (GH #3) — IO::File path must match __open + if ( defined $_mock_uid ) { + if ( defined $mock_file->contents() ) { + my $need = 0; + $need |= 4 if $rw =~ /r/; + $need |= 2 if $rw =~ /w/; + if ( !_check_perms( $mock_file, $need ) ) { + $! = EACCES; + _throw_autodie( 'open', @_ ) if _caller_has_autodie_for('open'); + return undef; + } + } + elsif ( $rw =~ /w/ ) { + if ( !_check_parent_perms( $abs_path, 2 | 1 ) ) { + $! = EACCES; + _throw_autodie( 'open', @_ ) if _caller_has_autodie_for('open'); + return undef; + } + } + } + my $filefh = IO::File->new; tie *{$filefh}, 'Test::MockFile::FileHandle', $abs_path, $rw; @@ -3003,6 +3153,27 @@ sub __sysopen (*$$;$) { return undef; } + # Permission check (GH #3) + if ( defined $_mock_uid ) { + if ( defined $mock_file->{'contents'} ) { + my $need = 0; + $need |= 4 if $rw =~ /r/; + $need |= 2 if $rw =~ /w/; + if ( !_check_perms( $mock_file, $need ) ) { + $! = EACCES; + _throw_autodie( 'sysopen', @_ ) if _caller_has_autodie_for('sysopen'); + return undef; + } + } + elsif ( $rw =~ /w/ ) { + if ( !_check_parent_perms( $mock_file->{'path'}, 2 | 1 ) ) { + $! = EACCES; + _throw_autodie( 'sysopen', @_ ) if _caller_has_autodie_for('sysopen'); + return undef; + } + } + } + $abs_path //= $mock_file->{'path'}; $_[0] = IO::File->new; @@ -3070,6 +3241,13 @@ sub __opendir (*$) { return undef; } + # Permission check: opendir needs read permission on directory (GH #3) + if ( defined $_mock_uid && !_check_perms( $mock_dir, 4 ) ) { + $! = EACCES; + _throw_autodie( 'opendir', @_ ) if _caller_has_autodie_for('opendir'); + return undef; + } + if ( !defined $_[0] ) { $_[0] = Symbol::gensym; } @@ -3273,6 +3451,11 @@ sub __unlink (@) { $files_deleted += CORE::unlink($file); } else { + # Permission check: unlink needs write+execute on parent dir (GH #3) + if ( defined $_mock_uid && !_check_parent_perms( $mock->{'path'}, 2 | 1 ) ) { + $! = EACCES; + next; + } $files_deleted += $mock->unlink; } } @@ -3491,6 +3674,13 @@ sub __mkdir (_;$) { return CORE::mkdir(@_); } + # Permission check: mkdir needs write+execute on parent dir (GH #3) + if ( defined $_mock_uid && !_check_parent_perms( $mock->{'path'}, 2 | 1 ) ) { + $! = EACCES; + _throw_autodie( 'mkdir', @_ ) if _caller_has_autodie_for('mkdir'); + return 0; + } + # File or directory, this exists and should fail if ( $mock->exists ) { $! = EEXIST; @@ -3560,6 +3750,13 @@ sub __rmdir (_) { return 0; } + # Permission check: rmdir needs write+execute on parent dir (GH #3) + if ( defined $_mock_uid && !_check_parent_perms( $mock->{'path'}, 2 | 1 ) ) { + $! = EACCES; + _throw_autodie( 'rmdir', @_ ) if _caller_has_autodie_for('rmdir'); + return 0; + } + if ( grep { $_->exists } _files_in_dir($file) ) { $! = ENOTEMPTY; _throw_autodie( 'rmdir', @_ ) if _caller_has_autodie_for('rmdir'); @@ -3728,18 +3925,22 @@ sub __chown (@) { } # Permission check uses the actual target uid/gid (not -1). + # Use mock user identity if set, otherwise real process credentials (GH #3) + my $eff_uid = defined $_mock_uid ? $_mock_uid : $>; + my $eff_gids = defined $_mock_uid ? join( ' ', @_mock_gids ) : $); + # -1 means "keep as is" and is handled per-file below. - my $target_uid = $uid == -1 ? $> : $uid; - my ($primary_gid) = split /\s/, $); # $) is "gid supplementary..." — extract primary + my $target_uid = $uid == -1 ? $eff_uid : $uid; + my ($primary_gid) = split /\s/, $eff_gids; my $target_gid = $gid == -1 ? $primary_gid : $gid; - my $is_root = $> == 0 || $) =~ /( ^ | \s ) 0 ( \s | $)/xms; - my $is_in_group = grep /(^ | \s ) \Q$target_gid\E ( \s | $ )/xms, $); + my $is_root = $eff_uid == 0 || $eff_gids =~ /( ^ | \s ) 0 ( \s | $)/xms; + my $is_in_group = grep /(^ | \s ) \Q$target_gid\E ( \s | $ )/xms, $eff_gids; # Only check permissions once (before the loop), not per-file. # -1 means "keep as is" — no permission needed for unchanged fields. if ( !$is_root && $uid != -1 && $gid != -1 ) { - if ( $> != $target_uid || !$is_in_group ) { + if ( $eff_uid != $target_uid || !$is_in_group ) { $! = EPERM; _throw_autodie( 'chown', @_ ) if _caller_has_autodie_for('chown'); return 0; @@ -3855,6 +4056,12 @@ sub __chmod (@) { next; } + # Permission check: only owner or root can chmod (GH #3) + if ( defined $_mock_uid && $_mock_uid != 0 && $_mock_uid != $mock->{'uid'} ) { + $! = EPERM; + next; + } + $mock->{'mode'} = ( $mock->{'mode'} & S_IFMT ) | ( $mode & S_IFPERMS ); $mock->{'ctime'} = time; diff --git a/t/perms.t b/t/perms.t new file mode 100644 index 0000000..3010745 --- /dev/null +++ b/t/perms.t @@ -0,0 +1,330 @@ +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; +use Test2::Plugin::NoWarnings; + +use Errno qw( EACCES EPERM ); +use Fcntl qw( O_RDONLY O_WRONLY O_RDWR O_CREAT ); + +use Test::MockFile qw< nostrict >; + +# GitHub issue #3: User perms are not checked on file access. +# When set_user() is active, mock operations check Unix permission bits. + +# ========================================================================= +# Cleanup helper — always clear mock user after each subtest +# ========================================================================= + +sub with_user (&@) { + my ( $code, $uid, @gids ) = @_; + Test::MockFile->set_user( $uid, @gids ); + my $ok = eval { $code->(); 1 }; + my $err = $@; + Test::MockFile->clear_user(); + die $err unless $ok; +} + +# ========================================================================= +# set_user / clear_user basics +# ========================================================================= + +subtest 'set_user and clear_user' => sub { + + # No mock user by default — open should succeed regardless of mode + my $f = Test::MockFile->file( '/perms/basic', 'hello', { mode => 0000, uid => 99, gid => 99 } ); + + ok( open( my $fh, '<', '/perms/basic' ), 'open succeeds with 0000 mode when no mock user set' ); + close $fh if $fh; + + # With mock user set, 0000 mode should fail for non-root + Test::MockFile->set_user( 1000, 1000 ); + ok( !open( my $fh2, '<', '/perms/basic' ), 'open fails with 0000 mode when mock user is non-owner' ); + is( $! + 0, EACCES, 'errno is EACCES' ); + + # clear_user disables checks again + Test::MockFile->clear_user(); + ok( open( my $fh3, '<', '/perms/basic' ), 'open succeeds again after clear_user' ); + close $fh3 if $fh3; +}; + +# ========================================================================= +# open() permission checks +# ========================================================================= + +subtest 'open read-only with owner read permission' => sub { + my $f = Test::MockFile->file( '/perms/owner_r', 'data', { mode => 0400, uid => 1000, gid => 1000 } ); + + with_user { ok( open( my $fh, '<', '/perms/owner_r' ), 'owner can read 0400 file' ); close $fh if $fh } 1000, 1000; + with_user { ok( !open( my $fh, '<', '/perms/owner_r' ), 'other user cannot read 0400 file' ) } 2000, 2000; +}; + +subtest 'open write-only with owner write permission' => sub { + my $f = Test::MockFile->file( '/perms/owner_w', 'data', { mode => 0200, uid => 1000, gid => 1000 } ); + + with_user { ok( open( my $fh, '>', '/perms/owner_w' ), 'owner can write 0200 file' ); close $fh if $fh } 1000, 1000; + with_user { ok( !open( my $fh, '>', '/perms/owner_w' ), 'other user cannot write 0200 file' ) } 2000, 2000; +}; + +subtest 'open read-write with owner rw permission' => sub { + my $f = Test::MockFile->file( '/perms/owner_rw', 'data', { mode => 0600, uid => 1000, gid => 1000 } ); + + with_user { ok( open( my $fh, '+<', '/perms/owner_rw' ), 'owner can rw 0600 file' ); close $fh if $fh } 1000, 1000; + with_user { ok( !open( my $fh, '+<', '/perms/owner_rw' ), 'other user cannot rw 0600 file' ) } 2000, 2000; +}; + +subtest 'open with group permissions' => sub { + my $f = Test::MockFile->file( '/perms/grp', 'data', { mode => 0040, uid => 1000, gid => 500 } ); + + # User in group 500 can read + with_user { ok( open( my $fh, '<', '/perms/grp' ), 'group member can read 0040 file' ); close $fh if $fh } 2000, 500; + + # User NOT in group 500 cannot read + with_user { ok( !open( my $fh, '<', '/perms/grp' ), 'non-group member cannot read 0040 file' ) } 2000, 2000; +}; + +subtest 'open with other permissions' => sub { + my $f = Test::MockFile->file( '/perms/other', 'data', { mode => 0004, uid => 1000, gid => 1000 } ); + + # Random user can read via "other" bits + with_user { ok( open( my $fh, '<', '/perms/other' ), 'other user can read 0004 file' ); close $fh if $fh } 9999, 9999; + + # Owner cannot read (owner bits are 0) + with_user { ok( !open( my $fh, '<', '/perms/other' ), 'owner cannot read when owner bits are 0' ) } 1000, 1000; +}; + +# ========================================================================= +# root bypass +# ========================================================================= + +subtest 'root can read/write any file' => sub { + my $f = Test::MockFile->file( '/perms/root', 'secret', { mode => 0000, uid => 1000, gid => 1000 } ); + + with_user { + ok( open( my $fh, '<', '/perms/root' ), 'root can read 0000 file' ); + close $fh if $fh; + } 0, 0; + + with_user { + ok( open( my $fh, '>', '/perms/root' ), 'root can write 0000 file' ); + close $fh if $fh; + } 0, 0; +}; + +# ========================================================================= +# sysopen permission checks +# ========================================================================= + +subtest 'sysopen permission checks' => sub { + my $f = Test::MockFile->file( '/perms/sys', 'data', { mode => 0400, uid => 1000, gid => 1000 } ); + + with_user { + ok( sysopen( my $fh, '/perms/sys', O_RDONLY ), 'owner can sysopen O_RDONLY on 0400' ); + close $fh if $fh; + } 1000, 1000; + + with_user { + ok( !sysopen( my $fh, '/perms/sys', O_RDONLY ), 'non-owner cannot sysopen O_RDONLY on 0400' ); + is( $! + 0, EACCES, 'sysopen errno is EACCES' ); + } 2000, 2000; + + with_user { + ok( !sysopen( my $fh, '/perms/sys', O_WRONLY ), 'owner cannot sysopen O_WRONLY on 0400 (no write bit)' ); + is( $! + 0, EACCES, 'sysopen errno is EACCES for write' ); + } 1000, 1000; +}; + +# ========================================================================= +# opendir permission checks +# ========================================================================= + +subtest 'opendir permission checks' => sub { + my $dir = Test::MockFile->new_dir( '/perms/dir', { mode => 0700, uid => 1000, gid => 1000 } ); + + with_user { + ok( opendir( my $dh, '/perms/dir' ), 'owner can opendir 0700 dir' ); + closedir $dh if $dh; + } 1000, 1000; + + with_user { + ok( !opendir( my $dh, '/perms/dir' ), 'non-owner cannot opendir 0700 dir' ); + is( $! + 0, EACCES, 'opendir errno is EACCES' ); + } 2000, 2000; +}; + +subtest 'opendir group read permission' => sub { + my $dir = Test::MockFile->new_dir( '/perms/grpdir', { mode => 0050, uid => 1000, gid => 500 } ); + + with_user { + ok( opendir( my $dh, '/perms/grpdir' ), 'group member can opendir 0050 dir' ); + closedir $dh if $dh; + } 2000, 500; + + with_user { + ok( !opendir( my $dh, '/perms/grpdir' ), 'non-group cannot opendir 0050 dir' ); + } 2000, 2000; +}; + +# ========================================================================= +# unlink permission checks (needs write+exec on parent) +# ========================================================================= + +subtest 'unlink permission checks on parent directory' => sub { + my $parent = Test::MockFile->new_dir( '/perms/udir', { mode => 0755, uid => 1000, gid => 1000 } ); + my $child = Test::MockFile->file( '/perms/udir/victim', 'gone' ); + + # Owner of parent can unlink + with_user { + is( unlink('/perms/udir/victim'), 1, 'parent owner can unlink child' ); + } 1000, 1000; + + # Re-create the file for next test + $child = Test::MockFile->file( '/perms/udir/victim2', 'gone2' ); + + # Non-owner, non-group with only read+exec on parent (0755 → other=rx) + # Other has r(4)+x(1) = 5, needs w(2)+x(1) = 3 — missing write + with_user { + is( unlink('/perms/udir/victim2'), 0, 'non-owner cannot unlink in 0755 dir (no write)' ); + is( $! + 0, EACCES, 'unlink errno is EACCES' ); + } 9999, 9999; +}; + +# ========================================================================= +# mkdir permission checks (needs write+exec on parent) +# ========================================================================= + +subtest 'mkdir permission checks on parent directory' => sub { + 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 { + 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();