use strict;
use Test::More;
use Config;
use lib './t';
use FilePathTest qw(
_run_for_warning
);
use File::Path qw(rmtree mkpath make_path remove_tree);
use File::Spec::Functions;
my $prereq = prereq();
plan skip_all => $prereq if defined $prereq;
plan tests => 11;
my $pwent = max_u();
my $grent = max_g();
my ( $max_uid, $max_user ) = @{ $pwent };
my ( $max_gid, $max_group ) = @{ $grent };
my $tmp_base = catdir(
curdir(),
sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ),
);
# invent some names
my @dir = (
catdir($tmp_base, qw(a b)),
catdir($tmp_base, qw(a c)),
catdir($tmp_base, qw(z b)),
catdir($tmp_base, qw(z c)),
);
# create them
my @created = mkpath([@dir]);
my $dir;
my $dir2;
my $dir_stem = $dir = catdir($tmp_base, 'owned-by');
$dir = catdir($dir_stem, 'aaa');
@created = make_path($dir, {owner => $max_user});
is(scalar(@created), 2, "created a directory owned by $max_user...");
my $dir_uid = (stat $created[0])[4];
is($dir_uid, $max_uid, "... owned by $max_uid");
$dir = catdir($dir_stem, 'aab');
@created = make_path($dir, {group => $max_group});
is(scalar(@created), 1, "created a directory owned by group $max_group...");
my $dir_gid = (stat $created[0])[5];
is($dir_gid, $max_gid, "... owned by group $max_gid");
$dir = catdir($dir_stem, 'aac');
@created = make_path( $dir, { user => $max_user,
group => $max_group});
is(scalar(@created), 1, "created a directory owned by $max_user:$max_group...");
($dir_uid, $dir_gid) = (stat $created[0])[4,5];
is($dir_uid, $max_uid, "... owned by $max_uid");
is($dir_gid, $max_gid, "... owned by group $max_gid");
{
# invent a user and group that don't exist
do { ++$max_user } while ( getpwnam( $max_user ) );
do { ++$max_group } while ( getgrnam( $max_group ) );
$dir = catdir($dir_stem, 'aad');
my $rv = _run_for_warning( sub {
make_path(
$dir,
{ user => $max_user, group => $max_group }
)
} );
like( $rv,
qr{unable to map $max_user to a uid, ownership not changed:}s,
"created a directory not owned by $max_user:$max_group...",
);
like( $rv,
qr{unable to map $max_group to a gid, group ownership not changed:}s,
"created a directory not owned by $max_user:$max_group...",
);
}
{
# cleanup
my $x;
my $opts = { error => \$x };
remove_tree($tmp_base, $opts);
ok(! -d $tmp_base, "directory '$tmp_base' removed, as expected");
is(scalar(@{$x}), 0, "no error messages using remove_tree() with \$opts");
}
sub max_u {
# find the highest uid ('nobody' or similar)
my $max_uid = 0;
my $max_user = undef;
while (my @u = getpwent()) {
if ($max_uid < $u[2]) {
$max_uid = $u[2];
$max_user = $u[0];
}
}
setpwent(); # in case we want to run again later
return [ $max_uid, $max_user ];
}
sub max_g {
# find the highest gid ('nogroup' or similar)
my $max_gid = 0;
my $max_group = undef;
while ( my @g = getgrent() ) {
print Dumper @g;
if ($max_gid < $g[2]) {
$max_gid = $g[2];
$max_group = $g[0];
}
}
setgrent(); # in case we want to run again later
return [ $max_gid, $max_group ];
}
sub prereq {
return "getpwent() not implemented on $^O" unless $Config{d_getpwent};
return "getgrent() not implemented on $^O" unless $Config{d_getgrent};
return "not running as root" unless $< == 0;
return "darwin's nobody and nogroup are -1 or -2" if $^O eq 'darwin';
my $pwent = max_u();
my $grent = max_g();
my ( $max_uid, $max_user ) = @{ $pwent };
my ( $max_gid, $max_group ) = @{ $grent };
return "getpwent() appears to be insane" unless $max_uid > 0;
return "getgrent() appears to be insane" unless $max_gid > 0;
return undef;
}