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

package Amavis::In::Message;
# this class keeps information about the message being processed

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::In::Message::PerRecip;
use Amavis::rfc2821_2822_Tools qw(rfc2822_timestamp quote_rfc2821_local
                                  qquote_rfc2821_local);
use Amavis::Util qw(ll do_log orcpt_decode);

sub new
  { my $class = $_[0];
    my $self = bless({},$class); $self->skip_bytes(0); $self }

sub conn_obj        # ref to a connection object Amavis::In::Connection
  { @_<2 ? shift->{conn}       : ($_[0]->{conn} = $_[1]) }
sub rx_time         # Unix time (s since epoch) of message reception by amavisd
  { @_<2 ? shift->{rx_time}    : ($_[0]->{rx_time} = $_[1]) }
sub partition_tag   # SQL partition tag (e.g. an ISO week number 1..53, or 0)
  { @_<2 ? shift->{partition}  : ($_[0]->{partition} = $_[1]) }
sub client_proto    # orig. client protocol, obtained from XFORWARD or milter
  { @_<2 ? shift->{cli_proto}  : ($_[0]->{cli_proto} = $_[1]) }
sub client_addr     # original client IP addr, obtained from XFORWARD or milter
  { @_<2 ? shift->{cli_ip}     : ($_[0]->{cli_ip} = $_[1]) }
sub client_name     # orig. client DNS name, obtained from XFORWARD or milter
  { @_<2 ? shift->{cli_name}   : (shift->{cli_name} = $_[1]) }
sub client_port    # orig client src port num, obtained from XFORWARD or milter
  { @_<2 ? shift->{cli_port}   : ($_[0]->{cli_port} = $_[1]) }
sub client_source   # LOCAL/REMOTE/undef, local_header_rewrite_clients/XFORWARD
  { @_<2 ? shift->{cli_source} : ($_[0]->{cli_source} = $_[1]) }
sub client_helo     # orig. client EHLO name, obtained from XFORWARD or milter
  { @_<2 ? shift->{cli_helo}   : ($_[0]->{cli_helo} = $_[1]) }
sub client_os_fingerprint  # SMTP client's OS fingerprint, obtained from p0f
  { @_<2 ? shift->{cli_p0f}    : ($_[0]->{cli_p0f} = $_[1]) }
sub originating     # originating from our users, copied from c('originating')
  { @_<2 ? shift->{originating}: ($_[0]->{originating} = $_[1]) }
sub queue_id # MTA queue ID of message if known (Courier, milter/AM.PDP, XFORW)
  { @_<2 ? shift->{queue_id}   : ($_[0]->{queue_id} = $_[1]) }
sub log_id          # task id as shown in the log, also known as am_id
  { @_<2 ? shift->{log_id}     : ($_[0]->{log_id} = $_[1]) }
sub mail_id         # long-term unique id of the message on this system
  { @_<2 ? shift->{mail_id}    : ($_[0]->{mail_id} = $_[1]) }
sub secret_id       # secret string to grant access to a message with mail_id
  { @_<2 ? $_[0]->{secret_id}  : ($_[0]->{secret_id} = $_[1]) }
sub parent_mail_id  # original mail_id for msgs generated by amavis (DSN,notif)
  { @_<2 ? shift->{parent_mail_id} : ($_[0]->{parent_mail_id} = $_[1]) }
sub attachment_password # scrambles a potentially dangerous released mail
  { @_<2 ? shift->{release_pwd}: ($_[0]->{release_pwd} = $_[1]) }
sub msg_size        # ESMTP SIZE value, later corrected to actual size,RFC 1870
  { @_<2 ? shift->{msg_size}   : ($_[0]->{msg_size} = $_[1]) }
sub auth_user       # ESMTP AUTH username
  { @_<2 ? shift->{auth_user}  : ($_[0]->{auth_user} = $_[1]) }
sub auth_pass       # ESMTP AUTH password
  { @_<2 ? shift->{auth_pass}  : ($_[0]->{auth_pass} = $_[1]) }
sub auth_submitter  # ESMTP MAIL command AUTH option value (addr-spec or "<>")
  { @_<2 ? shift->{auth_subm}  : (shift->{auth_subm} = $_[1]) }
sub tls_cipher      # defined if TLS was on, e.g. contains cipher alg.,RFC 3207
  { @_<2 ? shift->{auth_tlscif}: ($_[0]->{auth_tlscif} = $_[1]) }
