devdaily home | apple | java | perl | unix | directory | blog

What this is

This file is included in the DevDaily.com "Perl Source Code Warehouse" project. The intent of this project is to help you "Learn Perl by Example" TM.

Other links

The source code

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
}

eval {my @n = getgrgid 0};
if ($@ =~ /(The \w+ function is unimplemented)/) {
    skip_all "getgrgid unimplemented";
}

eval { require Config; import Config; };
my $reason;
if ($Config{'i_grp'} ne 'define') {
	$reason = '$Config{i_grp} not defined';
}
elsif (not -f "/etc/group" ) { # Play safe.
	$reason = 'no /etc/group file';
}

if (not defined $where) {	# Try NIS.
    foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
        if (-x $ypcat &&
            open(GR, "$ypcat group 2>/dev/null |") &&
            defined()) 
        {
            print "# `ypcat group` worked\n";

            # Check to make sure we're really using NIS.
            if( open(NSSW, "/etc/nsswitch.conf" ) ) {
                my($group) = grep /^\s*group:/, ;

                # If there's no group line, assume it default to compat.
                if( !$group || $group !~ /(nis|compat)/ ) {
                    print "# Doesn't look like you're using NIS in ".
                          "/etc/nsswitch.conf\n";
                    last;
                }
            }
            $where = "NIS group - $ypcat";
            undef $reason;
            last;
        }
    }
}

if (not defined $where) {	# Try NetInfo.
    foreach my $nidump (qw(/usr/bin/nidump)) {
        if (-x $nidump &&
            open(GR, "$nidump group . 2>/dev/null |") &&
            defined()) 
        {
            $where = "NetInfo group - $nidump";
            undef $reason;
            last;
        }
    }
}

if (not defined $where) {	# Try local.
    my $GR = "/etc/group";
    if (-f $GR && open(GR, $GR) && defined()) {
        undef $reason;
        $where = "local $GR";
    }
}

if ($reason) {
    skip_all $reason;
}


# By now the GR filehandle should be open and full of juicy group entries.

plan tests => 3;

# Go through at most this many groups.
# (note that the first entry has been read away by now)
my $max = 25;

my $n   = 0;
my $tst = 1;
my %perfect;
my %seen;

print "# where $where\n";

ok( setgrent(), 'setgrent' ) || print "# $!\n";

while () {
    chomp;
    # LIMIT -1 so that groups with no users don't fall off
    my @s = split /:/, $_, -1;
    my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
    if (@s) {
	push @{ $seen{$name_s} }, $.;
    } else {
	warn "# Your $where line $. is empty.\n";
	next;
    }
    if ($n == $max) {
	local $/;
	my $junk = ;
	last;
    }
    # In principle we could whine if @s != 4 but do we know enough
    # of group file formats everywhere?
    if (@s == 4) {
	$members_s =~ s/\s*,\s*/,/g;
	$members_s =~ s/\s+$//;
	$members_s =~ s/^\s+//;
	@n = getgrgid($gid_s);
	# 'nogroup' et al.
	next unless @n;
	my ($name,$passwd,$gid,$members) = @n;
	# Protect against one-to-many and many-to-one mappings.
	if ($name_s ne $name) {
	    @n = getgrnam($name_s);
	    ($name,$passwd,$gid,$members) = @n;
	    next if $name_s ne $name;
	}
	# NOTE: group names *CAN* contain whitespace.
	$members =~ s/\s+/,/g;
	# what about different orders of members?
	$perfect{$name_s}++
	    if $name    eq $name_s    and
# Do not compare passwords: think shadow passwords.
# Not that group passwords are used much but better not assume anything.
               $gid     eq $gid_s     and
               $members eq $members_s;
    }
    $n++;
}

endgrent();

print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";

if (keys %perfect == 0 && $n) {
    $max++;
    print <




Copyright 1998-2008 Alvin Alexander
All Rights Reserved.
 
devdaily.com is based in louisville, kentucky, and this web site is hosted by godaddy.com