Test-MockFile
view release on metacpan or search on metacpan
macOS/BSD behavior. PR #307
- GH #292 - Add 'no strict refs' to all dir operation CORE:: fallbacks
to fix bareword filehandle failures on Perl < 5.016. PR #307
- GH #298 - Don't apply umask to explicitly provided mode in file() and
new_dir() constructors. Fixes CPAN smoker failures with restrictive
umasks. PR #299
- GH #297 - Skip real-file flock test when filesystem lacks flock
support (e.g. NFS on FreeBSD). PR #300
- Propagate nlink to all same-inode mocks in link() so 3+ hard links
get consistent nlink values. PR #290
- Fix chown permission check for uid-only and gid-only changes that
previously skipped validation entirely. PR #290
[Maintenance]
- Modernize CI workflow with dynamic Perl versions, disttest job, and
macOS cross-platform coverage. PR #306
- Bump minimum Perl version to 5.16 and remove dead pre-5.16 code
paths. PR #305
0.038 3/20/2026
- Add :trace import tag for logging unmocked file accesses.
- Add file_passthrough() for strict-mode-compatible real filesystem
access with glob pattern support. PR #280
[Bug Fixes]
- GH #175 - Accept both EINVAL and ENOENT for readlink(undef).
- GH #179 - Fix filehandle reference leak. PR #276
- PRINT/PRINTF return false when weakened data ref is gone. PR #283
- Decrement nlink on unlink and preserve inode/nlink on rename. PR #276
- Set realistic nlink and unique inode defaults for mocked files.
- chmod/chown/utime/truncate now follow symlinks per POSIX. PR #287
- Use & ~umask instead of ^ umask for permission masking (multiple
locations).
- chown -1 now preserves per-file uid/gid instead of replacing with
process identity.
- Mask chmod mode with S_IFPERMS to prevent file type corruption.
- Use proper S_IFMT mask in is_link() to avoid false positives.
- Broken symlink stat sets ENOENT, not ELOOP.
- Use Errno constants instead of hardcoded errno values.
- PRINT writes at tell position instead of always appending.
- PRINT returns boolean 1, not byte count.
- Handle output record separator ($\) in PRINT for say() support.
- Update tell position after PRINT/WRITE/PRINTF operations.
- syswrite/printf must not inherit $\ from PRINT delegation.
- readlink returns ENOENT for non-existent mocks.
- lstat on unlinked symlink now returns ENOENT instead of stale stat.
- IO::File open on directory mocks returns EISDIR, append mode preserved.
- open/sysopen through broken symlink creates target file.
- Validate sysread length and return EINVAL on invalid seek whence.
- Correct blocks() calculation and remove dead code.
- Define S_IFPERMS locally instead of importing from Fcntl.
- Capture -s result before passing to is() for Perl < 5.16 compat.
- Apply permissions from sysopen O_CREAT 4th argument.
- Correct bareword check typo $_[9] -> $_[0] in dir functions.
- Pass missing args in chmod/chown passthrough to CORE.
- chown/chmod with broken symlinks no longer confess on multi-file lists.
- Use return undef in failure paths for correct list context.
- Truncate via read-only filehandle returns EINVAL.
- Add EISDIR checks, sysopen symlink following, and O_TRUNC dedup.
[Maintenance]
- Modernize CI workflow: upgrade checkout action and add Perl 5.40-5.42.
- Fix CI workflow permissions for code scanning. PR #284
- Refactor: improve readability and reduce duplication in MockFile.pm.
PR #284
- Add syswrite/sysread edge case test coverage. PR #282
0.035 11/30/2022
- GH #180 - Prevent open() and sysopen() from opening GLOB(..)-like paths.
0.034 4/25/2022
- GH #176: Add file handle support for BINMODE. This does nothing at this
time but at least it doesn't die.
- support for ~/foo and ~user/foo in mocking and access (globs)
0.033 3/7/2022
- Request last Overload::FileCheck release - 0.013
- Correct chown parameter position for file name
- Fixup Plugin for File::Temp tempfile in scalar context logic.
- Track File::Temp version in unit tests.
0.032 2/24/2022
- Less strict mode - Don't complain about commands not opening or directly interacting with a file.
0.031 2/24/2022
- Fix for Plugin::FileTemp when calling tempfile in scalar context
0.030 2/22/2022
- Fix support for mocking the top-level directory.
- Symlinks should appear in readdir
- Fix directory instantiation when creating a symlink.
- GH #105: Show directories in readdir
- Improve relative path management
- Don't let stat() get confused with trailing forward slash
- GH #118: Do not get confused by inner directory files.
- GH #85: Do not corrupt blessed handles.
0.025 1/26/2022
- Fix typo in chmod mock. Was accidentally calling chown.
- Fix dependency on Text::Glob. It is now a runtime requirement.
0.024 1/24/2022
- Prefer Carp::confess to die
- Do not use "$!" in tests as it's not consistent across platforms
- GH #78: Do not allow rmdir on a populated directory.
- GH #73: Prefer the term ->path to ->filename as it is more clear between file/dir
- chown $fh now works.
- Only warn about mixed files when using mocked files
0.024_01
- GH #83: Get Solaris testers passing.
- Remove all use of "$!" in tests as this has tranlation problems.
0.023 1/14/2022
- GH #58: Fix synopsis typos
- GH #65: Fix typos in the typo fixes.
- GH #34: Support open() with barewords
- GH #59: Detect and reject common path mistakes when mocking
- GH #69: Redesigned dir() (and some file()) interface <--- breaks previous interface
- GH #40: Support glob()
- GH #15: Implement chown/chmod
0.022 12/27/2021
- GH #47: Manage bareword filehandles in runtime:
0.021 1/30/2020
- Emit ENOTDIR on opendir when appropriate
- Switch to github actions for CI testing
0.020 10/14/2019
- GH #51 - Basic introduction of file ownership. Set default uid/gid to current user when not set
t/00-load.t
t/autodie_all_functions.t
t/autodie_compat.t
t/autodie_compat_reverse.t
t/autodie_eisdir.t
t/autodie_filesys.t
t/autodie_sysopen.t
t/autodie_sysopen_reverse.t
t/autovivify.t
t/blocks.t
t/chmod-chown-passthrough.t
t/chmod-filetemp.t
t/chmod.t
t/chown-chmod-nostrict.t
t/chown.t
t/creation_timestamps.t
t/cwd_abs_path.t
t/detect-common-mistakes.t
t/dir_interface.t
t/dir_mtime.t
t/enoent_on_nonexistent.t
t/fh-ref-leak.t
t/file_access_hooks.t
t/file_from_disk.t
t/file_passthrough.t
lib/Test/MockFile.pm view on Meta::CPAN
=cut
my $_file_arg_post;
sub file_arg_position_for_command { # can also be used by user hooks
my ( $command, $at_under_ref ) = @_;
$_file_arg_post //= {
'chmod' => 1,
'chown' => 2,
'lstat' => 0,
'mkdir' => 0,
'open' => 2,
'opendir' => 1,
'link' => 0,
'readlink' => 0,
'rename' => 0,
'rmdir' => 0,
'stat' => 0,
'symlink' => 1,
lib/Test/MockFile.pm view on Meta::CPAN
'opendir' => sub (*$) { goto \&__opendir },
'readdir' => sub (*) { goto \&__readdir },
'telldir' => sub (*) { goto \&__telldir },
'rewinddir' => sub (*) { goto \&__rewinddir },
'seekdir' => sub (*$) { goto \&__seekdir },
'closedir' => sub (*) { goto \&__closedir },
'unlink' => sub (@) { goto \&__unlink },
'readlink' => sub (_) { goto \&__readlink },
'mkdir' => sub (_;$) { goto \&__mkdir },
'rmdir' => sub (_) { goto \&__rmdir },
'chown' => sub (@) { goto \&__chown },
'chmod' => sub (@) { goto \&__chmod },
'rename' => sub ($$) { goto \&__rename },
'link' => sub ($$) { goto \&__link },
'symlink' => sub ($$) { goto \&__symlink },
'truncate' => sub ($$) { goto \&__truncate },
'flock' => sub (*$) { goto \&__flock },
'utime' => sub (@) { goto \&__utime },
);
_install_sub( $caller, $_, $subs{$_} ) for keys %subs;
lib/Test/MockFile.pm view on Meta::CPAN
}
sub _get_file_object {
my ($file_path) = @_;
my $file = _find_file_or_fh($file_path) or return;
return $files_being_mocked{$file};
}
# Like _get_file_object but follows symlinks (for chmod, chown, utime, truncate).
# Returns BROKEN_SYMLINK or CIRCULAR_SYMLINK sentinels on symlink errors,
# the mock object on success, or undef if not mocked.
sub _get_file_object_follow_link {
my ($file_path) = @_;
my $resolved = _find_file_or_fh( $file_path, 1 ); # follow symlinks
# Propagate symlink error sentinels
return $resolved if ref $resolved && ( $resolved == BROKEN_SYMLINK || $resolved == CIRCULAR_SYMLINK );
lib/Test/MockFile.pm view on Meta::CPAN
$mock_new->{'ctime'} = $now;
$mock_old->{'ctime'} = $now;
# Update parent directory timestamps (old dir loses entry, new dir gains entry)
_update_parent_dir_times($old);
_update_parent_dir_times($new);
return 1;
}
sub __chown (@) {
my ( $uid, $gid, @files ) = @_;
$^O eq 'MSWin32'
and return 0; # does nothing on Windows
# Not an error, report we changed zero files
@files
or return 0;
# Follow symlinks: chown operates on the target, not the symlink itself
my %mocked_files = map +( $_ => _get_file_object_follow_link($_) ), @files;
my @unmocked_files = grep !$mocked_files{$_}, @files;
my @mocked_files = map { ref $_ && ref $_ ne 'A::BROKEN::SYMLINK' && ref $_ ne 'A::CIRCULAR::SYMLINK' ? $_->{'path'} : () } values %mocked_files;
# The idea is that if some are mocked and some are not,
# it's probably a mistake. Broken/circular symlinks are mocked paths
# (handled per-file below), so they don't count as unmocked.
if ( @mocked_files && @unmocked_files ) {
confess(
sprintf 'You called chown() on a mix of mocked (%s) and unmocked files (%s) ' . ' - this is very likely a bug on your side',
( join ', ', @mocked_files ),
( join ', ', @unmocked_files ),
);
}
# 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 ) : $);
lib/Test/MockFile.pm view on Meta::CPAN
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.
# POSIX: non-root cannot change uid; can only change gid to a group they belong to.
if ( !$is_root ) {
if ( $uid != -1 && $eff_uid != $target_uid ) {
$! = EPERM;
_maybe_throw_autodie( 'chown', @_ );
return 0;
}
if ( $gid != -1 && !$is_in_group ) {
$! = EPERM;
_maybe_throw_autodie( 'chown', @_ );
return 0;
}
}
my $num_changed = 0;
foreach my $file (@files) {
my $mock = $mocked_files{$file};
# If this file is not mocked, none of the files are
# which means we can send them all and let the CORE function handle it
if ( !$mock ) {
_real_file_access_hook( 'chown', \@_ );
goto \&CORE::chown if _goto_is_available();
return CORE::chown( $uid, $gid, @files );
}
# Handle broken/circular symlink errors
if ( ref $mock eq 'A::BROKEN::SYMLINK' ) {
$! = ENOENT;
next;
}
if ( ref $mock eq 'A::CIRCULAR::SYMLINK' ) {
$! = ELOOP;
next;
lib/Test/MockFile.pm view on Meta::CPAN
# -1 means "keep as is" — preserve the file's current value
$mock->{'uid'} = $uid == -1 ? $mock->{'uid'} : $uid;
$mock->{'gid'} = $gid == -1 ? $mock->{'gid'} : $gid;
$mock->{'ctime'} = time;
$num_changed++;
}
if ( $num_changed < scalar(@files) ) {
_maybe_throw_autodie( 'chown', @_ );
}
return $num_changed;
}
sub __chmod (@) {
my ( $mode, @files ) = @_;
# Not an error, report we changed zero files
@files
lib/Test/MockFile.pm view on Meta::CPAN
*CORE::GLOBAL::seekdir = \&__seekdir;
*CORE::GLOBAL::closedir = \&__closedir;
*CORE::GLOBAL::unlink = \&__unlink;
*CORE::GLOBAL::readlink = \&__readlink;
*CORE::GLOBAL::symlink = \&__symlink;
*CORE::GLOBAL::link = \&__link;
*CORE::GLOBAL::mkdir = \&__mkdir;
*CORE::GLOBAL::rename = \&__rename;
*CORE::GLOBAL::rmdir = \&__rmdir;
*CORE::GLOBAL::chown = \&__chown;
*CORE::GLOBAL::chmod = \&__chmod;
*CORE::GLOBAL::flock = \&__flock;
*CORE::GLOBAL::utime = \&__utime;
*CORE::GLOBAL::truncate = \&__truncate;
# Override Cwd functions to resolve mocked symlinks (GH #139)
$_original_cwd_abs_path = \&Cwd::abs_path;
{
no warnings 'redefine';
*Cwd::abs_path = \&__cwd_abs_path;
t/autodie_all_functions.t view on Meta::CPAN
# Skip if autodie is not available
BEGIN {
eval { require autodie };
if ($@) {
plan skip_all => 'autodie not available';
}
}
use autodie qw(opendir closedir unlink readlink mkdir rmdir
rename link symlink truncate chmod chown utime);
use Test::MockFile qw(nostrict);
SKIP: {
# Helper to verify autodie exception
my $check_autodie = sub {
my ($err, $func_name, $test_label) = @_;
ok( defined $err, "$test_label: exception thrown" );
if ( eval { require autodie::exception; 1 } ) {
isa_ok( $err, 'autodie::exception', "$test_label: is autodie::exception" );
like( $err->function, qr/\Q$func_name\E/, "$test_label: function is $func_name" );
t/autodie_all_functions.t view on Meta::CPAN
my $died = !eval {
chmod( 0644, "/ad_chmod_noexist_$$" );
1;
};
my $err = $@;
ok( $died, "chmod dies on non-existent mocked file" );
$check_autodie->( $err, 'chmod', 'chmod ENOENT' );
};
# ---- chown ----
subtest 'chown dies on non-existent file' => sub {
my $file = Test::MockFile->file("/ad_chown_noexist_$$");
my $died = !eval {
chown( $>, (split /\s/, $))[0], "/ad_chown_noexist_$$" );
1;
};
my $err = $@;
ok( $died, "chown dies on non-existent mocked file" );
$check_autodie->( $err, 'chown', 'chown ENOENT' );
};
# ---- utime ----
subtest 'utime dies on non-existent file' => sub {
my $file = Test::MockFile->file("/ad_utime_noexist_$$");
my $died = !eval {
utime( time, time, "/ad_utime_noexist_$$" );
1;
t/autodie_all_functions.t view on Meta::CPAN
# mkdir
mkdir("/ad_success_mkdir_$$");
# rmdir
rmdir("/ad_success_rmdir_$$");
# chmod
chmod( 0755, "/ad_success_rdst_$$" );
# chown
chown( $>, (split /\s/, $))[0], "/ad_success_rdst_$$" );
# utime
utime( time, time, "/ad_success_rdst_$$" );
# unlink
unlink("/ad_success_rdst_$$");
1;
};
t/chmod-chown-passthrough.t view on Meta::CPAN
BEGIN {
$euid = $>;
$egid = int $);
$dir = "/tmp/tmf_passthrough_$$";
CORE::mkdir($dir, 0700) or die "Cannot create $dir: $!";
}
use Test::MockFile qw< nostrict >;
# These tests exercise the passthrough path in __chmod and __chown
# where all files are unmocked and must be forwarded to CORE::chmod/chown
# with the correct arguments (mode for chmod, uid+gid for chown).
subtest(
'chmod passthrough to real filesystem' => sub {
my $file = "$dir/chmod_test";
CORE::open( my $fh, '>', $file ) or die "Cannot create $file: $!";
print {$fh} "test content\n";
close $fh;
# Set to 0644 first via the override (passthrough since not mocked)
t/chmod-chown-passthrough.t view on Meta::CPAN
is(
sprintf( '%04o', $perms ),
'0755',
"chmod passthrough correctly applied mode 0755 to $f",
);
}
}
);
subtest(
'chown passthrough to real filesystem' => sub {
my $file = "$dir/chown_test";
CORE::open( my $fh, '>', $file ) or die "Cannot create $file: $!";
print {$fh} "test content\n";
close $fh;
# chown -1, -1 means "keep as is" - should always succeed
my $result = chown -1, -1, $file;
is( $result, 1, 'chown -1, -1 passthrough returned 1' );
my ( $uid, $gid ) = ( CORE::stat($file) )[ 4, 5 ];
is( $uid, $euid, 'File UID unchanged after chown -1, -1' );
# chown to current user/group - should always succeed
$result = chown $euid, $egid, $file;
is( $result, 1, 'chown to current user/group passthrough returned 1' );
( $uid, $gid ) = ( CORE::stat($file) )[ 4, 5 ];
is( $uid, $euid, 'File UID correct after chown' );
is( $gid, $egid, 'File GID correct after chown' );
}
);
done_testing();
# Cleanup
END {
if ( defined $dir && -d $dir ) {
CORE::unlink glob("$dir/*");
CORE::rmdir $dir;
t/chown-chmod-nostrict.t view on Meta::CPAN
my $egid = int $);
my $filename = __FILE__;
my $file = Test::MockFile->file( $filename, 'whatevs' );
subtest(
'Unmocked files and mixing unmocked and mocked files' => sub {
my $mocked = Cwd::getcwd() . "/$filename";
my $unmocked = '/foo_DOES_NOT_EXIST.znxc';
like(
dies( sub { chown -1, -1, $filename, $unmocked } ),
qr/^\QYou called chown() on a mix of mocked ($mocked) and unmocked files ($unmocked)\E/xms,
'Even without strict mode, you cannot mix mocked and unmocked files (chown)',
);
like(
dies( sub { chmod 0755, $filename, $unmocked } ),
qr/^\QYou called chmod() on a mix of mocked ($mocked) and unmocked files ($unmocked) \E/xms,
'Even without strict mode, you cannot mix mocked and unmocked files (chmod)',
);
}
);
"$path set GID correctly to $egid",
);
}
}
);
subtest(
'Change ownership of file to someone else' => sub {
note("\$>: $>, \$): $)");
my $chown_cb = sub {
my ( $args, $message ) = @_;
$! = 0;
if ($is_root) {
ok( chown( @{$args} ), $message );
is( $! + 0, 0, 'chown succeeded' );
is( "$!", '', 'No failure' );
}
else {
ok( !chown( @{$args} ), $message );
is( $! + 0, 1, "chown failed (EPERM): \$>:$>, \$):$)" );
}
};
$chown_cb->(
[ $euid + 9999, $egid + 9999, $filename ],
'chown file to some high, probably unavailable, UID/GID',
);
$chown_cb->(
[ $euid, $egid + 9999, $filename ],
'chown file to some high, probably unavailable, GID',
);
$chown_cb->(
[ $euid + 9999, $egid, $filename ],
'chown file to some high, probably unavailable, UID',
);
$chown_cb->(
[ 0, 0, $filename ],
'chown file to root',
);
$chown_cb->(
[ $euid, 0, $filename ],
'chown file to root GID',
);
$chown_cb->(
[ 0, $egid, $filename ],
'chown file to root UID',
);
}
);
subtest(
'chown with bareword (nonexistent file)' => sub {
no strict;
my $bareword_file = Test::MockFile->file('RANDOM_FILE_THAT_WILL_NOT_EXIST');
is( $! + 0, 0, '$! starts clean' );
ok(
!chown( $euid, $egid, RANDOM_FILE_THAT_WILL_NOT_EXIST ),
'Using bareword treats it as string',
);
is( $! + 0, 2, 'Correct ENOENT error' );
}
);
subtest(
'chown only user, only group, both' => sub {
is( $! + 0, 0, '$! starts clean' );
ok(
chown( $euid, -1, $filename ),
'chown\'ing file to only UID',
);
is( $! + 0, 0, '$! still clean' );
ok(
chown( -1, $egid, $filename ),
'chown\'ing file to only GID',
);
is( $! + 0, 0, '$! still clean' );
ok(
chown( $euid, $egid, $filename ),
'chown\'ing file to both UID and GID',
);
is( $! + 0, 0, '$! still clean' );
}
);
subtest(
'chown to different group of same user' => sub {
# See if this user has another group available
# (we might be on a user that has only one group)
$next_gid
or skip_all('This user only has one group');
is( $top_gid, $egid, 'Skipping the first GID' );
isnt( $next_gid, $egid, 'Testing a different GID' );
is( $! + 0, 0, '$! starts clean' );
ok(
chown( -1, $next_gid, $filename ),
'chown\'ing file to a different GID',
);
is( $! + 0, 0, '$! stays clean' );
}
);
subtest(
'chown on typeglob / filehandle' => sub {
my $filename = '/tmp/not-a-file';
my $file = Test::MockFile->file($filename);
open my $fh, '>', $filename
or die;
print {$fh} "whatevs\n"
or die;
my ( $exp_euid, $exp_egid ) = $is_root ? ( $euid + 9999, $egid + 9999 ) : ( $euid, $egid );
if ($is_root) {
is( $! + 0, 0, '$! starts clean' );
is( chown( $exp_euid, $exp_egid, $fh ), 1, 'root chown on a file handle works' );
is( $! + 0, 0, '$! stays clean' );
}
else {
is( $! + 0, 0, '$! starts clean' );
is( chown( $exp_euid, $exp_egid, $fh ), 1, 'Non-root chown on a file handle works' );
is( $! + 0, 0, '$! stays clean' );
}
close $fh
or die;
my (
$dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks
) = stat($filename);
is( $uid, $exp_euid, "Owner of the file is now there" );
is( $gid, $exp_egid, "Group of the file is now there" );
}
);
subtest(
'chown does not reset $!' => sub {
my $file = Test::MockFile->file( '/foo' => 'bar' );
$! = 3;
is( $! + 0, 3, '$! is set to 3 for our test' );
ok( chown( -1, -1, '/foo' ), 'Successfully run chown' );
is( $! + 0, 3, '$! is still 3 (not reset by chown)' );
}
);
subtest(
'chown -1 preserves per-file ownership, not process identity' => sub {
# Create a file with non-default ownership
my $custom_uid = 12345;
my $custom_gid = 67890;
my $file = Test::MockFile->file(
'/chown_test_preserve' => 'data',
{ uid => $custom_uid, gid => $custom_gid },
);
# Use root mock user so permission checks don't interfere with
# the -1 preservation semantics being tested here.
Test::MockFile->set_user( 0, 0 );
# chown(-1, -1) should keep the custom values, not replace with $> / $)
ok( chown( -1, -1, '/chown_test_preserve' ), 'chown(-1, -1) succeeds' );
my @st = stat('/chown_test_preserve');
is( $st[4], $custom_uid, 'uid preserved (not replaced with process uid)' );
is( $st[5], $custom_gid, 'gid preserved (not replaced with process gid)' );
# chown($new_uid, -1) should change uid but preserve gid
ok( chown( 99, -1, '/chown_test_preserve' ), 'chown(99, -1) succeeds' );
@st = stat('/chown_test_preserve');
is( $st[4], 99, 'uid changed to 99' );
is( $st[5], $custom_gid, 'gid still preserved after uid-only change' );
# chown(-1, $new_gid) should preserve uid but change gid
ok( chown( -1, 42, '/chown_test_preserve' ), 'chown(-1, 42) succeeds' );
@st = stat('/chown_test_preserve');
is( $st[4], 99, 'uid still preserved after gid-only change' );
is( $st[5], 42, 'gid changed to 42' );
Test::MockFile->clear_user;
}
);
subtest(
'chown uid-only and gid-only permission checks' => sub {
my $file = Test::MockFile->file(
'/chown_perm_test' => 'data',
{ uid => 1000, gid => 1000 },
);
# Non-root user cannot change uid to a different user (uid-only)
Test::MockFile->set_user( 1000, 1000 );
$! = 0;
is( chown( 2000, -1, '/chown_perm_test' ), 0, 'non-root cannot chown uid-only to different user' );
is( $! + 0, EPERM, 'errno is EPERM for uid-only chown' );
# Non-root user cannot change gid to a group they are not in (gid-only)
$! = 0;
is( chown( -1, 9999, '/chown_perm_test' ), 0, 'non-root cannot chown gid-only to foreign group' );
is( $! + 0, EPERM, 'errno is EPERM for gid-only chown' );
# Non-root user CAN change gid to a group they belong to
Test::MockFile->set_user( 1000, 1000, 2000 );
$! = 0;
is( chown( -1, 2000, '/chown_perm_test' ), 1, 'non-root can chown gid to own group' );
is( $! + 0, 0, 'no error for allowed gid change' );
# Non-root user CAN chown uid to self (no-op)
$! = 0;
is( chown( 1000, -1, '/chown_perm_test' ), 1, 'non-root can chown uid to self' );
is( $! + 0, 0, 'no error for uid self-chown' );
Test::MockFile->clear_user;
}
);
subtest(
'chown with broken symlink in multi-file list does not confess' => sub {
my $link = Test::MockFile->symlink( '/nonexistent_target', '/chown_broken_link' );
my $file = Test::MockFile->file( '/chown_real_file', 'content' );
# chown on a mix of regular file + broken symlink should NOT die.
# The broken symlink should silently fail with ENOENT, and the
# regular file should succeed.
my ( $result, $errno );
ok(
lives { $result = chown( $>, int($)), '/chown_broken_link', '/chown_real_file' ); $errno = $! + 0 },
'chown with broken symlink + regular file does not confess',
);
is( $result, 1, 'chown returns 1 (one file changed)' );
is( $errno, ENOENT, 'errno set to ENOENT for the broken symlink' );
}
);
subtest(
'chown with only broken symlink' => sub {
my $link = Test::MockFile->symlink( '/nowhere', '/chown_only_broken' );
my ( $result, $errno );
ok(
lives { $result = chown( $>, int($)), '/chown_only_broken' ); $errno = $! + 0 },
'chown with only a broken symlink does not confess',
);
is( $result, 0, 'chown returns 0 (no files changed)' );
is( $errno, ENOENT, 'errno set to ENOENT' );
}
);
done_testing();
exit;
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');
t/stat_timestamps.t view on Meta::CPAN
$mock->{'mtime'} = 1000;
chmod 0644, '/ts/chmod';
isnt( $mock->ctime(), 1000, 'chmod updates ctime' );
is( $mock->mtime(), 1000, 'chmod does not update mtime' );
}
note "-------------- CHOWN UPDATES ctime --------------";
{
my $mock = Test::MockFile->file( '/ts/chown', 'data' );
$mock->{'ctime'} = 1000;
$mock->{'mtime'} = 1000;
my ($primary_gid) = split /\s/, $);
chown $>, $primary_gid, '/ts/chown';
isnt( $mock->ctime(), 1000, 'chown updates ctime' );
is( $mock->mtime(), 1000, 'chown does not update mtime' );
}
note "-------------- OPEN > UPDATES mtime/ctime (truncate) --------------";
{
my $mock = Test::MockFile->file( '/ts/trunc', 'existing content' );
$mock->{'mtime'} = 1000;
$mock->{'ctime'} = 1000;
open my $fh, '>', '/ts/trunc' or die "open: $!";
t/symlink_follow_ops.t view on Meta::CPAN
use warnings;
use Test2::Bundle::Extended;
use Test2::Tools::Explain;
use Test2::Plugin::NoWarnings;
use Errno qw( ENOENT ELOOP EISDIR );
use Test::MockFile qw< nostrict >;
# Tests that chmod, chown, utime, and truncate follow symlinks
# and operate on the target file, not the symlink itself.
subtest 'chmod follows symlinks' => sub {
my $file = Test::MockFile->file( '/fake/target', 'data', { mode => 0644 | Test::MockFile::S_IFREG() } );
my $link = Test::MockFile->symlink( '/fake/target', '/fake/link' );
is( chmod( 0755, '/fake/link' ), 1, 'chmod via symlink returns 1' );
is(
sprintf( '%04o', ( stat '/fake/target' )[2] & 07777 ),
'0755',
t/symlink_follow_ops.t view on Meta::CPAN
my $link2 = Test::MockFile->symlink( '/fake/chain1', '/fake/chain2' );
is( chmod( 0700, '/fake/chain2' ), 1, 'chmod through symlink chain returns 1' );
is(
sprintf( '%04o', ( stat '/fake/chain_target' )[2] & 07777 ),
'0700',
'target file permissions changed through symlink chain',
);
};
subtest 'chown follows symlinks' => sub {
my $file = Test::MockFile->file( '/fake/chown_target', 'data' );
my $link = Test::MockFile->symlink( '/fake/chown_target', '/fake/chown_link' );
# chown with current user's uid/gid to avoid permission errors
my $result = chown( $>, $) + 0, '/fake/chown_link' );
is( $result, 1, 'chown via symlink returns 1' );
my @stat = stat('/fake/chown_target');
is( $stat[4], $>, 'target uid set through symlink' );
};
subtest 'chown on broken symlink fails with ENOENT' => sub {
my $link = Test::MockFile->symlink( '/fake/nowhere', '/fake/broken_chown' );
my $result = chown( $>, $) + 0, '/fake/broken_chown' );
is( $result, 0, 'chown on broken symlink returns 0' );
is( $! + 0, ENOENT, '$! is ENOENT for broken symlink' );
};
subtest 'utime follows symlinks' => sub {
my $file = Test::MockFile->file( '/fake/utime_target', 'data' );
my $link = Test::MockFile->symlink( '/fake/utime_target', '/fake/utime_link' );
my $atime = 1_000_000;
my $mtime = 2_000_000;
( run in 1.038 second using v1.01-cache-2.11-cpan-5511b514fd6 )