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

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

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(&delivery_status_notification &delivery_short_report
                  &build_mime_entity &defanged_mime_entity
                  &msg_from_quarantine &expand_variables);
}
use subs @EXPORT_OK;

use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use MIME::Entity;
use Time::HiRes ();

use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::Expand qw(expand);
use Amavis::In::Message;
use Amavis::In::Message::PerRecip;
use Amavis::Lookup qw(lookup lookup2);
use Amavis::MIME::Body::OnOpenFh;
use Amavis::Out::EditHeader qw(hdr);
use Amavis::ProcControl qw(exit_status_str proc_status_ok
                           run_command collect_results);
use Amavis::rfc2821_2822_Tools;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log sanitize_str min max minmax
                    untaint untaint_inplace
                    idn_to_ascii idn_to_utf8 mail_addr_idn_to_ascii
                    is_valid_utf_8 safe_decode_utf8
                    safe_encode safe_encode_utf8 safe_encode_utf8_inplace
                    orcpt_encode orcpt_decode xtext_decode safe_decode_mime
                    make_password ccat_split ccat_maj generate_mail_id);

# replace substring ${myhostname} with a value of a corresponding variable
sub expand_variables($) {
  my $str = $_[0]; local($1,$2);
  my $myhost = idn_to_utf8(c('myhostname'));
  $str =~ s{ \$ (?: \{ ([^\}]+) \} |
                    ([a-zA-Z](?:[a-zA-Z0-9_-]*[a-zA-Z0-9])?\b) ) }
           { { 'myhostname'       => $myhost,
               'myhostname_utf8'  => $myhost,
               'myhostname_ascii' => idn_to_ascii($myhost),
             }->{lc($1.$2)}
           }xgse;
  $str;
}

# wrap a mail message into a ZIP archive
#
sub wrap_message_into_archive($$) {
  my($msginfo,$prefix_lines_ref) = @_;

  # a file with a copy of a mail msg as retrieved from a quarantine:
  my $attachment_email_name = c('attachment_email_name');  # 'msg-%m.eml'
  # an archive file (will contain a retrieved message) to be attached:
  my $attachment_outer_name = c('attachment_outer_name');  # 'msg-%m.zip'

  my($email_fh, $arch_size);
  my $mail_id = $msginfo->mail_id;
  if (!defined $mail_id || $mail_id eq '') {
    $mail_id = '';
  } else {
    $mail_id =~ /^[A-Za-z0-9_-]*\z/  or die "unsafe mail_id: $mail_id";
    untaint_inplace($mail_id);
  }
  for ($attachment_email_name, $attachment_outer_name) {
    local $1;
    s{%(.)}{  $1 eq 'b' ? $msginfo->body_digest
            : $1 eq 'P' ? $msginfo->partition_tag
            : $1 eq 'm' ? $mail_id
            : $1 eq 'n' ? $msginfo->log_id
            : $1 eq 'i' ? iso8601_timestamp($msginfo->rx_time,1)  #,'-')
            : $1 eq '%' ? '%' : '%'.$1 }gse;
    $_ = $msginfo->mail_tempdir . '/' . $_;
  }
  my $eval_stat;
  eval {
    # copy a retrieved message to a file
    $email_fh = IO::File->new;
    $email_fh->open($attachment_email_name, O_CREAT|O_EXCL|O_RDWR, 0640)
      or die "Can't create file $attachment_email_name: $!";
    binmode($email_fh,':bytes') or die "Can't cancel :utf8 mode: $!";
    for (@$prefix_lines_ref) {
      $email_fh->print($_)
        or die "Error writing to $attachment_email_name: $!";
    }
    my $msg = $msginfo->mail_text;
    my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
    $msg = $msg_str_ref  if ref $msg_str_ref;
    # copy quarantined mail starting at skip_bytes to $attachment_email_name
    my $file_position = $msginfo->skip_bytes;
    if (!defined $msg) {
      # empty mail
    } elsif (ref $msg eq 'SCALAR') {
      # do it in chunks, saves memory, cache friendly
      while ($file_position < length($$msg)) {
        $email_fh->print(substr($$msg,$file_position,16384))
          or die "Error writing to $attachment_email_name: $!";
        $file_position += 16384;  # may overshoot, no problem
      }
    } elsif ($msg->isa('MIME::Entity')) {
      die "wrapping a MIME::Entity object is not implemented";
    } else {
      $msg->seek($file_position,0) or die "Can't rewind mail file: $!";
      my($nbytes,$buff);
      while (($nbytes = $msg->read($buff,16384)) > 0) {
        $email_fh->print($buff)
          or die "Error writing to $attachment_email_name: $!";
      }
      defined $nbytes or die "Error reading mail file: $!";
      undef $buff;  # release storage
    }
    $email_fh->close or die "Can't close file $attachment_email_name: $!";
    undef $email_fh;

    # create a password-protected archive containing the just prepared file;
    # no need to shell-protect arguments, as this does not invoke a shell
    my $password = $msginfo->attachment_password;
    my(@command) = ( qw(zip -q -j -l),
                     $password eq '' ? () : ('-P', $password),
                     $attachment_outer_name, $attachment_email_name );
    # supplying a password on a command line is lame as it shows in ps(1),
    # but an option -e would require a pseudo terminal, which is really
    # an overweight cannon unnecessary here: the password is used as a
    # scrambler only, protecting against accidental opening of a file,
    # so there is no security issue here
    $password = 'X' x length($password);  # can't hurt to wipe out
    my($proc_fh,$pid) = run_command(undef,undef,@command);
    my($r,$status) = collect_results($proc_fh,$pid,'zip',16384,[0]);
    undef $proc_fh; undef $pid;
    do_log(2,'archiver said: %s',$$r)  if ref $r && $$r ne '';
    $status == 0 or die "Error creating an archive: $status, $$r";
    my $errn = lstat($attachment_outer_name) ? 0 : 0+$!;
    if ($errn) { die "Archive $attachment_outer_name is inaccessible: $!" }
    else { $arch_size = 0 + (-s _) }
    1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
  };
  if ($eval_stat ne '' || !$arch_size) {  # handle failure
    my $msg = $eval_stat ne '' ? $eval_stat
                               : sprintf("archive size %d", $arch_size);
    do_log(-1,'Preparing an archive from a quarantined message failed: %s',
              $msg);
    if (defined $email_fh && $email_fh->fileno) {
      $email_fh->close
        or do_log(-1,"Can't close %s: %s", $attachment_email_name, $!);
    }
    undef $email_fh;
    if (-e $attachment_email_name) {
      unlink($attachment_email_name)
        or do_log(-1,"Can't remove %s: %s", $attachment_email_name, $!);
    }
    if (-e $attachment_outer_name) {
      unlink($attachment_outer_name)
        or do_log(-1,"Can't remove %s: %s", $attachment_outer_name, $!);
    }
    die "Preparing an archive from a quarantined message failed: $msg\n";
  }
  $attachment_outer_name;
}

