1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require './test.pl';
1N/A}
1N/A
1N/Aeval {my @n = getgrgid 0};
1N/Aif ($@ =~ /(The \w+ function is unimplemented)/) {
1N/A skip_all "getgrgid unimplemented";
1N/A}
1N/A
1N/Aeval { require Config; import Config; };
1N/Amy $reason;
1N/Aif ($Config{'i_grp'} ne 'define') {
1N/A $reason = '$Config{i_grp} not defined';
1N/A}
1N/Aelsif (not -f "/etc/group" ) { # Play safe.
1N/A $reason = 'no /etc/group file';
1N/A}
1N/A
1N/Aif (not defined $where) { # Try NIS.
1N/A foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
1N/A if (-x $ypcat &&
1N/A open(GR, "$ypcat group 2>/dev/null |") &&
1N/A defined(<GR>))
1N/A {
1N/A print "# `ypcat group` worked\n";
1N/A
1N/A # Check to make sure we're really using NIS.
1N/A if( open(NSSW, "/etc/nsswitch.conf" ) ) {
1N/A my($group) = grep /^\s*group:/, <NSSW>;
1N/A
1N/A # If there's no group line, assume it default to compat.
1N/A if( !$group || $group !~ /(nis|compat)/ ) {
1N/A print "# Doesn't look like you're using NIS in ".
1N/A "/etc/nsswitch.conf\n";
1N/A last;
1N/A }
1N/A }
1N/A $where = "NIS group - $ypcat";
1N/A undef $reason;
1N/A last;
1N/A }
1N/A }
1N/A}
1N/A
1N/Aif (not defined $where) { # Try NetInfo.
1N/A foreach my $nidump (qw(/usr/bin/nidump)) {
1N/A if (-x $nidump &&
1N/A open(GR, "$nidump group . 2>/dev/null |") &&
1N/A defined(<GR>))
1N/A {
1N/A $where = "NetInfo group - $nidump";
1N/A undef $reason;
1N/A last;
1N/A }
1N/A }
1N/A}
1N/A
1N/Aif (not defined $where) { # Try local.
1N/A my $GR = "/etc/group";
1N/A if (-f $GR && open(GR, $GR) && defined(<GR>)) {
1N/A undef $reason;
1N/A $where = "local $GR";
1N/A }
1N/A}
1N/A
1N/Aif ($reason) {
1N/A skip_all $reason;
1N/A}
1N/A
1N/A
1N/A# By now the GR filehandle should be open and full of juicy group entries.
1N/A
1N/Aplan tests => 3;
1N/A
1N/A# Go through at most this many groups.
1N/A# (note that the first entry has been read away by now)
1N/Amy $max = 25;
1N/A
1N/Amy $n = 0;
1N/Amy $tst = 1;
1N/Amy %perfect;
1N/Amy %seen;
1N/A
1N/Aprint "# where $where\n";
1N/A
1N/Aok( setgrent(), 'setgrent' ) || print "# $!\n";
1N/A
1N/Awhile (<GR>) {
1N/A chomp;
1N/A # LIMIT -1 so that groups with no users don't fall off
1N/A my @s = split /:/, $_, -1;
1N/A my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
1N/A if (@s) {
1N/A push @{ $seen{$name_s} }, $.;
1N/A } else {
1N/A warn "# Your $where line $. is empty.\n";
1N/A next;
1N/A }
1N/A if ($n == $max) {
1N/A local $/;
1N/A my $junk = <GR>;
1N/A last;
1N/A }
1N/A # In principle we could whine if @s != 4 but do we know enough
1N/A # of group file formats everywhere?
1N/A if (@s == 4) {
1N/A $members_s =~ s/\s*,\s*/,/g;
1N/A $members_s =~ s/\s+$//;
1N/A $members_s =~ s/^\s+//;
1N/A @n = getgrgid($gid_s);
1N/A # 'nogroup' et al.
1N/A next unless @n;
1N/A my ($name,$passwd,$gid,$members) = @n;
1N/A # Protect against one-to-many and many-to-one mappings.
1N/A if ($name_s ne $name) {
1N/A @n = getgrnam($name_s);
1N/A ($name,$passwd,$gid,$members) = @n;
1N/A next if $name_s ne $name;
1N/A }
1N/A # NOTE: group names *CAN* contain whitespace.
1N/A $members =~ s/\s+/,/g;
1N/A # what about different orders of members?
1N/A $perfect{$name_s}++
1N/A if $name eq $name_s and
1N/A# Do not compare passwords: think shadow passwords.
1N/A# Not that group passwords are used much but better not assume anything.
1N/A $gid eq $gid_s and
1N/A $members eq $members_s;
1N/A }
1N/A $n++;
1N/A}
1N/A
1N/Aendgrent();
1N/A
1N/Aprint "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
1N/A
1N/Aif (keys %perfect == 0 && $n) {
1N/A $max++;
1N/A print <<EOEX;
1N/A#
1N/A# The failure of op/grent test is not necessarily serious.
1N/A# It may fail due to local group administration conventions.
1N/A# If you are for example using both NIS and local groups,
1N/A# test failure is possible. Any distributed group scheme
1N/A# can cause such failures.
1N/A#
1N/A# What the grent test is doing is that it compares the $max first
1N/A# entries of $where
1N/A# with the results of getgrgid() and getgrnam() call. If it finds no
1N/A# matches at all, it suspects something is wrong.
1N/A#
1N/AEOEX
1N/A
1N/A fail();
1N/A print "#\t (not necessarily serious: run t/op/grent.t by itself)\n";
1N/A} else {
1N/A pass();
1N/A}
1N/A
1N/A# Test both the scalar and list contexts.
1N/A
1N/Amy @gr1;
1N/A
1N/Asetgrent();
1N/Afor (1..$max) {
1N/A my $gr = scalar getgrent();
1N/A last unless defined $gr;
1N/A push @gr1, $gr;
1N/A}
1N/Aendgrent();
1N/A
1N/Amy @gr2;
1N/A
1N/Asetgrent();
1N/Afor (1..$max) {
1N/A my ($gr) = (getgrent());
1N/A last unless defined $gr;
1N/A push @gr2, $gr;
1N/A}
1N/Aendgrent();
1N/A
1N/Ais("@gr1", "@gr2");
1N/A
1N/Aclose(GR);