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

package Amavis::Out::SQL::Connection;
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 DBI qw(:sql_types);

use Amavis::Conf qw(:platform c cr ca);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log do_log_safe);

# one object per connection (normally exactly one) to a database server;
# connection need not exist at all times, stores info on how to connect;
# when connected it holds a database handle
#
sub new {
  my($class, @dsns) = @_;  # a list of DSNs to try connecting to sequentially
  bless { dbh=>undef, sth=>undef, incarnation=>1, in_transaction=>0,
          dsn_list=>\@dsns, dsn_current=>undef }, $class;
}

sub dsn_current {  # get/set information on currently connected data set name
  my $self = shift; !@_ ? $self->{dsn_current} : ($self->{dsn_current}=shift);
}

sub dbh {  # get/set database handle
  my $self = shift; !@_ ? $self->{dbh} : ($self->{dbh}=shift);
}

sub sth {  # get/set statement handle
  my $self = shift; my $clause = shift;
  !@_ ? $self->{sth}{$clause} : ($self->{sth}{$clause}=shift);
}

sub dbh_inactive {  # get/set dbh "InactiveDestroy" attribute
  my $self = shift;
  my $dbh = $self->dbh;
  return if !$dbh;
  !@_ ? $dbh->{'InactiveDestroy'} : ($dbh->{'InactiveDestroy'}=shift);
}

sub DESTROY {
  my $self = $_[0]; local($@,$!,$_);
  do_log_safe(5,"Amavis::Out::SQL::Connection DESTROY called");
  # ignore failures, make perlcritic happy
  eval { $self->disconnect_from_sql } or 1;
}

# returns current connection version; works like cache versioning/invalidation:
# SQL statement handles need to be rebuilt and caches cleared when SQL
# connection is re-established and a new database handle provided
#
sub incarnation { my $self = $_[0]; $self->{incarnation} }

sub in_transaction {
  my $self = shift;
  !@_ ? $self->{in_transaction} : ($self->{in_transaction}=shift)
}

# returns DBD driver name such as 'Pg', 'mysql';  or undef if unknown
#
sub driver_name {
  my $self = $_[0];  my $dbh = $self->dbh;
  $dbh or die "sql driver_name: dbh not available";
  !$dbh->{Driver} ? undef : $dbh->{Driver}->{Name};
}

# DBI method wrappers:
#
sub begin_work {
  my $self = shift; do_log(5,"sql begin transaction");
  # DBD::mysql man page: if you detect an error while changing
  # the AutoCommit mode, you should no longer use the database handle.
  # In other words, you should disconnect and reconnect again
  $self->dbh or $self->connect_to_sql;
  my $stat; my $eval_stat;
  eval {
    $stat = $self->dbh->begin_work(@_);  1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
  };
  if (defined $eval_stat || !$stat) {
    do_log(-1,"sql begin transaction failed, ".
             "probably disconnected by server, reconnecting (%s)", $eval_stat);
    $self->disconnect_from_sql;
    die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
    $self->connect_to_sql;
    $stat = $self->dbh->begin_work(@_);
  }
  $self->in_transaction(1);
  $stat;
};

sub begin_work_nontransaction {
  my $self = $_[0]; do_log(5,"sql begin, nontransaction");
  $self->dbh or $self->connect_to_sql;
};

sub commit {
  my $self = shift; do_log(5,"sql commit");
  $self->in_transaction(0);
  my $dbh = $self->dbh;
  $dbh or die "commit: dbh not available";
  $dbh->commit(@_);  my($rv_err,$rv_str) = ($dbh->err, $dbh->errstr);
  do_log(2,"sql commit status: err=%s, errstr=%s",
           $rv_err,$rv_str)  if defined $rv_err;
  ($rv_err,$rv_str);  # potentially useful to see non-fatal errors
};

sub rollback {
  my $self = shift; do_log(5,"sql rollback");
  $self->in_transaction(0);
  $self->dbh or die "rollback: dbh not available";
  eval {
    $self->dbh->rollback(@_);  1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    do_log(-1,"sql rollback error, reconnecting (%s)", $eval_stat);
    $self->disconnect_from_sql;
    die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
    $self->connect_to_sql;
#   $self->dbh->rollback(@_);  # too late now, hopefully implied in disconnect
  };
};

sub fetchrow_arrayref {
  my($self,$clause,@args) = @_;
  $self->dbh or die "fetchrow_arrayref: dbh not available";
  my $sth = $self->sth($clause);
  $sth or die "fetchrow_arrayref: statement handle not available";
  $sth->fetchrow_arrayref(@args);
};

sub finish {
  my($self,$clause,@args) = @_;
  $self->dbh or die "finish: dbh not available";
  my $sth = $self->sth($clause);
  $sth or die "finish: statement handle not available";
  $sth->finish(@args);
};

