This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Passwd and group file groveling.
[perl5.git] / t / op / pwent.t
CommitLineData
c5987ebb
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = "../lib" if -d "../lib";
6 eval { require Config; import Config; };
7
8 my $PW = "/etc/passwd";
9
55ec6b63
JH
10 $where = $PW;
11
12 if (-x "/usr/bin/nidump") {
13 if (open(PW, "nidump passwd . |")) {
14 $where = "NetInfo";
15 } else {
16 print "1..0\n";
17 exit 0;
18 }
19 } elsif ((defined $Config{'i_pwd'} and $Config{'i_pwd'} ne 'define')
20 or not -f $PW or not open(PW, $PW)) {
c5987ebb
JH
21 print "1..0\n";
22 exit 0;
23 }
24}
25
26print "1..1\n";
27
28# Go through at most this many users.
29my $max = 25; #
30
31my $n = 0;
c5987ebb 32my $tst = 1;
55ec6b63
JH
33my %suspect;
34my %seen;
c5987ebb 35
c5987ebb 36while (<PW>) {
c5987ebb 37 chomp;
55ec6b63
JH
38 my @s = split /:/;
39 my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
40 if (@s) {
41 push @{ $seen{$name_s} }, $.;
42 } else {
43 warn "# Your $where line $. is empty.\n";
44 next;
45 }
46 next if $n == $max;
47 # In principle we could whine if @s != 7 but do we know enough
48 # of passwd file formats everywhere?
c5987ebb 49 if (@s == 7) {
c5987ebb
JH
50 @n = getpwuid($uid_s);
51 # 'nobody' et al.
52 next unless @n;
53 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
54 # Protect against one-to-many and many-to-one mappings.
55 if ($name_s ne $name) {
56 @n = getpwnam($name_s);
57 ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
58 next if $name_s ne $name;
59 }
55ec6b63 60 $suspect{$name_s}++
c5987ebb
JH
61 if $name ne $name_s or
62# Shadow passwords confuse this.
63# Think about non-crypt(3) encryptions, too, before you do anything rash.
64# $passwd ne $passwd_s or
65 $uid ne $uid_s or
66 $gid ne $gid_s or
67 $gcos ne $gcos_s or
68 $home ne $home_s or
69 $shell ne $shell_s;
70 }
71 $n++;
72}
73
55ec6b63
JH
74# Drop the multiply defined users.
75
76foreach (sort keys %seen) {
77 my $times = @{ $seen{$_} };
78 if ($times > 1) {
79 # Multiply defined users are rarely intentional.
80 local $" = ", ";
81 warn "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
82 delete $suspect{$_};
83 }
84}
85
86print "not " if keys %suspect;
c5987ebb
JH
87print "ok ", $tst++, "\n";
88
89close(PW);