# Create a MIME::Entity object. If $mail_as_string_ref points to a string
# (multiline mail header with a plain text body) it is added as the first
# MIME part. Optionally attach a message header section from original mail,
# or attach a complete original message.
#
sub build_mime_entity($$$$$$$) {
  my($mail_as_string_ref, $msginfo, $mime_type, $msg_format, $flat,
     $attach_orig_headers, $attach_orig_message) = @_;

  $msg_format = ''  if !defined $msg_format;
  if (!defined $mime_type || $mime_type !~ m{^ multipart (?: / | \z)}xsi) {
    my $multipart_cnt = 0;
    $multipart_cnt++  if $mail_as_string_ref;
    $multipart_cnt++  if defined $msginfo &&
                        ($attach_orig_headers || $attach_orig_message);
    $mime_type = 'multipart/mixed'  if $multipart_cnt > 1;
  }
  my($entity,$m_hdr,$m_body);
  if (!$mail_as_string_ref) {
    # no plain text part
  } elsif ($$mail_as_string_ref eq '') {
    $m_hdr = $m_body = '';
  } elsif (substr($$mail_as_string_ref, 0,1) eq "\n") { # empty header section?
    $m_hdr = ''; $m_body = substr($$mail_as_string_ref,1);
  } else {
    # calling index and substr is much faster than an equiv. split into $1,$2
    # by a regular expression: /^( (?!\n) .*? (?:\n|\z))? (?: \n (.*) )? \z/xs
    my $ind = index($$mail_as_string_ref,"\n\n");  # find header/body separator
    if ($ind < 0) {  # no body
      $m_hdr = $$mail_as_string_ref; $m_body = '';
    } else {  # normal mail, nonempty header section and nonempty body
      $m_hdr  = substr($$mail_as_string_ref, 0, $ind+1);
      $m_body = substr($$mail_as_string_ref, $ind+2);
    }
  }
  safe_encode_utf8_inplace($m_hdr);
  $m_body = safe_encode(c('bdy_encoding'), $m_body)  if defined $m_body;
  # make sure _our_ source line number is reported in case of failure
  my $multipart_cnt = 0;
  $mime_type = 'multipart/mixed'  if !defined $mime_type;
  eval {
    # RFC 6522: 7bit should always be adequate for multipart/report encoding
    $entity = MIME::Entity->build(
      Type => $mime_type, Encoding => '8bit',
      'X-Mailer' => undef);
    1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die $eval_stat;
  };
  if (defined $m_hdr) {  # insert header fields into MIME::Head entity;
    # Mail::Header::modify allows all-or-nothing control over automatic header
    # fields folding by Mail::Header, which is too bad - we would prefer
    # to have full control on folding of header fields that are explicitly
    # inserted here, and let Mail::Header handle the rest. Sorry, can't be
    # done, so let's just disable folding by Mail::Header (which does a poor
    # job when presented with few break opportunities), and wrap our header
    # fields ourselves, hoping the remaining automatically generated header
    # fields won't be too long.
    local($1,$2);
    my $head = $entity->head;  $head->modify(0);
    $m_hdr =~ s/\r?\n(?=[ \t])//gs;  # unfold header fields in a template
    for my $hdr_line (split(/\r?\n/, $m_hdr)) {
      if ($hdr_line =~ /^([^:]*?)[ \t]*:[ \t]*(.*)\z/s) {
        my($fhead,$fbody) = ($1,$2);
        $fbody = safe_decode_mime($fbody);  # to logical characters
        # encode, wrap, ...
        my $str = hdr($fhead, $fbody, 0, ' ', $msginfo->smtputf8);
        # re-split the result
        ($fhead,$fbody) = ($1,$2)  if $str =~ /^([^:]*):[ \t]*(.*)\z/s;
        chomp($fbody);
        do_log(5, "build_mime_entity %s: %s", $fhead,$fbody);
        eval {  # make sure _our_ source line number is reported on failure
          $head->replace($fhead,$fbody);  1;
        } or do {
          $@ = "errno=$!"  if $@ eq '';  chomp $@;
          die $@  if $@ =~ /^timed out\b/;  # resignal timeout
          die sprintf("%s header field '%s: %s'",
                      ($@ eq '' ? "invalid" : "$@, "), $fhead,$fbody);
        };
      }
    }
  }
  my(@prefix_lines);
  if (defined $m_body) {
    if ($flat && $attach_orig_message) {
      my($pos,$j);  # split $m_body into lines, retaining each \n
      for ($pos=0; ($j=index($m_body,"\n",$pos)) >= 0; $pos = $j+1) {
        push(@prefix_lines, substr($m_body,$pos,$j-$pos+1));
      }
      push(@prefix_lines, substr($m_body,$pos))  if $pos < length($m_body);
    } else {
      my $cnt_8bit = $m_body =~ tr/\x00-\x7F//c;
      eval {  # make sure _our_ source line number is reported on failure
        $entity->attach(
          Type => 'text/plain', Data => $m_body,
          Charset  => !$cnt_8bit ? 'us-ascii' : c('bdy_encoding'),
          Encoding => !$cnt_8bit ? '7bit'
                    : $cnt_8bit < 0.2 * length($m_body) ? 'quoted-printable'
                                                        : 'base64',
        );
        $multipart_cnt++; 1;
      } or do {
        my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
        die $eval_stat;
      };
    }
  }
  # prepend a Return-Path to make available the envelope sender address
  push(@prefix_lines, "\n")  if @prefix_lines;  # separates text from a message
  push(@prefix_lines, sprintf("Return-Path: %s\n", $msginfo->sender_smtp));

  if (defined $msginfo && $attach_orig_headers && !$attach_orig_message) {
    # attach a header section only
    my $hdr_8bit =
      $msginfo->header_8bit || grep(tr/\x00-\x7F//c, @prefix_lines);
    my $hdr_utf8 = 1;
    if ($hdr_8bit) {
      for (@prefix_lines, @{$msginfo->orig_header}) {
        if (tr/\x00-\x7F//c && !is_valid_utf_8($_)) { $hdr_utf8 = 0; last }
      }
    }

    # RFC 6522 Encoding considerations for text/rfc822-headers:
    # 7-bit is sufficient for normal mail headers, however, if the
    # headers are broken or extended and require encoding to make them
    # legal 7-bit content, they MAY be encoded with quoted-printable
    # as defined in [MIME].

    # RFC 6532 section 3.5: allows newly defined MIME types to permit
    # content-transfer-encoding, and it allows content-transfer-encoding
    # for message/global.

    # RFC 6533: Note that [RFC6532] relaxed a restriction from MIME [RFC2046]
    # regarding the use of Content-Transfer-Encoding in new "message"
    # subtypes. This specification (RFC 6533) explicitly allows the use
    # of Content-Transfer-Encoding in message/global-headers and
    # message/global-delivery-status.

    my $headers_mime_type =
      $flat ? 'text/plain' :
      $hdr_8bit && $hdr_utf8 ? 'message/global-headers'  # RFC 6533
                             : 'text/rfc822-headers';    # RFC 6522

    # [rt.cpan.org #98737] MIME::Tools 5.505 prohibits quoted-printable
    # for message/global-headers. Fixed by a later release.
    # my $headers_mime_encoding =
    #   !$hdr_8bit ? '7bit' :
    #   $headers_mime_type =~ m{^text/}i || MIME::Entity->VERSION > 5.505
    #     ? 'quoted-printable' : '8bit';

    my $headers_mime_encoding = $hdr_8bit ? '8bit' : '7bit';

    ll(4) && do_log(4,"build_mime_entity: attaching original ".
                      "header section, MIME type: %s, encoding: %s",
                      $headers_mime_type, $headers_mime_encoding);

    # RFC 6533 section 6.3. Interoperability considerations:
    # It is important that message/global-headers media type is not
    # converted to a charset other than UTF-8.  As a result, implementations
    # MUST NOT include a charset parameter with this media type.

    eval {  # make sure _our_ source line number is reported on failure
      $entity->attach(
        Data => [@prefix_lines, @{$msginfo->orig_header}],
        Type     => $headers_mime_type,
        Encoding => $headers_mime_encoding,
        Filename => $headers_mime_type eq 'message/global-headers' ?
                      'header.u8hdr' : 'header.hdr',
        Disposition => 'inline',
        Description => 'Message header section',
      );
      $multipart_cnt++; 1;
    } or do {
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      die $eval_stat;
    };

  } elsif (defined $msginfo && $attach_orig_message) {
    # attach a complete message
    my $password;
    if ($msg_format eq 'attach') {   # not 'arf' and not 'dsn'
      $password = $msginfo->attachment_password;  # already have it?
      if (!defined $password) {  # make one, and store it for later
        $password = make_password(c('attachment_password'), $msginfo);
        $msginfo->attachment_password($password);
      }
    }
    if ($msg_format eq 'attach' &&   # not 'arf' and not 'dsn'
        defined $password && $password ne '') {
      # attach as a ZIP archive
      $password = 'X' x length($password);  # can't hurt to wipe out
      do_log(4, "build_mime_entity: attaching entire original message as zip");
      my $archive_fn = wrap_message_into_archive($msginfo,\@prefix_lines);
      local($1); $archive_fn =~ m{([^/]*)\z}; my $att_filename = $1;
      eval {  # make sure _our_ source line number is reported on failure
        my $att = $entity->attach(  # RFC 2046
          Type => 'application/zip', Filename => $att_filename,
          Path => $archive_fn, Encoding => 'base64',
          Disposition => 'attachment', Description => 'Original message',
        );
        $multipart_cnt++; 1;
      } or do {
        my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
        die $eval_stat;
      };

    } else {
      # attach as a normal message
      do_log(4, "build_mime_entity: attaching entire original message, plain");
      my $orig_mail_as_body;
      my $msg = $msginfo->mail_text;
      my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
      $msg = $msg_str_ref  if ref $msg_str_ref;
      if (!defined $msg) {
        # empty mail
      } elsif (ref $msg eq 'SCALAR') {
        # will be handled by ->attach
      } elsif ($msg->isa('MIME::Entity')) {
        die "attaching a MIME::Entity object is not implemented";
      } else {
        $orig_mail_as_body =
          Amavis::MIME::Body::OnOpenFh->new($msginfo->mail_text,
                                         \@prefix_lines, $msginfo->skip_bytes);
        $orig_mail_as_body or die "Can't create Amavis::MIME::Body object: $!";
      }

      # RFC 6532 section 3.7: Internationalized messages in message/global
      # format MUST only be transmitted as authorized by [RFC6531]
      # or within a non-SMTP environment that supports these messages.
      my $message_mime_type =
        $flat ? 'text/plain' :
        $msginfo->smtputf8 && $msginfo->header_8bit
          ? 'message/global'  # RFC 6532
          : 'message/rfc822';

      # [rt.cpan.org #98737] MIME::Tools 5.505 prohibits quoted-printable
      # for message/global. Fixed by a later release.
      my $message_mime_encoding =
        !$msginfo->header_8bit && !$msginfo->body_8bit ? '7bit' :
        $message_mime_type =~ m{^text/}i || MIME::Entity->VERSION > 5.505
          ? 'quoted-printable' : '8bit';

      eval {  # make sure _our_ source line number is reported on failure
        my $att = $entity->attach(  # RFC 2046, RFC 6532
          Type => $message_mime_type,
          Encoding => $message_mime_encoding,
          Data => defined $orig_mail_as_body ? []
                : !$msginfo->skip_bytes ? $msg
                : substr($$msg, $msginfo->skip_bytes),
        # Path => $msginfo->mail_text_fn,
          $flat ? () : (Disposition => 'attachment', Filename => 'message',
                        Description => 'Original message'),
          # RFC 6532: File extension ".u8msg" is suggested for message/global
        );
        # direct access to tempfile handle
        $att->bodyhandle($orig_mail_as_body)  if defined $orig_mail_as_body;
        $multipart_cnt++; 1;
      } or do {
        my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
        die $eval_stat;
      };
    }
  }
  $entity->make_singlepart  if $multipart_cnt < 2;
  $entity;  # return the constructed MIME::Entity
}

# If $msg_format is 'dsn' generate a delivery status notification according
# to RFC 6522 (ex RFC 3462, RFC 1892), RFC 3464 (ex RFC 1894) and RFC 3461
# (ex RFC 1891).
# If $msg_format is 'arf' generate an abuse report according to RFC 5965
# - "An Extensible Format for Email Feedback Reports". If $msg_format is
# 'attach', generate a report message and attach the original message.
# If $msg_format is 'plain', generate a simple (flat) mail with the only
# MIME part being the original message (abuse@yahoo.com can't currently
# handle attachments in reports). Returns a message object, or undef if
# DSN is requested but not needed.
#   $request_type:  dsn, release, requeue, report
#   $msg_format:    dsn, arf, attach, plain, resend
#   $feedback_type: abuse, dkim, fraud, miscategorized, not-spam,
#                   opt-out, virus, other
#
sub delivery_status_notification($$$;$$$$) {  # ..._or_report
  my($msginfo,$dsn_per_recip_capable,$builtins_ref,
     $notif_recips,$request_type,$feedback_type,$msg_format) = @_;
  my $notification; my $suppressed = 0;
  my $is_smtputf8 = $msginfo->smtputf8;  # UTF-8 allowed
  if (!defined($msg_format)) {
    $msg_format = $request_type eq 'dsn'    ? 'dsn'
                : $request_type eq 'report' ? c('report_format')
                                            : c('release_format');
  }
  my($is_arf,$is_dsn,$is_attach,$is_plain) = (0) x 4;
  if    ($msg_format eq 'dsn')    { $is_dsn = 1 }
  elsif ($msg_format eq 'arf')    { $is_arf = 1 }
  elsif ($msg_format eq 'attach') { $is_attach = 1 }
  else                            { $is_plain = 1 }  # 'plain'
  my $dsn_time = $msginfo->rx_time;  # time of dsn creation - same as message
    # use a reception time for consistency and to be resilient to clock jumps
  $dsn_time = Time::HiRes::time  if !$dsn_time;  # now, if missing
  my $rfc2822_dsn_time = rfc2822_timestamp($dsn_time);
  my $sender = $msginfo->sender;
  my $dsn_passed_on = $msginfo->dsn_passed_on;  # NOTIFY=SUCCESS passed to MTA
  my $per_recip_data = $msginfo->per_recip_data;
  my $all_rejected = 0;
  if (@$per_recip_data) {
    $all_rejected = 1;
    for my $r (@$per_recip_data) {
      if ($r->recip_destiny != D_REJECT || $r->recip_smtp_response !~ /^5/)
        { $all_rejected = 0; last }
    }
  }
  my($min_spam_level, $max_spam_level) =
    minmax(map($_->spam_level, @{$msginfo->per_recip_data}));
  $min_spam_level = 0  if !defined $min_spam_level;
  $max_spam_level = 0  if !defined $max_spam_level;

  my $is_credible = $msginfo->sender_credible || '';
  my $os_fingerprint = $msginfo->client_os_fingerprint;
  my($cutoff_byrecip_maps, $cutoff_bysender_maps);
  my($dsn_cutoff_level_bysender, $dsn_cutoff_level);
  if ($is_dsn && $sender ne '') {
    # for null sender it doesn't matter, as DSN will not be sent regardless
    if ($is_credible) {
      do_log(3, "DSN: sender is credible (%s), SA: %.3f, <%s>",
                $is_credible, $max_spam_level, $sender);
      $cutoff_byrecip_maps  = ca('spam_crediblefrom_dsn_cutoff_level_maps');
      $cutoff_bysender_maps =
                     ca('spam_crediblefrom_dsn_cutoff_level_bysender_maps');
    } else {
      do_log(5, "DSN: sender NOT credible, SA: %.3f, <%s>",
                $max_spam_level, $sender);
      $cutoff_byrecip_maps  = ca('spam_dsn_cutoff_level_maps');
      $cutoff_bysender_maps = ca('spam_dsn_cutoff_level_bysender_maps');
    }
    $dsn_cutoff_level_bysender = lookup2(0,$sender,$cutoff_bysender_maps);
  }

  my $txt_recip = '';  # per-recipient part of dsn text according to RFC 3464
  my($any_succ,$any_fail,$any_delayed) = (0,0,0); local($1);
  for my $r (!$is_dsn ? () : @$per_recip_data) {  # prepare per-recip fields
    my $recip = $r->recip_addr;
    my $smtp_resp = $r->recip_smtp_response;
    my $recip_done = $r->recip_done; # 2=relayed to MTA, 1=faked deliv/quarant
    my $ccat_name = $r->setting_by_contents_category(\%ccat_display_names);
    $ccat_name = "NonBlocking:$ccat_name"  if !defined($r->blocking_ccat);
    my $spam_level = $r->spam_level;
    if (!$recip_done) {
      my $fwd_m = $r->delivery_method;
      if (!defined $fwd_m) {
        do_log(-2,"TROUBLE: recipient not done, undefined delivery_method: ".
                  "<%s> %s", $recip,$smtp_resp);
      } elsif ($fwd_m eq '') {  # e.g. milter
        # as far as we are concerned all is ok, delivery will be performed
        # by a helper program or MTA
        $smtp_resp = "250 2.5.0 Ok, continue delivery";
      } else {
        do_log(-2,"TROUBLE: recipient not done: <%s> %s", $recip,$smtp_resp);
      }
    }
    my $smtp_resp_class = $smtp_resp =~ /^(\d)/  ? $1 : '0';
    my $smtp_resp_code  = $smtp_resp =~ /^(\d+)/ ? $1 : '0';
    my $dsn_notify = $r->dsn_notify;
    my($notify_on_failure,$notify_on_success,$notify_on_delay,$notify_never) =
      (0,0,0,0);
    if (!defined($dsn_notify)) {
      $notify_on_failure = $notify_on_delay = 1;
    } else {
      for (@$dsn_notify) {  # validity of the list has already been checked
        if    ($_ eq 'FAILURE') { $notify_on_failure = 1 }
        elsif ($_ eq 'SUCCESS') { $notify_on_success = 1 }
        elsif ($_ eq 'DELAY')   { $notify_on_delay   = 1 }
        elsif ($_ eq 'NEVER')   { $notify_never = 1 }
      }
    }
    if ($notify_never || $sender eq '') {
      $notify_on_failure = $notify_on_success = $notify_on_delay = 0;
    }
    my $dest = $r->recip_destiny;
    my $remote_or_local = $recip_done==2 ? 'from MTA' :
                          $recip_done==1 ? '.' :  # this agent
                          'status-to-be-passed-back';
    # warn_sender is an old relic and does not fit well into DSN concepts;
    # we'll sneak it in, pretending to cause a DELAY notification
    my $warn_sender =
      $notify_on_delay && $smtp_resp_class eq '2' && $recip_done==2 &&
      $r->setting_by_contents_category(cr('warnsender_by_ccat'));
    ll(5) && do_log(5,
              "dsn: %s %s %s <%s> -> <%s>: on_succ=%d, on_dly=%d, ".
              "on_fail=%d, never=%d, warn_sender=%s, DSN_passed_on=%s, ".
              "destiny=%s, mta_resp: \"%s\"",
              $remote_or_local, $smtp_resp_code, $ccat_name, $sender, $recip,
              $notify_on_success, $notify_on_delay, $notify_on_failure,
              $notify_never, $warn_sender, $dsn_passed_on, $dest, $smtp_resp);
    # clearly log common cases to facilitate troubleshooting;

    # first look for some standard reasons for not sending a DSN
    if ($smtp_resp_class eq '4') {
      do_log(4, "DSN: TMPFAIL %s %s %s, not to be reported: <%s> -> <%s>",
                $remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
    } elsif ($smtp_resp_class eq '5' && $dest==D_REJECT &&
             ($dsn_per_recip_capable || $all_rejected)) {
      do_log(4, "DSN: FAIL %s %s %s, status propagated back: <%s> -> <%s>",
                $remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
    } elsif ($smtp_resp_class eq '5' && !$notify_on_failure) {
      $suppressed = 1;
      do_log($recip_done==2 ? 0 : 4, # log level 0 for remotes, RFC 3461 5.2.2d
                "DSN: FAIL %s %s %s, %s requested to be IGNORED: <%s> -> <%s>",
                $remote_or_local,$smtp_resp_code,$ccat_name,
                $notify_never?'explicitly':'implicitly', $sender, $recip);
    } elsif ($smtp_resp_class eq '2' && !$notify_on_success && !$warn_sender) {
      my $fmt = $dest==D_DISCARD
                  ? "SUCC (discarded) %s %s %s, destiny=DISCARD"
                  : "SUCC %s %s %s, no DSN requested";
      do_log(5, "DSN: $fmt: <%s> -> <%s>",
             $remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
    } elsif ($smtp_resp_class eq '2' && $notify_on_success && $dsn_passed_on &&
             !$warn_sender) {
      do_log(5, "DSN: SUCC %s %s %s, DSN parameters PASSED-ON: <%s> -> <%s>",
                $remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
    } elsif ($notify_never || $sender eq '') {  # test sender just in case
      $suppressed = 1;
      do_log(5, "DSN: NEVER %s %s, <%s> -> %s",
                $smtp_resp_code,$ccat_name,$sender,$recip);

    # next, look for some good _excuses_ for not sending a DSN

    } elsif ($dest==D_DISCARD) {  # requested by final_*_destiny
      $suppressed = 1;
      do_log(4, "DSN: FILTER %s %s %s, destiny=DISCARD: <%s> -> <%s>",
                $remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
    } elsif (defined $r->dsn_suppress_reason) {
      $suppressed = 1;
      do_log(3, "DSN: FILTER %s %s, suppress reason: %s, <%s> -> <%s>",
                $smtp_resp_code, $ccat_name, $r->dsn_suppress_reason,
                $sender,$recip);
    } elsif (defined $dsn_cutoff_level_bysender &&
             $spam_level >= $dsn_cutoff_level_bysender) {
      $suppressed = 1;
      do_log(3, "DSN: FILTER %s %s, spam level %.3f exceeds cutoff %s%s, ".
                "<%s> -> <%s>", $smtp_resp_code, $ccat_name,
                $spam_level, $dsn_cutoff_level_bysender,
                !$is_credible ? '' : ", (credible: $is_credible)",
                $sender, $recip);
    } elsif (defined($cutoff_byrecip_maps) &&
             ( $dsn_cutoff_level=lookup2(0,$recip,$cutoff_byrecip_maps),
               defined($dsn_cutoff_level) &&
               ( $spam_level >= $dsn_cutoff_level ||
                 ( $r->recip_blacklisted_sender &&
                  !$r->recip_whitelisted_sender) )
              ) ) {
      $suppressed = 1;
      do_log(3, "DSN: FILTER %s %s, spam level %.3f exceeds ".
                "by-recipient cutoff %s%s, <%s> -> <%s>",
                $smtp_resp_code, $ccat_name,
                $spam_level, $dsn_cutoff_level,
                !$is_credible ? '' : ", (credible: $is_credible)",
                $sender, $recip);
    } elsif ($msginfo->is_bulk && ccat_maj($r->contents_category) > CC_CLEAN) {
      $suppressed = 1;
      do_log(3, "DSN: FILTER %s %s, suppressed, bulk mail (%s), <%s> -> <%s>",
                $smtp_resp_code,$ccat_name,$msginfo->is_bulk,$sender,$recip);
    } elsif ($os_fingerprint =~ /^Windows\b/ &&   # hard-coded limits!
             !$msginfo->dkim_envsender_sig   &&   # a hack
             $spam_level >=
               ($os_fingerprint=~/^Windows XP(?![^(]*\b2000 SP)/ ? 5 : 8)) {
      $os_fingerprint =~ /^(\S+\s+\S+)/;
      do_log(3, "DSN: FILTER %s %s, suppressed for mail from %s ".
                "at %s, score=%s, <%s> -> <%s>", $smtp_resp_code, $ccat_name,
                $1, $msginfo->client_addr, $spam_level, $sender,$recip);
    } else {
      # RFC 3461, section 5.2.8: "A single DSN may describe attempts to deliver
      # a message to multiple recipients of that message. If a DSN is issued
      # for some recipients in an SMTP transaction and not for others according
      # to the rules above, the DSN SHOULD NOT contain information for
      # recipients for whom DSNs would not otherwise have been issued."
      $txt_recip .= "\n";  # empty line between groups of per-recipient fields

      my $dsn_orcpt = $r->dsn_orcpt;
      if (defined $dsn_orcpt) {
        # RFC 6533: systems generating a message/global-delivery-status
        # body part SHOULD use the utf-8-address form of the UTF-8 address
        # type for all addresses containing characters outside the ASCII
        # repertoire. These systems SHOULD upconvert the utf-8-addr-xtext
        # or the utf-8-addr-unitext form of a UTF-8 address type in the
        # ORCPT parameter to the utf-8-address form of a UTF-8 address type
        # in the "Original-Recipient:" field.
        my($addr_type, $addr) = orcpt_encode($dsn_orcpt, $is_smtputf8);
        $txt_recip .= "Original-Recipient: $addr_type;$addr\n";  # as octets
      }
      my $remote_mta = $r->recip_remote_mta;
      my $final_recip_encoded;
      { # normalize recipient address (like UTF-8 decoding)
        my($addr_type, $addr) = orcpt_decode(';'.quote_rfc2821_local($recip));
        ($addr_type, $addr) = orcpt_encode($addr_type.';'.$addr, $is_smtputf8);
        $final_recip_encoded = $addr_type.';'.$addr;
      }
      if (defined $dsn_orcpt || $remote_mta eq '' ||
          $r->recip_final_addr eq $recip) {
        $txt_recip .= "Final-Recipient: $final_recip_encoded\n";
      } else {
        $txt_recip .= "X-NextToLast-Final-Recipient: $final_recip_encoded\n";
        # normalize final recipient address (e.g. UTF-8 decoding)
        my($addr_type, $addr) =
          orcpt_decode(';'.quote_rfc2821_local($r->recip_final_addr));
        ($addr_type, $addr) = orcpt_encode($addr_type.';'.$addr, $is_smtputf8);
        $txt_recip .= "Final-Recipient: $addr_type;$addr\n";
      }
      my($smtp_resp_code, $smtp_resp_enhcode, $smtp_resp_msg);
      local($1,$2,$3);
      if ($smtp_resp =~ /^ (\d{3}) [ \t-] [ \t]* ([245] \. \d{1,3} \. \d{1,3})?
                           \s* (.*) \z/xs) {
        ($smtp_resp_code, $smtp_resp_enhcode, $smtp_resp_msg) = ($1,$2,$3);
      } else {
        $smtp_resp_msg = $smtp_resp;
      }
      if ($smtp_resp_enhcode eq '' && $smtp_resp_class =~ /^([245])\z/) {
        $smtp_resp_enhcode = "$1.0.0";
      }
      my $action;  # failed / relayed / delivered / expanded
      if ($recip_done == 2) {  # truly forwarded to MTA
        $action = $smtp_resp_class eq '5' ? 'failed'     # remote reject
                : $smtp_resp_class ne '2' ? undef        # shouldn't happen
                : !$dsn_passed_on ? 'relayed'   # relayed to non-conforming MTA
                : $warn_sender ? 'delayed'  # disguised as a DELAY notification
                : undef;  # shouldn't happen
      } elsif ($recip_done == 1) {
        # a faked delivery to bit bucket or to a quarantine
        $action = $smtp_resp_class eq '5' ? 'failed'     # local reject
                : $smtp_resp_class eq '2' ? 'delivered'  # discard / bit bucket
                : undef;  # shouldn't happen
      } elsif (!defined($recip_done) || $recip_done == 0) {
        $action = $smtp_resp_class eq '2' ? 'relayed'  #????
                : undef;  # shouldn't happen
      }
      defined $action  or die "Assert failed: $smtp_resp, $smtp_resp_class, ".
                              "$recip_done, $dsn_passed_on";
      if ($action eq 'failed') { $any_fail=1 }
      elsif ($action eq 'delayed') { $any_delayed=1 } else { $any_succ=1 }
      $txt_recip .= "Action: $action\n";
      $txt_recip .= "Status: $smtp_resp_enhcode\n";
      my $rem_smtp_resp = $r->recip_remote_mta_smtp_response;
      if ($warn_sender && $action eq 'delayed') {
        $smtp_resp = '250 2.6.0 Bad message, but will be delivered anyway';
      } elsif ($remote_mta ne '' && $rem_smtp_resp ne '') {
        $txt_recip .= "Remote-MTA: dns; $remote_mta\n";
        $smtp_resp = $rem_smtp_resp;
      } elsif ($smtp_resp !~ /\n/ && length($smtp_resp) > 78-23) { # wrap magic
        # take liberty to wrap our own SMTP responses
        $smtp_resp = wrap_string("x" x (23-11) . $smtp_resp, 78-11,'','',0);
        # length(" 554 5.0.0 ") = 11; length("Diagnostic-Code: smtp; ") = 23
        # insert and then remove prefix to maintain consistent wrapped size
        $smtp_resp =~ s/^x{12}//;
        # wrap response code according to RFC 3461 section 9.2
        $smtp_resp = join("\n", @{wrap_smtp_resp($smtp_resp)});
      }
      $smtp_resp =~ s/\n(?![ \t])/\n /gs;
      $txt_recip .= "Diagnostic-Code: smtp; $smtp_resp\n";
      # RFC 6533 adds optional field Localized-Diagnostic
      $txt_recip .= "Last-Attempt-Date: $rfc2822_dsn_time\n";
      my $final_log_id = $msginfo->log_id;
      $final_log_id .= '/' . $msginfo->mail_id  if defined $msginfo->mail_id;
      $txt_recip .= sprintf("Final-Log-ID: %s\n", $final_log_id);
      do_log(2, "DSN: NOTIFICATION: Action:%s, %s %s %s, spam level %.3f, ".
                "<%s> -> <%s>",  $action,
                $recip_done==2 && $action ne 'delayed' ? 'RELAYED' : 'LOCAL',
                $smtp_resp_code, $ccat_name, $spam_level, $sender, $recip);
    }
  }  # endfor per_recip_data

  # prepare a per-message part of a report
  my $txt_msg = '';
  my $myhost = c('myhostname');  # my FQDN (DNS) name, UTF-8 octets
  $myhost = $is_smtputf8 ? idn_to_utf8($myhost) : idn_to_ascii($myhost);
  my $dsn_envid = $msginfo->dsn_envid;  # ENVID is encoded as xtext: RFC 3461

  if ($is_dsn) {  # DSN - per-msg part of dsn text according to RFC 3464
    my $conn = $msginfo->conn_obj;
    my $from_mta = $conn->smtp_helo;
    my $client_ip = $conn->client_ip;
    $txt_msg .= "Reporting-MTA: dns; $myhost\n";
    $txt_msg .= "Received-From-MTA: dns; $from_mta ([$client_ip])\n"
      if $from_mta ne '';
    $txt_msg .= "Arrival-Date: ". rfc2822_timestamp($msginfo->rx_time) ."\n";
    my $dsn_envid = $msginfo->dsn_envid;  # ENVID is encoded as xtext: RFC 3461
    if (defined $dsn_envid) {
      $dsn_envid = sanitize_str(xtext_decode($dsn_envid));
      $txt_msg .= "Original-Envelope-Id: $dsn_envid\n";
    }

  } elsif ($is_arf) {  # abuse report format - RFC 5965
    # abuse, dkim, fraud, miscategorized, not-spam, opt-out, virus, other
    $txt_msg .= "Version: 1\n";                     # required
    $txt_msg .= "Feedback-Type: $feedback_type\n";  # required
    # User-Agent must comply with RFC 2616, section 14.43
    my $ua_version = "$myproduct_name/$myversion_id ($myversion_date)";
    $txt_msg .= "User-Agent: $ua_version\n";        # required
    $txt_msg .= "Reporting-MTA: dns; $myhost\n";
    # optional fields:

    # RFC 6692: Report generators that include an Arrival-Date report field
    # MAY choose to express the value of that date in Universal Coordinated
    # Time (UTC) to enable simpler correlation with local records at sites
    # that are following the provisions of RFC 6302.
    $txt_msg .= 'Arrival-Date: ';
    $txt_msg .= rfc2822_utc_timestamp($msginfo->rx_time) . "\n";
  # $txt_msg .= rfc2822_timestamp($msginfo->rx_time) . "\n";

    my $cl_ip_addr = $msginfo->client_addr;
    if (defined $cl_ip_addr) {
      $cl_ip_addr = 'IPv6:'.$cl_ip_addr  if $cl_ip_addr =~ /:[0-9a-f]*:/i &&
                                            $cl_ip_addr !~ /^IPv6:/i;
      $txt_msg .= "Source-IP: $cl_ip_addr\n";
    }
    # RFC 6692 (was: draft-kucherawy-marf-source-ports):
    my $cl_ip_port = $msginfo->client_port;
    $txt_msg .= "Source-Port: $cl_ip_port\n" if defined $cl_ip_port;
    my $dsn_envid = $msginfo->dsn_envid;  # ENVID is encoded as xtext: RFC 3461
    if (defined $dsn_envid) {
      $dsn_envid = sanitize_str(xtext_decode($dsn_envid));
      $txt_msg .= "Original-Envelope-Id: $dsn_envid\n";
    }
    $txt_msg .= "Original-Mail-From: " . $msginfo->sender_smtp . "\n";
    for my $r (@$per_recip_data) {
      $txt_msg .= "Original-Rcpt-To: " . $r->recip_addr_smtp . "\n";
    }
    my $sigs_ref = $msginfo->dkim_signatures_valid;
    if ($sigs_ref) {
      for my $sig (@$sigs_ref) {
        my $type = $sig->isa('Mail::DKIM::DkSignature') ? 'DK' : 'DKIM';
        $txt_msg .= sprintf("Reported-Domain: %s (valid %s signature by)\n",
                            $sig->domain, $type);
      }
    }
    if (c('enable_dkim_verification')) {
      for (Amavis::DKIM::generate_authentication_results($msginfo,0)) {
        my $h = $_;  $h =~ tr/\n//d;  # remove potential folding points
        $txt_msg .= "Authentication-Results: $h\n";
      }
    }
    $txt_msg .= "Incidents: 1\n";
    # Reported-URI
  }

  my($txt_8bit, $txt_utf8);
  my($delivery_status_mime_type, $delivery_status_mime_subtype);
  if ($is_dsn || $is_arf) {
    $txt_8bit = ($txt_msg=~tr/\x00-\x7F//c) + ($txt_recip=~tr/\x00-\x7F//c);
    $txt_utf8 = !$txt_8bit ||
                (is_valid_utf_8($txt_msg) && is_valid_utf_8($txt_recip));
    $delivery_status_mime_subtype =
        $is_arf ? 'feedback-report'
      : $txt_utf8 && ($is_smtputf8 || $txt_8bit) ? 'global-delivery-status'
                                                 : 'delivery-status';
    $delivery_status_mime_type = 'message/' . $delivery_status_mime_subtype;
  }

  if ( $is_arf || $is_plain || $is_attach ||
      ($is_dsn && ($any_succ || $any_fail || $any_delayed)) ) {
    my(@hdr_to) = $notif_recips ? qquote_rfc2821_local(@$notif_recips)
                                : map($_->recip_addr_smtp, @$per_recip_data);
    $_ = mail_addr_idn_to_ascii($_)  for @hdr_to;
    my $hdr_from = $msginfo->setting_by_contents_category(
                              $is_dsn ? cr('hdrfrom_notify_sender_by_ccat') :
            $request_type eq 'report' ? cr('hdrfrom_notify_report_by_ccat') :
                                        cr('hdrfrom_notify_release_by_ccat') );
    # make sure it's in octets
    $hdr_from = expand_variables(safe_encode_utf8($hdr_from));
    # use the provided template text
    my(%mybuiltins) = %$builtins_ref;  # make a local copy
    # not really needed, these header fields are overridden later
    $mybuiltins{'f'} = safe_decode_utf8($hdr_from);
    $mybuiltins{'T'} = \@hdr_to;
    $mybuiltins{'d'} = $rfc2822_dsn_time;
    $mybuiltins{'report_format'} = $msg_format;
    $mybuiltins{'feedback_type'} = $feedback_type;

    # RFC 3461 section 6.2: "If a DSN contains no notifications of
    # delivery failure, the MTA SHOULD return only the header section."
    my $dsn_ret = $msginfo->dsn_ret;
    my $attach_full_msg =
      !$is_dsn ? 1 : (defined $dsn_ret && $dsn_ret eq 'FULL' && $any_fail);
    if ($attach_full_msg && $is_dsn) {
      # apologize in the log, we should have supplied the full message, yet
      # RFC 3461 section 6.2 gives us an excuse: "However, if the length of the
      # message is greater than some implementation-specified length, the MTA
      # MAY return only the headers even if the RET parameter specified FULL."
      do_log(1, "DSN RET=%s requested, but we'll only attach a header section",
                $dsn_ret);
      $attach_full_msg = 0;  # override, just attach a header section
    }
    my $template_ref = $msginfo->setting_by_contents_category(
                                $is_dsn ? cr('notify_sender_templ_by_ccat') :
              $request_type eq 'report' ? cr('notify_report_templ_by_ccat') :
                                          cr('notify_release_templ_by_ccat') );
    my $report_str_ref = expand($template_ref, \%mybuiltins);

    # 'multipart/report' MIME type is defined in RFC 6522. The report-type
    # parameter identifies the type of report. The parameter is the MIME
    # subtype of the second body part of the multipart/report.
    my $report_entity = build_mime_entity($report_str_ref, $msginfo,
       !$is_dsn && !$is_arf ? 'multipart/mixed'
         : "multipart/report; report-type=$delivery_status_mime_subtype",
       $msg_format, $is_plain, 1, $attach_full_msg);

    my $head = $report_entity->head;
    # RFC 3464: The From field of the message header section of the DSN SHOULD
    # contain the address of a human who is responsible for maintaining the
    # mail system at the Reporting MTA site (e.g. Postmaster), so that a reply
    # to the DSN will reach that person.
    # Override header fields from the template:
    eval { $head->replace('From', $hdr_from); 1 }
      or do { chomp $@; die $@ };
    eval { $head->replace('To', join(', ',@hdr_to)); 1 }
      or do { chomp $@; die $@ };
    eval { $head->replace('Date', $rfc2822_dsn_time); 1 }
      or do { chomp $@; die $@ };

    if ($is_dsn || $is_arf) {  # attach a delivery-status or a feedback-report
      ll(4) && do_log(4,"dsn: creating mime part %s, %s",
                        $delivery_status_mime_type,
                        !$txt_8bit ? 'us-ascii' : $txt_utf8 ? 'valid UTF-8'
                          : '8bit but *not* UTF-8');
      eval {  # make sure our source line number is reported in case of failure
        # RFC 6533: Note that [RFC6532] relaxed a restriction from MIME
        # [RFC2046] regarding the use of Content-Transfer-Encoding in new
        # "message" subtypes.  This specification explicitly allows the
        # use of Content-Transfer-Encoding in message/global-headers and
        # message/global-delivery-status.
        # RFC 5965: Encoding considerations for message/feedback-report:
        # "7bit" encoding is sufficient and MUST be used to maintain
        # readability when viewed by non-MIME mail readers.
        $report_entity->add_part(
          MIME::Entity->build(
            Top => 0,
            Type => $delivery_status_mime_type,
            Data => $txt_msg . $txt_recip,
            $delivery_status_mime_subtype ne 'global-delivery-status' ? ()
              : (Charset => 'UTF-8'),
            Encoding    => $txt_8bit ? '8bit' : '7bit',
            Disposition => 'inline',
            Filename    => $is_arf ? 'arf_status'
                         : $delivery_status_mime_subtype eq
                             'global-delivery-status' ? 'dsn_status.u8dsn'
                                                      : 'dsn_status.dsn',
            Description => $is_arf      ? "\u$feedback_type report"
                         : $any_fail    ? 'Delivery error report'
                         : $any_delayed ? 'Delivery delay report'
                         :                'Delivery report',
          ), 1);  # insert as a second mime part (at offset 1)
        1;
      } or do {
        my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
        die $eval_stat;
      };
    }
    my $mailfrom =
      $is_dsn ? ''  # DSN envelope sender must be empty
              : mail_addr_idn_to_ascii(
                  unquote_rfc2821_local( (parse_address_list($hdr_from))[0] ));
    $notification = Amavis::In::Message->new;
    $notification->rx_time($dsn_time);
    $notification->log_id($msginfo->log_id);
    $notification->partition_tag($msginfo->partition_tag);
    $notification->parent_mail_id($msginfo->mail_id);
    $notification->mail_id(scalar generate_mail_id());
    $notification->conn_obj($msginfo->conn_obj);
    $notification->originating(
      ($request_type eq 'dsn' || $request_type eq 'report') ? 1 : 0);
    $notification->mail_text($report_entity);
    $notification->body_type($txt_8bit ? '8BITMIME' : '7BIT');
    $notification->add_contents_category(CC_CLEAN,0);
    my(@recips) = $notif_recips ? @$notif_recips
                                : map($_->recip_addr, @$per_recip_data);
    if ($request_type eq 'dsn' || $request_type eq 'report') {
      my $bcc = $msginfo->setting_by_contents_category(cr('dsn_bcc_by_ccat'));
      push(@recips, $bcc)  if defined $bcc && $bcc ne '';
    }
    if (grep( / [^\x00-\x7F] .*? \@ [^@]* \z/sx && is_valid_utf_8($_),
              ($mailfrom, @recips) )) {
      # localpart is non-ASCII UTF-8, we must use SMTPUTF8
      do_log(2, 'DSN notification requires SMTPUTF8');
      $notification->smtputf8(1);
    } else {
      $_ = mail_addr_idn_to_ascii($_)  for ($mailfrom, @recips);
    }
    $notification->sender($mailfrom);
    $notification->sender_smtp(qquote_rfc2821_local($mailfrom));
    $notification->auth_submitter('<>');
    $notification->auth_user(c('amavis_auth_user'));
    $notification->auth_pass(c('amavis_auth_pass'));
    $notification->recips(\@recips, 1);
    if (defined $hdr_from) {
      my(@rfc2822_from) =
        map(unquote_rfc2821_local($_), parse_address_list($hdr_from));
      $notification->rfc2822_from($rfc2822_from[0]);
    }
    my $notif_m = c('notify_method');
    $_->delivery_method($notif_m)  for @{$notification->per_recip_data};
  }
  do_log(5, 'delivery_status_notification: notif %d bytes, suppressed: %s',
            length($notification), $suppressed ? 'yes' : 'no');
  # $suppressed is true if DNS would be needed, but either the sender requested
  #   that DSN is not to be sent, or it is believed the bounce would not reach
  #   the correct sender (faked sender with viruses or spam);
  # $notification is undef if DSN is not needed
  ($notification, $suppressed);
}

# Return a triple of arrayrefs of quoted recipient addresses (the first lists
# recipients with successful delivery status, the second lists all the rest),
# plus a list of short per-recipient delivery reports for failed deliveries,
# that can be used in the first MIME part (the free text format) of delivery
# status notifications.
#
sub delivery_short_report($) {
  my $msginfo = $_[0];
  my(@succ_recips, @failed_recips, @failed_recips_full);
  for my $r (@{$msginfo->per_recip_data}) {
    my $remote_mta  = $r->recip_remote_mta;
    my $smtp_resp   = $r->recip_smtp_response;
    my $qrecip_addr = scalar(qquote_rfc2821_local($r->recip_addr));
    if ($r->recip_destiny == D_PASS && ($smtp_resp=~/^2/ || !$r->recip_done)) {
      push(@succ_recips, $qrecip_addr);
    } else {
      push(@failed_recips, $qrecip_addr);
      push(@failed_recips_full, sprintf("%s:%s\n   %s", $qrecip_addr,
        (!defined($remote_mta)||$remote_mta eq '' ?'' :" [$remote_mta] said:"),
        $smtp_resp));
    }
  }
  (\@succ_recips, \@failed_recips, \@failed_recips_full);
}

# Build a new MIME::Entity object based on the original mail, but hopefully
# safer to mail readers: conventional mail header fields are retained,
# original mail becomes an attachment of type 'message/rfc822' or
# 'message/global'. Text in $first_part becomes the first MIME part
# of type 'text/plain', $first_part may be a scalar string or a ref
# to a list of lines
#
sub defanged_mime_entity($$) {
  my($msginfo,$first_part) = @_;
  my $new_entity;
  $_ = safe_encode(c('bdy_encoding'), $_)
    for (ref $first_part ? @$first_part : $first_part);
  eval {  # make sure _our_ source line number is reported in case of failure
    $new_entity = MIME::Entity->build(
                    Type => 'multipart/mixed', 'X-Mailer' => undef);
    1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die $eval_stat;
  };
  # reinserting some of the original header fields to a new header, sanitized
  my $hdr_edits = $msginfo->header_edits;
  if (!$hdr_edits) {
    $hdr_edits = Amavis::Out::EditHeader->new;
    $msginfo->header_edits($hdr_edits);
  }
  my(%desired_field);
  for (qw(Received From Sender To Cc Reply-To Date Message-ID
          Resent-From Resent-Sender Resent-To Resent-Cc
          Resent-Date Resent-Message-ID In-Reply-To References Subject
          Comments Keywords Organization Organisation User-Agent X-Mailer
          DKIM-Signature DomainKey-Signature))
    { $desired_field{lc($_)} = 1 };
  local($1,$2);
  for my $curr_head (@{$msginfo->orig_header}) {  # array of header fields
    # obsolete RFC 822 syntax allowed whitespace before colon
    my($field_name, $field_body) =
      $curr_head =~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s
        ? ($1, $2) : (undef, $curr_head);
    if ($desired_field{lc($field_name)}) {  # only desired header fields
      # protect NUL, CR, and characters with codes above \377
      $field_body =~ s{ ( [^\001-\014\016-\377] ) }
                      { sprintf(ord($1)>255 ? '\\x{%04x}' : '\\x{%02x}',
                                ord($1)) }xgse;
      # protect NL in illegal all-whitespace continuation lines
      $field_body =~ s{\n([ \t]*)(?=\n)}{\\012$1}gs;
      $field_body =~ s{^(.{995}).{4,}$}{$1...}gm;  # truncate lines to 998
      chomp($field_body);    # note that field body is already folded
      if (lc($field_name) eq 'subject') {
        # needs to be inserted directly into new header section so that it
        # can be subjected to header edits, like inserting ***UNCHECKED***
        eval { $new_entity->head->add($field_name,$field_body); 1 }
          or do {chomp $@; die $@};
      } else {
        $hdr_edits->append_header($field_name,$field_body,2);
      }
    }
  }

  eval {
    my $cnt_8bit = $first_part =~ tr/\x00-\x7F//c;
    $new_entity->attach(
      Type => 'text/plain', Data => $first_part,
      Charset => c('bdy_encoding'),
      Encoding => !$cnt_8bit ? '7bit'
                : $cnt_8bit > 0.2 * length($first_part) ? 'base64'
                : 'quoted-printable',
    );
    1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die $eval_stat;
  };
  # prepend a Return-Path to make available the envelope sender address
  my $rp = sprintf("Return-Path: %s\n", $msginfo->sender_smtp);
  my $orig_mail_as_body;
  my $msg = $msginfo->mail_text;
  my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
  $msg = $msg_str_ref  if ref $msg_str_ref;
  if (!defined $msg) {
    # empty mail
  } elsif (ref $msg eq 'SCALAR') {
    # will be handled by ->attach
  } elsif ($msg->isa('MIME::Entity')) {
    die "attaching a MIME::Entity object is not implemented";
  } else {
    $orig_mail_as_body =
      Amavis::MIME::Body::OnOpenFh->new($msginfo->mail_text,
                                        [$rp], $msginfo->skip_bytes);
    $orig_mail_as_body or die "Can't create Amavis::MIME::Body object: $!";
  }
  eval {
    my $att = $new_entity->attach(  # RFC 2046
      Type => ($msginfo->smtputf8 && $msginfo->header_8bit ? 'message/global'
                 : 'message/rfc822') . '; x-spam-type=original',
      Encoding => $msginfo->header_8bit || $msginfo->body_8bit ? '8bit':'7bit',
      Data => defined $orig_mail_as_body ? []
            : !$msginfo->skip_bytes ? $msg
            : substr($$msg, $msginfo->skip_bytes),
    # Path => $msginfo->mail_text_fn,
      Description => 'Original message',
      Filename => 'message', Disposition => 'attachment',
    );
    # direct access to tempfile handle
    $att->bodyhandle($orig_mail_as_body)  if defined $orig_mail_as_body;
    1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die $eval_stat;
  };
  $new_entity;
}

# Fill-in a message object with information based on a quarantined mail.
# Expects $msginfo->mail_text to be a file handle (not a Mime::Entity object),
# leaves it positioned at the beginning of a mail body (not to be relied upon).
# If given a BSMTP file, expects that it contains a single message only.
#
sub msg_from_quarantine($$$) {
  my($msginfo,$request_type,$feedback_type) = @_;
  my $fh = $msginfo->mail_text;
  my $sender_override = $msginfo->sender;
  my $recips_data_override = $msginfo->per_recip_data;
  my $quarantine_id = $msginfo->parent_mail_id;
  $quarantine_id = ''  if !defined $quarantine_id;
  my $reporting = $request_type eq 'report';
  my $release_m;
  if ($request_type eq 'requeue') {
    $release_m = c('requeue_method');
    $release_m ne '' or die "requeue_method is unspecified";
  } else {  # 'release' or 'report'
    $release_m = c('release_method');
    $release_m = c('notify_method') if !defined $release_m || $release_m eq '';
    $release_m ne '' or die "release_method and notify_method are unspecified";
  }
  $msginfo->originating(1);  # (also enables DKIM signing)
  $msginfo->add_contents_category(CC_CLEAN,0);
  $msginfo->auth_submitter('<>');
  $msginfo->auth_user(c('amavis_auth_user'));
  $msginfo->auth_pass(c('amavis_auth_pass'));
  $fh->seek($msginfo->skip_bytes, 0) or die "Can't rewind mail file: $!";
  my $bsmtp = 0;  # message stored in an RFC 2442 format?
  my($qid,$sender,@recips_all,@recips_blocked);
  my $have_recips_blocked = 0; my $curr_head;
  my $ln; my $eof = 0; my $position = 0;
  my $offset_bytes = 0;  # file position just past the prefixed header fields
  # extract envelope information from the quarantine file
  do_log(4, "msg_from_quarantine: releasing %s", $quarantine_id);
  for (;;) {
    if ($eof) { $ln = "\n" }
    else {
      $! = 0; $ln = $fh->getline;
      if (!defined($ln)) {
        $eof = 1; $ln = "\n";  # fake a missing header/body separator line
        $! == 0  or die "Error reading file ".$msginfo->mail_text_fn.": $!";
      }
    }
    if ($ln =~ /^[ \t]/) { $curr_head .= $ln }
    else {
      my $next_head = $ln; local($1,$2);
      local($_) = $curr_head;  chomp;  s/\n(?=[ \t])//gs;  # unfold
      if (!defined($curr_head)) {  # first time
      } elsif (/^(?:EHLO|HELO)(?: |$)/i) { $bsmtp = 1;
      } elsif (/^MAIL FROM:[ \t]*(<.*>)/i) {
        $bsmtp = 1; $sender = $1; $sender = unquote_rfc2821_local($sender);
      } elsif ( $bsmtp && /^RCPT TO:[ \t]*(<.*>)/i) {
        push(@recips_all, unquote_rfc2821_local($1));
      } elsif ( $bsmtp && /^(?:DATA|NOOP)$/i) {
      } elsif ( $bsmtp && /^RSET$/i) {
        $sender = undef; @recips_all = (); @recips_blocked = (); $qid = undef;
      } elsif ( $bsmtp && /^QUIT$/i) { last;
      } elsif (!$bsmtp && /^Delivered-To:/si) {
      } elsif (!$bsmtp && /^(Return-Path|X-Envelope-From):[ \t]*(.*)$/si) {
        if (!defined $sender) {
          my(@addr_list) = parse_address_list($2);
          @addr_list >= 1  or die "Address missing in $1";
          @addr_list <= 1  or die "More than one address in $1";
          $sender =
            mail_addr_idn_to_ascii(unquote_rfc2821_local($addr_list[0]));
        }
      } elsif (!$bsmtp && /^X-Envelope-To:[ \t]*(.*)$/si) {
        my(@addr_list) = parse_address_list($1);
        push(@recips_all,
             map(mail_addr_idn_to_ascii(unquote_rfc2821_local($_)),
                 @addr_list));
      } elsif (!$bsmtp && /^X-Envelope-To-Blocked:[ \t]*(.*)$/si) {
        my(@addr_list) = parse_address_list($1);
        push(@recips_blocked,
             map(mail_addr_idn_to_ascii(unquote_rfc2821_local($_)),
                 @addr_list));
        $have_recips_blocked = 1;
      } elsif (/^X-Quarantine-ID:[ \t]*(.*)$/si) {
        $qid = $1;   $qid = $1 if $qid =~ /^<(.*)>\z/s;
      } elsif (!$reporting && /^X-Amavis-(?:Hold|Alert|Modified|PenPals|
                                            PolicyBank|OS-Fingerprint):/xsi) {
        # skip
      } elsif (!$reporting && /^(?:X-Spam|X-CRM114)-.+:/si) {
        # skip header fields inserted by us
      } else {
        last;  # end of known header fields, to be marked as 'skip_bytes'
      }
      last  if $next_head eq "\n";  # end-of-header-section reached
      $offset_bytes = $position;    # move past last processed header field
      $curr_head = $next_head;
    }
    $position += length($ln);
  }
  @recips_blocked = @recips_all  if !$have_recips_blocked; # pre-2.6.0 compatib
  my(@except);
  if (@recips_blocked < @recips_all) {
    for my $rec (@recips_all)
      { push(@except,$rec)  if !grep($rec eq $_, @recips_blocked) }
  }
  my $sender_smtp = qquote_rfc2821_local($sender);
  do_log(0,"Quarantined message %s (%s): %s %s -> %s%s",
           $request_type, $feedback_type, $quarantine_id, $sender_smtp,
           join(',', qquote_rfc2821_local(@recips_blocked)),
           !@except ? '' : (", (excluded: ".
                            join(',', qquote_rfc2821_local(@except)) . " )" ));
  my(@m);
  if (!defined($qid)) { push(@m, 'missing X-Quarantine-ID') }
  elsif ($qid ne $quarantine_id) {
    push(@m, sprintf("stored quar. ID '%s' does not match requested ID '%s'",
                     $qid,$quarantine_id));
  }
  push(@m, 'missing '.($bsmtp?'MAIL FROM':'X-Envelope-From or Return-Path'))
    if !defined $sender;
  push(@m, 'missing '.($bsmtp?'RCPT TO'  :'X-Envelope-To'))  if !@recips_all;
  do_log(0, "Quarantine %s %s: %s",
            $request_type, $quarantine_id, join("; ",@m))  if @m;
  if ($qid ne $quarantine_id)
    { die "Stored quarantine ID '$qid' does not match ".
          "requested ID '$quarantine_id'" }
  if ($bsmtp)
    { die "Releasing messages in BSMTP format not yet supported ".
           "(dot de-stuffing not implemented)" }
  $msginfo->sender($sender); $msginfo->sender_smtp($sender_smtp);
  $msginfo->recips(\@recips_all);
  $_->delivery_method($release_m)  for @{$msginfo->per_recip_data};
  # mark a file location past prefixed header fields where orig message starts
  $msginfo->skip_bytes($offset_bytes);

  my $msg_format = $request_type eq 'dsn'    ? 'dsn'
                 : $request_type eq 'report' ? c('report_format')
                                             : c('release_format');
  my $hdr_edits = Amavis::Out::EditHeader->new;
  $msginfo->header_edits($hdr_edits);
  if ($msg_format eq 'resend') {
    if (!defined($recips_data_override)) {
      $msginfo->recips(\@recips_blocked);  # override 'all' by 'blocked' recips
    } else {  # recipients specified in the request override stored info
      ll(5) && do_log(5, 'overriding recips %s by %s',
                  join(',', qquote_rfc2821_local(@recips_blocked)),
                  join(',', map($_->recip_addr_smtp, @$recips_data_override)));
      $msginfo->per_recip_data($recips_data_override);
    }
    $_->delivery_method($release_m)  for @{$msginfo->per_recip_data};
  } else {
    # collect more information from a quarantined message, making it available
    # to a report generator and to macros during template expansion
    Amavis::get_body_digest($msginfo, c('mail_digest_algorithm'));
    Amavis::collect_some_info($msginfo);
    if (defined($recips_data_override) && ll(5)) {
      do_log(5, 'overriding recips %s by %s',
                join(',', qquote_rfc2821_local(@recips_blocked)),
                join(',', map($_->recip_addr_smtp, @$recips_data_override)));
    }
    my($notification,$suppressed) = delivery_status_notification(
      $msginfo, 0, \%Amavis::builtins,
      !defined($recips_data_override) ? \@recips_blocked
        : [ map($_->recip_addr, @$recips_data_override) ],
      $request_type, $feedback_type, undef);
    # pushes original quarantined message into an attachment of a notification
    $msginfo = $notification;
  }
  if (defined $sender_override) {
    # sender specified in the request, overrides stored info
    do_log(5, "overriding sender %s by %s", $sender, $sender_override);
    $msginfo->sender($sender_override);
    $msginfo->sender_smtp(qquote_rfc2821_local($sender_override));
  }
  if ($msg_format eq 'resend') { # keep quarantined message at a top MIME level
    # Resent-* header fields must precede corresponding Received header field
    # "Resent-From:" and "Resent-Date:" are required fields!
    my $hdrfrom_recip = $msginfo->setting_by_contents_category(
                                           cr('hdrfrom_notify_recip_by_ccat'));
    # make sure it's in octets
    $hdrfrom_recip = expand_variables(safe_encode_utf8($hdrfrom_recip));
    if ($msginfo->requested_by eq '') {
      $hdr_edits->add_header('Resent-From', $hdrfrom_recip);
    } else {
      $hdr_edits->add_header('Resent-From',
                             qquote_rfc2821_local($msginfo->requested_by));
      $hdr_edits->add_header('Resent-Sender',
                             $hdrfrom_recip)  if $hdrfrom_recip ne '';
    }
    my $prd = $msginfo->per_recip_data;
    $hdr_edits->add_header('Resent-To',
                           $prd && @$prd==1 ? $prd->[0]->recip_addr_smtp
                                            : 'undisclosed-recipients:;');
    $hdr_edits->add_header('Resent-Date', # time of the release
                  rfc2822_timestamp($msginfo->rx_time));
    my $myhost = c('myhostname');  # my FQDN (DNS) name, UTF-8 octets
    $myhost = $msginfo->smtputf8 ? idn_to_utf8($myhost) :idn_to_ascii($myhost);
    $hdr_edits->add_header('Resent-Message-ID',
               sprintf('<%s-%s@%s>',
                       $msginfo->parent_mail_id||'', $msginfo->mail_id||'',
                       $myhost) );
  }
  $hdr_edits->add_header('Received', make_received_header_field($msginfo,1),1);
  my $bcc = $msginfo->setting_by_contents_category(cr('always_bcc_by_ccat'));
  if (defined $bcc && $bcc ne '' && $request_type ne 'report') {
    my $recip_obj = Amavis::In::Message::PerRecip->new;
    $recip_obj->recip_addr_modified($bcc);

    # leave recip_addr and recip_addr_smtp undefined to hide it from the log?
    $recip_obj->recip_addr($bcc);
    $recip_obj->recip_addr_smtp(qquote_rfc2821_local($bcc));  #****

    $recip_obj->recip_is_local(
      lookup2(0, $bcc, ca('local_domains_maps')) ? 1 : 0);
    $recip_obj->recip_destiny(D_PASS);
    $recip_obj->dsn_notify(['NEVER']);
    $recip_obj->delivery_method(c('notify_method'));
    $recip_obj->add_contents_category(CC_CLEAN,0);
    $msginfo->per_recip_data([@{$msginfo->per_recip_data}, $recip_obj]);
    do_log(2,"adding recipient - always_bcc: %s, delivery method %s",
             $bcc, $recip_obj->delivery_method);
  }
  $msginfo;
}

1;
