package Amavis::In::Message::PerRecip;

use strict;
use re 'taint';

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

use Amavis::Conf qw(:platform);
use Amavis::Util qw(setting_by_given_contents_category_all
                    setting_by_given_contents_category cmp_ccat);

sub new     # NOTE: this class is a list, not a hash
  { my $class = $_[0]; bless [(undef) x 42], $class }

# subs to set or access individual elements of a n-tuple by name
sub recip_addr       # unquoted recipient envelope e-mail address
  { @_<2 ? shift->[0] : ($_[0]->[0] = $_[1]) }
sub recip_addr_smtp  # SMTP-encoded recipient envelope e-mail address in <>
  { @_<2 ? shift->[1] : ($_[0]->[1] = $_[1]) }
sub recip_addr_modified  # recip. addr. with possible addr. extension inserted
  { @_<2 ? shift->[2] : ($_[0]->[2] = $_[1]) }
sub recip_is_local   # recip_addr matches @local_domains_maps
  { @_<2 ? shift->[3] : ($_[0]->[3] = $_[1]) }
sub recip_maddr_id   # maddr.id field from SQL corresponding to recip_addr_smtp
  { @_<2 ? shift->[4] : ($_[0]->[4] = $_[1]) }
sub recip_maddr_id_orig # maddr.id field from SQL corresponding to dsn_orcpt
  { @_<2 ? shift->[5] : ($_[0]->[5] = $_[1]) }
sub recip_penpals_related  # mail_id of a previous correspondence
  { @_<2 ? shift->[6] : ($_[0]->[6] = $_[1]) }
sub recip_penpals_age # penpals age in seconds if SQL or Redis is enabled
  { @_<2 ? shift->[7] : ($_[0]->[7] = $_[1]) }
sub recip_penpals_score # penpals score (info, also added to spam_level)
  { @_<2 ? shift->[8] : ($_[0]->[8] = $_[1]) }
sub dsn_notify       # ESMTP RCPT command NOTIFY option (DSN-RFC 3461, listref)
  { @_<2 ? shift->[9] : ($_[0]->[9] = $_[1]) }
sub dsn_orcpt  # ESMTP RCPT command ORCPT option (decoded: RFC 3461, RFC 6533)
  { @_<2 ? shift->[10] : ($_[0]->[10] = $_[1]) }
sub dsn_suppress_reason  # if defined disable sending DSN and supply a reason
  { @_<2 ? shift->[11] : ($_[0]->[11] = $_[1]) }
sub recip_destiny    # D_REJECT, D_BOUNCE, D_DISCARD, D_PASS
  { @_<2 ? shift->[12] : ($_[0]->[12] = $_[1]) }
sub recip_done       # false: not done, true: done (1: faked, 2: truly sent)
  { @_<2 ? shift->[13] : ($_[0]->[13] = $_[1]) }
sub recip_smtp_response # RFC 5321 response (3-digit + enhanced resp + text)
  { @_<2 ? shift->[14] : ($_[0]->[14] = $_[1]) }
sub recip_remote_mta_smtp_response  # smtp response as issued by remote MTA
  { @_<2 ? shift->[15] : ($_[0]->[15] = $_[1]) }
sub recip_remote_mta # remote MTA that issued the smtp response
  { @_<2 ? shift->[16] : ($_[0]->[16] = $_[1]) }
sub recip_tagged # message was tagged by address extension or Subject or X-Spam
  { @_<2 ? shift->[17] : ($_[0]->[17] = $_[1]) }
sub recip_mbxname    # mailbox name or file when known (local:, bsmtp: or sql:)
  { @_<2 ? shift->[18] : ($_[0]->[18] = $_[1]) }
sub recip_whitelisted_sender  # recip considers this sender whitelisted
  { @_<2 ? shift->[19] : ($_[0]->[19] = $_[1]) }
sub recip_blacklisted_sender  # recip considers this sender blacklisted
  { @_<2 ? shift->[20] : ($_[0]->[20] = $_[1]) }
sub bypass_virus_checks # boolean: virus checks to be bypassed for this recip
  { @_<2 ? shift->[21] : ($_[0]->[21] = $_[1]) }
sub bypass_banned_checks # bool: ban checks are to be bypassed for this recip
  { @_<2 ? shift->[22] : ($_[0]->[22] = $_[1]) }
sub bypass_spam_checks # boolean: spam checks are to be bypassed for this recip
  { @_<2 ? shift->[23] : ($_[0]->[23] = $_[1]) }
sub banned_parts     # banned part descriptions (ref to a list of banned parts)
  { @_<2 ? shift->[24] : ($_[0]->[24] = $_[1]) }
sub banned_parts_as_attr  # banned part descriptions - newer syntax (listref)
  { @_<2 ? shift->[25] : ($_[0]->[25] = $_[1]) }
sub banning_rule_key  # matching banned rules (lookup table keys) (ref to list)
  { @_<2 ? shift->[26] : ($_[0]->[26] = $_[1]) }
sub banning_rule_comment #comments (or whole expr) from banning_rule_key regexp
  { @_<2 ? shift->[27] : ($_[0]->[27] = $_[1]) }
sub banning_reason_short  # just one banned part leaf name with a rule comment
  { @_<2 ? shift->[28] : ($_[0]->[28] = $_[1]) }
sub banning_rule_rhs  # a right-hand side of matching rules (a ref to a list)
  { @_<2 ? shift->[29] : ($_[0]->[29] = $_[1]) }
