view release on metacpan or  search on metacpan

lib/Apache/AuthPOP3.pm  view on Meta::CPAN

package Apache::AuthPOP3;

use warnings;
use strict;

our $VERSION = '0.02';

use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION} and 
                     $ENV{MOD_PERL_API_VERSION} >= 2);

BEGIN {
  if ($ENV{MOD_PERL}) {
    my @constants = qw(OK DECLINED HTTP_UNAUTHORIZED);
    if (MP2) {
      require Apache2::Access;      # for note_basic_auth_failure, get_basic_auth_pw, and requires
      require Apache2::RequestUtil; # for push_handlers, and dir_config
      require Apache2::RequestRec;  # for user, and filename
      require Apache2::Log;         # for log_error
      require Apache2::Const;
      Apache2::Const->import(-compile => @constants);
    } else {
      require Apache;
      require Apache::Constants;
      Apache::Constants->import(@constants);
    }
  }
}

use Net::POP3;
use Cache::FileCache;
use Digest::SHA1 qw(sha1_hex);

sub handler {
  my $r = shift;

  $r->push_handlers(PerlAuthzHandler => \&authorize);

  # check if MailHost config variable is present
  return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED() unless (my $mailhost = $r->dir_config('MailHost'));

  # get user's authentication credentials
  my ($res, $passwd_sent) = $r->get_basic_auth_pw;
  return $res if (MP2 and $res != Apache2::Const::OK() or !MP2 and $res != Apache::Constants::OK());
  my $user_sent = $r->user;

  my $reason = authenticate($mailhost, $user_sent, $passwd_sent);
  if ($reason) {
    $r->note_basic_auth_failure;
    $r->log_reason($reason, $r->filename);
    return MP2 ? Apache2::Const::HTTP_UNAUTHORIZED() : Apache::Constants::HTTP_UNAUTHORIZED();
  }

  return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}

sub authenticate {
  my ($mailhost, $user_sent, $passwd_sent) = @_;

  $user_sent and $passwd_sent or return 'either username or password is empty';

  # cache sha1-ed password
  my $cache = new Cache::FileCache({ 'namespace' => __PACKAGE__, 'default_expires_in' => 120 });
  my $passwd_cached_sha1 = $cache->get($user_sent);
  my $passwd_sent_sha1 = sha1_hex($passwd_sent);
  if (defined $passwd_cached_sha1) {
    return "user $user_sent: POP3 login failed" if $passwd_cached_sha1 ne $passwd_sent_sha1;
  } else {
    return "user $user_sent: POP3 login failed" unless Net::POP3->new($mailhost)->login($user_sent, $passwd_sent);
    $cache->set($user_sent, $passwd_sent_sha1);
  }

  return '';
}

sub authorize {
  my $r = shift;

  return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED() unless (my $requires = $r->requires);
  my $user_sent = $r->user;

  for my $entry (@$requires) {
    my ($requirement, @rest) = split /\s+/, $entry->{requirement};
    return MP2 ? Apache2::Const::OK() : Apache::Constants::OK() if (lc $requirement eq 'valid-user');

    if (lc $requirement eq 'user') {
      foreach (@rest) { 
        if ($user_sent eq $_) {

          # change the username seen by apache to the one defined in UserMap
          if (my $usermap = $r->dir_config('UserMap')) {
            my %usermap = split /\s*(?:=>|,)\s*/, $usermap;
            $r->user($usermap{$user_sent}) if defined $usermap{$user_sent};
          }
          return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
        }
      }
      $r->log_error("user $user_sent: invalid user");
    }

    $r->log_error("user $user_sent: failed requirement");
  }