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

package Amavis::Out;
use strict;
use re 'taint';

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
  @EXPORT = qw(&mail_dispatch);
}

use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::Out::EditHeader;
use Amavis::Util qw(ll do_log);

sub mail_dispatch($$$;$) {
  my($msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;

  my $tmp_hdr_edits;
  my $saved_hdr_edits = $msginfo->header_edits;
  if (!c('enable_dkim_signing')) {
    # no signing
  } elsif ($initial_submission && $initial_submission eq 'Quar') {
    # do not attempt to sign messages on their way to a quarantine
  } else {
    # generate and add DKIM signatures
    my(@signatures) = Amavis::DKIM::dkim_make_signatures($msginfo,0);
    if (@signatures) {
      $msginfo->dkim_signatures_new(\@signatures);
      if (!defined($tmp_hdr_edits)) {
        $tmp_hdr_edits = Amavis::Out::EditHeader->new;
        $tmp_hdr_edits->inherit_header_edits($saved_hdr_edits);
      }
      for my $signature (@signatures) {
        my $s = $signature->as_string;
        local($1); $s =~ s{\015\012}{\n}gs; $s =~ s{\n+\z}{}gs;
        $s =~ s/^((?:DKIM|DomainKey)-Signature)://si;
        $tmp_hdr_edits->prepend_header($1, $s, 2);
      }
      if (c('enable_dkim_verification') &&
          grep($_->recip_is_local, @{$msginfo->per_recip_data})) {
        # it is too late to split a message now, add the A-R header field
        # if at least one recipient is local
        my $allowed_hdrs = cr('allowed_added_header_fields');
        if ($allowed_hdrs && $allowed_hdrs->{lc('Authentication-Results')}) {
          for my $h (Amavis::DKIM::generate_authentication_results(
                                                $msginfo, 0, \@signatures)) {
            $tmp_hdr_edits->prepend_header('Authentication-Results', $h, 1);
          }
        }
      }
    }
    $msginfo->header_edits($tmp_hdr_edits)  if defined $tmp_hdr_edits;
  }

  my $any_deliveries = 0;
  my $per_recip_data = $msginfo->per_recip_data;
  my $num_recips_notdone =
    scalar(grep(!$_->recip_done && (!$filter || &$filter($_)),
                @$per_recip_data));
  while ($num_recips_notdone > 0) {
    # a delivery method may be a scalar of a form protocol:socket_specs, or
    # a listref of such elements; if a list is provided, it is expected that
    # each entry will be using the same protocol name, otherwise behaviour
    # is unspecified - so just obtain the protocol name from the first entry
    #
    my(%protocols, $any_tempfail);
    for my $r (@$per_recip_data) {
      if (!$dsn_per_recip_capable) {
        my $recip_smtp_response = $r->recip_smtp_response;  # any 4xx code ?
        if (defined($recip_smtp_response) && $recip_smtp_response =~ /^4/) {
          $any_tempfail = $recip_smtp_response . ' (' . $r->recip_addr . ')';
        }
      }
      if (!$r->recip_done && (!$filter || &$filter($r))) {
        my $proto_sockname = $r->delivery_method;
        defined $proto_sockname
          or die "mail_dispatch: undefined delivery_method";
        !ref $proto_sockname || ref $proto_sockname eq 'ARRAY'
          or die "mail_dispatch: not a scalar or array ref: $proto_sockname";
        for (ref $proto_sockname ? @$proto_sockname : $proto_sockname) {
          local($1);
          if (/^([a-z][a-z0-9.+-]*):/si) { $protocols{lc($1)} = 1 }
          else { die "mail_dispatch: no recognized protocol name: $_" }
        }
      }
    }
    my(@unknown) =
      grep(!/^(?:smtp|lmtp|pipe|bsmtp|sql|local)\z/i, keys %protocols);
    !@unknown  or die "mail_dispatch: unknown protocol: ".join(', ',@unknown);

    if (!$dsn_per_recip_capable && defined $any_tempfail) {
      do_log(0, "temporary failures, giving up further deliveries: %s",
                $any_tempfail);
      my $smtp_resp =
        "451 4.5.0 Giving up due to previous temporary failures, id=" .
        $msginfo->log_id;
      # flag the remaining undelivered recipients as temporary failures
      for my $r (@$per_recip_data) {
        next if $r->recip_done;
        $r->recip_smtp_response($smtp_resp); $r->recip_done(1);
      }
      last;
    }

    # do one protocol per iteration only, so that we can bail out
    # as soon as some 4xx temporary failure is detected, avoiding
    # further deliveries which would lead to duplicate deliveries
    #
    if ($protocols{'smtp'} || $protocols{'lmtp'}) {
      require Amavis::Out::SMTP;
      Amavis::Out::SMTP::mail_via_smtp(@_);
      $any_deliveries = 1;  # approximation, will do for the time being
    } elsif ($protocols{'local'}) {
      require Amavis::Out::Local;
      Amavis::Out::Local::mail_to_local_mailbox(@_);
      $any_deliveries = 1;  # approximation, will do for the time being
    } elsif ($protocols{'pipe'}) {
      require Amavis::Out::Pipe;
      Amavis::Out::Pipe::mail_via_pipe(@_);
      $any_deliveries = 1;  # approximation, will do for the time being
    } elsif ($protocols{'bsmtp'}) {
      require Amavis::Out::BSMTP;
      Amavis::Out::BSMTP::mail_via_bsmtp(@_);
      $any_deliveries = 1;  # approximation, will do for the time being
    } elsif ($protocols{'sql'}) {
      $Amavis::extra_code_sql_quar && $Amavis::sql_storage
        or die "SQL quarantine code not enabled (1)";
      Amavis::Out::SQL::Quarantine::mail_via_sql(
                                        $Amavis::sql_dataset_conn_storage, @_);
      $any_deliveries = 1;  # approximation, will do for the time being
    }

    # are we done yet?
    my $num_recips_notdone_after =
      scalar(grep(!$_->recip_done && (!$filter || &$filter($_)),
                  @$per_recip_data));
    if ($num_recips_notdone_after >= $num_recips_notdone) {
      do_log(-2, "TROUBLE: Number of recipients (%d) not reduced, ".
                 "abandoning effort, proto: %s",
                 $num_recips_notdone_after, join(', ', keys %protocols) );
      last;
    }
    if ($num_recips_notdone_after > 0) {
      do_log(3, "Sent to %s recipients, %s still to go",
                $num_recips_notdone - $num_recips_notdone_after,
                $num_recips_notdone_after);
    }
    $num_recips_notdone = $num_recips_notdone_after;
  }
  # restore header edits if modified
  $msginfo->header_edits($saved_hdr_edits)  if defined $tmp_hdr_edits;

  $any_deliveries;  # (estimate) were any successful deliveries actually done?
}

1;