Commit | Line | Data |
---|---|---|
c5987ebb JH |
1 | #!./perl |
2 | ||
16acebfd NC |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
16acebfd | 5 | require './test.pl'; |
624c42e2 | 6 | set_up_inc('../lib'); |
16acebfd NC |
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 | ||
461bf37a NC |
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 | ||
16acebfd NC |
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 | |
baacc348 JH |
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 | } | |
16acebfd NC |
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 | ||
baacc348 | 75 | foreach my $dscl (@dscl) { |
16acebfd NC |
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) { | |
876725cf NC |
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'; | |
16acebfd | 88 | push @lines, join (':', @rec) . "\n"; |
0d7a9d9f | 89 | @rec = (); |
0d7a9d9f | 90 | } |
16acebfd NC |
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+//; | |
0d7a9d9f | 100 | } |
16acebfd NC |
101 | if (defined (my $info = $want{$name})) { |
102 | $rec[$info->{inx}] = $info->{mung}->($value); | |
0d7a9d9f TW |
103 | } |
104 | } | |
16acebfd | 105 | if (@rec) { |
4e09ec70 JK |
106 | # see above |
107 | no warnings 'uninitialized'; | |
16acebfd NC |
108 | push @lines, join (':', @rec) . "\n"; |
109 | } | |
110 | my $data = join '', @lines; | |
baacc348 | 111 | if (open PW, '<', \$data) { # Needs PerlIO::scalar. |
16acebfd NC |
112 | $where = "dscl . -readall /Users"; |
113 | last; | |
114 | } | |
0d7a9d9f | 115 | } |
16acebfd | 116 | } |
baacc348 | 117 | } # DSCL: |
0d7a9d9f | 118 | |
16acebfd NC |
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; | |
0f0aa27e | 130 | } else { |
16acebfd NC |
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"; | |
55ec6b63 | 133 | } |
16acebfd NC |
134 | } else { |
135 | die "Can't open $PW: $!"; | |
b91c0863 | 136 | } |
c5987ebb JH |
137 | } |
138 | ||
765e9edb | 139 | # By now the PW filehandle should be open and full of juicy password entries. |
b91c0863 | 140 | |
16acebfd | 141 | plan(tests => 2); |
c5987ebb JH |
142 | |
143 | # Go through at most this many users. | |
b91c0863 JH |
144 | # (note that the first entry has been read away by now) |
145 | my $max = 25; | |
c5987ebb JH |
146 | |
147 | my $n = 0; | |
b91c0863 | 148 | my %perfect; |
55ec6b63 | 149 | my %seen; |
c5987ebb | 150 | |
f0debaab JH |
151 | print "# where $where\n"; |
152 | ||
bd055eb9 | 153 | setpwent(); |
f0debaab | 154 | |
c5987ebb | 155 | while (<PW>) { |
c5987ebb | 156 | chomp; |
a941e390 MD |
157 | # LIMIT -1 so that users with empty shells don't fall off |
158 | my @s = split /:/, $_, -1; | |
32b4ad3c | 159 | my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s); |
16acebfd | 160 | (my $v) = $Config::Config{osvers} =~ /^(\d+)/; |
8faed529 | 161 | if ($^O eq 'darwin' && $v < 9) { |
32b4ad3c PS |
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 | } | |
b91c0863 | 166 | next if /^\+/; # ignore NIS includes |
55ec6b63 JH |
167 | if (@s) { |
168 | push @{ $seen{$name_s} }, $.; | |
169 | } else { | |
170 | warn "# Your $where line $. is empty.\n"; | |
171 | next; | |
172 | } | |
09ac174e GB |
173 | if ($n == $max) { |
174 | local $/; | |
175 | my $junk = <PW>; | |
176 | last; | |
177 | } | |
55ec6b63 JH |
178 | # In principle we could whine if @s != 7 but do we know enough |
179 | # of passwd file formats everywhere? | |
32b4ad3c | 180 | if (@s == 7 || ($^O eq 'darwin' && @s == 10)) { |
16acebfd | 181 | my @n = getpwuid($uid_s); |
c5987ebb JH |
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 | } | |
b91c0863 JH |
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; | |
c5987ebb JH |
199 | } |
200 | $n++; | |
201 | } | |
f0debaab | 202 | |
bd055eb9 | 203 | endpwent(); |
c5987ebb | 204 | |
f0debaab JH |
205 | print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n"; |
206 | ||
16acebfd NC |
207 | SKIP: { |
208 | skip("Found no password entries", 1) unless $n; | |
209 | ||
210 | if (keys %perfect == 0) { | |
211 | $max++; | |
212 | print <<EOEX; | |
b91c0863 JH |
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 | |
16acebfd NC |
226 | } |
227 | ||
7cbbc511 | 228 | cmp_ok(keys %perfect, '>', 0, "pwent test satisfactory") |
16acebfd | 229 | or note("(not necessarily serious: run t/op/pwent.t by itself)"); |
55ec6b63 | 230 | } |
c5987ebb | 231 | |
91e74348 | 232 | # Test both the scalar and list contexts. |
765e9edb JH |
233 | |
234 | my @pw1; | |
235 | ||
765e9edb JH |
236 | setpwent(); |
237 | for (1..$max) { | |
238 | my $pw = scalar getpwent(); | |
239 | last unless defined $pw; | |
240 | push @pw1, $pw; | |
241 | } | |
bd055eb9 | 242 | endpwent(); |
765e9edb JH |
243 | |
244 | my @pw2; | |
245 | ||
765e9edb JH |
246 | setpwent(); |
247 | for (1..$max) { | |
248 | my ($pw) = (getpwent()); | |
249 | last unless defined $pw; | |
250 | push @pw2, $pw; | |
251 | } | |
bd055eb9 | 252 | endpwent(); |
765e9edb | 253 | |
7cbbc511 JK |
254 | is("@pw1", "@pw2", |
255 | "getpwent() produced identical results in list and scalar contexts"); | |
765e9edb | 256 | |
c5987ebb | 257 | close(PW); |