sub dsn_ret         # ESMTP MAIL command RET option   (DSN-RFC 3461)
  { @_<2 ? shift->{dsn_ret}    : ($_[0]->{dsn_ret} = $_[1]) }
sub dsn_envid       # ESMTP MAIL command ENVID option (DSN-RFC 3461) xtext enc.
  { @_<2 ? shift->{dsn_envid}  : ($_[0]->{dsn_envid} = $_[1]) }
sub dsn_passed_on   # obligation to send notification on SUCCESS was relayed
  { @_<2 ? shift->{dsn_pass_on}: ($_[0]->{dsn_pass_on} = $_[1]) }
sub requested_by    # Resent-From addr who requested release from a quarantine
  { @_<2 ? shift->{requested_by}:($_[0]->{requested_by} = $_[1])}
sub body_type       # ESMTP BODY param (RFC 6152: 7BIT, 8BITMIME) or BINARYMIME
  { @_<2 ? shift->{body_type}  : ($_[0]->{body_type} = $_[1]) }
sub smtputf8        # ESMTP SMTPUTF8 param, boolean (RFC 6531)
  { @_<2 ? shift->{smtputf8}   : ($_[0]->{smtputf8} = $_[1]) }
sub header_8bit     # true if header contains non-ASCII characters
  { @_<2 ? shift->{header_8bit}: ($_[0]->{header_8bit} = $_[1]) }
sub body_8bit       # true if body contains non-ASCII characters
  { @_<2 ? shift->{body_8bit}  : ($_[0]->{body_8bit} = $_[1]) }
sub sender          # envelope sender, internal form, e.g.: j doe@example.com
  { @_<2 ? $_[0]->{sender}     : ($_[0]->{sender} = $_[1]) }
sub sender_smtp     # env sender, SMTP form in <>, e.g.: <"j doe"@example.com>
  { @_<2 ? shift->{sender_smtp}: ($_[0]->{sender_smtp} = $_[1]) }
sub sender_credible # envelope sender is believed to be valid
  { @_<2 ? shift->{sender_cred}: ($_[0]->{sender_cred} = $_[1]) }
sub sender_source   # unmangled sender addr. or info from the trace (log/notif)
  { @_<2 ? shift->{sender_src} : ($_[0]->{sender_src} = $_[1]) }
sub sender_maddr_id # maddr.id field from SQL if logging to SQL is enabled
  { @_<2 ? shift->{maddr_id}   : ($_[0]->{maddr_id} = $_[1]) }
sub mime_entity     # MIME::Parser entity holding the parsed message
  { @_<2 ? shift->{mime_entity}: (shift->{mime_entity} = $_[1])}
sub parts_root      # Amavis::Unpackers::Part root object
  { @_<2 ? shift->{parts_root} : ($_[0]->{parts_root} = $_[1])}
sub skip_bytes      # file offset where mail starts, useful for quar. release
  { @_<2 ? shift->{file_ofs}   : ($_[0]->{file_ofs} = $_[1]) }
sub mail_text       # RFC 5322 msg: open file handle, or MIME::Entity object
  { @_<2 ? shift->{mail_text}  : ($_[0]->{mail_text} = $_[1]) }
sub mail_text_str   # RFC 5322 msg: small messages as a stringref, else undef
  { @_<2 ? shift->{mailtextstr}: ($_[0]->{mailtextstr} = $_[1]) }
sub mail_text_fn    # orig. mail filename or undef, e.g. mail_tempdir/email.txt
  { @_<2 ? shift->{mailtextfn} : ($_[0]->{mailtextfn} = $_[1]) }
sub mail_tempdir    # work directory, under $TEMPBASE or supplied by client
  { @_<2 ? shift->{mailtempdir}: ($_[0]->{mailtempdir} = $_[1])}
sub mail_tempdir_obj # Amavis::TempDir obj when non-persistent (quar.release)
  { @_<2 ? shift->{tempdirobj}: ($_[0]->{tempdirobj} = $_[1])}
sub header_edits    # Amavis::Out::EditHeader object or undef
  { @_<2 ? shift->{hdr_edits}  : ($_[0]->{hdr_edits} = $_[1]) }
