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

package Amavis::In::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);
}

use Errno qw(ENOENT EACCES EINTR EAGAIN);
use MIME::Base64;
use Time::HiRes ();
#use IO::Socket::SSL;

use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::In::Connection;
use Amavis::In::Message;
use Amavis::Lookup qw(lookup lookup2);
use Amavis::Lookup::IP qw(lookup_ip_acl normalize_ip_addr);
use Amavis::rfc2821_2822_Tools;
use Amavis::TempDir;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log do_log_safe untaint
                    dump_captured_log log_capture_enabled
                    am_id new_am_id snmp_counters_init
                    orcpt_decode xtext_decode safe_encode_utf8_inplace
                    idn_to_ascii sanitize_str add_entropy
                    debug_oneshot waiting_for_client prolong_timer
                    switch_to_my_time switch_to_client_time
                    setting_by_given_contents_category);

BEGIN {  # due to dynamic loading runs only after config files have been read

  # for compatibility with 2.10 or earlier:
  $smtpd_tls_server_options{SSL_key_file} = $smtpd_tls_key_file
    if !exists $smtpd_tls_server_options{SSL_key_file} &&
       defined $smtpd_tls_key_file;
  $smtpd_tls_server_options{SSL_cert_file} = $smtpd_tls_cert_file
    if !exists $smtpd_tls_server_options{SSL_cert_file} &&
       defined $smtpd_tls_cert_file;

  my $tls_security_level = c('tls_security_level_in');
  $tls_security_level = 0  if !defined($tls_security_level) ||
                              lc($tls_security_level) eq 'none';
  if ($tls_security_level) {
    ( defined $smtpd_tls_server_options{SSL_cert_file} &&
      $smtpd_tls_server_options{SSL_cert_file} ne ''
    ) or die '$tls_security_level is enabled '.
          'but $smtpd_tls_server_options{SSL_cert_file} is not provided'."\n";
    ( defined $smtpd_tls_server_options{SSL_key_file} &&
      $smtpd_tls_server_options{SSL_key_file} ne ''
    ) or die '$tls_security_level is enabled '.
          'but $smtpd_tls_server_options{SSL_key_file} is not provided'."\n";
  }
  1;
}

sub new($) {
  my $class = $_[0];
  my $self = bless {}, $class;
  undef $self->{sock};              # SMTP socket
  $self->{proto} = undef;           # SMTP / ((ESMTP / LMTP) (A | S | SA)? )
  $self->{smtp_outbuf} = undef;     # SMTP responses buffer for PIPELINING
  undef $self->{pipelining};        # may we buffer responses?
  undef $self->{session_closed_normally};  # closed properly with QUIT
  $self->{within_data_transfer} = 0;
  $self->{smtp_inpbuf} = '';        # SMTP input buffer
  $self->{tempdir} = Amavis::TempDir->new;  # TempDir object
  $self;
}

sub DESTROY {
  my $self = $_[0];
  local($@,$!,$_); my $myactualpid = $$;
  eval {
    if (defined($my_pid) && $myactualpid != $my_pid) {
      do_log(5,"Skip closing SMTP session in a clone [%s] (born as [%s])",
                $myactualpid, $my_pid);
    } elsif (ref($self->{sock}) && ! $self->{session_closed_normally}) {
      my $msg = "421 4.3.2 Service shutting down, closing channel";
      $msg .= ", during waiting for input from client" if waiting_for_client();
      $msg .= ", sig: " .
              join(',', keys %Amavisd::got_signals)  if %Amavisd::got_signals;
      $self->smtp_resp(1,$msg);
    }
    1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";
    do_log_safe(1,"SMTP shutdown: %s", $eval_stat);
  };
}

sub readline {
  my($self, $timeout) = @_;
  my($rout,$eout,$rin,$ein);
  my $ifh = $self->{sock};
  for (;;) {
    local($1);
    return $1  if $self->{smtp_inpbuf} =~ s/^(.*?\015\012)//s;
#   if (defined $timeout) {
#     if (!defined $rin) {
#       $rin = $ein = ''; vec($rin, fileno $self->{sock}, 1) = 1; $ein = $rin;
#     }
#     my($nfound,$timeleft) =
#       select($rout=$rin, undef, $eout=$ein, $timeout);
#     defined $nfound && $nfound >= 0
#       or die "Select failed: ".
#              (!$self->{ssl_active} ? $! : $ifh->errstr.", $!");
#     if (!$nfound) {
#       do_log(2, 'smtp readline: timed out, %s s', $timeout);
#       $timeout = undef; next;  # carry on as usual
#     }
#   }
    my $nbytes = $ifh->sysread($self->{smtp_inpbuf}, 16384,
                               length($self->{smtp_inpbuf}));
    if ($nbytes) {
      ll(5) && do_log(5, 'smtp readline: read %d bytes, new size: %d',
                         $nbytes, length($self->{smtp_inpbuf}));
    } elsif (defined $nbytes) {  # defined but zero
      do_log(5, 'smtp readline: EOF');
      $! = 0;  # eof, no error
      last;
    } elsif ($! == EAGAIN || $! == EINTR) {
      do_log(5, 'smtp readline: interrupted: %s',
                !$self->{ssl_active} ? $! : $ifh->errstr.", $!");
      # retry
    } else {
      do_log(5, 'smtp readline: error: %s',
                !$self->{ssl_active} ? $! : $ifh->errstr.", $!");
      last;
    }
  }
  undef;
}

# Efficiently copy mail text from an SMTP socket to a file, converting
# CRLF to a local filesystem newlines \n, and handling dot-destuffing.
# Should be called just after the DATA command has been responded to,
# stops reading at a CRLF DOT CRLF or eof. Does not report stuffing errors.
#
# Our current statistics (Q4 2011) shows that 80 % of messages are below
# 30.000 bytes, and 90 % of messages are below 100.000 bytes in size.
#
sub copy_smtp_data {
  my($self, $ofh, $out_str_ref, $size_limit) = @_;
  my $ifh = $self->{sock};
  my $buff = $self->{smtp_inpbuf};  # work with a local copy
  $$out_str_ref = ''  if ref $out_str_ref;
  # assumes to be called right after a DATA<CR><LF>
  my $eof = 0; my $at_the_beginning = 1;
  my $size = 0; my $oversized = 0;
  my($errno,$nreads,$j);
  my $smtpd_t_o = c('smtpd_timeout');
  while (!$eof) {
    # alarm should apply per-line, but we are dealing with whole chunks here
    alarm($smtpd_t_o);
    $nreads = $ifh->sysread($buff, 65536, length $buff);
    if ($nreads) {
      ll(5) && do_log(5, "smtp copy: read %d bytes into buffer, new size: %d",
                         $nreads, length($buff));
    } elsif (defined $nreads) {
      $eof = 1;
      do_log(5, "smtp copy: EOF");
    } else {
      $eof = 1;
      $errno = !$self->{ssl_active} ? $! : $ifh->errstr.", $!";
      do_log(5, "smtp copy: error: %s", $errno);
    }
    if ($at_the_beginning && substr($buff,0,3) eq ".\015\012") {
      # a preceding \015\012 is implied, although no longer in the buffer
      substr($buff,0,3) = '';
      $self->{within_data_transfer} = 0;
      last;
    } elsif ( ($j=index($buff,"\015\012.\015\012")) >= 0 ) {  # last chunk
      my $carry = substr($buff,$j+5);  # often empty
      substr($buff,$j+2) = '';  # ditch the dot and the rest
      $size += length($buff);
      if (!$oversized) {
        $buff =~ s/\015\012\.?/\n/gs;
        # the last chunk is allowed to overshoot the 'small mail' limit
        $$out_str_ref .= $buff  if $out_str_ref;
        if ($ofh) {
          my $nwrites;
          for (my $ofs = 0; $ofs < length($buff); $ofs += $nwrites) {
            $nwrites = syswrite($ofh, $buff, length($buff)-$ofs, $ofs);
            defined $nwrites  or die "Error writing to mail file: $!";
          }
        }
        if ($size_limit && $size > $size_limit) {
          do_log(1,"Message size exceeded %d B", $size_limit);
          $oversized = 1;
        }
      }
      $buff = $carry;
      $self->{within_data_transfer} = 0;
      last;
    }
    my $carry = '';
    if ($eof) {
      # flush whatever is in the buffer, no more data coming
    } elsif ($at_the_beginning &&
             ($buff eq ".\015" || $buff eq '.' || $buff eq '')) {
      $carry = $buff; $buff = '';
    } elsif (substr($buff,-4,4) eq "\015\012.\015") {
      substr($buff,-4,4) = ''; $carry = "\015\012.\015";
    } elsif (substr($buff,-3,3) eq "\015\012.") {
      substr($buff,-3,3) = ''; $carry = "\015\012.";
    } elsif (substr($buff,-2,2) eq "\015\012") {
      substr($buff,-2,2) = ''; $carry = "\015\012";
    } elsif (substr($buff,-1,1) eq "\015") {
      substr($buff,-1,1) = ''; $carry = "\015";
    }
    if ($buff ne '') {
      $at_the_beginning = 0;
      # message size is defined in RFC 1870, includes CRLF but no stuffed dots
      # NOTE: we overshoot here by the number of stuffed dots, for performance;
      # the message size will be finely adjusted in get_body_digest()
      $size += length($buff);
      if (!$oversized) {
        # The RFC 5321 is quite clear, leading "." characters in
        # SMTP are stripped regardless of the following character.
        # Some MTAs only trim "." when the next character is also
        # a ".", but this violates the RFC.
        $buff =~ s/\015\012\.?/\n/gs;  # quite fast, but still a bottleneck
        if (!$out_str_ref) {
          # not writing to memory
        } elsif (length($$out_str_ref) < 100*1024) {  # 100 KiB 'small mail'
          $$out_str_ref .= $buff;
        } else {  # large mail, hand over writing to a file
#         my $nwrites;
#         for (my $ofs = 0; $ofs < length($$out_str_ref); $ofs += $nwrites) {
#           $nwrites = syswrite($ofh, $$out_str_ref,
#                               length($$out_str_ref)-$ofs, $ofs);
#           defined $nwrites  or die "Error writing to mail file: $!";
#         }
          $$out_str_ref = '';
          $out_str_ref = undef;
        }
        if ($ofh) {
          my $nwrites;
          for (my $ofs = 0; $ofs < length($buff); $ofs += $nwrites) {
            $nwrites = syswrite($ofh, $buff, length($buff)-$ofs, $ofs);
            defined $nwrites  or die "Error writing to mail file: $!";
          }
        }
        if ($size_limit && $size > $size_limit) {
          do_log(1,"Message size exceeded %d B, ".
                   "skipping further input", $size_limit);
          my $trunc_str = "\n***TRUNCATED***\n";
          $$out_str_ref .= $trunc_str  if $out_str_ref;
          if ($ofh) {
            my $nwrites = syswrite($ofh, $trunc_str);
            defined $nwrites  or die "Error writing to mail file: $!";
          }
          $oversized = 1;
        }
      }
    }
    $buff = $carry;
  }
  do_log(5, "smtp copy: %d bytes still buffered at end", length($buff));
  $self->{smtp_inpbuf} = $buff;  # put a local copy back into object
  !$self->{within_data_transfer}  or die "Connection broken during DATA: ".
                         (!$self->{ssl_active} ? $! : $ifh->errstr.", $!");
  # return a message size and an indication of exceeded size limit
  ($size,$oversized);
}

