1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
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
my $phony_user = get_phony_user();
my $phony_group = get_phony_group();
$dir = catdir($dir_stem, 'aad');
my $rv = _run_for_warning( sub {
make_path(
$dir,
{ user => $phony_user, group => $phony_group }
)
} );
like( $rv,
qr{unable to map $phony_user to a uid, ownership not changed:}s,
"created a directory not owned by $phony_user:$phony_group...",
);
like( $rv,
qr{unable to map $phony_group to a gid, group ownership not changed:}s,
"created a directory not owned by $phony_user:$phony_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;
}
sub get_phony_user {
return "getpwent() not implemented on $^O" unless $Config{d_getpwent};
return "not running as root" unless $< == 0;
my %real_users = ();
while(my @a=getpwent()) {
$real_users{$a[0]}++;
}
my $phony_stem = 'phonyuser';
my $phony = '';
do { $phony = $phony_stem . int(rand(10000)); } until (! $real_users{$phony});
return $phony;
}
sub get_phony_group {
return "getgrent() not implemented on $^O" unless $Config{d_getgrent};
return "not running as root" unless $< == 0;
my %real_groups = ();
while(my @a=getgrent()) {
$real_groups{$a[0]}++;
}
my $phony_stem = 'phonygroup';
my $phony = '';
do { $phony = $phony_stem . int(rand(10000)); } until (! $real_groups{$phony});
return $phony;
}
|
