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) { | |
77 | push @lines, join (':', @rec) . "\n"; | |
0d7a9d9f | 78 | @rec = (); |
0d7a9d9f | 79 | } |
16acebfd NC |
80 | next; |
81 | } | |
82 | my ($name, $value) = split ':\s+', $_, 2; | |
83 | unless (defined $value) { | |
84 | s/:$//; | |
85 | $name = $_; | |
86 | $value = <$fh>; | |
87 | chomp $value; | |
88 | $value =~ s/^\s+//; | |
0d7a9d9f | 89 | } |
16acebfd NC |
90 | if (defined (my $info = $want{$name})) { |
91 | $rec[$info->{inx}] = $info->{mung}->($value); | |
0d7a9d9f TW |
92 | } |
93 | } | |
16acebfd NC |
94 | if (@rec) { |
95 | push @lines, join (':', @rec) . "\n"; | |
96 | } | |
97 | my $data = join '', @lines; | |
98 | if (open PW, '<', \$data) { | |
99 | $where = "dscl . -readall /Users"; | |
100 | last; | |
101 | } | |
0d7a9d9f | 102 | } |
16acebfd | 103 | } |
0d7a9d9f | 104 | |
16acebfd NC |
105 | if (not defined $where) { |
106 | # Try local. | |
107 | my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined'; | |
108 | ||
109 | my $PW = "/etc/passwd"; | |
110 | if (!-f $PW) { | |
111 | skip_all($no_i_pwd) if $no_i_pwd; | |
112 | skip_all("no $PW file"); | |
113 | } elsif (open PW, '<', $PW) { | |
114 | if(defined <PW>) { | |
115 | $where = $PW; | |
0f0aa27e | 116 | } else { |
16acebfd NC |
117 | skip_all($no_i_pwd) if $no_i_pwd; |
118 | die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up"; | |
55ec6b63 | 119 | } |
16acebfd NC |
120 | } else { |
121 | die "Can't open $PW: $!"; | |
b91c0863 | 122 | } |
c5987ebb JH |
123 | } |
124 | ||
765e9edb | 125 | # By now the PW filehandle should be open and full of juicy password entries. |
b91c0863 | 126 | |
16acebfd | 127 | plan(tests => 2); |
c5987ebb JH |
128 | |
129 | # Go through at most this many users. | |
b91c0863 JH |
130 | # (note that the first entry has been read away by now) |
131 | my $max = 25; | |
c5987ebb JH |
132 | |
133 | my $n = 0; | |
b91c0863 | 134 | my %perfect; |
55ec6b63 | 135 | my %seen; |
c5987ebb | 136 | |
f0debaab JH |
137 | print "# where $where\n"; |
138 | ||
bd055eb9 | 139 | setpwent(); |
f0debaab | 140 | |
c5987ebb | 141 | while (<PW>) { |
c5987ebb | 142 | chomp; |
a941e390 MD |
143 | # LIMIT -1 so that users with empty shells don't fall off |
144 | my @s = split /:/, $_, -1; | |
32b4ad3c | 145 | my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s); |
16acebfd | 146 | (my $v) = $Config::Config{osvers} =~ /^(\d+)/; |
8faed529 | 147 | if ($^O eq 'darwin' && $v < 9) { |
32b4ad3c PS |
148 | ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9]; |
149 | } else { | |
150 | ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s; | |
151 | } | |
b91c0863 | 152 | next if /^\+/; # ignore NIS includes |
55ec6b63 JH |
153 | if (@s) { |
154 | push @{ $seen{$name_s} }, $.; | |
155 | } else { | |
156 | warn "# Your $where line $. is empty.\n"; | |
157 | next; | |
158 | } | |
09ac174e GB |
159 | if ($n == $max) { |
160 | local $/; | |
161 | my $junk = <PW>; | |
162 | last; | |
163 | } | |
55ec6b63 JH |
164 | # In principle we could whine if @s != 7 but do we know enough |
165 | # of passwd file formats everywhere? | |
32b4ad3c | 166 | if (@s == 7 || ($^O eq 'darwin' && @s == 10)) { |
16acebfd | 167 | my @n = getpwuid($uid_s); |
c5987ebb JH |
168 | # 'nobody' et al. |
169 | next unless @n; | |
170 | my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; | |
171 | # Protect against one-to-many and many-to-one mappings. | |
172 | if ($name_s ne $name) { | |
173 | @n = getpwnam($name_s); | |
174 | ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; | |
175 | next if $name_s ne $name; | |
176 | } | |
b91c0863 JH |
177 | $perfect{$name_s}++ |
178 | if $name eq $name_s and | |
179 | $uid eq $uid_s and | |
180 | # Do not compare passwords: think shadow passwords. | |
181 | $gid eq $gid_s and | |
182 | $gcos eq $gcos_s and | |
183 | $home eq $home_s and | |
184 | $shell eq $shell_s; | |
c5987ebb JH |
185 | } |
186 | $n++; | |
187 | } | |
f0debaab | 188 | |
bd055eb9 | 189 | endpwent(); |
c5987ebb | 190 | |
f0debaab JH |
191 | print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n"; |
192 | ||
16acebfd NC |
193 | SKIP: { |
194 | skip("Found no password entries", 1) unless $n; | |
195 | ||
196 | if (keys %perfect == 0) { | |
197 | $max++; | |
198 | print <<EOEX; | |
b91c0863 JH |
199 | # |
200 | # The failure of op/pwent test is not necessarily serious. | |
201 | # It may fail due to local password administration conventions. | |
202 | # If you are for example using both NIS and local passwords, | |
203 | # test failure is possible. Any distributed password scheme | |
204 | # can cause such failures. | |
205 | # | |
206 | # What the pwent test is doing is that it compares the $max first | |
207 | # entries of $where | |
208 | # with the results of getpwuid() and getpwnam() call. If it finds no | |
209 | # matches at all, it suspects something is wrong. | |
210 | # | |
211 | EOEX | |
16acebfd NC |
212 | } |
213 | ||
214 | cmp_ok(keys %perfect, '>', 0) | |
215 | or note("(not necessarily serious: run t/op/pwent.t by itself)"); | |
55ec6b63 | 216 | } |
c5987ebb | 217 | |
91e74348 | 218 | # Test both the scalar and list contexts. |
765e9edb JH |
219 | |
220 | my @pw1; | |
221 | ||
765e9edb JH |
222 | setpwent(); |
223 | for (1..$max) { | |
224 | my $pw = scalar getpwent(); | |
225 | last unless defined $pw; | |
226 | push @pw1, $pw; | |
227 | } | |
bd055eb9 | 228 | endpwent(); |
765e9edb JH |
229 | |
230 | my @pw2; | |
231 | ||
765e9edb JH |
232 | setpwent(); |
233 | for (1..$max) { | |
234 | my ($pw) = (getpwent()); | |
235 | last unless defined $pw; | |
236 | push @pw2, $pw; | |
237 | } | |
bd055eb9 | 238 | endpwent(); |
765e9edb | 239 | |
16acebfd | 240 | is("@pw1", "@pw2"); |
765e9edb | 241 | |
c5987ebb | 242 | close(PW); |