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