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

package Amavis::Out::BSMTP;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';

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

use Errno qw(ENOENT EACCES);
use IO::File qw(O_CREAT O_EXCL O_WRONLY);

use Amavis::Conf qw(:platform $QUARANTINEDIR c cr ca);
use Amavis::Out::EditHeader;
use Amavis::rfc2821_2822_Tools;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(untaint min max minmax ll do_log snmp_count
                    idn_to_ascii collect_equal_delivery_recips);

# store message in a BSMTP format
#
# RFC 2442: Application/batch-SMTP material is generated by a specially
# modified SMTP client operating without a corresponding SMTP server.
# The client simply assumes a successful response to all commands it issues.
# The resulting content then consists of the collected output from the SMTP
# client.
#
sub mail_via_bsmtp(@) {
  my($msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;
  my(@snmp_vars) = !$initial_submission ?
    ('', 'Relay',  'ProtoBSMTP', 'ProtoBSMTPRelay')
  : ('', 'Submit', 'ProtoBSMTP', 'ProtoBSMTPSubmit',
     'Submit'.$initial_submission);
  snmp_count('OutMsgs'.$_)  for @snmp_vars;
  my $logmsg = sprintf("%s via BSMTP: %s", ($initial_submission?'SEND':'FWD'),
                       $msginfo->sender_smtp);
  my($per_recip_data_ref, $proto_sockname) =
    collect_equal_delivery_recips($msginfo, $filter, qr/^bsmtp:/i);
  if (!$per_recip_data_ref || !@$per_recip_data_ref) {
    do_log(5, "%s, nothing to do", $logmsg);  return 1;
  }
  $proto_sockname = $proto_sockname->[0]  if ref $proto_sockname;
  ll(1) && do_log(1, "delivering to %s, %s -> %s",
                     $proto_sockname, $logmsg,
                     join(',', qquote_rfc2821_local(
                           map($_->recip_final_addr, @$per_recip_data_ref)) ));
  # just use the first one, ignoring failover alternatives
  local($1);
  $proto_sockname =~ /^bsmtp:(.*)\z/si
    or die "Bad fwd method syntax: ".$proto_sockname;
  my $bsmtp_file_final = $1; my $mbxname;
  my $s = $msginfo->sender;  # sanitized sender name for use in a filename
  $s =~ tr/a-zA-Z0-9@._+-/=/c;
  substr($s,100) = '...'  if length($s) > 100+3;
  $s =~ s/\@/_at_/g; $s =~ s/^(\.{0,2})\z/_$1/;
  $bsmtp_file_final =~ s{%(.)}
    {  $1 eq 'b' ? $msginfo->body_digest
     : $1 eq 'P' ? $msginfo->partition_tag
     : $1 eq 'm' ? $msginfo->mail_id||''
     : $1 eq 'n' ? $msginfo->log_id
     : $1 eq 's' ? untaint($s)  # a hack, avoid using %s
     : $1 eq 'i' ? iso8601_timestamp($msginfo->rx_time,1)  #,'-')
     : $1 eq '%' ? '%' : '%'.$1 }gse;
  # prepend directory if not specified
  my $bsmtp_file_final_to_show = $bsmtp_file_final;
  $bsmtp_file_final = $QUARANTINEDIR."/".$bsmtp_file_final
    if $QUARANTINEDIR ne '' && $bsmtp_file_final !~ m{^/};
  my $bsmtp_file_tmp = $bsmtp_file_final . ".tmp";
  my $mp; my $err;
  eval {
    my $errn = lstat($bsmtp_file_tmp) ? 0 : 0+$!;
    if ($errn == ENOENT) {}   # good, no file, as expected
    elsif ($errn==0 && (-f _ || -l _))
      { die "File $bsmtp_file_tmp already exists, refuse to overwrite" }
    else
      { die "File $bsmtp_file_tmp exists??? Refuse to overwrite it, $!" }
    $mp = IO::File->new;
    # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
    $mp->open($bsmtp_file_tmp, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
      or die "Can't create BSMTP file $bsmtp_file_tmp: $!";
    binmode($mp,':bytes') or die "Can't set :bytes, $!";

#   RFC 2442: Since no SMTP server is present the client must be prepared
#   to make certain assumptions about which SMTP extensions can be used.
#   The generator MAY assume that ESMTP [RFC 1869 (obsoleted by RFC 5321)]
#   facilities are available, that is, it is acceptable to use the EHLO
#   command and additional parameters on MAIL FROM and RCPT TO.  If EHLO
#   is used MAY assume that the 8bitMIME [RFC 6152], SIZE [RFC 1870], and
#   NOTARY [RFC 1891] extensions are available. In particular, NOTARY
#   SHOULD be used. (nowadays called DSN)

    my $myheloname = c('localhost_name');  # host name used in EHLO/HELO/LHLO
    $myheloname = 'localhost'  if $myheloname eq '';
    $myheloname = idn_to_ascii($myheloname);
    $mp->printf("EHLO %s\n", $myheloname)  or die "print failed (EHLO): $!";
    my $btype = $msginfo->body_type;  # RFC 6152: need "8bit Data"? (RFC 2045)
    $btype = ''  if !defined $btype;
    my $dsn_envid = $msginfo->dsn_envid; my $dsn_ret = $msginfo->dsn_ret;
    $mp->printf("MAIL FROM:%s\n", join(' ',
                          $msginfo->sender_smtp,
                          $btype ne ''       ? ('BODY='.uc($btype))  : (),
                          defined $dsn_ret   ? ('RET='.$dsn_ret)     : (),
                          defined $dsn_envid ? ('ENVID='.$dsn_envid) : () ),
                ) or die "print failed (MAIL FROM): $!";
    for my $r (@$per_recip_data_ref) {
      my(@dsn_notify);  # implies a default when the list is empty
      my $dn = $r->dsn_notify;
      @dsn_notify = @$dn  if $dn && $msginfo->sender ne '';  # if nondefault
      if (@dsn_notify && c('terminate_dsn_on_notify_success')) {
        # we want to handle option SUCCESS locally
        if (grep($_ eq 'SUCCESS', @dsn_notify)) {  # strip out SUCCESS
          @dsn_notify = grep($_ ne 'SUCCESS', @dsn_notify);
          @dsn_notify = ('NEVER')  if !@dsn_notify;
          do_log(3,"stripped out SUCCESS, result: NOTIFY=%s",
                   join(',',@dsn_notify));
        }
      }
      $mp->printf("RCPT TO:%s\n", join(' ',
                       qquote_rfc2821_local($r->recip_final_addr),
                       @dsn_notify ? ('NOTIFY='.join(',',@dsn_notify))  : (),
                       defined $r->dsn_orcpt ? ('ORCPT='.$r->dsn_orcpt) : () ),
                  ) or die "print failed (RCPT TO): $!";
    }
    $mp->print("DATA\n") or die "print failed (DATA): $!";
    my $hdr_edits = $msginfo->header_edits;
    $hdr_edits = Amavis::Out::EditHeader->new  if !$hdr_edits;
    my($received_cnt,$file_position) =
      $hdr_edits->write_header($msginfo,$mp,!$initial_submission);
    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 ($received_cnt > 100) {  # loop detection required by RFC 5321 sect. 6.3
      die "Too many hops: $received_cnt 'Received:' header fields";
    } elsif (!defined $msg) {
      # empty mail
    } elsif (ref $msg eq 'SCALAR') {
      my $buff = substr($$msg,$file_position);
      $buff =~ s/^\./../gm;
      $mp->print($buff)  or die "print failed - data: $!";
    } elsif ($msg->isa('MIME::Entity')) {
      $msg->print_body($mp);
    } else {
      my $ln;
      for ($! = 0; defined($ln=$msg->getline); $! = 0) {
        $mp->print($ln=~/^\./ ? (".",$ln) : $ln)
          or die "print failed - data: $!";
      }
      defined $ln || $! == 0  or die "Error reading: $!";
    }
    $mp->print(".\n")    or die "print failed (final dot): $!";
  # $mp->print("QUIT\n") or die "print failed (QUIT): $!";
    $mp->close or die "Error closing BSMTP file $bsmtp_file_tmp: $!";
    undef $mp;
    rename($bsmtp_file_tmp, $bsmtp_file_final)
      or die "Can't rename BSMTP file to $bsmtp_file_final: $!";
    $mbxname = $bsmtp_file_final;
    1;
  } or do { $err = $@ ne '' ? $@ : "errno=$!" };
  my $smtp_response;
  if ($err eq '') {
    $smtp_response = "250 2.6.0 Ok, queued as BSMTP $bsmtp_file_final_to_show";
    snmp_count('OutMsgsDelivers');
    my $size = $msginfo->msg_size;
    snmp_count( ['OutMsgsSize'.$_, $size, 'C64'] )  for @snmp_vars;
  } else {
    chomp $err;
    unlink($bsmtp_file_tmp)
      or do_log(-2,"Can't delete half-finished BSMTP file %s: %s",
                   $bsmtp_file_tmp, $!);
    $mp->close  if defined $mp;  # ignore status
    if ($err =~ /too many hops\b/i) {
      $smtp_response = "554 5.4.6 Reject: $err";
      snmp_count('OutMsgsRejects');
    } else {
      $smtp_response = "451 4.5.0 Writing $bsmtp_file_tmp failed: $err";
      snmp_count('OutMsgsAttemptFails');
    }
    die $err  if $err =~ /^timed out\b/;  # resignal timeout
  }
  $smtp_response .= ", id=" . $msginfo->log_id;
  $msginfo->dsn_passed_on($smtp_response=~/^2/ &&
                          !c('terminate_dsn_on_notify_success') ? 1 : 0);
  for my $r (@$per_recip_data_ref) {
    next  if $r->recip_done;
    $r->recip_smtp_response($smtp_response); $r->recip_done(2);
    $r->recip_mbxname($mbxname)  if $mbxname ne '' && $smtp_response =~ /^2/;
  }
  section_time('fwd-bsmtp');
  1;
}

1;