view release on metacpan or  search on metacpan

AuthzCache.pm  view on Meta::CPAN

# distinguishing version number. The Program (including Contributions)
# may always be distributed subject to the version of the Agreement
# under which it was received. In addition, after a new version of the
# Agreement is published, Contributor may elect to distribute the
# Program (including its Contributions) under the new version. No one
# other than IBM has the right to modify this Agreement. Except as
# expressly stated in Sections 2(a) and 2(b) above, Recipient receives
# no rights or licenses to the intellectual property of any
# Contributor under this Agreement, whether expressly, by implication,
# estoppel or otherwise. All rights in the Program not expressly
# granted under this Agreement are reserved.
#
# This Agreement is governed by the laws of the State of New York and
# the intellectual property laws of the United States of America. No
# party to this Agreement will bring a legal action under this
# Agreement more than one year after the cause of action arose. Each
# party waives its rights to a jury trial in any resulting litigation.
#
###############################################################################


# Package name
package Apache::AuthzCache;


# Required libraries
use strict;
use mod_perl ();
use Apache::Constants qw(OK AUTH_REQUIRED DECLINED DONE);
use Apache::Log;
use Cache::FileCache;
use Text::ParseWords;
use Time::Object;


# Global constants
use constant REQUIRE_OPTS => { 'inagroup'     => 1,
			       'inmanygroups' => 2,
			       'inallgroups'  => 3 };


# Global variables
$Apache::AuthzCache::VERSION = '1.01';