sub preserve_evidence {  # preserve temporary files etc in case of trouble
  my $self = shift;
  !$self->{tempdir} ? undef : $self->{tempdir}->preserve(@_);
}

sub authenticate($$$) {
  my($state,$auth_mech,$auth_resp) = @_;
  my($result,$newchallenge);
  if ($auth_mech eq 'ANONYMOUS') {   # RFC 2245
    $result = [$auth_resp,undef];
  } elsif ($auth_mech eq 'PLAIN') {  # RFC 2595, "user\0authname\0pass"
    if (!defined($auth_resp)) { $newchallenge = '' }
    else { $result = [ (split(/\000/,$auth_resp,-1))[0,2] ] }
  } elsif ($auth_mech eq 'LOGIN' && !defined $state) {
    $newchallenge = 'Username:'; $state = [];
  } elsif ($auth_mech eq 'LOGIN' && @$state==0) {
    push(@$state, $auth_resp); $newchallenge = 'Password:';
  } elsif ($auth_mech eq 'LOGIN' && @$state==1) {
    push(@$state, $auth_resp); $result = $state;
  } # CRAM-MD5:RFC 2195,  DIGEST-MD5:RFC 2831
  ($state,$result,$newchallenge);
}

# Parse the "PROXY protocol header", which is a block of connection info
# the connection initiator prepends at the beginning of a connection.
# Recognizes the PROXY protocol Version 1  (V 2 is not supported here).
# http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt
#
sub haproxy_protocol_parse($) {
  local($_) = $_[0];  # a "PROXY protocol header"
  my($proto, $src_addr, $dst_addr, $src_port, $dst_port);
  local($1,$2,$3,$4,$5);
  if (/^PROXY\ (UNKNOWN)/) {
    $proto = $1;  # receiver must ignore anything presented before the CRLF
  } elsif (/^PROXY\ ((?-i)TCP4)\ ((?:\d{1,3}\.){3}\d{1,3})
                               \ ((?:\d{1,3}\.){3}\d{1,3})
                               \ (\d{1,5})\ (\d{1,5})\x0D\x0A\z/xs) {
    ($proto, $src_addr, $dst_addr, $src_port, $dst_port) = ($1,$2,$3,$4,$5);
  } elsif (/^PROXY\ ((?-i)TCP6)\ ([0-9a-f]{0,4} (?: : [0-9a-f]{0,4}){2,7})
                               \ ([0-9a-f]{0,4} (?: : [0-9a-f]{0,4}){2,7})
                               \ (\d{1,5})\ (\d{1,5})\x0D\x0A\z/xsi) {
    ($proto, $src_addr, $dst_addr, $src_port, $dst_port) = ($1,$2,$3,$4,$5);
  }
  return ($proto)  if $proto !~ /^TCP[46]\z/;
  return if $src_port && $src_port =~ /^0/;  # leading zeroes not allowed
  return if $dst_port && $dst_port =~ /^0/;
  $src_port = 0+$src_port; $dst_port = 0+$dst_port;  # turn to numeric
  return if $src_port > 65535 || $dst_port > 65535;
  ($proto, $src_addr, $dst_addr, $src_port, $dst_port);
}

# process the "PROXY protocol header" and pretend the claimed connection
#
sub haproxy_apply($$) {
  my($conn, $line) = @_;
  if (defined $line) {
    ll(4) && do_log(4, 'HAProxy: < %s', $line);
    my($proto, $src_addr, $dst_addr, $src_port, $dst_port) =
      haproxy_protocol_parse($line);
    if (!defined $src_addr || !defined $dst_addr ||
        !$src_port || !$dst_port) {
      do_log(0, "HAProxy: PROXY protocol header expected, got: %s", $line);
      die "HAProxy: a PROXY protocol header expected";
    } elsif (!Amavis::access_is_allowed(undef, $src_addr, $src_port,
                                               $dst_addr, $dst_port)) {
      do_log(0, "HAProxy, access denied: %s [%s]:%d -> [%s]:%d",
                $proto, $src_addr, $src_port, $dst_addr, $dst_port);
      die "HAProxy: access from client $src_addr denied\n";
    } else {
      if (ll(3)) {
        do_log(3,
          "HAProxy: accepted:   (client) [%s]:%d -> [%s]:%d (HA Proxy/server)",
          $src_addr, $src_port, $dst_addr, $dst_port);
        do_log(3,
          "HAProxy: (HA Proxy/initiator) [%s]:%d -> [%s]:%d (me/target)",
          $conn->client_ip||'x', $conn->client_port||0,
          $conn->socket_ip||'x', $conn->socket_port||0);
      };
      $conn->client_ip(untaint(normalize_ip_addr($src_addr)));
      $conn->socket_ip(untaint(normalize_ip_addr($dst_addr)));
      $conn->client_port(untaint($src_port));
      $conn->socket_port(untaint($dst_port));
    }
  }
}

