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

package Amavis::Out::SMTP;
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';

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

use Time::HiRes qw(time);
use Encode ();
# use Authen::SASL;

use Amavis::Conf qw(:platform c cr ca $smtp_connection_cache_enable);
use Amavis::Lookup qw(lookup lookup2);
use Amavis::Out::EditHeader;
use Amavis::rfc2821_2822_Tools;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(untaint min max minmax ll do_log snmp_count
                    xtext_encode xtext_decode orcpt_encode orcpt_decode
                    idn_to_ascii mail_addr_idn_to_ascii
                    prolong_timer get_deadline
                    collect_equal_delivery_recips);

# simple OO wrapper around Mail::DKIM::Signer to provide a method 'print'
# and to convert \n to CRLF
#
sub new_dkim_wrapper {
  my($class, $handle,$strip_cr) = @_;
  bless { handle => $handle, strip_cr => $strip_cr }, $class;
}

sub close { 1 }

sub print {
  my $self = shift;
  my $buff = @_ == 1 ? $_[0] : join('',@_);
  do_log(-1,"WARN: Unicode string passed to Amavis::Out::SMTP::print : %s",
      $buff)  if utf8::is_utf8($buff);  # false on tainted, Perl 5.8 bug #32687
  $buff =~ tr/\015//d  if $self->{strip_cr};  # sanitize bare CR
  $buff =~ s{\n}{\015\012}gs;
  $self->{handle}->PRINT($buff);
}

# Add a log_id to the SMTP status text, insert a fabricated RFC 3463 enhanced
# status code if missing in an MTA response, see also RFC 5248
#
sub enhance_smtp_response($$$$$) {
  my($smtp_resp,$am_id,$mta_id,$dflt_enhcode,$cmd_name) = @_;
  local($1,$2,$3,$4); my $resp_msg;
  my($resp_code,$resp_more,$resp_enhcode) = ('451', ' ', '4.5.0');
  if (!defined($smtp_resp) || $smtp_resp eq '') {
    $smtp_resp = sprintf('No resp. to %s', $cmd_name);
  } elsif ($smtp_resp !~ /^[245]\d{2}/) {
    $smtp_resp = sprintf('Bad resp. to %s: %s', $cmd_name,$smtp_resp);
  } elsif ($smtp_resp =~ /^ (\d{3}) (\ |-|\z) [ \t]*
                            ([245] \. \d{1,3} \. \d{1,3})?
                            \s* (.*) \z/xs) {
    ($resp_code, $resp_more, $resp_enhcode, $resp_msg) = ($1, $2, $3, $4);
    if (!defined $resp_enhcode && $resp_code =~ /^[245]/) {
      my $c = substr($resp_code,0,1);
      $resp_enhcode = $dflt_enhcode; $resp_enhcode =~ s/^\d*/$c/;
    }
  }
  sprintf("%s%s%s from MTA(%s): %s",
          $resp_code, $resp_more, $resp_enhcode, $mta_id, $smtp_resp);
}

