view release on metacpan or  search on metacpan

lib/Apache2/AuthCookieLDAP.pm  view on Meta::CPAN

package Apache2::AuthCookieLDAP;

# Apache2::AuthCookieLDAP
#
# An Apache2::AuthCookie backend for LDAP based authentication
#
# Author: Kirill Solomko <ksolomko@cpan.org>

use strict;
use warnings;
use 5.010_000;
our $VERSION = '1.15';

use Apache2::AuthCookie;
use base qw(Apache2::AuthCookie);

use Apache2::Connection;
use Apache2::RequestRec;
use Apache2::Log;
use Apache2::Const -compile => qw(:log);
use APR::Const -compile     => qw(:error ENOTIME SUCCESS);

use English qw(-no_match_vars);

use Digest::MD5 qw(md5_hex);
use Crypt::CBC;
use Crypt::DES;

use Net::LDAP;

use constant CIPHER_TYPES => qw(DES IDEA Blowfish Blowfish_PP);
use constant LOG_LEVELS   => {
    emerg  => Apache2::Const::LOG_EMERG,
    alert  => Apache2::Const::LOG_ALERT,
    crit   => Apache2::Const::LOG_CRIT,
    err    => Apache2::Const::LOG_ERR,
    warn   => Apache2::Const::LOG_WARNING,
    notice => Apache2::Const::LOG_NOTICE,
    info   => Apache2::Const::LOG_INFO,
    debug  => Apache2::Const::LOG_DEBUG
};

use constant NULL               => q{};
use constant C_SECRET_KEY       => '_SecretKey';
use constant C_SESSION_LIFETIME => '_SessionLifetime';
use constant C_LDAPURI          => '_LDAPURI';
use constant C_BASE             => '_Base';
use constant C_BINDDN           => '_BindDN';
use constant C_BINDPW           => '_BindPW';
use constant C_FILTER           => '_Filter';
use constant C_CIPHER           => '_Cipher';
use constant C_DEBUG            => '_Debug';
use constant C_DEBUG_LOGLEVEL   => '_DebugLogLevel';
use constant C_ERROR_LOGLEVEL   => '_ErrorLogLevel';

my %CONFIG_DEFAULT = (
    C_SECRET_KEY,     undef,          C_SESSION_LIFETIME, '00-24-00-00',
    C_LDAPURI,        undef,          C_BASE,             undef,
    C_BINDDN,         undef,          C_BINDPW,           undef,
    C_FILTER,         '(uid=%USER%)', C_CIPHER,           'des',
    C_DEBUG_LOGLEVEL, 'alert',        C_ERROR_LOGLEVEL,   'err',
    C_DEBUG,          0,
);

my $ldap_handler;
my %config_data;
my %ciphers;
my $DEBUG = C_DEBUG;

#----------------------------------------------------------------------
sub cipher {
    my ( $self, $r ) = @_;

    my $auth_name  = $r->auth_name;
    my $cipher     = $self->config( $r, C_CIPHER );
    my $cipher_key = $auth_name . ':' . lc($cipher);

    unless ( exists $ciphers{$cipher_key} ) {
        my $secret_key = $self->config( $r, C_SECRET_KEY );
        foreach my $cipher_type (CIPHER_TYPES) {
            next unless lc($cipher_type) eq $cipher;
            $ciphers{$cipher_key} = Crypt::CBC->new(
                -key    => $secret_key,
                -cipher => $cipher_type
            );
        }
    }
    exists $ciphers{$cipher_key}
      ? return $ciphers{$cipher_key}
      : $self->fatal( $r, "Wrong cipher $cipher" );
    return NULL;
}

sub config {
    my ( $self, $r, $req_key ) = @_;

    return unless defined $req_key;

    if ( keys %config_data ) {
        exists $config_data{$req_key}
          ? return $config_data{$req_key}
          : return NULL;
    }

    my $auth_name = $r->auth_name;
    foreach my $key ( keys %CONFIG_DEFAULT ) {
        my $default = $CONFIG_DEFAULT{$key};
        my $var     = $r->dir_config( $auth_name . $key );
        $config_data{$key} = defined $var ? $var : $default;
        if ( $key eq C_DEBUG ) {
            $DEBUG = $config_data{$key};
        }
    }

    foreach my $key ( ( C_DEBUG_LOGLEVEL, C_ERROR_LOGLEVEL ) ) {
        my $value = $config_data{$key};
        my $replace = $key eq C_DEBUG_LOGLEVEL ? 'alert' : 'err';
        unless ( exists LOG_LEVELS->{$value} ) {
            $self->fatal( $r,
                "Loglevel '$value' does not exist, using '$replace' instead" );
        }
    }

    my %use_files;
    foreach my $c_key ( C_BASE, C_BINDDN, C_BINDPW ) {
        my $c_var = $config_data{$c_key};
        if ( $c_var && $c_var =~ /^file:(.+):(.+)$/ ) {
            -f $1
              ? push @{ $use_files{$1} }, [ $c_key, $2 ]
              : $self->fatal( $r, "$c_key: check your file access: $1" );
        }
    }

    foreach my $file ( keys %use_files ) {
        open( my $lp_fh, $file )
          || $self->fatal( $r, "Cannot open $file: $!" );
        my $search_data = $use_files{$file};
        if ( $#$search_data != 1 ) {    # to be safe
            $self->fatal( $r, "Wrong regex pattern for file $file" );
        }

        while ( my $row = <$lp_fh> ) {