# Accept an SMTP or LMTP connect (which can do any number of transactions)
# and call content checking for each message received
#
sub process_smtp_request($$$$) {
  my($self, $sock, $lmtp, $conn, $check_mail) = @_;
  # $sock:       connected socket from Net::Server
  # $lmtp:       greet as an LMTP server instead of (E)SMTP
  # $conn:       information about client connection
  # $check_mail: subroutine ref to be called with file handle

  my($msginfo, $authenticated, $auth_user, $auth_pass);
  my(%announced_ehlo_keywords);
  $self->{sock} = $sock;
  $self->{pipelining} = 0;    # may we buffer responses?
  $self->{smtp_outbuf} = [];  # SMTP responses buffer for PIPELINING
  $self->{session_closed_normally} = 0;  # closed properly with QUIT?
  $self->{ssl_active} = 0;    # session upgraded to SSL
  my $tls_security_level = c('tls_security_level_in');
  $tls_security_level = 0  if !defined($tls_security_level) ||
                              lc($tls_security_level) eq 'none';
  my $myheloname;
# $myheloname = idn_to_ascii(c('myhostname'));
# $myheloname = 'localhost';
# $myheloname = '[127.0.0.1]';
  my $sock_ip = $conn->socket_ip;
  $myheloname = defined $sock_ip && $sock_ip ne '' ? "[$sock_ip]"
                                                   : '[localhost]';
  new_am_id(undef, $Amavis::child_invocation_count, undef);
  my $initial_am_id = 1;
  my($sender_unq, $sender_quo, @recips, $got_rcpt);
  my $max_recip_size_limit;  # maximum of per-recipient message size limits
  my($terminating,$aborting,$eof,$voluntary_exit); my(%xforward_args);
  my $seq = 0;
  my(%baseline_policy_bank) = %current_policy_bank;
  $conn->appl_proto($self->{proto} = $lmtp ? 'LMTP' : 'SMTP');

  my $final_oversized_destiny_all_pass = 1;
  my $oversized_fd_map_ref =
    setting_by_given_contents_category(CC_OVERSIZED,
                                       cr('final_destiny_maps_by_ccat'));
  my $oversized_lovers_map_ref =
    setting_by_given_contents_category(CC_OVERSIZED,
                                       cr('lovers_maps_by_ccat'));
  # system-wide message size limit, if any
  my $message_size_limit = c('smtpd_message_size_limit');
  if ($enforce_smtpd_message_size_limit_64kb_min &&
      $message_size_limit && $message_size_limit < 65536) {
    $message_size_limit = 65536;  # RFC 5321 requires at least 64k
  }

  if (c('haproxy_target_enabled')) {
    Amavis::Timing::go_idle(4);
    my $line; { local($/) = "\012"; $line = $self->readline }
    Amavis::Timing::go_busy(5);
    defined $line  or die "Error reading, expected a PROXY header: $!";
    haproxy_apply($conn, $line);
  }

  my $smtpd_greeting_banner_tmp = c('smtpd_greeting_banner');
  $smtpd_greeting_banner_tmp =~
    s{ \$ (?: \{ ([^\}]+) \} |
              ([a-zA-Z](?:[a-zA-Z0-9_-]*[a-zA-Z0-9])?\b) ) }
     { { 'helo-name'    => $myheloname,
         'myhostname'   => idn_to_ascii(c('myhostname')),
         'version'      => $myversion,
         'version-id'   => $myversion_id,
         'version-date' => $myversion_date,
         'product'      => $myproduct_name,
         'protocol'     => $lmtp?'LMTP':'ESMTP' }->{lc($1.$2)}
     }xgse;
  $self->smtp_resp(1,"220 $smtpd_greeting_banner_tmp");
  section_time('SMTP greeting');
  # each call to smtp_resp starts a $smtpd_timeout timeout to tame slow clients

  $0 = sprintf("%s (ch%d-idle)",
               c('myprogram_name'), $Amavis::child_invocation_count);
  Amavis::Timing::go_idle(4);
  local($_);  local($/) = "\012";  # input line terminator set to LF
  for ($! = 0; defined($_ = $self->readline); $! = 0) {
    $0 = sprintf("%s (ch%d-%s)",
                c('myprogram_name'), $Amavis::child_invocation_count, am_id());
    Amavis::Timing::go_busy(5);
    # the ball is now in our courtyard, (re)start our timer;
    # each of our smtp responses will switch back to a $smtpd_timeout timer
    { # a block is used as a 'switch' statement - 'last' will exit from it
      my $cmd = $_;
      ll(4) && do_log(4, '%s< %s', $self->{proto},$cmd);
      if (!/^ [ \t]* ( [A-Za-z] [A-Za-z0-9]* ) (?: [ \t]+ (.*?) )? [ \t]*
              \015 \012 \z /xs) {
        $self->smtp_resp(1,"500 5.5.2 Error: bad syntax", 1, $cmd); last;
      };
      $_ = uc($1); my $args = $2;
      switch_to_my_time("rx SMTP $_");

# (causes holdups in Postfix, it doesn't retry immediately; better set max_use)
#     $Amavis::child_task_count >= $max_requests    # exceeded max_requests
#     && /^(?:HELO|EHLO|LHLO|DATA|NOOP|QUIT|VRFY|EXPN|TURN)\z/ && do {
#       # pipelining checkpoints;
#       # in case of multiple-transaction protocols (e.g. SMTP, LMTP)
#       # we do not like to keep running indefinitely at the MTA's mercy
#       my $msg = "Closing transmission channel ".
#                  "after $Amavis::child_task_count transactions, $_";
#       do_log(2,"%s",$msg); $self->smtp_resp(1,"421 4.3.0 ".$msg);  #flush!
#       $terminating=1; last;
#     };

      $tls_security_level && lc($tls_security_level) ne 'may' &&
      !$self->{ssl_active} && !/^(?:NOOP|EHLO|STARTTLS|QUIT)\z/ && do {
        $self->smtp_resp(1,"530 5.7.0 Must issue a STARTTLS command first",
                         1,$cmd);
        last;
      };

#     lc($tls_security_level) eq 'verify' && !/^QUIT\z/ && do {
#       $self->smtp_resp(1,"554 5.7.0 Command refused due to lack of security",
#                        1,$cmd);
#       last;
#     };

      /^NOOP\z/ && do { $self->smtp_resp(1,"250 2.0.0 Ok $_"); last };  #flush!

      /^QUIT\z/ && do {
        if ($args ne '') {
          $self->smtp_resp(1,"501 5.5.4 Error: QUIT does not accept arguments",
                           1,$cmd);  #flush
        } else {
          my $smtpd_quit_banner_tmp = c('smtpd_quit_banner');
          $smtpd_quit_banner_tmp =~
            s{ \$ (?: \{ ([^\}]+) \} |
                      ([a-zA-Z](?:[a-zA-Z0-9_-]*[a-zA-Z0-9])?\b) ) }
             { { 'helo-name'    => $myheloname,
                 'myhostname'   => idn_to_ascii(c('myhostname')),
                 'version'      => $myversion,
                 'version-id'   => $myversion_id,
                 'version-date' => $myversion_date,
                 'product'      => $myproduct_name,
                 'protocol'     => $lmtp?'LMTP':'ESMTP' }->{lc($1.$2)}
             }xgse;
          $self->smtp_resp(1,"221 2.0.0 $smtpd_quit_banner_tmp");  #flush!
          $terminating = 1;
        }
        last;
      };

      /^(?:RSET|HELO|EHLO|LHLO|STARTTLS)\z/ && do {
        # explicit or implicit session reset
        $sender_unq = $sender_quo = undef; @recips = (); $got_rcpt = 0;
        undef $max_recip_size_limit; undef $msginfo;  # forget previous
        $final_oversized_destiny_all_pass = 1;
        %current_policy_bank = %baseline_policy_bank;  # restore bank settings
        %xforward_args = ();
        if (/^(?:RSET|STARTTLS)\z/ && $args ne '') {
          $self->smtp_resp(1,"501 5.5.4 Error: $_ does not accept arguments",
                           1,$cmd);
        } elsif (/^RSET\z/) {
          $self->smtp_resp(0,"250 2.0.0 Ok $_");
        } elsif (/^STARTTLS\z/) {  # RFC 3207 (ex RFC 2487)
          if ($self->{ssl_active}) {
            $self->smtp_resp(1,"554 5.5.1 Error: TLS already active");
          } elsif (!$tls_security_level) {
            $self->smtp_resp(1,"502 5.5.1 Error: command not available");
        # } elsif (!$announced_ehlo_keywords{'STARTTLS'}) {
        #   $self->smtp_resp(1,"502 5.5.1 Error: ".
        #                      "service extension STARTTLS was not announced");
          } else {
            $self->smtp_resp(1,"220 2.0.0 Ready to start TLS");  #flush!
            %announced_ehlo_keywords = ();
            IO::Socket::SSL->start_SSL($sock,
              SSL_server => 1,
              SSL_hostname => idn_to_ascii(c('myhostname')),
              SSL_error_trap => sub {
                my($sock,$msg) = @_;
                do_log(-2,"STARTTLS, upgrading socket to TLS failed: %s",$msg);
              },
              %smtpd_tls_server_options,
            ) or die "Error upgrading input socket to TLS: ".
                     IO::Socket::SSL::errstr();
            if ($self->{smtp_inpbuf} ne '') {
              do_log(-1, "STARTTLS pipelining violation attempt, sanitized");
              $self->{smtp_inpbuf} = '';  # ditch any buffered data
            }
            $self->{ssl_active} = 1;
            ll(3) && do_log(3,"smtpd TLS cipher: %s", $sock->get_cipher);
            section_time('SMTP starttls');
          }
        } elsif (/^HELO\z/) {
          $self->{pipelining} = 0; $lmtp = 0;
          $conn->appl_proto($self->{proto} = 'SMTP');
          $self->smtp_resp(0,"250 $myheloname");
          $conn->smtp_helo($args); section_time('SMTP HELO');
        } elsif (/^(?:EHLO|LHLO)\z/) {
          $self->{pipelining} = 1; $lmtp = $_ eq 'LHLO' ? 1 : 0;
          $conn->appl_proto($self->{proto} = $lmtp ? 'LMTP' : 'ESMTP');
          my(@ehlo_keywords) = (
            'VRFY',
            'PIPELINING',           # RFC 2920
            !defined($message_size_limit) ? 'SIZE'  # RFC 1870
              : sprintf('SIZE %d',$message_size_limit),
            'ENHANCEDSTATUSCODES',  # RFC 2034, RFC 3463, RFC 5248
            '8BITMIME',             # RFC 6152
            'SMTPUTF8',             # RFC 6531
            'DSN',                  # RFC 3461
            !$tls_security_level || $self->{ssl_active} ? ()
              : 'STARTTLS',         # RFC 3207 (ex RFC 2487)
            !@{ca('auth_mech_avail')} ? ()   # RFC 4954 (ex RFC 2554)
              : join(' ','AUTH',@{ca('auth_mech_avail')}),
            'XFORWARD NAME ADDR PORT PROTO HELO IDENT SOURCE',
          # 'XCLIENT NAME ADDR PORT PROTO HELO LOGIN',
          );
          my(%smtpd_discard_ehlo_keywords) =
            map((uc($_),1), @{ca('smtpd_discard_ehlo_keywords')});
          # RFC 6531: Servers offering this extension MUST provide
          #   support for, and announce, the 8BITMIME extension
          $smtpd_discard_ehlo_keywords{'SMTPUTF8'} = 1
            if $smtpd_discard_ehlo_keywords{'8BITMIME'};
          @ehlo_keywords =
            grep(/^([A-Za-z0-9]+)/ &&
                 !$smtpd_discard_ehlo_keywords{uc $1}, @ehlo_keywords);
          $self->smtp_resp(1,"250 $myheloname\n" .
                             join("\n",@ehlo_keywords));  #flush!
          %announced_ehlo_keywords =
            map( (/^([A-Za-z0-9]+)/ && uc $1, 1), @ehlo_keywords);
          $conn->smtp_helo($args); section_time("SMTP $_");
        };
        last;
      };

      /^XFORWARD\z/ && do {  # Postfix extension
        my $xcmd = $_;
        if (defined $sender_unq) {
          $self->smtp_resp(1,"503 5.5.1 Error: $xcmd not allowed ".
                             "within transaction",1,$cmd);
          last;
        }
        my $bad;
        for (split(' ',$args)) {
          if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* ) =
                  ( [\x21-\x7E\x80-\xFF]{0,255} )\z/xs) {
            $self->smtp_resp(1,"501 5.5.4 Syntax error in $xcmd parameters",
                             1, $cmd);
            $bad = 1; last;
          } else {
            my($name,$val) = (uc($1), $2);
            if ($name=~/^(?:NAME|ADDR|PORT|PROTO|HELO|IDENT|SOURCE|LOGIN)\z/) {
              $val = undef  if uc($val) eq '[UNAVAILABLE]';
              # Postfix since vers 2.3 (20060610) uses xtext-encoded (RFC 3461)
              # strings in XCLIENT and XFORWARD attribute values, previous
              # versions sent plain text with neutered special characters.
              # The IDENT option is available since postfix 2.8.0 .
              $val = xtext_decode($val)  if defined $val &&
                                            $val =~ /\+([0-9a-fA-F]{2})/;
              $xforward_args{$name} = $val;
            } else {
              $self->smtp_resp(1,"501 5.5.4 $xcmd command parameter ".
                                 "error: $name=$val",1,$cmd);
              $bad = 1; last;
            }
          }
        }
        $self->smtp_resp(1,"250 2.5.0 Ok $_")  if !$bad;
        last;
      };

      /^HELP\z/ && do {
        $self->smtp_resp(0,"214 2.0.0 See $myproduct_name home page at:\n".
                           "http://www.ijs.si/software/amavisd/");
        last;
      };

      /^AUTH\z/ && @{ca('auth_mech_avail')} && do {  # RFC 4954 (ex RFC 2554)
      # if (!$announced_ehlo_keywords{'AUTH'}) {
      #   $self->smtp_resp(1,"502 5.5.1 Error: ".
      #                      "service extension AUTH was not announced");
      #   last;
      # } elsif
        if ($args !~ /^([^ ]+)(?: ([^ ]*))?\z/is) {
          $self->smtp_resp(1,"501 5.5.2 Syntax: AUTH mech [initresp]",1,$cmd);
          last;
        }
        # enhanced status codes: RFC 4954, RFC 5248
        my($auth_mech,$auth_resp) = (uc($1), $2);
        if ($authenticated) {
          $self->smtp_resp(1,"503 5.5.1 Error: session already authenticated",
                             1,$cmd);
        } elsif (defined $sender_unq) {
          $self->smtp_resp(1,"503 5.5.1 Error: AUTH not allowed within ".
                             "transaction",1,$cmd);
        } elsif (!grep(uc($_) eq $auth_mech, @{ca('auth_mech_avail')})) {
          $self->smtp_resp(1,"504 5.5.4 Error: requested authentication ".
                             "mechanism not supported",1,$cmd);
        } else {
          my($state,$result,$challenge);
          if   ($auth_resp eq '=') { $auth_resp = '' }  # zero length
          elsif ($auth_resp eq '') { $auth_resp = undef }
          for (;;) {
            if ($auth_resp !~ m{^[A-Za-z0-9+/]*=*\z}) {
              $self->smtp_resp(1,"501 5.5.2 Authentication failed: ".
                                 "malformed authentication response",1,$cmd);
              last;
            } else {
              $auth_resp = decode_base64($auth_resp)  if $auth_resp ne '';
              ($state,$result,$challenge) =
                authenticate($state, $auth_mech, $auth_resp);
              if (ref($result) eq 'ARRAY') {
                $self->smtp_resp(0,"235 2.7.0 Authentication succeeded");
                $authenticated = 1; ($auth_user,$auth_pass) = @$result;
                do_log(2,"AUTH %s, user=%s", $auth_mech,$auth_user); #auth_resp
                last;
              } elsif (defined $result && !$result) {
                $self->smtp_resp(0,"535 5.7.8 Authentication credentials ".
                                   "invalid", 1, $cmd);
                last;
              }
            }
            # server challenge or ready prompt
            $self->smtp_resp(1,"334 ".encode_base64($challenge,''));
            $! = 0; $auth_resp = $self->readline;
            defined $auth_resp  or die "Error reading auth resp: ".
                            (!$self->{ssl_active} ? $! : $sock->errstr.", $!");
            switch_to_my_time('rx AUTH challenge reply');
            do_log(5, "%s< %s", $self->{proto},$auth_resp);
            $auth_resp =~ s/\015?\012\z//;
            if (length($auth_resp) > 12288) {  # RFC 4954
              $self->smtp_resp(1,"500 5.5.6 Authentication exchange ".
                                 "line is too long");
              last;
            } elsif ($auth_resp eq '*') {
              $self->smtp_resp(1,"501 5.7.1 Authentication aborted");
              last;
            }
          }
        }
        last;
      };

      /^VRFY\z/ && do {
        if ($args eq '') {
          $self->smtp_resp(1,"501 5.5.2 Syntax: VRFY address", 1,$cmd); #flush!
        } else {  # RFC 2505
          $self->smtp_resp(1,"252 2.0.0 Argument not checked", 0,$cmd); #flush!
        }
        last;
      };

      /^MAIL\z/ && do {  # begin new SMTP transaction
        if (defined $sender_unq) {
          $self->smtp_resp(1,"503 5.5.1 Error: nested MAIL command", 1, $cmd);
          last;
        }
        if (!$authenticated &&
            c('auth_required_inp') && @{ca('auth_mech_avail')} ) {
          $self->smtp_resp(1,"530 5.7.0 Authentication required", 1, $cmd);
          last;
        }
        # begin SMTP transaction
        my $now = Time::HiRes::time;
        if (!$seq) { # the first connect
          section_time('SMTP pre-MAIL');
        } else {     # establish a new time reference for each transaction
          Amavis::Timing::init(); snmp_counters_init();
        }
        $seq++;
        new_am_id(undef, $Amavis::child_invocation_count, $seq)
          if !$initial_am_id;
        $initial_am_id = 0;
        # enter 'in transaction' state
        $Amavis::zmq_obj->register_proc(1,1,'m',am_id()) if $Amavis::zmq_obj;
        $Amavis::snmp_db->register_proc(1,1,'m',am_id()) if $Amavis::snmp_db;
        Amavis::check_mail_begin_task();
        $self->{tempdir}->prepare_dir;
        $self->{tempdir}->prepare_file;
        $msginfo = Amavis::In::Message->new;
        $msginfo->rx_time($now);
        $msginfo->log_id(am_id());
        $msginfo->conn_obj($conn);

        my $cl_ip = normalize_ip_addr($xforward_args{'ADDR'});
        my $cl_port = $xforward_args{'PORT'};
        my $cl_src  = $xforward_args{'SOURCE'};  # local_header_rewrite_clients
        my $cl_login= $xforward_args{'LOGIN'};   # XCLIENT
        $cl_port = undef  if $cl_port !~ /^\d{1,9}\z/ || $cl_port > 65535;
        my(@bank_names_cl);
        { my $cl_ip_tmp = $cl_ip;
          # treat unknown client IP address as 0.0.0.0,
          # from "This" Network, RFC 1700
          $cl_ip_tmp = '0.0.0.0'  if !defined($cl_ip) || $cl_ip eq '';
          my(@cp) = @{ca('client_ipaddr_policy')};
          do_log(-1,'@client_ipaddr_policy must contain pairs, '.
                    'number of elements is not even')  if @cp % 2 != 0;
          my $labeler = Amavis::Lookup::Label->new('client_ipaddr_policy');
          while (@cp > 1) {
            my $lookup_table = shift(@cp);
            my $policy_names = shift(@cp);  # comma-separated string of names
            next if !defined $policy_names;
            if (lookup_ip_acl($cl_ip_tmp, $labeler, $lookup_table)) {
              local $1;
              push(@bank_names_cl,
                map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $policy_names)));
              last;  # should we stop here or not?
            }
          }
        }
        # load policy banks from the 'client_ipaddr_policy' lookup
        Amavis::load_policy_bank($_,$msginfo) for @bank_names_cl;
        $msginfo->originating(c('originating'));

        $msginfo->client_addr($cl_ip);      # ADDR
        $msginfo->client_port($cl_port);    # PORT
        $msginfo->client_source($cl_src);   # SOURCE
        $msginfo->client_name($xforward_args{'NAME'});
        $msginfo->client_helo($xforward_args{'HELO'});
        $msginfo->client_proto($xforward_args{'PROTO'});
        $msginfo->queue_id($xforward_args{'IDENT'});
      # $msginfo->body_type('7BIT');  # presumed, unless explicitly declared
        %xforward_args = ();  # reset values for the next transaction
        if ($self->{ssl_active}) {
          $msginfo->tls_cipher($sock->get_cipher);
          if ($self->{proto} =~ /^(LMTP|ESMTP)\z/i) {
            $self->{proto} .= 'S';  # RFC 3848
            $conn->appl_proto($self->{proto});
          }
        }
        my $submitter;
        if ($authenticated) {
          $msginfo->auth_user($auth_user); $msginfo->auth_pass($auth_pass);
          if ($self->{proto} =~ /^(LMTP|ESMTP)S?\z/i) {
            $self->{proto} .= 'A';  # RFC 3848
            $conn->appl_proto($self->{proto});
          }
        } elsif (c('auth_reauthenticate_forwarded') &&
                 c('amavis_auth_user') ne '') {
          $msginfo->auth_user(c('amavis_auth_user'));
          $msginfo->auth_pass(c('amavis_auth_pass'));
        # $submitter = quote_rfc2821_local(c('mailfrom_notify_recip'));
        # safe_encode_utf8_inplace($submitter)  # to octets (if not already)
        # $submitter = expand_variables($submitter) if defined $submitter;
        }
        local($1,$2);
        if ($args !~ /^FROM: [ \t]*
                      ( < (?:  " (?: \\. | [^\\"] ){0,999} " | [^"\@ \t] )*
                          (?: \@ (?: \[ (?: \\. | [^\]\\] ){0,999} \] |
                                     [^\[\]\\> \t] )* )? > )
                      (?: [ \t]+ (.+) )? \z/isx ) {
          $self->smtp_resp(0,"501 5.5.2 Syntax: MAIL FROM:<address>",1,$cmd);
          last;
        }
        my($addr,$opt) = ($1,$2);
        my($size,$dsn_ret,$dsn_envid,$smtputf8);
        my $msg; my $msg_nopenalize = 0;
        for (split(' ',$opt)) {
          if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* )
                  (?: = ( [^=\000-\040\177]+ ) )? \z/xs) {
                  # any CHAR excluding "=", SP, and control characters
            $msg = "501 5.5.4 Syntax error in MAIL FROM parameters";
          } else {
            my($name,$val) = (uc($1),$2);
            if (!defined($val) && $name =~ /^(?:BODY|RET|ENVID|AUTH)\z/) {
              $msg = "501 5.5.4 Syntax error in MAIL parameter, ".
                     "value is required: $name";
            } elsif ($name eq 'SIZE') {  # RFC 1870
              if (!$announced_ehlo_keywords{'SIZE'}) {
                do_log(5,'service extension SIZE was not announced');
                # "555 5.5.4 Service extension SIZE was not announced: $name"
              }
              if (!defined $val) {
                # value not provided, ignore
              } elsif ($val !~ /^\d{1,20}\z/) {
                $msg = "501 5.5.4 Syntax error in MAIL parameter: $name";
              } else {
                $size = untaint($val)  if !defined $size;
              }
            } elsif ($name eq 'SMTPUTF8') {  # RFC 6531
              if (!$announced_ehlo_keywords{'SMTPUTF8'}) {
                do_log(5,'service extension SMTPUTF8 was not announced');
                # "555 5.5.4 Service extension SMTPUTF8 not announced: $name"
              }
              if (defined $val) {
                # RFC 6531: The parameter does not accept a value.
                $msg = "501 5.5.4 Syntax error in MAIL parameter: $name";
              } else {
                $msginfo->smtputf8(1);
                if ($self->{proto} =~ /^(LMTP|ESMTP)S?A?\z/si) {
                  $self->{proto} = 'UTF8' . $self->{proto};  # RFC 6531
                  $self->{proto} =~ s/^UTF8ESMTP/UTF8SMTP/s;
                  $conn->appl_proto($self->{proto});
                }
              }
            } elsif ($name eq 'BODY') {  # RFC 6152: 8bit-MIMEtransport
              if (!$announced_ehlo_keywords{'8BITMIME'}) {
                do_log(5,'service extension 8BITMIME was not announced: BODY');
                # "555 5.5.4 Service extension 8BITMIME not announced: $name"
              }
              if (defined $val && $val =~ /^(?:7BIT|8BITMIME)\z/i) {
                $msginfo->body_type(uc $val);
              } else {
                $msg = "501 5.5.4 Syntax error in MAIL parameter: $name";
              }
            } elsif ($name eq 'RET') {    # RFC 3461
              if (!$announced_ehlo_keywords{'DSN'}) {
                do_log(5,'service extension DSN was not announced: RET');
                # "555 5.5.4 Service extension DSN not announced: $name"
              }
              if (!defined($dsn_ret)) {
                $dsn_ret = uc $val;
              } else {
                $msg = "501 5.5.4 Syntax error in MAIL parameter: $name";
              }
            } elsif ($name eq 'ENVID') {  # RFC 3461, value encoded as xtext
              if (!$announced_ehlo_keywords{'DSN'}) {
                do_log(5,'service extension DSN was not announced: ENVID');
                # "555 5.5.4 Service extension DSN not announced: $name"
              }
              if (!defined($dsn_envid)) {
                $dsn_envid = $val;
              } else {
                $msg = "501 5.5.4 Syntax error in MAIL parameter: $name";
              }
            } elsif ($name eq 'AUTH') {   # RFC 4954 (ex RFC 2554)
              if (!$announced_ehlo_keywords{'AUTH'}) {
                do_log(5,'service extension AUTH was not announced');
                # "555 5.5.4 Service extension AUTH not announced: $name"
              }
              my $s = xtext_decode($val); # encoded as xtext: RFC 3461
              do_log(5,"MAIL command, %s, submitter: %s", $authenticated,$s);
              if (defined $submitter) {   # authorized identity
                $msg = "504 5.5.4 MAIL command duplicate param.: $name=$val";
              } elsif (!@{ca('auth_mech_avail')}) {
                do_log(3,"MAIL command parameter AUTH supplied, but ".
                         "authentication capability not announced, ignored");
                $submitter = '<>';
                # mercifully ignore invalid parameter for the benefit of
                # running amavisd as a Postfix pre-queue smtp proxy filter
              # $msg = "503 5.7.4 Error: authentication disabled";
              } else {
                $submitter = $s;
              }
            } else {
              $msg = "504 5.5.4 MAIL command parameter error: $name=$val";
            }
          }
          last  if defined $msg;
        }
        if (!defined($msg) && defined $dsn_ret && $dsn_ret!~/^(FULL|HDRS)\z/) {
          $msg = "501 5.5.4 Syntax error in MAIL parameter RET: $dsn_ret";
        }
        if (!defined $msg) {
          $sender_quo = $addr; $sender_unq = unquote_rfc2821_local($addr);
          $addr = $1  if $addr =~ /^<(.*)>\z/s;
          my $requoted = qquote_rfc2821_local($sender_unq);
          do_log(2, "address modified (sender): %s -> %s",
                    $sender_quo, $requoted)  if $requoted ne $sender_quo;
          if (defined $policy_bank{'MYUSERS'} &&
              $sender_unq ne '' && $msginfo->originating &&
              lookup2(0,$sender_unq, ca('local_domains_maps'))) {
            Amavis::load_policy_bank('MYUSERS',$msginfo);
          }
          debug_oneshot(
            lookup2(0,$sender_unq, ca('debug_sender_maps')) ? 1 : 0,
            $self->{proto} . "< $cmd");
        # $submitter = $addr  if !defined($submitter);  # RFC 4954: MAY
          $submitter = '<>'   if !defined($msginfo->auth_user);
          $msginfo->auth_submitter($submitter);
          if (defined $size) {
            do_log(5, "mesage size set to a declared size %s", $size);
            $msginfo->msg_size(0+$size);
          }
          if (defined $dsn_ret || defined $dsn_envid) {
            # keep ENVID in xtext-encoded form
            $msginfo->dsn_ret($dsn_ret)      if defined $dsn_ret;
            $msginfo->dsn_envid($dsn_envid)  if defined $dsn_envid;
          }
          $msg = "250 2.1.0 Sender $sender_quo OK";
        };
        $self->smtp_resp(0,$msg, !$msg_nopenalize && $msg=~/^5/ ? 1 : 0, $cmd);
        section_time('SMTP MAIL');
        last;
      };

      /^RCPT\z/ && do {
        if (!defined($sender_unq)) {
          $self->smtp_resp(1,"503 5.5.1 Need MAIL command before RCPT",1,$cmd);
          @recips = (); $got_rcpt = 0;
          last;
        }
        $got_rcpt++;
        local($1,$2);
        if ($args !~ /^TO: [ \t]*
                      ( < (?:  " (?: \\. | [^\\"] ){0,999} " | [^"\@ \t] )*
                          (?: \@ (?: \[ (?: \\. | [^\]\\] ){0,999} \] |
                                     [^\[\]\\> \t] )* )? > )
                      (?: [ \t]+ (.+) )? \z/isx ) {
          $self->smtp_resp(0,"501 5.5.2 Syntax: RCPT TO:<address>",1,$cmd);
          last;
        }
        my($addr_smtp,$opt) = ($1,$2);
        my($notify,$orcpt);
        my $msg; my $msg_nopenalize = 0;
        for (split(' ',$opt)) {
          if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]*  )
                  (?: = ( [^=\000-\040\177]+ ) )? \z/xs) {
                  # any CHAR excluding "=", SP, and control characters
            $msg = "501 5.5.4 Syntax error in RCPT parameters";
          } else {
            my($name,$val) = (uc($1),$2);
            if (!defined($val) && $name =~ /^(?:NOTIFY|ORCPT)\z/) {
              $msg = "501 5.5.4 Syntax error in RCPT parameter, ".
                     "value is required: $name";
            } elsif ($name eq 'NOTIFY') {  # RFC 3461
              if (!$announced_ehlo_keywords{'DSN'}) {
                do_log(5,'service extension DSN was not announced: NOTIFY');
                # "555 5.5.4 Service extension DSN not announced: $name"
              }
              if (!defined($notify)) {
                $notify = $val;
              } else {
                $msg = "501 5.5.4 Syntax error in RCPT parameter $name";
              }
            } elsif ($name eq 'ORCPT') {
              # RFC 3461: value encoded as xtext
              # RFC 6533: utf-8-addr-xtext, utf-8-addr-unitext, utf-8-address
              if (!$announced_ehlo_keywords{'DSN'}) {
                do_log(5,'service extension DSN was not announced: ORCPT');
                # "555 5.5.4 Service extension DSN not announced: $name"
              }
              if (defined $orcpt) {  # duplicate
                $msg = "501 5.5.4 Syntax error in RCPT parameter $name";
              } else {
                my($addr_type, $orcpt_dec) =
                  orcpt_decode($val, $msginfo->smtputf8);
                $orcpt = $addr_type . ';' . $orcpt_dec;
              }
            } else {
              $msg = "555 5.5.4 RCPT command parameter unrecognized: $name";
              # 504 5.5.4 RCPT command parameter not implemented:
              # 504 5.5.4 RCPT command parameter error:
              # 555 5.5.4 RCPT command parameter unrecognized:
            }
          }
          last  if defined $msg;
        }
        my $addr = unquote_rfc2821_local($addr_smtp);
        my $requoted = qquote_rfc2821_local($addr);
        if ($requoted ne $addr_smtp) {  # check for valid canonical quoting
          # RFC 3461: If no ORCPT parameter was present in the RCPT command
          # when the message was received, an ORCPT parameter MAY be added
          # to the RCPT command when the message is relayed. If an ORCPT
          # parameter is added by the relaying MTA, it MUST contain the
          # recipient address from the RCPT command used when the message
          # was received by that MTA
          if (defined $orcpt) {
            do_log(2, "address modified (recip): %s -> %s, orcpt retained: %s",
                      $addr_smtp, $requoted, $orcpt);
          } else {
            do_log(2, "address modified (recip): %s -> %s, setting orcpt",
                      $addr_smtp, $requoted);
            $orcpt = ';' . $addr_smtp;
          }
        }
        if (lookup2(0,$addr, ca('debug_recipient_maps'))) {
          debug_oneshot(1, $self->{proto} . "< $cmd");
        }
        my $mslm = ca('message_size_limit_maps');
        my $recip_size_limit;
        $recip_size_limit = lookup2(0,$addr,$mslm)  if @$mslm;
        if ($recip_size_limit) {
          # RFC 5321 requires at least 64k
          $recip_size_limit = 65536
            if $recip_size_limit < 65536 &&
               $enforce_smtpd_message_size_limit_64kb_min;
          $max_recip_size_limit = $recip_size_limit
            if $recip_size_limit > $max_recip_size_limit;
        }
        my $mail_size = $msginfo->msg_size;
        if (!defined($msg) && defined($notify)) {
          my(@v) = split(/,/,uc($notify),-1);
          if (grep(!/^(?:NEVER|SUCCESS|FAILURE|DELAY)\z/, @v)) {
            $msg = "501 5.5.4 Error in RCPT parameter NOTIFY, ".
                   "illegal value: $notify";
          } elsif (grep($_ eq 'NEVER', @v) && grep($_ ne 'NEVER', @v)) {
            $msg = "501 5.5.4 Error in RCPT parameter NOTIFY, ".
                   "illegal combination of values: $notify";
          } elsif (!@v) {
            $msg = "501 5.5.4 Error in RCPT parameter NOTIFY, ".
                   "missing value: $notify";
          }
          $notify = \@v;  # replace a string with a listref of items
        }
        if (!defined($msg) && $recip_size_limit) {
          # check mail size if known, update $final_oversized_destiny_all_pass
          my $fd = !ref $oversized_fd_map_ref ? $oversized_fd_map_ref # compat
               : lookup2(0, $addr, $oversized_fd_map_ref, Label => 'Destiny4');
          if (!defined $fd || $fd == D_PASS) {
            $fd = D_PASS;  # keep D_PASS
          } elsif (defined($oversized_lovers_map_ref) &&
                   lookup2(0, $addr, $oversized_lovers_map_ref,
                           Label => 'Lovers4')) {
            $fd = D_PASS;  # D_PASS for oversized lovers
          } else {  # $fd != D_PASS, blocked if oversized
            if ($final_oversized_destiny_all_pass) {
              $final_oversized_destiny_all_pass = 0;  # not PASS for all recips
              do_log(5, 'Not a D_PASS on oversized for all recips: %s', $addr);
            }
          }
          # check declared mail size here if known, otherwise we'll check
          # the actual mail size after the message is received
          if (defined $mail_size && $mail_size > $recip_size_limit) {
            $msg = $fd == D_TEMPFAIL ? '452 4.3.4' :
                   $fd == D_PASS     ? '250 2.3.4' : '552 5.3.4';
            $msg .= " Declared message size ($mail_size B) ".
                    "exceeds size limit for recipient $addr_smtp";
            $msg_nopenalize = 1;
            do_log(0, "%s %s 'RCPT TO': %s", $self->{proto},
                   $fd == D_TEMPFAIL ? 'TEMPFAIL' :
                   $fd == D_PASS ? 'PASS' : 'REJECT',
                   $msg);
          }
        }
        if (!defined($msg) && $got_rcpt > $smtpd_recipient_limit) {
          $msg = "452 4.5.3 Too many recipients";
        }
        if (!defined $msg) {
          $msg = "250 2.1.5 Recipient $addr_smtp OK";
        }
        if ($msg =~ /^2/) {
          my $recip_obj = Amavis::In::Message::PerRecip->new;
          $recip_obj->recip_addr($addr);
          $recip_obj->recip_addr_smtp($addr_smtp);
          $recip_obj->recip_destiny(D_PASS);  # default is Pass
          $recip_obj->dsn_notify($notify)  if defined $notify;
          $recip_obj->dsn_orcpt($orcpt)    if defined $orcpt;
          push(@recips,$recip_obj);
        }
        $self->smtp_resp(0,$msg, !$msg_nopenalize && $msg=~/^5/ ? 1 : 0, $cmd);
        last;
      };

      /^DATA\z/ && $args ne '' && do {
        $self->smtp_resp(1,"501 5.5.4 Error: DATA does not accept arguments",
                         1,$cmd);  #flush
        last;
      };

      /^DATA\z/ && !@recips && do {
        if (!defined($sender_unq)) {
          $self->smtp_resp(1,"503 5.5.1 Need MAIL command before DATA",1,$cmd);
        } elsif (!$got_rcpt) {
          $self->smtp_resp(1,"503 5.5.1 Need RCPT command before DATA",1,$cmd);
        } elsif ($lmtp) {  # RFC 2033 requires 503 code!
          $self->smtp_resp(1,"503 5.1.1 Error (DATA): no valid recipients",
                           0,$cmd);  #flush!
        } else {
          $self->smtp_resp(1,"554 5.1.1 Error (DATA): no valid recipients",
                           0,$cmd);  #flush!
        }
        last;
      };