sub rfc2822_from #author addresses list (rfc allows one or more), parsed 'From'
  { @_<2 ? $_[0]->{hdr_from}   : ($_[0]->{hdr_from} = $_[1]) }
sub rfc2822_sender  # sender address (rfc allows none or one), parsed 'Sender'
  { @_<2 ? shift->{hdr_sender} : ($_[0]->{hdr_sender} = $_[1]) }
sub rfc2822_resent_from # resending author addresses list, parsed 'Resent-From'
  { @_<2 ? shift->{hdr_rfrom}  : ($_[0]->{hdr_rfrom} = $_[1]) }
sub rfc2822_resent_sender  # resending sender addresses, parsed 'Resent-Sender'
  { @_<2 ? shift->{hdr_rsender}: ($_[0]->{hdr_rsender} = $_[1]) }
sub rfc2822_to      # parsed 'To' header field: a list of recipients
  { @_<2 ? shift->{hdr_to}     : ($_[0]->{hdr_to} = $_[1]) }
sub rfc2822_cc      # parsed 'Cc' header field: a list of Cc recipients
  { @_<2 ? shift->{hdr_cc}     : (shift->{hdr_cc} = $_[1]) }
sub orig_header_fields # header field indices by h.f. name, hashref of arrays
  { @_<2 ? shift->{orig_hdr_f} : ($_[0]->{orig_hdr_f} = $_[1]) }
sub orig_header # orig.h.sect, arrayref of h.fields, with folding & trailing LF
  { @_<2 ? shift->{orig_header}: ($_[0]->{orig_header} = $_[1]) }
sub orig_header_size # size of original header, incl. a separator line,RFC 1870
  { @_<2 ? shift->{orig_hdr_s} : ($_[0]->{orig_hdr_s} = $_[1]) }
sub references  # References & In-Reply-To message IDs, array
  { @_<2 ? shift->{refs}       : ($_[0]->{refs} = $_[1]) }
sub orig_body_size  # size of original body (in bytes), RFC 1870
  { @_<2 ? shift->{orig_bdy_s} : ($_[0]->{orig_bdy_s} = $_[1]) }
sub body_start_pos  # byte offset into a msg where mail body starts (if known)
  { @_<2 ? shift->{body_pos}: ($_[0]->{body_pos} = $_[1]) }
sub body_digest     # digest of a message body (e.g. MD5, SHA1, SHA256), hex
  { @_<2 ? shift->{body_digest}: ($_[0]->{body_digest} = $_[1]) }
sub trace  # info from Received header fields, top-down, array of hashrefs
  { @_<2 ? shift->{trace}      : ($_[0]->{trace} = $_[1]) }
sub ip_addr_trace_public  # public IP addresses in 'Received from' hdr flds
  { @_<2 ? shift->{iptracepub} : ($_[0]->{iptracepub} = $_[1]) }
sub is_mlist        # mail is from a mailing list (boolean/string)
  { @_<2 ? shift->{is_mlist}   : ($_[0]->{is_mlist} = $_[1]) }
sub is_auto         # mail is an auto-response (boolean/string)
  { @_<2 ? shift->{is_auto}    : ($_[0]->{is_auto} = $_[1]) }
sub is_bulk         # mail from a m.list or bulk or auto-response (bool/string)
  { @_<2 ? $_[0]->{is_bulk}    : ($_[0]->{is_bulk} = $_[1]) }
sub dkim_signatures_all # a ref to a list of DKIM signature objects, or undef
  { @_<2 ? shift->{dkim_sall}  : ($_[0]->{dkim_sall} = $_[1]) }
sub dkim_signatures_valid # a ref to a list of valid DKIM signature objects
  { @_<2 ? shift->{dkim_sval}  : ($_[0]->{dkim_sval} = $_[1]) }
sub dkim_author_sig # author domain signature present and valid (bool/domain)
  { @_<2 ? shift->{dkim_auth_s}: ($_[0]->{dkim_auth_s} = $_[1]) }
sub dkim_thirdparty_sig # third-party signature present and valid (bool/domain)
  { @_<2 ? shift->{dkim_3rdp_s}: ($_[0]->{dkim_3rdp_s} = $_[1]) }
sub dkim_sender_sig # a sender signature is present and is valid (bool/domain)
  { @_<2 ? shift->{dkim_sndr_s}: (shift->{dkim_sndr_s} = $_[1]) }
