File Coverage

blib/lib/Unix/SetUser.pm

Criterion	Covered	Total	%
statement	63	110	57.2
branch	24	56	42.8
condition	4	9	44.4
subroutine	8	9	88.8
pod	1	1	100.0
total	100	185	54.0

# $Id$

package Unix::SetUser;

use warnings;
use strict;
use Carp;
use Unix::SavedIDs 0.004002;
use Data::Dumper;

#warn "\@INC = ".join(" ",@INC)."\n";
#warn "\%INC = ".Dumper(\%INC)."\n";

our $verbose = 0;

my $warncount = 0;

BEGIN {
	use Exporter ();
	our ($VERSION,@ISA,@EXPORT);
	@ISA    = qw(Exporter);
	@EXPORT = qw(set_user);
	$VERSION = 0.004003;
}

sub set_user {
	## Figure Out IDs to Set
	my($user,$group,@sup_groups) = @_;
	my($uid,$gid,%sup_gids);
	my $is_int = qr/^(\d+)$/o;
	if ( !defined($user) ) {
		croak "set_user() called with no arguments";
	}
	# get uids
	if ( $user =~ $is_int ) {
		$uid = $1;
	}
	else {
		# get numeric uid if given non-numeric user name
		$uid = getpwnam($user);
		if ( !defined($uid) ) {
			croak "User '$user' does not exist";
		}
		if ( $uid !~ $is_int ) {
			croak "User id for '$user' is not an int.  "
				."This shouldn't ever happen";
		}
		$uid = $1;
	}
	# get primary gid
	if ( defined($group) && $group =~ $is_int ) {
		$gid = $1;
		if ( !getgrgid($gid) ) {
			croak "Primary group id '$gid' does not exist\n";
		}
	}
	else {
		# use user's primary group if no primary group specified
		if ( !defined($group) ) {
			$gid = (getpwuid($uid))[3];
			if ( !defined($gid)) {
				croak "Failed to get primary group ID for uid '$uid'";
			}
		}
		else {
			# get gid from group name
			$gid = getgrnam($group);
			if ( !defined($gid) ) {
				croak "Primary group '$group' does not exist";
			}

		}
		if ( $gid !~ $is_int ) {
			croak "Primary group ID for '$user' is not an int.  "
				."This shouldn't ever happen";
		}
	}
	# get supplemental groups
	my @dont_exist;
	foreach my $sup_group (@sup_groups) {
		my $sup_gid;
		if ( !defined($sup_group) ) {
			croak "Supplemental group list contains 'undef'";
		}
		# if ints, make sure they exist
		if ( $sup_group =~ $is_int ) {
			$sup_gid = $1;
			if ( $sup_gid == $gid || defined($sup_gids{$sup_gid})) {
				# remove duplicates
				next;
			}
			if ( !getgrgid($sup_gid) ) {
				push(@dont_exist,$sup_group);
				next;
			}
		}
		# if not ints, convert text usernames to ints which tests existance
		else {
			$sup_gid = getgrnam($sup_group);
			if ( !defined($sup_gid) ) {
				push(@dont_exist,$sup_group);
				next;
			}
			if ( $sup_gid !~ $is_int ) {
				croak "Supplemental group id for group '$sup_group' is "
					."not an int.  This shouldn't ever happen";
			}
			if ( $sup_gid == $gid || defined($sup_gids{$sup_gid}) ) {
				# duplicate
				next;
			}
		}
		$sup_gids{$sup_gid} = 1;
	}
	if ( @dont_exist ) {
		croak "Specified supplemental group(s) '".join("', '",@dont_exist)
			."' do(es) not exist(s)";
	}

	## Set Ids

	# set gid, egid and sgid
	setresgid($gid,$gid,$gid);
	# set egid & supplimental gids
	my $egid_string = $gid;
	if ( keys(%sup_gids) == 0 ) { #  $) lists primary group twice
		$egid_string .= ' '.$gid; #  if it's your only group
	}
	else {
		$egid_string .= ' '.join(' ',sort(keys(%sup_gids)));
	}
	$) = $egid_string;
	# set uid,euid & suid
	#_warn_ids();
	#warn "-- Setting uid,euid & suid setresuid($uid,$uid,$uid)\n";
	setresuid($uid,$uid,$uid);
	#_warn_ids();

	## Make sure everything worked
	my @errs = ();
	# make sure uid change worked
	if ( $< != $uid ) {
		push(@errs,"Failed to set uid: uid = '$<', not '$uid'");
	}
	# make sure set euid worked
	if ( $> != $uid ) {
		push(@errs,"Failed to set euid: euid = '$>', not '$uid'");
	}
	# make sure saved uid got set correctly
	my $suid = (getresuid())[2];
	if ( $suid != $uid ) {
		push(@errs,'Failed to set saved uid: saved uid = '.$suid
			.' not '.$uid);
	}
	#warn "about to check rgid\n";
	#_warn_ids();
	# make sure rgid is correct
	if ( $( !~ /^(\d+)/o ) {
		croak "GID is not an int!??!";
	}
	my $now_gid = $1;
	if ( $now_gid != $gid ) {
		croak "Failed to set gid: gid is '$now_gid' not '$gid'\n";
	}
	# make sure set egid & supplimental gids worked
	if ( $) ne $egid_string ) {
		# Order doesn't matter, so split, sort and rejoin to test.
		my $now = join(' ',sort(split(' ',$))));
		my $want = join(' ',sort(split(' ',$egid_string)));
		if ( $now ne $want ) {
			push(@errs,"Failed to set egid: egid = '$)', not '$egid_string'");
		}
	}
	# make sure sgid got set correctly
	my $sgid = (getresgid())[2];
	if ( $sgid != $gid ) {
		push(@errs,'Failed to set saved gid: saved gid = '.$sgid
			.' not '.$gid);
	}
	if ( @errs ) {
		croak join("\n",@errs);
	}
	#_warn_ids();
	return undef;
}

sub _warn_ids {
	$warncount++;
	warn "count = $warncount\n";
	warn "\$< = '$<'\n";
	warn "\$> = '$>'\n";
	warn "\$( = '$('\n";
	warn "\$) = '$)'\n";
	warn "geresuid = ".join(',',getresuid())."\n";
	warn "geresgid = ".join(',',getresuid())."\n";
}

1; # Magic true value required at end of module
__END__