#     /^DATA\z/ && uc($msginfo->body_type) eq "BINARYMIME" && do {  # RFC 3030
#       $self->smtp_resp(1,"503 5.5.1 DATA is incompatible with BINARYMIME",
#                          0,$cmd);  #flush!
#       last;
#     };

      /^DATA\z/ && do {
        # set timer to the initial value, MTA timer starts here
        if ($message_size_limit) {  # enforce system-wide size limit
          if (!$max_recip_size_limit ||
              $max_recip_size_limit > $message_size_limit) {
            $max_recip_size_limit = $message_size_limit;
          }
        }
        my $size = 0; my $oversized = 0; my $eval_stat; my $complete;
        # preallocate some storage
        my $out_str = ''; vec($out_str,65536,8) = 0; $out_str = '';
        eval {
          $msginfo->sender($sender_unq); $msginfo->sender_smtp($sender_quo);
          $msginfo->per_recip_data(\@recips);
          ll(1) && do_log(1, "%s %s:%s %s: %s -> %s%s Received: %s",
            $conn->appl_proto,
            !ref $inet_socket_bind && $conn->socket_ip eq $inet_socket_bind
              ? '' : '['.$conn->socket_ip.']',
            $conn->socket_port, $self->{tempdir}->path,
            $sender_quo,
            join(',', map($_->recip_addr_smtp, @{$msginfo->per_recip_data})),
            join('',
              !defined $msginfo->msg_size  ? () :  # RFC 1870
                                   ' SIZE='.$msginfo->msg_size,
              !defined $msginfo->body_type ? () : ' BODY='.$msginfo->body_type,
              !$msginfo->smtputf8          ? () : ' SMTPUTF8',
              !defined $msginfo->dsn_ret   ? () : ' RET='.$msginfo->dsn_ret,
              !defined $msginfo->dsn_envid ? () :
                                   ' ENVID='.xtext_decode($msginfo->dsn_envid),
              !defined $msginfo->auth_submitter ||
                       $msginfo->auth_submitter eq '<>' ? () :
                                   ' AUTH='.$msginfo->auth_submitter,
            ),
            make_received_header_field($msginfo,0) );
          # pipelining checkpoint
          $self->smtp_resp(1,"354 End data with <CR><LF>.<CR><LF>");  #flush!
          $self->{within_data_transfer} = 1;
          # data transferring state
          $Amavis::zmq_obj->register_proc(2,0,'d',am_id()) if $Amavis::zmq_obj;
          $Amavis::snmp_db->register_proc(2,0,'d',am_id()) if $Amavis::snmp_db;
          section_time('SMTP pre-DATA-flush')  if $self->{pipelining};
          $self->{tempdir}->empty(0);  # mark the mail file as non-empty
          switch_to_client_time('receiving data');
          my $fh = $self->{tempdir}->fh;
          # the copy_smtp_data() will use syswrite, flush buffer just in case
          if ($fh) { $fh->flush or die "Can't flush mail file: $!" }
          if (!$max_recip_size_limit || $final_oversized_destiny_all_pass) {
            # no message size limit enforced, faster
            ($size,$oversized) = $self->copy_smtp_data($fh, \$out_str, undef);
          } else {  # enforce size limit
            do_log(5,"enforcing size limit %s during DATA",
                     $max_recip_size_limit);
            ($size,$oversized) = $self->copy_smtp_data($fh, \$out_str,
                                                       $max_recip_size_limit);
          };
          switch_to_my_time('rx data-end');
          $complete = !$self->{within_data_transfer};
          $eof = 1  if !$complete;
          # normal data termination, eof on socket, timeout, fatal error
          do_log(4, "%s< .<CR><LF>", $self->{proto})  if $complete;
          if ($fh) {
            $fh->flush or die "Can't flush mail file: $!";
            # On some systems you have to do a seek whenever you
            # switch between reading and writing. Among other things,
            # this may have the effect of calling stdio's clearerr(3).
            $fh->seek(0,1) or die "Can't seek on file: $!";
          }
          section_time('SMTP DATA');
          1;
        } or do {  # end eval
          $eval_stat = $@ ne '' ? $@ : "errno=$!";
        };
        if ( defined $eval_stat || !$complete ||  # err or connection broken
             ($oversized && !$final_oversized_destiny_all_pass) ) {
          chomp $eval_stat  if defined $eval_stat;
          # on error, either send: '421 Shutting down',
          # or: '451 Aborted, error in processing' and NOT shut down!
          if ($oversized && !defined $eval_stat &&
              !$self->{within_data_transfer}) {
            my $msg = "552 5.3.4 Message size ($size B) exceeds size limit";
            do_log(0, "%s REJECT: %s", $self->{proto},$msg);
            $self->smtp_resp(1,$msg, 0,$cmd);
          } elsif (!$self->{within_data_transfer}) {
            my $msg = 'Error in processing: ' .
                      (defined $eval_stat ? $eval_stat
                       : !$complete ? 'incomplete' : '(no error?)');
            do_log(-2, "%s TROUBLE: 451 4.5.0 %s", $self->{proto},$msg);
            $self->smtp_resp(1,"451 4.5.0 $msg");
        ### $aborting = $msg;
          } else {
            $aborting = "Connection broken during data transfer"  if $eof;
            $aborting .= ', '  if $aborting ne '' && defined $eval_stat;
            $aborting .= $eval_stat  if defined $eval_stat;
            $aborting .= " during waiting for input from client"
              if defined $eval_stat && $eval_stat =~ /^timed out\b/
                 && waiting_for_client();
            $aborting = '???'  if $aborting eq '';
            do_log(defined $eval_stat ? -1 : 3,
                   "%s ABORTING: %s", $self->{proto}, $aborting);
          }
        } else {  # all OK
          # According to RFC 1047 it is not a good idea to do lengthy
          # processing here, but we do not have much choice, amavis has no
          # queuing mechanism and cannot accept responsibility for delivery.
          #
          # check contents before responding
          # check_mail() expects an open file handle in $msginfo->mail_text,
          # need not be rewound
          $msginfo->mail_tempdir($self->{tempdir}->path);
          $msginfo->mail_text_fn($self->{tempdir}->path . '/email.txt');
          $msginfo->mail_text($self->{tempdir}->fh);
          $msginfo->mail_text_str(\$out_str)  if defined $out_str &&
                                                 $out_str ne '';
          #
          # RFC 1870: The message size is defined as the number of octets,
          # including CR-LF pairs, but not counting the SMTP DATA command's
          # terminating dot or doubled (stuffing) dots
          my $declared_size = $msginfo->msg_size;  # RFC 1870
          if (!defined($declared_size)) {
            do_log(5, "message size set to %s", $size);
          } elsif ($size > $declared_size) { # shouldn't happen with decent MTA
            do_log(4,"Actual message size %s B greater than the ".
                     "declared %s B", $size,$declared_size);
          } elsif ($size < $declared_size) { # not unusual, but permitted
            do_log(4,"Actual message size %d B less than the declared %d B",
                     $size,$declared_size);
          }
          $msginfo->msg_size(untaint($size)); # store actual RFC 1870 mail size

          # some fatal errors are not catchable by eval (like exceeding virtual
          # memory), but may still allow processing to continue in a DESTROY or
          # END method; turn on trouble flag here to allow DESTROY to deal with
          # such a case correctly, then clear the flag after content checking
          # if everything turned out well
          $self->{tempdir}->preserve(1);
          my($smtp_resp, $exit_code, $preserve_evidence) =
            &$check_mail($msginfo,$lmtp);  # do all the contents checking
          $self->{tempdir}->preserve(0)  if !$preserve_evidence;  # clear if ok
          prolong_timer('check done');

          if ($smtp_resp =~ /^4/) {
            # ok, not-done recipients are to be expected, do not check
          } elsif (grep(!$_->recip_done && $_->delivery_method ne '',
                        @{$msginfo->per_recip_data})) {
            die "TROUBLE: (MISCONFIG?) not all recipients done";
          } elsif (grep(!$_->recip_done && $_->delivery_method eq '',
                        @{$msginfo->per_recip_data})) {
            die "NOT ALL RECIPIENTS DONE, EMPTY DELIVERY_METHOD!";
          # do_log(0, "NOT ALL RECIPIENTS DONE, EMPTY DELIVERY_METHOD!");
          }
          section_time('SMTP pre-response');
          if (!$lmtp) {  # smtp
            do_log(3, 'sending SMTP response: "%s"', $smtp_resp);
            $self->smtp_resp(0, $smtp_resp);
          } else {       # lmtp
            my $bounced = $msginfo->dsn_sent;  # 1=bounced, 2=suppressed
            for my $r (@{$msginfo->per_recip_data}) {
              my $resp = $r->recip_smtp_response;
              my $recip_quoted = $r->recip_addr_smtp;
              if ($resp=~/^[24]/) {
                # success or tempfail, no need to change status
              } elsif ($bounced && $bounced == 1) {  # genuine bounce
                # a non-delivery notifications was already sent by us, so
                # MTA must not bounce it again; turn status into a success
                $resp = sprintf("250 2.5.0 Ok %s, DSN was sent (%s)",
                                $recip_quoted, $resp);
              } elsif ($bounced) {  # fake bounce - bounce was suppressed
                $resp = sprintf("250 2.5.0 Ok %s, DSN suppressed (%s)",
                                $recip_quoted, $resp);
              } elsif ($resp=~/^5/ && $r->recip_destiny != D_REJECT) {
                # just in case, if the bounce suppression scheme did not work
                $resp = sprintf("250 2.5.0 Ok %s, DSN suppressed_2 (%s)",
                                $recip_quoted, $resp);
              }
              do_log(3, 'LMTP response for %s: "%s"', $recip_quoted, $resp);
              $self->smtp_resp(0, $resp);
            }
          }
          $self->smtp_resp_flush;  # optional, but nice to report timing right
          section_time('SMTP response');
        };  # end all OK
        $self->{tempdir}->clean;
        my $msg_size = $msginfo->msg_size;
        my $sa_rusage = $msginfo->supplementary_info('RUSAGE-SA');
        $sender_unq = $sender_quo = undef; @recips = (); $got_rcpt = 0;
        undef $max_recip_size_limit; undef $msginfo;  # forget previous
        $final_oversized_destiny_all_pass = 1;
        %xforward_args = ();
        section_time('dump_captured_log')  if log_capture_enabled();
        dump_captured_log(1, c('enable_log_capture_dump'));
        %current_policy_bank = %baseline_policy_bank;  # restore bank settings
        # report elapsed times by section for each transaction
        # (the time for a QUIT remains unaccounted for)
        if (ll(2)) {
          my $am_rusage_report = Amavis::Timing::rusage_report();
          my $am_timing_report = Amavis::Timing::report();
          if ($sa_rusage && @$sa_rusage) {
            local $1; my $sa_cpu_sum = 0; $sa_cpu_sum += $_ for @$sa_rusage;
            $am_timing_report =~  # ugly hack
              s{\bcpu ([0-9.]+) ms\]}
               {sprintf("cpu %s ms, AM-cpu %.0f ms, SA-cpu %.0f ms]",
                        $1, $1 - $sa_cpu_sum*1000, $sa_cpu_sum*1000) }se;
          }
          do_log(2,"size: %d, %s", $msg_size, $am_timing_report);
          do_log(2,"size: %d, RUSAGE %s", $msg_size, $am_rusage_report)
            if defined $am_rusage_report;
        }
        Amavis::Timing::init(); snmp_counters_init();
        $Amavis::last_task_completed_at = Time::HiRes::time;
        last;
      };  # DATA

      /^(?:EXPN|TURN|ETRN|SEND|SOML|SAML)\z/ && do {
        $self->smtp_resp(1,"502 5.5.1 Error: command $_ not implemented",
                           0,$cmd);
        last;
      };
      # catchall (unknown commands):  #flush!
      $self->smtp_resp(1,"500 5.5.2 Error: command $_ not recognized", 1,$cmd);
    };  # end of 'switch' block
    if ($terminating || defined $aborting) {  # exit SMTP-session loop
      $voluntary_exit = 1; last;
    }

    # don't bother, just flush any responses regardless of pending input;
    # this also keeps us on the safe side when a Postfix pre-queue setup
    # turns HELO into EHLO sessions and smtpd_proxy_options=speed_adjust
    # is not in use
    $self->smtp_resp_flush;
