Apache-SiteControl
view release on metacpan or search on metacpan
lib/Apache/SiteControl.pm view on Meta::CPAN
return defined($user) ? $user : 0;
}
sub getPermissionManager
{
my $this = shift;
my $r = shift;
my $debug = $r->dir_config("SiteControlDebug") || 0;
my $name = $r->dir_config("AuthName") || "default";
$r->log_error("AuthName is not set! Using 'default'.") if $name eq "default";
return $managers{$name} if(defined($managers{$name}) && $managers{$name});
$r->log_error("Building manager") if $debug;
my $factory = $r->dir_config("SiteControlManagerFactory");
$r->log_error("Manager Factory not set!") if !defined($factory);
return undef if !defined($factory);
$r->log_error("Loading module $factory") if $debug;
eval "require $factory" or $r->log_error("Could not load $factory: $@");
$factory = '$managers{$name}' . " = $factory" . '->getPermissionManager()';
$r->log_error("Building a manager using: $factory") if $debug;
eval($factory) or $r->log_error("Evaluation failed: $@");
return $managers{$name};
}
# This is the method that receives the login form data and decides if the
# user is allowed to log in.
sub authen_cred
{
my $this = shift; # Package name (same as AuthName directive)
my $r = shift; # Apache request object
my @cred = @_; # Credentials from login form
my $debug = $r->dir_config("SiteControlDebug") || 0;
my $checker = $r->dir_config("SiteControlMethod") || "Apache::SiteControl::Radius";
my $factory = $r->dir_config("SiteControlUserFactory") || "Apache::SiteControl::UserFactory";
my $user = undef;
my $ok;
# Load the user authentication module
eval "require $checker" or $r->log_error("Could not load $checker: $@");
eval "require $factory" or $r->log_error("Could not load $factory: $@");
eval '$ok = ' . ${checker} . '::check_credentials($r, @cred)' or $r->log_error("authentication error code: $@");
if($ok) {
eval('$user = ' . "$factory" . '->makeUser($r, @cred)');
if($@) {
$r->log_error("Error reported during call to ${factory}->makeUser: $@");
}
}
return $user->{sessionid} if defined($user);
return undef;
}
# This sub is called for every request that is under the control of
# SiteControl. It is responsible for verifying that the user id (session
# key) is valid and that the user is ok.
# It returns a user name if all is well, and undef if not.
sub authen_ses_key
{
my ($this, $r, $session_key) = @_;
my $debug = $r->dir_config("SiteControlDebug") || 0;
my $factory = $r->dir_config("SiteControlUserFactory") || "Apache::SiteControl::UserFactory";
my $user = undef;
eval "require $factory" or $r->log_error("Could not load $factory: $@");
$r->log_error("Attempting auth using session key $session_key") if $debug;
eval {
eval('$user = ' . "$factory" . '->findUser($r, $session_key)');
if($@) {
$r->log_error("Error reported during call to ${factory}->findUser: $@");
}
};
if($@) {
$r->log_error("User tried access with invalid/nonexistent session: $@");
return undef;
}
return $user->getUsername if defined($user);
return undef;
}
1;
__END__
=head1 NAME
Apache::SiteControl - Perl web site authentication/authorization system
=head1 SYNOPSIS
See samples/site for complete example. Note, this module is intended for
mod_perl. See Apache2::SiteControl for mod_perl2.
=head1 DESCRIPTION
Apache::SiteControl is a set of perl object-oriented classes that
implement a fine-grained security control system for a web-based application.
The intent is to provide a clear, easy-to-integrate system that does not
require the policies to be written into your application components. It
attempts to separate the concerns of how to show and manipulate data from the
concerns of who is allowed to view and manipulate data and why.
For example, say your web application is written in HTML::Mason. Your
individual "screens" are composed of Mason modules, and you would like to keep
those as clean as possible, but decisions have to be made about what to allow
as the component is processed. SiteControl attempts to make that as easy as
possible.
=head2 DEVELOPER'S VIEWPOINT - EXAMPLE
In this document we use HTML::Mason to create examples of how to use the
control mechanisms, but any mod_perl based system should be supportable.
( run in 0.553 second using v1.01-cache-2.11-cpan-13bb782fe5a )