# $Id: AuthzCache.pm,v 1.1 2000/06/23 20:53:10 cgilmore Exp cgilmore $
#
# Author          : Christian Gilmore
# Created On      : Fri Jun 23 10:15:36 CDT 2000
# Status          : In Development
# 
# PURPOSE
#    Group Authorization Cache
#
###############################################################################


# Package name
package Tivoli::Apache::AuthzCache;


# Required libraries
use strict;
use Apache::Constants qw(OK AUTH_REQUIRED DECLINED DONE);
use IPC::Cache;


# Global variables
$Tivoli::Apache::AuthzCache::VERSION = '0.01';


###############################################################################
###############################################################################
# _parse_groups: internal subroutine to split apart groups from a string
###############################################################################
###############################################################################
sub _parse_groups {
  my $groups = shift;
  my @groups = ();
  my $inquote = 0;
  my $length = length($groups);
  my $nextquote = 0;
  my $nextspace = 0;
  my $pos = 0;

  # shrink whitespace sets to just a single space
  $groups =~ s/\s+/ /g;
 
  # Extract groups from list
  while ($pos < $length) {
    $nextquote = index($groups, '"', $pos);
    $nextspace = index($groups, ' ', $pos);
    $nextspace = $length if $nextspace < 0;
    $nextquote = $length if $nextquote < 0;
    if ($inquote) {
      push(@groups, substr($groups, $pos, $nextquote - $pos));
      $pos = $nextquote + 2;
      $inquote = 0;
    } elsif ($nextspace < $nextquote) {
      push(@groups, substr($groups, $pos, $nextspace - $pos));
      $pos = $nextspace + 1;
    } else {
      $inquote = 1;
      $pos = $nextquote + 1;
    }
  }

  return @groups;
}

###############################################################################
###############################################################################
# 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 = ();

  # Get configuration
  my $casesensitive = $r->dir_config('AuthzCache_casesensitive') || 'on';
  my $cache_time_limit = $r->dir_config('AuthzCache_cache_time');
  my $auth_name = $r->auth_name;

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

  # 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 = _parse_groups($rest);
    }
  }

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

  # Create the cache if needed
  my $cache = IPC::Cache->new({ namespace => 'AuthGroups' });
  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");

    foreach my $req_group (@require_groups) {
      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
	  $r->log->debug("handler: user in cache and case-insensitive ",
			 "groups $req_group and $user_group match; ",
			 "returning OK and clearing PerlAuthzHandler");
	  $r->set_handlers(PerlAuthzHandler => undef);
	  # Per Eric Cholet
	  $r->set_handlers(PerlAuthzHandler => [\&OK]);
	  return OK;
	}
	elsif ($req_group eq $user_group) {
	  # Password matches so end stage
	  $r->log->debug("handler: user in cache and groups $req_group and ",
			 "$user_group match; ",
			 "returning OK and clearing PerlAuthzHandler");
	  $r->set_handlers(PerlAuthzHandler => undef);
	  return OK;
	}
      }
    }
  }
  
  # 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

  # Get username and group
  my $user_sent = $r->connection->user;
  my $group_sent = $r->subprocess_env("REMOTE_GROUP");
  $r->log->debug("manage_cache: username=$user_sent, group=$group_sent");

  # Get configuration
  my $casesensitive = $r->dir_config('AuthzCache_casesensitive') || 'on';
  my $cache_time_limit = $r->dir_config('AuthzCache_cache_time');
  my $auth_name = $r->auth_name;

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

  # Add the user to the cache
  my $cache = IPC::Cache->new({ namespace => 'AuthGroups' });
  $cache->set($user_sent, [($group_sent)], $cache_time_limit);
  $r->log->debug("manage_cache: added $user_sent:$group_sent to the cache");

  return OK;
}

1;

__END__

# $Log: AuthzCache.pm,v $
# Revision 1.1  2000/06/23 20:53:10  cgilmore
# Initial revision