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

package Amavis::In::AMPDP;
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 subs @EXPORT;

use Errno qw(ENOENT EACCES);
use IO::File ();
use Time::HiRes ();
use Digest::MD5;
use MIME::Base64;

use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::In::Connection;
use Amavis::In::Message;
use Amavis::IO::Zlib;
use Amavis::Lookup qw(lookup lookup2);
use Amavis::Lookup::IP qw(lookup_ip_acl normalize_ip_addr);
use Amavis::Notify qw(msg_from_quarantine);
use Amavis::Out qw(mail_dispatch);
use Amavis::Out::EditHeader qw(hdr);
use Amavis::rfc2821_2822_Tools;
use Amavis::TempDir;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log debug_oneshot dump_captured_log
                    untaint snmp_counters_init read_file
                    snmp_count proto_encode proto_decode
                    switch_to_my_time switch_to_client_time
                    am_id new_am_id add_entropy rmdir_recursively
                    generate_mail_id);

sub new($) { my $class = $_[0];  bless {}, $class }

# used with sendmail milter and traditional (non-SMTP) MTA interface,
# but also to request a message release from a quarantine
#
sub process_policy_request($$$$) {
  my($self, $sock, $conn, $check_mail, $old_amcl) = @_;
  # $sock:       connected socket from Net::Server
  # $conn:       information about client connection
  # $check_mail: subroutine ref to be called with file handle

  my(%attr);
  $0 = sprintf("%s (ch%d-P-idle)",
               c('myprogram_name'), $Amavis::child_invocation_count);
  ll(5) && do_log(5, "process_policy_request: %s, %s, fileno=%s",
                     $old_amcl, c('myprogram_name'), fileno($sock));
  if ($old_amcl) {
    # Accept a single request from traditional amavis helper program.
    # Receive TEMPDIR/SENDER/RCPTS/LDA/LDAARGS from client
    # Simple protocol: \2 means LDA follows; \3 means EOT (end of transmission)
    die "process_policy_request: old AM.CL protocol is no longer supported\n";

  } else {  # new amavis helper protocol AM.PDP or a Postfix policy server
    # for Postfix policy server see Postfix docs SMTPD_POLICY_README
    my(@response); local($1,$2,$3);
    local($/) = "\012";  # set line terminator to LF (Postfix idiosyncrasy)
    my $ln;  # can accept multiple tasks
    switch_to_client_time("start receiving AM.PDP data");
    $conn->appl_proto('AM.PDP');
    for ($! = 0; defined($ln=$sock->getline); $! = 0) {
      my $end_of_request = $ln =~ /^\015?\012\z/ ? 1 : 0;  # end of request?
      switch_to_my_time($end_of_request ? 'rx entire AM.PDP request'
                                        : 'rx AM.PDP line');
      $0 = sprintf("%s (ch%d-P)",
                   c('myprogram_name'), $Amavis::child_invocation_count);
      Amavis::Timing::init(); snmp_counters_init();
      # must not use \r and \n, not the same as \015 and \012 on some platforms
      if ($end_of_request) {  # end of request
        section_time('got data');
        my $msg_size;
        eval {
          my($msginfo,$bank_names_ref) = preprocess_policy_query(\%attr,$conn);
          $Amavis::MSGINFO = $msginfo;  # ugly
          my $req = lc($attr{'request'});
          @response = $req eq 'smtpd_access_policy'
                        ? postfix_policy($msginfo,\%attr)
                  : $req =~ /^(?:release|requeue|report)\z/
                        ? dispatch_from_quarantine($msginfo, $req,
                                 $req eq 'report' ? 'abuse' : 'miscategorized')
                  : check_ampdp_policy($msginfo,$check_mail,0,$bank_names_ref);
          $msg_size = $msginfo->msg_size;
          undef $Amavis::MSGINFO;  # release global reference
          1;
        } or do {
          my $err = $@ ne '' ? $@ : "errno=$!";  chomp $err;
          do_log(-2, "policy_server FAILED: %s", $err);
          @response = (proto_encode('setreply','450','4.5.0',"Failure: $err"),
                       proto_encode('return_value','tempfail'),
                       proto_encode('exit_code',sprintf("%d",EX_TEMPFAIL)));
          die $err  if $err =~ /^timed out\b/;  # resignal timeout
        # last;
        };
        $sock->print( join('', map($_."\015\012", (@response,'')) ))
          or die "Can't write response to socket: $!, fileno=".fileno($sock);
        %attr = (); @response = ();
        if (ll(2)) {
          my $rusage_report = Amavis::Timing::rusage_report();
          do_log(2,"size: %d, %s", $msg_size, Amavis::Timing::report());
          do_log(2,"size: %d, RUSAGE %s", $msg_size, $rusage_report)
            if defined $rusage_report;
        }
      } elsif ($ln =~ /^ ([^=\000\012]*?) (=|:[ \t]*)
                         ([^\012]*?) \015?\012 \z/xsi) {
        my $attr_name = proto_decode($1);
        my $attr_val  = proto_decode($3);
        if (!exists $attr{$attr_name}) {
          $attr{$attr_name} = $attr_val;
        } else {
          $attr{$attr_name} = [ $attr{$attr_name} ]  if !ref $attr{$attr_name};
          push(@{$attr{$attr_name}}, $attr_val);
        }
        my $known_attr = scalar(grep($_ eq $attr_name, qw(
          request protocol_state version_client protocol_name helo_name
          client_name client_address client_port client_source sender recipient
          delivery_care_of queue_id partition_tag mail_id secret_id quar_type
          mail_file tempdir tempdir_removed_by policy_bank requested_by) ));
        do_log(!$known_attr?1:3,
               "policy protocol: %s=%s", $attr_name,$attr_val);
      } else {
        do_log(-1, "policy protocol: INVALID AM.PDP ATTRIBUTE LINE: %s", $ln);
      }
      $0 = sprintf("%s (ch%d-P-idle)",
                   c('myprogram_name'), $Amavis::child_invocation_count);
      switch_to_client_time("receiving AM.PDP data");
    }
    defined $ln || $! == 0  or die "Read from client socket FAILED: $!";
    switch_to_my_time('end of AM.PDP session');
  };
  $0 = sprintf("%s (ch%d-P)",
               c('myprogram_name'), $Amavis::child_invocation_count);
}

