This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Net::Ping 2.17.
[perl5.git] / t / op / pwent.t
CommitLineData
c5987ebb
JH
1#!./perl
2
3BEGIN {
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
b91c0863
JH
44 if (not defined $where) { # Try local.
45 my $PW = "/etc/passwd";
46 if (-f $PW && open(PW, $PW) && defined(<PW>)) {
47 $where = $PW;
45c0de28 48 undef $reason;
55ec6b63 49 }
b91c0863
JH
50 }
51
45c0de28
GS
52 if ($reason) { # Give up.
53 print "1..0 # Skip: $reason\n";
c5987ebb
JH
54 exit 0;
55 }
56}
57
765e9edb 58# By now the PW filehandle should be open and full of juicy password entries.
b91c0863 59
765e9edb 60print "1..2\n";
c5987ebb
JH
61
62# Go through at most this many users.
b91c0863
JH
63# (note that the first entry has been read away by now)
64my $max = 25;
c5987ebb
JH
65
66my $n = 0;
c5987ebb 67my $tst = 1;
b91c0863 68my %perfect;
55ec6b63 69my %seen;
c5987ebb 70
f0debaab
JH
71print "# where $where\n";
72
bd055eb9 73setpwent();
f0debaab 74
c5987ebb 75while (<PW>) {
c5987ebb 76 chomp;
a941e390
MD
77 # LIMIT -1 so that users with empty shells don't fall off
78 my @s = split /:/, $_, -1;
32b4ad3c
PS
79 my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
80 if ($^O eq 'darwin') {
81 ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
82 } else {
83 ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
84 }
b91c0863 85 next if /^\+/; # ignore NIS includes
55ec6b63
JH
86 if (@s) {
87 push @{ $seen{$name_s} }, $.;
88 } else {
89 warn "# Your $where line $. is empty.\n";
90 next;
91 }
09ac174e
GB
92 if ($n == $max) {
93 local $/;
94 my $junk = <PW>;
95 last;
96 }
55ec6b63
JH
97 # In principle we could whine if @s != 7 but do we know enough
98 # of passwd file formats everywhere?
32b4ad3c 99 if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
c5987ebb
JH
100 @n = getpwuid($uid_s);
101 # 'nobody' et al.
102 next unless @n;
103 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
104 # Protect against one-to-many and many-to-one mappings.
105 if ($name_s ne $name) {
106 @n = getpwnam($name_s);
107 ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
108 next if $name_s ne $name;
109 }
b91c0863
JH
110 $perfect{$name_s}++
111 if $name eq $name_s and
112 $uid eq $uid_s and
113# Do not compare passwords: think shadow passwords.
114 $gid eq $gid_s and
115 $gcos eq $gcos_s and
116 $home eq $home_s and
117 $shell eq $shell_s;
c5987ebb
JH
118 }
119 $n++;
120}
f0debaab 121
bd055eb9 122endpwent();
c5987ebb 123
f0debaab
JH
124print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
125
93d44f78 126if (keys %perfect == 0 && $n) {
b91c0863
JH
127 $max++;
128 print <<EOEX;
129#
130# The failure of op/pwent test is not necessarily serious.
131# It may fail due to local password administration conventions.
132# If you are for example using both NIS and local passwords,
133# test failure is possible. Any distributed password scheme
134# can cause such failures.
135#
136# What the pwent test is doing is that it compares the $max first
137# entries of $where
138# with the results of getpwuid() and getpwnam() call. If it finds no
139# matches at all, it suspects something is wrong.
140#
141EOEX
142 print "not ";
143 $not = 1;
144} else {
145 $not = 0;
55ec6b63 146}
b91c0863
JH
147print "ok ", $tst++;
148print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
149print "\n";
c5987ebb 150
91e74348 151# Test both the scalar and list contexts.
765e9edb
JH
152
153my @pw1;
154
765e9edb
JH
155setpwent();
156for (1..$max) {
157 my $pw = scalar getpwent();
158 last unless defined $pw;
159 push @pw1, $pw;
160}
bd055eb9 161endpwent();
765e9edb
JH
162
163my @pw2;
164
765e9edb
JH
165setpwent();
166for (1..$max) {
167 my ($pw) = (getpwent());
168 last unless defined $pw;
169 push @pw2, $pw;
170}
bd055eb9 171endpwent();
765e9edb
JH
172
173print "not " unless "@pw1" eq "@pw2";
174print "ok ", $tst++, "\n";
175
c5987ebb 176close(PW);