Apache-AppSamurai
view release on metacpan or search on metacpan
lib/Apache/AppSamurai.pm view on Meta::CPAN
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
##
# AppSamurai is a set of scripts and a module that tie into Apache via
# mod_perl to provide an authenticating reverse proxy front end for
# web applications. It allows the use of outside authentication not
# supported by the backend app, and also adds session tracking.
package Apache::AppSamurai;
use strict;
use warnings;
# Keep VERSION (set manually) and REVISION (set by CVS)
use vars qw($VERSION $REVISION $MP);
$VERSION = '1.01';
$REVISION = substr(q$Revision: 1.66 $, 10, -1);
use Carp;
# mod_perl Includes
BEGIN {
if (eval{require mod_perl2;}) {
mod_perl2->import(qw(1.9922 StackedHandlers MethodHandlers Authen
Authz));
require Apache2::Connection;
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::Log;
require Apache2::Access;
require Apache2::Response;
require Apache2::Util;
require Apache2::URI;
require APR::Table;
require APR::Pool;
require Apache2::Const;
Apache2::Const->import(qw(OK DECLINED REDIRECT HTTP_FORBIDDEN
HTTP_INTERNAL_SERVER_ERROR
HTTP_MOVED_TEMPORARILY HTTP_UNAUTHORIZED
M_GET));
require Apache2::Request;
$MP = 2;
} else {
require mod_perl;
mod_perl->import(qw(1.07 StackedHandlers MethodHandlers Authen Authz));
require Apache;
require Apache::Log;
require Apache::Util;
require Apache::Constants;
Apache::Constants->import(qw(OK DECLINED REDIRECT HTTP_FORBIDDEN
HTTP_INTERNAL_SERVER_ERROR
HTTP_MOVED_TEMPORARILY HTTP_UNAUTHORIZED
M_GET));
require Apache::Request;
$MP = 1;
}
}
# Non-mod_perl includes
use CGI::Cookie;
use URI;
use Time::HiRes qw(usleep);
use Apache::AppSamurai::Util qw(CreateSessionAuthKey CheckSidFormat
HashPass HashAny ComputeSessionId
CheckUrlFormat CheckHostName
CheckHostIP XHalf);
# Apache::AppSamurai::Session is a replacement for Apache::Session::Flex
# It provides normal Apache::Session::Flex features, plus optional extras
# like alternate session key generators/sizes and record level encryption
use Apache::AppSamurai::Session;
# Apache::AppSamurai::Tracker is a special instance of Session meant to
# be shared between all processes serving an auth_name
use Apache::AppSamurai::Tracker;
### START Apache::AuthSession based methods
# The following lower case methods are directly based on Apache::AuthCookie, or
# are required AuthCookie methods (like authen_cred() and authen_ses_key())
# Note - ($$) syntax, used in mod_perl 1 to induce calling the handler as
# an object, has been eliminated in mod_perl 2. Each handler method called
# directly from Apache must be wrapped to support mod_perl 1 and mod_perl 2
# calls. (Just explaining the mess before you have to read it.)
# Identify the username for the session and set for the request
sub recognize_user_mp1 ($$) { &recognize_user_real }
sub recognize_user_mp2 : method { &recognize_user_real }
*recognize_user = ($MP eq 1) ? \&recognize_user_mp1 : \&recognize_user_mp2;
sub recognize_user_real {
my ($self, $r) = @_;
my ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);
return DECLINED unless $auth_type and $auth_name;
my $cookie_name = $self->cookie_name($r);
my ($cookie) = $r->headers_in->{'Cookie'} =~ /$cookie_name=([^;]+)/;
if (!$cookie && $r->dir_config("${auth_name}Keysource")) {
# Try to get key text using alternate method then compute the key.
# FetchKeysource returns '' if no custom source is configured, in
# which case the cookie should have been previously set, so non-zero
# output is required.
$cookie = $self->FetchKeysource($r);
if ($cookie) {
$cookie = CreateSessionAuthKey($cookie);
}
}
return DECLINED unless $cookie;
$self->Log($r, ('debug', "recognize_user(): cookie $cookie_name is " . XHalf($cookie)));
my ($user,@args) = $auth_type->authen_ses_key($r, $cookie);
if ($user and scalar @args == 0) {
$self->Log($r, ('debug', "recognize_user(): user is $user"));
($MP eq 1) ? ($r->connection->user($user)) : ($r->user($user));
} elsif (scalar @args > 0 and $auth_type->can('custom_errors')) {
return $auth_type->custom_errors($r, $user, @args);
} else {
# Shrug
$self->Log($r, ('warn', "recognize_user(): Unexpected result"));
return DECLINED;
}
return OK;
}
# Get the cookie name for this protected area
sub cookie_name {
my ($self, $r) = @_;
my $auth_type = $r->auth_type;
my $auth_name = $r->auth_name;
my $cookie_name = $r->dir_config("${auth_name}CookieName") ||
"${auth_type}_${auth_name}";
return $cookie_name;
}
# Set request cache options (no-cache unless specifically told to cache)
sub handle_cache {
my ($self, $r) = @_;
my $auth_name = $r->auth_name;
return unless $auth_name;
unless ($r->dir_config("${auth_name}Cache")) {
$r->no_cache(1);
if (!$r->headers_out->{'Pragma'}) {
$r->err_headers_out->{'Pragma'} = 'no-cache';
}
}
}
# Backdate cookie to attempt to clear from web browser cookie store
sub remove_cookie {
my ($self, $r) = @_;
my $cookie_name = $self->cookie_name($r);
my $str = $self->cookie_string( request => $r,
key => $cookie_name,
value => '',
expires => 'Mon, 21-May-1971 00:00:00 GMT' );
$r->err_headers_out->add("Set-Cookie" => "$str");
$self->Log($r, ('debug', "remove_cookie(): removed_cookie \"$cookie_name\""));
}
# Convert current POST request to GET
# Note - The use of this is questionable now that Apache::Request is being
# used. May go away in the future.
sub _convert_to_get {
my ($self, $r) = @_;
return unless $r->method eq 'POST';
$self->Log($r, ('debug', "Converting POST -> GET"));
# Use Apache::Request for immediate access to all arguments.
my $ar = ($MP eq 1) ?
Apache::Request->instance($r) :
Apache2::Request->new($r);
# Pull list if GET and POST args
my @params = $ar->param;
my ($name, @values, $value);
my @pairs = ();
foreach $name (@params) {
# we don't want to copy login data, only extra data.
$name =~ /^(destination|credential_\d+)$/ and next;
# Pull list of values for this key
@values = $ar->param($name);
# Make sure there is at least one value, which can be empty
(scalar(@values)) or ($values[0] = '');
foreach $value (@values) {
if ($MP eq 1) {
push(@pairs, Apache::Util::escape_uri($name) . '=' .
Apache::Util::escape_uri($value));
} else {
# Assume mod_perl 2 behaviour
push(@pairs, Apache2::Util::escape_path($name, $r->pool) .
'=' . Apache2::Util::escape_path($value, $r->pool));
}
}
}
$r->args(join '&', @pairs) if scalar(@pairs) > 0;
$r->method('GET');
$r->method_number(M_GET);
$r->headers_in->unset('Content-Length');
}
# Handle regular (form based) login
sub login_mp1 ($$) { &login_real }
sub login_mp2 : method { &login_real }
*login = ($MP eq 1) ? \&login_mp1 : \&login_mp2;
sub login_real {
my ($self, $r) = @_;
my ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);
# Use the magic of Apache::Request to ditch POST handling code
# and cut to the args.
my $ar = ($MP eq 1) ?
Apache::Request->instance($r) :
Apache2::Request->new($r);
my ($ses_key, $tc, $destination, $nonce, $sig, $serverkey);
my @credentials = ();
# Get the hard set destination, or setup to just reload
if ($r->dir_config("${auth_name}LoginDestination")) {
$destination = $r->dir_config("${auth_name}LoginDestination");
} elsif ($ar->param("destination")) {
$destination = $ar->param("destination");
} else {
# Someday something slick could hold the URL, then cut through
# to it. Someday. Today we die.
$self->Log($r, ('warn', "No key 'destination' found in form data"));
$r->subprocess_env('AuthCookieReason', 'no_cookie');
return $auth_type->login_form($r);
}
# Check form nonce and signature
if (defined($ar->param("nonce")) and defined($ar->param("sig"))) {
unless (($nonce = CheckSidFormat($ar->param("nonce"))) and
($sig = CheckSidFormat($ar->param("sig")))) {
$self->Log($r, ('warn', "Missing/invalid form nonce or sig"));
$r->subprocess_env('AuthCookieReason', 'no_cookie');
$r->err_headers_out->{'Location'} = $self->URLErrorCode($destination, 'bad_credentials');
$r->status(REDIRECT);
return REDIRECT;
}
$serverkey = $self->GetServerKey($r) or die("FATAL: Could not fetch valid server key\n");
# Now check!
unless ($sig eq ComputeSessionId($nonce, $serverkey)) {
# Failed!
$self->Log($r, ('warn', "Bad signature on posted form (Possible scripted attack)"));
$r->subprocess_env('AuthCookieReason', 'no_cookie');
$r->err_headers_out->{'Location'} = $self->URLErrorCode($destination, 'bad_credentials');
$r->status(REDIRECT);
return REDIRECT;
}
} else {
# Failed!
$self->Log($r, ('warn', "Missing NONCE and/or SIG in posted form (Possible scripted attack)"));
$r->subprocess_env('AuthCookieReason', 'no_cookie');
$r->err_headers_out->{'Location'} = $self->URLErrorCode($destination, 'bad_credentials');
$r->status(REDIRECT);
return REDIRECT;
}
# Get the credentials from the data posted by the client
while ($tc = $ar->param("credential_" . scalar(@credentials))) {
push(@credentials, $tc);
($tc) ? ($tc =~ s/^(.).*$/$1/s) : ($tc = ''); # Only pull first char
# for logging
$self->Log($r, ('debug', "login(); Received credential_" . (scalar(@credentials) - 1) . ": $tc (hint)"));
}
# Convert all args into a GET and clear the credential_X args
$self->_convert_to_get($r) if $r->method eq 'POST';
# Check against credential cache if UniqueCredentials is set
if ($r->dir_config("${auth_name}AuthUnique")) {
unless ($self->CheckTracker($r, 'AuthUnique', @credentials)) {
# Tried to send the same credentials twice (or tracker system
# failure. Delete the credentials to fall through
@credentials = ();
$self->Log($r, ('warn', "login(): AuthUnique check failed: Tracker failure, or same credentials have been sent before"));
}
}
if (@credentials) {
# Exchange the credentials for a session key.
$ses_key = $self->authen_cred($r, @credentials);
if ($ses_key) {
# Set session cookie with expiration included if SessionExpire
# is set. (Extended +8 hours so we see logout events and cleanup)
if ($r->dir_config("${auth_name}SessionExpire")) {
$self->send_cookie($r, $ses_key, {expires => $r->dir_config("${auth_name}SessionExpire") + 28800});
} else {
$self->send_cookie($r, $ses_key);
}
$self->handle_cache($r);
# Log 1/2 of session key to debug
$self->Log($r, ('debug', "login(): session key (browser cookie value): " . XHalf($ses_key)));
# Godspeed You Black Emperor!
$r->headers_out->{"Location"} = $destination;
return HTTP_MOVED_TEMPORARILY;
}
}
# Add their IP to the failure tracker
# Ignores return (refusing a login page to an attacker doesn't stop them
# from blindly reposting... can add a fail here if an embedded form
# verification key is added to the mix in the future)
if ($r->dir_config("${auth_name}IPFailures")) {
if ($MP eq 1) {
$self->CheckTracker($r, 'IPFailures', $r->dir_config("${auth_name}IPFailures"), $r->get_remote_host);
} else {
$self->CheckTracker($r, 'IPFailures', $r->dir_config("${auth_name}IPFailures"), $r->connection->get_remote_host);
}
}
# Append special error message code and try to redirect to the entry
# point. (Avoids having the LOGIN URL show up in the browser window)
$r->err_headers_out->{'Location'} = $self->URLErrorCode($destination, 'bad_credentials');
$r->status(REDIRECT);
return REDIRECT;
# Handle this ol' style - XXX remove?
#$r->subprocess_env('AuthCookieReason', 'bad_credentials');
#$r->uri($destination);
#return $auth_type->login_form($r);
}
# Special version of login that handles Basic Auth login instead of form
# Can be called by authenticate() if there is no valid session but a
# Authorization: Basic header is detected. Can also be called directly,
# just like login() for targeted triggering
sub loginBasic_mp1 ($$) { &loginBasic_real }
sub loginBasic_mp2 : method { &loginBasic_real }
*loginBasic = ($MP eq 1) ? \&loginBasic_mp1 : \&loginBasic_mp2;
sub loginBasic_real {
my ($self, $r) = @_;
my ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);
my ($ses_key, $t, @at, $tc);
my @credentials = ();
return DECLINED unless $r->is_initial_req; # Authenticate first req only
# Count input credentials to figure how to split input
my @authmethods = $self->GetAuthMethods($r);
(@authmethods) || (die("loginBasic(): Missing authentication methods\n"));
my $amc = scalar(@authmethods);
# Extract basic auth info and fill out @credentials array
my ($stat, $pass) = $r->get_basic_auth_pw;
if ($r->user && $pass) {
# Strip "domain\" portion of user if present.
# (Thanks Windows Mobile ActiveSync for forcing domain\username syntax)
$t = $r->user;
$t =~ s/^.*\\+//;
$r->user($t);
push(@credentials, $t);
# Use custom map pattern if set; else just a generic split on semicolon
if (defined($r->dir_config("${auth_name}BasicAuthMap"))) {
push(@credentials, $self->ApplyAuthMap($r,$pass,$amc));
} else {
# Boring old in-order split
foreach (split(';', $pass, $amc)) {
push(@credentials, $_);
}
}
# Log partial first char of each credential
if ($r->dir_config("${auth_name}Debug")) {
for (my $i = 0; $i < scalar(@credentials); $i++) {
$credentials[$i] =~ /^(.)/;
$self->Log($r, ('debug', "loginBasic(): Received credential_$i: $1 (hint)"));
}
}
# Check against credential cache if AuthUnique is set
if ($r->dir_config("${auth_name}AuthUnique")) {
unless ($self->CheckTracker($r, 'AuthUnique', @credentials)) {
# Tried to send the same credentials twice (or tracker system
# failure. Delete the credentials to fall through
@credentials = ();
lib/Apache/AppSamurai.pm view on Meta::CPAN
$ses_key = $self->authen_cred($r, @credentials);
if ($ses_key) {
# Set session cookie with expiration included if SessionExpire
# is set. (Extended +8 hours for logouts/cleanup)
if ($r->dir_config("${auth_name}SessionExpire")) {
$self->send_cookie($r, $ses_key, {expires => $r->dir_config("${auth_name}SessionExpire") + 28800});
} else {
$self->send_cookie($r, $ses_key);
}
$self->handle_cache($r);
# Log 1/2 of session key to debug
$self->Log($r, ('debug', "loginBasic(): session key (browser cookie value): " . XHalf($ses_key)));
# Godspeed You Black Emperor!
$t = $r->uri;
($r->args) && ($t .= '?' . $r->args);
$self->Log($r, ('debug', "loginBasic(): REDIRECTING TO: $t"));
$r->err_headers_out->{'Location'} = $t;
return REDIRECT;
}
}
}
# Unset the username if set
$r->user() and $r->user(undef);
# Add their IP to the failure tracker and just return HTTP_FORBIDDEN
# if they exceed the limit
if ($r->dir_config("${auth_name}IPFailures")) {
if ($MP eq 1) {
unless ($self->CheckTracker($r, 'IPFailures', $r->dir_config("${auth_name}IPFailures"), $r->get_remote_host)) {
$self->Log($r, ('warn', "loginBasic(): Returning HTTP_FORBIDDEN to IPFailires banned IP"));
return HTTP_FORBIDDEN;
}
} else {
unless ($self->CheckTracker($r, 'IPFailures', $r->dir_config("${auth_name}IPFailures"), $r->connection->get_remote_host)) {
$self->Log($r, ('warn', "loginBasic(): Returning HTTP_FORBIDDEN to IPFailires banned IP"));
return HTTP_FORBIDDEN;
}
}
}
# Set the basic auth header and send back to the client
$r->note_basic_auth_failure;
return HTTP_UNAUTHORIZED;
}
# Logout, kill session, kill, kill, kill
sub logout_mp1 ($$) { &logout_real }
sub logout_mp2 : method { &logout_real }
*logout = ($MP eq 1) ? \&logout_mp1 : \&logout_mp2;
sub logout_real {
my $self = shift;
my $r = shift;
my $auth_name = $r->auth_name;
my $redirect = shift || "";
my ($sid, %sess, $sessconfig, $username, $alterlist);
# Get the Cookie header. If there is a session key for this realm, strip
# off everything but the value of the cookie.
my $cookie_name = $self->cookie_name($r);
my ($key) = $r->headers_in->{'Cookie'} =~ /$cookie_name=([^;]+)/;
# Try custom keysource if no cookie is present and Keysource is configured
if (!$key && $auth_name && $r->dir_config("${auth_name}Keysource")) {
# Pull in key text
$key = $self->FetchKeysource($r);
# Non-empty, so use to generate the real session auth key
if ($key) {
$key = CreateSessionAuthKey($key);
}
}
# If set, check key format, else check for custom keysource
if ($key) {
($key = CheckSidFormat($key)) || (($self->Log($r, 'error', 'logout(): Invalid Session Key Format')) && (return undef));
}
# Get session config from Apache
($sessconfig = $self->GetSessionConfig($r)) || (die("logout: Unable to get session configuration while checking authentication\n"));
if ($key) {
# Enter the authentication key into the session config (NEVER STORE IT
# IN THE ACTUAL SESSION DATA!)
$sessconfig->{key} = $key;
# Compute real session ID
($sessconfig->{ServerKey}) ||
(($self->Log($r, ('error', 'logout(): ${auth_name}SessionServerPass or ${auth_name}SessionServerKey not set (required for HMAC sessions)'))) &&
(return undef));
($sid = ComputeSessionId($key, $sessconfig->{ServerKey})) || (($self->Log($r, ('error', 'logout(): Error computing session ID'))) && (return undef));
} else {
$sid = '';
}
# Try to delete the session. Note that session handling errors do not
# return but fall through to return OK or REDIRECT depending
# on how we were called.
if ($sid) {
# Check the SID
if ($sid = CheckSidFormat($sid)) {
# Open the session (this should die on a non-existant session)!!!
eval { tie(%sess, 'Apache::AppSamurai::Session', $sid, $sessconfig); };
if ($@) {
$self->Log($r, ('debug', "logout(): Unable to open session \"$sid\": $@"));
} else {
$username = $sess{'username'};
# Load alterlist
$alterlist = $self->AlterlistLoad(\%sess);
# Re-apply passback cookies to which were cleared and backdated
# after session creation. (This clears the passback cookies)
if (defined($alterlist->{cookie})) {
$self->AlterlistPassBackCookie($alterlist, $r);
}
$self->DestroySession($r, \%sess);
untie(%sess);
$self->Log($r, ('notice', "LOGOUT: username=\"$username\", session=\"$sid\", reason=logout"));
}
} else {
$self->Log($r, ('error', 'logout(): Invalid Session ID Format'));
}
} else {
# No cookie set
$self->Log($r, ('error', 'logout(): Missing session ID'));
}
# Clear cookie and set no-cache for client
$self->remove_cookie($r);
$self->handle_cache($r);
# Check for hard-coded redirect for logout, or failing that, our
# landing page
if ($r->dir_config("${auth_name}LogoutDestination")) {
$redirect = $r->dir_config("${auth_name}LogoutDestination");
} elsif ($r->dir_config("${auth_name}LoginDestination")) {
$redirect = $r->dir_config("${auth_name}LoginDestination");
}
if ($redirect ne '') {
$r->err_headers_out->{'Location'} = $redirect;
$r->status(REDIRECT);
return REDIRECT;
} else {
# Strip path and reload - THIS ONLY WORKS IF / IS REDIRECTED TO THE
# LANDING PAGE
$r->err_headers_out->{'Location'} = '/';
$r->status(REDIRECT);
return REDIRECT;
}
# Returning the login form without redirecting on logout is probably not
# right for any circumstance. (Leaving this here for reference.)
# else {
# return $self->login_form($r);
# }
}
# Check for unauthenticated session and force login if not authenticated
sub authenticate_mp1 ($$) { &authenticate_real }
sub authenticate_mp2 : method { &authenticate_real }
*authenticate = ($MP eq 1) ? \&authenticate_mp1 : \&authenticate_mp2;
sub authenticate_real {
my ($self, $r) = @_;
my $auth_user;
my ($t, $foundcookie);
unless ($r->is_initial_req) {
if (defined $r->prev) {
# we are in a sub-request. Just copy user from previous request.
($MP eq 1) ? ($r->connection->user($r->prev->connection->user)) :
($r->user($r->prev->user));
}
return OK;
}
# Type must either be our own, or Basic
unless (($r->auth_type eq $self) || ($r->auth_type =~ /^basic$/i)) {
# Location requires authentication but we don't handle this AuthType.
$self->Log($r, ('debug', "authenticate(): AuthType mismatch: $self =/= ".$r->auth_type));
return DECLINED;
}
# AuthType is $auth_type which we handle, Check the authentication realm
my $auth_name = $r->auth_name;
$self->Log($r, ('debug', "authenticate(): auth_name " . $auth_name));
unless ($auth_name) {
$r->log_reason("AuthName not set, AuthType=$self", $r->uri);
return HTTP_INTERNAL_SERVER_ERROR;
}
# Get the Cookie header. If there is a session key for this realm, strip
# off everything but the value of the cookie.
my $cookie_name = $self->cookie_name($r);
my ($ses_key_cookie) = ($r->headers_in->{"Cookie"} || "") =~ /$cookie_name=([^;]+)/;
$foundcookie = 0;
if ($ses_key_cookie) {
# If cookie found and not "", set $foundcookie to note auth key source
$foundcookie = 1;
} elsif ($r->dir_config("${auth_name}Keysource")) {
# Try custom keysource if no cookie is present and Keysource is configured
# Pull in key text
$ses_key_cookie = $self->FetchKeysource($r);
if ($ses_key_cookie) {
# Non-empty, so use to generate the real session auth key
$ses_key_cookie = CreateSessionAuthKey($ses_key_cookie);
} else {
$ses_key_cookie = "";
}
} else {
$ses_key_cookie = "";
}
# Report half of session key
$self->Log($r, ('debug', "authenticate(): Current ses_key_cookie: \"" . XHalf($ses_key_cookie) . "\""));
if ($ses_key_cookie) {
my ($auth_user, @args) = $self->authen_ses_key($r, $ses_key_cookie);
if ($auth_user and scalar @args == 0) {
# We have a valid session key, so we return with an OK value.
# Tell the rest of Apache what the authentication method and
# user is.
if ($MP eq 1) {
$r->connection->auth_type($self);
$r->connection->user($auth_user);
} else {
# Assume MP2 behaviour
$r->ap_auth_type($self);
$r->user($auth_user);
}
$self->Log($r, ('debug', "authenticate(): user authenticated as $auth_user"));
return OK;
} elsif (scalar @args > 0 and $self->can('custom_errors')) {
return $self->custom_errors($r, $auth_user, @args);
} else {
# There was a session key set, but it's invalid.
if ($foundcookie) {
# Remove cookie from the client now so it does not come back.
$self->remove_cookie($r);
}
$self->handle_cache($r);
$r->subprocess_env('AppSamuraiReason', 'bad_cookie');
# Add to our the session tracker (so we can short cut if resent)
# Ignores return (we are already on the way out...)
if ($r->dir_config("${auth_name}SessionUnique")) {
$self->CheckTracker($r, 'SessionUnique', $ses_key_cookie);
}
}
} else {
lib/Apache/AppSamurai.pm view on Meta::CPAN
my $satisfy_all = $satisfy eq 'all';
my ($forbidden);
foreach my $req (@$reqs_arr) {
my ($requirement, $args) = split /\s+/, $req->{requirement}, 2;
$args = '' unless defined $args;
$self->Log($r, ('debug', "authorize(): requirement := $requirement, $args"));
if ( lc($requirement) eq 'valid-user' ) {
if ($satisfy_all) {
next;
} else {
return OK;
}
}
if($requirement eq 'user') {
if ($args =~ m/\b$user\b/) {
next if $satisfy_all;
return OK; # satisfy any
}
$forbidden = 1;
next;
}
# Call a custom method
my $ret_val = $self->$requirement($r, $args);
$self->Log($r, ('debug', "authorize(): $self->$requirement returned $ret_val"));
if ($ret_val == OK) {
next if $satisfy_all;
return OK; # satisfy any
}
# Nothing succeeded, deny access to this user.
$forbidden = 1;
}
return $forbidden ? HTTP_FORBIDDEN : OK;
}
# Have a session cookie Mr. Browser
sub send_cookie {
my ($self, $r, $ses_key, $cookie_args) = @_;
$cookie_args = {} unless defined $cookie_args;
my $cookie_name = $self->cookie_name($r);
my $cookie = $self->cookie_string( request => $r,
key => $cookie_name,
value => $ses_key,
%$cookie_args );
# add P3P header if user has configured it.
my $auth_name = $r->auth_name;
if (my $p3p = $r->dir_config("${auth_name}P3P")) {
$r->err_headers_out->{'P3P'} = $p3p;
}
$r->err_headers_out->add("Set-Cookie" => $cookie);
}
# Convert cookie store to header ready string
sub cookie_string {
my $self = shift;
# if passed 3 args, we have old-style call.
if (scalar(@_) == 3) {
carp "cookie_string(): deprecated old style call to ".__PACKAGE__."::cookie_string()";
my ($r, $key, $value) = @_;
return $self->cookie_string(request=>$r, key=>$key, value=>$value);
}
# otherwise assume named parameters.
my %p = @_;
for (qw/request key/) {
die("cookie_string(): missing required parameter $_\n") unless defined $p{$_};
}
# its okay if value is undef here.
my $r = $p{request};
$p{value} = '' unless defined $p{value};
my $string = sprintf '%s=%s', @p{'key','value'};
my $auth_name = $r->auth_name;
if (my $expires = $p{expires} || $r->dir_config("${auth_name}Expires")) {
$expires = Apache::AppSamurai::Util::expires($expires);
$string .= "; expires=$expires";
}
$string .= '; path=' . ( $self->get_cookie_path($r) || '/' );
if (my $domain = $r->dir_config("${auth_name}Domain")) {
$string .= "; domain=$domain";
}
if (!$r->dir_config("${auth_name}Secure") || ($r->dir_config("${auth_name}Secure") == 1)) {
$string .= '; secure';
}
# HttpOnly is an MS extension. See
# http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp
if ($r->dir_config("${auth_name}HttpOnly")) {
$string .= '; HttpOnly';
}
return $string;
}
# Retrieve session cookie value
sub key {
my ($self, $r) = @_;
my $auth_name = $r->auth_name;
my $key = "";
my $allcook = ($r->headers_in->{"Cookie"} || "");
my $cookie_name = $self->cookie_name($r);
($key) = $allcook =~ /(?:^|\s)$cookie_name=([^;]*)/;
# Try custom keysource if no cookie is present and Keysource is configured
if (!$key && $auth_name && $r->dir_config("${auth_name}Keysource")) {
# Pull in key text
$key = $self->FetchKeysource($r);
# Non-empty, so use to generate the real session auth key
if ($key) {
$key = CreateSessionAuthKey($key);
}
}
return $key;
}
# Retrieve session cookie path
sub get_cookie_path {
my ($self, $r) = @_;
my $auth_name = $r->auth_name;
return $r->dir_config("${auth_name}Path");
}
# Check authentication credentials and return a new session key
sub authen_cred {
my $self = shift;
my $r = shift;
my $username = shift;
my @creds = @_;
my $alterlist = {};
# Check for matching credentials and configured authentication methods
unless (@creds) {
$self->Log($r, ('error', "LOGIN FAILURE: Missing credentials"));
return undef;
}
my @authmethods = $self->GetAuthMethods($r);
unless (@authmethods) {
$self->Log($r, ('error', "LOGIN FAILURE: No authentication methods defined"));
return undef;
}
unless (scalar(@creds) == scalar(@authmethods)) {
$self->Log($r, ('error', "LOGIN FAILURE: Wrong number of credentials supplied"));
return undef;
}
my $authenticated = 0;
my ($ret, $errors);
# Require and get new instance of each authentication module
my $authenticators = $self->InitAuthenticators($r, @authmethods);
$self->Log($r, ('debug', "authen_cred(): About to cycle authenticators"));
for (my $i = 0; $i < scalar(@authmethods); $i++) {
$self->Log($r, ('debug', "authen_cred(): Checking $authmethods[$i]"));
lib/Apache/AppSamurai.pm view on Meta::CPAN
# Open the session (Eval will die on a non-existent session)
eval { tie(%sess, 'Apache::AppSamurai::Session', $sid, $sessconfig); };
if ($@) {
$self->Log($r, ('debug', "authen_ses_key(): Unable to open session \"$sid\": $@"));
return undef;
}
# Dump session contents to log (with some attempted cleanup for security)
if ($self->_debug($r)) {
my @tsl = ();
push(@tsl, "authen_ses_key(): Dump of session \"$sid\": ");
foreach $tk (sort keys %sess) {
$tv = $sess{$tk};
if ($tk eq 'al-header') {
# Sanitize headers (Leaving 8 chars of context for each)
$tv =~ s/^(\w+:authorization:.{1,8})(.*)$/$1 . "X" x length($2)/gmie;
} elsif ($tk eq 'al-cookie') {
# Sanitize cookies (Leaving 8 characters of context)
$tv =~ s/^(\w+:[^\:\=]+:.{1,8})([^;]*)(;.*)$/$1 . ("X" x length($2)) . $3/gmie;
} elsif ($tk =~ /auth/i) {
# Probably something we want hidden
$tv =~ s/^(.{1,8})(.*)$/$1 . "X" x length($2)/gmie;
}
push(@tsl, "$tk=>\"$tv\"");
}
$self->Log($r, ('debug', join(",", @tsl)));
}
# Pull header and cookie mod lists
$alterlist = $self->AlterlistLoad(\%sess);
# No reason... yet
$reason = '';
# Give me a reason... anything... any little excuse to kill your session...
$username = $sess{'username'};
if (!$username) {
# Session must have a username
$reason = 'no_username';
# Extra-bad!
$self->Log($r, ('error', "authen_ses_key(): No username for session \"$sid\""));
} elsif (!$self->CheckTime(\%sess)) {
# Expiration check failed
$reason = 'timeout';
} elsif (($sess{"Authorization"}) && ($r->headers_in->{"Authorization"}) && ($r->headers_in->{"Authorization"} ne $sess{"Authorization"})) {
# Client sent a Authorization header that does not match the one sent
# when logging in. This indicates one of two potential issues:
# 1) For areas configured to use basic auth, the auth has changed on
# the browser side, so kill the session.
# 2) For areas we front with a form, this indicates that the backend
# server sent a 401 to the client. We need to kill the session to
# get things in line again.
$reason = "basic_auth_change";
}
if ($reason) {
# Oh no! They gave us a reason... It's ON! (well, off)
# Remove passback and session cookies first
if (defined($alterlist->{cookie})) {
$self->AlterlistPassBackCookie($alterlist, $r);
}
$self->remove_cookie($r);
$self->handle_cache($r);
# Wake up. Time to die.
$self->DestroySession($r, \%sess);
untie(%sess);
$self->Log($r, ('notice', "LOGOUT: username=\"$username\", session=\"$sid\", reason=$reason"));
# If serving basic auth, return undef instead of triggering login form
if ($r->auth_type =~ /^basic$/i) {
return undef;
} else {
# Use Apache::AuthCookie based custom_errors feature, which will
# call back into our custom_errors() method. (expired_cookie
# applies as an acceptable error for all of these cases.)
return('login', 'expired_cookie');
}
}
# Apply header and cookie alterations to request headed for backend server
$self->AlterlistApply($alterlist, $r);
$self->Log($r, ('debug', "authen_ses_key(): Loaded and applied alterlist groups " . join(",", keys %{$alterlist})));
# Release session file
untie(%sess);
return $username;
}
# custom_errors are a nice way to get flexible actions based on certain events
# without having to rewrite authentication() and other methods. Takes
# the request, a "code", and a message. The original intent of this was to
# allow for custom server return messages, but I muck it up to do things like
# redirecting on certain errors, too.
sub custom_errors {
my ($self, $r, $code, $message) = @_;
my $t;
# Handle request based on the format of the $code argument
if ($code =~ /^login$/) {
# Append the passed error code using ASERRCODE and bring up the login
# form. (Adds error code query to the current URI, which the login
# form will pull back in)
$t = $r->uri;
($r->args) && ($t .= "?" . $r->args);
$r->uri($self->URLErrorCode($t, 'message'));
return $self->login_form($r);
} elsif ($code =~ /^([A-Z0-9_]+)$/) {
# Codes in all caps with an underscore are assumed to be Apache
# response codes
($message) && ($r->custom_response($code, $message));
return $code;
} else {
# What was that? Die out.
die "custom_errors(): Invalid code passed to custom_errors: \"$code\"";
}
}
## END Apache::AuthCookie based methods
# Everything past this point is not an overridden/modified Apache::AuthCookie
# function.
# Taking a request, try to get the <AuthName>AuthMethods list for the resource
sub GetAuthMethods {
my ($self, $r) = @_;
my ($authname, $authmethlist);
my @authmethods = ();
# Get the auth name
($authname = $r->auth_name()) || (die("GetAuthMethods(): No auth name set for this request!\n"));
($authmethlist = $r->dir_config($authname . "AuthMethods")) || (die("GetAuthMethods(): No authentication methods found for $authname!\n"));
# <AuthName>AuthMethods should be a comma deliminated list of methods. Let
# us see, shall we?
foreach (split(',', $authmethlist)) {
(/^\s*(Auth[\w\d]+)\s*$/) || (die("GetAuthMethods(): Invalid ${authname}AuthMethods definition!\n"));
push(@authmethods, $1);
}
return @authmethods;
}
# This just loads the appropriate Apache::AppSamurai::AuthXXX modules
# so they are ready to authenticate against. Note that this function
# needs only be called by authen_cred() most of the time. Returns a ref
# to a hash with AuthName->AuthNameInstance mappings
sub InitAuthenticators {
my $self = shift;
my $r = shift;
my @authmethods = @_;
my ($am, $amn, $lkn, $skn, $ch, $authname, $dirconfig);
(scalar(@authmethods)) || (die("InitAuthenticators(): You must specify at least one authentication method!\n"));
# Clear authenticator handle hash
my $authenticators = {};
# Get directory authentication name and a hash of its config
($authname = $r->auth_name()) || (die("InitAuthenticators(): No auth name set for this request!\n"));
$dirconfig = $r->dir_config();
# Init each auth method
foreach $am (@authmethods) {
($am =~ /^Auth[A-Z0-9][a-zA-Z0-9:]+$/) || (die("InitAuthenticators(): Illegal authentication method name! (Check case)\n"));
# Extract any config variables set for the configure auth methods
# and store in a temp hash before creating auth module instance
$ch = {};
$lkn = '';
$skn = '';
foreach $lkn (keys %{$dirconfig}) {
($lkn =~ /^${authname}${am}([\w\d]+)\s*$/) || (next);
$skn = $1;
$ch->{$skn} = $dirconfig->{$lkn};
# If a "header:<field>" is requested, replace with the named
# header's value from the client request, or an empty string
if ($ch->{$skn} =~ /^header:([\w\d\-]+)$/i) {
$ch->{$skn} = $r->headers_in->{$1};
}
lib/Apache/AppSamurai.pm view on Meta::CPAN
# Extract the session config
($sessconfig = $self->GetSessionConfig($r)) || (die "CreateSession(): Unable to get session configuration while creating new session");
# Create a session auth key to send back to send back as the cookie
# value, and to use the HMAC-SHA and optional session file encryptor.
# FetchKeysource returns "" by default, resulting in a fully randomized
# key.
$kt = $self->FetchKeysource($r);
if (defined($kt)) {
$sessconfig->{key} = CreateSessionAuthKey($kt);
} else {
$self->Log($r, ('warn', "CreateSession(): Failed to generate session authentication key: Session creation denied"));
return undef;
}
# Check for valid looking key
unless (CheckSidFormat($sessconfig->{key})) {
$self->Log($r, ('warn', "CreateSession(): Bad session authentication key returned! Session creation denied"));
return undef;
}
# Run against the unique session tracker if configured. (*Don't make
# the same session twice)
if ($sessconfig->{Unique}) {
unless ($self->CheckTracker($r, 'SessionUnique', $sessconfig->{key})) {
$self->Log($r, ('warn', "CreateSession(): SessionUnique detected duplicate session authentication key! Session creation denied"));
return undef;
}
}
# Wrapped this in an eval, since Apache:Session dies on failures
eval { tie(%sess, 'Apache::AppSamurai::Session', undef, $sessconfig); };
if ($@) {
$self->Log($r, ('error', "CreateSession(): Unable to create new session: $@"));
return undef;
}
$sid = $sess{_session_id};
# Make sure we received a good session ID.
(CheckSidFormat($sid)) || (($self->Log($r, ('error', 'CreateSession(): Invalid Session ID Format on new Session'))) && (return undef));
$self->Log($r, ('notice', "LOGIN: username=\"$username\", session=\"$sid\""));
# Store some basics
$sess{'username'} = $username;
$sess{'ctime'} = time();
# Track last access time if Timeout is set
if ($sessconfig->{Timeout}) {
$sess{'atime'} = $sess{'ctime'};
$sess{'Timeout'} = $sessconfig->{Timeout};
}
# Set hard expiration time if Expire is set
if ($sessconfig->{Expire}) {
$sess{'etime'} = $sess{'ctime'} + $sessconfig->{Expire};
$sess{'Expire'} = $sessconfig->{Expire};
}
# Apply passback cookies to response, and pull in updated alterlist
if (defined($alterlist->{cookie})) {
$alterlist = $self->AlterlistPassBackCookie($alterlist, $r);
}
# If present, save Authorization header to detect future changes,
# then prepend an alterlist rule to delete the header to prevent
# pass though to the backend server. (If needed, a separate
# alterlist rule to add an Authorization header should be set
# by a auth module.)
if ($r->headers_in->{"Authorization"}) {
$sess{'Authorization'} = $r->headers_in->{"Authorization"};
# Stick it in front in case we have an existing add
# header from an auth module
unshift(@{$alterlist->{header}}, 'delete:Authorization:');
}
# Save current alterlist to session
$self->AlterlistSave($alterlist, \%sess);
# Release session
untie(%sess);
# Return the session auth key
return $sessconfig->{key};
}
# Destroy a session, rendering it forever useless. Takes a request hash ref
# and a session hash ref as args. (Session must be tied when DestroySession
# is called.)
sub DestroySession {
my ($self, $r, $sess) = @_;
# Call the delete method for the the tied hash. Wrapped in eval goodness
# since Apache::Session will die on error.
eval { tied(%{$sess})->delete; };
if ($@) {
$self->Log($r, ('warn', "DestroySession(): Unable to destroy session: $@"));
return undef;
}
return 1;
}
## TRACKER - A system to store persistant and shared data for various
## uses. This is yet more code that could be refactored and busted into
## external modules to allow for adding arbitrary stateful checks of
## all sorts of things, (like the authentication handlers).
## For now, only a small set of tracker types are provided,
## and all are defined in this module.
# Get Tracker config (Tracker being a special case Session type targetted
# at IPC tasks) The tracker should never hold sensitive data since encryption
# support is not provided! Make sure to hash sensitive info if you need to
# track old session authentication keys or other items.
sub GetTrackerConfig {
my ($self, $r) = @_;
my $auth_name = ($r->auth_name()) || (die("GetTrackerConfig(): No auth name defined!\n"));
my $dirconfig = $r->dir_config;
my $trakconfig = {};
lib/Apache/AppSamurai.pm view on Meta::CPAN
# Returns undef if the atime is more than the session's timeout age
# or if etime is set and is over the session's expire age.
sub CheckTime {
my ($self, $sess) = @_;
my $time = time();
my $tdiff;
my $ret = undef;
# All sessions require at least a floating or fixed timeout!
($sess->{atime} || $sess->{etime}) or return undef;
# Check the hard timeout first, if it exists.
# This short circuits further checking since the hard timeout is king!
if ($sess->{etime}) {
if ($time >= $sess->{etime}) {
return undef;
} else {
$ret = $sess->{etime};
}
}
if ($sess->{atime}) {
$tdiff = $time - $sess->{atime};
if ($tdiff < $sess->{Timeout}) {
# We are still valid. Update the time if we are over 60 seconds
# stale.
if ($tdiff >= 60) {
$sess->{atime} = $time;
}
$ret = $sess->{atime};
} else {
return undef;
}
}
return $ret;
}
# The Alterlist functions manipulate and apply a list of transforms to apply to
# the headers and cookies of the client request before sending the request
# through to the backend server. $self->{alterlist} is a hash containing
# one or more of the following container arrays:
#
# header
# ------
# @{$self->{alterlist}->{header}} - One or more header transforms, with the
# syntax:
# ACTION:NAME:VALUE
# ACTION - add, replace, or delete
# NAME - Header name (or regex match for delete)
# VALUE - New value of header for add or replace, else optional regex filter
# for delete (Prefix pattern with ! for negation)
#
# cookie
# ------
# @{$self->{alterlist}->{cookie}} - One or more cookie transforms, with the
# syntax:
# ACTION:NAME:VALUE
# ACTION - add, replace, delete, or passback
# NAME - Cookie name (or regex match for delete)
# VALUE - New value of cookie, or regex filter for delete action (Prefix
# pattern with ! for negation)
#
# Note - delete rules with optional value match pattern will delete only values
# of a multi-value cookie that match the value pattern
#
# The special "passback" action passes cookies back to the web browser on
# login, This allows us to gather cookies from backend servers on login, but
# have the web browser maintain them.
#
# More containers can be added without modifying the generic functions.
# Load Alterlist rules from session and return a ref to the loaded alterlist
sub AlterlistLoad {
my ($self, $sess) = @_;
my ($sk,$rk);
my $alterlist = {};
# All alterlist save value start with al-
foreach $sk (keys %{$sess}) {
($sk =~ /^al\-([\w]+)$/) || (next);
$rk = $1;
@{$alterlist->{$rk}} = split("\n", $sess->{$sk});
}
return $alterlist;
}
# Update current alterlist with given alterlist hash ref
sub AlterlistMod {
my ($self, $alterlist, $alm) = @_;
my $rk;
(defined($alterlist)) || ($alterlist = {});
# Update alterlist from $alm hash ref
foreach $rk (keys %{$alm}) {
foreach (@{$alm->{$rk}}) {
push(@{$alterlist->{$rk}}, $_);
}
}
# Modifications made directly, but return the ref in case
return $alterlist;
}
# Save existing alterlist to given session
sub AlterlistSave {
my ($self, $alterlist, $sess) = @_;
my ($sk,$rk);
# Save alterlist to session in \n deliminated form.
if (defined($alterlist) && scalar(keys %{$alterlist})) {
foreach $rk (keys %{$alterlist}) {
$sk = "al-" . $rk;
$sess->{$sk} = join("\n", @{$alterlist->{$rk}});
}
}
return $alterlist;
}
# Apply current alterlist rules to request (just calls sub methods in order)
sub AlterlistApply {
my ($self, $alterlist, $r) = @_;
my $status = 1;
(defined($alterlist)) || (return 0);
if (defined($alterlist->{header})) {
# Run through headers (saving off alter count)
$self->AlterlistApplyHeader($alterlist, $r);
$self->Log($r, ('debug', "AlterlistApply(): Applied alterlist for header"));
}
if (defined($alterlist->{cookie})) {
# Run through cookies (saving off alter count)
$self->AlterlistApplyCookie($alterlist, $r);
$self->Log($r, ('debug', "AlterlistApply(): Applied alterlist for cookie"));
}
return $alterlist;
}
# Apply alterlist rules to request headers.
sub AlterlistApplyHeader {
my ($self, $alterlist, $r) = @_;
(defined($alterlist->{header})) || (return 0);
my ($t, $h, $hl, $act, $key, $val, $tk, $tv);
# Extract current header hash and build \n deliminated lookup string
# to fast match against
$h = $r->headers_in;
$hl = "\n" . join("\n", keys(%{$h})) . "\n";
# Cycle through all header transforms
foreach $t (@{$alterlist->{header}}) {
($t =~ /^(add|replace|rep|delete|del):([\w\d\-]+):(.*?)$/i) || (($self->Log($r, ('debug', "AlterlistApplyHeader(): Skipping illegal header transform \"$t\""))) && (next));
$act = $1;
$key = $2;
$val = $3;
if ($act =~ /^add$/) {
# Blindly clear then add the header
$r->headers_in->unset($key);
$r->headers_in->add($key => $val);
# Log obscured value
$self->Log($r, ('debug', "HEADER ADD: $key: " . XHalf($val)));
} else {
# Replace and delete allow for regex header name matches
while ($hl =~ /($key)/igm) {
# Update
$tk = $1;
# Make sure header was not deleted
($r->headers_in->{$tk}) || (next);
if ($act =~ /^replace|rep$/) {
# Blindly delete then add the header
# Save old value for log
$tv = $r->headers_in->{$tk};
$r->headers_in->unset($tk);
$r->headers_in->add($tk => $val);
# Log obscured values
$self->Log($r, 'debug', ("AlterlistApplyHeader(): HEADER REPLACE: $tk: " . XHalf($tv) . " -> " . XHalf($val)));
} elsif ($act =~ /^delete|del$/) {
# Check for extra content match
if ($val) {
$tv = $r->headers_in->{$tk};
# Handle negation
if ($val =~ s/^\!//) {
($tv =~ /($val)/is) && (next);
} else {
($tv =~ /($val)/is) || (next);
}
}
# Kill!
$r->headers_in->unset($tk);
# Log obscured value
$self->Log($r, ('debug', "AlterlistApplyHeader(): HEADER DELETE: $tk: " . XHalf($tv)));
}
}
}
}
return $alterlist;
}
# Apply alterlist rules to request cookies.
# Note - Does not handle "passback" cookie. Use AlterlistPassBackCookie() to
# retrieve and clear passback cookies)
sub AlterlistApplyCookie {
my ($self, $alterlist, $r) = @_;
(defined($alterlist->{cookie})) || (return 0);
my ($t, %c, $cl, $act, $key, $val, $tk, $tv, @ta, @td);
my $alterred = 0;
# Grab any cookies any put into a hash of CGI::Cookies, or just make an
# empty cookie hash for now.
%c = CGI::Cookie->fetch($r);
(%c) || (%c = ());
# Build \n deliminated lookup string to fast match against
$cl = "\n" . join("\n", keys(%c)) . "\n";
foreach $t (@{$alterlist->{cookie}}) {
# Note - : or = allowed between NAME and VALUE to make life easier
($t =~ /^(add|replace|rep|delete|del|passback|set):([\w\d\-]+)(?:\:|\=)(.*?)$/i) || (($self->Log($r, ('debug', "AlterlistApplyCookie(): Skipping illegal cookie transform \"$t\""))) && (next));
$act = $1;
$key = $2;
$val = $3;
if ($act =~ /^passback|set$/) {
# passback not handled in this method
next;
} elsif ($act =~ /^add$/) {
# Blindly add the cookie
@ta = split('&', $val);
# Add a new CGI::Cookie to the hash
$c{$key} = new CGI::Cookie(-name => $key, -value => \@ta);
# Log obscured value
$self->Log($r, ('debug', "AlterlistApplyCookie(): COOKIE ADD: $key=" . XHalf($val)));
$alterred++;
} else {
# Replace and delete allow for regex cookie name matches
while ($cl =~ /($key)/igm) {
# Update
$tk = $1;
if ($act =~ /^replace|rep$/) {
# Blindly delete then add the cookie back with new value
# Save old value for log
$tv = join('&', $c{$tk}->value);;
delete($c{$tk});
@ta = split('&', $val);
$c{$tk} = new CGI::Cookie(-name => $tk, -value => \@ta);
# Log obscured values
$self->Log($r, ('debug', "AlterlistApplyCookie(): COOKIE REPLACE: $tk: " . XHalf($tv) . " -> " . XHalf($val)));
$alterred++;
} elsif ($act =~ /^delete|del$/) {
# Check for extra content match
if ($val) {
@ta = ();
@td = ();
# Cycle through multi-values
foreach $tv ($c{$tk}->value) {
# Handle negation
if ($val =~ s/^\!//) {
# Save value and continue
if ($tv =~ /($val)/is) {
push(@ta, $tv);
next;
}
} else {
# Save value and continue
unless ($tv =~ /($val)/is) {
push(@ta, $tv);
next;
}
}
# Fell through, so this value is history/unsaved
push(@td, $tv);
$alterred++;
}
# Kill!
if (scalar @ta) {
# Some values left not deleted, so set those back
$c{$tk}->value(\@ta);
$tv = join('&', @td);
# Log obscured value
$self->Log($r, ('debug', "AlterlistApplyCookie(): COOKIE DELETE PARTIAL: $tk=" . XHalf($tv)));
} else {
# Nothing left inside. KILL!
delete($c{$tk});
$tv = join('&', @td);
# Obscure values for logging
$tv =~ s/([^X])[\w\d]/${1}X/gs;
$self->Log($r, ('debug', "AlterlistApplyCookie(): COOKIE DELETE FULL: $tk=$tv"));
}
} else {
# Kill Em All
$tv = $c{$key}->value;
delete($c{$key});
# Obscure values for logging
$tv =~ s/([^X])[\w\d]/${1}X/gs;
$self->Log($r, ('debug', "AlterlistApplyCookie(): COOKIE DELETE FULL: $key=$tv"));
$alterred++;
}
}
}
}
}
# Unset, then add cookies to header if changes were made
if ($alterred) {
$r->headers_in->unset('Cookie');
$t = '';
foreach $tk (keys %c) {
# Cookie to list in string form.
$t .= $c{$tk}->name . "=" . join('&', $c{$tk}->value) . "; ";
}
# Kill trailing '; '
$t =~ s/\; $//s;
# Ship it
$r->headers_in->add('Cookie' => $t);
}
return $alterlist;
}
# Add a Set-cookie: header to r for all alterlist "passback" cookies and return
# a modified alterlist with the passback cookie values cleared and expired.
#
# Unlike normal alterlist rules, passback cookies are sent BACK to the client.
# The only time this can occur is upon login/redirect. The purpose of passback
# cookies is to set the same cookies in the browser as they would have set
# if they were connecting directly to the backend server(s).
#
# The return should be used to update the alterlist. When
# AlterlistPassBackCookie is applied again, it will UNSET the passback cookies.
# This should be done on logout.
sub AlterlistPassBackCookie() {
my ($self, $alterlist, $r) = @_;
(defined($alterlist->{cookie})) || (return 0);
my ($t, $key, $val, $opt, $tdomain, $tpath, $texpire);
my @ct = ();
my %c = ();
foreach $t (@{$alterlist->{cookie}}) {
# Note - : or = allowed between NAME and VALUE to make life easier
($t =~ /^(passback|set):([\w\d\-]+)(?:\:|\=)([^;]*)(;.*)?$/i) || ((push(@ct, $t)) && (next));
$key = $2;
$val = $3;
$opt = $4;
$tdomain = $tpath = $texpire = '';
# Unlike AlterlistApplyCookie which just needs to parse name and
# value, the PassBack cookies are Set-Cookie items which may
# have options. Also, only process the last cookie value if
# a multi-value cookie is passed
# Add a new CGI::Cookie to the hash
$c{$key} = new CGI::Cookie(-name => $key,
-value => $val,
);
# Set further options (only Expires and Path currently passed through)
foreach $t (split(';', $opt)) {
if ($t =~ /^\s*expires=([\w\d \:\;\-,]+)\s*$/) {
$c{$key}->expires($1);
} elsif ($t =~ /^\s*path=(\/.*?)\s*$/) {
$c{$key}->path($1);
}
}
# Set other options to match session cookie values (could be made a
# configurable, and allow for maintaining the original options from the
# cookie. I don't see a need.)
my $auth_name = $r->auth_name;
if ($r->dir_config("${auth_name}Domain")) {
$c{$key}->domain($r->dir_config("${auth_name}Domain"));
}
if (!$r->dir_config("${auth_name}Secure") || ($r->dir_config("${auth_name}Secure") == 1)) {
$c{$key}->secure(1);
}
$r->err_headers_out->add('Set-Cookie' => $c{$key});
# Clean up and log
$t = $c{$key};
$t =~ /($key\s*\=\s*)(.*?)(;|$)/;
$self->Log($r, ('debug', "AlterlistPassBackCookie(): COOKIE PASSBACK: " . $1 . XHalf($2) . $3));
# Save an empty/expired cookie so next call to AlterlistPassBackCookie
# with this alterlist will unset the cookie
$c{$key}->value('');
$c{$key}->expires('Thu, 1-Jan-1970 00:00:00 GMT');
push(@ct, "passback:" . $c{$key});
}
# Save updated cookie array
@{$alterlist->{cookie}} = @ct;
return $alterlist;
}
# Append an error code to the list of query args in a given URL. (Used to
# pass friendly error messages to users in external redirects. (Note that
# AuthCookie used subprocess_env() to pass that info, but since that will only
# work in the same main request, it won't pass into an external redirect.)
sub URLErrorCode {
my $self = shift;
my $uri = (shift) || (return undef);
my $ecode = (shift) || ('');
($uri = new URI($uri)) || (return undef);
# Error codes must contain only letters, numbers, and/or _ chars.
# Your login.pl script should read them in CAREFULLY and make sure
# they follow this format.
($ecode =~ /^([\w\d_]+)$/) || (return undef);
# Add the error code and return the URI in string form
$uri->query_form($uri->query_form, 'ASERRCODE' => $ecode);
return $uri->as_string;
}
# Log to configured log. Always takes the request as the 1st arg. Can
# take either a loglevel and a message as args 2 and 3, or an array
# of loglevel and message arrays as the 2nd arg.
sub Log {
my $self = shift;
my $r = shift;
my $la = [];
my $debug = $self->_debug($r);
# Check if being called with a level and message, or with a log array
if (ref($_[0]) eq "ARRAY") {
$la = $_[0];
(defined(@{$la}) && (scalar @{$la})) || (return 0);
} else {
(defined($_[0]) && defined($_[1])) || (return 0);
# Set to a single child array of arrays
$la = [[$_[0], $_[1]]];
}
# Collect a few tidbits (package name, client IP and URI?args)
my $auth_name = ($r->auth_name || "");
$auth_name .= ': ';
my $info = ' <client=';
if ($MP eq 1) {
$info .= ($r->get_remote_host || "");
} else {
$info .= ($r->connection->get_remote_host || "");
}
$info .= ', uri="';
$info .= ($r->uri() || "");
(defined($r->args())) && ($info .= '?' . $r->args());
$info .= '">';
# Get the log handle for the server
my $log = $r->server->log;
my $defaultlevel = 'error';
my ($li, $level, $line);
# Cycle through the log entries
foreach $li (@{$la}) {
if (scalar(@{$li}) == 2) { # 2 argument form with level and line
$level = $li->[0];
lib/Apache/AppSamurai.pm view on Meta::CPAN
my $debug = 0;
if ($r->auth_name) {
my $auth_name = $r->auth_name;
if ($r->dir_config("${auth_name}Debug")) {
($r->dir_config("${auth_name}Debug") =~ /^(\d+)$/) && ($debug = $1);
}
}
return $debug;
}
# Filter the output line before logging. Restricts to no more than CharMax
# characters and converts everything matching BlankChars to a space to
# try and protect logging systems and log monitors from attack.
sub FilterLogLine {
my $self = shift;
my $line = (shift || return undef);
my $LogCharMax = 1024;
# Strip surrounding whitespace
$line =~ s/^\s*(.+?)\s*$/$1/s;
# Convert newlines to ', '
$line =~ s/\r?\n/, /sg;
# Check length and truncate if needed
$line = substr($line, 0, $LogCharMax);
# Convert BlankChars matches to blanks
$line =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f\x7f\'\\]+/ /g;
return $line;
}
1; # End of Apache::AppSamurai
__END__
=head1 NAME
Apache::AppSamurai - An Authenticating Mod_Perl Front End
"Protect your master, even if he is without honour...."
=head1 SYNOPSIS
All configuration is done within Apache. Requires Apache 1.3.x/mod_perl1 or
Apache 2.0.x/mod_perl2. See L</EXAMPLES> for sample configuration segments.
=head1 DESCRIPTION
B<Apache::AppSamurai> protects web applications from direct attack by
unauthenticated users, and adds a flexible authentication front end
to local or proxied applications with limited authentication options.
Unauthenticated users are presented with either a login form, or a basic
authentication popup (depending on configuration.) User supplied credentials
are checked against one or more authentication systems before the user's
session is created and a session authentication cookie is passed back to the
browser. Only authenticated and authorized requests are proxied through
to the backend server.
Apache::AppSamurai is based on, and includes some code from,
L<Apache::AuthCookie|Apache::AuthCookie>.
Upon that core is added a full authentication and session handling framework.
(No coding required.) Features include:
=over 4
=item *
B<Modular authentication> - Uses authentication sub-modules for the easy
addition custom authentication methods
=item *
B<Form based or Basic Auth login> - On the front end, supports standard
form based logins, or optionally Basic Auth login. (For use with automated
systems that can not process a form.)
=item *
B<Apache::Session> - Used for session data handling
=item *
B<Session data encrypted on server> - By default, all session
data encrypted before storing to proxy's filesystem (Uses custom
B<Apache::Session> compatible session generator and session serialization
modules)
=item *
B<Unified mod_perl 1 and 2 support> - One module set supports both
Apache 1.x/mod_perl 1.x and Apache 2.x/mod_perl 2.x
=back
=head1 SESSION STORAGE SECURITY
Server side session data may include sensitive information, including the basic
authentication C<Authorization> header to be sent to the backend server.
(This is just a Base64 encoded value, revealing the username and password
if stolen.)
To protect the data on-disk, Apache::AppSamurai includes
its own HMAC based session ID generator and encrypting session serializer.
(L<Apache::AppSamurai::Session::Generate::HMAC_SHA|Apache::AppSamurai::Session::Generate::HMAC_SHA>
and
L<Apache::AppSamurai::Session::Serialize::CryptBase64|Apache::AppSamurai::Session::Serialize::CryptBase64>
, respectively.)
These modules are configured by default and may be used directly with
Apache::Session, or outside of Apache::AppSamurai if desired.
=head1 USAGE
Almost all options are set using C<PerlSetVar> statements, and can be used
inside most configuration sections.
Each configuration option must be prefixed by the I<AuthName> for the
Apache::AppSamurai instance you wish to apply the option to. This
I<AuthName> is then referenced within the protected area(s). Most of setups
only require one I<AuthName>. You can call it "BOB" or "MegaAuthProtection".
You can even call it "authname".
B<IMPORTANT NOTE> - The I<AuthName> is omitted in the configuration
descriptions below for brevity. "Example" is used as the I<AuthName> in the
L</EXAMPLES> section.
Most setups will include a set of global configuration values to setup the
Apache::AppSamurai instance. Each protected area then points to a specific
AuthName and Apache::AppSamurai methods for authentication and
authorization.
=head2 GENERAL CONFIGURATION
=head3 I<Debug> C<0|1>
(Default: 0)
Set to 1 to send debugging output to the Apache logs. (Note - you must have
a log configured to catch errors, including debug level errors, to see the
output.)
=head3 I<CookieName> C<NAME>
(Default:AUTHTYPE_AUTHNAME)
The name of the session cookie to send to the browser.
=head3 I<LoginScript> C<PATH>
(Default: undef)
The URL path (location) of the proxy's login page for form based login.
(Sample script provided with the Apache::AppSamurai distribution.)
=head3 I<Path> C<PATH>
(Default: /)
The URL path to protect.
=head3 I<Domain> C<DOMAIN>
(Default: not set)
The optional domain to set for all session cookies. Do not configure this
unless you are sure you need it: A misconfigured domain can result in session
stealing.
=head3 I<Satisfy> C<All|Any>
(Default: All)
Set C<require> behaviour within protected areas. Either C<All> to require all
authentication checks to succeed, or C<Any> to require only one to.
=head3 I<Secure> C<0|1>
(Default: 1)
Set to 1 to require the C<secure> flag to be set on the session cookie, forcing
the use of SSL/TLS.
=head3 I<HttpOnly> C<0|1>
(Default: 0)
Set to 1 to require the Microsoft proprietary C<http-only> flag to be set on
session cookies.
=head3 I<LoginDestination> C<PATH>
(Default: undef)
Set an optional hard coded destination URI path all users will be directed to
after login. (While full URLs are allowed, a path starting in / is
recommended.) This setting only applies so form based login. Basic Auth
logins always follow the requested URL.
=head3 I<LogoutDestination> C<PATH>
(Default: undef)
Set an optional hard coded destination URI path all users will be directed to
after logging out. (While full URLs are allowed, a path starting in / is
recommended.) This setting only applies so form based login. Basic Auth
logins always follow the requested URL.
If I<LogoutDestination> is unset and I<LoginDestination> is set,
users will be directed to I<LoginDestination> after logout. (This is
to prevent a user from logging back into the logout URI, which would log them
back out again. Oh the humanity!)
lib/Apache/AppSamurai.pm view on Meta::CPAN
=head3 login()
Should be configured in the Apache config as the PerlHandler, (or
"PerlResponseHandler" for mod_perl 2.x), for a special pseudo file under
the F<AppSamurai/> directory. In example configs and
the example F<login.pl> form page, the pseudo file is named B<LOGIN>.
C<login()> expects an Apache request with a list of credentials included as
arguments. B<credential_0> is the username. All further credentials are
mapped in order to the authentication modules defined in L</AuthMethods>.
Each configured authentication method is checked, in order. If all
succeed, a session is created and a session authentication cookie is returned
along with a redirect to the page requested by the web browser.
If login fails, the browser is redirected to the login form.
=head3 logout()
Should be called directly by your logout page or logout pseudo file.
This expects an Apache request handle. It can also take a second
option, which should be a scalar URI path to redirect users to after
logout. C<logout()> attempts to look up and destroy the session tied to the
passed in session authentication key.
Like C<login()>, you may create a special pseudo file named LOGOUT and
use PerlHandler, (or "PerlResponseHandler" for mod_perl 2.x), to map it
to the C<logout()> method. This is particularly handy when paired with
mod_rewrite to map a specific application URI to a pseudo file mapped to
C<logout()> (See L</EXAMPLES> for a sample config that uses this method.)
=head1 EXAMPLES
## This is a partial configuration example showing most supported
## configuration options and a reverse proxy setup. See examples/conf/
## in the Apache::AppSamurai distribution for real-world example configs.
## Apache 1.x/mod_perl 1.x settings are enabled with Apache 2.x/mod_perl 2.x
## config alternatives commented out. ("*FOR MODPERL2 USE:" precedes
## the Apache 2.x/mod_perl 2.x version of any alternative config items.)
## Note that example configs in examples/conf/ use IfDefine to support
## both version sets without having to comment out items. Also note that it
## is far too ugly looking to include in this example.
## General mod_perl setup
# Apache::AppSamurai is always strict, warn, and taint clean. (Unless
# I mucked something up ;)
PerlWarn On
PerlTaintCheck On
PerlModule Apache::Registry
#*FOR MODPERL2 USE:
# PerlSwitches -wT
# PerlModule ModPerl::Registry
# Load the main module and define configuration options for the
# "Example" auth_name
PerlModule Apache::AppSamurai
PerlSetVar ExampleDebug 0
PerlSetVar ExampleCookieName MmmmCookies
PerlSetVar ExamplePath /
PerlSetVar ExampleLoginScript /login.pl
# Defaults to All by may also be Any
#PerlSetVar ExampleSatisty All
# Optional session cookie domain (Avoid unless absolutely needed.)
#PerlSetVar ExampleDomain ".thing.er"
# Require secure sessions (default: 1)
#PerlSetVar ExampleSecure 1
# Set proprietary MS flag
PerlSetVar ExampleHttpOnly 1
# Define authentication sources, in order
PerlSetVar ExampleAuthMethods "AuthRadius,AuthBasic"
# Custom mapping of xxxxxx;yyyyyy Basic authentication password input
# to specific and separate individual credentials. (default: undef)
PerlSetVar ExampleBasicAuthMap "2,1=(.+);([^;]+)"
## Apache::AppSamurai::AuthRadius options ##
# (Note - See L<Apache::AppSamurai::AuthRadius> for more info)
PerlSetVar ExampleAuthRadiusConnect "192.168.168.168:1645"
PerlSetVar ExampleAuthRadiusSecret "radiuspassword"
## Apache::AppSamurai::AuthBasic options.##
# (Note - See L<Apache::AppSamurai::AuthBasic> for more info)
# Set the URL to send Basic auth checks to
PerlSetVar ExampleAuthBasicLoginUrl "https://ex.amp.le/thing/login"
# Always send Basic authentication header to backend server
PerlSetVar ExampleAuthBasicKeepAuth 1
# Capture cookies from AuthBasic login and set in client browser
PerlSetVar ExampleAuthBasicPassBackCookies 1
# Abort the check unless the "realm" returned by the server matches
PerlSetVar ExampleAuthBasicRequireRealm "blah.bleh.blech"
# Pass the named header directly through to the AuthBasic server
PerlSetVar ExampleAuthBasicUserAgent "header:User-Agent"
## Session storage options ##
# (Note - See L<Apache::AppSamurai::Session> and L<Apache::Session> for
# more information.)
# Inactivity timeout (in seconds)
PerlSetVar ExampleSessionTimeout 1800
# Use the File storage and lock types from Apache::Session
PerlSetVar ExampleSessionStore "File"
PerlSetVar ExampleSessionLock "File"
# File storage options (Relevant only to File storage and lock types)
PerlSetVar ExampleSessionDirectory "/var/www/session/sessions"
PerlSetVar ExampleSessionLockDirectory "/var/www/session/slock"
# Use the Apache::AppSamurai::Session::Generate::HMAC_SHA generator
PerlSetVar ExampleSessionGenerate "AppSamurai/HMAC_SHA"
# Use the Apache::AppSamurai::Session::Serialize::CryptBase64
# data serializer module with Crypt::Rijndael (AES) as the block
# cipher provider
PerlSetVar ExampleSessionSerialize "AppSamurai/CryptBase64"
PerlSetVar ExampleSessionSerializeCipher "Crypt::Rijndael"
# Set the server's encryption passphrase (for use with HMAC session
# generation and/or encrypted session storage)
PerlSetVar ExampleSessionServerPass "This is an example passphrase"
## Tracker storage options ##
# Cleanup tracker entries that have not changed in 1 day
PerlSetVar ExampleTrackerCleanup 86400
# Block further login attempts from IPs that send 10 failures with
# no more than 60 seconds between each subsequent failure
PerlSetVar ExampleIPFailures "10:60"
# Force at least one credential to be unique per-login. (Requires
# token or other non-static authentication type.)
PerlSetVar ExampleAuthUnique 1
# Prohibit a new session from using the same session ID as a previous
# session. (Only relevant for non-random sessions that use the
# Keysource directive to calculate a pseudo-cookie.)
PerlSetVar ExampleSessionUnique 1
## Special AppSamurai directory options ##
# (These will vary widely depending on your specific setup and requirements.)
<Directory "/var/www/htdocs/AppSamurai">
lib/Apache/AppSamurai.pm view on Meta::CPAN
# basic auth header from the client, and an argument called
# "Sessionthing" from the request URL. (NOTE - Keysource
# should be used with care! Do not use it unless you are
# sure of what you are doing!!!)
PerlAddVar ExampleKeysource header:Authorization
PerlAddVar ExampleKeysource arg:Sessionthing
Order deny,allow
Allow from all
require valid-user
</Directory>
#*FOR MODPERL2 USE:
#</Proxy>
# Do not allow forward proxying
ProxyRequests Off
# Proxy requests for /thing/* to https://ex.amp.le/thing/*
RewriteRule ^/thing/(.*)$ https://ex.amp.le/thing/$1 [P]
# Similar for /thaang/*
RewriteRule ^/thaang/(.*)$ https://ex.amp.le/thaang/$1 [P]
# Redirect requests to / into our default app
RewriteRule ^/?$ /thing/ [R,L]
# Allow in AppSamurai requests to proxy server
RewriteRule ^/AppSamurai -
# Capture logout URL from app and send to a pseudo page mapped to logout()
RewriteRule ^/thing/logout\.asp$ /AppSamurai/LOGOUT
# Block all other requests
RewriteRule .* - [F]
#*FOR MODPERL2 YOU MUST UNCOMMENT AND PUT THE FOLLOWING INSIDE
# RELEVANT VirtualHost SECTIONS (For most Apache2 setups, this would be
# the "<VirtualHost _default_:443>" section inside ssl.conf)
#
## Enable rewrite engine inside virtualhost
#RewriteEngine on
## Inherit rewrite settings from parent (global)
#RewriteOptions inherit
## Enable proxy connections to SSL
#SSLProxyEngine on
=head1 EXTENDING
Additional authentication modules, tracking features, and other options
can be added to Apache::AppSamurai. In the case of authentication modules,
all that is required is creating a new module that inherits from
L<Apache::AppSamurai::AuthBase|Apache::AppSamurai::AuthBase>.
Other features may be more difficult to add. (Apache::AppSamurai could
use some refactoring.)
Interface and utility methods are not documented at this time. Please
consult the code, and also the L<Apache::AuthCookie|Apache::AuthCookie>
documentation.
=head1 FILES
=over 4
=item F<APPSAMURAI_CONTENT/>
Directory that holds Apache::AppSamurai login/logout pages and related
content. This must be served by Apache and reachable. (This is
generally mapped to B</AppSamurai/> on the server.) When starting from
scratch, copy the contents of F</examples/htdocs/> from the Apache-AppSamurai
distribution into this directory.
=item F<APPSAMURAI_CONTENT/login.pl>
The default login mod_perl script. Must be modified to match your setup.
=item F<APPSAMURAI_CONTENT/login.html>
The default HTML login form template. (Split out from login.pl to ease
customization.)
=item F<APPSAMURAI_CONTENT/robots.txt>
Generic "deny all" robots file. (You don't want your login area appearing
on Google. Note that the default login page also has a META tag to prevent
indexing.)
=item F<APPSAMURAI_CONTENT/images/>
Image files for login page.
=back
=head1 SEE ALSO
L<Apache::AppSamurai::Session>, L<Apache::AppSamurai::Tracker>,
L<Apache::AppSamurai::AuthBase>, L<Apache::AppSamurai::AuthBasic>,
L<Apache::AppSamurai::AuthRadius>, L<Apache::AppSamurai::AuthSimple>,
L<Apache::AppSamurai::Util>,L<Apache::AppSamurai::Session::Generate::HMAC_SHA>,
L<Apache::AppSamurai::Session::Serialize::CryptBase64>,
L<Apache::Session>
=head1 AUTHOR
Paul M. Hirsch, C<< <paul at voltagenoir.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<< <paul at voltagnoir.org> >>
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Apache::AppSamurai
You can also look for information at:
=over 4
=item * AppSamurai Project Homepage
L<http://appsamurai.sourceforge.net>
=item * AppSamurai Project Homepage (backup)
L<http://www.voltagenoir.org/AppSamurai/>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Apache-AppSamurai>
=back
=head1 ACKNOWLEDGEMENTS
AppSamurai.pm (the main Apache::AppSamurai module), contains some code
from Apache::AuthCookie, which was developed by Ken Williams and others.
The included Apache::AuthCookie code is under the same licenses as Perl
and under the following copyright:
Copyright (c) 2000 Ken Williams. All rights reserved.
=head1 COPYRIGHT & LICENSE
Copyright 2008 Paul M. Hirsch, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
( run in 1.266 second using v1.01-cache-2.11-cpan-39bf76dae61 )