view release on metacpan or  search on metacpan

Auth/File.pm  view on Meta::CPAN

	# initialize parent class
	my $self = $class->SUPER::new($params);

	#
	# class specific parameters
	#
    
	# parameter 'UserFile': file containing user data
	$self->{userfile}  = $params->{UserFile} || 'auth_user.txt';
	# parameter 'GroupFile': file containing group data
	$self->{groupfile} = $params->{GroupFile} || 'auth_group.txt';
	# parameter 'PreLoadFiles': do we preload the user and group files into memory?
	$self->{preloadfiles} = $params->{PreLoadFiles} || 0;
    
	#
	# class members
	#

	# hash of registered users, each key is a user name, each value is an anon hash of user attributes
	$self->{users} = {};
	# hash of groups, each key is a group name, each value an anon array of user names
	$self->{groups} = {};

	# blessed are the greek
	bless($self, $class);

	# read authentication data
	if ($self->{preloadfiles}) {
		$self->_info("Preloading user and group files");
		$self->_readUserFile();
		$self->_readGroupFile();
	}

	return $self;
}

###########################################################
###
### backend specific methods
###
###########################################################

###########################################################

sub _login {
    
	##
	## check username and password
	##

	my $self = shift;
	my ($username, $password) = @_;

	$self->_debug("username: $username, password: $password");

	my $result = 0;

	# Get the user data
	my %user_data = $self->_getUserData($username);

	# See if the credentials are valid
	if (%user_data) {
		if (defined $user_data{password}) {
			# check against plaintext password
			$result = ($user_data{password} eq $password);
		} elsif (defined $user_data{crypt_password}) {
			# check against crypted password
			$result = (crypt($password, $user_data{crypt_password}) eq $user_data{crypt_password});
		}
	}
	if ($result) {
		$self->_info("user '$username' logged in");
		# save the user profile
		$self->{userid} = $user_data{username};
		$self->{profile} = \%user_data;
	}

	return $result;
}

###########################################################

sub _ipAuth {

	die "IP based authentication is not implemented in CGI::Session::Auth::File yet";
}

###########################################################

sub _loadProfile {
    
	##
	## get user profile userid
	##

	my $self = shift;
	my ($username) = @_;
	$self->{userid} = $username;
	$self->{profile} = {$self->_getUserData($username)};
}

###########################################################

sub isGroupMember {
    
	##
	## check if user is in given group
	##

	my $self = shift;
	my ($group) = @_;
	my @users = $self->_getGroupData($group);
	my $username = $self->{userid};

	return grep { $_ eq $username } @users;
}

###########################################################
###
### internal methods
###