This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ypcat working, but NIS not used
[perl5.git] / t / op / grent.t
CommitLineData
c5987ebb
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
ae4ed236
MS
6 require './test.pl';
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') {
45c0de28 17 $reason = '$Config{i_grp} not defined';
ae4ed236
MS
18}
19elsif (not -f "/etc/group" ) { # Play safe.
45c0de28 20 $reason = 'no /etc/group file';
ae4ed236 21}
c5987ebb 22
ae4ed236
MS
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're really using NIS.
32 if( open(NSSW, "/etc/nsswitch.conf" ) ) {
33 my($group) = grep /^\s*group:/, <NSSW>;
34
35 # If there's 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 }
b91c0863 46 }
ae4ed236 47}
b91c0863 48
ae4ed236
MS
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 }
b91c0863 59 }
ae4ed236 60}
55ec6b63 61
ae4ed236
MS
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";
c5987ebb
JH
67 }
68}
69
ae4ed236
MS
70if ($reason) {
71 skip_all $reason;
72}
73
74
765e9edb 75# By now the GR filehandle should be open and full of juicy group entries.
b91c0863 76
ae4ed236 77plan tests => 3;
c5987ebb
JH
78
79# Go through at most this many groups.
b91c0863 80# (note that the first entry has been read away by now)
55ec6b63 81my $max = 25;
c5987ebb 82
55ec6b63 83my $n = 0;
c5987ebb 84my $tst = 1;
b91c0863 85my %perfect;
55ec6b63 86my %seen;
c5987ebb 87
f0debaab
JH
88print "# where $where\n";
89
ae4ed236 90ok( setgrent(), 'setgrent' ) || print "# $!\n";
f0debaab 91
c5987ebb 92while (<GR>) {
c5987ebb 93 chomp;
a941e390
MD
94 # LIMIT -1 so that groups with no users don't fall off
95 my @s = split /:/, $_, -1;
55ec6b63
JH
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 }
09ac174e
GB
103 if ($n == $max) {
104 local $/;
105 my $junk = <GR>;
106 last;
107 }
55ec6b63
JH
108 # In principle we could whine if @s != 4 but do we know enough
109 # of group file formats everywhere?
c5987ebb 110 if (@s == 4) {
5e5f18aa 111 $members_s =~ s/\s*,\s*/,/g;
b56ec344
JH
112 $members_s =~ s/\s+$//;
113 $members_s =~ s/^\s+//;
c5987ebb
JH
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 }
b91c0863 124 # NOTE: group names *CAN* contain whitespace.
5e5f18aa 125 $members =~ s/\s+/,/g;
b91c0863
JH
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.
55ec6b63 130# Not that group passwords are used much but better not assume anything.
b91c0863
JH
131 $gid eq $gid_s and
132 $members eq $members_s;
c5987ebb
JH
133 }
134 $n++;
135}
136
bd055eb9
JH
137endgrent();
138
f0debaab
JH
139print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
140
93d44f78 141if (keys %perfect == 0 && $n) {
b91c0863
JH
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
ae4ed236
MS
157
158 fail();
159 print "#\t (not necessarily serious: run t/op/grent.t by itself)\n";
b91c0863 160} else {
ae4ed236 161 pass();
55ec6b63 162}
c5987ebb 163
91e74348 164# Test both the scalar and list contexts.
765e9edb
JH
165
166my @gr1;
167
765e9edb
JH
168setgrent();
169for (1..$max) {
170 my $gr = scalar getgrent();
171 last unless defined $gr;
172 push @gr1, $gr;
173}
bd055eb9 174endgrent();
765e9edb
JH
175
176my @gr2;
177
765e9edb
JH
178setgrent();
179for (1..$max) {
180 my ($gr) = (getgrent());
181 last unless defined $gr;
182 push @gr2, $gr;
183}
bd055eb9 184endgrent();
765e9edb 185
ae4ed236 186is("@gr1", "@gr2");
765e9edb 187
c5987ebb 188close(GR);