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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
eval {my @n = getgrgid 0};
if ($@ =~ /(The \w+ function is unimplemented)/) {
skip_all "getgrgid unimplemented";
}
eval { require Config; import Config; };
my $reason;
if ($Config{'i_grp'} ne 'define') {
$reason = '$Config{i_grp} not defined';
}
elsif (not -f "/etc/group" ) { # Play safe.
$reason = 'no /etc/group file';
}
if (not defined $where) { # Try NIS.
foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
if (-x $ypcat &&
open(GR, "$ypcat group 2>/dev/null |") &&
defined(<GR>))
{
print "# `ypcat group` worked\n";
# Check to make sure we're really using NIS.
if( open(NSSW, "/etc/nsswitch.conf" ) ) {
my($group) = grep /^\s*group:/, <NSSW>;
# If there's no group line, assume it default to compat.
if( !$group || $group !~ /(nis|compat)/ ) {
print "# Doesn't look like you're using NIS in ".
"/etc/nsswitch.conf\n";
last;
}
}
$where = "NIS group - $ypcat";
undef $reason;
last;
}
}
}
if (not defined $where) { # Try NetInfo.
foreach my $nidump (qw(/usr/bin/nidump)) {
if (-x $nidump &&
open(GR, "$nidump group . 2>/dev/null |") &&
defined(<GR>))
{
$where = "NetInfo group - $nidump";
undef $reason;
last;
}
}
}
if (not defined $where) { # Try local.
my $GR = "/etc/group";
if (-f $GR && open(GR, $GR) && defined(<GR>)) {
undef $reason;
$where = "local $GR";
}
}
if ($reason) {
skip_all $reason;
}
# By now the GR filehandle should be open and full of juicy group entries.
plan tests => 3;
# Go through at most this many groups.
# (note that the first entry has been read away by now)
my $max = 25;
my $n = 0;
my $tst = 1;
my %perfect;
my %seen;
print "# where $where\n";
ok( setgrent(), 'setgrent' ) || print "# $!\n";
while (<GR>) {
chomp;
# LIMIT -1 so that groups with no users don't fall off
my @s = split /:/, $_, -1;
my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
if (@s) {
push @{ $seen{$name_s} }, $.;
} else {
warn "# Your $where line $. is empty.\n";
next;
}
if ($n == $max) {
local $/;
my $junk = <GR>;
last;
}
# In principle we could whine if @s != 4 but do we know enough
# of group file formats everywhere?
if (@s == 4) {
$members_s =~ s/\s*,\s*/,/g;
$members_s =~ s/\s+$//;
$members_s =~ s/^\s+//;
@n = getgrgid($gid_s);
# 'nogroup' et al.
next unless @n;
my ($name,$passwd,$gid,$members) = @n;
# Protect against one-to-many and many-to-one mappings.
if ($name_s ne $name) {
@n = getgrnam($name_s);
($name,$passwd,$gid,$members) = @n;
next if $name_s ne $name;
}
# NOTE: group names *CAN* contain whitespace.
$members =~ s/\s+/,/g;
# what about different orders of members?
$perfect{$name_s}++
if $name eq $name_s and
# Do not compare passwords: think shadow passwords.
# Not that group passwords are used much but better not assume anything.
$gid eq $gid_s and
$members eq $members_s;
}
$n++;
}
endgrent();
print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
if (keys %perfect == 0 && $n) {
$max++;
print <<EOEX;
#
# The failure of op/grent test is not necessarily serious.
# It may fail due to local group administration conventions.
# If you are for example using both NIS and local groups,
# test failure is possible. Any distributed group scheme
# can cause such failures.
#
# What the grent test is doing is that it compares the $max first
# entries of $where
# with the results of getgrgid() and getgrnam() call. If it finds no
# matches at all, it suspects something is wrong.
#
EOEX
fail();
print "#\t (not necessarily serious: run t/op/grent.t by itself)\n";
} else {
pass();
}
# Test both the scalar and list contexts.
my @gr1;
setgrent();
for (1..$max) {
my $gr = scalar getgrent();
last unless defined $gr;
push @gr1, $gr;
}
endgrent();
my @gr2;
setgrent();
for (1..$max) {
my ($gr) = (getgrent());
last unless defined $gr;
push @gr2, $gr;
}
endgrent();
is("@gr1", "@gr2");
close(GR);
|