Devel::PPPort: Fix D_PPP_FIX_UTF8_ERRSV macro
[perl.git] / t / op / grent.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 eval {my @n = getgrgid 0};
10 if ($@ =~ /(The \w+ function is unimplemented)/) {
11     skip_all "getgrgid unimplemented";
12 }
13
14 eval { require Config; import Config; };
15 my $reason;
16 if ($Config{'i_grp'} ne 'define') {
17         $reason = '$Config{i_grp} not defined';
18 }
19 elsif (not -f "/etc/group" ) { # Play safe.
20         $reason = 'no /etc/group file';
21 }
22
23 if (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
49 if (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
62 if (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
70 if ($reason) {
71     skip_all $reason;
72 }
73
74
75 # By now the GR filehandle should be open and full of juicy group entries.
76
77 plan tests => 3;
78
79 # Go through at most this many groups.
80 # (note that the first entry has been read away by now)
81 my $max = 25;
82
83 my $n   = 0;
84 my $tst = 1;
85 my %perfect;
86 my %seen;
87
88 print "# where $where\n";
89
90 ok( setgrent(), 'setgrent' ) || print "# $!\n";
91
92 while (<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
137 endgrent();
138
139 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
140
141 if (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
156 EOEX
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
166 my @gr1;
167
168 setgrent();
169 for (1..$max) {
170     my $gr = scalar getgrent();
171     last unless defined $gr;
172     push @gr1, $gr;
173 }
174 endgrent();
175
176 my @gr2;
177
178 setgrent();
179 for (1..$max) {
180     my ($gr) = (getgrent());
181     last unless defined $gr;
182     push @gr2, $gr;
183 }
184 endgrent();
185
186 is("@gr1", "@gr2", "getgrent gave same results in scalar and list contexts");
187
188 close(GR);