sub execute {
  my($self,$clause,@args) = @_;
  $self->dbh or die "sql execute: dbh not available";
  my $sth = $self->sth($clause);  # fetch cached st. handle or prepare new
  if ($sth) {
    ll(5) && do_log(5, "sql: executing clause (%d args): %s",
                       scalar(@args), $clause);
  } else {
    ll(4) && do_log(4,"sql: preparing and executing (%d args): %s",
                       scalar(@args), $clause);
    $sth = $self->dbh->prepare($clause); $self->sth($clause,$sth);
    $sth or die "sql: prepare failed: ".$DBI::errstr;
  }
  my($rv_err,$rv_str);
  eval {
    for my $j (0..$#args) { # arg can be a scalar or [val,type] or [val,\%attr]
      my $arg = $args[$j];
      $sth->bind_param($j+1, !ref($arg) ? $arg : @$arg);
    # ll(5) && do_log(5, "sql: bind %d: %s",
    #                 $j+1, !ref($arg) ? $arg : '['.join(',',@$arg).']' );
    }
    $sth->execute; $rv_err = $sth->err; $rv_str = $sth->errstr;  1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    # man DBI: ->err code is typically an integer but you should not assume so
    # $DBI::errstr is normally already contained in $eval_stat
    my $sqlerr   = $sth ? $sth->err   : $DBI::err;
    my $sqlstate = $sth ? $sth->state : $DBI::state;
    my $msg = sprintf("err=%s, %s, %s", $sqlerr, $sqlstate, $eval_stat);
    if (!$sth) {
      die "sql execute (no handle): ".$msg;
    } elsif (! ($sqlerr eq '2006' || $sqlerr eq '2013'   ||   # MySQL
                ($sqlerr == -1 && $sqlstate eq  'S1000') ||   # PostgreSQL 7
                ($sqlerr ==  7 && $sqlstate =~ /^(S8|08|57)...\z/i) )) { #PgSQL
                # libpq-fe.h: ExecStatusType PGRES_FATAL_ERROR=7
      # ignore failures, make perlcritic happy
      eval { $self->disconnect_from_sql } or 1;  # better safe than sorry
      die "sql exec: $msg\n";
    } else {  # Server has gone away; Lost connection to...
      # MySQL: 2006, 2013;  PostgreSQL: 7
      if ($self->in_transaction) {
        # ignore failures, make perlcritic happy
        eval { $self->disconnect_from_sql } or 1;
        die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
        die "sql execute failed within transaction, $msg";
      } else {  # try one more time
        do_log(0,"NOTICE: reconnecting in response to: %s", $msg);
        # ignore failures, make perlcritic happy
        eval { $self->disconnect_from_sql } or 1;
        die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
        $self->connect_to_sql;
        $self->dbh or die "sql execute: reconnect failed";
        do_log(4,"sql: preparing and executing (again): %s", $clause);
        $sth = $self->dbh->prepare($clause); $self->sth($clause,$sth);
        $sth or die "sql: prepare (reconnected) failed: ".$DBI::errstr;
        $rv_err = $rv_str = undef;
        eval {
          for my $j (0..$#args) {  # a scalar or [val,type] or [val,\%attr]
            $sth->bind_param($j+1, !ref($args[$j]) ? $args[$j] : @{$args[$j]});
          }
          $sth->execute; $rv_err = $sth->err; $rv_str = $sth->errstr;  1;
        } or do {
          $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
          $msg = sprintf("err=%s, %s, %s", $DBI::err,$DBI::state,$eval_stat);
          $self->disconnect_from_sql;
          die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
          die "sql execute failed again, $msg";
        };
      }
    }
  };
  # $rv_err: undef indicates success, "" indicates an 'information',
  #          "0" indicates a 'warning', true indicates an error
  do_log(2,"sql execute status: err=%s, errstr=%s",
           $rv_err,$rv_str)  if defined $rv_err;
  ($rv_err,$rv_str);  # potentially useful to see non-fatal errors
}

# Connect to a database.  Take a list of database connection
# parameters and try each until one succeeds.
#  -- based on code from Ben Ransford <amavis@uce.ransford.org> 2002-09-22
#
sub connect_to_sql {
  my $self = shift;  # a list of DSNs to try connecting to sequentially
  my $dbh; my(@dsns) = @{$self->{dsn_list}};
  do_log(3,"Connecting to SQL database server");
  for my $tmpdsn (@dsns) {
    my($dsn, $username, $password) = @$tmpdsn;
    do_log(4,"connect_to_sql: trying '%s'", $dsn);
    $dbh = DBI->connect($dsn, $username, $password,
             {PrintError => 0, RaiseError => 0, Taint => 1, AutoCommit => 1} );
    if ($dbh) {
      $self->dsn_current($dsn);
      do_log(3,"connect_to_sql: '%s' succeeded", $dsn);
      last;
    }
    do_log(-1,"connect_to_sql: unable to connect to DSN '%s': %s",
              $dsn, $DBI::errstr);
  }
  $self->dbh($dbh); delete($self->{sth});
  $self->in_transaction(0); $self->{incarnation}++;
  $dbh or die "connect_to_sql: unable to connect to any dataset";
  $dbh->{'RaiseError'} = 1;
# $dbh->{mysql_auto_reconnect} = 1;  # questionable benefit
# $dbh->func(30000,'busy_timeout');  # milliseconds (SQLite)

  # https://mathiasbynens.be/notes/mysql-utf8mb4
  #   Never use utf8 in MySQL — always use utf8mb4 instead.
  #   SET NAMES utf8mb4 COLLATE utf8mb4_unicode_ci
  my $cmd = $self->driver_name eq 'mysql' ? "SET NAMES 'utf8mb4'"
                                          : "SET NAMES 'utf8'";
  eval {
    $dbh->do($cmd); 1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    do_log(2,"connect_to_sql: %s failed: %s", $cmd, $eval_stat);
  };
  section_time('sql-connect');
  $self;
}

sub disconnect_from_sql($) {
  my $self = $_[0];
  my $did_disconnect;
  $self->in_transaction(0);
  if ($self->dbh) {
    do_log(4,"disconnecting from SQL");
    $self->dbh->disconnect; $self->dbh(undef);
    $did_disconnect = 1;
  }
  delete $self->{sth}; $self->dsn_current(undef);
  $did_disconnect;
}

1;