###############################################################################
###############################################################################
# handler: hook into Apache/mod_perl API
###############################################################################
###############################################################################
sub handler {
  my $r = shift;
  return OK unless $r->is_initial_req; # only the first internal request
  my $requires = $r->requires;
  return OK unless $requires;
  my $require_groups = undef;

  # Get configuration
  my $casesensitive = $r->dir_config('AuthzCache_CaseSensitive') || 'on';
  my $cache_time_limit = $r->dir_config('AuthzCache_CacheTime') ||
    $r->dir_config('AuthzCache_Timeout') || $Cache::Cache::EXPIRES_NEVER;
  my $cache_dir = $r->dir_config('AuthzCache_Directory') || '/tmp';
  my $cache_umask = $r->dir_config('AuthzCache_Umask') || '007';
  my $auth_name = $r->auth_name;
  my $requirement = $r->dir_config('AuthzRequire') || 'inAGroup';
  $r->log->debug("manage_cache: cache_time_limit=$cache_time_limit, ",
		 "cache_dir=$cache_dir, cache_umask=$cache_umask, ",
		 "auth_name=$auth_name");
  $requirement = REQUIRE_OPTS->{lc($requirement)} || 1;

  # Get username
  my $user_sent = $r->connection->user;
  $r->log->debug("handler: username=$user_sent");

  # Clear for paranoid security precautions
  $r->subprocess_env(REMOTE_GROUP => undef);
  undef($r->headers_in->{'REMOTE_GROUP'});
  $r->notes('AuthzCache' => undef);

  # Get required groups
  for my $req (@$requires) {
    my ($require, $rest) = split /\s+/, $req->{requirement}, 2;
    if ($require eq "user") { return OK
                                if grep $user_sent eq $_, split /\s+/, $rest }
    elsif ($require eq "valid-user") { return OK }
    elsif ($require eq 'group') {
      @$require_groups = Text::ParseWords::parse_line('\s+', 0, $rest);
    }
  }

  # Do we want Windows-like case-insensitivity?
  if ($casesensitive eq 'off') {
    $user_sent = lc($user_sent);
  }

  # Create the cache if needed
  my $cache = Cache::FileCache->new({ namespace          => $auth_name,
				      default_expires_in => $cache_time_limit,
				      cache_root         => $cache_dir,
				      directory_umask    => $cache_umask });
  my $user_groups = $cache->get($user_sent);

  # Is the user in the cache
  if ($user_groups) {
    $r->log->debug("handler: using cached groups for $user_sent");

    my $success_groups = '';
  OUTTER: foreach my $req_group (@$require_groups) {
      my $succeeded = 0;
    INNER: foreach my $user_group (@$user_groups) {
	$r->log->debug("handler: comparing $req_group to $user_group");
	if ($casesensitive eq 'off' &&
	    lc($req_group) eq lc($user_group)) {
	  # Password matches so end stage
	  # The required patch was not introduced in 1.26. It is no longer
	  # promised to be included in any timeframe. Commenting out.
	  # if ($mod_perl::VERSION < 1.26) {
	    # Since set_handlers() doesn't work properly until
	    # 1.26 (according to Doug MacEachern) I have to work
	    # around it by cobbling together cheat sheets for the
	    # subsequent handlers in this phase. I get the

AuthzCache.pm  view on Meta::CPAN

		     "environment to $success_groups and notes");
      $r->subprocess_env(REMOTE_GROUP => $success_groups);
      $r->headers_in->{'REMOTE_GROUP'} = $success_groups;
      $r->notes('AuthzCache' => 'hit');
      return OK;
    }
  } # USER_GROUPS

  # User not in cache
  $r->log->debug("handler: user/group not in cache; returning DECLINED");
  return DECLINED;
}

###############################################################################
###############################################################################
# manage_cache: insert new entries into the cache
###############################################################################
###############################################################################
sub manage_cache {
  my $r = shift;
  return OK unless $r->is_initial_req; # only the first internal request
  my $requires = $r->requires;
  return OK unless $requires;

  # Get username
  my $user_sent = $r->connection->user;

  # Get required groups and proceed with caching only if groups were required
  for my $req (@$requires) {
    my ($require, $rest) = split /\s+/, $req->{requirement}, 2;
    if ($require eq "user") { return OK
                                if grep $user_sent eq $_, split /\s+/, $rest }
    elsif ($require eq "valid-user") { return OK }
  }

  my ($group_sent, $cache_result) = undef;
  # The required patch was not introduced in 1.26. It is no longer
  # promised to be included in any timeframe. Commenting out.
  # if ($mod_perl::VERSION < 1.26) {
    # I shouldn't need to use the below lines as this module
    # should never be called if there was a cache hit.  Since
    # set_handlers() doesn't work properly until 1.26 (according
    # to Doug MacEachern) I have to work around it by cobbling
    # together cheat sheets for the previous handlers in this
    # phase. I get the willies about the security implications in
    # a general environment where you might be using someone
    # else's handlers upstream or downstream...
  $group_sent = $r->subprocess_env("REMOTE_GROUP") ||
    $r->headers_in->{'REMOTE_GROUP'};
  $cache_result = $r->notes('AuthzCache');
  if ($group_sent && $cache_result eq 'hit') {
    $r->log->debug("manage_cache: upstream cache hit for ",
		   "username=$user_sent, group=$group_sent");
    return OK;
  # }
  }

  # Get configuration
  my $casesensitive = $r->dir_config('AuthzCache_CaseSensitive') || 'on';
  my $cache_time_limit = $r->dir_config('AuthzCache_CacheTime') ||
    $r->dir_config('AuthzCache_Timeout') || $Cache::Cache::EXPIRES_NEVER;
  my $cache_dir = $r->dir_config('AuthzCache_Directory') || '/tmp';
  my $cache_umask = $r->dir_config('AuthzCache_Umask') || '007';
  my $auth_name = $r->auth_name;
  $r->log->debug("manage_cache: cache_time_limit=$cache_time_limit, ",
		 "cache_dir=$cache_dir, cache_umask=$cache_umask, ",
		 "auth_name=$auth_name");

  # Do we want Windows-like case-insensitivity?
  if ($casesensitive eq 'off') {
    $user_sent = lc($user_sent);
    $group_sent = lc($group_sent);
  }

  # Add groups to the cache
  my $groups = []; # perl-5.8 chokes on declaring an array dereference
  @$groups = Text::ParseWords::parse_line('\s+', 0, $group_sent);
  my $cache = Cache::FileCache->new({ namespace          => $auth_name,
				      default_expires_in => $cache_time_limit,
				      cache_root         => $cache_dir,
				      directory_umask    => $cache_umask });
  my $user_groups = $cache->get($user_sent);
  if (ref($user_groups)) {
    $cache->set($user_sent, [(@{$groups}, @{$user_groups})], $cache_time_limit);
  } else {
    $cache->set($user_sent, $groups, $cache_time_limit);
  }
  $r->log->debug("manage_cache: added $user_sent:$group_sent to the cache");

  return OK;
}

if (Apache->module("Apache::Status")) {
  Apache::Status->menu_item('AuthzCache' => 'AuthzCache Menu Item',
			    \&status_menu);
}

###############################################################################
###############################################################################
# status_menu: provide status via Apache::Status on cache
###############################################################################
###############################################################################
sub status_menu {
  my ($r, $q) = @_;
  my @s;

  my $cache_dir = $r->dir_config('AuthzCache_Directory') || '/tmp';
  my $cache = Cache::FileCache->new({ cache_root => $cache_dir });
  my @nss = $cache->get_namespaces();

  push(@s, "<TABLE BORDER=\"1\">\n<TR>\n<TD><STRONG>Namespace</STRONG></TD>\n",
       "<TD><STRONG>UserID</STRONG></TD>\n",
       "<TD><STRONG>Authorized Groups</STRONG></TD>\n",
       "<TD><STRONG>Creation Date</STRONG></TD>\n",
       "<TD><STRONG>Expiration Date</STRONG></TD>\n</TR>\n");

  foreach my $ns (sort(@nss)) {
    $cache = Cache::FileCache->new({ cache_root => $cache_dir,
				     namespace  => $ns });
    my @keys = $cache->get_keys();
    foreach my $key (sort(@keys)) {