# 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;