This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
chop/chomp modify readonly values
[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";
c5987ebb
JH
6 eval { require Config; import Config; };
7
b91c0863
JH
8 unless (defined $Config{'i_pwd'} &&
9 $Config{'i_pwd'} eq 'define' &&
10 -f "/etc/passwd" ) { # Play safe.
11 print "1..0\n";
12 exit 0;
13 }
14
15 if (not defined $where) { # Try NIS.
16 foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
17 if (-x $ypcat &&
18 open(PW, "$ypcat passwd 2>/dev/null |") &&
19 defined(<PW>)) {
20 $where = "NIS passwd";
21 last;
22 }
23 }
24 }
c5987ebb 25
b91c0863
JH
26 if (not defined $where) { # Try NetInfo.
27 foreach my $nidump (qw(/usr/bin/nidump)) {
28 if (-x $nidump &&
29 open(PW, "$nidump passwd . 2>/dev/null |") &&
30 defined(<PW>)) {
31 $where = "NetInfo passwd";
32 last;
33 }
34 }
35 }
55ec6b63 36
b91c0863
JH
37 if (not defined $where) { # Try local.
38 my $PW = "/etc/passwd";
39 if (-f $PW && open(PW, $PW) && defined(<PW>)) {
40 $where = $PW;
55ec6b63 41 }
b91c0863
JH
42 }
43
44 if (not defined $where) { # Give up.
c5987ebb
JH
45 print "1..0\n";
46 exit 0;
47 }
48}
49
b91c0863
JH
50# By now PW filehandle should be open and full of juicy password entries.
51
c5987ebb
JH
52print "1..1\n";
53
54# Go through at most this many users.
b91c0863
JH
55# (note that the first entry has been read away by now)
56my $max = 25;
c5987ebb
JH
57
58my $n = 0;
c5987ebb 59my $tst = 1;
b91c0863 60my %perfect;
55ec6b63 61my %seen;
c5987ebb 62
c5987ebb 63while (<PW>) {
c5987ebb 64 chomp;
55ec6b63
JH
65 my @s = split /:/;
66 my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
b91c0863 67 next if /^\+/; # ignore NIS includes
55ec6b63
JH
68 if (@s) {
69 push @{ $seen{$name_s} }, $.;
70 } else {
71 warn "# Your $where line $. is empty.\n";
72 next;
73 }
b91c0863 74 last if $n == $max;
55ec6b63
JH
75 # In principle we could whine if @s != 7 but do we know enough
76 # of passwd file formats everywhere?
c5987ebb 77 if (@s == 7) {
c5987ebb
JH
78 @n = getpwuid($uid_s);
79 # 'nobody' et al.
80 next unless @n;
81 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
82 # Protect against one-to-many and many-to-one mappings.
83 if ($name_s ne $name) {
84 @n = getpwnam($name_s);
85 ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
86 next if $name_s ne $name;
87 }
b91c0863
JH
88 $perfect{$name_s}++
89 if $name eq $name_s and
90 $uid eq $uid_s and
91# Do not compare passwords: think shadow passwords.
92 $gid eq $gid_s and
93 $gcos eq $gcos_s and
94 $home eq $home_s and
95 $shell eq $shell_s;
c5987ebb
JH
96 }
97 $n++;
98}
99
b91c0863
JH
100if (keys %perfect == 0) {
101 $max++;
102 print <<EOEX;
103#
104# The failure of op/pwent test is not necessarily serious.
105# It may fail due to local password administration conventions.
106# If you are for example using both NIS and local passwords,
107# test failure is possible. Any distributed password scheme
108# can cause such failures.
109#
110# What the pwent test is doing is that it compares the $max first
111# entries of $where
112# with the results of getpwuid() and getpwnam() call. If it finds no
113# matches at all, it suspects something is wrong.
114#
115EOEX
116 print "not ";
117 $not = 1;
118} else {
119 $not = 0;
55ec6b63 120}
b91c0863
JH
121print "ok ", $tst++;
122print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
123print "\n";
c5987ebb
JH
124
125close(PW);