view release on metacpan or  search on metacpan

AuthzCache.pm  view on Meta::CPAN

  }

  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)) {
      my $obj = $cache->get_object($key);
      my $user_groups = $obj->get_data;
      my $created = Time::Object->new($obj->get_created_at);
      my $expires = Time::Object->new($obj->get_expires_at);
      push(@s, "<TR><TD VALIGN=\"TOP\">$ns</TD>\n",
	   "<TD VALIGN=\"TOP\">$key</TD>\n<TD VALIGN=\"TOP\">");
      foreach my $user_group (sort(@$user_groups)) {
	next if $user_group eq '';
	push(@s, "$user_group<BR>\n");
      }
      push(@s, "</TD>\n<TD VALIGN=\"TOP\">$created</TD>\n",
	   "<TD VALIGN=\"TOP\">$expires</TD>\n</TR>\n");
    }
  }

  push(@s, '</TABLE>');

  return \@s;
}

1;

__END__

# Documentation - try 'pod2text AuthzCache'

=head1 NAME

Apache::AuthzCache - mod_perl Cache Authorization Module

=head1 SYNOPSIS

 <Directory /foo/bar>