view release on metacpan or  search on metacpan

Session/Session.pm  view on Meta::CPAN

package Apache::AuthDigest::API::Session;

use Apache::Log;
use Apache::ModuleConfig;

use Apache::AuthDigest::API;

use 5.006;
use DynaLoader;

use strict;

our $VERSION = '0.01';
our @ISA = qw(DynaLoader Apache::AuthDigest::API);

__PACKAGE__->bootstrap($VERSION);

sub note_digest_auth_failure {

  my $r = shift;

  my $log = $r->server->log;

  my $cfg = Apache::ModuleConfig->get($r, __PACKAGE__);

  my $key = $cfg->{_session};

  my $nonce = $r->notes($key);

  unless ($nonce) {
    $log->info('Apache::AuthDigest::API::Session - no session found for ',
               "session key $key, using default request time instead");

    return $r->SUPER::note_digest_auth_failure;
  }

  $log->info("Apache::AuthDigest::API::Session - using notes() key $key ",
             "with session $nonce");

  my $auth_name = $r->auth_name;
  my $header_type = $r->proxyreq ? 'Proxy-Authenticate' : 'WWW-Authenticate';

  my $header_info = qq!Digest realm="$auth_name", nonce="$nonce"!;
                       

  $r->err_headers_out->set($header_type => $header_info);
}

sub compare_digest_response {

  my $r = shift;

  my $rc = $r->SUPER::compare_digest_response(@_);

  return unless $rc;

  my ($key, $session) = $r->get_session;

  $r->notes($key => $session);

  return $rc;
}

sub set_session {

  my ($r, $session) = @_;

  my $log = $r->server->log;

  my $cfg = Apache::ModuleConfig->get($r, __PACKAGE__);

  my $key = $cfg->{_session};

  $r->notes($key => $session);
}

sub get_session {

  my $r = shift;

  my $log = $r->server->log;

  my $cfg = Apache::ModuleConfig->get($r, __PACKAGE__);

  my $key = $cfg->{_session};

  my $response = $r->parse_digest_header;

  return ($key, $response->{nonce});

}

sub DigestSessionKey ($$$) {

  my ($cfg, $parms, $arg) = @_;

  $cfg->{_session} = $arg;
}

sub DIR_CREATE {
  # Initialize an object instead of using the mod_perl default.

  my $class = shift;
  my %self  = ();

  $self{_session} = 'AuthDigestSession';

  return bless \%self, $class;
}

sub DIR_MERGE {
  # Allow the subdirectory to inherit the configuration
  # of the parent, while overriding with anything more specific.