view release on metacpan or  search on metacpan

lib/Lemonldap/NG/Portal/Lib/Net/LDAP.pm  view on Meta::CPAN

use Lemonldap::NG::Portal::Main::Constants ':all';
use Net::LDAP::Control::PasswordPolicy;
use Encode;
use Scalar::Util 'weaken';
use IO::Socket::Timeout;
use Net::LDAP qw(LDAP_PP_PASSWORD_EXPIRED LDAP_PP_ACCOUNT_LOCKED
  LDAP_PP_CHANGE_AFTER_RESET LDAP_PP_PASSWORD_MOD_NOT_ALLOWED
  LDAP_PP_MUST_SUPPLY_OLD_PASSWORD LDAP_PP_INSUFFICIENT_PASSWORD_QUALITY
  LDAP_PP_PASSWORD_TOO_SHORT LDAP_PP_PASSWORD_TOO_YOUNG
  LDAP_PP_PASSWORD_IN_HISTORY );

use utf8;

our $VERSION = '2.23.0';

# INITIALIZATION

# Build a Net::LDAP object using parameters issued from $portal
sub new {
    my ( $class, $args ) = @_;
    my $portal = $args->{p}    or die "$class: p argument is required!";
    my $conf   = $args->{conf} or die "$class: conf argument is required!";
    my ( $self, @servers, %tlsParams );
    my $useStartTls = 0;

    foreach my $server ( split /[\s,]+/, $conf->{ldapServer} ) {
        if ( $server =~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) {
            $useStartTls = 1;
            $server      = $1;
            %tlsParams   = split( /[&=]/, $2 || "" );
        }
        elsif ( $server =~ m{^(ldaps://[^/]+)/?\??(.*)$} ) {
            $useStartTls = 0;
            $server      = $1;
            %tlsParams   = split( /[&=]/, $2 || "" );
        }
        else {
            $useStartTls = 0;
        }
        push @servers, $server;
    }
    $tlsParams{cafile} ||= $conf->{ldapCAFile} if $conf->{ldapCAFile};
    $tlsParams{capath} ||= $conf->{ldapCAPath} if $conf->{ldapCAPath};
    $tlsParams{verify} ||= $conf->{ldapVerify} if $conf->{ldapVerify};
    $self = Net::LDAP->new(
        \@servers,
        onerror   => undef,
        keepalive => 1,
        %tlsParams,
        ( $conf->{ldapPort}    ? ( port    => $conf->{ldapPort} )    : () ),
        ( $conf->{ldapTimeout} ? ( timeout => $conf->{ldapTimeout} ) : () ),
        ( $conf->{ldapVersion} ? ( version => $conf->{ldapVersion} ) : () ),
        ( $conf->{ldapRaw}     ? ( raw     => $conf->{ldapRaw} )     : () ),
    );
    unless ($self) {
        $portal->logger->error( "LDAP initialization error: " . $@ );
        return 0;
    }
    elsif ( $Net::LDAP::VERSION < '0.64' ) {

        # CentOS7 has a bug in which IO::Socket::SSL will return a broken
        # socket when certificate validation fails. Net::LDAP does not catch
        # it, and the process ends up crashing.
        # As a precaution, make sure the underlying socket is doing fine:
        if (    $self->socket->isa('IO::Socket::SSL')
            and $self->socket->errstr < 0 )
        {
            $portal->logger->error(
                "LDAP SSL connection failed: " . $self->socket->errstr );
            return 0;
        }
    }
    bless $self, $class;

    # Set socket timeouts
    my $socket = $self->socket;
    IO::Socket::Timeout->enable_timeouts_on($socket);
    $socket->read_timeout( $conf->{ldapIOTimeout} );
    $socket->write_timeout( $conf->{ldapIOTimeout} );

    if ($useStartTls) {
        my $mesg = $self->start_tls(%tlsParams);
        if ( $mesg->code ) {
            $portal->logger->error( 'LDAP StartTLS failed: ' . $mesg->error );
            return 0;
        }
    }
    $self->{portal} = $portal;
    $self->{conf}   = $conf;
    weaken $self->{portal};

    # Setting default LDAP password storage encoding to utf-8
    return $self;
}

# RUNNING METHODS

## @method Net::LDAP::Message bind(string dn, hash args)
# Reimplementation of Net::LDAP::bind(). Connection is done :
# - with $dn and $args->{password} as dn/password if defined,
# - or with Lemonldap::NG account,
# - or with an anonymous bind.
# @param $dn LDAP distinguish name
# @param %args See Net::LDAP(3) manpage for more
# @return Net::LDAP::Message
sub bind {
    my ( $self, $dn, %args ) = @_;
    my $mesg;

    $self->{portal}->logger->debug("Call bind for $dn") if $dn;
    unless ($dn) {
        $dn = $self->{conf}->{managerDn};
        $args{password} =
          decode( 'utf-8', $self->{conf}->{managerPassword} );
    }
    if ( $dn && $args{password} ) {
        if ( $self->{conf}->{ldapPwdEnc} ne 'utf-8' ) {
            eval {
                my $tmp = encode(
                    $self->{conf}->{ldapPwdEnc},
                    decode( 'utf-8', $args{password} )
                );
                $args{password} = $tmp;
            };
            print STDERR "$@\n" if ($@);