sub mail_body_mangle  # mail body is being modified (and how) (e.g. defanged)
  { @_<2 ? shift->[30] : ($_[0]->[30] = $_[1]) }
sub contents_category # sorted listref of "major,minor" strings(category types)
  { @_<2 ? shift->[31] : ($_[0]->[31] = $_[1]) }
sub blocking_ccat   # category type most responsible for blocking msg, or undef
  { @_<2 ? shift->[32] : ($_[0]->[32] = $_[1]) }
sub user_id   # listref of recipient IDs from a lookup, e.g. SQL field users.id
  { @_<2 ? shift->[33] : ($_[0]->[33] = $_[1]) }
sub user_policy_id  # recipient's policy ID, e.g. SQL field users.policy_id
  { @_<2 ? shift->[34] : ($_[0]->[34] = $_[1]) }
sub courier_control_file # path to control file containing this recipient
  { @_<2 ? shift->[35] : ($_[0]->[35] = $_[1]) }
sub courier_recip_index # index of recipient within control file
  { @_<2 ? shift->[36] : ($_[0]->[36] = $_[1]) }
sub delivery_method # delivery method, or empty for implicit delivery (milter)
  { @_<2 ? shift->[37] : ($_[0]->[37] = $_[1]) }
sub spam_level  # spam score as returned by spam scanners, ham near 0, spam 5
  { @_<2 ? shift->[38] : ($_[0]->[38] = $_[1]) }
sub spam_tests      # a listref of r/o stringrefs, each: t1=score1,t2=score2,..
  { @_<2 ? shift->[39] : ($_[0]->[39] = $_[1]) }
# per-recipient spam info - when undefined consult a per-message counterpart
sub spam_report     # SA terse report of tests hit (for header section reports)
  { @_<2 ? shift->[40] : ($_[0]->[40] = $_[1]) }
sub spam_summary    # SA summary of tests hit for standard body reports
  { @_<2 ? shift->[41] : ($_[0]->[41] = $_[1]) }

sub recip_final_addr {  # return recip_addr_modified if set, else recip_addr
  my $self = shift;
  my $newaddr = $self->recip_addr_modified;
  defined $newaddr ? $newaddr : $self->recip_addr;
}

# The contents_category list is a sorted list of strings, each of the form
# "major" or "major,minor", where major and minor are numbers, representing
# major and minor category type. Sort order is descending by numeric values,
# major first, and subordered by a minor value. When an entry "major,minor"
# is added, an entry "major" is added automatically (minor implied to be 0).
# A string "major" means the same as "major,0". See CC_* constants for major
# category types. Minor category types semantics is specific to each major
# category, higher number represent more important finding than a lower number.

# add new findings to the contents_category list
#
sub add_contents_category {
  my($self, $major,$minor) = @_;
  my $aref = $self->contents_category || [];
  # major category is always inserted, but "$major,$minor" only if minor>0
  if (defined $minor && $minor > 0) {  # straight insertion of "$major,$minor"
    my $el = sprintf("%d,%d",$major,$minor); my $j=0;
    for (@$aref) { if (cmp_ccat($_,$el) <= 0) { last } else { $j++ } };
    if ($j > $#{$aref}) { push(@$aref,$el) }  # append
    elsif (cmp_ccat($aref->[$j],$el) != 0) { splice(@$aref,$j,0,$el) }
  }
  # straight insertion of "$major" into an ordered array (descending order)
  my $el = sprintf("%d",$major); my $j=0;
  for (@$aref) { if (cmp_ccat($_,$el) <= 0) { last } else { $j++ } };
  if ($j > $#{$aref}) { push(@$aref,$el) }  # append
  elsif (cmp_ccat($aref->[$j],$el) != 0)
    { splice(@$aref,$j,0,$el) }  # insert at index $j
  $self->contents_category($aref);
}

# is the "$major,$minor" category in the list?
#
sub is_in_contents_category {
  my($self, $major,$minor) = @_;
  my $el = sprintf('%d,%d', $major,$minor);
  my $aref = $self->contents_category;
  !defined($aref) ? undef : scalar(grep(cmp_ccat($_,$el) == 0, @$aref));
}

# get a setting corresponding to the most important contents category;
# i.e. the highest entry from the category list for which a corresponding entry
# in the associative array of settings exists determines returned setting;
#
sub setting_by_main_contents_category {
  my($self, @settings_href_list) = @_;
  return undef  if !@settings_href_list;
  my $aref = $self->contents_category;
  setting_by_given_contents_category($aref, @settings_href_list);
}

# get a list of settings corresponding to all relevant contents categories,
# sorted from the most important to the least important entry;  entries which
# have no corresponding setting are not included in the list
#
sub setting_by_main_contents_category_all {
  my($self, @settings_href_list) = @_;
  return undef  if !@settings_href_list;
  my $aref = $self->contents_category;
  setting_by_given_contents_category_all($aref, @settings_href_list);
}

sub setting_by_blocking_contents_category {
  my($self, @settings_href_list) = @_;
  my $blocking_ccat = $self->blocking_ccat;
  !defined($blocking_ccat) ? undef
    : setting_by_given_contents_category($blocking_ccat, @settings_href_list);
}

sub setting_by_contents_category {
  my($self, @settings_href_list) = @_;
  my $blocking_ccat = $self->blocking_ccat;
  !defined($blocking_ccat)
    ? $self->setting_by_main_contents_category(@settings_href_list)
    : setting_by_given_contents_category($blocking_ccat, @settings_href_list);
}

1;