package Amavis::Out::SQL::Quarantine;
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_sql);
  import Amavis::Out::SQL::Connection ();
}
use subs @EXPORT;

use DBI qw(:sql_types);

use Amavis::Conf qw(:platform c cr ca $sql_quarantine_chunksize_max);
use Amavis::rfc2821_2822_Tools qw(qquote_rfc2821_local);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log snmp_count collect_equal_delivery_recips);
use Amavis::IO::SQL;

sub mail_via_sql {
  my($conn_h,
     $msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;
  my(@snmp_vars) = !$initial_submission ?
    ('', 'Relay',  'ProtoSQL', 'ProtoSQLRelay')
  : ('', 'Submit', 'ProtoSQL', 'ProtoSQLSubmit',
     'Submit'.$initial_submission);
  snmp_count('OutMsgs'.$_)  for @snmp_vars;
  my $logmsg =
    sprintf("%s via SQL (%s): %s", ($initial_submission?'SEND':'FWD'),
            $conn_h->dsn_current, $msginfo->sender_smtp);
  my($per_recip_data_ref, $proto_sockname) =
    collect_equal_delivery_recips($msginfo, $filter, qr/^sql:/i);
  if (!$per_recip_data_ref || !@$per_recip_data_ref) {
    do_log(5, "%s, nothing to do", $logmsg);  return 1;
  }
  my $mail_id = $msginfo->mail_id;
  defined $mail_id  or die "mail_via_sql: mail_id still undefined";
  $proto_sockname = $proto_sockname->[0]  if ref $proto_sockname;
  ll(1) && do_log(1, "delivering to %s, %s -> %s, mail_id %s",
                     $proto_sockname, $logmsg,
                     join(',', qquote_rfc2821_local(
                            map($_->recip_final_addr, @$per_recip_data_ref)) ),
                     $mail_id);
  my $msg = $msginfo->mail_text;  # a scalar reference, or a file handle
  my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
  $msg = $msg_str_ref  if ref $msg_str_ref;
  my($err,$smtp_response);
  eval {
    my $sql_cl_r = cr('sql_clause');
    $conn_h->begin_work;  # SQL transaction starts
    eval {
      my $mp = Amavis::IO::SQL->new;
      $mp->open($conn_h, $sql_cl_r->{'ins_quar'}, $msginfo->mail_id, 'w',
                $msginfo->partition_tag, $sql_quarantine_chunksize_max,
                $msginfo->rx_time)
        or die "Can't open Amavis::IO::SQL object: $!";
      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);
      if ($received_cnt > 100) { # loop detection required by RFC 5321 sect 6.2
        die "Too many hops: $received_cnt 'Received:' header fields";
      } elsif (!defined $msg) {
        # empty mail
      } elsif (ref $msg eq 'SCALAR') {
        $mp->print(substr($$msg,$file_position))
          or die "Can't write to SQL storage: $!";
      } elsif ($msg->isa('MIME::Entity')) {
        $msg->print_body($mp);
      } else {
        my($nbytes,$buff);
        while (($nbytes = $msg->read($buff,32768)) > 0) {
          $mp->print($buff) or die "Can't write to SQL storage: $!";
        }
        defined $nbytes or die "Error reading: $!";
      }
      $mp->close or die "Error closing Amavis::IO::SQL object: $!";
      $conn_h->commit;  1;
    } or do {
      my $err = $@ ne '' ? $@ : "errno=$!";  chomp $err;  my $msg = $err;
      $msg = "writing mail text to SQL failed: $msg"; do_log(0,"%s",$msg);
      if ($conn_h->in_transaction) {
        eval {
          $conn_h->rollback;
          do_log(1,"mail_via_sql: rollback done");  1;
        } or do {
          $@ = "errno=$!"  if $@ eq '';  chomp $@;
          do_log(1,"mail_via_sql: rollback %s", $@);
          die $@  if $@ =~ /^timed out\b/;  # resignal timeout
        };
      }
      die $err  if $err =~ /^timed out\b/;  # resignal timeout
      die $msg;
    };
    1;
  } or do { $err = $@ ne '' ? $@ : "errno=$!" };
  if ($err eq '') {
    $smtp_response = "250 2.6.0 Ok, Stored to sql db as mail_id $mail_id";
    snmp_count('OutMsgsDelivers');
    my $size = $msginfo->msg_size;
    snmp_count( ['OutMsgsSize'.$_, $size, 'C64'] )  for @snmp_vars;
  } else {
    chomp $err;
    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 Storing to sql db as mail_id $mail_id failed: $err";
      snmp_count('OutMsgsAttemptFails');
    }
    die $err  if $err =~ /^timed out\b/;  # resignal timeout
  }
  $smtp_response .= ", id=" . $msginfo->log_id;
  for my $r (@$per_recip_data_ref) {
    next  if $r->recip_done;
    $r->recip_smtp_response($smtp_response); $r->recip_done(2);
    if ($smtp_response =~ /^2/) {
      my $mbxname = $mail_id;
      my $p_tag = $msginfo->partition_tag;
      $mbxname .= '[' . $p_tag . ']'
        if defined($p_tag) && $p_tag ne '' && $p_tag ne '0';
      $r->recip_mbxname($mbxname);
    }
  }
  section_time('fwd-sql');
  1;
}

1;