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 / grent.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 $GR = "/etc/group";
9
55ec6b63
JH
10 $where = $GR;
11
12 if (-x "/usr/bin/nidump") {
13 if (open(GR, "nidump group . |")) {
14 $where = "NetInfo";
15 } else {
16 print "1..0\n";
17 exit 0;
18 }
19 } elsif ((defined $Config{'i_grp'} and $Config{'i_grp'} ne 'define')
20 or not -f $GR or not open(GR, $GR)
21 ) {
c5987ebb
JH
22 print "1..0\n";
23 exit 0;
24 }
25}
26
27print "1..1\n";
28
29# Go through at most this many groups.
55ec6b63 30my $max = 25;
c5987ebb 31
55ec6b63 32my $n = 0;
c5987ebb 33my $tst = 1;
55ec6b63
JH
34my %suspect;
35my %seen;
c5987ebb 36
c5987ebb 37while (<GR>) {
c5987ebb 38 chomp;
55ec6b63
JH
39 my @s = split /:/;
40 my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
41 if (@s) {
42 push @{ $seen{$name_s} }, $.;
43 } else {
44 warn "# Your $where line $. is empty.\n";
45 next;
46 }
47 next if $n == $max;
48 # In principle we could whine if @s != 4 but do we know enough
49 # of group file formats everywhere?
c5987ebb 50 if (@s == 4) {
5e5f18aa 51 $members_s =~ s/\s*,\s*/,/g;
b56ec344
JH
52 $members_s =~ s/\s+$//;
53 $members_s =~ s/^\s+//;
c5987ebb
JH
54 @n = getgrgid($gid_s);
55 # 'nogroup' et al.
56 next unless @n;
57 my ($name,$passwd,$gid,$members) = @n;
58 # Protect against one-to-many and many-to-one mappings.
59 if ($name_s ne $name) {
60 @n = getgrnam($name_s);
61 ($name,$passwd,$gid,$members) = @n;
62 next if $name_s ne $name;
63 }
5e5f18aa 64 $members =~ s/\s+/,/g;
55ec6b63 65 $suspect{$name_s}++
c5987ebb
JH
66 if $name ne $name_s or
67# Shadow passwords confuse this.
55ec6b63 68# Not that group passwords are used much but better not assume anything.
c5987ebb
JH
69# $passwd ne $passwd_s or
70 $gid ne $gid_s or
71 $members ne $members_s;
72 }
73 $n++;
74}
75
55ec6b63
JH
76# Drop the multiply defined groups.
77
78foreach (sort keys %seen) {
79 my $times = @{ $seen{$_} };
80 if ($times > 1) {
81 # Multiply defined groups are rarely intentional.
82 local $" = ", ";
83 warn "# Group '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
84 delete $suspect{$_};
85 }
86}
87
88print "not " if keys %suspect;
c5987ebb
JH
89print "ok ", $tst++, "\n";
90
91close(GR);