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