# Send mail using SMTP - single transaction
# (e.g. forwarding original mail or sending notification)
# May throw exception (die) if temporary failure (4xx) or other problem
#
# Multiple transactions may be necessary, either due to different delivery
# methods (IP address, port, SMTP vs. LMTP) or due to '452 Too many recipients'
#
sub mail_via_smtp(@) {
  my($msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;
  #
  # RFC 2033: LMTP protocol MUST NOT be used on the TCP port 25
  #
  # $initial_submission can be treated as a boolean, but for more detailed
  # needs it can be any of:  false: 0
  #                       or true: 'Quar', 'Dsn', 'Notif', 'AV', 'Arf'
  my $which_section = 'fwd_init';
  my $id = $msginfo->parent_mail_id;
  $id = $msginfo->mail_id . (defined $id ? "($id)" : "");
  my $sender_smtp = $msginfo->sender_smtp;
  my $logmsg = sprintf("%s %s", $id, $initial_submission?'SEND':'FWD');
  my($per_recip_data_ref, $proto_sockname) =
    collect_equal_delivery_recips($msginfo, $filter, qr/^(?:smtp|lmtp):/i);
  if (!$per_recip_data_ref || !@$per_recip_data_ref) {
    do_log(5, "%s from %s, nothing to do", $logmsg, $sender_smtp);
    return 1;
  }
  my $proto_sockname_displ = !ref $proto_sockname ? $proto_sockname
                               : '(' . join(', ',@$proto_sockname) . ')';
  my(@per_recip_data) = @$per_recip_data_ref;  undef $per_recip_data_ref;
  ll(4) && do_log(4, "about to connect to %s, %s from %s -> %s",
                     $proto_sockname_displ, $logmsg, $sender_smtp,
                     join(',', qquote_rfc2821_local(
                                map($_->recip_final_addr, @per_recip_data)) ));
  my $am_id = $msginfo->log_id;
  my $dsn_envid = $msginfo->dsn_envid;
  my $dsn_ret = $msginfo->dsn_ret;
  my $smtputf8 = $msginfo->smtputf8;  # SMTPUTF8 requested
  my $smtputf8_capable;               # SMTPUTF8 offered by MTA, RFC 6531
  my($relayhost, $protocol, $lmtp, $mta_id, @snmp_vars);
  my($smtp_session, $smtp_handle, $smtp_resp, $smtp_response);
  my($any_valid_recips, $any_tempfail_recips, $pipelining,
     $any_valid_recips_and_data_sent, $recips_done_by_early_fail,
     $in_datasend_mode, $dsn_capable, $auth_capable) = (0) x 8;
  my $mimetransport8bit_capable = 0;  # RFC 6152
  my(%from_options);
  # RFC 5321 (ex RFC 2821), section 4.5.3.2. Timeouts
  my $smtp_connect_timeout   =  35;
  my $smtp_helo_timeout      = 300;
  my $smtp_starttls_timeout  = 300;
  my $smtp_xforward_timeout  = 300;
  my $smtp_mail_timeout      = 300;
  my $smtp_rcpt_timeout      = 300;
  my $smtp_data_init_timeout = 120;
  my $smtp_data_xfer_timeout = 180;
  my $smtp_data_done_timeout = 600;
  my $smtp_quit_timeout      =  10;  # 300
  my $smtp_rset_timeout      =  20;
  # can appear anywhere in a pipelined command group:
  #   RSET, MAIL FROM, SEND FROM, SOML FROM, SAML FROM, RCPT TO, data
  # can only appear as the last command in a pipelined group:  --> flush
  #   EHLO, DATA, VRFY, EXPN, TURN, QUIT, NOOP,
  #   AUTH(RFC 4954), STARTTLS(RFC 3207), and all unknown commands

  # needed to implement dynamic_destination: a '*' in place of a host or port
  my($wildcard_implied_host, $wildcard_implied_port);
  my $conn = $msginfo->conn_obj;
  if ($conn) {
    my $host = $conn->client_ip;
    $wildcard_implied_host = $host  if defined($host) && $host ne '';
    my $port = $conn->socket_port;
    $wildcard_implied_port = $port+1  if defined($port) && $port =~ /^\d+\z/;
  }
  my($remaining_time, $deadline) = get_deadline($which_section, 1, 0);
  alarm(0);  # stop the timer
  my $err;
  eval {
    $which_section = 'fwd-connect';
    require Amavis::Out::SMTP::Session;
    $smtp_session = Amavis::Out::SMTP::Session->new($proto_sockname, $deadline,
                               $wildcard_implied_host, $wildcard_implied_port)
      or die "Can't establish an SMTP/LMTP session with $proto_sockname_displ";
    $smtp_handle = $smtp_session->smtp_handle;
    if ($smtp_handle) {
      $relayhost = $smtp_handle->socketname;
      $protocol = $smtp_handle->protocol;
      $lmtp = lc($protocol) eq 'lmtp' ? 1 : 0;  # RFC 2033
      $mta_id = sprintf("%s:%s", $protocol, $relayhost);
      @snmp_vars = !$initial_submission ?
        ('', 'Relay',  'Proto'.uc($protocol), 'Proto'.uc($protocol).'Relay')
      : ('', 'Submit', 'Proto'.uc($protocol), 'Proto'.uc($protocol).'Submit',
         'Submit'.$initial_submission);
      snmp_count('OutMsgs'.$_)  for @snmp_vars;
    }
    $dsn_capable = c('propagate_dsn_if_possible') &&
                   defined($smtp_session->supports('DSN'));         # RFC 3461
    $mimetransport8bit_capable =  # 8bit-MIMEtransport service extension
                   defined($smtp_session->supports('8BITMIME'));    # RFC 6152
    $smtputf8_capable =           # "Internationalized Email" service extension
                   $mimetransport8bit_capable &&
                   defined($smtp_session->supports('SMTPUTF8'));    # RFC 6531
    $pipelining =  defined($smtp_session->supports('PIPELINING'));  # RFC 2920
    do_log(3,"No announced PIPELINING support by MTA?")  if !$pipelining;
    ll(5) && do_log(5,"Remote host presents itself as: %s, handles %s",
                      $smtp_handle->domain,
                      join(', ', $dsn_capable ? 'DSN' : (),
                                 $pipelining  ? 'PIPELINING' : (),
                                 $mimetransport8bit_capable ? '8BITMIME' : (),
                                 $smtputf8_capable ? 'SMTPUTF8' : () ) );
    if ($lmtp && !$pipelining) {  # RFC 2033 requirements
      die "An LMTP server implementation MUST implement PIPELINING";
    }
    if ($lmtp && !defined($smtp_session->supports('ENHANCEDSTATUSCODES'))) {
      die "An LMTP server implementation MUST implement ENHANCEDSTATUSCODES";
    }

    if (!$smtputf8_capable || !$smtputf8) {
      # if SMTPUTF8 is not requested or if MTA is unable to handle
      # IDN with U-labels, and local part is all-ASCII, then we may
      # still get this delivered by converting a domain name
      # to ASCII-compatible encoding (ACE)
      if ($sender_smtp =~ /^ [\x00-\x7F]* \@ [^\@]* [^\x00-\x7F] [^\@]*\z/xs) {
        # localpart all-ASCII, domain is non-ASCII
        my $idn_ascii = mail_addr_idn_to_ascii($sender_smtp);
        do_log(2,'sender IDN encoded to ACE: %s -> %s',
                 $sender_smtp, $idn_ascii);
        $sender_smtp = $idn_ascii;
      }
      for my $r (@per_recip_data) {
        next  if $r->recip_done;
        my $rcpt_addr = $r->recip_final_addr;
        if ($rcpt_addr =~ /^ [\x00-\x7F]* \@ [^\@]* [^\x00-\x7F] [^\@]*\z/xs) {
          my $idn_ascii = mail_addr_idn_to_ascii($rcpt_addr);
          do_log(2,'recipient IDN encoded to ACE: %s -> %s',
                   $rcpt_addr, $idn_ascii);
          $rcpt_addr = $idn_ascii;
          $r->dsn_orcpt(join(';', orcpt_decode(';'.$r->recip_addr_smtp)))
            if !defined $r->dsn_orcpt;
          # N.B.: change recip_addr_modified(), not recip_final_addr() !
          $r->recip_addr_modified($rcpt_addr);
        }
      }
    }

    if ($smtputf8) {  # SMTPUTF8 handling was requested, RFC 6531
      #
      # RFC 6531 section 3.4: If the SMTPUTF8-aware SMTP client is aware
      # that neither the envelope nor the message being sent requires any
      # of the SMTPUTF8 extension capabilities, it SHOULD NOT supply the
      # SMTPUTF8 parameter with the MAIL command.
      #
      my($sender_8bit, $recips_8bit);
      $sender_8bit = 1  if $msginfo->sender_smtp =~ tr/\x00-\x7F//c;
      for my $r (@per_recip_data) {
        next  if $r->recip_done;
        $recips_8bit = 1  if $r->recip_final_addr =~ tr/\x00-\x7F//c;
      }

      if (!ll(5)) {
        # don't bother, just logging
      } elsif ($sender_8bit || $recips_8bit || $msginfo->header_8bit) {
        do_log(5,'SMTPUTF8 option requested and is needed, %s is non-ASCII',
                 join(' & ', $sender_8bit  ? 'sender' : (),
                             $recips_8bit  ? 'recip'  : (),
                             $msginfo->header_8bit ? 'header' : () ));
      } else {
        do_log(5,'SMTPUTF8 option requested but not needed');
      }

      if (!$smtputf8_capable) {
        # RFC 6531 sect 3.5: An SMTPUTF8-aware SMTP client MUST NOT send
        # an internationalized message to an SMTP server that does not
        # support SMTPUTF8.
        # 550 5.6.7 Non-ASCII addresses not permitted for that sender
        # 553 5.6.7 Non-ASCII addresses not permitted for that recipient
        # after DATA-dot:
        # 554 5.6.9 UTF-8 header message cannot be transmitted to one or more
        #   recipients, so the message must be rejected
        #
        if (!$sender_8bit && !$recips_8bit) {
          # mail addresses are all-ASCII, don't care for an 8bit header
          do_log(3,'SMTPUTF8 option requested but not offered, turning it off');
          $smtputf8 = 0;  # turn off if not needed
        }
      }
    }
    section_time($which_section);

    $which_section = 'fwd-xforward';
    my $cl_ip = $msginfo->client_addr;
    if (defined $cl_ip && $cl_ip ne '' &&
        defined($smtp_session->supports('XFORWARD'))) {
      $cl_ip = 'IPv6:'.$cl_ip  if $cl_ip =~ /:[0-9a-f]*:/i &&
                                  $cl_ip !~ /^IPv6:/i;
      my(%xfwd_supp_opt) = map((uc($_),1),
                               split(' ',$smtp_session->supports('XFORWARD')));
      my(@params) = map
        { my($n,$v) = @$_;
          # Postfix since version 20060610 uses xtext-encoded (RFC 3461)
          # strings in XCLIENT and XFORWARD attribute values, previous
          # versions expected plain text with neutered special characters;
          # see README_FILES/XFORWARD_README
          if (defined $v && $v ne '') {
            $v =~ s/[^\041-\176]/?/gs;  # isprint
            $v =~ s/[<>()\\";\@]/?/gs;  # other chars that are special in hdrs
                     # postfix/src/smtpd/smtpd.c NEUTER_CHARACTERS
            $v = xtext_encode($v);
            substr($v,255) = ''  if length($v) > 255;  # chop xtext, not nice
          }
          !defined $v || $v eq '' || !$xfwd_supp_opt{$n} ? () : ("$n=$v") }
        ( ['ADDR',$cl_ip],                ['NAME',$msginfo->client_name],
          ['PORT',$msginfo->client_port], ['PROTO',$msginfo->client_proto],
          ['HELO',$msginfo->client_helo], ['SOURCE',$msginfo->client_source],
          ['IDENT',$msginfo->queue_id] );
      $smtp_session->timeout(
        max(60,min($smtp_xforward_timeout,$deadline-time())));
      $smtp_handle->command('XFORWARD',@params);  #flush!
      $smtp_resp = $smtp_session->smtp_response;  # fetch response to XFORWARD
      if (!defined $smtp_resp || $smtp_resp eq '') {
        do_log(-1,"%s SMTP resp. to XFORWARD, dt: %.3f s",
                  !defined $smtp_resp ? 'No' : 'Empty',
                  time - $smtp_handle->last_io_event_tx_timestamp);
      } elsif ($smtp_resp !~ /^2/) {
        do_log(0,"Negative SMTP resp. to XFORWARD: %s", $smtp_resp);
      } else {  # success, $smtp_resp =~ /^2/
        do_log(3,"smtp resp to XFORWARD: %s", $smtp_resp);
      }
      section_time($which_section);
    }

    $which_section = 'fwd-auth';
    my $auth_user = $msginfo->auth_user;
    my $mechanisms = $smtp_session->supports('AUTH');
    if (!c('auth_required_out')) {
      do_log(3,"AUTH not needed, user='%s', MTA offers '%s'",
               $auth_user,$mechanisms);
    } elsif ($mechanisms eq '') {
      do_log(3,"INFO: MTA does not offer AUTH capability, user='%s'",
               $auth_user);
    } elsif (!defined $auth_user) {
      do_log(0,"INFO: AUTH needed for submission but AUTH data not available");
    } else {
      do_log(3,"INFO: authenticating %s, server supports AUTH %s",
               $auth_user,$mechanisms);
      $auth_capable = 1;
#     my $sasl = Authen::SASL->new(
#       'callback' => { 'user' => $auth_user, 'authname' => $auth_user,
#                       'pass' => $msginfo->auth_pass });
#     $smtp_handle->auth($sasl) or die "sending AUTH, user=$auth_user\n";#flush
      do_log(0,"Sorry, AUTH not supported in this version of amavisd!");
      section_time($which_section);
    }

    $which_section = 'fwd-pre-mail-from';
    $smtp_session->timeout(max(60,min($smtp_mail_timeout,$deadline-time())));
    my $fetched_mail_resp = 0;  my $fetched_rcpt_resp = 0;
    my $data_command_accepted = 0;
    if ($initial_submission && $dsn_capable && !defined($dsn_envid)) {
      # ENVID identifies transaction, not a message
      $dsn_envid = xtext_encode(sprintf("AM.%s.%s\@%s",
                     $msginfo->mail_id || $msginfo->log_id,
                     iso8601_utc_timestamp(time),
                     idn_to_ascii(c('myhostname')) ));
    }
    $from_options{'RET'} = $dsn_ret  if $dsn_capable && defined $dsn_ret;
    if ($dsn_capable && defined $dsn_envid) {
      # check for proper encoding (RFC 3461), just in case
      if ($dsn_envid =~ tr/ =\x00-\x1F//) {
        do_log(-1, "Prohibited character in ENVID: %s", $dsn_envid);
      } else {
        $from_options{'ENVID'} = $dsn_envid;
      }
    }

    my $submitter = $msginfo->auth_submitter;
    $from_options{'AUTH'} = xtext_encode($submitter)  # RFC 4954 (ex RFC 2554)
      if $auth_capable &&
         defined($submitter) && $submitter ne '' && $submitter ne '<>';

    if ($smtputf8 && $smtputf8_capable) {
      $from_options{'SMTPUTF8'} = undef;  # turn option *on*, no value
    }

    my $btype = $msginfo->body_type;
    if (defined $btype && $btype ne '') {
      $btype = uc $btype;
      if ($btype ne '7BIT' && $btype ne '8BITMIME') {
        do_log(-1,'requested BODY type %s is unknown/unsupported', $btype);
      } elsif ($mimetransport8bit_capable) {
        $from_options{'BODY'} = $btype;
      }
    }
    if (!$mimetransport8bit_capable &&
        defined $btype && $btype ne '' && uc $btype ne '7BIT') {
      do_log(-1,'requested BODY type is %s, but MTA does not announce '.
                '8bit-MIMEtransport capability', $btype);  # RFC 6152
      for my $r (@per_recip_data) {
        next  if $r->recip_done;
        $r->recip_smtp_response('550 5.6.3 Conversion to 7BIT required '.
                                'but not supported');
        $r->recip_remote_mta($relayhost); $r->recip_done(2);
      }
      $recips_done_by_early_fail = 1;
    } elsif ($smtputf8 &&
             !$smtputf8_capable && $sender_smtp =~ tr/\x00-\x7F//c) {
      do_log(1,'SMTPUTF8 option requested, not offered by MTA, '.
               'sender is non-ASCII: %s', $sender_smtp);
      for my $r (@per_recip_data) {
        next  if $r->recip_done;
        $r->recip_smtp_response('550 5.6.7 Non-ASCII addresses not permitted '.
                                'for sender');
        $r->recip_remote_mta($relayhost); $r->recip_done(2);
      }
      $recips_done_by_early_fail = 1;
    } else {
      $which_section = 'fwd-mail-from';
      $smtp_handle->mail($sender_smtp, %from_options);  # MAIL FROM
      # consider the transaction state unknown until we see a response
      $smtp_session->transaction_begins_unconfirmed; # also counts transactions
      if (!$pipelining) {
        $smtp_resp = $smtp_session->smtp_response;  $fetched_mail_resp = 1;
        if (!defined $smtp_resp || $smtp_resp eq '') {
          die sprintf("%s response to MAIL, dt: %.3f s\n",
                      !defined $smtp_resp ? 'No' : 'Empty',
                      time - $smtp_handle->last_io_event_tx_timestamp);
        } elsif ($smtp_resp =~ /^2/) {
          do_log(3, "smtp resp to MAIL: %s", $smtp_resp);
          $smtp_session->transaction_begins;  # transaction is active
        } else {  # failure
          do_log(1, "smtp resp to MAIL: %s", $smtp_resp);
          # transaction state unchanged, consider it unknown
          my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
                                                    '.1.0','MAIL FROM');
          for my $r (@per_recip_data) {
            next  if $r->recip_done;
            $r->recip_remote_mta($relayhost);
            $r->recip_remote_mta_smtp_response($smtp_resp);
            $r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
          }
          $recips_done_by_early_fail = 1;
        }
        section_time($which_section);
      }
    }

    $which_section = 'fwd-rcpt-to';
    $smtp_session->timeout(max(60,min($smtp_rcpt_timeout,$deadline-time())));
    my($skipping_resp, @per_recip_data_rcpt_sent);
    for my $r (@per_recip_data) {  # send recipient addresses
      next  if $r->recip_done;
      if (defined $skipping_resp) {
        $r->recip_smtp_response($skipping_resp); $r->recip_done(2);
        next;
      }
      # prepare to send a RCPT TO command
      my $raddr = qquote_rfc2821_local($r->recip_final_addr);
      if ($smtputf8 && !$smtputf8_capable && $raddr =~ tr/\x00-\x7F//c) {
        do_log(1,'SMTPUTF8 option requested, not offered by MTA, '.
                 'recipient is non-ASCII: %s', $raddr);
        $r->recip_smtp_response('553 5.6.7 Non-ASCII addresses '.
                                'not permitted for recipient');
        $r->recip_remote_mta($relayhost); $r->recip_done(2);
      } elsif (!$dsn_capable) {
        $smtp_handle->recipient($raddr);  # a barebones RCPT TO command
        push(@per_recip_data_rcpt_sent, $r);  # remember which recips were sent
      } else {  # include dsn options with a RCPT TO command
        my(@dsn_notify);  # implies a default when the list is empty
        my $dn = $r->dsn_notify;
        @dsn_notify = @$dn  if $dn && $msginfo->sender ne '';  # if nondefault
        if (c('terminate_dsn_on_notify_success')) {
          # we want to handle option SUCCESS locally
          if (grep($_ eq 'SUCCESS', @dsn_notify)) {  # strip out SUCCESS
            @dsn_notify = grep($_ ne 'SUCCESS', @dsn_notify);
            @dsn_notify = ('NEVER')  if !@dsn_notify;
            do_log(3,"stripped out SUCCESS, result: NOTIFY=%s",
                     join(',',@dsn_notify));
          }
        }
        my(%rcpt_options);
        $rcpt_options{'NOTIFY'} =
          join(',', map(uc($_),@dsn_notify))  if @dsn_notify;
        my($addr_type, $addr) =
          orcpt_encode($r->dsn_orcpt, $smtputf8 && $smtputf8_capable, 1);
        $rcpt_options{'ORCPT'} = $addr_type.';'.$addr  if defined $addr;
        $smtp_handle->recipient($raddr, %rcpt_options);  # RCPT TO
        push(@per_recip_data_rcpt_sent, $r);  # remember which recips were sent
      }
      if (!$pipelining) {  # must fetch responses to RCPT TO right away
        $smtp_resp = $smtp_session->smtp_response;  $fetched_rcpt_resp = 1;
        if (defined $smtp_resp && $smtp_resp ne '') {
          $r->recip_remote_mta($relayhost);
          $r->recip_remote_mta_smtp_response($smtp_resp);
          my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
                                                    '.1.0','RCPT TO');
          $r->recip_smtp_response($smtp_resp_ext);  # preliminary response
        }
        if (!defined $smtp_resp || $smtp_resp eq '') {
          die sprintf("%s response to RCPT (%s), dt: %.3f s\n",
                      !defined $smtp_resp ? 'No' : 'Empty',  $raddr,
                      time - $smtp_handle->last_io_event_tx_timestamp);
        } elsif ($smtp_resp =~ /^2/) {
          do_log(3, "smtp resp to RCPT (%s): %s", $raddr,$smtp_resp);
          $any_valid_recips++;
        } else {  # failure
          do_log(1, "smtp resp to RCPT (%s): %s", $raddr,$smtp_resp);
          if ($smtp_resp =~ /^452/) {  # too many recipients - see RFC 5321
            do_log(-1, 'Only %d recips sent in one go: "%s"',
                       $any_valid_recips, $smtp_resp)
                       if !defined $skipping_resp;
            $skipping_resp = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
                                                   '.5.3','RCPT TO');
          } elsif ($smtp_resp =~ /^4/) {
            $any_tempfail_recips++;
          }
          $r->recip_done(2);  # got a negative response to RCPT TO
        }
      }
    }
    section_time($which_section)  if !$pipelining;  # otherwise it just shows 0

    my $what_cmd;
    if (!@per_recip_data_rcpt_sent ||  # no recipients were sent
        $fetched_rcpt_resp && !$any_valid_recips) {  # no recipients accepted
      # it is known there are no valid recipients, don't go into DATA section
      do_log(0,"no valid recipients, skip data transfer");
      $smtp_session->timeout($smtp_rset_timeout);
      $what_cmd = 'RSET';  $smtp_handle->rset;  # send a RSET
      $smtp_session->transaction_ends_unconfirmed;
    } elsif ($fetched_rcpt_resp &&              # no pipelining
             $any_tempfail_recips && !$dsn_per_recip_capable) {
      # we must not proceed if mail did not came in as LMTP,
      # or we would generate mail duplicates on each delivery attempt
      do_log(-1,"mail_via_smtp: DATA skipped, tempfailed recips: %s",
                $any_tempfail_recips);
      $smtp_session->timeout($smtp_rset_timeout);
      $what_cmd = 'RSET';  $smtp_handle->rset;  # send a RSET
      $smtp_session->transaction_ends_unconfirmed;
    } else {  # pipelining, or we know we got a clearance to proceed
      $which_section = 'fwd-data-cmd';
      # pipelining in effect, or we have at least one valid recipient, go DATA
      $smtp_session->timeout(
        max(60,min($smtp_data_init_timeout,$deadline-time())));
      $smtp_handle->data;  #flush!  DATA
      $in_datasend_mode = 1;  # DATA command was sent (but not yet confirmed)
      if (!$fetched_mail_resp) {  # pipelining in effect, late response to MAIL
        $which_section = 'fwd-mail-pip';
        $smtp_session->timeout(
          max(60,min($smtp_mail_timeout,$deadline-time())));
        $smtp_resp = $smtp_session->smtp_response;  $fetched_mail_resp = 1;
        if (!defined $smtp_resp || $smtp_resp eq '') {
          die sprintf("%s response to MAIL (pip), dt: %.3f s\n",
                      !defined $smtp_resp ? 'No' : 'Empty',
                      time - $smtp_handle->last_io_event_tx_timestamp);
        } elsif ($smtp_resp =~ /^2/) {
          do_log(3, "smtp resp to MAIL (pip): %s", $smtp_resp);
          $smtp_session->transaction_begins;  # transaction is active
        } else {  # failure
          do_log(1, "smtp resp to MAIL (pip): %s", $smtp_resp);
          # transaction state unchanged, consider it unknown
          my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
                                         $am_id, $mta_id, '.1.0', 'MAIL FROM');
          for my $r (@per_recip_data) {
            next  if $r->recip_done;
            $r->recip_remote_mta($relayhost);
            $r->recip_remote_mta_smtp_response($smtp_resp);
            $r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
          }
          $recips_done_by_early_fail = 1;
        }
        section_time($which_section);
      }
      if (!$fetched_rcpt_resp) {  # pipelining in effect, late response to RCPT
        $which_section = 'fwd-rcpt-pip';
        $smtp_session->timeout(
          max(60,min($smtp_rcpt_timeout,$deadline-time())));
        for my $r (@per_recip_data_rcpt_sent) {  # only for those actually sent
          my $raddr = qquote_rfc2821_local($r->recip_final_addr);
          $smtp_resp = $smtp_session->smtp_response;  $fetched_rcpt_resp = 1;
          if (defined $smtp_resp && $smtp_resp ne '') {
            if ($r->recip_done) {  # shouldn't happen, unless MAIL FROM failed
              do_log(-1,"panic: recipient done, but got an ".
                        "smtp resp to RCPT (pip) (%s): %s",
                        $raddr,$smtp_resp)  if !$recips_done_by_early_fail;
              next;  # do not overwrite previous diagnostics
            }
            $r->recip_remote_mta($relayhost);
            $r->recip_remote_mta_smtp_response($smtp_resp);
            my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
                                           $am_id, $mta_id, '.1.0', 'RCPT TO');
            $r->recip_smtp_response($smtp_resp_ext);  # preliminary response
          }
          if (!defined $smtp_resp || $smtp_resp eq '') {
            die sprintf("%s response to RCPT (pip) (%s), dt: %.3f s\n",
                        !defined $smtp_resp ? 'No' : 'Empty',  $raddr,
                        time - $smtp_handle->last_io_event_tx_timestamp);
          } elsif ($smtp_resp =~ /^2/) {
            do_log(3, "smtp resp to RCPT (pip) (%s): %s", $raddr,$smtp_resp);
            $any_valid_recips++;
          } else {  # failure
            do_log(1, "smtp resp to RCPT (pip) (%s): %s", $raddr,$smtp_resp);
            if ($smtp_resp =~ /^452/) {  # too many recipients - see RFC 5321
              do_log(-1, 'Only %d recips sent in one go: "%s"',
                         $any_valid_recips, $smtp_resp)
                         if !defined $skipping_resp;
              $skipping_resp = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
                                                     '.5.3','RCPT TO');
            } elsif ($smtp_resp =~ /^4/) {
              $any_tempfail_recips++;
            }
            $r->recip_done(2);  # got a negative response to RCPT TO
          }
        }
        section_time($which_section);
      }
      $which_section = 'fwd-data-chkpnt'  if $pipelining;
      $smtp_session->timeout(
        max(60,min($smtp_data_init_timeout,$deadline-time())));
      $smtp_resp = $smtp_session->smtp_response;  # fetch response to DATA
      section_time($which_section);
      $data_command_accepted = 0;
      if (!defined $smtp_resp || $smtp_resp eq '') {
        do_log(-1,"%s SMTP resp. to DATA, dt: %.3f s",
                  !defined $smtp_resp ? 'No' : 'Empty',
                  time - $smtp_handle->last_io_event_tx_timestamp);
        $smtp_resp = sprintf("450 4.5.0 %s response to DATA",
                             !defined $smtp_resp ? 'No' : 'Empty');
      } elsif ($smtp_resp !~ /^3/) {
        do_log(0,"Negative SMTP resp. to DATA: %s", $smtp_resp);
      } else {  # success, $smtp_resp =~ /^3/
        $data_command_accepted = 1;
        do_log(3,"smtp resp to DATA: %s", $smtp_resp);
      }
      if (!$data_command_accepted) {
        $in_datasend_mode = 0;
        $smtp_session->timeout($smtp_rset_timeout);
        $what_cmd = 'RSET';  $smtp_handle->rset;  # send a RSET
        $smtp_session->transaction_ends_unconfirmed;
        # replace success responses to RCPT TO commands with a response to DATA
        for my $r (@per_recip_data_rcpt_sent) {  # only for those actually sent
          next  if $r->recip_done;  # skip those that failed at earlier stages
          $r->recip_remote_mta($relayhost);
          $r->recip_remote_mta_smtp_response($smtp_resp);
          my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
                                              $am_id, $mta_id, '.5.0', 'DATA');
          $smtp_response = $smtp_resp_ext  if !defined $smtp_response;
          $r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
        }
      } elsif (!$any_valid_recips) {  # pipelining and no recipients, in DATA
        do_log(2,"Too late, DATA accepted but no valid recips, send dummy");
        $which_section = 'fwd-dummydata-end';
        $smtp_session->timeout(
          max(60,min($smtp_data_done_timeout,$deadline-time())));
        $what_cmd = 'data-dot';
        $smtp_handle->dataend;  # .<CR><LF>  as required by RFC 2920: if a DATA
               # command was accepted the SMTP client should send a single dot
        $in_datasend_mode = 0; $smtp_session->transaction_ends_unconfirmed;
      } elsif ($any_tempfail_recips && !$dsn_per_recip_capable) {  # pipelining
        # we must not proceed if mail did not came in as LMTP,
        # or we would generate mail duplicates on each delivery attempt
        do_log(2,"Too late, DATA accepted but tempfailed recips, bail out");
        die "Bail out, DATA accepted but tempfailed recips, not an LMTP input";
      } else {  # all ok so far, we are in a DATA state and must send contents
        $which_section = 'fwd-data-hdr';
        my $hdr_edits = $msginfo->header_edits;
        $hdr_edits = Amavis::Out::EditHeader->new  if !$hdr_edits;
        $smtp_session->timeout(
          max(60,min($smtp_data_xfer_timeout,$deadline-time())));
        my($received_cnt,$file_position) =
          $hdr_edits->write_header($msginfo,$smtp_handle,!$initial_submission);
        if ($received_cnt > 100) {
          # loop detection required by RFC 5321 (ex RFC 2821) section 6.3
          # Do not modify the signal text, it gets matched elsewhere!
          die "Too many hops: $received_cnt 'Received:' header fields\n";
        }
        $which_section = 'fwd-data-contents';
        # a file handle or a string ref or MIME::Entity object
        my $msg = $msginfo->mail_text;
        my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
        $msg = $msg_str_ref  if ref $msg_str_ref;
        if (!defined $msg) {
          # empty mail
        } elsif (ref $msg eq 'SCALAR') {
          # do it in chunks, saves memory, cache friendly
          while ($file_position < length($$msg)) {
            $smtp_handle->datasend(substr($$msg,$file_position,16384));
            $file_position += 16384;  # may overshoot, no problem
          }
        } elsif ($msg->isa('MIME::Entity')) {
          $msg->print_body($smtp_handle);
        } else {
          my($nbytes,$buff);
          while (($nbytes = $msg->read($buff,3*16384)) > 0) {
            $smtp_handle->datasend($buff);
          }
          defined $nbytes or die "Error reading: $!";
        }
        section_time($which_section);

        $which_section = 'fwd-data-end';
        $smtp_session->timeout(
          max(60,min($smtp_data_done_timeout,$deadline-time())));
        $what_cmd = 'data-dot';
        $smtp_handle->dataend;  # .<CR><LF>
        $in_datasend_mode = 0; $smtp_session->transaction_ends_unconfirmed;
        $any_valid_recips_and_data_sent = 1;
        section_time($which_section)  if !$pipelining;  # otherwise it shows 0
      }
    }
    if ($pipelining && !$smtp_connection_cache_enable) {
      do_log(5,"smtp connection_cache disabled, sending QUIT");
      $smtp_session->quit;  #flush!   QUIT
      # can't be sure until we see a response, consider uncertain just in case
      $smtp_session->transaction_ends_unconfirmed;
    }
    $which_section = 'fwd-rundown-1';
    $smtp_resp = undef;
    if (!defined $what_cmd) {
      # not expecting a response?
    } elsif ($what_cmd ne 'data-dot') {  # must be a response to a RSET
      $smtp_resp = $smtp_session->smtp_response;  # fetch a response
      if (!defined $smtp_resp || $smtp_resp eq '') {
        die sprintf("%s SMTP response to %s, dt: %.3f s",
                    !defined $smtp_resp ? 'No' : 'Empty',  $what_cmd,
                    time - $smtp_handle->last_io_event_tx_timestamp);
      } elsif ($smtp_resp !~ /^2/) {
        die "Negative SMTP response to $what_cmd: $smtp_resp";
      } else {  # success, $smtp_resp =~ /^2/
        do_log(3,"smtp resp to %s: %s", $what_cmd,$smtp_resp);
        $smtp_session->transaction_ends  if $what_cmd eq 'RSET';
      }
    } else {  # get response(s) to data-dot
      # replace success responses to RCPT TO commands with a final response
      my $first = 1;  my $anyfail = 0;  my $anysucc = 0;
      for my $r (@per_recip_data_rcpt_sent) {  # only for those actually sent
        if ($lmtp || $first) {
          $first = 0;  my $raddr = qquote_rfc2821_local($r->recip_final_addr);
          $raddr .= ', etc.'  if !$lmtp && @per_recip_data > 1;
          $smtp_resp = $smtp_session->smtp_response;  # resp to data-dot
          if (!defined $smtp_resp || $smtp_resp eq '') {
            $anyfail = 1;
            do_log(0,"%s SMTP response to %s (%s), dt: %.3f s",
                     !defined $smtp_resp ? 'No' : 'Empty', $what_cmd, $raddr,
                     time - $smtp_handle->last_io_event_tx_timestamp);
          } elsif ($smtp_resp !~ /^2/) {
            $anyfail = 1;
            do_log(0,"Negative SMTP response to %s (%s): %s, dt: %.1f ms",
                     $what_cmd, $raddr, $smtp_resp,
                     1000*(time-$smtp_handle->last_io_event_tx_timestamp));
          } else {  # success, $smtp_resp =~ /^2/
            $anysucc = 1;
            ll(3) && do_log(3,"smtp resp to %s (%s): %s, dt: %.1f ms",
                       $what_cmd, $raddr, $smtp_resp,
                       1000*(time-$smtp_handle->last_io_event_tx_timestamp));
          }
        }
        next  if $r->recip_done;  # skip those that failed at earlier stages
        $r->recip_remote_mta($relayhost);
        $r->recip_remote_mta_smtp_response($smtp_resp);
        my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
                                                  '.6.0','data-dot');
        $smtp_response = $smtp_resp_ext  if !defined $smtp_response;
        $r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
        $r->recip_mbxname($r->recip_final_addr)  if $smtp_resp =~ /^2/;
      }
      if ($first) {  # fetch an uncollected response
        # fetch unprocessed response if all recipients were rejected
        # but we nevertheless somehow entered a data transfer mode
        # (i.e. if an SMTP server failed to reject a DATA command).
        # RFC 2033: when there have been no successful RCPT commands in the
        # mail transaction, the DATA command MUST fail with a 503 reply code
        $smtp_resp = $smtp_session->smtp_response;  # resp to data-dot
        $smtp_resp = ''  if !defined $smtp_resp;
        if ($smtp_resp =~ /^2/) { $anysucc = 1 } else { $anyfail = 1 }
        do_log(3,"smtp resp to _dummy_ data %s: %s", $what_cmd,$smtp_resp);
      }
      if ($anysucc && !$anyfail) {
        # we are certain all went fine and a transaction is definitely over
        $smtp_session->transaction_ends;
      }
    }
