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