package Apache2::SiteControl; use 5.008; use strict; use warnings; use Carp; use Apache2::AuthCookie; use Apache::Session::File; our $VERSION = "1.05"; use base qw(Apache2::AuthCookie); our %managers = (); sub getCurrentUser { my $this = shift; my $r = shift; my $debug = $r->dir_config("SiteControlDebug") || 0; my $factory = $r->dir_config("SiteControlUserFactory") || "Apache2::SiteControl::UserFactory"; my $auth_type = $r->auth_type; my $auth_name = $r->auth_name; my ($ses_key) = ($r->headers_in->{"Cookie"} || "") =~ /$auth_type\_$auth_name=([^;]+)/; $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->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") || "Apache2::SiteControl::Radius"; my $factory = $r->dir_config("SiteControlUserFactory") || "Apache2::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") || "Apache2::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 Apache2::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 Apache2::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. A good mason component tries to do most of the perl processing in a separate block, so that simple substitutions can be made in HTML in the rest of the page. This makes it much easier for web developers and perl developers to co-exist on a project. The SiteControl system tries to make it possible to continue to follow this model. You obtain a user object and permission manager from the SiteControl system. These are intended to be opaque data types to the page designer, and are defined elsewhere (see USERS). The actual web page component should carry these objects around without implementing anything in the way of policy. For example, your mason component might look like this:
... % if($manager->can($currentUser, "edit", $table)) { % } else {x is <% $table->{x} %>
% }
<%init>
my $currentUser = Apache2::SiteControl->getCurrentUser($r);
my $manager = Apache2::SiteControl->getPermissionManager($r);
... application specific stuff...
i.e.
my $table = ...
%init>
Notice that the component does not bother looking at the user object, and there
is no policy code...just a request for permission:
if($manager->can($currentUser, "do something to", $resource))
Of course the developer needs to know I