xref: /openbsd/gnu/usr.bin/perl/t/op/grent.t (revision 5759b3d2) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8
9eval {my @n = getgrgid 0};
10if ($@ =~ /(The \w+ function is unimplemented)/) {
11    skip_all "getgrgid unimplemented";
12}
13
14eval { require Config; import Config; };
15my $reason;
16if ($Config{'i_grp'} ne 'define') {
17	$reason = '$Config{i_grp} not defined';
18}
19elsif (not -f "/etc/group" ) { # Play safe.
20	$reason = 'no /etc/group file';
21}
22
23if (not defined $where) {	# Try NIS.
24    foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
25        if (-x $ypcat &&
26            open(GR, "$ypcat group 2>/dev/null |") &&
27            defined(<GR>))
28        {
29            print "# `ypcat group` worked\n";
30
31            # Check to make sure we are really using NIS.
32            if( open(NSSW, "/etc/nsswitch.conf" ) ) {
33                my($group) = grep /^\s*group:/, <NSSW>;
34
35                # If there is no group line, assume it default to compat.
36                if( !$group || $group !~ /(nis|compat)/ ) {
37                    print "# Doesn't look like you're using NIS in ".
38                          "/etc/nsswitch.conf\n";
39                    last;
40                }
41            }
42            $where = "NIS group - $ypcat";
43            undef $reason;
44            last;
45        }
46    }
47}
48
49if (not defined $where) {	# Try NetInfo.
50    foreach my $nidump (qw(/usr/bin/nidump)) {
51        if (-x $nidump &&
52            open(GR, "$nidump group . 2>/dev/null |") &&
53            defined(<GR>))
54        {
55            $where = "NetInfo group - $nidump";
56            undef $reason;
57            last;
58        }
59    }
60}
61
62if (not defined $where) {	# Try local.
63    my $GR = "/etc/group";
64    if (-f $GR && open(GR, $GR) && defined(<GR>)) {
65        undef $reason;
66        $where = "local $GR";
67    }
68}
69
70if ($reason) {
71    skip_all $reason;
72}
73
74
75# By now the GR filehandle should be open and full of juicy group entries.
76
77plan tests => 3;
78
79# Go through at most this many groups.
80# (note that the first entry has been read away by now)
81my $max = 25;
82
83my $n   = 0;
84my $tst = 1;
85my %perfect;
86my %seen;
87
88print "# where $where\n";
89
90ok( setgrent(), 'setgrent' ) || print "# $!\n";
91
92while (<GR>) {
93    chomp;
94    # LIMIT -1 so that groups with no users do not fall off
95    my @s = split /:/, $_, -1;
96    my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
97    if (@s) {
98	push @{ $seen{$name_s} }, $.;
99    } else {
100	warn "# Your $where line $. is empty.\n";
101	next;
102    }
103    if ($n == $max) {
104	local $/;
105	my $junk = <GR>;
106	last;
107    }
108    # In principle we could whine if @s != 4 but do we know enough
109    # of group file formats everywhere?
110    if (@s == 4) {
111	$members_s =~ s/\s*,\s*/,/g;
112	$members_s =~ s/\s+$//;
113	$members_s =~ s/^\s+//;
114	@n = getgrgid($gid_s);
115	# 'nogroup' et al.
116	next unless @n;
117	my ($name,$passwd,$gid,$members) = @n;
118	# Protect against one-to-many and many-to-one mappings.
119	if ($name_s ne $name) {
120	    @n = getgrnam($name_s);
121	    ($name,$passwd,$gid,$members) = @n;
122	    next if $name_s ne $name;
123	}
124	# NOTE: group names *CAN* contain whitespace.
125	$members =~ s/\s+/,/g;
126	# what about different orders of members?
127	$perfect{$name_s}++
128	    if $name    eq $name_s    and
129# Do not compare passwords: think shadow passwords.
130# Not that group passwords are used much but better not assume anything.
131               $gid     eq $gid_s     and
132               $members eq $members_s;
133    }
134    $n++;
135}
136
137endgrent();
138
139print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
140
141if (keys %perfect == 0 && $n) {
142    $max++;
143    print <<EOEX;
144#
145# The failure of op/grent test is not necessarily serious.
146# It may fail due to local group administration conventions.
147# If you are for example using both NIS and local groups,
148# test failure is possible.  Any distributed group scheme
149# can cause such failures.
150#
151# What the grent test is doing is that it compares the $max first
152# entries of $where
153# with the results of getgrgid() and getgrnam() call.  If it finds no
154# matches at all, it suspects something is wrong.
155# 
156EOEX
157
158    fail();
159    print "#\t (not necessarily serious: run t/op/grent.t by itself)\n";
160} else {
161    pass("getgrgid and getgrnam performed as expected");
162}
163
164# Test both the scalar and list contexts.
165
166my @gr1;
167
168setgrent();
169for (1..$max) {
170    my $gr = scalar getgrent();
171    last unless defined $gr;
172    push @gr1, $gr;
173}
174endgrent();
175
176my @gr2;
177
178setgrent();
179for (1..$max) {
180    my ($gr) = (getgrent());
181    last unless defined $gr;
182    push @gr2, $gr;
183}
184endgrent();
185
186is("@gr1", "@gr2", "getgrent gave same results in scalar and list contexts");
187
188close(GR);
189