# Based on given query attributes describing a message to be checked or
# released, return a new Amavis::In::Message object with filled-in information
#
sub preprocess_policy_query($$) {
  my($attr_ref,$conn) = @_;

  my $now = Time::HiRes::time;
  my $msginfo = Amavis::In::Message->new;
  $msginfo->rx_time($now);
  $msginfo->log_id(am_id());
  $msginfo->conn_obj($conn);
  $msginfo->originating(1);
  $msginfo->add_contents_category(CC_CLEAN,0);
  add_entropy(%$attr_ref);

  # amavisd -> amavis-helper protocol query consists of any number of
  # the following lines, the response is terminated by an empty line.
  # The 'request=AM.PDP' is a required first field, the order of
  # remaining fields is arbitrary, but multivalued attributes such as
  # 'recipient' must retain their relative order.
  # Required AM.PDP fields are: request, tempdir, sender, recipient(s)
  #   request=AM.PDP
  #   version_client=n             (currently ignored)
  #   tempdir=/var/amavis/amavis-milter-MWZmu9Di
  #   tempdir_removed_by=client    (tempdir_removed_by=server is a default)
  #   mail_file=/var/amavis/am.../email.txt (defaults to tempdir/email.txt)
  #   sender=<foo@example.com>
  #   recipient=<bar1@example.net>
  #   recipient=<bar2@example.net>
  #   recipient=<bar3@example.net>
  #   delivery_care_of=server      (client or server, client is a default)
  #   queue_id=qid
  #   protocol_name=ESMTP
  #   helo_name=host.example.com
  #   client_address=10.2.3.4
  #   client_port=45678
  #   client_name=host.example.net
  #   client_source=LOCAL/REMOTE/[UNAVAILABLE]
  #     (matches local_header_rewrite_clients, see Postfix XFORWARD_README)
  #   policy_bank=SMTP_AUTH,TLS,ORIGINATING,MYNETS,...
  # Required 'release' or 'requeue' or 'report' fields are: request, mail_id
  #   request=release  (or request=requeue, or request=report)
  #   mail_id=xxxxxxxxxxxx
  #   secret_id=xxxxxxxxxxxx              (authorizes a release/report)
  #   partition_tag=xx                    (required if mail_id is not unique)
  #   quar_type=x                         F/Z/B/Q/M  (defaults to Q or F)
  #                                       file/zipfile/bsmtp/sql/mailbox
  #   mail_file=...  (optional: overrides automatics; $QUARANTINEDIR prepended)
  #   requested_by=<releaser@example.com> (optional: lands in Resent-From:)
  #   sender=<foo@example.com>            (optional: replaces envelope sender)
  #   recipient=<bar1@example.net>        (optional: replaces envelope recips)
  #   recipient=<bar2@example.net>
  #   recipient=<bar3@example.net>
  my(@recips); my(@bank_names);
  exists $attr_ref->{'request'} or die "Missing 'request' field";
  my $ampdp = $attr_ref->{'request'} =~
                               /^(?:AM\.CL|AM\.PDP|release|requeue|report)\z/i;
  local $1;
  @bank_names =
    map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $attr_ref->{'policy_bank'}))
    if defined $attr_ref->{'policy_bank'};
  my $d_co  = $attr_ref->{'delivery_care_of'};
  my $td_rm = $attr_ref->{'tempdir_removed_by'};
  $msginfo->client_delete(defined($td_rm) && lc($td_rm) eq 'client' ? 1 : 0);
  $msginfo->queue_id($attr_ref->{'queue_id'})
    if exists $attr_ref->{'queue_id'};
  $msginfo->client_proto($attr_ref->{'protocol_name'})
    if exists $attr_ref->{'protocol_name'};
  if (exists $attr_ref->{'client_address'}) {
    $msginfo->client_addr(normalize_ip_addr($attr_ref->{'client_address'}));
  }
  $msginfo->client_port($attr_ref->{'client_port'})
    if exists $attr_ref->{'client_port'};
  $msginfo->client_name($attr_ref->{'client_name'})
    if exists $attr_ref->{'client_name'};
  $msginfo->client_source($attr_ref->{'client_source'})
    if exists $attr_ref->{'client_source'}
       &&  uc($attr_ref->{'client_source'}) ne '[UNAVAILABLE]';
  $msginfo->client_helo($attr_ref->{'helo_name'})
    if exists $attr_ref->{'helo_name'};
