view release on metacpan or  search on metacpan

lib/Footprintless/Plugin/Ldap/Ldap.pm  view on Meta::CPAN

use parent qw(Footprintless::MixableBase);

use overload q{""} => 'to_string', fallback => 1;

use Carp;
use Footprintless::Mixins qw(
    _entity
);
use Log::Any;
use Net::LDAP;
use Net::LDAP::Constant qw(LDAP_NO_SUCH_OBJECT);
use Net::LDAP::LDIF;
use Net::LDAP::Util;
use Time::HiRes qw(gettimeofday tv_interval);

my $logger = Log::Any->get_logger();

# https://tools.ietf.org/html/rfc2251#section-4.5.1
# If the client does not want any attributes returned, it can specify
# a list containing only the attribute with OID "1.1"
use constant NO_ATTRIBUTES => ['1.1'];

sub add {
    my ( $self, $entry ) = @_;
    croak('not connected') unless ( $self->{connection} );

    $logger->tracef( 'adding %s', $entry->dn() );
    my $message = $self->{connection}->add($entry);
    $message->code() && croak( $message->error() );

    return $self;
}

sub add_or_update {
    my ( $self, $entry ) = @_;

    eval { $self->add($entry); };
    if ($@) {
        $self->update($entry);
    }

    return $self;
}

sub base_dn {
    my ( $self, @rdns ) = @_;
    my $dn = $self->{default_base};
    foreach my $rdn (@rdns) {
        $dn = "$rdn,$dn";
    }
    return $dn;
}

sub bind {
    my ( $self, $dn, %options ) = @_;
    croak('not connected') unless ( $self->{connection} );

    if ( !$dn ) {

        # binding with instance credentials
        $dn      = $self->{bind_dn};
        %options = %{ $self->{bind_options} };
    }

    if ($dn) {
        my $result = $self->{connection}->bind( $dn, %options );
        $result->code() && croak( "unable to authenticate to $self:\n\t" . $result->error() );
    }
    else {
        my $result = $self->{connection}->bind();
        $result->code() && croak( "unable to bind anonymously:\n\t" . $result->error() );
    }

    return $self;
}

sub connect {
    my ( $self, %connect_options ) = @_;

    return if ( $self->{connection} );

    my ( $hostname, $port );
    if ( $self->{tunnel_hostname} ) {
        $self->{tunnel} = $self->{factory}->tunnel(
            $self->{coordinate},
            destination_hostname => $self->{tunnel_destination_hostname} || $self->{hostname},
            destination_port => $self->{port}
        );
        $self->{tunnel}->open();
        $hostname = $self->{tunnel}->get_local_hostname() || 'localhost';
        $port = $self->{tunnel}->get_local_port();
    }
    else {
        $hostname = $self->{hostname};
        $port     = $self->{port};
    }

    $logger->debugf( 'connecting to [%s:%s]', $hostname, $port );
    $self->{connection} = (
        $self->{secure}
        ? Net::LDAPS->new( $hostname, port => $port, %connect_options )
        : Net::LDAP->new( $hostname, port => $port, %connect_options )
        )
        || croak("unable to connect");

    if ( $self->{tunnel_hostname} ) {

        # Since tunnels give the illusion of a successful connection
        # we will attempt a bind to see if we are really connected.
        my $result = $self->{connection}->bind();
        if ( $result->code() == 1 ) {
            $self->disconnect();
            croak( "unable to connect through tunnel:\n\t" . $result->error() );
        }

        # We do not unbind since some ldap servers do not allow subsequent
        # bind operations (https://metacpan.org/pod/Net::LDAP#unbind)
    }

    return $self;