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';
    eval {my @n = getpwuid 0; setpwent()};
    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
	print "1..0 # Skip: $1\n";
	exit 0;
    }
    eval { require Config; import Config; };
    my $reason;
    if ($Config{'i_pwd'} ne 'define') {
	$reason = '$Config{i_pwd} undefined';
    }
    elsif (not -f "/etc/passwd" ) { # Play safe.
	$reason = 'no /etc/passwd file';
    }

    if (not defined $where) {	# Try NIS.
	foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
	    if (-x $ypcat &&
		open(PW, "$ypcat passwd 2>/dev/null |") &&
		defined()) {
		$where = "NIS passwd";
		undef $reason;
		last;
	    }
	}
    }

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

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

    if (not defined $where) {      # Try NIS+
     foreach my $niscat (qw(/bin/niscat)) {
         if (-x $niscat &&
           open(PW, "$niscat passwd.org_dir 2>/dev/null |") &&
           defined()) {
           $where = "NIS+ $niscat passwd.org_dir";
           undef $reason;
           last;
         }
     }
    }

    if ($reason) {	# Give up.
	print "1..0 # Skip: $reason\n";
	exit 0;
    }
}

# By now the PW filehandle should be open and full of juicy password entries.

print "1..2\n";

# Go through at most this many users.
# (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";

setpwent();

while () {
    chomp;
    # LIMIT -1 so that users with empty shells don't fall off
    my @s = split /:/, $_, -1;
    my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
    if ($^O eq 'darwin') {
       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
    } else {
       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
    }
    next if /^\+/; # ignore NIS includes
    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 != 7 but do we know enough
    # of passwd file formats everywhere?
    if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
	@n = getpwuid($uid_s);
	# 'nobody' et al.
	next unless @n;
	my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
	# Protect against one-to-many and many-to-one mappings.
	if ($name_s ne $name) {
	    @n = getpwnam($name_s);
	    ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
	    next if $name_s ne $name;
	}
	$perfect{$name_s}++
	    if $name    eq $name_s    and
               $uid     eq $uid_s     and
# Do not compare passwords: think shadow passwords.
               $gid     eq $gid_s     and
               $gcos    eq $gcos_s    and
               $home    eq $home_s    and
               $shell   eq $shell_s;
    }
    $n++;
}

endpwent();

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