sub dkim_envsender_sig # boolean: envelope sender signature present and valid
  { @_<2 ? shift->{dkim_envs_s}: ($_[0]->{dkim_envs_s} = $_[1]) }
sub dkim_signatures_new # ref to a list of DKIM signature objects, our signing
  { @_<2 ? shift->{dkim_snew}  : ($_[0]->{dkim_snew} = $_[1]) }
sub dkim_signwith_sd # ref to a pair [selector,domain] to force signing with
  { @_<2 ? shift->{dkim_signsd}: ($_[0]->{dkim_signsd} = $_[1]) }
sub quarantined_to  # list of quar mailbox names or addresses if quarantined
  { @_<2 ? shift->{quarantine} : ($_[0]->{quarantine} = $_[1]) }
sub quar_type  # list of quar types: F/Z/B/Q/M (file/zipfile/bsmtp/sql/mailbox)
  { @_<2 ? shift->{quar_type}  : ($_[0]->{quar_type} = $_[1]) }
sub dsn_sent        # delivery status notification was sent(1) or suppressed(2)
  { @_<2 ? shift->{dsn_sent}   : ($_[0]->{dsn_sent} = $_[1]) }
sub client_delete   # don't delete the tempdir, it is a client's responsibility
  { @_<2 ? shift->{client_del} :($_[0]->{client_del} = $_[1])}
sub contents_category # sorted arrayref CC_VIRUS/CC_BANNED/CC_SPAM../CC_CLEAN
  { @_<2 ? shift->{category}   : ($_[0]->{category} = $_[1]) }
sub blocking_ccat   # category type most responsible for blocking msg, or undef
  { @_<2 ? $_[0]->{bl_ccat}    : ($_[0]->{bl_ccat} = $_[1]) }
sub checks_performed  # a hashref of checks done on a msg (for statistics/log)
  { @_<2 ? shift->{checks_perf}: ($_[0]->{checks_perf} = $_[1]) }
sub actions_performed  # listref, summarized actions & SMTP status, for logging
  { @_<2 ? shift->{act_perf}   : ($_[0]->{act_perf} = $_[1]) }
sub virusnames      # a ref to a list of virus names detected, or undef
  { @_<2 ? shift->{virusnames} : ($_[0]->{virusnames} = $_[1]) }
sub spam_report     # SA terse report of tests hit (for header section reports)
  { @_<2 ? shift->{spam_report}   : ($_[0]->{spam_report} = $_[1])}
sub spam_summary    # SA summary of tests hit for standard body reports
  { @_<2 ? shift->{spam_summary}  :($_[0]->{spam_summary} = $_[1])}
sub ip_repu_score   # IP reputation score (info, also added to spam_level)
  { @_<2 ? shift->{ip_repu_score} :($_[0]->{ip_repu_score} = $_[1])}
sub time_elapsed    # elapsed times by section - associative array ref
  { @_<2 ? shift->{elapsed}       : ($_[0]->{elapsed} = $_[1])}

# new style of providing additional information from checkers
sub supplementary_info {  # holds a hash of tag/value pairs, such as SA get_tag
  my $self=shift; my $key=shift;
  !@_ ? $self->{info_tag}{$key} : ($self->{info_tag}{$key}=shift);
}

{ no warnings 'once';
# the following methods apply on a per-message level as well, summarizing
# per-recipient information as far as possible
  *add_contents_category =
    \&Amavis::In::Message::PerRecip::add_contents_category;
  *is_in_contents_category =
    \&Amavis::In::Message::PerRecip::is_in_contents_category;
  *setting_by_main_contents_category =
    \&Amavis::In::Message::PerRecip::setting_by_main_contents_category;
  *setting_by_main_contents_category_all =
    \&Amavis::In::Message::PerRecip::setting_by_main_contents_category_all;
  *setting_by_blocking_contents_category =
    \&Amavis::In::Message::PerRecip::setting_by_blocking_contents_category;
  *setting_by_contents_category =
    \&Amavis::In::Message::PerRecip::setting_by_contents_category;
}

