1use strict; 2use Test::More; 3use Config; 4use lib './t'; 5use FilePathTest qw( 6 _run_for_warning 7); 8use File::Path qw(rmtree mkpath make_path remove_tree); 9use File::Spec::Functions; 10 11 12my $prereq = prereq(); 13plan skip_all => $prereq if defined $prereq; 14plan tests => 11; 15 16my $pwent = max_u(); 17my $grent = max_g(); 18my ( $max_uid, $max_user ) = @{ $pwent }; 19my ( $max_gid, $max_group ) = @{ $grent }; 20 21my $tmp_base = catdir( 22 curdir(), 23 sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ), 24); 25 26# invent some names 27my @dir = ( 28 catdir($tmp_base, qw(a b)), 29 catdir($tmp_base, qw(a c)), 30 catdir($tmp_base, qw(z b)), 31 catdir($tmp_base, qw(z c)), 32); 33 34# create them 35my @created = mkpath([@dir]); 36 37my $dir; 38my $dir2; 39 40my $dir_stem = $dir = catdir($tmp_base, 'owned-by'); 41 42$dir = catdir($dir_stem, 'aaa'); 43@created = make_path($dir, {owner => $max_user}); 44is(scalar(@created), 2, "created a directory owned by $max_user..."); 45 46my $dir_uid = (stat $created[0])[4]; 47is($dir_uid, $max_uid, "... owned by $max_uid"); 48 49$dir = catdir($dir_stem, 'aab'); 50@created = make_path($dir, {group => $max_group}); 51is(scalar(@created), 1, "created a directory owned by group $max_group..."); 52 53my $dir_gid = (stat $created[0])[5]; 54is($dir_gid, $max_gid, "... owned by group $max_gid"); 55 56$dir = catdir($dir_stem, 'aac'); 57@created = make_path( $dir, { user => $max_user, 58 group => $max_group}); 59is(scalar(@created), 1, "created a directory owned by $max_user:$max_group..."); 60 61($dir_uid, $dir_gid) = (stat $created[0])[4,5]; 62is($dir_uid, $max_uid, "... owned by $max_uid"); 63is($dir_gid, $max_gid, "... owned by group $max_gid"); 64 65{ 66 # invent a user and group that don't exist 67 my $phony_user = get_phony_user(); 68 my $phony_group = get_phony_group(); 69 70 $dir = catdir($dir_stem, 'aad'); 71 my $rv = _run_for_warning( sub { 72 make_path( 73 $dir, 74 { user => $phony_user, group => $phony_group } 75 ) 76 } ); 77 like( $rv, 78 qr{unable to map $phony_user to a uid, ownership not changed:}s, 79 "created a directory not owned by $phony_user:$phony_group...", 80 ); 81 like( $rv, 82 qr{unable to map $phony_group to a gid, group ownership not changed:}s, 83 "created a directory not owned by $phony_user:$phony_group...", 84 ); 85} 86 87{ 88 # cleanup 89 my $x; 90 my $opts = { error => \$x }; 91 remove_tree($tmp_base, $opts); 92 ok(! -d $tmp_base, "directory '$tmp_base' removed, as expected"); 93 is(scalar(@{$x}), 0, "no error messages using remove_tree() with \$opts"); 94} 95 96sub max_u { 97 # find the highest uid ('nobody' or similar) 98 my $max_uid = 0; 99 my $max_user = undef; 100 while (my @u = getpwent()) { 101 if ($max_uid < $u[2]) { 102 $max_uid = $u[2]; 103 $max_user = $u[0]; 104 } 105 } 106 setpwent(); # in case we want to run again later 107 return [ $max_uid, $max_user ]; 108} 109 110sub max_g { 111 # find the highest gid ('nogroup' or similar) 112 my $max_gid = 0; 113 my $max_group = undef; 114 while ( my @g = getgrent() ) { 115 if ($max_gid < $g[2]) { 116 $max_gid = $g[2]; 117 $max_group = $g[0]; 118 } 119 } 120 setgrent(); # in case we want to run again later 121 return [ $max_gid, $max_group ]; 122} 123 124sub prereq { 125 return "getpwent() not implemented on $^O" unless $Config{d_getpwent}; 126 return "getgrent() not implemented on $^O" unless $Config{d_getgrent}; 127 return "not running as root" unless $< == 0; 128 return "darwin's nobody and nogroup are -1 or -2" if $^O eq 'darwin'; 129 130 my $pwent = max_u(); 131 my $grent = max_g(); 132 my ( $max_uid, $max_user ) = @{ $pwent }; 133 my ( $max_gid, $max_group ) = @{ $grent }; 134 135 return "getpwent() appears to be insane" unless $max_uid > 0; 136 return "getgrent() appears to be insane" unless $max_gid > 0; 137 return undef; 138} 139 140sub get_phony_user { 141 return "getpwent() not implemented on $^O" unless $Config{d_getpwent}; 142 return "not running as root" unless $< == 0; 143 my %real_users = (); 144 while(my @a=getpwent()) { 145 $real_users{$a[0]}++; 146 } 147 my $phony_stem = 'phonyuser'; 148 my $phony = ''; 149 do { $phony = $phony_stem . int(rand(10000)); } until (! $real_users{$phony}); 150 return $phony; 151} 152 153sub get_phony_group { 154 return "getgrent() not implemented on $^O" unless $Config{d_getgrent}; 155 return "not running as root" unless $< == 0; 156 my %real_groups = (); 157 while(my @a=getgrent()) { 158 $real_groups{$a[0]}++; 159 } 160 my $phony_stem = 'phonygroup'; 161 my $phony = ''; 162 do { $phony = $phony_stem . int(rand(10000)); } until (! $real_groups{$phony}); 163 return $phony; 164} 165 166