Commit | Line | Data |
---|---|---|
c5987ebb JH |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
b62e3068 | 6 | eval {my @n = getpwuid 0; setpwent()}; |
df284ca6 JD |
7 | if ($@ && $@ =~ /(The \w+ function is unimplemented)/) { |
8 | print "1..0 # Skip: $1\n"; | |
9 | exit 0; | |
10 | } | |
c5987ebb | 11 | eval { require Config; import Config; }; |
45c0de28 GS |
12 | my $reason; |
13 | if ($Config{'i_pwd'} ne 'define') { | |
14 | $reason = '$Config{i_pwd} undefined'; | |
15 | } | |
16 | elsif (not -f "/etc/passwd" ) { # Play safe. | |
17 | $reason = 'no /etc/passwd file'; | |
b91c0863 JH |
18 | } |
19 | ||
20 | if (not defined $where) { # Try NIS. | |
21 | foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) { | |
22 | if (-x $ypcat && | |
23 | open(PW, "$ypcat passwd 2>/dev/null |") && | |
24 | defined(<PW>)) { | |
25 | $where = "NIS passwd"; | |
45c0de28 | 26 | undef $reason; |
b91c0863 JH |
27 | last; |
28 | } | |
29 | } | |
30 | } | |
c5987ebb | 31 | |
b91c0863 JH |
32 | if (not defined $where) { # Try NetInfo. |
33 | foreach my $nidump (qw(/usr/bin/nidump)) { | |
34 | if (-x $nidump && | |
35 | open(PW, "$nidump passwd . 2>/dev/null |") && | |
36 | defined(<PW>)) { | |
37 | $where = "NetInfo passwd"; | |
45c0de28 | 38 | undef $reason; |
b91c0863 JH |
39 | last; |
40 | } | |
41 | } | |
42 | } | |
55ec6b63 | 43 | |
0d7a9d9f TW |
44 | if (not defined $where && # Try dscl |
45 | $Config{useperlio} eq 'define') { # need perlio | |
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 (qw(/usr/bin/dscl)) { | |
76 | -x $dscl or next; | |
77 | open (my $fh, '-|', join (' ', $dscl, qw{. -readall /Users}, | |
78 | keys %want, '2>/dev/null')) or next; | |
79 | my $data; | |
80 | my @rec; | |
81 | while (<$fh>) { | |
82 | chomp; | |
83 | if ($_ eq '-') { | |
84 | @rec and $data .= join (':', @rec) . "\n"; | |
85 | @rec = (); | |
86 | next; | |
87 | } | |
88 | my ($name, $value) = split ':\s+', $_, 2; | |
89 | unless (defined $value) { | |
90 | s/:$//; | |
91 | $name = $_; | |
92 | $value = <$fh>; | |
93 | chomp $value; | |
94 | $value =~ s/^\s+//; | |
95 | } | |
96 | if (defined (my $info = $want{$name})) { | |
97 | $rec[$info->{inx}] = $info->{mung}->($value); | |
98 | } | |
99 | } | |
100 | @rec and $data .= join (':', @rec) . "\n"; | |
101 | if (open (PW, '<', \$data)) { | |
102 | $where = "dscl . -readall /Users"; | |
103 | undef $reason; | |
104 | last; | |
105 | } | |
106 | } | |
107 | } | |
108 | ||
b91c0863 JH |
109 | if (not defined $where) { # Try local. |
110 | my $PW = "/etc/passwd"; | |
111 | if (-f $PW && open(PW, $PW) && defined(<PW>)) { | |
112 | $where = $PW; | |
45c0de28 | 113 | undef $reason; |
55ec6b63 | 114 | } |
b91c0863 JH |
115 | } |
116 | ||
a9a3fcb4 PP |
117 | if (not defined $where) { # Try NIS+ |
118 | foreach my $niscat (qw(/bin/niscat)) { | |
119 | if (-x $niscat && | |
120 | open(PW, "$niscat passwd.org_dir 2>/dev/null |") && | |
121 | defined(<PW>)) { | |
122 | $where = "NIS+ $niscat passwd.org_dir"; | |
123 | undef $reason; | |
124 | last; | |
125 | } | |
126 | } | |
127 | } | |
128 | ||
45c0de28 GS |
129 | if ($reason) { # Give up. |
130 | print "1..0 # Skip: $reason\n"; | |
c5987ebb JH |
131 | exit 0; |
132 | } | |
133 | } | |
134 | ||
765e9edb | 135 | # By now the PW filehandle should be open and full of juicy password entries. |
b91c0863 | 136 | |
765e9edb | 137 | print "1..2\n"; |
c5987ebb JH |
138 | |
139 | # Go through at most this many users. | |
b91c0863 JH |
140 | # (note that the first entry has been read away by now) |
141 | my $max = 25; | |
c5987ebb JH |
142 | |
143 | my $n = 0; | |
c5987ebb | 144 | my $tst = 1; |
b91c0863 | 145 | my %perfect; |
55ec6b63 | 146 | my %seen; |
c5987ebb | 147 | |
f0debaab JH |
148 | print "# where $where\n"; |
149 | ||
bd055eb9 | 150 | setpwent(); |
f0debaab | 151 | |
c5987ebb | 152 | while (<PW>) { |
c5987ebb | 153 | chomp; |
a941e390 MD |
154 | # LIMIT -1 so that users with empty shells don't fall off |
155 | my @s = split /:/, $_, -1; | |
32b4ad3c | 156 | my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s); |
8faed529 RGS |
157 | (my $v) = $Config{osvers} =~ /^(\d+)/; |
158 | if ($^O eq 'darwin' && $v < 9) { | |
32b4ad3c PS |
159 | ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9]; |
160 | } else { | |
161 | ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s; | |
162 | } | |
b91c0863 | 163 | next if /^\+/; # ignore NIS includes |
55ec6b63 JH |
164 | if (@s) { |
165 | push @{ $seen{$name_s} }, $.; | |
166 | } else { | |
167 | warn "# Your $where line $. is empty.\n"; | |
168 | next; | |
169 | } | |
09ac174e GB |
170 | if ($n == $max) { |
171 | local $/; | |
172 | my $junk = <PW>; | |
173 | last; | |
174 | } | |
55ec6b63 JH |
175 | # In principle we could whine if @s != 7 but do we know enough |
176 | # of passwd file formats everywhere? | |
32b4ad3c | 177 | if (@s == 7 || ($^O eq 'darwin' && @s == 10)) { |
c5987ebb JH |
178 | @n = getpwuid($uid_s); |
179 | # 'nobody' et al. | |
180 | next unless @n; | |
181 | my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; | |
182 | # Protect against one-to-many and many-to-one mappings. | |
183 | if ($name_s ne $name) { | |
184 | @n = getpwnam($name_s); | |
185 | ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; | |
186 | next if $name_s ne $name; | |
187 | } | |
b91c0863 JH |
188 | $perfect{$name_s}++ |
189 | if $name eq $name_s and | |
190 | $uid eq $uid_s and | |
191 | # Do not compare passwords: think shadow passwords. | |
192 | $gid eq $gid_s and | |
193 | $gcos eq $gcos_s and | |
194 | $home eq $home_s and | |
195 | $shell eq $shell_s; | |
c5987ebb JH |
196 | } |
197 | $n++; | |
198 | } | |
f0debaab | 199 | |
bd055eb9 | 200 | endpwent(); |
c5987ebb | 201 | |
f0debaab JH |
202 | print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n"; |
203 | ||
93d44f78 | 204 | if (keys %perfect == 0 && $n) { |
b91c0863 JH |
205 | $max++; |
206 | print <<EOEX; | |
207 | # | |
208 | # The failure of op/pwent test is not necessarily serious. | |
209 | # It may fail due to local password administration conventions. | |
210 | # If you are for example using both NIS and local passwords, | |
211 | # test failure is possible. Any distributed password scheme | |
212 | # can cause such failures. | |
213 | # | |
214 | # What the pwent test is doing is that it compares the $max first | |
215 | # entries of $where | |
216 | # with the results of getpwuid() and getpwnam() call. If it finds no | |
217 | # matches at all, it suspects something is wrong. | |
218 | # | |
219 | EOEX | |
220 | print "not "; | |
221 | $not = 1; | |
222 | } else { | |
223 | $not = 0; | |
55ec6b63 | 224 | } |
b91c0863 JH |
225 | print "ok ", $tst++; |
226 | print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not; | |
227 | print "\n"; | |
c5987ebb | 228 | |
91e74348 | 229 | # Test both the scalar and list contexts. |
765e9edb JH |
230 | |
231 | my @pw1; | |
232 | ||
765e9edb JH |
233 | setpwent(); |
234 | for (1..$max) { | |
235 | my $pw = scalar getpwent(); | |
236 | last unless defined $pw; | |
237 | push @pw1, $pw; | |
238 | } | |
bd055eb9 | 239 | endpwent(); |
765e9edb JH |
240 | |
241 | my @pw2; | |
242 | ||
765e9edb JH |
243 | setpwent(); |
244 | for (1..$max) { | |
245 | my ($pw) = (getpwent()); | |
246 | last unless defined $pw; | |
247 | push @pw2, $pw; | |
248 | } | |
bd055eb9 | 249 | endpwent(); |
765e9edb JH |
250 | |
251 | print "not " unless "@pw1" eq "@pw2"; | |
252 | print "ok ", $tst++, "\n"; | |
253 | ||
c5987ebb | 254 | close(PW); |