#
#   if ($self->{smtp_outbuf} && @{$self->{smtp_outbuf}} &&
#       $self->{pipelining}) {
#     # RFC 2920 requires a flush whenever a local TCP input buffer is emptied
#     my $fd_sock = fileno($sock);
#     my $rout; my $rin = ''; vec($rin,$fd_sock,1) = 1;
#     my($nfound, $timeleft) = select($rout=$rin, undef, undef, 0);
#     if (defined $nfound && $nfound > 0 && vec($rout, $fd_sock, 1)) {
#       # input is available, do not bother flushing output yet
#       do_log(2,"pipelining in effect, input available, flush delayed");
#     } else {
#       $self->smtp_resp_flush;
#     }
#   }

    $0 = sprintf("%s (ch%d-%s-idle)",
                c('myprogram_name'), $Amavis::child_invocation_count, am_id());
    Amavis::Timing::go_idle(6);
  } # end of loop
  my($errn,$errs);
  if (!$voluntary_exit) {
    $eof = 1;
    if (!defined($_)) {
      $errn = 0+$!;
      $errs = !$self->{ssl_active} ? "$!" : $sock->errstr.", $!";
    }
  }
  # come here when: QUIT is received, eof or err on socket, or we need to abort
  $0 = sprintf("%s (ch%d)",
               c('myprogram_name'), $Amavis::child_invocation_count);
  alarm(0); do_log(4,"SMTP session over, timer stopped");
  Amavis::Timing::go_busy(7);
  # flush just in case, session might have been disconnected
  eval {
    $self->smtp_resp_flush;  1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    do_log(1, "flush failed: %s", $eval_stat);
  };
  my $msg =
    defined $aborting && !$eof ? "ABORTING the session: $aborting" :
    defined $aborting ? $aborting :
    !$terminating ? "client broke the connection without a QUIT ($errs)" : '';
  if ($msg eq '') {
    # ok
  } elsif ($aborting) {
    do_log(-1, "%s: NOTICE: %s", $self->{proto},$msg);
  } else {
    do_log( 3, "%s: notice: %s", $self->{proto},$msg);
  }
  if (defined $aborting && !$eof)
    { $self->smtp_resp(1,"421 4.3.2 Service shutting down, ".$aborting) }
  $self->{session_closed_normally} = 1;
  # Net::Server closes connection after child_finish_hook
}