#   if ($pipelining) {}     # QUIT was already sent
#   elsif (!$smtp_connection_cache_enable)  {
#     $smtp_session->quit;  #flush!   QUIT
#     # can't be sure until we see a response, consider uncertain just in case
#     $smtp_session->transaction_ends_unconfirmed;
#   }
#   if ($smtp_session->session_state eq 'quitsent') {
#     $smtp_session->timeout($smtp_quit_timeout);
#     $smtp_resp = $smtp_session->smtp_response;
#     $smtp_resp = ''  if !defined $smtp_resp;
#     do_log(3,"smtp resp to QUIT: %s", $smtp_resp);
#     if ($smtp_resp =~ /^2/) {
#       $smtp_session->transaction_ends;
#     } else {
#       $smtp_session->transaction_ends_unconfirmed;
#       do_log(0,"Negative SMTP resp. to QUIT: %s", $smtp_resp);
#     }
#   }
    my $keep_session = $smtp_session->session_state ne 'quitsent';
    if ($keep_session && !defined($smtp_session->in_smtp_transaction)) {
      do_log(2,"SMTP transaction state uncertain, closing just in case");
      $keep_session = 0;
    }
    $smtp_session->close($keep_session)
      or die "Error closing Amavis::Out::SMTP::Session";
    undef $smtp_handle; undef $smtp_session;
    1;
    # some unusual error conditions _are_ captured by eval, but fail to set $@
  } or do { $err = $@ ne '' ? $@ : "errno=$!"; chomp $err };
  my $saved_section_name = $which_section;
  $which_section = 'fwd-end-chkpnt';
  do_log(2,"mail_via_smtp: session failed: %s", $err)  if defined $err;
  prolong_timer($which_section);  # restart timer
  # terminate the SMTP session if still alive
  if (!defined($smtp_session)) {
    # already closed normally
  } elsif ($in_datasend_mode) {
    # We are aborting SMTP session. Data transfer mode must NOT be terminated
    # with a dataend (dot), otherwise recipient will receive a chopped-off mail
    # (and possibly be receiving it over and over again during each MTA retry.
    do_log(-1, "mail_via_smtp: NOTICE: aborting SMTP session, %s", $err);
    $smtp_session->close(0);  # abruptly terminate SMTP session, ignore status
  } else {
    do_log(5,"smtp session done, sending QUIT");
    eval {
      $smtp_session->timeout(1);    # don't wait for too long
      $smtp_session->quit;  #flush! # send a QUIT regardless of success so far
      $smtp_session->transaction_ends_unconfirmed;
      for (my $cnt=0; ; $cnt++) {  # curious if there are any pending responses
        my $smtp_resp = $smtp_session->smtp_response;
        last  if !defined $smtp_resp;
        do_log(0,"discarding unprocessed reply: %s", $smtp_resp);
        if ($cnt > 20) { do_log(-1,"aborting, discarding many replies"); last }
      }
    } or do {
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      do_log(-1, "mail_via_smtp: error during QUIT: %s", $eval_stat);
    };
    $smtp_session->close(0);  # terminate SMTP session, ignore status
  }
  undef $smtp_handle; undef $smtp_session;
  # prepare final smtp response and log abnormal events
  for my $r (@per_recip_data) {
    my $resp = $r->recip_smtp_response;
    $smtp_response = $resp  if !defined($smtp_response) ||
                               $resp =~ /^4/ && $smtp_response !~ /^4/ ||
                               $resp !~ /^2/ && $smtp_response !~ /^[45]/;
  }
  if (!defined $err) {
    # no errors
  } elsif ($err =~ /^timed out\b/ || $err =~ /: Timeout\z/) {
    $smtp_response = sprintf("450 4.4.2 Timed out during %s, MTA(%s), id=%s",
                             $saved_section_name, $mta_id, $am_id);
  } elsif ($err =~ /^Can't connect\b/) {
    $smtp_response = sprintf("450 4.4.1 %s, MTA(%s), id=%s",
                             $err, $mta_id, $am_id);
  } elsif ($err =~ /^Too many hops\b/) {
    $smtp_response = sprintf("554 5.4.6 Reject: %s, id=%s", $err, $am_id);
  } else {
    $smtp_response = sprintf("451 4.5.0 From MTA(%s) during %s (%s): id=%s",
                             $mta_id, $saved_section_name, $err, $am_id);
  }
  # NOTE: $initial_submission argument is typically treated as a boolean
  # but a value of 'AV' is supplied by av_smtp_client to allow a forwarding
  # method to distinguish it from ordinary submissions
  my $ll = ($smtp_response =~ /^2/ || $initial_submission eq 'AV') ? 1 : -1;
  ll($ll) && do_log($ll, "%s from %s -> %s, %s %s",
          $logmsg, $sender_smtp,
          join(',', qquote_rfc2821_local(
                      map($_->recip_final_addr, @per_recip_data))),
          join(' ', map { my $v=$from_options{$_}; defined($v)?"$_=$v":"$_" }
                        (keys %from_options)),
          $smtp_response);
  if (defined $smtp_response) {
    $msginfo->dsn_passed_on($dsn_capable && $smtp_response=~/^2/ &&
                            !c('terminate_dsn_on_notify_success') ? 1 : 0);
    for my $r (@per_recip_data) {
      # attach an SMTP response to each recip that was not already processed
      if (!$r->recip_done) {  # mark it as done
        $r->recip_smtp_response($smtp_response); $r->recip_done(2);
        $r->recip_mbxname($r->recip_final_addr)  if $smtp_response =~ /^2/;
      } elsif ($any_valid_recips_and_data_sent &&
               $r->recip_smtp_response =~ /^452/) {
        # 'undo' the RCPT TO '452 Too many recipients' situation,
        # mail needs to be transferred in more than one transaction
        $r->recip_smtp_response(undef); $r->recip_done(undef);
      }
    }
    if ($smtp_response =~ /^2/) {
      snmp_count('OutMsgsDelivers');
      my $size = $msginfo->msg_size;
      snmp_count( ['OutMsgsSize'.$_, $size, 'C64'] )  for @snmp_vars;
    } elsif ($smtp_response =~ /^4/) {
      snmp_count('OutMsgsAttemptFails');
    } elsif ($smtp_response =~ /^5/) {
      snmp_count('OutMsgsRejects');
    }
  }
  section_time($which_section);
  die $err  if defined($err) && $err =~ /^timed out\b/;  # resignal timeout
  1;
}

1;