# SPDX-License-Identifier: GPL-2.0-or-later

package Amavis::Lookup::LDAP;
use strict;
use re 'taint';

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
              $ldap_sys_default @ldap_attrs @mv_ldap_attrs);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
  import Amavis::LDAP::Connection ();

  $ldap_sys_default = {
    base           => undef,
    scope          => 'sub',
    query_filter   => '(&(objectClass=amavisAccount)(mail=%m))',
  };

  @ldap_attrs = qw(amavisLocal amavisMessageSizeLimit
    amavisVirusLover amavisSpamLover amavisUncheckedLover
    amavisBannedFilesLover amavisBadHeaderLover
    amavisBypassVirusChecks amavisBypassSpamChecks
    amavisBypassBannedChecks amavisBypassHeaderChecks
    amavisSpamTagLevel amavisSpamTag2Level amavisSpamKillLevel
    amavisSpamDsnCutoffLevel amavisSpamQuarantineCutoffLevel
    amavisSpamSubjectTag amavisSpamSubjectTag2 amavisSpamModifiesSubj
    amavisVirusQuarantineTo amavisSpamQuarantineTo amavisBannedQuarantineTo
    amavisUncheckedQuarantineTo amavisBadHeaderQuarantineTo
    amavisCleanQuarantineTo amavisArchiveQuarantineTo
    amavisAddrExtensionVirus amavisAddrExtensionSpam
    amavisAddrExtensionBanned amavisAddrExtensionBadHeader
    amavisWarnVirusRecip amavisWarnBannedRecip amavisWarnBadHeaderRecip
    amavisVirusAdmin amavisNewVirusAdmin amavisSpamAdmin
    amavisBannedAdmin amavisBadHeaderAdmin
    amavisBannedRuleNames amavisDisclaimerOptions
    amavisForwardMethod amavisSaUserConf amavisSaUserName
    amavisBlacklistSender amavisWhitelistSender
  );
  @mv_ldap_attrs = qw(amavisBlacklistSender amavisWhitelistSender);
  1;
}

use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::rfc2821_2822_Tools qw(make_query_keys split_address);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(untaint untaint_inplace snmp_count
                    ll do_log do_log_safe idn_to_ascii);

sub new {
  my($class,$default,$conn_h) = @_;
  my $self = bless {}, $class;
  $self->{conn_h} = $conn_h;  $self->{incarnation} = 0;
  for (qw(base scope query_filter)) {
    # replace undefined attributes with config values or defaults
    $self->{$_} = $default->{$_}          unless defined($self->{$_});
    $self->{$_} = $ldap_sys_default->{$_} unless defined($self->{$_});
  }
  $self;
}

sub DESTROY {
  my $self = $_[0]; local($@,$!,$_);
  do_log_safe(5,"Amavis::Lookup::LDAP DESTROY called");
}

sub init {
  my $self = $_[0];
  if ($self->{incarnation} != $self->{conn_h}->incarnation) {  # invalidated?
    $self->{incarnation} = $self->{conn_h}->incarnation;
    $self->clear_cache;  # db handle has changed, invalidate cache
  }
  $self;
}

sub clear_cache {
  my $self = $_[0];
  delete $self->{cache};
}