# sends an SMTP response consisting of a 3-digit code and an optional message;
# slow down evil clients by delaying response on permanent errors
#
sub smtp_resp($$$;$$) {
  my($self, $flush,$resp, $penalize,$line) = @_;
  if ($penalize) {  # PENALIZE syntax errors?
    do_log(0, "%s: %s; smtp_resp: %s", $self->{proto},$resp,$line);
#   sleep 1;
#   section_time('SMTP penalty wait');
  }
  push(@{$self->{smtp_outbuf}}, @{wrap_smtp_resp(sanitize_str($resp,1))});
  $self->smtp_resp_flush   if $flush || !$self->{pipelining} ||
                              @{$self->{smtp_outbuf}} > 200;
}

sub smtp_resp_flush($) {
  my $self = $_[0];
  my $outbuf_ref = $self->{smtp_outbuf};
  if ($outbuf_ref && @$outbuf_ref) {
    if (ll(4)) { do_log(4, "%s> %s", $self->{proto}, $_) for @$outbuf_ref }
    my $sock = $self->{sock};
    my $stat = $sock->print(join('', map($_."\015\012", @$outbuf_ref)));
    @$outbuf_ref = ();  # prevent printing again even if error
    $stat or die "Error writing an SMTP response to the socket: ".
                            (!$self->{ssl_active} ? $! : $sock->errstr.", $!");
    $sock->flush or die "Error flushing an SMTP response to the socket: ".
                            (!$self->{ssl_active} ? $! : $sock->errstr.", $!");
    # put a ball in client's courtyard, start his timer
    switch_to_client_time('smtp response sent');
  }
}

1;