# $msginfo->body_type('8BITMIME');
  $msginfo->requested_by(unquote_rfc2821_local($attr_ref->{'requested_by'}))
    if exists $attr_ref->{'requested_by'};
  if (exists $attr_ref->{'sender'}) {
    my $sender = $attr_ref->{'sender'};
    $sender = '<'.$sender.'>'  if $sender !~ /^<.*>\z/;
    $msginfo->sender_smtp($sender);
    $sender = unquote_rfc2821_local($sender);
    $msginfo->sender($sender);
  }
  if (exists $attr_ref->{'recipient'}) {
    my $r = $attr_ref->{'recipient'}; @recips = ();
    for my $addr (!ref($r) ? $r : @$r) {
      my $addr_quo = $addr;
      my $addr_unq = unquote_rfc2821_local($addr);
      $addr_quo = '<'.$addr_quo.'>'  if $addr_quo !~ /^<.*>\z/;
      my $recip_obj = Amavis::In::Message::PerRecip->new;
      $recip_obj->recip_addr($addr_unq);
      $recip_obj->recip_addr_smtp($addr_quo);
      $recip_obj->dsn_orcpt($addr_quo);
      $recip_obj->recip_destiny(D_PASS);  # default is Pass
      $recip_obj->delivery_method('')  if !defined($d_co) ||
                                          lc($d_co) eq 'client';
      push(@recips,$recip_obj);
    }
    $msginfo->per_recip_data(\@recips);
  }
  if (!exists $attr_ref->{'tempdir'}) {
    my $tempdir = Amavis::TempDir->new;
    $tempdir->prepare_dir;
    $msginfo->mail_tempdir($tempdir->path);
    # Save the Amavis::TempDir object from destruction by keeping a ref to it
    # in $msginfo. When $msginfo is destroyed, the temporary directory will be
    # automatically destroyed too. This is specific to AM.PDP requests without
    # a working directory provided by a caller, and different from usual
    # SMTP sessions which keep a per-process permanent reference to an
    # Amavis::TempDir object, which makes keeping it in mail_tempdir_obj
    # not necessary.
    $msginfo->mail_tempdir_obj($tempdir);
  } else {
    local($1,$2); my $tempdir = $attr_ref->{tempdir};
    $tempdir =~ m{^ (?: \Q$TEMPBASE\E | \Q$MYHOME\E )
                    (?: / (?! \.\. (?:\z|/)) [A-Za-z0-9_.-]+ )*
                    / [A-Za-z0-9_.-]+ \z}xso
      or die "Suspicious temporary directory name '$tempdir'";
    $msginfo->mail_tempdir(untaint($tempdir));
  }
  my $quar_type;
  my $p_mail_id;
  if (!$ampdp) {
    # don't bother with filenames
  } elsif ($attr_ref->{'request'} =~ /^(?:release|requeue|report)\z/i) {
    exists $attr_ref->{'mail_id'} or die "Missing 'mail_id' field";
    $msginfo->partition_tag($attr_ref->{'partition_tag'});  # may be undef
    $p_mail_id = $attr_ref->{'mail_id'};
    # amavisd almost-base64: 62 +, 63 -  (in use up to 2.6.4, dropped in 2.7.0)
    # RFC 4648 base64:       62 +, 63 /  (not used here)
    # RFC 4648 base64url:    62 -, 63 _
    $p_mail_id =~ m{^ [A-Za-z0-9] [A-Za-z0-9_+-]* ={0,2} \z}xs
      or die "Invalid mail_id '$p_mail_id'";
    $p_mail_id = untaint($p_mail_id);
    $msginfo->parent_mail_id($p_mail_id);
    $msginfo->mail_id(scalar generate_mail_id());
    if (!exists($attr_ref->{'secret_id'}) || $attr_ref->{'secret_id'} eq '') {
      die "Secret_id is required, but missing"  if c('auth_required_release');
    } else {
      # version 2.7.0 and later uses RFC 4648 base64url and id=b64(md5(sec)),
      # versions before 2.7.0 used almost-base64 and id=b64(md5(b64(sec)))
      { # begin block, 'last' exits it
        my $secret_b64 = $attr_ref->{'secret_id'};
        $secret_b64 = ''  if !defined $secret_b64;
        if (index($secret_b64,'+') < 0) {  # new or undetermined format
          local($_) = $secret_b64;  tr{-_}{+/};  # revert base64url to base64
          my $secret_bin = decode_base64($_);
          my $id_new_b64 = Digest::MD5->new->add($secret_bin)->b64digest;
          substr($id_new_b64, 12) = '';
          $id_new_b64 =~ tr{+/}{-_};  # base64 -> RFC 4648 base64url
          last  if $id_new_b64 eq $p_mail_id;  # exit enclosing block
        }
        if (index($secret_b64,'_') < 0) {  # old or undetermined format
          my $id_old_b64 = Digest::MD5->new->add($secret_b64)->b64digest;
          substr($id_old_b64, 12) = '';
          $id_old_b64 =~ tr{/}{-};  # base64 -> almost-base64
          last  if $id_old_b64 eq $p_mail_id;  # exit enclosing block
        }
        die "Secret_id $secret_b64 does not match mail_id $p_mail_id";
      };  # end block, 'last' arrives here
    }
    $quar_type = $attr_ref->{'quar_type'};
    if (!defined($quar_type) || $quar_type eq '') {
      # choose some reasonable default (simpleminded)
      $quar_type = c('spam_quarantine_method') =~ /^sql:/i ? 'Q' : 'F';
    }
    my $fn = $p_mail_id;
    if ($quar_type eq 'F' || $quar_type eq 'Z') {
      $QUARANTINEDIR ne '' or die "Config variable \$QUARANTINEDIR is empty";
      if ($attr_ref->{'mail_file'} ne '') {
        $fn = $attr_ref->{'mail_file'};
        $fn =~ m{^[A-Za-z0-9][A-Za-z0-9/_.+-]*\z}s && $fn !~ m{\.\.(?:/|\z)}
          or die "Unsafe filename '$fn'";
        $fn = $QUARANTINEDIR.'/'.untaint($fn);
      } else {  # automatically guess a filename - simpleminded
        if ($quarantine_subdir_levels < 1) { $fn = "$QUARANTINEDIR/$fn" }
        else { my $subd = substr($fn,0,1);   $fn = "$QUARANTINEDIR/$subd/$fn" }
        $fn .= '.gz'  if $quar_type eq 'Z';
      }
    }
    $msginfo->mail_text_fn($fn);
  } elsif (!exists $attr_ref->{'mail_file'}) {
    $msginfo->mail_text_fn($msginfo->mail_tempdir . '/email.txt');
  } else {
    # SECURITY: just believe the supplied file name, blindly untainting it
    $msginfo->mail_text_fn(untaint($attr_ref->{'mail_file'}));
  }
  my $fname = $msginfo->mail_text_fn;
  if ($ampdp && defined($fname) && $fname ne '') {
    my $fh;
    my $releasing = $attr_ref->{'request'}=~ /^(?:release|requeue|report)\z/i;
    new_am_id('rel-'.$msginfo->mail_id)  if $releasing;
    if ($releasing && $quar_type eq 'Q') {  # releasing from SQL
      do_log(5, "preprocess_policy_query: opening in sql: %s", $p_mail_id);
      my $obj = $Amavis::sql_storage;
      $Amavis::extra_code_sql_quar && $obj
        or die "SQL quarantine code not enabled (3)";
      my $conn_h = $obj->{conn_h}; my $sql_cl_r = cr('sql_clause');
      my $sel_msg  = $sql_cl_r->{'sel_msg'};
      my $sel_quar = $sql_cl_r->{'sel_quar'};
      if (!defined($msginfo->partition_tag) &&
          defined($sel_msg) && $sel_msg ne '') {
        do_log(5, "preprocess_policy_query: missing partition_tag in request,".
                  " fetching msgs record for mail_id=%s", $p_mail_id);
        # find a corresponding partition_tag if missing from a release request
        $conn_h->begin_work_nontransaction;  #(re)connect if necessary
        $conn_h->execute($sel_msg, $p_mail_id);
        my $a_ref; my $cnt = 0; my $partition_tag;
        while ( defined($a_ref=$conn_h->fetchrow_arrayref($sel_msg)) ) {
          $cnt++;
          $partition_tag = $a_ref->[0]  if !defined $partition_tag;
          ll(5) && do_log(5, "release: got msgs record for mail_id=%s: %s",
                             $p_mail_id, join(', ',@$a_ref));
        }
        $conn_h->finish($sel_msg)  if defined $a_ref;  # only if not all read
        $cnt <= 1 or die "Multiple ($cnt) records with same mail_id exist, ".
                         "specify a partition_tag in the AM.PDP request";
        if ($cnt < 1) {
          do_log(0, "release: no records with msgs.mail_id=%s in a database, ".
                    "trying to read from a quar. anyway", $p_mail_id);
        }
        $msginfo->partition_tag($partition_tag);  # could still be undef/NULL !
      }
      ll(5) && do_log(5, "release: opening mail_id=%s, partition_tag=%s",
                         $p_mail_id, $msginfo->partition_tag);
      $conn_h->begin_work_nontransaction;  # (re)connect if not connected
      $fh = Amavis::IO::SQL->new;
      $fh->open($conn_h, $sel_quar, $p_mail_id,
                'r', untaint($msginfo->partition_tag))
        or die "Can't open sql obj for reading: $!";  1;
    } else {  # mail checking or releasing from a file
      do_log(5, "preprocess_policy_query: opening mail '%s'", $fname);
      # set new amavis message id
      new_am_id( ($fname =~ m{amavis-(milter-)?([^/ \t]+)}s ? $2 : undef),
                 $Amavis::child_invocation_count )  if !$releasing;
      # file created by amavis helper program or other client, just open it
      my(@stat_list) = lstat($fname); my $errn = @stat_list ? 0 : 0+$!;
      if ($errn == ENOENT) { die "File $fname does not exist" }
      elsif ($errn) { die "File $fname inaccessible: $!" }
      elsif (!-f _) { die "File $fname is not a plain file" }
      add_entropy(@stat_list);
      if ($fname =~ /\.gz\z/) {
        $fh = Amavis::IO::Zlib->new;
        $fh->open($fname,'rb') or die "Can't open gzipped file $fname: $!";
      } else {
      # $msginfo->msg_size(0 + (-s _));  # underestimates the RFC 1870 size
        $fh = IO::File->new;
        $fh->open($fname,'<') or die "Can't open file $fname: $!";
        binmode($fh,':bytes') or die "Can't cancel :utf8 mode: $!";
        my $file_size = $stat_list[7];
        if ($file_size < 100*1024) {  # 100 KiB 'small mail', read into memory
          do_log(5, 'preprocess_policy_query: reading from %s to memory, '.
                    'file size %d bytes', $fname, $file_size);
          my $str = ''; read_file($fh,\$str);
          $fh->seek(0,0) or die "Can't rewind file $fname: $!";
          $msginfo->mail_text_str(\$str);  # save mail as a string
        }
      }
    }
    $msginfo->mail_text($fh);  # save file handle to object
    $msginfo->log_id(am_id());
  }
  if ($ampdp && ll(3)) {
    do_log(3, "Request: %s %s %s: %s -> %s", $attr_ref->{'request'},
              $attr_ref->{'mail_id'}, $msginfo->mail_tempdir,
              $msginfo->sender_smtp,
              join(',', map($_->recip_addr_smtp, @recips)) );
  } else {
    do_log(3, "Request: %s(%s): %s %s %s: %s[%s] <%s> -> <%s>",
              @$attr_ref{qw(request protocol_state mail_id protocol_name
              queue_id client_name client_address sender recipient)});
  }
  ($msginfo, \@bank_names);
}