# The $addr may be a string of octets (assumed to be UTF-8 encoded)
# or a string of characters which gets first encoded to UTF-8 octets.
# International domain name (IDN) in $addr will be converted to ACE
# and lowercased. International domain names in LDAP are expected to be
# encoded in ASCII-compatible encoding (ACE).
#
sub lookup_ldap($$$%) {
  my($self,$addr,$get_all,%options) = @_;
  my(@result,@matchingkey,@tmp_result,@tmp_matchingkey);
  if (exists $self->{cache} && exists $self->{cache}->{$addr}) { # cached?
    my $c = $self->{cache}->{$addr}; @result = @$c if ref $c;
    @matchingkey = map('/cached/',@result); # will do for now, improve some day
#   if (!ll(5)) {
#     # don't bother preparing log report which will not be printed
#   } elsif (!@result) {
#     do_log(5,'lookup_ldap (cached): "%s" no match', $addr);
#   } else {
#     for my $m (@result) {
#       do_log(5, 'lookup_ldap (cached): "%s" matches, result=(%s)',
#         $addr, join(", ", map { sprintf("%s=>%s", $_,
#                                 !defined($m->{$_})?'-':'"'.$m->{$_}.'"'
#                                        ) } sort keys(%$m) ) );
#     }
#   }
    if (!$get_all) {
      return(!wantarray ? $result[0] : ($result[0], $matchingkey[0]));
    } else {
      return(!wantarray ? \@result   : (\@result,   \@matchingkey));
    }
  }
  my $is_local;  # not looked up in SQL and LDAP to avoid recursion!
  $is_local = Amavis::Lookup::lookup(0,$addr,
                                     grep(ref ne 'Amavis::Lookup::SQL' &&
                                          ref ne 'Amavis::Lookup::SQLfield' &&
                                          ref ne 'Amavis::Lookup::LDAP' &&
                                          ref ne 'Amavis::Lookup::LDAPattr',
                                          @{ca('local_domains_maps')}));
  my($keys_ref,$rhs_ref,@keys);
  ($keys_ref,$rhs_ref) = make_query_keys($addr,
                                   $ldap_lookups_no_at_means_domain,$is_local);
  @keys = @$keys_ref;
  unshift(@keys, '<>')  if $addr eq '';  # a hack for a null return path
  untaint_inplace($_) for @keys; # untaint keys
  $_ = Net::LDAP::Util::escape_filter_value($_) for @keys;
  # process %m
  my $filter = $self->{query_filter};
  my @filter_attr;  my $expanded_filter = '';
  for my $t ($filter =~ /\G( \( [^(=]+ = %m \) | [ \t0-9A-Za-z]+ | . )/xgs) {
    if ($t !~ m{ \( ([^(=]+) = %m \) }xs) { $expanded_filter .= $t }
    else {
      push(@filter_attr, $1);
      $expanded_filter .= '(|' . join('', map("($1=$_)", @keys)) . ')';
    }
  }
  $filter = $expanded_filter;
  # process %d
  my $base = $self->{base};
  if ($base =~ /%d/) {
    my($localpart,$domain) = split_address($addr);
    if ($domain) {
      untaint_inplace($domain); local($1);
      $domain =~ s/^\@?(.*?)\.*\z/$1/s;
      $domain = idn_to_ascii($domain);
      $base =~ s/%d/&Net::LDAP::Util::escape_dn_value($domain)/gse;
    }
  }
  # build hash of keys and array position
  my(%xref); my $key_num = 0;
  $xref{$_} = $key_num++ for @keys;
  #
  do_log(4,'lookup_ldap "%s", query keys: %s, base: %s, filter: %s',
    $addr,join(', ',map("\"$_\"",@keys)),$self->{base},$self->{query_filter});
  my $conn_h = $self->{conn_h};
  $conn_h->begin_work;  # (re)connect if not connected
  eval {
    snmp_count('OpsLDAPSearch');
    my(@entry);
    my $search_obj = $conn_h->do_search($base, $self->{scope}, $filter);
    @entry = $search_obj->entries  if $search_obj && !$search_obj->code;
    my(%mv_ldap_attrs) = map((lc($_), 1), @mv_ldap_attrs);
    for my $entry (@entry) {
      my $match = {};
      $match->{dn} = $entry->dn;
      for my $attr (@ldap_attrs) {
        my $value;
        do_log(9,'lookup_ldap: reading attribute "%s" from object', $attr);
        $attr = lc $attr;
        if ($mv_ldap_attrs{$attr}) {  # multivalued
          $value = $entry->get_value($attr, asref => 1);
        } else {
          $value = $entry->get_value($attr);
        }
        $match->{$attr} = $value  if defined $value;
      }
      my $pos;
      for my $attr (@filter_attr) {
        my $value = scalar($entry->get_value($attr));
        if (defined $value) {
          if (!exists $match->{'amavislocal'} && $value eq '@.') {
            # NOTE: see lookup_sql
            $match->{'amavislocal'} = undef;
            do_log(5, 'lookup_ldap: "%s" matches catchall, amavislocal=>undef',
                      $addr);
          }
          $pos = $xref{$value};
          last;
        }
      }
      my $key_str = join(", ",map {sprintf("%s=>%s",$_,!defined($match->{$_})?
        '-':'"'.$match->{$_}.'"')} keys(%$match));
      push(@tmp_result,      [$pos,{%$match}]); # copy hash
      push(@tmp_matchingkey, [$pos,$key_str]);
      last if !$get_all;
    }
    1;
  } or do {
    my $err = $@ ne '' ? $@ : "errno=$!";  chomp $err;
    do_log(-1,"lookup_ldap: %s", $err);
    die $err;
  };
  @result      = map($_->[1], sort {$a->[0] <=> $b->[0]} @tmp_result);
  @matchingkey = map($_->[1], sort {$a->[0] <=> $b->[0]} @tmp_matchingkey);
  if (!ll(4)) {
    # don't bother preparing log report which will not be printed
  } elsif (!@result) {
    do_log(4,'lookup_ldap, "%s" no match', $addr);
  } else {
    do_log(4,'lookup_ldap(%s) matches, result=(%s)',$addr,$_) for @matchingkey;
  }
  # save for future use, but only within processing of this message
  $self->{cache}->{$addr} = \@result;
  section_time('lookup_ldap');
  if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
  else           { !wantarray ? \@result   : (\@result,   \@matchingkey)   }
}

1;