This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test in change#4428 needs strict interpretation of C modulus
[perl5.git] / t / op / pwent.t
CommitLineData
c5987ebb
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
b91c0863 5 unshift @INC, "../lib" if -d "../lib";
df284ca6
JD
6 eval {my @n = getpwuid 0};
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
b91c0863
JH
58# By now PW filehandle should be open and full of juicy password entries.
59
c5987ebb
JH
60print "1..1\n";
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
c5987ebb 71while (<PW>) {
c5987ebb 72 chomp;
55ec6b63
JH
73 my @s = split /:/;
74 my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
b91c0863 75 next if /^\+/; # ignore NIS includes
55ec6b63
JH
76 if (@s) {
77 push @{ $seen{$name_s} }, $.;
78 } else {
79 warn "# Your $where line $. is empty.\n";
80 next;
81 }
09ac174e
GB
82 if ($n == $max) {
83 local $/;
84 my $junk = <PW>;
85 last;
86 }
55ec6b63
JH
87 # In principle we could whine if @s != 7 but do we know enough
88 # of passwd file formats everywhere?
c5987ebb 89 if (@s == 7) {
c5987ebb
JH
90 @n = getpwuid($uid_s);
91 # 'nobody' et al.
92 next unless @n;
93 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
94 # Protect against one-to-many and many-to-one mappings.
95 if ($name_s ne $name) {
96 @n = getpwnam($name_s);
97 ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
98 next if $name_s ne $name;
99 }
b91c0863
JH
100 $perfect{$name_s}++
101 if $name eq $name_s and
102 $uid eq $uid_s and
103# Do not compare passwords: think shadow passwords.
104 $gid eq $gid_s and
105 $gcos eq $gcos_s and
106 $home eq $home_s and
107 $shell eq $shell_s;
c5987ebb
JH
108 }
109 $n++;
110}
111
b91c0863
JH
112if (keys %perfect == 0) {
113 $max++;
114 print <<EOEX;
115#
116# The failure of op/pwent test is not necessarily serious.
117# It may fail due to local password administration conventions.
118# If you are for example using both NIS and local passwords,
119# test failure is possible. Any distributed password scheme
120# can cause such failures.
121#
122# What the pwent test is doing is that it compares the $max first
123# entries of $where
124# with the results of getpwuid() and getpwnam() call. If it finds no
125# matches at all, it suspects something is wrong.
126#
127EOEX
128 print "not ";
129 $not = 1;
130} else {
131 $not = 0;
55ec6b63 132}
b91c0863
JH
133print "ok ", $tst++;
134print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
135print "\n";
c5987ebb
JH
136
137close(PW);