view release on metacpan or  search on metacpan

lib/Apache/SiteControl.pm  view on Meta::CPAN

   $r->log_error("Session cookie: " . ($ses_key ? $ses_key:"UNSET")) if $debug;
   $r->log_error("Loading module $factory") if $debug;
   eval "require $factory" or $r->log_error("Could not load $factory: $@");
   $r->log_error("Using user factory $factory") if $debug;
   my $username = $r->connection->user();
   return undef if(!$username);

   $r->log_error("user name is $username") if $debug;
   my $user = undef;

   $factory = '$user' . " = $factory" . '->findUser($r, $ses_key)';
   $r->log_error("Evaluating: $factory") if $debug;
   eval($factory) or $r->log_error("Eval failed: $@");

   $r->log_error("Got user object: $user") if $debug && defined($user);
   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