File: //usr/share/perl5/vendor_perl/Amavis/LDAP/Connection.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::LDAP::Connection;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';
use Net::LDAP;
use Net::LDAP::Util;
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
$have_sasl $ldap_sys_default);
$VERSION = '2.412';
@ISA = qw(Exporter);
$have_sasl = eval { require Authen::SASL };
}
use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log do_log_safe);
BEGIN {
# must be in a separate BEGIN block to be able to see imported symbols
$ldap_sys_default = {
hostname => 'localhost',
localaddr => undef,
port => undef, # 389 or 636, default provided by Net::LDAP
scheme => undef, # 'ldaps' or 'ldap', depending on hostname
version => 3,
timeout => 120,
deref => 'find',
bind_dn => undef,
bind_password => undef,
tls => 0,
verify => 'none',
sslversion => 'tlsv1',
clientcert => undef,
clientkey => undef,
cafile => undef,
capath => undef,
sasl => 0,
sasl_mech => undef, # space-separated list of mech names
sasl_auth_id => undef,
};
1;
}
sub new {
my($class,$default) = @_;
my $self = bless { ldap => undef }, $class;
$self->{incarnation} = 1;
for (qw(hostname localaddr port scheme inet6 version timeout
base scope deref bind_dn bind_password
tls verify sslversion clientcert clientkey cafile capath
sasl sasl_mech sasl_auth_id)) {
# replace undefined attributes with user values or defaults
$self->{$_} = $default->{$_} if !defined($self->{$_});
$self->{$_} = $ldap_sys_default->{$_} if !defined($self->{$_});
}
if (!defined $self->{scheme}) {
$self->{scheme} = $self->{hostname} =~ /^ldaps/i ? 'ldaps' : 'ldap';
}
$self;
}
sub ldap { # get/set ldap handle
my $self = shift;
!@_ ? $self->{ldap} : ($self->{ldap}=shift);
}
sub DESTROY {
my $self = $_[0]; local($@,$!,$_);
do_log_safe(5,"Amavis::LDAP::Connection DESTROY called");
# ignore failure, make perlcritic happy
eval { $self->disconnect_from_ldap } or 1;
}
sub incarnation { my $self = $_[0]; $self->{incarnation} }
sub in_transaction { 0 }
sub begin_work {
my $self = $_[0];
do_log(5,"ldap begin_work");
$self->ldap or $self->connect_to_ldap;
}
sub connect_to_ldap {
my $self = $_[0];
my($bind_err,$start_tls_err);
do_log(3,"Connecting to LDAP server");
my $hostlist = ref $self->{hostname} eq 'ARRAY' ?
join(", ",@{$self->{hostname}}) : $self->{hostname};
do_log(4,"connect_to_ldap: trying %s", $hostlist);
my $ldap = Net::LDAP->new($self->{hostname},
localaddr => $self->{localaddr},
port => $self->{port},
scheme => $self->{scheme},
version => $self->{version},
timeout => $self->{timeout},
keepalive => 1, # since Net::LDAP 0.53
# remaining keepalive* options need Socket::Linux and a
# patch at [rt.cpan.org #83039], otherwise are ignored
keepalive_idle => 240,
keepalive_interval => 30,
keepalive_probe => 10,
);
if (!$ldap) { # connect failed
do_log(-1,"connect_to_ldap: unable to connect to host %s", $hostlist);
} else {
do_log(3,"connect_to_ldap: connected to %s", $hostlist);
# $ldap->debug(12); # debug output goes to STDERR
if ($self->{tls}) { # TLS required
my $mesg = $ldap->start_tls(verify => $self->{verify},
sslversion => $self->{sslversion},
clientcert => $self->{clientcert},
clientkey => $self->{clientkey},
cafile => $self->{cafile},
capath => $self->{capath});
if ($mesg->code) { # start TLS failed
my $err = $mesg->error_name;
do_log(-1,"connect_to_ldap: start TLS failed: %s", $err);
$self->ldap(undef);
$start_tls_err = 1;
} else { # started TLS
do_log(3,"connect_to_ldap: TLS version %s enabled", $mesg);
}
}
if ($self->{bind_dn} || $self->{sasl}) { # bind required
my $sasl;
my $passw = $self->{bind_password};
if ($self->{sasl}) { # using SASL to authenticate?
$have_sasl or die "connect_to_ldap: SASL requested but no Authen::SASL";
$sasl = Authen::SASL->new(mechanism => $self->{sasl_mech},
callback => { user => $self->{sasl_auth_id},
pass => $passw } );
}
my $mesg = $ldap->bind($self->{bind_dn},
$sasl ? (sasl => $sasl)
: defined $passw ? (password => $passw) : ());
$passw = 'X' x length($passw) if defined $passw; # can't hurt
if ($mesg->code) { # bind failed
my $err = $mesg->error_name;
do_log(-1,"connect_to_ldap: bind failed: %s", $err);
$self->ldap(undef);
$bind_err = 1;
} else { # bind succeeded
do_log(3,"connect_to_ldap: bind %s succeeded", $self->{bind_dn});
}
}
}
$self->ldap($ldap); $self->{incarnation}++;
$ldap or die "connect_to_ldap: unable to connect";
if ($start_tls_err) { die "connect_to_ldap: start TLS failed" }
if ($bind_err) { die "connect_to_ldap: bind failed" }
section_time('ldap-connect');
$self;
}
sub disconnect_from_ldap {
my $self = $_[0];
return if !$self->ldap;
do_log(4,"disconnecting from LDAP");
$self->ldap->disconnect;
$self->ldap(undef);
1;
}
sub do_search {
my($self,$base,$scope,$filter) = @_;
my($result,$error_name);
$self->ldap or die "do_search: ldap not available";
do_log(5,'lookup_ldap: searching base="%s", scope="%s", filter="%s"',
$base, $scope, $filter);
eval {
$result = $self->{ldap}->search(base => $base,
scope => $scope,
filter => $filter,
deref => $self->{deref},
);
if ($result->code) {
$error_name = $result->error_name;
if ($error_name eq 'LDAP_NO_SUCH_OBJECT') {
# probably alright, e.g. a foreign %d
do_log(4, 'do_search failed in "%s": %s', $base, $error_name);
} else {
die $error_name."\n";
}
}
1;
} or do {
my $err = $@ ne '' ? $@ : "errno=$!"; chomp $err;
die $err if $err =~ /^timed out\b/; # resignal timeout
if ($err !~ /^LDAP_/) {
die "do_search: $err";
} elsif ($error_name !~ /^LDAP_(?:BUSY|UNAVAILABLE|UNWILLING_TO_PERFORM|
TIMEOUT|SERVER_DOWN|CONNECT_ERROR|OTHER|
LOCAL_ERROR|OPERATIONS_ERROR)\z/x) {
die "do_search: failed: $error_name\n";
} else { # LDAP related error, worth retrying
do_log(0, "NOTICE: do_search: trying again: %s", $error_name);
$self->disconnect_from_ldap;
$self->connect_to_ldap;
$self->ldap or die "do_search: reconnect failed";
do_log(5,
'lookup_ldap: searching (again) base="%s", scope="%s", filter="%s"',
$base, $scope, $filter);
eval {
$result = $self->{ldap}->search(base => $base,
scope => $scope,
filter => $filter,
deref => $self->{deref},
);
if ($result->code) { die $result->error_name, "\n"; }
1;
} or do {
my $err = $@ ne '' ? $@ : "errno=$!"; chomp $err;
$self->disconnect_from_ldap;
die $err if $err =~ /^timed out\b/; # resignal timeout
die "do_search: failed again, $err";
};
};
};
$result;
}
1;