sub check_ampdp_policy($$$$) {
  my($msginfo,$check_mail,$old_amcl,$bank_names_ref) = @_;
  my($smtp_resp, $exit_code, $preserve_evidence);
  my(%baseline_policy_bank) = %current_policy_bank;
  # do some sanity checks before deciding to call check_mail()
  if (!ref($msginfo->per_recip_data) || !defined($msginfo->mail_text)) {
    $smtp_resp = '450 4.5.0 Incomplete request'; $exit_code = EX_TEMPFAIL;
  } else {
    # loading a policy bank can affect subsequent c(), cr() and ca() results,
    # so it is necessary to load each policy bank in the right order and soon
    # after information becomes available; general principle is that policy
    # banks are loaded in order in which information becomes available:
    # interface/socket, client IP, SMTP session info, sender, ...
    my $cl_ip  = $msginfo->client_addr;
    my $cl_src = $msginfo->client_source;
    my(@bank_names_cl);
    { my $cl_ip_tmp = $cl_ip;
      # treat unknown client IP addr 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;
    # additional banks from the request
    Amavis::load_policy_bank(untaint($_),$msginfo) for @$bank_names_ref;
    $msginfo->originating(c('originating'));
    my $sender = $msginfo->sender;
    if (defined $policy_bank{'MYUSERS'} &&
        $sender ne '' && $msginfo->originating &&
        lookup2(0,$sender, ca('local_domains_maps'))) {
      Amavis::load_policy_bank('MYUSERS',$msginfo);
    }
    my $debrecipm = ca('debug_recipient_maps');
    if (lookup2(0, $sender, ca('debug_sender_maps')) ||
        @$debrecipm && grep(lookup2(0, $_->recip_addr, $debrecipm),
                                    @{$msginfo->per_recip_data})) {
      debug_oneshot(1);
    }
    # check_mail() expects open file on $fh, need not be rewound
    Amavis::check_mail_begin_task();
    ($smtp_resp, $exit_code, $preserve_evidence) = &$check_mail($msginfo,0);
    my $fh = $msginfo->mail_text;  my $tempdir = $msginfo->mail_tempdir;
    $fh->close or die "Error closing temp file: $!"   if $fh;
    undef $fh; $msginfo->mail_text(undef);
    $msginfo->mail_text_str(undef); $msginfo->body_start_pos(undef);
    my $errn = $tempdir eq '' ? ENOENT : (stat($tempdir) ? 0 : 0+$!);
    if ($tempdir eq '' || $errn == ENOENT) {
      # do nothing
    } elsif ($msginfo->client_delete) {
      do_log(4, "AM.PDP: deletion of %s is client's responsibility", $tempdir);
    } elsif ($preserve_evidence) {
      do_log(-1,'AM.PDP: tempdir is to be PRESERVED: %s', $tempdir);
    } else {
      my $fname = $msginfo->mail_text_fn;
      do_log(4, 'AM.PDP: tempdir and file being removed: %s, %s',
                $tempdir,$fname);
      unlink($fname) or die "Can't remove file $fname: $!"  if $fname ne '';
      # must step out of the directory which is about to be deleted,
      # otherwise rmdir can fail (e.g. on Solaris)
      chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!";
      rmdir_recursively($tempdir);
    }
  }
  # amavisd -> amavis-helper protocol response consists of any number of
  # the following lines, the response is terminated by an empty line:
  #   version_server=2
  #   log_id=xxx
  #   delrcpt=<recipient>
  #   addrcpt=<recipient>
  #   delheader=hdridx hdr_head
  #   chgheader=hdridx hdr_head hdr_body
  #   insheader=hdridx hdr_head hdr_body
  #   addheader=hdr_head hdr_body
  #   replacebody=new_body  (not implemented)
  #   quarantine=reason  (currently never used, supposed to call
  #                       smfi_quarantine, placing message on hold)
  #   return_value=continue|reject|discard|accept|tempfail
  #   setreply=rcode xcode message
  #   exit_code=n

  my(@response); my($rcpt_deletes,$rcpt_count)=(0,0);
  push(@response, proto_encode('version_server', '2'));
  push(@response, proto_encode('log_id', $msginfo->log_id));
  for my $r (@{$msginfo->per_recip_data}) {
    $rcpt_count++;
    $rcpt_deletes++  if $r->recip_done;
  }
  local($1,$2,$3);
  if ($smtp_resp=~/^([1-5]\d\d) ([245]\.\d{1,3}\.\d{1,3})(?: |\z)(.*)\z/s)
    { push(@response, proto_encode('setreply', $1,$2,$3)) }
  if (     $exit_code == EX_TEMPFAIL) {
    push(@response, proto_encode('return_value','tempfail'));
  } elsif ($exit_code == EX_NOUSER) {          # reject the whole message
    push(@response, proto_encode('return_value','reject'));
  } elsif ($exit_code == EX_UNAVAILABLE) {     # reject the whole message
    push(@response, proto_encode('return_value','reject'));
  } elsif ($exit_code == 99 || $rcpt_deletes >= $rcpt_count) {
    $exit_code = 99; # let MTA discard the message, it was already handled here
    push(@response, proto_encode('return_value','discard'));
  } elsif (grep($_->delivery_method ne '', @{$msginfo->per_recip_data})) {
    # explicit forwarding by us
    die "Not all recips done, but explicit forwarding";  # just in case
  } else {  # EX_OK
    for my $r (@{$msginfo->per_recip_data}) {  # modified recipient addresses?
      my $newaddr = $r->recip_final_addr;
      if ($r->recip_done) {           # delete
        push(@response, proto_encode('delrcpt', $r->recip_addr_smtp))
          if defined $r->recip_addr;  # if in the original list, not always_bcc
      } elsif ($newaddr ne $r->recip_addr) {   # modify, e.g. adding extension
        push(@response, proto_encode('delrcpt', $r->recip_addr_smtp))
          if defined $r->recip_addr;  # if in the original list, not always_bcc
        push(@response, proto_encode('addrcpt',
                                     qquote_rfc2821_local($newaddr)));
      }
    }
    my $hdr_edits = $msginfo->header_edits;
    if ($hdr_edits) {  # any added or modified header fields?
      local($1,$2); my($field_name,$edit,$field_body);
      while ( ($field_name,$edit) = each %{$hdr_edits->{edit}} ) {
        $field_body = $msginfo->get_header_field_body($field_name,0);  # first
        if (!defined($field_body)) {
          # such header field does not exist or is not available, do nothing
        } else {                 # edit the first occurrence
          chomp($field_body);
          my $orig_field_body = $field_body;
          for my $e (@$edit) {   # possibly multiple (iterative) edits
            if (!defined($e)) { $field_body = undef; last }  # delete existing
            my($new_fbody,$verbatim) = &$e($field_name,$field_body);
            if (!defined($new_fbody)) { $field_body = undef; last }  # delete
            my $curr_head = $verbatim ? ($field_name . ':' . $new_fbody)
                                      : hdr($field_name, $new_fbody, 0,
                                            $msginfo->smtputf8);
            chomp($curr_head); $curr_head .= "\n";
            $curr_head =~ /^([^:]*?)[ \t]*:(.*)\z/s;
            $field_body = $2; chomp($field_body);  # carry to next iteration
          }
          if (!defined($field_body)) {
            push(@response, proto_encode('delheader','1',$field_name));
          } elsif ($field_body ne $orig_field_body) {
            # sendmail inserts a space after a colon, remove ours
            $field_body =~ s/^[ \t]//;
            push(@response, proto_encode('chgheader','1',
                                         $field_name,$field_body));
          }
        }
      }
      my $hdridx = c('prepend_header_fields_hdridx');  # milter insertion index
      $hdridx = 0  if !defined($hdridx) || $hdridx < 0;
      $hdridx = sprintf("%d",$hdridx);  # convert to string
      # prepend header fields one at a time, topmost field last
      for my $hf (map(ref $hdr_edits->{$_} ? reverse @{$hdr_edits->{$_}} : (),
                      qw(addrcvd prepend)) ) {
        if ($hf =~ /^([^:]*?)[ \t]*:[ \t]*(.*?)$/s)
          { push(@response, proto_encode('insheader',$hdridx,$1,$2)) }
      }
      # append header fields
      for my $hf (map(ref $hdr_edits->{$_} ? @{$hdr_edits->{$_}} : (),
                      qw(append)) ) {
        if ($hf =~ /^([^:]*?)[ \t]*:[ \t]*(.*?)$/s)
          { push(@response, proto_encode('addheader',$1,$2)) }
      }
    }
    if ($old_amcl) {   # milter via old amavis helper program
      # warn if there is anything that should be done but MTA is not capable of
      # (or a helper program cannot pass the request)
      for (grep(/^(delrcpt|addrcpt)=/, @response))
        { do_log(-1, "WARN: MTA can't do: %s", $_) }
      if ($rcpt_deletes && $rcpt_count-$rcpt_deletes > 0) {
        do_log(-1, "WARN: ACCEPT THE WHOLE MESSAGE, ".
                   "MTA-in can't do selective recips deletion");
      }
    }
    push(@response, proto_encode('return_value','continue'));
  }
  push(@response, proto_encode('exit_code',sprintf("%d",$exit_code)));
  ll(3) && do_log(3, 'mail checking ended: %s', join("\n",@response));
  dump_captured_log(1, c('enable_log_capture_dump'));
  %current_policy_bank = %baseline_policy_bank;  # restore bank settings
  @response;
}

# just a proof-of-concept, experimental
#
sub postfix_policy($$) {
  my($msginfo,$attr_ref) = @_;
  my(@response);
  if ($attr_ref->{'request'} ne 'smtpd_access_policy') {
    die("unknown 'request' value: " . $attr_ref->{'request'});
  } else {
    @response = 'action=DUNNO';
  }
  @response;
}

sub dispatch_from_quarantine($$$) {
  my($msginfo,$request_type,$feedback_type) = @_;
  my $err;
  eval {
    # feed information to a msginfo object, possibly replacing it
    $msginfo = msg_from_quarantine($msginfo,$request_type,$feedback_type);
    mail_dispatch($msginfo,0,1);  # re-send the original mail or report
    1;
  } or do {
    $err = $@ ne '' ? $@ : "errno=$!";  chomp $err;
    do_log(0, "WARN: dispatch_from_quarantine failed: %s",$err);
    die $err  if $err =~ /^timed out\b/;  # resignal timeout
  };
  my(@response);
  my $per_recip_data = $msginfo->per_recip_data;
  if (!defined($per_recip_data) || !@$per_recip_data) {
    push(@response, proto_encode('setreply','250','2.5.0',
                                 "No recipients, nothing to do"));
  } else {
    Amavis::build_and_save_structured_report($msginfo,'SEND');
    for my $r (@$per_recip_data) {
      local($1,$2,$3); my($smtp_s,$smtp_es,$msg);
      my $resp = $r->recip_smtp_response;
      if ($err ne '')
        { ($smtp_s,$smtp_es,$msg) = ('450', '4.5.0', "ERROR: $err") }
      elsif ($resp =~ /^([1-5]\d\d) ([245]\.\d{1,3}\.\d{1,3})(?: |\z)(.*)\z/s)
        { ($smtp_s,$smtp_es,$msg) = ($1,$2,$3) }
      elsif ($resp =~ /^(([1-5])\d\d)(?: |\z)(.*)\z/s)
        { ($smtp_s,$smtp_es,$msg) = ($1, "$2.0.0" ,$3) }
      else
        { ($smtp_s,$smtp_es,$msg) = ('450', '4.5.0', "Unexpected: $resp") }
      push(@response, proto_encode('setreply',$smtp_s,$smtp_es,$msg));
    }
  }
  @response;
}

1;