view release on metacpan or  search on metacpan

AuthDigest.pm  view on Meta::CPAN

package Apache::AuthDigest;

use Apache::Constants qw(OK DECLINED AUTH_REQUIRED DECLINE_CMD);
use Apache::File;
use Apache::Log;
use Apache::ModuleConfig;

use Apache::AuthDigest::API;

use DynaLoader;
use strict;

our $VERSION = '0.022';
our @ISA = qw(DynaLoader);

__PACKAGE__->bootstrap($VERSION);

sub handler {

  my $r = Apache::AuthDigest::API->new(shift);

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

  if (Apache->module('mod_digest.c')) {
    $log->info('Apache::AuthDigest - deferring to mod_digest');

    return DECLINED;
  }

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

  my ($status, $response) = $r->get_digest_auth_response;

  return $status unless $status == OK;

  my $password_file = $cfg->{_password_file};

  my $fh = Apache::File->new($password_file);

  unless ($fh) {
    $log->error("Apache::AuthDigest - could not open ",
                 "password file '$password_file'");

    return DECLINED;
  }

  my $digest = get_user_credentials($r->user, $r->auth_name, $fh);

  unless ($digest) {
    $log->error("Apache::AuthDigest - user '", $r->user,
                "' not found in password file '$password_file'");

    $r->note_digest_auth_failure;
    return AUTH_REQUIRED;
  }

  return OK if $r->compare_digest_response($response, $digest);

  $log->error("Apache::AuthDigest - user '", $r->user,
              "' password mismatch");

  $r->note_digest_auth_failure;
  return AUTH_REQUIRED;
}

sub get_user_credentials {

  my ($user, $realm, $fh) = @_;

  my ($username, $userrealm, $digest) = ();

  while (my $line = <$fh>) {
    ($username, $userrealm, $digest) = split /:/, $line;

    last if ($user eq $username && $realm eq $userrealm);

    $digest = undef;  # in case we fall through
  }

  chomp $digest;

  return $digest;
}


sub AuthDigestFile ($$$) {

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

  return DECLINE_CMD if Apache->module('mod_digest.c');

  die "Invalid AuthDigestFile $arg!" unless -f $arg;

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

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

  my $class = shift;
  my $self  = { _password_file => undef };

  return bless $self, $class;
}

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

  my ($parent, $current) = @_;

  my %new = (%$parent, %$current);

  return bless \%new, ref($parent);
}

1;

__END__

=head1 NAME

Apache::AuthDigest - reimplementation of mod_digest.c in Perl

=head1 SYNOPSIS

  PerlModule Apache::AuthDigest

  <Location /protected>
    PerlAuthenHandler Apache::AuthDigest
    Require valid-user
    AuthType Digest
    AuthName "cookbook"
    AuthDigestFile .htdigest
  </Location>

=head1 DESCRIPTION

Apache::AuthDigest is a reimplementation of mod_digest,
the standard Apache module that implements Digest authentication.
For more information on Digest authentication, see RFC 2617:
  ftp://ftp.isi.edu/in-notes/rfc2617.txt

To do this, Apache::AuthDigest uses an API provided by
Apache::AuthDigest::API, which is included in this distribution.
see the Apache::AuthDigest::API manpage if you want to implement
a Digest authentication scheme that uses something other than
a flat file.

=head1 EXAMPLE

The configuration for Apache::AuthDigest is relatively simple:

  PerlModule Apache::AuthDigest

  <Location /protected>
    PerlAuthenHandler Apache::AuthDigest
    Require valid-user
    AuthType Digest
    AuthName "cookbook"
    AuthDigestFile .htdigest