# The order of entries in a per-recipient list is the original order
# in which recipient addresses (e.g. obtained via 'MAIL TO:') were received.
# Only the entries that were accepted (via SMTP response code 2xx)
# are placed in the list. The ORDER MUST BE PRESERVED and no recipients
# may be added or removed from the list (without precaution)! This is vital
# to be able to produce correct per-recipient responses to an LMTP client!
#
sub per_recip_data {  # get or set a listref of envelope recipient objects
  my $self = shift;
  # store a copy of the a given listref of recip objects
  if (@_) { $self->{recips} = [@{$_[0]}] }
  # caller may modify data if he knows what he is doing
  $self->{recips};    # return a list of recipient objects
}

sub recips {          # get or set a listref of envelope recipients
  my $self = shift;
  if (@_) {  # store a copy of a given listref of recipient addresses
    my($recips_list_ref, $set_dsn_orcpt_too) = @_;
    $self->per_recip_data([ map {
      my $per_recip_obj = Amavis::In::Message::PerRecip->new;
      $per_recip_obj->recip_addr($_);
      $per_recip_obj->recip_addr_smtp(qquote_rfc2821_local($_));
      $per_recip_obj->dsn_orcpt(
        join(';', orcpt_decode(';'.$per_recip_obj->recip_addr_smtp)))
        if $set_dsn_orcpt_too;
      $per_recip_obj->recip_destiny(D_PASS);  # default is Pass
      $per_recip_obj } @{$recips_list_ref} ]);
  }
  return  if !defined wantarray;  # don't bother
  # return listref of recipient addresses
  [ map($_->recip_addr, @{$self->per_recip_data}) ];
}

# for each header field maintain a list of signature indices which covered it;
# returns a list of signature indices for a given header field position
#
sub header_field_signed_by {
  my($self,$header_field_index) = @_;
  my $h = $self->{hdr_sig_ind};  my $hf;
  if (@_ > 2) {
    $self->{hdr_sig_ind} = $h = []  if !$h;
    $hf = $h->[$header_field_index];
    $h->[$header_field_index] = $hf = []  if !$hf;
    # store signature index(es) at a given header position
    shift; shift; push(@$hf, @_);
  }
  $hf = $h->[$header_field_index]  if $h && !$hf;
  $hf ? @{$hf} : ();
}

# return a j-th header field with a given field name, along with its index
# in the array of all header fields; if a field name is undef then all
# header fields are considered; search proceeds top-down if j >= 0,
# or bottom up for negative values (-1=last, -2=next-to-last, ...)
#
sub get_header_field2 {
  my($self, $field_name, $j) = @_;
  my $orig_hfields = $self->orig_header_fields;
  return if !$orig_hfields;
  my($field_ind, $field, $all_fields, $hfield_indices);
  # arrayref of header field indices for a given h.field name
  $hfield_indices = $orig_hfields->{lc $field_name}  if defined $field_name;
  $all_fields = $self->orig_header;
  if (defined $field_name) {
    if (!defined $hfield_indices) {
      # no header field with such name
    } elsif (ref $hfield_indices) {
      # $hfield_indices is an arrayref
      $j = 0  if !defined $j;
      $field_ind = $hfield_indices->[$j];
    } else {
      # optimized: $hfield_indices is a scalar - the only element
      $field_ind = $hfield_indices  if !defined($j) || $j == 0 || $j == -1;
    }
  } elsif (!ref $all_fields) {
    # no header section
  } elsif ($j >= 0) {  # top-down, 0,1,2,...
    $field_ind = $j  if $j <= $#$all_fields;
  } else {  # bottom-up, -1,-2,-3,...
    $j += @$all_fields;  # turn into an absolute index
    $field_ind = $j  if $j >= 0;
  }
  return $field_ind  if !wantarray;
  ($field_ind, !defined $field_ind ? undef : $all_fields->[$field_ind]);
}

# compatibility wrapper for pre-2.8.0 custom code
#
sub get_header_field {
  my($self, $field_name, $j) = @_;
  my($field_ind, $field) = $self->get_header_field2($field_name,$j);
  if (defined($field_ind) && wantarray) {
    local $1;
    $field_name = lc($1)  if $field =~ /^([^:]*?)[ \t]*:/s;
  }
  !wantarray ? $field_ind : ($field_ind, $field_name, $field);
}

sub get_header_field_body {
  my($self, $field_name, $j) = @_;
  my $k;  my($field_ind, $f) = $self->get_header_field2($field_name,$j);
  defined $f && ($k=index($f,':')) >= 0 ? substr($f,$k+1) : $f;
}

1;