Update releaser managers
[perl.git] / t / op / pwent.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use strict;
10 use warnings;
11
12 eval {my @n = getpwuid 0; setpwent()};
13 skip_all($1) if $@ && $@ =~ /(The \w+ function is unimplemented)/;
14
15 eval { require Config; };
16
17 sub try_prog {
18     my ($where, $args, @pathnames) = @_;
19     foreach my $prog (@pathnames) {
20         next unless -x $prog;
21         next unless open PW, '-|', "$prog $args 2>/dev/null";
22         next unless defined <PW>;
23         return $where;
24     }
25     return;
26 }
27
28 # Try NIS.
29 my $where = try_prog('NIS passwd', 'passwd',
30                      qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat));
31
32 # Try NetInfo.
33 $where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump');
34
35 # Try NIS+.
36 $where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat');
37
38 # Try dscl
39 DSCL: {
40 my @dscl = qw(/usr/bin/dscl);
41 if (!defined $where && $Config::Config{useperlio} && grep { -x } @dscl) {
42     eval { require PerlIO::scalar; }; # Beware miniperl.
43     if ($@) {
44         print "# No PerlIO::scalar, will not try dscl\n";
45         last DSCL;
46     }
47     # Map dscl items to passwd fields, and provide support for
48     # mucking with the dscl output if we need to (and we do).
49     my %want = do {
50         my $inx = 0;
51         map {$_ => {inx => $inx++, mung => sub {$_[0]}}}
52             qw{RecordName Password UniqueID PrimaryGroupID
53                RealName NFSHomeDirectory UserShell};
54     };
55
56     # The RecordName for a /User record is the username. In some
57     # cases there are synonyms (e.g. _www and www), in which case we
58     # get a blank-delimited list. We prefer the first entry in the
59     # list because getpwnam() does.
60     $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]};
61
62     # The UniqueID and PrimaryGroupID for a /User record are the
63     # user ID and the primary group ID respectively. In cases where
64     # the high bit is set, 'dscl' returns a negative number, whereas
65     # getpwnam() returns its twos complement. This mungs the dscl
66     # output to agree with what getpwnam() produces. Interestingly
67     # enough, getpwuid(-2) returns the right record ('nobody'), even
68     # though it returns the uid as 4294967294. If you track uid_t
69     # on an i386, you find it is an unsigned int, which makes the
70     # unsigned version the right one; but both /etc/passwd and
71     # /etc/master.passwd contain negative numbers.
72     $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub {
73         unpack 'L', pack 'l', $_[0]};
74
75     foreach my $dscl (@dscl) {
76         next unless -x $dscl;
77         next unless open my $fh, '-|', "$dscl . -readall /Users @{[keys %want]} 2>/dev/null";
78         my @lines;
79         my @rec;
80         while (<$fh>) {
81             chomp;
82             if ($_ eq '-') {
83                 if (@rec) {
84                     # Some records do not have all items. In particular,
85                     # the macports user has no real name. Here it's an undef,
86                     # in the password file it becomes an empty string.
87                     no warnings 'uninitialized';
88                     push @lines, join (':', @rec) . "\n";
89                     @rec = ();
90                 }
91                 next;
92             }
93             my ($name, $value) = split ':\s+', $_, 2;
94             unless (defined $value) {
95                 s/:$//;
96                 $name = $_;
97                 $value = <$fh>;
98                 chomp $value;
99                 $value =~ s/^\s+//;
100             }
101             if (defined (my $info = $want{$name})) {
102                 $rec[$info->{inx}] = $info->{mung}->($value);
103             }
104         }
105         if (@rec) {
106         # see above
107         no warnings 'uninitialized';
108             push @lines, join (':', @rec) . "\n";
109         }
110         my $data = join '', @lines;
111         if (open PW, '<', \$data) { # Needs PerlIO::scalar.
112             $where = "dscl . -readall /Users";
113             last;
114         }
115     }
116 }
117 } # DSCL:
118
119 if (not defined $where) {
120     # Try local.
121     my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined';
122
123     my $PW = "/etc/passwd";
124     if (!-f $PW) {
125         skip_all($no_i_pwd) if $no_i_pwd;
126         skip_all("no $PW file");
127     } elsif (open PW, '<', $PW) {
128         if(defined <PW>) {
129             $where = $PW;
130         } else {
131             skip_all($no_i_pwd) if $no_i_pwd;
132             die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up";
133         }
134     } else {
135         die "Can't open $PW: $!";
136     }
137 }
138
139 # By now the PW filehandle should be open and full of juicy password entries.
140
141 plan(tests => 2);
142
143 # Go through at most this many users.
144 # (note that the first entry has been read away by now)
145 my $max = 25;
146
147 my $n = 0;
148 my %perfect;
149 my %seen;
150
151 print "# where $where\n";
152
153 setpwent();
154
155 while (<PW>) {
156     chomp;
157     # LIMIT -1 so that users with empty shells don't fall off
158     my @s = split /:/, $_, -1;
159     my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
160     (my $v) = $Config::Config{osvers} =~ /^(\d+)/;
161     if ($^O eq 'darwin' && $v < 9) {
162        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
163     } else {
164        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
165     }
166     next if /^\+/; # ignore NIS includes
167     if (@s) {
168         push @{ $seen{$name_s} }, $.;
169     } else {
170         warn "# Your $where line $. is empty.\n";
171         next;
172     }
173     if ($n == $max) {
174         local $/;
175         my $junk = <PW>;
176         last;
177     }
178     # In principle we could whine if @s != 7 but do we know enough
179     # of passwd file formats everywhere?
180     if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
181         my @n = getpwuid($uid_s);
182         # 'nobody' et al.
183         next unless @n;
184         my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
185         # Protect against one-to-many and many-to-one mappings.
186         if ($name_s ne $name) {
187             @n = getpwnam($name_s);
188             ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
189             next if $name_s ne $name;
190         }
191         $perfect{$name_s}++
192             if $name    eq $name_s    and
193                $uid     eq $uid_s     and
194 # Do not compare passwords: think shadow passwords.
195                $gid     eq $gid_s     and
196                $gcos    eq $gcos_s    and
197                $home    eq $home_s    and
198                $shell   eq $shell_s;
199     }
200     $n++;
201 }
202
203 endpwent();
204
205 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
206
207 SKIP: {
208     skip("Found no password entries", 1) unless $n;
209
210     if (keys %perfect == 0) {
211         $max++;
212         print <<EOEX;
213 #
214 # The failure of op/pwent test is not necessarily serious.
215 # It may fail due to local password administration conventions.
216 # If you are for example using both NIS and local passwords,
217 # test failure is possible.  Any distributed password scheme
218 # can cause such failures.
219 #
220 # What the pwent test is doing is that it compares the $max first
221 # entries of $where
222 # with the results of getpwuid() and getpwnam() call.  If it finds no
223 # matches at all, it suspects something is wrong.
224
225 EOEX
226     }
227
228     cmp_ok(keys %perfect, '>', 0, "pwent test satisfactory")
229         or note("(not necessarily serious: run t/op/pwent.t by itself)");
230 }
231
232 # Test both the scalar and list contexts.
233
234 my @pw1;
235
236 setpwent();
237 for (1..$max) {
238     my $pw = scalar getpwent();
239     last unless defined $pw;
240     push @pw1, $pw;
241 }
242 endpwent();
243
244 my @pw2;
245
246 setpwent();
247 for (1..$max) {
248     my ($pw) = (getpwent());
249     last unless defined $pw;
250     push @pw2, $pw;
251 }
252 endpwent();
253
254 is("@pw1", "@pw2",
255     "getpwent() produced identical results in list and scalar contexts");
256
257 close(PW);