| Current File : //usr/share/perl5/vendor_perl/Amavis/In/Message.pm |
# 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;