use strict;
use re 'taint';
use warnings FATAL => 'utf8';
no warnings 'uninitialized';
package Amavis::Boot;
use strict;
use re 'taint';
use Errno qw(ENOENT EACCES);
sub fetch_modules($$@) {
my($reason, $required, @modules) = @_;
my($have_sawampersand) = Devel::SawAmpersand->UNIVERSAL::can("sawampersand");
my($amp) = $have_sawampersand && Devel::SawAmpersand::sawampersand() ? 1 : 0;
warn "fetch_modules: PL_sawampersand flag was already turned on" if $amp;
my(@missing);
for my $m (@modules) {
local($_) = $m;
$_ .= /^auto::/ ? '.al' : '.pm' if !m{^/} && !m{\.(pm|pl|al|ix)\z};
s{::}{/}g;
eval { require $_ }
or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
push(@missing,$m);
printf STDERR ("fetch_modules: error loading %s module %s:\n%s\n",
$required ? 'required' : 'optional', $_,
join("\n", map {" $_"} split(/\n/,$eval_stat)))
if $eval_stat !~ /\bCan't locate \Q$_\E in \@INC\b/;
};
if ($have_sawampersand && !$amp && Devel::SawAmpersand::sawampersand())
{ $amp = 1; warn "Loading of module $m turned on PL_sawampersand flag" }
}
die "ERROR: MISSING $reason:\n" . join('', map { " $_\n" } @missing)
if $required && @missing;
\@missing;
}
BEGIN {
if ($] < 5.008000) { # deal with a perl 5.6.1 glob() taint bug
fetch_modules('REQUIRED BASIC MODULES', 1, qw(File::Glob));
File::Glob->import(':globally'); # use the same module as Perl 5.8 uses
}
fetch_modules('REQUIRED BASIC MODULES', 1, qw(
Exporter POSIX Fcntl Socket Errno Carp Time::HiRes
IO::Handle IO::File IO::Socket IO::Socket::UNIX IO::Socket::INET
IO::Stringy Digest::MD5 Unix::Syslog File::Basename
Compress::Zlib MIME::Base64 MIME::QuotedPrint MIME::Words
MIME::Head MIME::Body MIME::Entity MIME::Parser MIME::Decoder
MIME::Decoder::Base64 MIME::Decoder::Binary MIME::Decoder::QuotedPrint
MIME::Decoder::NBit MIME::Decoder::UU MIME::Decoder::Gzip64
Net::Server Net::Server::PreFork
));
# with earlier versions of Perl one may need to add additional modules
# to the list, such as: auto::POSIX::setgid auto::POSIX::setuid ...
fetch_modules('OPTIONAL BASIC MODULES', 0, qw(
PerlIO PerlIO::scalar Unix::Getrusage
Carp::Heavy auto::POSIX::setgid auto::POSIX::setuid
auto::POSIX::SigAction::new auto::POSIX::SigAction::safe
MIME::Decoder::BinHex
));
}
1;
#
package Amavis::Conf;
use strict;
use re 'taint';
# constants; intentionally leave value -1 unassigned for compatibility
sub D_REJECT () { -3 }
sub D_BOUNCE () { -2 }
sub D_DISCARD() { 0 }
sub D_PASS () { 1 }
# major contents_category constants, in increasing order of importance
sub CC_CATCHALL() { 0 }
sub CC_CLEAN () { 1 } # tag_level = "CC_CLEAN,1"
sub CC_MTA () { 2 } # trouble passing mail back to MTA
sub CC_OVERSIZED() { 3 }
sub CC_BADH () { 4 }
sub CC_SPAMMY() { 5 } # tag2_level (and: tag3_level = "CC_SPAMMY,1")
sub CC_SPAM () { 6 } # kill_level
sub CC_UNCHECKED() { 7 }
sub CC_BANNED() { 8 }
sub CC_VIRUS () { 9 }
#
*CC_TEMPFAIL = \&CC_MTA; # alias - old name, cc 2 was repurposed/generalized)
#
# in other words: major_ccat minor_ccat %subject_tag_maps_by_ccat
## if score >= kill level => CC_SPAM 0
## elsif score >= tag3 level => CC_SPAMMY 1 @spam_subject_tag3_maps
## elsif score >= tag2 level => CC_SPAMMY 0 @spam_subject_tag2_maps
## elsif score >= tag level => CC_CLEAN 1 @spam_subject_tag_maps
## else => CC_CLEAN 0
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
'dynamic_confvars' => # per- policy bank settings
[qw(
$policy_bank_name $protocol @inet_acl
$myhostname $snmp_contact $snmp_location
$syslog_ident $syslog_facility $syslog_priority
$log_level $log_templ $log_recip_templ
$forward_method $notify_method $resend_method
$release_method $requeue_method $release_format $report_format
$os_fingerprint_method $os_fingerprint_dst_ip_and_port
$originating @smtpd_discard_ehlo_keywords
$propagate_dsn_if_possible $terminate_dsn_on_notify_success
$amavis_auth_user $amavis_auth_pass $auth_reauthenticate_forwarded
$auth_required_out $auth_required_inp $auth_required_release
@auth_mech_avail $tls_security_level_in $tls_security_level_out
$local_client_bind_address $smtpd_message_size_limit
$localhost_name $smtpd_greeting_banner $smtpd_quit_banner
$mailfrom_to_quarantine $warn_offsite $bypass_decode_parts @decoders
@av_scanners @av_scanners_backup @spam_scanners
$first_infected_stops_scan
$sa_spam_report_header $sa_spam_level_char $sa_mail_body_size_limit
$penpals_bonus_score $penpals_halflife $bounce_killer_score
$reputation_factor
$undecipherable_subject_tag $localpart_is_case_sensitive
$recipient_delimiter $replace_existing_extension
$hdr_encoding $bdy_encoding $hdr_encoding_qb
$allow_disclaimers $insert_received_line
$append_header_fields_to_bottom $prepend_header_fields_hdridx
$allow_fixing_improper_header
$allow_fixing_improper_header_folding $allow_fixing_long_header_lines
%allowed_added_header_fields %allowed_header_tests
$X_HEADER_TAG $X_HEADER_LINE $notify_xmailer_header
$remove_existing_x_scanned_headers $remove_existing_spam_headers
%sql_clause $sql_partition_tag
%local_delivery_aliases $banned_namepath_re
$per_recip_whitelist_sender_lookup_tables
$per_recip_blacklist_sender_lookup_tables
@anomy_sanitizer_args @altermime_args_defang
@altermime_args_disclaimer @disclaimer_options_bysender_maps
%signed_header_fields @dkim_signature_options_bysender_maps
@local_domains_maps @mynetworks_maps @client_ipaddr_policy
@newvirus_admin_maps @banned_filename_maps
@spam_quarantine_bysender_to_maps
@spam_tag_level_maps @spam_tag2_level_maps @spam_tag3_level_maps
@spam_kill_level_maps @spam_modifies_subj_maps
@spam_subject_tag_maps @spam_subject_tag2_maps @spam_subject_tag3_maps
@spam_dsn_cutoff_level_maps @spam_dsn_cutoff_level_bysender_maps
@spam_crediblefrom_dsn_cutoff_level_maps
@spam_crediblefrom_dsn_cutoff_level_bysender_maps
@spam_quarantine_cutoff_level_maps @spam_notifyadmin_cutoff_level_maps
@whitelist_sender_maps @blacklist_sender_maps @score_sender_maps
@author_to_policy_bank_maps @signer_reputation_maps
@message_size_limit_maps @debug_sender_maps
@bypass_virus_checks_maps @bypass_spam_checks_maps
@bypass_banned_checks_maps @bypass_header_checks_maps
@viruses_that_fake_sender_maps @virus_name_to_spam_score_maps
@remove_existing_spam_headers_maps
%final_destiny_by_ccat %lovers_maps_by_ccat
%defang_maps_by_ccat %subject_tag_maps_by_ccat
%quarantine_method_by_ccat %quarantine_to_maps_by_ccat
%notify_admin_templ_by_ccat %notify_recips_templ_by_ccat
%notify_sender_templ_by_ccat %notify_autoresp_templ_by_ccat
%notify_release_templ_by_ccat %notify_report_templ_by_ccat
%warnsender_by_ccat
%hdrfrom_notify_admin_by_ccat %mailfrom_notify_admin_by_ccat
%hdrfrom_notify_recip_by_ccat %mailfrom_notify_recip_by_ccat
%hdrfrom_notify_sender_by_ccat
%hdrfrom_notify_release_by_ccat %hdrfrom_notify_report_by_ccat
%admin_maps_by_ccat %warnrecip_maps_by_ccat
%always_bcc_by_ccat %dsn_bcc_by_ccat
%addr_extension_maps_by_ccat %addr_rewrite_maps_by_ccat
%smtp_reason_by_ccat
)],
'confvars' => # global settings (not per-policy, not per-recipient)
[qw(
$myproduct_name $myversion_id $myversion_id_numeric $myversion_date
$myversion $instance_name @additional_perl_modules
$MYHOME $TEMPBASE $QUARANTINEDIR $quarantine_subdir_levels
$daemonize $courierfilter_shutdown $pid_file $lock_file $db_home
$enable_db $enable_global_cache
$daemon_user $daemon_group $daemon_chroot_dir $path
$DEBUG $DO_SYSLOG $LOGFILE $logline_maxlen $nanny_details_level
$max_servers $max_requests
$min_servers $min_spare_servers $max_spare_servers
$child_timeout $smtpd_timeout
%current_policy_bank %policy_bank
%interface_policy @client_ipaddr_policy
$unix_socketname $inet_socket_port $inet_socket_bind $listen_queue_size
$smtp_connection_cache_on_demand $smtp_connection_cache_enable
$relayhost_is_client $smtpd_recipient_limit
$smtpd_tls_cert_file $smtpd_tls_key_file
$enforce_smtpd_message_size_limit_64kb_min
$MAXLEVELS $MAXFILES
$MIN_EXPANSION_QUOTA $MIN_EXPANSION_FACTOR
$MAX_EXPANSION_QUOTA $MAX_EXPANSION_FACTOR
@lookup_sql_dsn @storage_sql_dsn $timestamp_fmt_mysql
$sql_quarantine_chunksize_max $sql_allow_8bit_address
$sql_lookups_no_at_means_domain $ldap_lookups_no_at_means_domain
$virus_check_negative_ttl $virus_check_positive_ttl
$spam_check_negative_ttl $spam_check_positive_ttl
$trim_trailing_space_in_lookup_result_fields
$enable_ldap $default_ldap
@keep_decoded_original_maps @map_full_type_to_short_type_maps
%banned_rules $penpals_threshold_low $penpals_threshold_high
$enable_dkim_verification $enable_dkim_signing
%dkim_signing_keys_by_domain
@dkim_signing_keys_list @dkim_signing_keys_storage
$file $altermime $enable_anomy_sanitizer
)],
'sa' => # global SpamAssassin settings
[qw(
$spamcontrol_obj
$helpers_home $sa_configpath $sa_siteconfigpath
$sa_local_tests_only $sa_auto_whitelist $sa_timeout $sa_debug
$dspam $sa_spawned
)],
'platform' => [qw(
$can_truncate $unicode_aware $eol $my_pid
&D_REJECT &D_BOUNCE &D_DISCARD &D_PASS
&CC_CATCHALL &CC_CLEAN &CC_MTA &CC_OVERSIZED
&CC_BADH &CC_SPAMMY &CC_SPAM &CC_UNCHECKED &CC_BANNED &CC_VIRUS
%ccat_display_names %ccat_display_names_major
)],
# other variables settable by user in amavisd.conf,
# but not directly accessible to the program
'hidden_confvars' => [qw(
$mydomain
)],
'legacy_dynamic_confvars' =>
# the rest of the program does not use these settings directly and they
# should not be visible in, or imported to other modules, but may be
# referenced indirectly through *_by_ccat variables for compatibility
[qw(
$final_virus_destiny $final_spam_destiny
$final_banned_destiny $final_bad_header_destiny
@virus_lovers_maps @spam_lovers_maps
@banned_files_lovers_maps @bad_header_lovers_maps
$always_bcc $dsn_bcc
$mailfrom_notify_sender $mailfrom_notify_recip
$mailfrom_notify_admin $mailfrom_notify_spamadmin
$hdrfrom_notify_sender $hdrfrom_notify_recip
$hdrfrom_notify_admin $hdrfrom_notify_spamadmin
$hdrfrom_notify_release $hdrfrom_notify_report
$notify_virus_admin_templ $notify_spam_admin_templ
$notify_virus_recips_templ $notify_spam_recips_templ
$notify_virus_sender_templ $notify_spam_sender_templ
$notify_sender_templ $notify_release_templ
$notify_report_templ $notify_autoresp_templ
$warnvirussender $warnspamsender $warnbannedsender $warnbadhsender
$defang_virus $defang_banned $defang_spam
$defang_bad_header $defang_undecipherable $defang_all
$virus_quarantine_method $banned_files_quarantine_method
$spam_quarantine_method $bad_header_quarantine_method
$clean_quarantine_method $archive_quarantine_method
@virus_quarantine_to_maps @banned_quarantine_to_maps
@spam_quarantine_to_maps @bad_header_quarantine_to_maps
@clean_quarantine_to_maps @archive_quarantine_to_maps
@virus_admin_maps @banned_admin_maps
@spam_admin_maps @bad_header_admin_maps
@warnvirusrecip_maps @warnbannedrecip_maps @warnbadhrecip_maps
@addr_extension_virus_maps @addr_extension_spam_maps
@addr_extension_banned_maps @addr_extension_bad_header_maps
)],
'legacy_confvars' =>
# legacy variables, predeclared for compatibility of amavisd.conf
# The rest of the program does not use them directly and they should
# not be visible in other modules, but may be referenced through
# @*_maps variables for backwards compatibility
[qw(
%local_domains @local_domains_acl $local_domains_re @mynetworks
%bypass_virus_checks @bypass_virus_checks_acl $bypass_virus_checks_re
%bypass_spam_checks @bypass_spam_checks_acl $bypass_spam_checks_re
%bypass_banned_checks @bypass_banned_checks_acl $bypass_banned_checks_re
%bypass_header_checks @bypass_header_checks_acl $bypass_header_checks_re
%virus_lovers @virus_lovers_acl $virus_lovers_re
%spam_lovers @spam_lovers_acl $spam_lovers_re
%banned_files_lovers @banned_files_lovers_acl $banned_files_lovers_re
%bad_header_lovers @bad_header_lovers_acl $bad_header_lovers_re
%virus_admin %spam_admin
$newvirus_admin $virus_admin $banned_admin $bad_header_admin $spam_admin
$warnvirusrecip $warnbannedrecip $warnbadhrecip
$virus_quarantine_to $banned_quarantine_to
$spam_quarantine_to $spam_quarantine_bysender_to
$bad_header_quarantine_to $clean_quarantine_to $archive_quarantine_to
$keep_decoded_original_re $map_full_type_to_short_type_re
$banned_filename_re $viruses_that_fake_sender_re
$sa_tag_level_deflt $sa_tag2_level_deflt $sa_tag3_level_deflt
$sa_kill_level_deflt
$sa_quarantine_cutoff_level @spam_notifyadmin_cutoff_level_maps
$sa_dsn_cutoff_level $sa_crediblefrom_dsn_cutoff_level
$sa_spam_modifies_subj $sa_spam_subject_tag1 $sa_spam_subject_tag
%whitelist_sender @whitelist_sender_acl $whitelist_sender_re
%blacklist_sender @blacklist_sender_acl $blacklist_sender_re
$addr_extension_virus $addr_extension_spam
$addr_extension_banned $addr_extension_bad_header
$sql_select_policy $sql_select_white_black_list
$gets_addr_in_quoted_form @debug_sender_acl
$arc $bzip2 $lzop $lha $unarj $gzip $uncompress $unfreeze
$unrar $zoo $pax $cpio $ar $rpm2cpio $cabextract $ripole $tnef
$gunzip $bunzip2 $unlzop $unstuff
$SYSLOG_LEVEL
)],
);
Exporter::export_tags qw(dynamic_confvars confvars sa platform
hidden_confvars legacy_dynamic_confvars legacy_confvars);
} # BEGIN
use POSIX ();
use Carp ();
use Errno qw(ENOENT EACCES EBADF);
use vars @EXPORT;
sub c($); sub cr($); sub ca($); sub dkim_key(@); # prototypes
use subs qw(c cr ca dkim_key); # access subroutine to config vars and keys
BEGIN { push(@EXPORT,qw(c cr ca dkim_key)) }
# new-style access to dynamic config variables
# return a config variable value - usually a scalar;
# one level of indirection for scalars is allowed
sub c($) {
my($name) = @_;
if (!exists $current_policy_bank{$name}) {
Carp::croak(sprintf('No entry "%s" in policy bank "%s"',
$name, $current_policy_bank{'policy_bank_name'}));
}
my($var) = $current_policy_bank{$name}; my($r) = ref($var);
!$r ? $var : $r eq 'SCALAR' ? $$var : $r eq 'REF' ? $$var
: $r eq 'ARRAY' ? @$var : $r eq 'HASH' ? %$var : $var;
}
# return a ref to a config variable value, or undef if var is undefined
sub cr($) {
my($name) = @_;
if (!exists $current_policy_bank{$name}) {
Carp::croak(sprintf('No entry "%s" in policy bank "%s"',
$name, $current_policy_bank{'policy_bank_name'}));
}
my($var) = $current_policy_bank{$name};
!defined($var) ? undef : !ref($var) ? \$var : $var;
}
# return a ref to a config variable value (which is supposed to be an array),
# converting undef to an empty array, and a scalar to a one-element array
# if necessary
sub ca($) {
my($name) = @_;
if (!exists $current_policy_bank{$name}) {
Carp::croak(sprintf('No entry "%s" in policy bank "%s"',
$name, $current_policy_bank{'policy_bank_name'}));
}
my($var) = $current_policy_bank{$name};
!defined($var) ? [] : !ref($var) ? [$var] : $var;
}
# Store a private DKIM signing key for a given domain and selector.
# The argument $key can be a Mail::DKIM::PrivateKey object or a file
# name containing a key in a PEM format (e.g. as generated by openssl).
# For compatibility with dkim_milter the signing domain can include a '*'
# as a wildcard - this is not recommended as this way amavisd can produce
# signatures which have no corresponding public key published in DNS.
# The proper way is to have one dkim_key entry for each published DNS RR.
# Optional arguments can provide additional information about the resource
# record (RR) of a public key, i.e. its options according to RFC 4871.
# The subroutine is typically called from a configuration file.
#
sub dkim_key($$$;@) {
my($domain,$selector,$key) = @_; shift; shift; shift;
@_%2 == 0 or die "dkim_key: a list of key/value pairs expected as options\n";
my(%key_options) = @_; # remaining args are options from a public key RR
defined $domain && $domain ne ''
or die "dkim_key: domain must not be empty: ($domain,$selector,$key)";
defined $selector && $selector ne ''
or die "dkim_key: selector must not be empty: ($domain,$selector,$key)";
my($key_storage_ind);
if (ref $key) {
push(@dkim_signing_keys_storage, [$key]);
$key_storage_ind = $#dkim_signing_keys_storage;
} else { # assume a file name with a private key in PEM format
my($fname) = $key;
my($pem_fh) = IO::File->new; # open a file with a private key
$pem_fh->open($fname,'<') or die "Can't open PEM file $fname: $!";
my(@stat_list) = stat($pem_fh);
@stat_list or warn "Error on stat($fname): $!";
my($dev,$inode) = @stat_list;
if ($dev && $inode) {
for my $j (0..$#dkim_signing_keys_storage) { # same file reused?
my($k,$dv,$in,$fn) = @{$dkim_signing_keys_storage[$j]};
if ($dv == $dev && $in == $inode) { $key_storage_ind = $j; last }
}
}
if (!defined($key_storage_ind)) {
# read file and store its contents as new entry
my($ln); $key = '';
for ($! = 0; defined($ln=$pem_fh->getline); $! = 0) { $key .= $ln }
defined $ln || $!==0 or # returning EBADF at EOF is a perl bug
$!==EBADF ? do_log(0,"Error reading key from file %s: %s", $fname,$!)
: die "Error reading key from file $fname: $!";
push(@dkim_signing_keys_storage, [$key,$dev,$inode,$fname]);
$key_storage_ind = $#dkim_signing_keys_storage;
}
$pem_fh->close or die "Error closing file $fname: $!";
$key_options{k} = 'rsa' if defined $key_options{k}; # force RSA
}
$domain = lc($domain) if !ref($domain); # possibly a regexp
$selector = lc($selector);
$key_options{domain} = $domain; $key_options{selector} = $selector;
$key_options{key_storage_ind} = $key_storage_ind;
!grep { $_->{domain} eq $domain && $_->{selector} eq $selector }
@dkim_signing_keys_list
or die "dkim_key: selector $selector for domain $domain already in use\n";
$key_options{key_ind} = $#dkim_signing_keys_list + 1;
push(@dkim_signing_keys_list, \%key_options); # using list to preserve order
}
# essential initializations, right at the program start time, may run as root!
#
use vars qw($read_config_files_depth @actual_config_files);
BEGIN { # init_primary: version, $unicode_aware, base policy bank
$myproduct_name = 'amavisd-new';
$myversion_id = '2.6.4'; $myversion_date = '20090625';
$myversion = "$myproduct_name-$myversion_id ($myversion_date)";
$myversion_id_numeric = # x.yyyzzz, allows numerical compare, like Perl $]
sprintf("%8.6f", $1 + ($2 + $3/1000)/1000)
if $myversion_id =~ /^(\d+)(?:\.(\d*)(?:\.(\d*))?)?(.*)$/;
$eol = "\n"; # native record separator in files: LF or CRLF or even CR
$unicode_aware =
$] >= 5.008 && length("\x{263a}")==1 && eval { require Encode };
$read_config_files_depth = 0;
eval { require Devel::SawAmpersand }; # load if avail, don't bother otherwise
# initialize policy bank hash to contain dynamic config settings
for my $tag (@EXPORT_TAGS{'dynamic_confvars', 'legacy_dynamic_confvars'}) {
for my $v (@$tag) {
local($1,$2);
if ($v !~ /^([%\$\@])(.*)\z/) { die "Unsupported variable type: $v" }
else {
no strict 'refs'; my($type,$name) = ($1,$2);
$current_policy_bank{$name} = $type eq '$' ? \${"Amavis::Conf::$name"}
: $type eq '@' ? \@{"Amavis::Conf::$name"}
: $type eq '%' ? \%{"Amavis::Conf::$name"}
: undef;
}
}
}
$current_policy_bank{'policy_bank_name'} = ''; # builtin policy
$current_policy_bank{'policy_bank_path'} = '';
$policy_bank{''} = { %current_policy_bank }; # copy
} # end BEGIN - init_primary
# boot-time initializations of simple global settings, may run as root!
#
BEGIN {
# serves only as a quick default for other configuration settings
$MYHOME = '/var/amavis';
$mydomain = '!change-mydomain-variable!.example.com';#intentionally bad deflt
# Create debugging output - true: log to stderr; false: log to syslog/file
$DEBUG = 0;
# Cause Net::Server parameters 'background' and 'setsid' to be set,
# resulting in the program to detach itself from the terminal
$daemonize = 1;
# Net::Server pre-forking settings - defaults, overruled by amavisd.conf
$max_servers = 2; # number of pre-forked children
$max_requests = 20; # retire a child after that many accepts, 0=unlimited
# timeout for our processing:
$child_timeout = 8*60; # abort child if it does not complete a task in n sec
# timeout for waiting on client input:
$smtpd_timeout = 8*60; # disconnect session if client is idle for too long;
# $smtpd_timeout should be higher than Postfix's max_idle (default 100s)
# Assume STDIN is a courierfilter pipe and shutdown when it becomes readable
$courierfilter_shutdown = 0;
# Can file be truncated?
# Set to 1 if 'truncate' works (it is XPG4-UNIX standard feature,
# not required by Posix).
# Things will go faster with SMTP-in, otherwise (e.g. with milter)
# it makes no difference as file truncation will not be used.
$can_truncate = 1;
# expiration time of cached results: time to live in seconds
# (how long the result of a virus/spam test remains valid)
$virus_check_negative_ttl= 3*60; #time to remember that mail wasn't infected
$virus_check_positive_ttl= 30*60; # time to remember that mail was infected
$spam_check_negative_ttl = 10*60; # time to remember that mail was not spam
$spam_check_positive_ttl = 30*60; # time to remember that mail was spam
#
# NOTE:
# Cache size will be determined by the largest of the $*_ttl values and the
# mail rate. With high mail rate the cache database may grow quite large.
# Reasonable compromise for the max value is 15 minutes to 2 hours.
# Customizable notification messages, logging
$syslog_ident = 'amavis';
$SYSLOG_LEVEL = 'mail.debug';
# should be less than 1023-prefix, i.e. 980, see sub write_log
$logline_maxlen = 980;
$enable_db = 0; # load optional modules Amavis::DB & Amavis::DB::SNMP
$enable_global_cache = 0; # enable use of bdb-based Amavis::Cache
$nanny_details_level = 1; # register_proc verbosity: 0, 1, 2
# $enable_dkim_signing = undef;
# $enable_dkim_verification = undef;
$reputation_factor = 0.2; # a value between 0 and 1, controlling the amount
# of 'bending' of a calculated spam score towards a fixed score assigned
# to a signer identity (its 'reputation') through @signer_reputation_maps;
# the formula is: adjusted_spam_score = f*reputation + (1-f)*spam_score;
# which has the same semantics as auto_whitelist_factor in SpamAssassin AWL
# Where to find SQL server(s) and database to support SQL lookups?
# A list of triples: (dsn,user,passw). Specify more than one
# for multiple (backup) SQL servers.
#
#@storage_sql_dsn =
#@lookup_sql_dsn =
# ( ['DBI:mysql:mail:host1', 'some-username1', 'some-password1'],
# ['DBI:mysql:mail:host2', 'some-username2', 'some-password2'] );
# Does a database mail address field with no '@' character represent a
# local username or a domain name? By default it implies a username in
# SQL and LDAP lookups (but represents a domain in hash and acl lookups),
# so domain names in SQL and LDAP should be specified as '@domain'.
# Setting these to true will cause 'xxx' to be interpreted as a domain
# name, just like in hash or acl lookups.
#
$sql_lookups_no_at_means_domain = 0;
$ldap_lookups_no_at_means_domain = 0;
# Maximum size (in bytes) for data written to a field 'quarantine.mail_text'
# when quarantining to SQL. Must not exceed size allowed for a data type
# on a given SQL server. It also determines a buffer size in amavisd.
# Too large a value may exceed process virtual memory limits or just waste
# memory, too small a value splits large mail into too many chunks, which
# may be less efficient to process.
#
$sql_quarantine_chunksize_max = 16384;
$sql_allow_8bit_address = 0;
$penpals_bonus_score = undef; # maximal (positive) score value by which spam
# score is lowered when sender is known to have previously received mail
# from our local user from this mail system. Zero or undef disables
# pen pals lookups in SQL tables msgs and msgrcpt, and is a default.
$penpals_halflife = 7*24*60*60; # exponential decay time constant in seconds;
# pen pal bonus is halved for each halflife period since the last mail
# sent by a local user to a current message's sender
$penpals_threshold_low = 1.0; # SA score below which pen pals lookups are
# not performed to save time; undef lets the threshold be ignored;
$penpals_threshold_high = undef;
# when (SA_score - $penpals_bonus_score > $penpals_threshold_high)
# pen pals lookup will not be performed to save time, as it could not
# influence blocking of spam even at maximal penpals bonus (age=0);
# usual choice for value would be kill level or other reasonably high
# value; undef lets the threshold be ignored and is a default (useful
# for testing and statistics gathering);
$bounce_killer_score = 0;
#
# Receiving mail related
# $unix_socketname = '/var/amavis/amavisd.sock'; # old amavis client protocol
# $inet_socket_port = 10024; # accept SMTP on this TCP port
# $inet_socket_port = [10024,10026,10027]; # ...possibly on more than one
$inet_socket_bind = '127.0.0.1'; # limit socket bind to loopback interface
@inet_acl = qw( 127.0.0.1 ::1 ); # allow SMTP access only from localhost
@mynetworks = qw( 127.0.0.0/8 ::1 FE80::/10 FEC0::/10
10.0.0.0/8 172.16.0.0/12 192.168.0.0/16 );
$originating = 0; # a boolean, initially reflects @mynetworks,
# but may be modified later through a policy bank
$notify_method = 'smtp:[127.0.0.1]:10025';
$forward_method = 'smtp:[127.0.0.1]:10025';
$resend_method = undef; # overrides $forward_method on defanging if nonempty
$release_method = undef; # overrides $notify_method on releasing
# from quarantine if nonempty
$requeue_method = 'smtp:[127.0.0.1]:25'; # requeueing release from a quarant.
$release_format = 'resend'; # (dsn), (arf), attach, plain, resend
$report_format = 'arf'; # (dsn), arf, attach, plain, resend
$virus_quarantine_method = 'local:virus-%m';
$spam_quarantine_method = 'local:spam-%m.gz';
$banned_files_quarantine_method = 'local:banned-%m';
$bad_header_quarantine_method = 'local:badh-%m';
$clean_quarantine_method = undef; # 'local:clean-%m';
$archive_quarantine_method = undef; # 'local:archive-%m.gz';
$insert_received_line = 1; # insert Received: header field? (not with milter)
$append_header_fields_to_bottom = 0; # obsolete! (always treated as 0)
$prepend_header_fields_hdridx = 0; # normally 0, use 1 for co-existence
# with signing DK and DKIM milters
$remove_existing_x_scanned_headers = 0;
$remove_existing_spam_headers = 1;
# fix improper header fields in passed or released mail - this setting
# is a pre-condition for $allow_fixing_improper_header_folding and similar
# (future) fixups; (desirable, but may break DKIM validation of messages
# with illegal header section)
$allow_fixing_improper_header = 1;
# fix improper folded header fields made up entirely of whitespace, by
# removing all-whitespace lines ($allow_fixing_improper_header must be true)
$allow_fixing_improper_header_folding = 1;
# truncate header section lines longer than 998 characters as limited
# by the rfc2822 ($allow_fixing_improper_header must be true)
$allow_fixing_long_header_lines = 1;
# encoding (charset in MIME terminology)
# to be used in RFC 2047-encoded ...
$hdr_encoding = 'iso-8859-1'; # ... header field bodies
$bdy_encoding = 'iso-8859-1'; # ... notification body text
# encoding (encoding in MIME terminology)
$hdr_encoding_qb = 'Q'; # quoted-printable (default)
#$hdr_encoding_qb = 'B'; # base64 (usual for far east charsets)
$smtpd_recipient_limit = 1100; # max recipients (RCPT TO) - sanity limit
# $myhostname is used by SMTP server module in the initial SMTP welcome line,
# in inserted Received: lines, Message-ID in notifications, log entries, ...
$myhostname = (POSIX::uname)[1]; # should be a FQDN !
$snmp_contact = ''; # a value of sysContact OID
$snmp_location = ''; # a value of sysLocation OID
$smtpd_greeting_banner = '${helo-name} ${protocol} ${product} service ready';
$smtpd_quit_banner = '${helo-name} ${product} closing transmission channel';
$enforce_smtpd_message_size_limit_64kb_min = 1;
# $localhost_name is the name of THIS host running amavisd
# (typically 'localhost'). It is used in HELO SMTP command
# when reinjecting mail back to MTA via SMTP for final delivery,
# and in inserted Received header field
$localhost_name = 'localhost';
$propagate_dsn_if_possible = 1; # pass on DSN if MTA announces this
# capability; useful to be turned off globally but enabled in
# MYNETS policy bank to hide internal mail routing from outsiders
$terminate_dsn_on_notify_success = 0; # when true=>handle DSN NOTIFY=SUCCESS
# locally, do not let NOTIFY=SUCCESS propagate to MTA (but allow
# other DSN options like NOTIFY=NEVER/FAILURE/DELAY, ORCPT, RET,
# and ENVID to propagate if possible)
#@auth_mech_avail = ('PLAIN','LOGIN'); # empty list disables incoming AUTH
#$auth_required_inp = 1; # incoming SMTP authentication required by amavisd?
#$auth_required_out = 1; # SMTP authentication required by MTA
$auth_required_release = 1; # secret_id is required for a quarantine release
$tls_security_level_in = undef; # undef, 'may', 'encrypt', ...
$tls_security_level_out = undef; # undef, 'may', 'encrypt', ...
$smtpd_tls_cert_file = undef; # e.g. "$MYHOME/cert/amavisd-cert.pem"
$smtpd_tls_key_file = undef; # e.g. "$MYHOME/cert/amavisd-key.pem"
# SMTP AUTH username and password for notification submissions
# (and reauthentication of forwarded mail if requested)
#$amavis_auth_user = undef; # perhaps: 'amavisd'
#$amavis_auth_pass = undef;
#$auth_reauthenticate_forwarded = undef; # supply our own credentials also
# for forwarded (passed) mail
$smtp_connection_cache_on_demand = 1;
$smtp_connection_cache_enable = 1;
# whom quarantined messages appear to be sent from (envelope sender)
# $mailfrom_to_quarantine = undef; # orig. sender if undef, or set explicitly
# where to send quarantined malware - specify undef to disable, or an
# e-mail address containing '@', or just a local part, which will be
# mapped by %local_delivery_aliases into local mailbox name or directory.
# The lookup key is a recipient address
$virus_quarantine_to = 'virus-quarantine';
$banned_quarantine_to = 'banned-quarantine';
$spam_quarantine_to = 'spam-quarantine';
$bad_header_quarantine_to = 'bad-header-quarantine';
$clean_quarantine_to = 'clean-quarantine';
$archive_quarantine_to = 'archive-quarantine';
# similar to $spam_quarantine_to, but the lookup key is the sender address
$spam_quarantine_bysender_to = undef; # dflt: no by-sender spam quarantine
# quarantine directory or mailbox file or empty
# (only used if $virus_quarantine_to specifies direct local delivery)
$QUARANTINEDIR = undef; # no quarantine unless overridden by config
$undecipherable_subject_tag = '***UNCHECKED*** ';
@spam_scanners = (
['SpamAssassin', 'Amavis::SpamControl::SpamAssassin' ],
# ['SpamdClient', 'Amavis::SpamControl::SpamdClient' ],
# ['DSPAM', 'Amavis::SpamControl::ExtProg', $dspam,
# [ qw(--stdout --classify --deliver=innocent,spam
# --mode=tum --tokenizer=chained,noise
# --user), $daemon_user ],
# # use option --feature instead of --tokenizer with dspam < 3.8.0
# mail_body_size_limit => 65000, score_factor => 0.1,
# ],
# ['CRM114', 'Amavis::SpamControl::ExtProg', 'crm',
# [ qw(-u /var/amavis/home/.crm114 mailreaver.crm
# --dontstore --report_only --stats_only
# --good_threshold=10 --spam_threshold=-10) ],
# mail_body_size_limit => 65000, score_factor => -0.20,
# ],
);
$sa_spawned = 0; # true: run SA in a subprocess; false: call SA directly
# string to prepend to Subject header field when message qualifies as spam
# $sa_spam_subject_tag1 = undef; # example: '***possible SPAM*** '
# $sa_spam_subject_tag = undef; # example: '***SPAM*** '
$sa_spam_modifies_subj = 1; # true for compatibility; can be a lookup
# table indicating per-recip settings
$sa_spam_level_char = '*'; # character to be used in X-Spam-Level bar;
# empty or undef disables adding this header field
# $sa_spam_report_header = undef; # insert X-Spam-Report header field?
$sa_local_tests_only = 0;
$sa_debug = undef;
$sa_timeout = 30;# timeout low boundary in seconds for a call to SpamAssassin
$file = 'file'; # path to the file(1) utility for classifying contents
$altermime = 'altermime'; # path to the altermime utility (optional)
@altermime_args_defang = qw(--verbose --removeall);
@altermime_args_disclaimer = qw(--disclaimer=/etc/altermime-disclaimer.txt);
# @altermime_args_disclaimer =
# qw(--disclaimer=/etc/_OPTION_.txt --disclaimer-html=/etc/_OPTION_.html);
# @disclaimer_options_bysender_maps = ( 'altermime-disclaimer' );
$MIN_EXPANSION_FACTOR = 5; # times original mail size
$MAX_EXPANSION_FACTOR = 500; # times original mail size
# See amavisd.conf and README.lookups for details.
# What to do with the message (this is independent of quarantining):
# Reject: tell MTA to generate a non-delivery notification, MTA gets 5xx
# Bounce: generate a non-delivery notification by ourselves, MTA gets 250
# Discard: drop the message and pretend it was delivered, MTA gets 250
# Pass: accept/forward a message
#
# COMPATIBILITY NOTE: the separation of *_destiny values into
# D_BOUNCE, D_REJECT, D_DISCARD and D_PASS made settings $warnvirussender
# and $warnspamsender only still useful with D_PASS. The combination of
# D_DISCARD + $warn*sender=1 is mapped into D_BOUNCE for compatibility.
# The following symbolic constants can be used in *destiny settings:
#
# D_PASS mail will pass to recipients, regardless of contents;
#
# D_DISCARD mail will not be delivered to its recipients, sender will NOT be
# notified. Effectively we lose mail (but it will be quarantined
# unless disabled).
#
# D_BOUNCE mail will not be delivered to its recipients, a non-delivery
# notification (bounce) will be sent to the sender by amavisd-new
# (unless suppressed). Bounce (DSN) will not be sent if a virus
# name matches $viruses_that_fake_sender_maps, or to messages
# from mailing lists (Precedence: bulk|list|junk), or for spam
# exceeding spam_dsn_cutoff_level
#
# D_REJECT mail will not be delivered to its recipients, sender should
# preferably get a reject, e.g. SMTP permanent reject response
# (e.g. with milter), or non-delivery notification from MTA
# (e.g. Postfix). If this is not possible (if different recipients
# have different tolerances to bad mail contents and not using
# LMTP) amavisd-new sends a bounce by itself (same as D_BOUNCE).
#
# Notes:
# D_REJECT and D_BOUNCE are similar,the difference is in who is responsible
# for informing the sender about non-delivery, and how informative
# the notification can be (amavisd-new knows more than MTA);
# With D_REJECT, MTA may reject original SMTP, or send DSN (delivery status
# notification, colloquially called 'bounce') - depending on MTA
# and its interface to a content checker; best suited for sendmail
# milter, especially for spam.
# With D_BOUNCE, amavisd-new (not MTA) sends DSN (can better explain the
# reason for mail non-delivery but unable to reject the original
# SMTP session, and is in position to suppress DSN if considered
# unsuitable). Best suited for Postfix and other dual-MTA setups.
# Exceeded spam cutoff limit or faked virus sender implicitly
# turns D_BOUNCE into a D_DISCARD;
$final_virus_destiny = D_DISCARD; # D_REJECT, D_BOUNCE, D_DISCARD, D_PASS
$final_banned_destiny = D_BOUNCE; # D_REJECT, D_BOUNCE, D_DISCARD, D_PASS
$final_spam_destiny = D_BOUNCE; # D_REJECT, D_BOUNCE, D_DISCARD, D_PASS
$final_bad_header_destiny= D_PASS; # D_REJECT, D_BOUNCE, D_DISCARD, D_PASS
# If decided to pass viruses (or spam) to certain recipients using
# %lovers_maps_by_ccat, or by %final_destiny_by_ccat resulting in D_PASS,
# one may set the corresponding %addr_extension_maps_by_ccat to some string,
# and the recipient address will have this string appended as an address
# extension to a local-part (mailbox part) of the address. This extension
# can be used by a final local delivery agent for example to place such mail
# in different folder. Leaving these variable undefined or empty string
# prevents appending address extension. Recipients which do not match access
# lists in @local_domains_maps are not affected (i.e. non-local recipients
# do not get address extension appended).
#
# LDAs usually default to stripping away address extension if no special
# handling for it is specified, so having this option enabled normally
# does no harm, provided the $recipients_delimiter character matches
# the setting at the final MTA's local delivery agent (LDA).
#
# $addr_extension_virus = 'virus'; # for example
# $addr_extension_spam = 'spam';
# $addr_extension_banned = 'banned';
# $addr_extension_bad_header = 'badh';
# Delimiter between local part of the recipient address and address extension
# (which can optionally be added, see variable %addr_extension_maps_by_ccat.
# E.g. recipient address <user@domain.example> gets
# changed to <user+virus@domain.example>.
#
# Delimiter should match equivalent (final) MTA delimiter setting.
# (e.g. for Postfix add 'recipient_delimiter = +' to main.cf).
# Setting it to an empty string or to undef disables this feature
# regardless of %addr_extension_maps_by_ccat setting.
# $recipient_delimiter = '+';
$replace_existing_extension = 1; # true: replace ext; false: append ext
# Affects matching of localpart of e-mail addresses (left of '@')
# in lookups: true = case sensitive, false = case insensitive
$localpart_is_case_sensitive = 0;
# Trim trailing whitespace from SQL fields, LDAP attribute values
# and hash righthand-sides as read by read_hash(); disabled by default;
# turn it on for compatibility with pre-2.4.0 versions.
$trim_trailing_space_in_lookup_result_fields = 0;
} # end BEGIN - init_secondary
# init structured variables like %sql_clause, $map_full_type_to_short_type_re,
# %ccat_display_names, @decoders, build default maps; may run as root!
#
BEGIN {
$allowed_added_header_fields{lc($_)} = 1 for qw(
Received DKIM-Signature Authentication-Results
X-Quarantine-ID X-Amavis-Alert X-Amavis-Hold X-Amavis-Modified
X-Amavis-PenPals X-Amavis-OS-Fingerprint X-Amavis-PolicyBank
X-Spam-Status X-Spam-Level X-Spam-Flag X-Spam-Score
X-Spam-Report X-Spam-Checker-Version X-Spam-Tests
X-CRM114-Status X-CRM114-CacheID X-CRM114-Notice X-CRM114-Action
X-DSPAM-Result X-DSPAM-Class X-DSPAM-Signature X-DSPAM-Processed
X-DSPAM-Confidence X-DSPAM-Probability X-DSPAM-User X-DSPAM-Factors
);
$allowed_added_header_fields{lc('X-Spam-Checker-Version')} = 0;
# $allowed_added_header_fields{lc(c('X_HEADER_TAG'))} = 1; #later:read_config
# $allowed_added_header_fields{lc('Received')} = 0 if !$insert_received_line;
# controls which header section tests are performed in check_header_validity,
# keys correspond to minor contents categories for CC_BADH
$allowed_header_tests{lc($_)} = 1 for qw(
other mime 8bit control empty long syntax missing multiple);
# rfc4871 standard set of header fields to be signed:
my(@sign_headers) = qw(From Sender Reply-To Subject Date Message-ID To Cc
In-Reply-To References MIME-Version Content-Type Content-Transfer-Encoding
Content-ID Content-Description Resent-Date Resent-From Resent-Sender
Resent-To Resent-Cc Resent-Message-ID List-Id List-Post List-Owner
List-Subscribe List-Unsubscribe List-Help List-Archive);
# additional header fields considered appropriate, see also rfc4021
# and IANA registry "Permanent Message Header Field Names";
# see rfc3834 for Auto-Submitted
push(@sign_headers, qw(Received Precedence
Original-Message-ID Message-Context PICS-Label Sensitivity Solicitation
Content-Location Content-Features Content-Disposition Content-Language
Content-Alternative Content-Base Content-MD5 Content-Duration Content-Class
Accept-Language Auto-Submitted Archived-At));
# note that we are signing Received despite the advise in rfc4871;
# some additional nonstandard header fields:
push(@sign_headers, qw(Organization Organisation User-Agent X-Mailer));
$signed_header_fields{lc($_)} = 1 for @sign_headers;
# Excluded:
# DKIM-Signature DomainKey-Signature Keywords Comments
# Errors-To X-Archived-At X-Virus-Scanned
# Some MTAs are dropping Disposition-Notification-To, exclude:
# Disposition-Notification-To Disposition-Notification-Options
# Signing a 'Sender' may not be a good idea because when such mail is sent
# through a mailing list, this header field is usually replaced by a new one,
# invalidating a signature. Long To and Cc address lists are often mangled,
# especially when containing non-encoded display names. Off: Sender, To, Cc
$signed_header_fields{lc($_)} = 0 for qw(Sender To Cc);
#
# a value greater than 1 causes signing of one additional null instance of
# a header field, thus prohibiting prepending additional occurences of such
# header field without breaking a signature
$signed_header_fields{lc($_)} = 2 for qw(From Date Subject Content-Type);
# provide names for content categories - to be used only for logging,
# SNMP counter names and display purposes
%ccat_display_names = (
CC_CATCHALL, 'CatchAll', # last resort, should not normally appear
CC_CLEAN, 'Clean',
CC_CLEAN.',1', 'CleanTag', # tag_level
CC_MTA, 'MtaFailed', # unable to forward (general)
CC_MTA.',1', 'MtaTempFailed', # MTA response was 4xx
CC_MTA.',2', 'MtaRejected', # MTA response was 5xx
CC_OVERSIZED, 'Oversized',
CC_BADH, 'BadHdr',
CC_BADH.',1', 'BadHdrMime',
CC_BADH.',2', 'BadHdr8bit',
CC_BADH.',3', 'BadHdrChar',
CC_BADH.',4', 'BadHdrSpace',
CC_BADH.',5', 'BadHdrLong',
CC_BADH.',6', 'BadHdrSyntax',
CC_BADH.',7', 'BadHdrMissing',
CC_BADH.',8', 'BadHdrDupl',
CC_SPAMMY, 'Spammy', # tag2_level
CC_SPAMMY.',1','Spammy3', # tag3_level
CC_SPAM, 'Spam', # kill_level
CC_UNCHECKED, 'Unchecked',
CC_BANNED, 'Banned',
CC_VIRUS, 'Virus',
);
# provide names for content categories - to be used only for logging,
# SNMP counter names and display purposes, similar to %ccat_display_names
# but only major contents category names are listed
%ccat_display_names_major = (
CC_CATCHALL, 'CatchAll', # last resort, should not normally appear
CC_CLEAN, 'Clean',
CC_MTA, 'MtaFailed', # unable to forward
CC_OVERSIZED, 'Oversized',
CC_BADH, 'BadHdr',
CC_SPAMMY, 'Spammy', # tag2_level
CC_SPAM, 'Spam', # kill_level
CC_UNCHECKED, 'Unchecked',
CC_BANNED, 'Banned',
CC_VIRUS, 'Virus',
);
# $sql_partition_tag is a user-specified SQL field value in tables
# maddr, msgs, msgrcpt and quarantine, inserted into new records. It is
# usually an integer, but depending on a schema may be other data type
# e.g. a string. May be used to speed up purging of old records by using
# partitioned tables (MySQL 5.1+, PostgreSQL 8.1+). A possible usage can
# be a week-of-a-year, or some other slowly changing value, allowing to
# quickly drop old table partitions without wasting time on deleting
# individual records. Mail addresses in table maddr are self-contained
# within a partition tag, which means that the same mail address may
# appear in more than one maddr partition (using different 'id's), and
# that tables msgs and msgrcpt are guaranteed to reference a maddr.id
# within their own partition tag. The $sql_partition_tag may be a scalar
# (usually an integer or a string), or a reference to a subroutine, which
# will be called with an object of type Amavis::In::Message as argument,
# and its result will be used as a partition tag value. Possible usage:
#
# $sql_partition_tag =
# sub { my($msginfo)=@_; iso8601_week($msginfo->rx_time) };
# The SQL select clause to fetch per-recipient policy settings.
# The %k will be replaced by a comma-separated list of query addresses
# for a recipient (e.g. a full address, domain only, catchall), %a will be
# replaced by an exact recipient address (same as the first entry in %k,
# suitable for pattern matching). Use ORDER, if there is a chance that
# multiple records will match - the first match wins (i.e. the first
# returned record). If field names are not unique (e.g. 'id'), the later
# field overwrites the earlier in a hash returned by lookup, which is why
# we use 'users.*, policy.*, users.id', i.e. the id is repeated at the end.
# This is a legacy variable for upwards compatibility, now only referenced
# by the program through a %sql_clause entry 'sel_policy' - newer config
# files may assign directly to $sql_clause{'sel_policy'} if preferred.
#
$sql_select_policy =
'SELECT users.*, policy.*, users.id'.
' FROM users LEFT JOIN policy ON users.policy_id=policy.id'.
' WHERE users.email IN (%k) ORDER BY users.priority DESC';
# Btw, MySQL and PostgreSQL are happy with 'SELECT *, users.id',
# but Oracle wants 'SELECT users.*, policy.*, users.id', which is
# also acceptable to MySQL and PostgreSQL.
# The SQL select clause to check sender in per-recipient whitelist/blacklist.
# The first SELECT argument '?' will be users.id from recipient SQL lookup,
# the %k will be a sender addresses (e.g. a full address, a domain only, a
# catchall), the %a will be an exact sender address (same as the first entry
# in %k). Only the first occurrence of '?' will be replaced by users.id,
# subsequent occurrences of '?' will see empty string as an argument.
# There can be zero or more occurrences of %k or %a, lookup keys will be
# replicated accordingly. Up until version 2.2.0 the '?' had to be placed
# before the '%k'; starting with 2.2.1 this restriction is lifted.
# This is a separate legacy variable for upwards compatibility, now only
# referenced by the program through %sql_clause entry 'sel_wblist' - newer
# config files may assign directly to $sql_clause{'sel_wblist'} if preferred.
#
$sql_select_white_black_list =
'SELECT wb FROM wblist JOIN mailaddr ON wblist.sid=mailaddr.id'.
' WHERE wblist.rid=? AND mailaddr.email IN (%k)'.
' ORDER BY mailaddr.priority DESC';
%sql_clause = (
'sel_policy' => \$sql_select_policy,
'sel_wblist' => \$sql_select_white_black_list,
'sel_adr' =>
'SELECT id FROM maddr WHERE partition_tag=? AND email=?',
'ins_adr' =>
'INSERT INTO maddr (partition_tag, email, domain) VALUES (?,?,?)',
'ins_msg' =>
'INSERT INTO msgs (partition_tag, mail_id, secret_id, am_id,'.
' time_num, time_iso, sid, policy, client_addr, size, host)'.
' VALUES (?,?,?,?,?,?,?,?,?,?,?)',
'upd_msg' =>
'UPDATE msgs SET content=?, quar_type=?, quar_loc=?, dsn_sent=?,'.
' spam_level=?, message_id=?, from_addr=?, subject=?, client_addr=?'.
' WHERE partition_tag=? AND mail_id=?',
'ins_rcp' =>
'INSERT INTO msgrcpt (partition_tag, mail_id, rid,'.
' ds, rs, bl, wl, bspam_level, smtp_resp) VALUES (?,?,?,?,?,?,?,?,?)',
# 'INSERT INTO msgrcpt (partition_tag, mail_id, rid,'.
# ' ds, rs, content, bl, wl, bspam_level, sql_policy_id, smtp_resp)'.
# ' VALUES (?,?,?,?,?,?,?,?,?,?,?)',
'ins_quar' =>
'INSERT INTO quarantine (partition_tag, mail_id, chunk_ind, mail_text)'.
' VALUES (?,?,?,?)',
'sel_msg' => # obtains partition_tag if missing in a release request
'SELECT partition_tag FROM msgs WHERE mail_id=?',
'sel_quar' =>
'SELECT mail_text FROM quarantine'.
' WHERE coalesce(partition_tag,0)=coalesce(?,0) AND mail_id=?'.
' ORDER BY chunk_ind',
'sel_penpals' => # no message-id references list
"SELECT msgs.time_num, msgs.mail_id, subject".
" FROM msgs JOIN msgrcpt USING (partition_tag,mail_id)".
" WHERE sid=? AND rid=? AND msgs.content!='V' AND ds='P'".
" ORDER BY msgs.time_num DESC", # LIMIT 1
'sel_penpals_msgid' => # with a nonempty message-id references list
"SELECT msgs.time_num, msgs.mail_id, subject, message_id, rid".
" FROM msgs JOIN msgrcpt USING (partition_tag,mail_id)".
" WHERE sid=? AND msgs.content!='V' AND ds='P' AND message_id IN (%m)".
" AND rid!=sid".
" ORDER BY rid=? DESC, msgs.time_num DESC", # LIMIT 1
);
# NOTE on $sql_clause{'upd_msg'}: MySQL clobbers timestamp on update
# (unless DEFAULT 0 is used) setting it to current local time and
# losing the cherishly preserved and prepared time of mail reception.
# From the MySQL 4.1 documentation:
# * With neither DEFAULT nor ON UPDATE clauses, it is the same as
# DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP.
# * suppress the automatic initialization and update behaviors for the first
# TIMESTAMP column by explicitly assigning it a constant DEFAULT value
# (for example, DEFAULT 0)
# * The first TIMESTAMP column in table row automatically is updated to
# the current timestamp when the value of any other column in the row is
# changed, unless the TIMESTAMP column explicitly is assigned a value
# other than NULL.
# maps full string as returned by a file(1) utility into a short string;
# first match wins, more specific entries should precede general ones!
# the result may be a string or a ref to a list of strings;
# see also sub decompose_part()
# prepare an arrayref, later to be converted to an Amavis::Lookup::RE object
$map_full_type_to_short_type_re = [
[qr/^empty\z/ => 'empty'],
[qr/^directory\z/ => 'dir'],
[qr/^can't (stat|read)\b/ => 'dat'], # file(1) diagnostics
[qr/^cannot open\b/ => 'dat'], # file(1) diagnostics
[qr/^ERROR:/ => 'dat'], # file(1) diagnostics
[qr/can't read magic file|couldn't find any magic files/ => 'dat'],
[qr/^data\z/ => 'dat'],
[qr/^ISO-8859.*\btext\b/ => 'txt'],
[qr/^Non-ISO.*ASCII\b.*\btext\b/ => 'txt'],
[qr/^Unicode\b.*\btext\b/i => 'txt'],
[qr/^UTF.* Unicode text\b/i => 'txt'],
[qr/^'diff' output text\b/ => 'txt'],
[qr/^GNU message catalog\b/ => 'mo'],
[qr/^PGP encrypted data\b/ => 'pgp'],
[qr/^PGP armored data( signed)? message\b/ => ['pgp','pgp.asc'] ],
[qr/^PGP armored\b/ => ['pgp','pgp.asc'] ],
### 'file' is a bit too trigger happy to claim something is 'mail text'
# [qr/^RFC 822 mail text\b/ => 'mail'],
[qr/^(ASCII|smtp|RFC 822) mail text\b/ => 'txt'],
[qr/^JPEG image data\b/ =>['image','jpg'] ],
[qr/^GIF image data\b/ =>['image','gif'] ],
[qr/^PNG image data\b/ =>['image','png'] ],
[qr/^TIFF image data\b/ =>['image','tif'] ],
[qr/^PCX\b.*\bimage data\b/ =>['image','pcx'] ],
[qr/^PC bitmap data\b/ =>['image','bmp'] ],
[qr/^MP2\b/ =>['audio','mpa','mp2'] ],
[qr/^MP3\b/ =>['audio','mpa','mp3'] ],
[qr/^MPEG video stream data\b/ =>['movie','mpv'] ],
[qr/^MPEG system stream data\b/ =>['movie','mpg'] ],
[qr/^MPEG\b/ =>['movie','mpg'] ],
[qr/^Microsoft ASF\b/ =>['movie','wmv'] ],
[qr/^RIFF\b.*\bAVI\b/ =>['movie','avi'] ],
[qr/^RIFF\b.*\banimated cursor\b/ =>['movie','ani'] ],
[qr/^RIFF\b.*\bWAVE audio\b/ =>['audio','wav'] ],
[qr/^Macromedia Flash data\b/ => 'swf'],
[qr/^HTML document text\b/ => 'html'],
[qr/^XML document text\b/ => 'xml'],
[qr/^exported SGML document text\b/ => 'sgml'],
[qr/^PostScript document text\b/ => 'ps'],
[qr/^PDF document\b/ => 'pdf'],
[qr/^Rich Text Format data\b/ => 'rtf'],
[qr/^Microsoft Office Document\b/i => 'doc'], # OLE2: doc, ppt, xls, ...
[qr/^Microsoft Installer\b/i => 'doc'], # file(1) may misclassify
[qr/^ms-windows meta(file|font)\b/i => 'wmf'],
[qr/^LaTeX\b.*\bdocument text\b/ => 'lat'],
[qr/^TeX DVI file\b/ => 'dvi'],
[qr/\bdocument text\b/ => 'txt'],
[qr/^compiled Java class data\b/ => 'java'],
[qr/^MS Windows 95 Internet shortcut text\b/ => 'url'],
[qr/^frozen\b/ => 'F'],
[qr/^gzip compressed\b/ => 'gz'],
[qr/^bzip compressed\b/ => 'bz'],
[qr/^bzip2 compressed\b/ => 'bz2'],
[qr/^lzop compressed\b/ => 'lzo'],
[qr/^compress'd/ => 'Z'],
[qr/^Zip archive\b/i => 'zip'],
[qr/^7-zip archive\b/i => '7z'],
[qr/^RAR archive\b/i => 'rar'],
[qr/^LHa.*\barchive\b/i => 'lha'], # (also known as .lzh)
[qr/^ARC archive\b/i => 'arc'],
[qr/^ARJ archive\b/i => 'arj'],
[qr/^Zoo archive\b/i => ['zoo','unzoo'] ],
[qr/^(\S+\s+)?tar archive\b/i => 'tar'],
[qr/^(\S+\s+)?cpio archive\b/i => 'cpio'],
[qr/^StuffIt Archive\b/i => 'sit'],
[qr/^Debian binary package\b/i => 'deb'], # standard Unix archive (ar)
[qr/^current ar archive\b/i => 'a'], # standard Unix archive (ar)
[qr/^RPM\b/ => 'rpm'],
[qr/^(Transport Neutral Encapsulation Format|TNEF)\b/i => 'tnef'],
[qr/^Microsoft Cabinet (file|archive)\b/i => 'cab'],
[qr/^InstallShield Cabinet file\b/ => 'installshield'],
[qr/^(uuencoded|xxencoded)\b/i => 'uue'],
[qr/^binhex\b/i => 'hqx'],
[qr/^(ASCII|text)\b/i => 'asc'],
[qr/^Emacs.*byte-compiled Lisp data/i => 'asc'], # BinHex with empty line
[qr/\bscript text executable\b/ => 'txt'],
[qr/^MS Windows\b.*\bDLL\b/ => ['exe','dll'] ],
[qr/\bexecutable for MS Windows\b.*\bDLL\b/ => ['exe','dll'] ],
[qr/^MS-DOS executable \(built-in\)/ => 'asc'], # starts with LZ
[qr/^(MS-)?DOS executable\b.*\bDLL\b/ => ['exe','dll'] ],
[qr/^MS Windows\b.*\bexecutable\b/ => ['exe','exe-ms'] ],
[qr/\bexecutable for MS Windows\b/ => ['exe','exe-ms'] ],
[qr/^COM executable for DOS\b/ => 'asc'], # misclassified?
[qr/^DOS executable \(COM\)/ => 'asc'], # misclassified?
[qr/^(MS-)?DOS executable\b(?!.*\(COM\))/ => ['exe','exe-ms'] ],
[qr/^PA-RISC.*\bexecutable\b/ => ['exe','exe-unix'] ],
[qr/^ELF .*\bexecutable\b/ => ['exe','exe-unix'] ],
[qr/^COFF format .*\bexecutable\b/ => ['exe','exe-unix'] ],
[qr/^executable \(RISC System\b/ => ['exe','exe-unix'] ],
[qr/^VMS\b.*\bexecutable\b/ => ['exe','exe-vms'] ],
[qr/\bexecutable\b/i => 'exe'],
[qr/\bshared object, /i => 'so'],
[qr/\brelocatable, /i => 'o'],
[qr/\btext\b/i => 'asc'],
[qr/^/ => 'dat'], # catchall
];
# MS Windows PE 32-bit Intel 80386 GUI executable not relocatable
# MS-DOS executable (EXE), OS/2 or MS Windows
# MS-DOS executable PE for MS Windows (DLL) (GUI) Intel 80386 32-bit
# MS-DOS executable PE for MS Windows (DLL) (GUI) Alpha 32-bit
# MS-DOS executable, NE for MS Windows 3.x (driver)
# MS-DOS executable (built-in) (any file starting with LZ!)
# PE executable for MS Windows (DLL) (GUI) Intel 80386 32-bit
# PE executable for MS Windows (GUI) Intel 80386 32-bit
# NE executable for MS Windows 3.x
# PA-RISC1.1 executable dynamically linked
# PA-RISC1.1 shared executable dynamically linked
# ELF 64-bit LSB executable, Alpha (unofficial), version 1 (FreeBSD),
# for FreeBSD 5.0.1, dynamically linked (uses shared libs), stripped
# ELF 64-bit LSB executable, Alpha (unofficial), version 1 (SYSV),
# for GNU/Linux 2.2.5, dynamically linked (uses shared libs), stripped
# ELF 64-bit MSB executable, SPARC V9, version 1 (FreeBSD),
# for FreeBSD 5.0, dynamically linked (uses shared libs), stripped
# ELF 64-bit MSB shared object, SPARC V9, version 1 (FreeBSD), stripped
# ELF 32-bit LSB executable, Intel 80386, version 1, dynamically`
# ELF 32-bit MSB executable, SPARC, version 1, dynamically linke`
# COFF format alpha executable paged stripped - version 3.11-10
# COFF format alpha executable paged dynamically linked stripped`
# COFF format alpha demand paged executable or object module
# stripped - version 3.11-10
# COFF format alpha paged dynamically linked not stripped shared`
# executable (RISC System/6000 V3.1) or obj module
# VMS VAX executable
# A list of pairs or n-tuples: [short-type, code_ref, optional-args...].
# Maps short types to a decoding routine, the first match wins.
# Arguments beyond the first two can be program path string (or a listref of
# paths to be searched) or a reference to a variable containing such a path,
# which allows for lazy evaluation, making possible to assign values to
# legacy configuration variables even after the assignment to @decoders.
@decoders = (
['mail', \&Amavis::Unpackers::do_mime_decode],
# ['asc', \&Amavis::Unpackers::do_ascii],
# ['uue', \&Amavis::Unpackers::do_ascii],
# ['hqx', \&Amavis::Unpackers::do_ascii],
# ['ync', \&Amavis::Unpackers::do_ascii],
['F', \&Amavis::Unpackers::do_uncompress, \$unfreeze],
['Z', \&Amavis::Unpackers::do_uncompress, \$uncompress],
['gz', \&Amavis::Unpackers::do_gunzip],
['gz', \&Amavis::Unpackers::do_uncompress, \$gunzip],
['bz2', \&Amavis::Unpackers::do_uncompress, \$bunzip2],
['lzo', \&Amavis::Unpackers::do_uncompress, \$unlzop],
['rpm', \&Amavis::Unpackers::do_uncompress, \$rpm2cpio],
['cpio', \&Amavis::Unpackers::do_pax_cpio, \$pax],
['cpio', \&Amavis::Unpackers::do_pax_cpio, \$cpio],
['tar', \&Amavis::Unpackers::do_pax_cpio, \$pax],
['tar', \&Amavis::Unpackers::do_pax_cpio, \$cpio],
# ['tar', \&Amavis::Unpackers::do_tar], # no longer supported
['deb', \&Amavis::Unpackers::do_ar, \$ar],
# ['a', \&Amavis::Unpackers::do_ar, \$ar], #unpacking .a seems an overkill
['zip', \&Amavis::Unpackers::do_unzip],
['7z', \&Amavis::Unpackers::do_7zip, ['7zr','7za','7z'] ],
['rar', \&Amavis::Unpackers::do_unrar, \$unrar],
['arj', \&Amavis::Unpackers::do_unarj, \$unarj],
['arc', \&Amavis::Unpackers::do_arc, \$arc],
['zoo', \&Amavis::Unpackers::do_zoo, \$zoo],
['lha', \&Amavis::Unpackers::do_lha, \$lha],
['doc', \&Amavis::Unpackers::do_ole, \$ripole],
['cab', \&Amavis::Unpackers::do_cabextract, \$cabextract],
['tnef', \&Amavis::Unpackers::do_tnef_ext, \$tnef],
['tnef', \&Amavis::Unpackers::do_tnef],
# ['sit', \&Amavis::Unpackers::do_unstuff, \$unstuff], # not safe
['exe', \&Amavis::Unpackers::do_executable, \$unrar,\$lha,\$unarj],
);
# build_default_maps
@local_domains_maps = (
\%local_domains, \@local_domains_acl, \$local_domains_re);
@mynetworks_maps = (\@mynetworks);
@client_ipaddr_policy = map { $_ => 'MYNETS' } @mynetworks_maps;
@bypass_virus_checks_maps = (
\%bypass_virus_checks, \@bypass_virus_checks_acl, \$bypass_virus_checks_re);
@bypass_spam_checks_maps = (
\%bypass_spam_checks, \@bypass_spam_checks_acl, \$bypass_spam_checks_re);
@bypass_banned_checks_maps = (
\%bypass_banned_checks, \@bypass_banned_checks_acl, \$bypass_banned_checks_re);
@bypass_header_checks_maps = (
\%bypass_header_checks, \@bypass_header_checks_acl, \$bypass_header_checks_re);
@virus_lovers_maps = (
\%virus_lovers, \@virus_lovers_acl, \$virus_lovers_re);
@spam_lovers_maps = (
\%spam_lovers, \@spam_lovers_acl, \$spam_lovers_re);
@banned_files_lovers_maps = (
\%banned_files_lovers, \@banned_files_lovers_acl, \$banned_files_lovers_re);
@bad_header_lovers_maps = (
\%bad_header_lovers, \@bad_header_lovers_acl, \$bad_header_lovers_re);
@warnvirusrecip_maps = (\$warnvirusrecip);
@warnbannedrecip_maps = (\$warnbannedrecip);
@warnbadhrecip_maps = (\$warnbadhrecip);
@newvirus_admin_maps = (\$newvirus_admin);
@virus_admin_maps = (\%virus_admin, \$virus_admin);
@banned_admin_maps = (\$banned_admin, \%virus_admin, \$virus_admin);
@bad_header_admin_maps= (\$bad_header_admin);
@spam_admin_maps = (\%spam_admin, \$spam_admin);
@virus_quarantine_to_maps = (\$virus_quarantine_to);
@banned_quarantine_to_maps = (\$banned_quarantine_to);
@spam_quarantine_to_maps = (\$spam_quarantine_to);
@spam_quarantine_bysender_to_maps = (\$spam_quarantine_bysender_to);
@bad_header_quarantine_to_maps = (\$bad_header_quarantine_to);
@clean_quarantine_to_maps = (\$clean_quarantine_to);
@archive_quarantine_to_maps = (\$archive_quarantine_to);
@keep_decoded_original_maps = (\$keep_decoded_original_re);
@map_full_type_to_short_type_maps = (\$map_full_type_to_short_type_re);
# @banned_filename_maps = ( {'.' => [$banned_filename_re]} );
# @banned_filename_maps = ( {'.' => 'DEFAULT'} );#names mapped by %banned_rules
@banned_filename_maps = ( 'DEFAULT' ); # same as previous, but shorter
@viruses_that_fake_sender_maps = (\$viruses_that_fake_sender_re, 1);
@spam_tag_level_maps = (\$sa_tag_level_deflt);
@spam_tag2_level_maps = (\$sa_tag2_level_deflt); # CC_SPAMMY
@spam_tag3_level_maps = (\$sa_tag3_level_deflt); # CC_SPAMMY,1
@spam_kill_level_maps = (\$sa_kill_level_deflt); # CC_SPAM
@spam_dsn_cutoff_level_maps = (\$sa_dsn_cutoff_level);
@spam_dsn_cutoff_level_bysender_maps = (\$sa_dsn_cutoff_level);
@spam_crediblefrom_dsn_cutoff_level_maps =
(\$sa_crediblefrom_dsn_cutoff_level);
@spam_crediblefrom_dsn_cutoff_level_bysender_maps =
(\$sa_crediblefrom_dsn_cutoff_level);
@spam_quarantine_cutoff_level_maps = (\$sa_quarantine_cutoff_level);
@spam_modifies_subj_maps = (\$sa_spam_modifies_subj);
@spam_subject_tag_maps = (\$sa_spam_subject_tag1); # note: inconsistent name
@spam_subject_tag2_maps = (\$sa_spam_subject_tag); # note: inconsistent name
@spam_subject_tag3_maps = (); # new variable, no backwards compatib. needed
@whitelist_sender_maps = (
\%whitelist_sender, \@whitelist_sender_acl, \$whitelist_sender_re);
@blacklist_sender_maps = (
\%blacklist_sender, \@blacklist_sender_acl, \$blacklist_sender_re);
@addr_extension_virus_maps = (\$addr_extension_virus);
@addr_extension_spam_maps = (\$addr_extension_spam);
@addr_extension_banned_maps = (\$addr_extension_banned);
@addr_extension_bad_header_maps = (\$addr_extension_bad_header);
@debug_sender_maps = (\@debug_sender_acl);
@remove_existing_spam_headers_maps = (\$remove_existing_spam_headers);
# new variables, no backwards compatibility needed
# @score_sender_maps, @author_to_policy_bank_maps, @signer_reputation_maps,
# @message_size_limit_maps
# build backwards-compatible settings hashes
%final_destiny_by_ccat = (
CC_VIRUS, sub { c('final_virus_destiny') },
CC_BANNED, sub { c('final_banned_destiny') },
CC_SPAM, sub { c('final_spam_destiny') },
CC_BADH, sub { c('final_bad_header_destiny') },
CC_OVERSIZED, D_BOUNCE,
CC_CATCHALL, D_PASS,
);
%smtp_reason_by_ccat = (
# currently only used for blocked messages only, status 5xx
# a multiline message will produce a valid multiline SMTP response
CC_VIRUS, "id=%n - INFECTED: %V",
CC_BANNED, "id=%n - BANNED: %F",
CC_UNCHECKED, "id=%n - UNCHECKED",
CC_SPAM, "id=%n - SPAM",
CC_SPAMMY.',1', "id=%n - SPAMMY (tag3)",
CC_SPAMMY, "id=%n - SPAMMY",
CC_BADH.',1', "id=%n - BAD HEADER: MIME error",
CC_BADH.',2', "id=%n - BAD HEADER: nonencoded 8-bit character",
CC_BADH.',3', "id=%n - BAD HEADER: contains invalid control character",
CC_BADH.',4', "id=%n - BAD HEADER: line made up entirely of whitespace",
CC_BADH.',5', "id=%n - BAD HEADER: line longer than RFC 2822 limit",
CC_BADH.',6', "id=%n - BAD HEADER: syntax error",
CC_BADH.',7', "id=%n - BAD HEADER: missing required header field",
CC_BADH.',8', "id=%n - BAD HEADER: duplicate header field",
CC_BADH, "id=%n - BAD HEADER",
CC_OVERSIZED, "id=%n - Message size exceeds recipient's size limit",
CC_MTA.',1', "id=%n - Temporary MTA failure on relaying",
CC_MTA.',2', "id=%n - Rejected by MTA on relaying",
CC_MTA, "id=%n - Unable to relay message back to MTA",
CC_CLEAN, "id=%n - CLEAN",
CC_CATCHALL, "id=%n - OTHER", # should not happen
);
%lovers_maps_by_ccat = (
CC_VIRUS, sub { ca('virus_lovers_maps') },
CC_BANNED, sub { ca('banned_files_lovers_maps') },
CC_SPAM, sub { ca('spam_lovers_maps') },
CC_BADH, sub { ca('bad_header_lovers_maps') },
);
%defang_maps_by_ccat = (
CC_VIRUS, sub { c('defang_virus') },
CC_BANNED, sub { c('defang_banned') },
CC_UNCHECKED, sub { c('defang_undecipherable') },
CC_SPAM, sub { c('defang_spam') },
CC_SPAMMY, sub { c('defang_spam') },
# CC_BADH.',3', 1, # NUL or CR character in header section
# CC_BADH.',5', 1, # header line longer than 998 characters
# CC_BADH.',6', 1, # header field syntax error
CC_BADH, sub { c('defang_bad_header') },
);
%subject_tag_maps_by_ccat = (
CC_VIRUS, [ '***INFECTED*** ' ],
CC_BANNED, undef,
CC_UNCHECKED, sub { [ c('undecipherable_subject_tag') ] }, # not by-recip
CC_SPAM, undef,
CC_SPAMMY.',1', sub { ca('spam_subject_tag3_maps') },
CC_SPAMMY, sub { ca('spam_subject_tag2_maps') },
CC_CLEAN.',1', sub { ca('spam_subject_tag_maps') },
);
%quarantine_method_by_ccat = (
CC_VIRUS, sub { c('virus_quarantine_method') },
CC_BANNED, sub { c('banned_files_quarantine_method') },
CC_SPAM, sub { c('spam_quarantine_method') },
CC_SPAMMY, sub { c('clean_quarantine_method') }, #formally a clean msg
CC_BADH, sub { c('bad_header_quarantine_method') },
CC_CLEAN, sub { c('clean_quarantine_method') },
);
%quarantine_to_maps_by_ccat = (
CC_VIRUS, sub { ca('virus_quarantine_to_maps') },
CC_BANNED, sub { ca('banned_quarantine_to_maps') },
CC_SPAM, sub { ca('spam_quarantine_to_maps') },
CC_SPAMMY, sub { ca('clean_quarantine_to_maps') }, # formally is clean
CC_BADH, sub { ca('bad_header_quarantine_to_maps') },
CC_CLEAN, sub { ca('clean_quarantine_to_maps') },
);
%admin_maps_by_ccat = (
CC_VIRUS, sub { ca('virus_admin_maps') },
CC_BANNED, sub { ca('banned_admin_maps') },
CC_SPAM, sub { ca('spam_admin_maps') },
CC_BADH, sub { ca('bad_header_admin_maps') },
);
%always_bcc_by_ccat = (
CC_CATCHALL, sub { c('always_bcc') },
);
%dsn_bcc_by_ccat = (
CC_CATCHALL, sub { c('dsn_bcc') },
);
%mailfrom_notify_admin_by_ccat = (
CC_SPAM, sub { c('mailfrom_notify_spamadmin') },
CC_CATCHALL, sub { c('mailfrom_notify_admin') },
);
%hdrfrom_notify_admin_by_ccat = (
CC_SPAM, sub { c('hdrfrom_notify_spamadmin') },
CC_CATCHALL, sub { c('hdrfrom_notify_admin') },
);
%mailfrom_notify_recip_by_ccat = (
CC_CATCHALL, sub { c('mailfrom_notify_recip') },
);
%hdrfrom_notify_recip_by_ccat = (
CC_CATCHALL, sub { c('hdrfrom_notify_recip') },
);
%hdrfrom_notify_sender_by_ccat = (
CC_CATCHALL, sub { c('hdrfrom_notify_sender') },
);
%hdrfrom_notify_release_by_ccat = (
CC_CATCHALL, sub { c('hdrfrom_notify_release') },
);
%hdrfrom_notify_report_by_ccat = (
CC_CATCHALL, sub { c('hdrfrom_notify_report') },
);
%notify_admin_templ_by_ccat = (
CC_SPAM, sub { cr('notify_spam_admin_templ') },
CC_CATCHALL, sub { cr('notify_virus_admin_templ') },
);
%notify_recips_templ_by_ccat = (
CC_SPAM, sub { cr('notify_spam_recips_templ') }, #usualy empty
CC_CATCHALL, sub { cr('notify_virus_recips_templ') },
);
%notify_sender_templ_by_ccat = ( # bounce templates
CC_VIRUS, sub { cr('notify_virus_sender_templ') },
CC_BANNED, sub { cr('notify_virus_sender_templ') }, #historical reason
CC_SPAM, sub { cr('notify_spam_sender_templ') },
CC_CATCHALL, sub { cr('notify_sender_templ') },
);
%notify_release_templ_by_ccat = (
CC_CATCHALL, sub { cr('notify_release_templ') },
);
%notify_report_templ_by_ccat = (
CC_CATCHALL, sub { cr('notify_report_templ') },
);
%notify_autoresp_templ_by_ccat = (
CC_CATCHALL, sub { cr('notify_autoresp_templ') },
);
%warnsender_by_ccat = ( # deprecated use, except perhaps for CC_BADH
CC_VIRUS, sub { c('warnvirussender') },
CC_BANNED, sub { c('warnbannedsender') },
CC_SPAM, sub { c('warnspamsender') },
CC_BADH, sub { c('warnbadhsender') },
);
%warnrecip_maps_by_ccat = (
CC_VIRUS, sub { ca('warnvirusrecip_maps') },
CC_BANNED, sub { ca('warnbannedrecip_maps') },
CC_SPAM, undef,
CC_BADH, sub { ca('warnbadhrecip_maps') },
);
%addr_extension_maps_by_ccat = (
CC_VIRUS, sub { ca('addr_extension_virus_maps') },
CC_BANNED, sub { ca('addr_extension_banned_maps') },
CC_SPAM, sub { ca('addr_extension_spam_maps') },
CC_SPAMMY, sub { ca('addr_extension_spam_maps') },
CC_BADH, sub { ca('addr_extension_bad_header_maps') },
# CC_OVERSIZED, 'oversized';
);
%addr_rewrite_maps_by_ccat = ( );
} # end BEGIN - init_tertiary
# prototypes
sub Amavis::Unpackers::do_mime_decode($$);
sub Amavis::Unpackers::do_ascii($$);
sub Amavis::Unpackers::do_uncompress($$$);
sub Amavis::Unpackers::do_gunzip($$);
sub Amavis::Unpackers::do_pax_cpio($$$);
#sub Amavis::Unpackers::do_tar($$); # no longer supported
sub Amavis::Unpackers::do_ar($$$);
sub Amavis::Unpackers::do_unzip($$;$$);
sub Amavis::Unpackers::do_7zip($$$;$);
sub Amavis::Unpackers::do_unrar($$$;$);
sub Amavis::Unpackers::do_unarj($$$;$);
sub Amavis::Unpackers::do_arc($$$);
sub Amavis::Unpackers::do_zoo($$$);
sub Amavis::Unpackers::do_lha($$$;$);
sub Amavis::Unpackers::do_ole($$$);
sub Amavis::Unpackers::do_cabextract($$$);
sub Amavis::Unpackers::do_tnef($$);
sub Amavis::Unpackers::do_tnef_ext($$$);
sub Amavis::Unpackers::do_unstuff($$$);
sub Amavis::Unpackers::do_executable($$@);
no warnings 'once';
# Define alias names or shortcuts in this module to make it simpler
# to call these routines from amavisd.conf
*read_l10n_templates = \&Amavis::Util::read_l10n_templates;
*read_text = \&Amavis::Util::read_text;
*read_hash = \&Amavis::Util::read_hash;
*read_array = \&Amavis::Util::read_array;
*dump_hash = \&Amavis::Util::dump_hash;
*dump_array = \&Amavis::Util::dump_array;
*ask_daemon = \&Amavis::AV::ask_daemon;
*ask_av_smtp = \&Amavis::AV::ask_av_smtp;
*sophos_savi = \&Amavis::AV::ask_sophos_savi;
*ask_clamav = \&Amavis::AV::ask_clamav;
*do_mime_decode = \&Amavis::Unpackers::do_mime_decode;
*do_ascii = \&Amavis::Unpackers::do_ascii;
*do_uncompress = \&Amavis::Unpackers::do_uncompress;
*do_gunzip = \&Amavis::Unpackers::do_gunzip;
*do_pax_cpio = \&Amavis::Unpackers::do_pax_cpio;
*do_tar = \&Amavis::Unpackers::do_tar; # no longer supported
*do_ar = \&Amavis::Unpackers::do_ar;
*do_unzip = \&Amavis::Unpackers::do_unzip;
*do_unrar = \&Amavis::Unpackers::do_unrar;
*do_7zip = \&Amavis::Unpackers::do_7zip;
*do_unarj = \&Amavis::Unpackers::do_unarj;
*do_arc = \&Amavis::Unpackers::do_arc;
*do_zoo = \&Amavis::Unpackers::do_zoo;
*do_lha = \&Amavis::Unpackers::do_lha;
*do_ole = \&Amavis::Unpackers::do_ole;
*do_cabextract = \&Amavis::Unpackers::do_cabextract;
*do_tnef_ext = \&Amavis::Unpackers::do_tnef_ext;
*do_tnef = \&Amavis::Unpackers::do_tnef;
*do_unstuff = \&Amavis::Unpackers::do_unstuff;
*do_executable = \&Amavis::Unpackers::do_executable;
*iso8601_week = \&Amavis::rfc2821_2822_Tools::iso8601_week;
*iso8601_timestamp = \&Amavis::rfc2821_2822_Tools::iso8601_timestamp;
*iso8601_utc_timestamp = \&Amavis::rfc2821_2822_Tools::iso8601_utc_timestamp;
sub new_RE { Amavis::Lookup::RE->new(@_) }
*defang_by_ccat = \%defang_maps_by_ccat; # compatibility with old name
use vars qw(%defang_by_ccat);
@virus_name_to_spam_score_maps =
(new_RE( # the order matters!
[ qr'^Phishing\.' => 0.1 ],
[ qr'^Structured\.(SSN|CreditCardNumber)\b' => 0.1 ],
[ qr'^(Email|HTML)\.Phishing\.(?!.*Sanesecurity)' => 0.1 ],
[ qr'^Sanesecurity\.(Malware|Rogue|Trojan)\.' => undef ],# keep as infected
[ qr'^Sanesecurity\.' => 0.1 ],
[ qr'^Sanesecurity_PhishBar_' => 0 ],
[ qr'^Sanesecurity.TestSig_' => 0 ],
[ qr'^Email\.Spam\.Bounce(\.[^., ]*)*\.Sanesecurity\.' => 0 ],
[ qr'^Email\.Spammail\b' => 0.1 ],
[ qr'^MSRBL-(Images|SPAM)\b' => 0.1 ],
[ qr'^VX\.Honeypot-SecuriteInfo\.com\.Joke' => 0.1 ],
[ qr'^VX\.not-virus_(Hoax|Joke)\..*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
[ qr'^Email\.Spam.*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
[ qr'^Safebrowsing\.' => 0.1 ],
[ qr'^winnow\.(phish|spam)\.' => 0.1 ],
[ qr'^INetMsg\.SpamDomain' => 0.1 ],
[ qr'-SecuriteInfo\.com(\.|\z)' => undef ], # keep as infected
[ qr'^MBL_NA\.UNOFFICIAL' => 0.1 ], # false positives
[ qr'^MBL_' => undef ], # keep as infected
));
# Sanesecurity http://www.sanesecurity.co.uk/
# MSRBL- http://www.msrbl.com/site/contact
# MBL http://www.malware.com.br/index.shtml
# -SecuriteInfo.com http://clamav.securiteinfo.com/malwares.html
# prepend a lookup table label object for logging purposes
sub label_default_maps() {
for my $varname (qw(
@local_domains_maps @mynetworks_maps
@bypass_virus_checks_maps @bypass_spam_checks_maps
@bypass_banned_checks_maps @bypass_header_checks_maps
@virus_lovers_maps @spam_lovers_maps
@banned_files_lovers_maps @bad_header_lovers_maps
@warnvirusrecip_maps @warnbannedrecip_maps @warnbadhrecip_maps
@newvirus_admin_maps @virus_admin_maps
@banned_admin_maps @bad_header_admin_maps @spam_admin_maps
@virus_quarantine_to_maps @banned_quarantine_to_maps
@spam_quarantine_to_maps @spam_quarantine_bysender_to_maps
@bad_header_quarantine_to_maps @clean_quarantine_to_maps
@archive_quarantine_to_maps @banned_filename_maps
@keep_decoded_original_maps @map_full_type_to_short_type_maps
@viruses_that_fake_sender_maps @virus_name_to_spam_score_maps
@spam_tag_level_maps @spam_tag2_level_maps @spam_tag3_level_maps
@spam_kill_level_maps @spam_modifies_subj_maps
@spam_dsn_cutoff_level_maps @spam_dsn_cutoff_level_bysender_maps
@spam_quarantine_cutoff_level_maps @spam_notifyadmin_cutoff_level_maps
@spam_subject_tag_maps @spam_subject_tag2_maps @spam_subject_tag3_maps
@whitelist_sender_maps @blacklist_sender_maps @score_sender_maps
@author_to_policy_bank_maps @signer_reputation_maps
@message_size_limit_maps
@addr_extension_virus_maps @addr_extension_spam_maps
@addr_extension_banned_maps @addr_extension_bad_header_maps
@remove_existing_spam_headers_maps @debug_sender_maps ))
{
my($g) = $varname; $g =~ s{\@}{Amavis::Conf::}; # qualified variable name
my($label) = $varname; $label=~s/^\@//; $label=~s/_maps$//;
{ no strict 'refs';
unshift(@$g, # NOTE: a symbolic reference
Amavis::Lookup::Label->new($label)) if @$g; # no label if empty
}
}
}
# return a list of actually read&evaluated configuration files
sub get_config_files_read() { @actual_config_files }
# read and evaluate a configuration file, some sanity checking and housekeeping
sub read_config_file($$) {
my($config_file,$is_optional) = @_;
my(@stat_list) = stat($config_file); # symlinks-friendly
my($errn) = @stat_list ? 0 : 0+$!;
if ($errn == ENOENT && $is_optional) {
# don't complain if missing
} else {
my($owner_uid) = $stat_list[4];
my($msg);
if ($errn == ENOENT) { $msg = "does not exist" }
elsif ($errn) { $msg = "is inaccessible: $!" }
elsif (-d _) { $msg = "is a directory" }
elsif (!-f _) { $msg = "is not a regular file" }
elsif ($> && -o _) { $msg = "should not be owned by EUID $>"}
elsif ($> && -w _) { $msg = "is writable by EUID $>, EGID $)" }
elsif ($owner_uid) { $msg = "should be owned by root (uid 0) "}
if (defined $msg) { die "Config file \"$config_file\" $msg," }
$read_config_files_depth++; push(@actual_config_files, $config_file);
if ($read_config_files_depth >= 100) {
print STDERR "read_config_files: recursion depth limit exceeded\n";
exit 1; }
$! = 0;
if (defined(do $config_file)) {}
elsif ($@ ne '') { die "Error in config file \"$config_file\": $@" }
elsif ($! != 0) { die "Error reading config file \"$config_file\": $!" }
$read_config_files_depth-- if $read_config_files_depth > 0;
}
1;
}
sub include_config_files(@) { read_config_file($_,0) for @_; 1 }
sub include_optional_config_files(@) { read_config_file($_,1) for @_; 1 }
sub supply_after_defaults() {
$daemon_chroot_dir = ''
if !defined $daemon_chroot_dir || $daemon_chroot_dir eq '/';
$TEMPBASE = $MYHOME if !defined $TEMPBASE;
$helpers_home = $MYHOME if !defined $helpers_home;
$db_home = "$MYHOME/db" if !defined $db_home;
$lock_file = "$MYHOME/amavisd.lock" if !defined $lock_file;
$pid_file = "$MYHOME/amavisd.pid" if !defined $pid_file;
local($1,$2);
if ($SYSLOG_LEVEL =~ /^\s*([a-z0-9]+)\.([a-z0-9]+)\s*\z/i) { $syslog_facility = $1 if $syslog_facility eq '';
$syslog_priority = $2 if $syslog_priority eq '';
}
$X_HEADER_LINE= "$myproduct_name at $mydomain" if !defined $X_HEADER_LINE;
$X_HEADER_TAG = 'X-Virus-Scanned' if !defined $X_HEADER_TAG;
if ($X_HEADER_TAG =~ /^[!-9;-\176]+\z/) {
my($allowed_hdrs) = cr('allowed_added_header_fields');
$allowed_hdrs->{lc($X_HEADER_TAG)} = 1
if $allowed_hdrs && !exists($allowed_hdrs->{lc($X_HEADER_TAG)});
}
$gunzip = "$gzip -d" if !defined $gunzip && $gzip ne '';
$bunzip2 = "$bzip2 -d" if !defined $bunzip2 && $bzip2 ne '';
$unlzop = "$lzop -d" if !defined $unlzop && $lzop ne '';
my($pname) = '"Content-filter at ${myhostname}"';
$hdrfrom_notify_sender = "$pname <postmaster\@\${myhostname}>"
if !defined $hdrfrom_notify_sender;
$hdrfrom_notify_recip = $mailfrom_notify_recip ne ''
? "$pname <$mailfrom_notify_recip>"
: $hdrfrom_notify_sender if !defined $hdrfrom_notify_recip;
$hdrfrom_notify_admin = $mailfrom_notify_admin ne ''
? "$pname <$mailfrom_notify_admin>"
: $hdrfrom_notify_sender if !defined $hdrfrom_notify_admin;
$hdrfrom_notify_spamadmin = $mailfrom_notify_spamadmin ne ''
? "$pname <$mailfrom_notify_spamadmin>"
: $hdrfrom_notify_sender if !defined $hdrfrom_notify_spamadmin;
$hdrfrom_notify_release = $hdrfrom_notify_sender
if !defined $hdrfrom_notify_release;
$hdrfrom_notify_report = $hdrfrom_notify_sender
if !defined $hdrfrom_notify_report;
for ($final_virus_destiny, $final_banned_destiny, $final_spam_destiny) {
if ($_ > 0) { $_ = D_PASS }
elsif ($_ < 0 && $_ != D_BOUNCE && $_ != D_REJECT) { $_ = c('forward_method') eq '' ? D_REJECT : D_BOUNCE;
}
}
if ($final_virus_destiny == D_DISCARD && c('warnvirussender') )
{ $final_virus_destiny = D_BOUNCE }
if ($final_spam_destiny == D_DISCARD && c('warnspamsender') )
{ $final_spam_destiny = D_BOUNCE }
if ($final_banned_destiny == D_DISCARD && c('warnbannedsender') )
{ $final_banned_destiny = D_BOUNCE }
if ($final_bad_header_destiny == D_DISCARD && c('warnbadhsender') )
{ $final_bad_header_destiny = D_BOUNCE }
if (!%banned_rules) {
%banned_rules = ('DEFAULT'=>$banned_filename_re); }
1;
}
1;
package Amavis::Log;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init &collect_log_stats &log_to_stderr &log_fd
&write_log &open_log &close_log);
import Amavis::Conf qw(:platform $DEBUG c cr ca
$myversion $logline_maxlen $daemon_user);
}
use subs @EXPORT_OK;
use POSIX qw(locale_h strftime);
use Fcntl qw(LOCK_SH LOCK_EX LOCK_UN);
use Unix::Syslog qw(:macros :subs);
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use Time::HiRes ();
use vars qw($loghandle); use vars qw($myname); use vars qw($log_to_stderr $do_syslog $logfile $within_write_log);
use vars qw($current_syslog_ident $current_syslog_facility);
use vars qw(%syslog_prio_name_to_num); use vars qw($log_lines $log_retries %log_entries_by_level %log_status_counts);
sub init($$) {
($do_syslog, $logfile) = @_;
$log_lines = 0; %log_entries_by_level = ();
$log_retries = 0; %log_status_counts = ();
for my $pn qw(DEBUG INFO NOTICE WARNING ERR CRIT ALERT EMERG) {
my($prio) = eval("LOG_$pn");
$syslog_prio_name_to_num{$pn} = $prio =~ /^\d+\z/ ? $prio : LOG_WARNING;
}
$myname = $0;
open_log();
if (!$do_syslog && $logfile eq '')
{ print STDERR "Logging to STDERR (no \$LOGFILE and no \$DO_SYSLOG)\n" }
}
sub collect_log_stats() {
my(@result) = ($log_lines, {%log_entries_by_level},
$log_retries, {%log_status_counts});
$log_lines = 0; %log_entries_by_level = ();
$log_retries = 0; %log_status_counts = ();
@result;
}
sub log_to_stderr(;$) {
$log_to_stderr = shift if @_ > 0;
$log_to_stderr;
}
sub log_fd() {
$log_to_stderr ? fileno(STDERR)
: $do_syslog ? undef : defined $loghandle ? $loghandle->fileno : fileno(STDERR);
}
sub open_log() {
if ($do_syslog) {
my($id) = c('syslog_ident'); my($fac) = c('syslog_facility');
$fac =~ /^[A-Za-z0-9_]+\z/
or die "Suspicious syslog facility name: $fac";
my($syslog_facility_num) = eval("LOG_\U$fac");
$syslog_facility_num =~ /^\d+\z/
or die "Unknown syslog facility name: $fac";
openlog($id, LOG_PID | LOG_NDELAY, $syslog_facility_num);
$current_syslog_ident = $id; $current_syslog_facility = $fac;
} elsif ($logfile ne '') {
$loghandle = IO::File->new;
$loghandle->open($logfile, O_CREAT|O_APPEND|O_WRONLY, 0640)
or die "Failed to open log file $logfile: $!";
binmode($loghandle,":bytes") or die "Can't cancel :utf8 mode: $!"
if $unicode_aware;
$loghandle->autoflush(1);
if ($> == 0) {
local($1);
my($uid) = $daemon_user=~/^(\d+)$/ ? $1 : (getpwnam($daemon_user))[2];
if ($uid) {
chown($uid,-1,$logfile)
or die "Can't chown logfile $logfile to $uid: $!";
}
}
} else { STDERR->autoflush(1); }
}
sub close_log() {
if ($do_syslog) {
closelog();
undef $current_syslog_ident; undef $current_syslog_facility;
} elsif (defined($loghandle) && $logfile ne '') {
$loghandle->close or die "Error closing log file $logfile: $!";
undef $loghandle;
}
}
sub write_log($$$;@) {
my($level,$am_id,$errmsg,@args) = @_;
return if $within_write_log;
$within_write_log = 1;
$am_id = !defined $am_id ? '' : "($am_id) ";
if (@args && index($errmsg,'%') >= 0) { $errmsg = sprintf($errmsg,@args) }
$errmsg = Amavis::Util::sanitize_str($errmsg);
my($alert_mark) = $level >= 0 ? '' : $level >= -1 ? '(!)' : '(!!)';
$log_entries_by_level{"$level"}++;
if ($do_syslog && !$log_to_stderr) {
my($prio) = $syslog_prio_name_to_num{uc(c('syslog_priority'))};
if ($level > 2) { $prio = LOG_DEBUG if $prio > LOG_DEBUG }
elsif ($level >= 1) { $prio = LOG_INFO if $prio > LOG_INFO }
elsif ($level >= 0) { $prio = LOG_NOTICE if $prio > LOG_NOTICE }
elsif ($level >= -1) { $prio = LOG_WARNING if $prio > LOG_WARNING }
elsif ($level >= -2) { $prio = LOG_ERR if $prio > LOG_ERR }
else { $prio = LOG_CRIT if $prio > LOG_CRIT }
if (c('syslog_ident') ne $current_syslog_ident ||
c('syslog_facility') ne $current_syslog_facility) {
close_log() if !defined($current_syslog_ident) &&
!defined($current_syslog_facility);
open_log();
}
my($pre) = $alert_mark;
my($logline_size) = $logline_maxlen;
$logline_size = 50 if $logline_size < 50; while (length($am_id)+length($pre)+length($errmsg) > $logline_size) {
my($avail) = $logline_size - length($am_id . $pre . "...");
$log_lines++; $! = 0;
syslog($prio, "%s", $am_id . $pre . substr($errmsg,0,$avail) . "...");
if ($! != 0) { $log_retries++; $log_status_counts{"$!"}++ }
$pre = $alert_mark . "..."; $errmsg = substr($errmsg,$avail);
}
$log_lines++; $! = 0; syslog($prio, "%s", $am_id . $pre . $errmsg);
if ($! != 0) { $log_retries++; $log_status_counts{"$!"}++ }
} else {
$log_lines++;
if ($log_to_stderr || !defined $loghandle) {
my($now) = Time::HiRes::time;
my($prefix) = sprintf("%s:%06.3f %s %s[%s]: ", strftime("%b %e %H:%M",localtime($now)), $now-int($now/60)*60,
c('myhostname'), $myname, $$); my($s) = $prefix . $am_id . $alert_mark . $errmsg . "\n";
print STDERR ($s) or die "Error writing to STDERR: $!";
} else {
my($prefix) = sprintf("%s %s %s[%s]: ", strftime("%b %e %H:%M:%S",localtime), c('myhostname'), $myname, $$);
my($s) = $prefix . $am_id . $alert_mark . $errmsg . "\n";
flock($loghandle,LOCK_EX) or die "Can't lock a log file: $!";
seek($loghandle,0,2) or die "Can't position log file to its tail: $!";
$loghandle->print($s) or die "Error writing to log file: $!";
flock($loghandle,LOCK_UN) or die "Can't unlock a log file: $!";
}
}
$within_write_log = 0;
}
1;
package Amavis::Timing;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init §ion_time &report &get_time_so_far);
}
use subs @EXPORT_OK;
use vars qw(@timing);
use Time::HiRes ();
sub init() {
@timing = (); section_time('init');
}
sub section_time($) {
push(@timing,shift,Time::HiRes::time);
}
sub report() {
section_time('rundown');
my($notneeded, $t0) = (shift(@timing), shift(@timing));
my($total) = $t0 <= 0 ? 0 : $timing[$ if ($total < 0.0000001) { $total = 0.0000001 }
my(@sections); my($t00) = $t0;
while (@timing) {
my($section, $t) = (shift(@timing), shift(@timing));
my($dt) = $t <= $t0 ? 0 : $t-$t0; my($dt_c) = $t <= $t00 ? 0 : $t-$t00; my($dtp) = $dt >= $total ? 100 : $dt*100.0/$total; my($dtp_c) = $dt_c >= $total ? 100 : $dt_c*100.0/$total; push(@sections, sprintf("%s: %.0f (%.0f%%)%.0f",
$section, $dt*1000, $dtp, $dtp_c));
$t0 = $t;
}
sprintf("TIMING [total %.0f ms] - %s", $total * 1000, join(", ",@sections));
}
sub get_time_so_far() {
my($notneeded, $t0) = @timing;
my($total) = $t0 <= 0 ? 0 : Time::HiRes::time - $t0;
$total < 0 ? 0 : $total;
}
use vars qw($t_was_busy $t_busy_cum $t_idle_cum $t0);
sub idle_proc(@) {
my($t1) = Time::HiRes::time;
if (defined $t0) {
($t_was_busy ? $t_busy_cum : $t_idle_cum) += $t1 - $t0;
Amavis::Util::ll(5) && Amavis::Util::do_log(5,
"idle_proc, %s: was %s, %.1f ms, total idle %.3f s, busy %.3f s",
$_[0], $t_was_busy ? "busy" : "idle", 1000*($t1 - $t0),
$t_idle_cum, $t_busy_cum);
}
$t0 = $t1;
}
sub go_idle(@) {
if ($t_was_busy) { idle_proc(@_); $t_was_busy = 0 }
}
sub go_busy(@) {
if (!$t_was_busy) { idle_proc(@_); $t_was_busy = 1 }
}
sub report_load() {
$t_busy_cum + $t_idle_cum <= 0 ? undef
: sprintf("load: %.0f %%, total idle %.3f s, busy %.3f s",
100*$t_busy_cum / ($t_busy_cum + $t_idle_cum), $t_idle_cum, $t_busy_cum);
}
1;
package Amavis::Util;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&untaint &min &max &unique_list &unique_ref
&safe_encode &safe_decode &q_encode
&xtext_encode &xtext_decode &orcpt_encode &orcpt_decode
&snmp_count &snmp_counters_init &snmp_counters_get
&am_id &new_am_id &ll &do_log &debug_oneshot
&add_entropy &fetch_entropy &generate_mail_id &prolong_timer
&waiting_for_client &switch_to_my_time &switch_to_client_time
&sanitize_str &fmt_struct &freeze &thaw
&ccat_split &ccat_maj &cmp_ccat &cmp_ccat_maj
&setting_by_given_contents_category_all
&setting_by_given_contents_category
&rmdir_recursively &read_text &read_l10n_templates
&read_hash &read_array &dump_hash &dump_array
&dynamic_destination);
import Amavis::Conf qw(:platform $DEBUG c cr ca $child_timeout $smtpd_timeout
$trim_trailing_space_in_lookup_result_fields);
import Amavis::Log qw(write_log);
import Amavis::Timing qw(section_time);
}
use subs @EXPORT_OK;
use Errno qw(ENOENT EACCES EAGAIN ESRCH EBADF);
use IO::File ();
use Digest::MD5 2.22;
sub untaint($) {
no re 'taint';
my($str);
if (defined($_[0])) {
local($1); $str = $1 if (ref($_[0]) ? ${$_[0]} : $_[0]) =~ /^(.*)\z/s;
}
$str;
}
sub min(@) {
my($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_; my($m); for (@$r) { $m = $_ if defined $_ && (!defined $m || $_ < $m) }
$m;
}
sub max(@) {
my($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_; my($m); for (@$r) { $m = $_ if defined $_ && (!defined $m || $_ > $m) }
$m;
}
sub unique_list(@) {
my($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_; my(%seen); my(@result) = grep { defined($_) && !$seen{$_}++ } @$r;
@result;
}
sub unique_ref(@) {
my($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_; my(%seen); my(@result) = grep { defined($_) && !$seen{$_}++ } @$r;
\@result;
}
sub safe_encode($$;$) {
if (!$unicode_aware) { $_[1] } else {
my($encoding,$str,$check) = @_;
$check = 0 if !defined $check;
my($taint) = Encode::encode('ascii',substr($str,0,0));
$taint . Encode::encode($encoding,untaint($str),$check); }
}
sub safe_decode($$;$) {
if (!$unicode_aware) { $_[1] } else {
my($encoding,$str,$check) = @_;
$check = 0 if !defined $check;
my($taint) = substr($str,0,0); $taint . Encode::decode($encoding,untaint($str),$check); }
}
sub q_encode($$$) {
my($octets,$encoding,$charset) = @_;
my($prefix) = '=?' . $charset . '?' . $encoding . '?';
my($suffix) = '?='; local($1,$2,$3);
$octets =~ /^ ( [\001-\011\013\014\016-\177]* [ \t] )? (.*?)
( [ \t] [\001-\011\013\014\016-\177]* )? \z/sx;
my($head,$rest,$tail) = ($1,$2,$3);
$rest =~ s{([\000-\037\177\200-\377=?_])}{sprintf('=%02X',ord($1))}egs;
$rest =~ tr/ /_/; my($s) = $head; my($len) = 75 - (length($prefix)+length($suffix)) - 2;
while ($rest ne '') {
$s .= ' ' if $s !~ /[ \t]\z/; $rest =~ /^ ( .{0,$len} [^=] (?: [^=] | \z ) ) (.*) \z/sx;
$s .= $prefix.$1.$suffix; $rest = $2;
}
$s.$tail;
}
sub xtext_encode($) { my($str) = @_; local($1);
$str = safe_encode('UTF-8',$str) if $unicode_aware && Encode::is_utf8($str);
$str =~ s/([^\041-\052\054-\074\076-\176])/sprintf("+%02X",ord($1))/egs;
$str;
}
sub xtext_decode($) {
my($str) = @_; local($1);
$str =~ s/\+([0-9a-fA-F]{2})/pack("C",hex($1))/egs;
$str;
}
sub orcpt_encode($) { my($str) = @_; local($1); $str = $1 if $str =~ /^<(.*)>\z/s; $str =~ s/[^\040-\176]/?/gs;
'rfc822;' . xtext_encode($str);
}
sub orcpt_decode($) { my($str) = @_; my($addr_type,$orcpt); local($1,$2);
if (defined $str) {
if ($str =~ /^([^\000-\040\177()<>\[\]\@\\:;,."]*);(.*\z)/si){ # atom;xtext
($addr_type,$orcpt) = ($1,$2);
} else {
($addr_type,$orcpt) = ('rfc822',$str); # rfc3464 address-type
}
$orcpt = xtext_decode($orcpt); # decode
$orcpt =~ s/[^\040-\176]/?/gs; # some minimal sanitation
}
# result in $orcpt is presumably a rfc2822-encoded address, no angle brackets
($addr_type,$orcpt);
}
# Set or get Amavis internal task id (also called: message id).
# This task id performs a similar function as queue-id in MTA responses.
# It may only be used in generating text part of SMTP responses,
# or in generating log entries. It is only unique within a limited timespan.
use vars qw($amavis_task_id); # internal task id
# (accessible via am_id() and later also as $msginfo->log_id)
sub am_id(;$) {
if (@_) { # set, if argument present
$amavis_task_id = shift;
$0 = "amavisd ($amavis_task_id)";
}
$amavis_task_id; # return current value
}
sub new_am_id($;$$) {
my($str, $cnt, $seq) = @_;
my($id);
$id = defined $str ? $str : sprintf("%05d", $$);
$id .= sprintf("-%02d", $cnt) if defined $cnt;
$id .= "-$seq" if defined $seq && $seq > 1;
am_id($id);
}
use vars qw($entropy); # MD5 ctx (128 bits, 32 hex digits or 22 base64 chars)
sub add_entropy(@) { # arguments may be strings or array references
$entropy = Digest::MD5->new if !defined $entropy;
my($s) = join(",", map {!defined($_) ? 'U' : ref eq 'ARRAY' ? @$_ : $_} @_);
# do_log(5,"add_entropy: %s",$s);
$entropy->add($s);
}
sub fetch_entropy() {
$entropy->clone->b64digest;
}
# generate a reasonably unique (long-term) id based on collected entropy.
# The result is a pair of (mostly public) mail_id, and a secret id,
# where mail_id == b64(md5(b64(secret))). The secret id could be used to
# authorize releasing quarantined mail. Both the mail_id and secret are
# 12-char strings of characters [A-Za-z0-9+-], with an additional restriction
# for mail_id which must begin and end with an alphanumeric character.
# As the number of encoded bits is an integral multiple of 24, no base64
# trailing padding characters '=' are needed for the time being (rfc4648).
# Note the difference in base64-like encodings:
# amavisd almost-base64: 62 +, 63 -
# rfc4648 base64: 62 +, 63 /
# rfc4648 base64url: 62 -, 63 _
# Generally, rfc2822 controls, SP and specials must be avoided: ()<>[]:;@\,."
sub generate_mail_id() {
my($secret_id,$id,$rest);
for (my $j=0; $j<100; $j++) { local($1,$2); $entropy->clone->b64digest =~ /^(.{12})(.*)\z/s;
($secret_id,$rest) = ($1,$2); $secret_id =~ tr{/}{-}; $id = Digest::MD5->new->add($secret_id)->b64digest; last if $id =~ /^[A-Za-z0-9].{10}[A-Za-z0-9]/s; add_entropy($j); do_log(5,"generate_mail_id retry: %s",$id);
}
$entropy = undef;
add_entropy($rest); add_entropy($id); $id = substr($id,0,12); $id =~ tr{/}{-}; ($id,$secret_id);
}
use vars qw(@counter_names);
sub snmp_counters_init() { @counter_names = () }
sub snmp_count(@) { push(@counter_names, @_) }
sub snmp_counters_get() { \@counter_names }
use vars qw($debug_oneshot);
sub debug_oneshot(;$$) {
if (@_) {
my($new_debug_oneshot) = shift;
if (($new_debug_oneshot ? 1 : 0) != ($debug_oneshot ? 1 : 0)) {
do_log(0, "DEBUG_ONESHOT: TURNED ".($new_debug_oneshot ? "ON" : "OFF"));
do_log(0, shift) if @_; }
$debug_oneshot = $new_debug_oneshot;
}
$debug_oneshot;
}
sub ll($) {
my($level) = @_;
$level = 0 if ($DEBUG || $debug_oneshot) && $level > 0;
my($current_log_level) = c('log_level');
$current_log_level = 0 if !defined $current_log_level;
$level <= $current_log_level;
}
sub do_log($$;@) {
my($level) = shift; $level = 0 if ($DEBUG || $debug_oneshot) && $level > 0;
my($current_log_level) = c('log_level');
$current_log_level = 0 if !defined $current_log_level;
write_log($level, am_id(), shift, @_) if $level <= $current_log_level;
1;
}
sub prolong_timer($;$) {
my($which_section, $child_remaining_time) = @_;
if (defined $child_remaining_time) { $child_remaining_time = 10 if $child_remaining_time < 10;
do_log(5, "prolong_timer %s: timer set to %d s",
$which_section,$child_remaining_time);
} else {
$child_remaining_time = alarm(0); do_log(5, "prolong_timer %s: remaining time = %d s",
$which_section,$child_remaining_time);
$child_remaining_time = 60 if $child_remaining_time < 60;
}
alarm($child_remaining_time); }
use vars qw($waiting_for_client); sub waiting_for_client() {
!@_ ? $waiting_for_client : ($waiting_for_client=shift);
}
sub switch_to_my_time($) { my($msg) = @_;
my($interval) = $child_timeout < 5 ? 5 : $child_timeout;
do_log(5, "switch_to_my_time %d s, %s", $interval,$msg);
alarm($interval); $waiting_for_client = 0;
}
sub switch_to_client_time($) { my($msg) = @_;
my($interval) = $smtpd_timeout < 5 ? 5 : $smtpd_timeout;
do_log(5, "switch_to_client_time %d s, %s", $interval,$msg);
alarm($interval); $waiting_for_client = 1;
}
sub sanitize_str {
my($str, $keep_eol) = @_;
my(%map) = ("\r" => '\\r', "\n" => '\\n', "\f" => '\\f', "\t" => '\\t',
"\b" => '\\b', "\e" => '\\e', "\\" => '\\\\');
local($1);
if ($keep_eol) {
$str =~ s/([^\012\040-\133\135-\176])/ exists($map{$1}) ? $map{$1} :
sprintf(ord($1)>255 ? '\\x{%04x}' : '\\%03o', ord($1))/eg;
} else {
$str =~ s/([^\040-\133\135-\176])/ exists($map{$1}) ? $map{$1} :
sprintf(ord($1)>255 ? '\\x{%04x}' : '\\%03o', ord($1))/eg;
}
$str = safe_encode('utf8',$str) if $unicode_aware && Encode::is_utf8($str);
$str;
}
sub fmt_struct($) {
my($arg) = @_;
!defined($arg) ? 'undef' : !ref($arg) ? '"'.$arg.'"' :
ref($arg) eq 'ARRAY' ? '['.join(',',map {fmt_struct($_)} @$arg).']' : $arg;
};
sub st_encode($) {
my($str) = @_; local($1);
$str =~ s/([%~\000\200])/sprintf("%%%02X",ord($1))/egs;
$str;
}
sub freeze($); sub freeze($) {
my($obj) = @_; my($ty) = ref($obj);
if (!defined($obj)) { 'U' }
elsif (!$ty) { join('~', '', st_encode($obj)) } elsif ($ty eq 'SCALAR') { join('~', 'S', st_encode(freeze($$obj))) }
elsif ($ty eq 'REF') { join('~', 'R', st_encode(freeze($$obj))) }
elsif ($ty eq 'ARRAY') { join('~', 'A', map {st_encode(freeze($_))} @$obj) }
elsif ($ty eq 'HASH') {
join('~', 'H',
map {(st_encode($_),st_encode(freeze($obj->{$_})))} sort keys %$obj)
} else { die "Can't freeze object type $ty" }
}
sub thaw($); sub thaw($) {
my($str) = @_;
return undef if !defined $str;
my($ty,@val) = split(/~/,$str,-1);
for (@val) { s/%([0-9a-fA-F]{2})/pack("C",hex($1))/eg }
if ($ty eq 'U') { undef }
elsif ($ty eq '') { $val[0] }
elsif ($ty eq 'S') { my($obj)=thaw($val[0]); \$obj }
elsif ($ty eq 'R') { my($obj)=thaw($val[0]); \$obj }
elsif ($ty eq 'A') { [map {thaw($_)} @val] }
elsif ($ty eq 'H') {
my($hr) = {};
while (@val) { my($k) = shift @val; $hr->{$k} = thaw(shift @val) }
$hr;
} else { die "Can't thaw object type $ty" }
}
sub ccat_split($) {
my($ccat) = @_; my($major,$minor);
$ccat = $ccat->[0] if ref $ccat; ($major,$minor) = split(/,/,$ccat,-1) if defined $ccat;
!wantarray ? $major : ($major,$minor);
}
sub ccat_maj($) {
my($ccat) = @_; my($major,$minor);
$ccat = $ccat->[0] if ref $ccat; ($major,$minor) = split(/,/,$ccat,-1) if defined $ccat;
$major;
}
sub cmp_ccat($$) {
my($a_maj,$a_min) = split(/,/, shift, -1);
my($b_maj,$b_min) = split(/,/, shift, -1);
$a_maj == $b_maj ? $a_min <=> $b_min : $a_maj <=> $b_maj;
}
sub cmp_ccat_maj($$) {
my($a_maj,$a_min) = split(/,/, shift, -1);
my($b_maj,$b_min) = split(/,/, shift, -1);
$a_maj <=> $b_maj;
}
sub setting_by_given_contents_category_all($@) {
my($ccat,@settings_href_list) = @_; my(@r);
if (!@settings_href_list) {} else {
for my $e ((!defined($ccat) ?() :ref($ccat) ?@$ccat :$ccat), CC_CATCHALL) {
if (grep { defined($_) && exists($_->{$e}) } @settings_href_list) {
my(@slist) = map { !defined($_) || !exists($_->{$e}) ? undef :
do {my($s)=$_->{$e}; ref($s) eq 'CODE' ? &$s : $s}
} @settings_href_list;
push(@r, [$e,@slist]); }
}
}
@r; }
sub setting_by_given_contents_category($@) {
my($ccat,@settings_href_list) = @_; my(@slist);
if (!@settings_href_list) {} else {
for my $e ((!defined($ccat) ?() :ref($ccat) ?@$ccat :$ccat), CC_CATCHALL) {
if (grep { defined($_) && exists($_->{$e}) } @settings_href_list) {
@slist = map { !defined($_) || !exists($_->{$e}) ? undef :
do {my($s)=$_->{$e}; ref($s) eq 'CODE' ? &$s : $s}
} @settings_href_list;
last;
}
}
}
!wantarray ? $slist[0] : @slist; }
sub rmdir_recursively($;$); sub rmdir_recursively($;$) {
my($dir, $exclude_itself) = @_; my($cnt) = 0;
do_log(4,"rmdir_recursively: %s, excl=%s", $dir,$exclude_itself);
local(*DIR); my($errn) = opendir(DIR,$dir) ? 0 : 0+$!;
if ($errn == ENOENT) { die "Directory $dir does not exist," }
elsif ($errn == EACCES) { do_log(3,"rmdir_recursively: enabling read access to directory %s",$dir);
chmod(0750,$dir) or die "Can't change protection-1 on dir $dir: $!";
$errn = opendir(DIR,$dir) ? 0 : 0+$!; }
if ($errn) { die "Can't open directory $dir: $!" }
my(@dirfiles) = readdir(DIR); closedir(DIR) or die "Error closing directory $dir: $!";
for my $f (@dirfiles) {
my($fname) = "$dir/$f";
next if $f eq '.' || $f eq '..';
$errn = lstat($fname) ? 0 : 0+$!;
if ($errn == ENOENT) { die "File \"$fname\" does not exist" }
elsif ($errn == EACCES) { do_log(3,"rmdir_recursively: enabling access to files in dir %s",$dir);
chmod(0750,$dir) or die "Can't change protection-2 on dir $dir: $!";
$errn = lstat($fname) ? 0 : 0+$!; }
if ($errn) { die "File \"$fname\" inaccessible: $!" }
if (-d _) {
rmdir_recursively(untaint($fname), 0);
} else {
$cnt++;
if (unlink(untaint($fname))) {} else { do_log(3,"rmdir_recursively: enabling write access to dir %s",$dir);
my($what) = -l _ ? 'symlink' :-d _ ? 'directory' :'non-regular file';
chmod(0750,$dir) or die "Can't change protection-3 on dir $dir: $!";
unlink(untaint($fname)) or die "Can't remove $what $fname: $!";
}
}
}
section_time("unlink-$cnt-files");
if (!$exclude_itself) {
rmdir($dir) or die "rmdir_recursively: Can't remove directory $dir: $!";
section_time('rmdir');
}
1;
}
sub read_text($;$) {
my($filename, $encoding) = @_;
my($inp) = IO::File->new;
$inp->open($filename,'<') or die "Can't open file $filename for reading: $!";
if ($unicode_aware && defined($encoding) && $encoding ne '') {
binmode($inp, ":encoding($encoding)")
or die "Can't set :encoding($encoding) on file $filename: $!";
}
my($str) = ''; my($nbytes,$buff);
while (($nbytes=$inp->read($buff,16384)) > 0) { $str .= $buff }
defined $nbytes or die "Error reading from $filename: $!";
$inp->close or die "Error closing $filename: $!";
$str;
}
sub read_l10n_templates($;$) {
my($dir) = @_;
if (@_ > 1) { my($l10nlang, $l10nbase) = @_; $dir = "$l10nbase/$l10nlang" }
my($file_chset) = Amavis::Util::read_text("$dir/charset");
local($1,$2);
if ($file_chset =~ m{^(?:\ $file_chset = untaint($1);
} else {
die "Invalid charset $file_chset\n";
}
$Amavis::Conf::notify_sender_templ =
Amavis::Util::read_text("$dir/template-dsn.txt", $file_chset);
$Amavis::Conf::notify_virus_sender_templ =
Amavis::Util::read_text("$dir/template-virus-sender.txt", $file_chset);
$Amavis::Conf::notify_virus_admin_templ =
Amavis::Util::read_text("$dir/template-virus-admin.txt", $file_chset);
$Amavis::Conf::notify_virus_recips_templ =
Amavis::Util::read_text("$dir/template-virus-recipient.txt", $file_chset);
$Amavis::Conf::notify_spam_sender_templ =
Amavis::Util::read_text("$dir/template-spam-sender.txt", $file_chset);
$Amavis::Conf::notify_spam_admin_templ =
Amavis::Util::read_text("$dir/template-spam-admin.txt", $file_chset);
}
sub read_hash(@) {
unshift(@_,{}) if !ref $_[0]; my($hashref, $filename, $keep_case) = @_;
my($lpcs) = c('localpart_is_case_sensitive');
my($inp) = IO::File->new;
$inp->open($filename,'<') or die "Can't open file $filename for reading: $!";
my($ln);
for ($! = 0; defined($ln=$inp->getline); $! = 0) {
chomp($ln);
my($lhs) = ''; my($rhs) = ''; my($at_rhs) = 0; my($trailing_comment) = 0;
for my $t ( $ln =~ /\G ( " (?: \\. | [^"\\] )* " |
[^#" \t]+ | [ \t]+ | . )/gcsx) {
if ($t eq '#') { $trailing_comment = 1; last }
if (!$at_rhs && $t =~ /^[ \t]+\z/) { $at_rhs = 1 }
else { ($at_rhs ? $rhs : $lhs) .= $t }
}
$rhs =~ s/[ \t]+\z// if $trailing_comment ||
$trim_trailing_space_in_lookup_result_fields;
next if $lhs eq '' && $rhs eq '';
my($source_route,$localpart,$domain) =
Amavis::rfc2821_2822_Tools::parse_quoted_rfc2821($lhs,1);
$localpart = lc($localpart) if !$lpcs;
my($addr) = $localpart . lc($domain);
$hashref->{$addr} = $rhs eq '' ? 1 : $rhs;
}
defined $ln || $!==0 or $!==EBADF ? do_log(0,"Error reading from %s: %s", $filename,$!)
: die "Error reading from $filename: $!";
$inp->close or die "Error closing $filename: $!";
$hashref;
}
sub read_array(@) {
unshift(@_,[]) if !ref $_[0]; my($arrref, $filename, $keep_case) = @_;
my($inp) = IO::File->new;
$inp->open($filename,'<') or die "Can't open file $filename for reading: $!";
my($ln);
for ($! = 0; defined($ln=$inp->getline); $! = 0) {
chomp($ln); my($lhs) = '';
for my $t ( $ln =~ /\G ( " (?: \\. | [^"\\] )* " |
[^#" \t]+ | [ \t]+ | . )/gcsx) {
last if $t eq '#';
$lhs .= $t;
}
$lhs =~ s/[ \t]+\z//; # trim trailing whitespace
push(@$arrref, Amavis::rfc2821_2822_Tools::unquote_rfc2821_local($lhs))
if $lhs ne '';
}
defined $ln || $!==0 or $!==EBADF ? do_log(0,"Error reading from %s: %s", $filename,$!)
: die "Error reading from $filename: $!";
$inp->close or die "Error closing $filename: $!";
$arrref;
}
sub dump_hash($) {
my($hr) = @_;
do_log(0, "dump_hash: %s => %s", $_, $hr->{$_}) for (sort keys %$hr);
}
sub dump_array($) {
my($ar) = @_;
do_log(0, "dump_array: %s", $_) for @$ar;
}
sub dynamic_destination($$$) {
my($method,$conn,$force_dynamic) = @_;
my($client_ip) = !defined($conn) ? undef : $conn->client_ip;
if ($method =~ /^[A-Za-z0-9]*:/) {
my(@list); $list[0] = ''; my($j) = 0;
for ($method =~ /\G \[ (?: \\. | [^\]\\] )* \] | " (?: \\. | [^"\\] )* "
| : | [ \t]+ | [^:"\[ \t]+ | . /gcsx) { if ($_ eq ':') { $list[++$j] = '' } else { $list[$j] .= $_ }
};
if ($list[1] =~ m{^/}) {
} else {
my($new_method); my($proto,$relayhost,$relayport) = @list;
($relayhost,$relayport) = ('*','*') if $force_dynamic;
if ($relayhost eq '*') {
do_log(0,"dynamic destination expected, no client IP address: %s",
$method) if $client_ip eq '';
$relayhost = "[$client_ip]";
}
$relayport = $conn->socket_port + 1 if $relayport eq '*';
$list[1] = $relayhost; $list[2] = $relayport;
$new_method = join(':',@list);
if ($new_method ne $method) {
do_log(3, "dynamic destination: %s -> %s", $method,$new_method);
$method = $new_method;
}
}
}
$method;
}
1;
package Amavis::ProcControl;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&exit_status_str &proc_status_ok &kill_proc &cloexec
&run_command &run_command_consumer &run_as_subprocess
&collect_results &collect_results_structured);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(ll do_log prolong_timer); import Amavis::Log qw(open_log close_log log_fd);
}
use subs @EXPORT_OK;
use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS
WTERMSIG WSTOPSIG);
use Errno qw(ENOENT EACCES EAGAIN ESRCH);
use IO::File ();
use Time::HiRes ();
sub exit_status_str($;$) {
my($stat,$errno) = @_; my($str);
if (WIFEXITED($stat)) {
$str = sprintf("exit %d", WEXITSTATUS($stat));
} elsif (WIFSTOPPED($stat)) {
$str = sprintf("stopped, signal %d", WSTOPSIG($stat));
} else {
my($sig) = WTERMSIG($stat);
$str = sprintf("%s, signal %d (%04x)",
$sig == 2 ? 'INTERRUPTED' : $sig == 6 ? 'ABORTED' :
$sig == 9 ? 'KILLED' : $sig == 15 ? 'TERMINATED' : 'DIED',
$sig, $stat);
}
if (defined $errno) { $str .= ', '.$errno if (0+$errno) != 0 || ($errno ne '' && $errno ne '0');
}
$str;
}
sub proc_status_ok($;$@) {
my($exit_status,$errno,@success) = @_;
my($ok) = 0;
if ((!defined $errno || $errno == 0) && WIFEXITED($exit_status)) {
my($j) = WEXITSTATUS($exit_status);
if (!@success) { $ok = $j==0 } elsif (grep {$_ == $j} @success) { $ok = 1 }
}
$ok;
}
sub kill_proc($;$$$$) {
my($pid,$what,$timeout,$proc_fh,$reason) = @_;
$pid >= 0 or die "Shouldn't be killing process groups: [$pid]";
$pid != 1 or die "Shouldn't be killing process 'init': [$pid]";
$what = defined $what ? " running $what" : '';
$reason = defined $reason ? " (reason: $reason)" : '';
my($n) = kill(0,$pid); if ($n == 0 && $! != ESRCH) {
die sprintf("Can't send SIG 0 to process [%s]%s: %s", $pid,$what,$!);
} elsif ($n == 0) {
do_log(2, "no need to kill process [%s]%s, already gone", $pid,$what);
} else {
do_log(-1,"killing process [%s]%s%s", $pid,$what,$reason);
kill('TERM',$pid) or $! == ESRCH or die sprintf("Can't send SIGTERM to process [%s]%s: %s",$pid,$what,$!);
}
$proc_fh->close if defined $proc_fh;
my($child_stat) = defined $pid && waitpid($pid,WNOHANG) > 0 ? $? : undef;
$n = kill(0,$pid); if ($n > 0 && defined($timeout) && $timeout > 0) {
sleep($timeout); $n = kill(0,$pid); }
if ($n == 0 && $! != ESRCH) {
die sprintf("Can't send SIG 0 to process [%s]%s: %s", $pid,$what,$!);
} elsif ($n > 0) { do_log(-1,"process [%s]%s is still alive, using a bigger hammer",
$pid,$what);
kill('KILL',$pid) or $! == ESRCH
or die sprintf("Can't send SIGKILL to process [%s]%s: %s",$pid,$what,$!);
}
}
sub cloexec($;$$) { undef }
sub open_on_specific_fd($$$$) {
my($fd_target,$fname,$flags,$mode) = @_;
my($fd_got); my($logging_safe) = 0;
if (ll(5)) {
my($log_fd) = log_fd();
$logging_safe = 1 if !defined($log_fd) || $log_fd > 2;
}
local($1);
if ($fname =~ /^&=?(\d+)\z/) { $fd_got = $1 } my($flags_displayed) = $flags == &POSIX::O_RDONLY ? '<'
: $flags == &POSIX::O_WRONLY ? '>' : $flags;
if (!defined($fd_got) || $fd_got != $fd_target) {
do_log(5, "open_on_specific_fd: target fd%s closing, to become %s %s",
$fd_target,$flags_displayed,$fname) if $logging_safe;
POSIX::close($fd_target); }
if (!defined($fd_got)) { $fd_got = POSIX::open($fname,$flags,$mode);
defined $fd_got or die "Can't open $fname: $!";
$fd_got = 0 + $fd_got; }
if ($fd_got != $fd_target) { eval { do_log(5, "open_on_specific_fd: target fd%s dup2 from fd%s %s %s",
$fd_target,$fd_got,$flags_displayed,$fname) if $logging_safe;
};
defined POSIX::dup2($fd_got,$fd_target)
or die "Can't dup2 from $fd_got to $fd_target: $!";
if ($fd_got > 2) { my($err); defined POSIX::close($fd_got) or $err = $!;
$err = defined $err ? ": $err" : '';
eval { do_log(5, "open_on_specific_fd: source fd%s closed%s",
$fd_got,$err) if $logging_safe;
};
}
}
$fd_got;
}
sub release_parent_resources() {
$Amavis::sql_dataset_conn_lookups->dbh_inactive(1)
if $Amavis::sql_dataset_conn_lookups;
$Amavis::sql_dataset_conn_storage->dbh_inactive(1)
if $Amavis::sql_dataset_conn_storage;
}
sub run_command($$@) {
my($stdin_from, $stderr_to, $cmd, @args) = @_;
my($cmd_text) = join(' ', $cmd, @args);
$stdin_from = '/dev/null' if $stdin_from eq '';
$stderr_to = '&1' if !defined($stderr_to) || $stderr_to eq ''; my($msg) = join(' ', $cmd, @args, "<$stdin_from", "2>$stderr_to");
my($proc_fh) = IO::File->new; my($child_out_fh) = IO::File->new; pipe($proc_fh,$child_out_fh)
or die "run_command: Can't create a pipe: $!";
my($pid);
eval {
$pid = fork(); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die "run_command (forking): $eval_stat";
};
defined($pid) or die "run_command: can't fork: $!";
if (!$pid) { alarm(0); my($interrupt) = '';
my($h1) = sub { $interrupt = $_[0] };
my($h2) = sub { die "Received signal ".$_[0] };
@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)} = ($h1) x 7;
eval { local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
$proc_fh->close or die "Child can't close parent side of a pipe: $!";
release_parent_resources();
open_on_specific_fd(0, $stdin_from, &POSIX::O_RDONLY, 0);
open_on_specific_fd(1, '&='.fileno($child_out_fh), &POSIX::O_WRONLY, 0);
open_on_specific_fd(2, $stderr_to, &POSIX::O_WRONLY, 0);
exec {$cmd} ($cmd,@args);
die "run_command: failed to exec $cmd_text: $!";
};
my($err) = $@ ne '' ? $@ : "errno=$!"; chomp $err;
eval {
local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
open_log(); do_log(-1,"run_command: child process [%s]: %s", $$,$err);
};
{ no warnings;
POSIX::_exit(6); kill('KILL',$$); exit 1; }
}
ll(5) && do_log(5,"run_command: [%s] %s", $pid,$msg);
$child_out_fh->close
or die "Parent failed to close child side of the pipe: $!";
binmode($proc_fh) or die "Can't set pipe to binmode: $!"; ($proc_fh, $pid); }
sub run_command_consumer($$@) {
my($stdout_to, $stderr_to, $cmd, @args) = @_;
my($cmd_text) = join(' ', $cmd, @args);
$stdout_to = '/dev/null' if $stdout_to eq '';
$stderr_to = '&1' if !defined($stderr_to) || $stderr_to eq ''; my($msg) = join(' ', $cmd, @args, ">$stdout_to", "2>$stderr_to");
my($proc_fh) = IO::File->new; my($child_in_fh) = IO::File->new; pipe($child_in_fh,$proc_fh)
or die "run_command_consumer: Can't create a pipe: $!";
my($pid);
eval {
$pid = fork(); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die "run_command_consumer (fork): $eval_stat";
};
defined($pid) or die "run_command_consumer: can't fork: $!";
if (!$pid) { alarm(0); my($interrupt) = '';
my($h1) = sub { $interrupt = $_[0] };
my($h2) = sub { die "Received signal ".$_[0] };
@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)} = ($h1) x 7;
eval { local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
$proc_fh->close or die "Child can't close parent side of a pipe: $!";
release_parent_resources();
open_on_specific_fd(0, '&='.fileno($child_in_fh), &POSIX::O_RDONLY, 0);
open_on_specific_fd(1, $stdout_to, &POSIX::O_WRONLY, 0);
open_on_specific_fd(2, $stderr_to, &POSIX::O_WRONLY, 0);
exec {$cmd} ($cmd,@args);
die "run_command_consumer: failed to exec $cmd_text: $!";
};
my($err) = $@ ne '' ? $@ : "errno=$!"; chomp $err;
eval {
local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
open_log(); do_log(-1,"run_command_consumer: child process [%s]: %s", $$,$err);
};
{ no warnings;
POSIX::_exit(6); kill('KILL',$$); exit 1; }
}
ll(5) && do_log(5,"run_command_consumer: [%s] %s", $pid,$msg);
$child_in_fh->close
or die "Parent failed to close child side of the pipe: $!";
binmode($proc_fh) or die "Can't set pipe to binmode: $!"; $proc_fh->autoflush(1);
($proc_fh, $pid); }
sub run_as_subprocess($@) {
my($code,@args) = @_;
my($remaining_time) = alarm(0); my($proc_fh) = IO::File->new; my($child_out_fh) = IO::File->new; pipe($proc_fh,$child_out_fh)
or die "run_as_subprocess: Can't create a pipe: $!";
my($pid);
eval {
$pid = fork(); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die "run_as_subprocess (forking): $eval_stat";
};
defined($pid) or die "run_as_subprocess: can't fork: $!";
if (!$pid) { my($t0) = Time::HiRes::time; my(@result); my($interrupt) = '';
my($h1) = sub { $interrupt = $_[0] };
my($h2) = sub { die "Received signal ".$_[0] };
@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)} = ($h1) x 7;
$SIG{PIPE} = 'IGNORE'; $0 = 'sub-' . $0; my($eval_stat);
eval { local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
prolong_timer("child[$$]", $remaining_time); $proc_fh->close or die "Child can't close parent side of a pipe: $!";
binmode($child_out_fh) or die "Can't set pipe to binmode: $!";
release_parent_resources();
close STDOUT; open(STDOUT, '>&'.fileno($child_out_fh))
or die "Child can't dup pipe to STDOUT: $!";
binmode(STDOUT) or die "Can't set STDOUT to binmode: $!";
ll(5) && do_log(5,"[%s] run_as_subprocess: running as child, ".
"stdin=%s, stdout=%s, pipe=%s", $$, fileno(STDIN),
fileno(STDOUT), fileno($child_out_fh));
@result = &$code(@args); 1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
my($dt) = Time::HiRes::time - $t0;
eval { local(@SIG{qw(INT HUP TERM TSTP QUIT USR1 USR2)}) = ($h2) x 7;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
my($status); my($ll) = 3;
if (defined $eval_stat) { chomp $eval_stat; $ll = -2;
$status = sprintf("STATUS: FAILURE %s", $eval_stat);
} else { $status = sprintf("STATUS: SUCCESS, %d results", scalar(@result));
};
my($frozen) = Amavis::Util::freeze([$status,@result]);
ll($ll) && do_log($ll, "[%s] run_as_subprocess: child done (%.1f ms), ".
"sending results: res_len=%d, %s",
$$, $dt*1000, length($frozen), $status);
local $SIG{PIPE} = sub { die "Broken pipe\n" }; $child_out_fh->print($frozen) or die "Can't write result to pipe: $!";
$child_out_fh->close or die "Child can't close its side of a pipe: $!";
close STDOUT or die "Child can't close its STDOUT: $!";
POSIX::_exit(0); };
my($eval2_stat) = $@ ne '' ? $@ : "errno=$!";
eval {
chomp $eval2_stat;
if ($interrupt ne '') { my($i) = $interrupt; $interrupt = ''; die $i }
my($ll) = $eval2_stat =~ /^Broken pipe\b/ ? 1 : -1;
do_log($ll,"run_as_subprocess: child process [%s]: %s", $$,$eval2_stat);
};
POSIX::_exit(6); }
ll(5) && do_log(5,"run_as_subprocess: spawned a subprocess [%s]", $pid);
$child_out_fh->close
or die "Parent failed to close child side of the pipe: $!";
binmode($proc_fh) or die "Can't set pipe to binmode: $!"; prolong_timer('run_as_subprocess', $remaining_time); ($proc_fh, $pid); }
sub collect_results($$;$$$) {
my($proc_fh,$pid, $what,$results_max_size,$success_list_ref) = @_;
my($child_stat); my($close_err) = 0; my($pid_orig) = $pid;
my($result) = ''; my($result_l) = 0; my($skipping) = 0; my($eval_stat);
eval { my($nbytes,$buff);
while (($nbytes=$proc_fh->read($buff,16384)) > 0) {
if (!defined($results_max_size)) { $result .= $buff } elsif ($results_max_size == 0 || $skipping) {} elsif ($result_l <= $results_max_size) { $result .= $buff }
else {
$skipping = 1; do_log(-1,'collect_results from [%s] (%s): results size limit '.
'(%d bytes) exceeded', $pid_orig,$what,$results_max_size);
}
$result_l += $nbytes;
}
defined $nbytes or die "Error reading from a subprocess [$pid_orig]: $!";
ll(5) && do_log(5,'collect_results from [%s] (%s), %d bytes, (limit %s)',
$pid_orig,$what,$result_l,$results_max_size);
1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
if ($results_max_size > 0 && length($result) > $results_max_size)
{ $result = substr($result,0,$results_max_size) . "..." }
if (defined $eval_stat) { chomp $eval_stat;
undef $_[0]; kill_proc($pid,$what,1,$proc_fh, "on reading: $eval_stat") if defined $pid;
undef $proc_fh; undef $pid;
die "collect_results - reading aborted: $eval_stat";
}
undef $eval_stat;
eval {
$proc_fh->close or $close_err = $!;
$child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
undef $proc_fh; undef $pid;
undef $_[0]; 1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
undef $_[0]; kill_proc($pid,$what,1,$proc_fh, "on closing: $eval_stat") if defined $pid;
undef $proc_fh; undef $pid;
die "collect_results - closing aborted: $eval_stat";
};
if (defined $success_list_ref) {
proc_status_ok($child_stat,$close_err, @$success_list_ref)
or do_log(-2, 'collect_results from [%s] (%s): %s %s', $pid_orig,$what,
exit_status_str($child_stat,$close_err), $result);
} elsif ($close_err != 0) {
die "Can't close pipe to subprocess [$pid_orig]: $close_err";
}
(\$result,$child_stat);
}
sub collect_results_structured($$;$$) {
my($proc_fh,$pid, $what,$results_max_size) = @_;
my($result_ref,$child_stat) =
collect_results($proc_fh,$pid, $what,$results_max_size,[0]);
my($result_ref) = Amavis::Util::thaw($$result_ref);
my(@result) = !ref($result_ref) ? () : @$result_ref;
@result >= 1
or die "collect_results_structured: no results from subprocess [$pid]";
my($status) = shift(@result);
$status =~ /^STATUS: (?:SUCCESS|FAILURE)\b/
or die "collect_results_structured: subprocess [$pid] returned: $status";
(\@result,$child_stat);
}
1;
package Amavis::rfc2821_2822_Tools;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT = qw(
&rfc2822_timestamp &iso8601_timestamp &iso8601_utc_timestamp &iso8601_week
&format_time_interval &make_received_header_field &parse_received
&fish_out_ip_from_received &parse_message_id
&split_address &split_localpart &replace_addr_fields &make_query_keys
"e_rfc2821_local &qquote_rfc2821_local
&parse_quoted_rfc2821 &unquote_rfc2821_local &parse_address_list
&wrap_string &wrap_smtp_resp &one_response_for_all
&EX_OK &EX_NOUSER &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM);
import Amavis::Conf qw(:platform c cr ca $myproduct_name);
import Amavis::Util qw(ll do_log unique_list);
}
use subs @EXPORT;
use POSIX qw(locale_h strftime);
BEGIN {
eval { require 'sysexits.ph' }; do { sub EX_OK() {0} } unless defined(&EX_OK);
do { sub EX_NOUSER() {67} } unless defined(&EX_NOUSER);
do { sub EX_UNAVAILABLE() {69} } unless defined(&EX_UNAVAILABLE);
do { sub EX_TEMPFAIL() {75} } unless defined(&EX_TEMPFAIL);
do { sub EX_NOPERM() {77} } unless defined(&EX_NOPERM);
}
sub get_zone_offset($) {
my($t) = @_;
my($d) = 0; for (1..3) { my($r) = sprintf("%04d%02d%02d", (localtime($t))[5, 4, 3]) cmp
sprintf("%04d%02d%02d", (gmtime($t + $d))[5, 4, 3]);
if ($r == 0) { last } else { $d += $r * 24 * 3600 }
}
my($sl,$su) = (0,0);
for ((localtime($t))[2,1,0]) { $sl = $sl * 60 + $_ }
for ((gmtime($t + $d))[2,1,0]) { $su = $su * 60 + $_ }
$d += $sl - $su; my($sign) = $d >= 0 ? '+' : '-';
$d = -$d if $d < 0;
$d = int(($d + 30) / 60.0); sprintf("%s%02d%02d", $sign, int($d / 60), $d % 60);
}
sub rfc2822_timestamp($) {
my($t) = @_;
my(@lt) = localtime($t);
my($zone_name) = strftime("%Z",@lt);
my($s) = strftime("%a, %e %b %Y %H:%M:%S ", @lt);
$s .= get_zone_offset($t);
$s .= " (" . $zone_name . ")" if $zone_name !~ /^\s*\z/;
$s;
}
sub iso8601_timestamp($;$$$) {
my($t,$suppress_zone,$dtseparator,$with_field_separators) = @_;
my($fmt) = $with_field_separators ? "%Y-%m-%dT%H:%M:%S" : "%Y%m%dT%H%M%S";
$fmt =~ s/T/$dtseparator/ if defined $dtseparator;
my($s) = strftime($fmt,localtime($t));
$s .= get_zone_offset($t) unless $suppress_zone;
$s;
}
sub iso8601_utc_timestamp($;$$$) {
my($t,$suppress_zone,$dtseparator,$with_field_separators) = @_;
my($fmt) = $with_field_separators ? "%Y-%m-%dT%H:%M:%S" : "%Y%m%dT%H%M%S";
$fmt =~ s/T/$dtseparator/ if defined $dtseparator;
my($s) = strftime($fmt,gmtime($t));
$s .= 'Z' unless $suppress_zone;
$s;
}
sub iso8601_week($) {
my($unix_time) = @_;
my($y,$dowm0,$doy0) = (localtime($unix_time))[5,6,7];
$y += 1900; $dowm0--; $dowm0=6 if $dowm0<0; my($dow0101) = ($dowm0 - $doy0 + 53*7) % 7; my($wn) = int(($doy0 + $dow0101) / 7);
if ($dow0101 < 4) { $wn++ }
if ($wn == 0) { $wn = iso8601_year_is_long($y-1) ? 53 : 52 }
elsif ($wn == 53 && !iso8601_year_is_long($y)) { $wn = 1 }
$wn;
}
sub iso8601_year_is_long($) {
my($y) = @_;
my($p) = $y + int($y/4) - int($y/100) + int($y/400);
if (($p % 7) == 4) { return 1 }
$y--; $p = $y + int($y/4) - int($y/100) + int($y/400);
if (($p % 7) == 3) { return 1 } else { return 0 }
}
sub format_time_interval($) {
my($t) = @_;
return 'undefined' if !defined $t;
my($sign) = ''; if ($t < 0) { $sign = '-'; $t = - $t };
my($dd) = int($t / (24*3600)); $t = $t - $dd*(24*3600);
my($hh) = int($t / 3600); $t = $t - $hh*3600;
my($mm) = int($t / 60); $t = $t - $mm*60;
sprintf("%s%d %d:%02d:%02d", $sign,$dd,$hh,$mm,int($t+0.5));
}
sub make_received_header_field($$$$) {
my($conn, $msginfo, $id, $folded) = @_;
my($smtp_proto, $recips) = ($conn->appl_proto, $msginfo->recips);
my($client_ip) = $conn->client_ip;
if ($client_ip =~ /:/ && $client_ip !~ /^IPv6:/i) {
$client_ip = 'IPv6:' . $client_ip; }
my($tls) = $msginfo->tls_cipher;
my($s) = sprintf("from %s%s%s\n by %s%s (%s, %s)",
$conn->smtp_helo eq '' ? 'unknown' : $conn->smtp_helo,
$client_ip eq '' ? '' : " ([$client_ip])",
!defined $tls ? '' : " (using TLS with cipher $tls)",
c('localhost_name'),
$conn->socket_ip eq '' ? ''
: sprintf(" (%s [%s])", c('myhostname'), $conn->socket_ip),
$myproduct_name,
$conn->socket_port eq '' ? 'unix socket' : "port ".$conn->socket_port);
$s .= "\n with $smtp_proto" if $smtp_proto=~/^(ES|S|L)MTPS?A?\z/i; $s .= "\n id $id" if $id ne '';
$s .= "\n for " . qquote_rfc2821_local(@$recips) if @$recips == 1;
$s .= ";\n " . rfc2822_timestamp($msginfo->rx_time);
$s =~ s/\n//g if !$folded;
$s;
}
sub parse_received($) {
local($_) = $_[0]; my(%fld);
local($1); tr/\n//d; # unfold, chomp
my($comm_lvl) = 0; my($in_option) = '';
my($in_ext_dom) = 0; my($in_tcp_info) = 0;
my($in_qcontent) = 0; my($in_literal) = 0; my($in_angle) = 0;
my($str_l) = length($_); my($new_pos);
for (my $pos=-1; $new_pos=pos($_), $new_pos<$str_l; $pos=$new_pos) {
$new_pos > $pos or die "parse_received PANIC1 $new_pos"; if ($comm_lvl > 0 && /\G( \) )/gcsx) {
if ($comm_lvl > 1 || $in_tcp_info) { $fld{$in_option} .= $1 } if ($comm_lvl == 1 && !$in_tcp_info) { $in_option =~ s/-com\z// }
$comm_lvl--; next; }
if ($in_tcp_info && /\G( \) )/gcsx) { $in_option =~ s/-tcp\z//; $in_tcp_info = 0; $in_ext_dom = 4; next }
if (!$in_qcontent && !$in_literal && !$comm_lvl &&
!$in_tcp_info && $in_ext_dom==1 && /\G( \( )/gcsx) {
$in_option .= '-tcp'; $in_tcp_info = 1; $in_ext_dom = 2; next;
}
if (!$in_qcontent && !$in_literal && /\G( \( )/gcsx) {
$comm_lvl++; if ($comm_lvl > 1 || $in_tcp_info) { $fld{$in_option} .= $1 } if ($comm_lvl == 1 && !$in_tcp_info) { $in_option .= '-com';
$fld{$in_option} .= ' ' if defined $fld{$in_option}; }
next;
}
if ($comm_lvl > 0 && /\G( \\. )/gcsx) { $fld{$in_option} .= $1; next }
if ($comm_lvl > 0 && /\G( [^()\\]+ )/gcsx) { $fld{$in_option} .= $1; next }
if ($in_qcontent && /\G( " )/gcsx) # normal exit from qcontent
{ $in_qcontent = 0; $fld{$in_option} .= $1; next }
if ($in_qcontent && /\G( > )/gcsx) # bail out of qcontent
{ $in_qcontent = 0; $in_angle = 0; $fld{$in_option} .= $1; next }
if ($in_qcontent && /\G( \\. )/gcsx) { $fld{$in_option} .= $1; next }
if ($in_qcontent && /\G( [^"\\>]+ )/gcsx) { $fld{$in_option} .= $1; next }
if ($in_literal && /\G( \] )/gcsx)
{ $in_literal = 0; $fld{$in_option} .= $1; next }
if ($in_literal && /\G( > )/gcsx) { $in_literal = 0; $in_angle = 0; $fld{$in_option} .= $1; next }
if (!$comm_lvl && !$in_qcontent && /\G( \[ )/gcsx)
{ $in_literal = 1; $fld{$in_option} .= $1; next }
if ($in_literal && /\G( \\. )/gcsx) { $fld{$in_option} .= $1; next }
if ($in_literal && /\G( [^\]\\>]+ )/gcsx) { $fld{$in_option} .= $1; next }
if (!$comm_lvl && !$in_qcontent && !$in_literal && !$in_tcp_info) { if (!$in_angle && /\G( < )/gcsx)
{ $in_angle = 1; $fld{$in_option} .= $1; next }
if ( $in_angle && /\G( > )/gcsx)
{ $in_angle = 0; $fld{$in_option} .= $1; next }
if (!$in_angle && /\G (from|by) (?:[ \t]+|\z|(?=[\[\(",;<]))/gcsxi)
{ $in_option = lc($1); $in_ext_dom = 1; next }
if (!$in_angle &&/\G (via|with|id|for)(?:[ \t]+|\z|(?=[\[\(",;<]))/gcsxi)
{ $in_option = lc($1); $in_ext_dom = 0; next }
if (!$in_angle &&/\G( ; )/gcsxi)
{ $in_option = lc($1); $in_ext_dom = 0; next }
if (/\G( [ \t]+ )/gcsx) { $fld{$in_option} .= $1; next }
if (/\G( [^ \t,:;\@<>()"\[\]\\]+ )/gcsx) { $fld{$in_option} .= $1; next }
}
if (/\G( . )/gcsx) { $fld{$in_option} .= $1; next } # other junk
die "parse_received PANIC2 $new_pos"; # just in case
}
for my $f ('from-tcp','by-tcp') {
# a tricky part is handling the syntax:
# (Domain/Addr-literal) [ FWS "(" [ Domain FWS ] Addr-literal ")" ] CFWS
# where absence of Address-literal in TCP-info means that what looked
# like a domain in the optional TCP-info, is actually a comment in CFWS
local($_) = $fld{$f};
if (!defined($_)) {}
elsif (/\[ (\d{1,3} (?: \. \d{1,3}){3}) \] /x) {}
elsif (/\[ [^\]]* : [^\]]* \]/x && # triage, must contain a colon
/\[ (?: IPv6: )? [0-9a-f]{0,4}
(?: : [0-9a-f]{0,4} | \. [0-9]{1,3} ){2,9} \]/xi) {}
# elsif (/ (?: ^ | \D ) ( \d{1,3} (?: \. \d{1,3}){3}) (?! [0-9.] ) /x) {}
elsif (/^(?: localhost | ( [a-z0-9_\/+-]{1,63} \. )+ [a-z-]{2,} )\b/xi) {}
else {
my($fc) = $f; $fc =~ s/-tcp\z/-com/;
$fld{$fc} = '' if !defined $fld{$fc};
$fld{$fc} = $_ . (/[ \t]\z/||$fld{$fc}=~/^[ \t]/?'':' ') .$fld{$fc};
delete $fld{$f};
}
}
for (values %fld) { s/[ \t]+\z//; s/^[ \t]+// }
# for my $f (sort {$s{$a}<=>$s{$b}} keys %fld)
# { do_log(5, "%-8s -> /%s/", $f,$fld{$f}) }
\%fld;
}
sub fish_out_ip_from_received($) {
my($received) = @_;
my($fields_ref) = parse_received($received);
my($ip); local($1);
for (grep {defined} (@$fields_ref{qw(from-tcp from from-com)})) {
if (/ \[ (\d{1,3} (?: \. \d{1,3}){3}) (?: \. \d{4,5} )? \] /x) {
$ip = $1; last;
} elsif (/\[ [^\]]* : [^\]]* \]/x && # triage, must contain a colon
/\[ ( (?: IPv6: )? [0-9a-f]{0,4}
(?: : [0-9a-f]{0,4} | \. [0-9]{1,3} ){2,9} ) \]/xi) {
$ip = $1; last;
} elsif (/ (?: ^ | \D ) ( \d{1,3} (?: \. \d{1,3}){3}) (?! [0-9.] ) /x) {
$ip = $1; last;
}
}
do_log(5, "fish_out_ip_from_received: %s", $ip) if defined $ip;
!defined($ip) ? undef : $ip; # undef need not be tainted
}
# Splits unquoted fully qualified e-mail address, or an address
# with a missing domain part. Returns a pair: (localpart, domain).
# The domain part (if nonempty) includes the '@' as the first character.
# If the syntax is badly broken, everything ends up as a localpart.
# The domain part can be an address literal, as specified by rfc2822.
# Does not handle explicit route paths, use parse_quoted_rfc2821 for that.
#
sub split_address($) {
my($mailbox) = @_; local($1,$2);
$mailbox =~ /^ (.*?) ( \@ (?: \[ (?: \\. | [^\]\\] ){0,999} (?: \] | \z)
| [^\[\@] )*
) \z/xs ? ($1, $2) : ($mailbox, '');
}
# split_localpart() splits localpart of an e-mail address at the first
# occurrence of the address extension delimiter character. (based on
# equivalent routine in Postfix)
#
# Reserved addresses are not split: postmaster, mailer-daemon,
# double-bounce. Addresses that begin with owner-, or addresses
# that end in -request are not split when the owner_request_special
# parameter is set.
sub split_localpart($$) {
my($localpart, $delimiter) = @_;
my($owner_request_special) = 1; # configurable ???
my($extension); local($1,$2);
if ($localpart =~ /^(postmaster|mailer-daemon|double-bounce)\z/i) {
# do not split these, regardless of what the delimiter is
} elsif ($delimiter eq '-' && $owner_request_special &&
$localpart =~ /^owner-.|.-request\z/si) {
# don't split owner-foo or foo-request
} elsif ($localpart =~ /^(.+?)(\Q$delimiter\E.*)\z/s) {
($localpart, $extension) = ($1, $2); # extension includes a delimiter
# do not split the address if the result would have a null localpart
}
($localpart, $extension);
}
# replace localpart/extension/domain fields of an original email address
# with nonempty fields of a replacement
#
sub replace_addr_fields($$;$) {
my($orig_addr, $repl_addr, $delim) = @_;
my($localpart_o, $domain_o, $ext_o, $localpart_r, $domain_r, $ext_r);
($localpart_o,$domain_o) = split_address($orig_addr);
($localpart_r,$domain_r) = split_address($repl_addr);
$localpart_r = $localpart_o if $localpart_r eq '';
$domain_r = $domain_o if $domain_r eq '';
if ($delim ne '') {
($localpart_o,$ext_o) = split_localpart($localpart_o,$delim);
($localpart_r,$ext_r) = split_localpart($localpart_r,$delim);
$ext_r = $ext_o if !defined $ext_r;
}
$localpart_r . (defined $ext_r ? $ext_r : '') . $domain_r;
}
# given a (potentially multiline) header field Message-ID, Resent-Message-ID.
# In-Reply-To, or References, parse the rfc5322 (rfc2822) syntax extracting
# all message IDs while ignoring comments, and return them as a list
# See also: rfc2392 - Content-ID and Message-ID Uniform Resource Locators
#
sub parse_message_id($) {
my($str) = @_;
$str =~ tr/\n//d; my(@message_id); my($garbage) = 0;
$str =~ s/[ \t]+/ /g; # compress whitespace as a quickfix/bandaid
for my $t ( $str =~ /\G ( [ \t]+ | \( (?: \\. | [^()\\] ){0,999} \) |
< (?: " (?: \\. | [^"\\>] ){0,999} " |
\[ (?: \\. | [^\]\\>]){0,999} \] |
[^"<>\[\]\\]+ )* > |
[^<( \t]+ | . )/gcsx ) {
if ($t =~ /^<.*>\z/) { push(@message_id,$t) }
elsif ($t =~ /^[ \t]*\z/) {} # ignore FWS
elsif ($t =~ /^\(.*\)\z/) # ignore CFWS
{ do_log(2, "parse_message_id ignored comment: /%s/ in %s", $t,$str) }
else { $garbage = 1 }
}
if (@message_id > 1) {
@message_id = unique_list(\@message_id); # remove possible duplicates
} elsif ($garbage && !@message_id) {
local($_) = $str; s/^[ \t]+//; s/[ \t\n]+\z//; # trim and sanitize <...>
s/^<//; s/>\z//; s/>/_/g; $_ = '<'.$_.'>'; @message_id = ($_);
do_log(5, "parse_message_id sanitizing garbage: /%s/ to %s", $str,$_);
}
@message_id;
}
# For a given email address (e.g. for User+Foo@sub.exAMPLE.CoM)
# prepare and return a list of lookup keys in the following order:
# User+Foo@sub.exAMPLE.COM (as-is, no lowercasing)
# user+foo@sub.example.com
# user@sub.example.com (only if $recipient_delimiter nonempty)
# user+foo(@) (only if $include_bare_user)
# user(@) (only if $include_bare_user and $recipient_delimiter nonempty)
# (@)sub.example.com
# (@).sub.example.com
# (@).example.com
# (@).com
# (@).
# Note about (@): if $at_with_user is true the user-only keys (without domain)
# get an '@' character appended (e.g. 'user+foo@'). Usual for lookup_hash.
# If $at_with_user is false the domain-only (without localpart) keys
# get a '@' prepended (e.g. '@.example.com'). Usual for SQL and LDAP lookups.
#
# The domain part is lowercased in all but the first item in the resulting
# list; the localpart is lowercased iff $localpart_is_case_sensitive is true.
#
sub make_query_keys($$$;$) {
my($addr,$at_with_user,$include_bare_user,$append_string) = @_;
my($localpart,$domain) = split_address($addr); $domain = lc($domain);
my($saved_full_localpart) = $localpart;
$localpart = lc($localpart) if !c('localpart_is_case_sensitive');
# chop off leading @, and trailing dots
local($1);
$domain = $1 if $domain =~ /^\@?(.*?)\.*\z/s;
my($extension); my($delim) = c('recipient_delimiter');
if ($delim ne '') {
($localpart,$extension) = split_localpart($localpart,$delim);
# extension includes a delimiter since amavisd-new-2.5.0!
}
$extension = '' if !defined $extension; # mute warnings
my($append_to_user,$prepend_to_domain) = $at_with_user ? ('@','') : ('','@');
my(@keys); # a list of query keys
push(@keys, $addr); # as is
push(@keys, $localpart.$extension.'@'.$domain)
if $extension ne ''; # user+foo@example.com
push(@keys, $localpart.'@'.$domain); # user@example.com
if ($include_bare_user) { # typically enabled for local users only
push(@keys, $localpart.$extension.$append_to_user)
if $extension ne ''; # user+foo(@)
push(@keys, $localpart.$append_to_user); # user(@)
}
push(@keys, $prepend_to_domain.$domain); # (@)sub.example.com
if ($domain =~ /\[/) { # don't split address literals
push(@keys, $prepend_to_domain.'.'); # (@).
} else {
my(@dkeys); my($d) = $domain;
for (;;) { # (@).sub.example.com (@).example.com (@).com (@).
push(@dkeys, $prepend_to_domain.'.'.$d);
last if $d eq '';
$d = ($d =~ /^([^.]*)\.(.*)\z/s) ? $2 : '';
}
if (@dkeys > 10) { @dkeys = @dkeys[$#dkeys-9 .. $#dkeys] } # sanity limit
push(@keys,@dkeys);
}
if (defined $append_string && $append_string ne '') {
$_ .= $append_string for @keys;
}
my($keys_ref) = []; # remove duplicates
for my $k (@keys) { push(@$keys_ref,$k) if !grep {$k eq $_} @$keys_ref }
ll(5) && do_log(5,"query_keys: %s", join(', ',@$keys_ref));
# the rhs replacement strings are similar to what would be obtained
# by lookup_re() given the following regular expression:
# /^( ( ( [^\@]*? ) ( \Q$delim\E [^\@]* )? ) (?: \@ (.*) ) )$/xs
my($rhs) = [ # a list of right-hand side replacement strings
$addr, # $1 = User+Foo@Sub.Example.COM
$saved_full_localpart, # $2 = User+Foo
$localpart, # $3 = user
$extension, # $4 = +foo
$domain, # $5 = sub.example.com
];
($keys_ref, $rhs);
}
# quote_rfc2821_local() quotes the local part of a mailbox address
# (given in internal (unquoted) form), and returns external (quoted)
# mailbox address, as per rfc5321 (ex rfc2821).
#
# internal (unquoted) form is used internally by amavisd-new and other mail sw,
# external (quoted) form is used in SMTP commands and in message header section
#
# To re-insert message back via SMTP, the local-part of the address needs
# to be quoted again if it contains reserved characters or otherwise
# does not obey the dot-atom syntax, as specified in rfc5321 (ex rfc2821).
#
sub quote_rfc2821_local($) {
my($mailbox) = @_;
# atext: any character except controls, SP, and specials (rfc2821/rfc2822)
my($atext) = "a-zA-Z0-9! my($localpart,$domain) = split_address($mailbox);
if ($localpart !~ /^[$atext]+(\.[$atext]+)*\z/so) { local($1); $localpart =~ s/([\000-\037\177-\377"\\])/\\$1/g; # quote non-qtext
$localpart = '"'.$localpart.'"'; # make it a qcontent
# Postfix hates ""@domain but is not so harsh on @domain
# Late breaking news: don't bother, both forms are rejected by Postfix
# when strict_rfc821_envelopes=yes, and both are accepted otherwise
}
# we used to strip off empty domain (just '@') unconditionally, but this
# leads Postfix to interpret an address with a '@' in the quoted local part
# e.g. <"h@example.net"@> as <hhh@example.net> (subject to Postfix setting
# 'resolve_dequoted_address'), which is not what the sender requested;
# we no longer do that if localpart contains an '@':
$domain = '' if $domain eq '@' && $localpart =~ /\@/;
$localpart . $domain;
}
# wraps the result of quote_rfc2821_local into angle brackets <...> ;
# If given a list, it returns a list (possibly converted to
# comma-separated scalar if invoked in scalar context), quoting each element;
#
sub qquote_rfc2821_local(@) {
my(@r) = map { $_ eq '' ? '<>' : ('<' . quote_rfc2821_local($_) . '>') } @_;
wantarray ? @r : join(', ', @r);
}
sub parse_quoted_rfc2821($$) {
my($addr,$unquote) = @_;
# the angle-bracket stripping is not really a duty of this subroutine,
# as it should have been already done elsewhere, but we allow it here anyway:
$addr =~ s/^\s*<//s; $addr =~ s/>\s*\z//s; # tolerate unmatched angle brkts
local($1,$2); my($source_route,$localpart,$domain) = ('','','');
# RFC 2821: so-called "source route" MUST BE accepted,
# SHOULD NOT be generated, and SHOULD be ignored.
# Path = "<" [ A-d-l ":" ] Mailbox ">"
# A-d-l = At-domain *( "," A-d-l )
# At-domain = "@" domain
if (index($addr,':') >= 0 && # triage before more testing for source route
$addr =~ m{^ ( [ \t]* \@ (?: [0-9A-Za-z.!\#\$%&*/^{}=_+-]* |
\[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]*
(?: , [ \t]* \@ (?: [0-9A-Za-z.!\#\$%&*/^{}=_+-]* |
\[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]* )*
: [ \t]* ) (.*) \z }xs)
{ # NOTE: we are quite liberal on allowing whitespace around , and : here,
# and liberal in allowed character set and syntax of domain names,
# we mainly avoid stop-characters in the domain names of source route
$source_route = $1; $addr = $2;
}
if ($addr =~ m{^ ( .*? )
( \@ (?: [^\@\[\]]+ | \[ (?: \\. | [^\]\\] ){0,999} \]
| [^\@] )* )
\z}xs) {
($localpart,$domain) = ($1,$2);
} else {
($localpart,$domain) = ($addr,'');
}
$localpart =~ s/ " | \\ (.) | \\ \z /$1/xsg if $unquote; ($source_route, $localpart, $domain);
}
sub unquote_rfc2821_local($) {
my($mailbox) = @_;
my($source_route,$localpart,$domain) = parse_quoted_rfc2821($mailbox,1);
$domain = '@' if $domain eq '' && $localpart ne '' && $localpart =~ /\@/;
$localpart . $domain;
}
use vars qw($s $p @addresses);
sub flush_a() {
$s =~ s/^[ \t]+//s; $s =~ s/[ \t]\z//s; # trim
$p =~ s/^[ \t]+//s; $p =~ s/[ \t]\z//s;
if ($p ne '') { $p =~ s/^<//; $p =~ s/>\z//; push(@addresses,$p) }
elsif ($s ne '') { push(@addresses,$s) }
$p = ''; $s = '';
}
sub parse_address_list($) {
local($_) = $_[0];
local($1); s/\n(?=[ \t])//gs; s/\n+\z//s; # unfold, chomp
my($str_l) = length($_); $p = ''; $s = ''; @addresses = ();
my($comm_lvl) = 0; my($in_qcontent) = 0; my($in_literal) = 0;
my($in_group) = 0; my($in_angle) = 0; my($after_at) = 0; my($new_pos);
for (my $pos=-1; $new_pos=pos($_), $new_pos<$str_l; $pos=$new_pos) {
$new_pos > $pos or die "parse_address_list PANIC1 $new_pos"; if ($comm_lvl > 0 && /\G( \) )/gcsx) { $comm_lvl--; next }
if (!$in_qcontent && !$in_literal && /\G( \( )/gcsx) { $comm_lvl++; next }
if ($comm_lvl > 0 && /\G( \\. )/gcsx) { next }
if ($comm_lvl > 0 && /\G( [^()\\]+ )/gcsx) { next }
if ($in_qcontent && /\G( " )/gcsx) # normal exit from qcontent
{ $in_qcontent = 0; ($in_angle?$p:$s) .= $1; next }
if ($in_qcontent && /\G( > )/gcsx) # bail out of qcontent
{ $in_qcontent = 0; $in_angle = 0; $after_at = 0;
($in_angle?$p:$s) .= $1; next }
if (!$comm_lvl && !$in_qcontent && !$in_literal && /\G( " )/gcsx)
{ $in_qcontent = 1; ($in_angle?$p:$s) .= $1; next }
if ($in_qcontent && /\G( \\. )/gcsx) { ($in_angle?$p:$s) .= $1; next }
if ($in_qcontent && /\G( [^"\\>]+ )/gcsx) { ($in_angle?$p:$s) .= $1; next }
# address literal
if ($in_literal && /\G( \] )/gcsx)
{ $in_literal = 0; ($in_angle?$p:$s) .= $1; next }
if ($in_literal && /\G( > )/gcsx) # bail out of address literal
{ $in_literal = 0; $in_angle = 0; $after_at = 0;
($in_angle?$p:$s) .= $1; next }
if (!$comm_lvl && !$in_qcontent && /\G( \[ )/gcsx)
{ $in_literal = 1 if $after_at; ($in_angle?$p:$s) .= $1; next }
if ($in_literal && /\G( \\. )/gcsx) { ($in_angle?$p:$s) .= $1; next }
if ($in_literal && /\G( [^\]\\>]+ )/gcsx) { ($in_angle?$p:$s) .= $1; next }
# normal content
if (!$comm_lvl && !$in_qcontent && !$in_literal) {
if (!$in_angle && /\G( < )/gcsx)
{ $in_angle = 1; $after_at = 0; flush_a() if $p ne ''; $p .= $1; next }
if ( $in_angle && /\G( > )/gcsx)
{ $in_angle = 0; $after_at = 0; $p .= $1; next }
if (/\G( , )/gcsx) # top-level addr separator or source route delimiter
{ !$in_angle ? flush_a() : ($p.=$1); $after_at = 0; next }
if (!$in_angle && !$in_group && /\G( : )/gcsx) # group name terminator
{ $in_group = 1; $s .= $1; $p=$s=''; next } # discard group name
if ($after_at && /\G( : )/gcsx) # source route terminator
{ $after_at = 0; ($in_angle?$p:$s) .= $1; next }
if ( $in_group && /\G( ; )/gcsx) # group terminator
{ $in_group = 0; $after_at = 0; next }
if (!$in_group && /\G( ; )/gcsx) # out of place special
{ ($in_angle?$p:$s) .= $1; $after_at = 0; next }
if (/\G( \@ )/gcsx) { $after_at = 1; ($in_angle?$p:$s) .= $1; next }
if (/\G( [ \t]+ )/gcsx) { ($in_angle?$p:$s) .= $1; next }
if (/\G( [^,:;\@<>()"\[\]\\]+ )/gcsx) { ($in_angle?$p:$s) .= $1; next }
}
if (/\G( . )/gcsx) { ($in_angle?$p:$s) .= $1; next } die "parse_address_list PANIC2 $new_pos"; }
flush_a(); @addresses;
}
sub displayed_length($$) {
my($str,$ind) = @_;
for my $t ($str =~ /\G ( \t | [^\t]+ )/gcsx)
{ $ind += $t ne "\t" ? length($t) : 8 - $ind % 8 }
$ind;
}
sub wrap_string($;$$$$) {
my($str,$max_len,$prefix,$indent,$structured) = @_;
$max_len = 78 if !defined $max_len;
$prefix = '' if !defined $prefix;
$structured = 0 if !defined $structured;
my(@chunks);
if ($structured) {
local($1);
1 while $str =~ s/^([ \t]*)\n/$1/; $str =~ s/\n(?=[ \t]*(\n|\z))//g; # within and at end
$str =~ s/\n(?![ \t])/\n /g; @chunks = split(/\n/,$str,-1);
} else {
$str =~ s/\n(?![ \t])/\n /g; $str =~ s/\n//g; # unfold (knowing a space at folds is not missing)
@chunks = $str =~ /\G ( (?: ^ .*? | [ \t]) [^ \t]+ [ \t]* )
(?= \z | [ \t] [^ \t] )/gcsx;
}
my($result) = ''; my($s) = ''; my($s_displ_ind) = displayed_length($prefix,0);
my($contin_line) = 0; while (@chunks) { my($chunk) = shift(@chunks);
$chunk =~ s/^[ \t]/$indent/ if defined $indent && $contin_line && $s eq '';
my($s_displ_l) = displayed_length($chunk, $s_displ_ind);
if ($s_displ_l <= $max_len || (@chunks==0 && $s =~ /^[ \t]*\z/)) { $s .= $chunk; $s_displ_ind = $s_displ_l; } else {
local($1,$2);
$chunk =~ /^ ( .* [^ \t] ) ( [ \t]* ) \z/xs or die "Assert 1 failed in wrap: /$result/, /$chunk/";
my($solid,$white_tail) = ($1,$2);
my($min_displayed_s_len) = displayed_length($solid, $s_displ_ind);
if (@chunks > 0 && ($min_displayed_s_len <= $max_len || $s =~ /^[ \t]*\z/) ) { $s .= $solid; $s_displ_ind = $min_displayed_s_len; if (defined $indent && $indent eq '') {
} else {
while ($white_tail ne '') {
my($c) = substr($white_tail,0,1); my($dlen) = displayed_length($c, $s_displ_ind);
if ($dlen > $max_len) { last }
else {
$s .= $c; $s_displ_ind = $dlen; $white_tail = substr($white_tail,1); }
}
$chunks[0] = $white_tail . $chunks[0] if $white_tail ne '';
}
} elsif ($s =~ /^[ \t]*\z/) {
die "Assert 2 failed in wrap: /$result/, /$chunk/";
} else { if ($contin_line) { $result .= "\n" } else { $contin_line = 1 }
$s =~ s/[ \t]+\z// if defined $indent && $indent eq '';
$result .= $prefix.$s; $s = '';
$s_displ_ind = displayed_length($prefix,0);
unshift(@chunks,$chunk); }
}
}
if ($s !~ /^[ \t]*\z/) { if ($contin_line) { $result .= "\n" } else { $contin_line = 1 }
$s =~ s/[ \t]+\z// if defined $indent && $indent eq ''; # trim plain text
$result .= $prefix.$s; $s = '';
}
$result;
}
sub wrap_smtp_resp($) {
my($resp) = @_;
my($max_len) = 512-2; my(@result_list); local($1,$2,$3,$4);
if ($resp !~ /^ ([1-5]\d\d) (\ |-|\z)
([245] \. \d{1,3} \. \d{1,3} (?: \ |\z) )?
(.*) \z/xs)
{ die "wrap_smtp_resp: bad SMTP response code: '$resp'" }
my($resp_code,$continuation,$enhanced,$tail) = ($1,$2,$3,$4);
$continuation eq ' ' || $continuation eq ''
or die "wrap_smtp_resp: continuation SMTP response code: '$resp'";
my($lead_len) = length($resp_code) + 1 + length($enhanced);
while (length($tail) > $max_len-$lead_len || $tail =~ /\n/) {
my($head) = substr($tail, 0, $max_len-$lead_len);
if ($head =~ /^([^\n]*\n)/s) { $head = $1 }
$tail = substr($tail,length($head)); chomp($head);
push(@result_list, $resp_code.'-'.$enhanced.$head);
}
push(@result_list, $resp_code.' '.$enhanced.$tail);
\@result_list;
}
sub one_response_for_all($$;$) {
my($msginfo, $dsn_per_recip_capable, $suppressed) = @_;
my($smtp_resp, $exit_code, $ndn_needed);
my($am_id) = $msginfo->log_id;
my($delivery_method) = $msginfo->delivery_method;
my($sender) = $msginfo->sender;
my($per_recip_data) = $msginfo->per_recip_data;
my($any_not_done) = scalar(grep { !$_->recip_done } @$per_recip_data);
if ($delivery_method ne '' && $any_not_done)
{ die "Explicit forwarding, but not all recips done" }
if (!@$per_recip_data) { $smtp_resp = "250 2.5.0 Ok, id=$am_id"; $exit_code = EX_OK;
do_log(5, "one_response_for_all <%s>: no recipients, '%s'",
$sender, $smtp_resp);
}
if (!defined $smtp_resp) {
for my $r (@$per_recip_data) { if ($r->recip_smtp_response =~ /^4/) { $smtp_resp = $r->recip_smtp_response; last }
}
if (!defined $smtp_resp) {
for my $r (@$per_recip_data) { if ($r->recip_done && $r->recip_smtp_response !~ /^[245]/) {
$smtp_resp = '451 4.5.0 Bad SMTP response code??? "'
. $r->recip_smtp_response . '"';
last; }
}
}
if (defined $smtp_resp) {
$exit_code = EX_TEMPFAIL;
do_log(5, "one_response_for_all <%s>: 4xx found, '%s'",
$sender,$smtp_resp);
}
}
if (!defined $smtp_resp) {
my($notall);
for my $r (@$per_recip_data) {
if ($r->recip_destiny == D_DISCARD) { $smtp_resp = $r->recip_smtp_response if !defined $smtp_resp }
else { $notall=1; last } }
if ($notall) { undef $smtp_resp }
if (defined $smtp_resp) {
$exit_code = 99; do_log(5, "one_response_for_all <%s>: all DISCARD, '%s'",
$sender,$smtp_resp);
}
}
if (!defined $smtp_resp) {
my($notall, $done_level);
my($bounce_cnt) = 0;
for my $r (@$per_recip_data) {
my($dest, $resp) = ($r->recip_destiny, $r->recip_smtp_response);
if ($dest == D_DISCARD) {
} elsif ($resp =~ /^5/ && $dest != D_BOUNCE) {
if (!defined $smtp_resp || $r->recip_done > $done_level)
{ $smtp_resp = $resp; $done_level = $r->recip_done }
} else { $notall=1; last } }
if ($notall) { undef $smtp_resp }
if (defined $smtp_resp) {
$exit_code = EX_UNAVAILABLE;
do_log(5, "one_response_for_all <%s>: REJECTs, '%s'",$sender,$smtp_resp);
}
}
if (!defined $smtp_resp) {
my($rej_cnt) = 0; my($bounce_cnt) = 0; my($drop_cnt) = 0;
for my $r (@$per_recip_data) {
my($dest, $resp) = ($r->recip_destiny, $r->recip_smtp_response);
if ($resp =~ /^2/ && $dest == D_PASS) { $smtp_resp = $resp if !defined $smtp_resp }
$drop_cnt++ if $dest == D_DISCARD;
if ($resp =~ /^5/)
{ if ($dest == D_BOUNCE) { $bounce_cnt++ } else { $rej_cnt++ } }
}
$exit_code = EX_OK;
if (!defined $smtp_resp) { $smtp_resp = "250 2.5.0 Ok, id=$am_id";
if ($any_not_done) { $smtp_resp .= ", continue delivery" }
else { $exit_code = 99 } }
if ($rej_cnt + $bounce_cnt + $drop_cnt > 0) {
$smtp_resp .= ", ";
$smtp_resp .= "but " if $rej_cnt+$bounce_cnt+$drop_cnt<@$per_recip_data;
$smtp_resp .= join ", and ",
map { my($cnt, $nm) = @$_;
!$cnt ? () : $cnt == @$per_recip_data ? $nm : "$cnt $nm"
} ([$rej_cnt, 'REJECT'],
[$bounce_cnt, $suppressed ? 'DISCARD(bounce.suppressed)' :'BOUNCE'],
[$drop_cnt, 'DISCARD']);
}
$ndn_needed =
($bounce_cnt > 0 || ($rej_cnt > 0 && !$dsn_per_recip_capable)) ? 1 : 0;
ll(5) && do_log(5,
"one_response_for_all <%s>: %s, r=%d,b=%d,d=%s, ndn_needed=%s, '%s'",
$sender,
$rej_cnt + $bounce_cnt + $drop_cnt > 0 ? 'mixed' : 'success',
$rej_cnt, $bounce_cnt, $drop_cnt, $ndn_needed, $smtp_resp);
}
($smtp_resp, $exit_code, $ndn_needed);
}
1;
package Amavis::Lookup::RE;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log fmt_struct);
}
sub new($$) { my($class) = shift; bless [@_], $class }
sub lookup_re($$;$%) {
my($self, $addr,$get_all,%options) = @_;
local($1,$2,$3,$4); my(@matchingkey,@result);
$addr .= $options{AppendStr} if exists $options{AppendStr};
for my $e (@$self) { my($key,$r);
if (ref($e) eq 'ARRAY') { ($key,$r) = ($e->[0], @$e < 2 ? 1 : $e->[1]);
} else { ($key,$r) = ($e, 1);
}
""=~/x{0}/; my(@rhs); if (!ref($addr)) { @rhs = $addr =~ /$key/ }
else { for (@$addr) { @rhs = /$key/; last if @rhs } } if (@rhs) { if (!ref($r) && $r=~/\$/) { my($any) = $r =~ s{ \$ ( (\d+) | \{ (\d+) \} | \( (\d+) \) ) }
{ my($j)=$2+$3+$4; $j<1 ? '' : $rhs[$j-1] }gxse;
$r .= substr($addr,0,0) if $any;
}
push(@result,$r); push(@matchingkey,$key);
last if !$get_all;
}
}
if (!ll(5)) {
} elsif (!@result) {
do_log(5, "lookup_re(%s), no matches", fmt_struct($addr));
} else { my(%esc) = (r => "\r", n => "\n", f => "\f", b => "\b",
e => "\e", a => "\a", t => "\t");
my(@mk) = @matchingkey;
for my $mk (@mk) { $mk =~ s{ \\(.) }{ exists($esc{$1}) ? $esc{$1} : $1 }egsx }
if (!$get_all) { do_log(5, 'lookup_re(%s) matches key "%s", result=%s',
fmt_struct($addr), $mk[0], fmt_struct($result[0]));
} else { do_log(5, "lookup_re(%s) matches keys: %s", fmt_struct($addr),
join(', ', map {sprintf('"%s"=>%s', $mk[$_],fmt_struct($result[$_]))}
(0..$ }
}
if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
else { !wantarray ? \@result : (\@result, \@matchingkey) }
}
1;
package Amavis::Lookup::IP;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&lookup_ip_acl);
import Amavis::Util qw(ll do_log);
}
use subs @EXPORT_OK;
sub ip_to_vec($;$) {
my($ip,$allow_mask) = @_;
my($ip_len); my(@ip_fields);
local($1,$2,$3,$4,$5,$6);
$ip =~ s/^[ \t]+//; $ip =~ s/[ \t\r\n]+\z//s; # trim
my($ipa) = $ip;
($ipa,$ip_len) = ($1,$2) if $allow_mask && $ip =~ m{^([^/]*)/(.*)\z}s;
$ipa = $1 if $ipa =~ m{^ \[ (.*) \] \z}xs; $ipa = $1 if $ipa =~ m{^(.*)%[A-Za-z0-9]+\z}s; if ($ipa =~ m{^(IPv6:)?(.*:)(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z}si){
my(@d) = ($3,$4,$5,$6);
!grep {$_ > 255} @d
or die "Invalid decimal field value in IPv6 address: [$ip]\n";
$ipa = $2 . sprintf("%02X%02X:%02X%02X", @d);
} elsif ($ipa =~ m{^\d{1,3}(?:\.\d{1,3}){0,3}\z}) { my(@d) = split(/\./,$ipa,-1);
!grep {$_ > 255} @d
or die "Invalid field value in IPv4 address: [$ip]\n";
defined($ip_len) || @d==4
or die "IPv4 address [$ip] contains fewer than 4 fields\n";
$ipa = '::FFFF:' . sprintf("%02X%02X:%02X%02X", @d); if (!defined($ip_len)) { $ip_len = 32; } elsif ($ip_len =~ /^\d{1,9}\z/) { } elsif ($ip_len =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) {
!grep {$_ > 255} ($1,$2,$3,$4)
or die "Illegal field value in IPv4 mask: [$ip]\n";
my($mask1) = pack('C4',$1,$2,$3,$4); my($len) = unpack("%b*",$mask1); my($mask2) = pack('B32', '1' x $len); $mask1 eq $mask2
or die "IPv4 mask not representing valid CIDR mask: [$ip]\n";
$ip_len = $len;
} else {
die "Invalid IPv4 network mask or CIDR prefix length: [$ip]\n";
}
$ip_len<=32 or die "IPv4 network prefix length greater than 32: [$ip]\n";
$ip_len += 128-32; }
$ipa =~ s/^IPv6://i;
if ($ipa !~ /^(.*?)::(.*)\z/s) { @ip_fields = split(/:/,$ipa,-1); } else { my(@a) = split(/:/,$1,-1); my(@b) = split(/:/,$2,-1);
my($missing_cnt) = 8-(@a+@b); $missing_cnt = 1 if $missing_cnt<1;
@ip_fields = (@a, ('0') x $missing_cnt, @b);
}
@ip_fields<8 and die "IPv6 address [$ip] contains fewer than 8 fields\n";
@ip_fields>8 and die "IPv6 address [$ip] contains more than 8 fields\n";
!grep { !/^[0-9a-zA-Z]{1,4}\z/ } @ip_fields or die "Invalid syntax of IPv6 address: [$ip]\n";
my($vec) = pack("n8", map {hex} @ip_fields);
if (!defined($ip_len)) { $ip_len = 128 }
elsif ($ip_len !~ /^\d{1,3}\z/)
{ die "Invalid prefix length syntax in IP address: [$ip]\n" }
elsif ($ip_len > 128)
{ die "IPv6 network prefix length greater than 128: [$ip]\n" }
my($mask) = pack('B128', '1' x $ip_len);
($vec,$mask,$ip_len);
}
sub lookup_ip_acl($@) {
my($ip, @nets_ref) = @_;
my($ip_vec,$ip_mask); my($eval_stat);
eval { ($ip_vec,$ip_mask) = ip_to_vec($ip,0); 1 }
or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
my($label,$fullkey,$result); my($found) = 0;
for my $tb (@nets_ref) {
my($t) = ref($tb) eq 'REF' ? $$tb : $tb; if (!ref($t) || ref($t) eq 'SCALAR') { my($r) = ref($t) ? $$t : $t; $result = $r; $fullkey = "(constant:$r)";
$found=1 if defined $result;
} elsif (ref($t) eq 'HASH') {
if (!defined $ip_vec) { undef $fullkey; $result = $t->{$fullkey}; $found=1 if defined $result;
} else { my($ip_c); my($ip_dq); $ip_c = join(':', map {sprintf('%04x',$_)} unpack('n8',$ip_vec));
my($ipv4_vec,$ipv4_mask) = ip_to_vec('::FFFF:0:0/96',1);
if ( ($ip_vec & $ipv4_mask) eq ($ipv4_vec & $ipv4_mask) ) {
$ip_dq = join('.', unpack('C4',substr($ip_vec,12,4))); }
do_log(5, 'lookup_ip_acl keys: "%s", "%s"', $ip_dq,$ip_c);
if (defined $ip_dq) { for (my(@f)=split(/\./,$ip_dq); @f && !$found; $ $fullkey = join('.',@f); $result = $t->{$fullkey};
$found=1 if defined $result;
}
}
if (!$found) { $fullkey = $ip_c; $result = $t->{$fullkey};
$found=1 if defined $result;
}
}
} elsif (ref($t) eq 'ARRAY') {
my($key,$acl_ip_vec,$acl_mask,$acl_mask_len); local($1,$2);
for my $net (@$t) {
$fullkey = $key = $net; $result = 1;
if ($key =~ /^(!+)(.*)\z/s) { $key = $2;
$result = 1 - $result if (length($1) & 1); }
($acl_ip_vec, $acl_mask, $acl_mask_len) = ip_to_vec($key,1);
if ($acl_mask_len == 0) { $found=1 } elsif (!defined($ip_vec)) {} elsif (($ip_vec & $acl_mask) eq ($acl_ip_vec & $acl_mask)) { $found=1 }
last if $found;
}
} elsif ($t->isa('Amavis::Lookup::IP')) { my($acl_ip_vec, $acl_mask, $acl_mask_len);
for my $e (@$t) {
($fullkey, $acl_ip_vec, $acl_mask, $acl_mask_len, $result) = @$e;
if ($acl_mask_len == 0) { $found=1 } elsif (!defined($ip_vec)) {} elsif (($ip_vec & $acl_mask) eq ($acl_ip_vec & $acl_mask)) { $found=1 }
last if $found;
}
} elsif ($t->isa('Amavis::Lookup::Label')) { $label = $t->display; } else {
die "TROUBLE: lookup table is an unknown object: " . ref($t);
}
last if $found;
}
$fullkey = $result = undef if !$found;
if ($label ne '') { $label = " ($label)" }
ll(4) && do_log(4, 'lookup_ip_acl%s: key="%s"%s', $label, $ip,
!$found ? ", no match" : " matches \"$fullkey\", result=$result");
if (defined $eval_stat) {
chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; $eval_stat = "lookup_ip_acl$label: $eval_stat";
do_log(2, "%s", $eval_stat);
}
!wantarray ? $result : ($result, $fullkey, $eval_stat);
}
sub new($@) {
my($class,@nets) = @_;
my(@list); local($1,$2);
for my $net (@nets) {
my($key) = $net; my($result) = 1;
if ($key =~ /^(!+)(.*)\z/s) { $key = $2;
$result = 1 - $result if (length($1) & 1); }
my($ip_vec, $ip_mask, $ip_mask_len) = ip_to_vec($key,1);
push(@list, [$net, $ip_vec, $ip_mask, $ip_mask_len, $result]);
}
bless \@list, $class;
}
1;
package Amavis::Lookup::Label;
use strict;
use re 'taint';
sub new($$) { my($class) = shift; my($str) = shift; bless \$str, $class }
sub display($) { my($self) = shift; $$self }
1;
package Amavis::Lookup;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&lookup &lookup2 &lookup_hash &lookup_acl);
import Amavis::Util qw(ll do_log fmt_struct);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(split_address make_query_keys);
}
use subs @EXPORT_OK;
sub lookup_hash($$;$%) {
my($addr, $hash_ref,$get_all,%options) = @_;
ref($hash_ref) eq 'HASH'
or die "lookup_hash: arg2 must be a hash ref: $hash_ref";
local($1,$2,$3,$4); my(@matchingkey,@result); my($append_string);
$append_string = $options{AppendStr} if exists $options{AppendStr};
my($keys_ref,$rhs_ref) = make_query_keys($addr,1,1,$append_string);
for my $key (@$keys_ref) { if (exists $$hash_ref{$key}) { push(@result,$$hash_ref{$key}); push(@matchingkey,$key);
last if !$get_all;
}
}
for my $r (@result) { if (!ref($r) && $r=~/\$/) { my($any) = $r =~ s{ \$ ( (\d+) | \{ (\d+) \} | \( (\d+) \) ) }
{ my($j)=$2+$3+$4; $j<1 ? '' : $rhs_ref->[$j-1] }gxse;
$r .= substr($addr,0,0) if $any;
}
}
if (!ll(5)) {
} elsif (!@result) {
do_log(5,"lookup_hash(%s), no matches", $addr);
} elsif (!$get_all) { do_log(5,'lookup_hash(%s) matches key "%s", result=%s',
$addr, $matchingkey[0], !defined($result[0])?'undef':$result[0]);
} else { do_log(5,"lookup_hash(%s) matches keys: %s", $addr,
join(', ', map {sprintf('"%s"=>%s',$matchingkey[$_],$result[$_])}
(0..$ }
if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
else { !wantarray ? \@result : (\@result, \@matchingkey) }
}
sub lookup_acl($$%) {
my($addr, $acl_ref,%options) = @_;
ref($acl_ref) eq 'ARRAY'
or die "lookup_acl: arg2 must be a list ref: $acl_ref";
return undef if !@$acl_ref; my($lpcs) = c('localpart_is_case_sensitive');
my($localpart,$domain) = split_address($addr); $domain = lc($domain);
$localpart = lc($localpart) if !$lpcs;
local($1,$2);
$domain = $1 if $domain =~ /^\@?(.*?)\.*\z/s;
$domain .= $options{AppendStr} if exists $options{AppendStr};
my($matchingkey, $result); my($found) = 0;
for my $e (@$acl_ref) {
$result = 1; $matchingkey = $e; my($key) = $e;
if ($key =~ /^(!+)(.*)\z/s) { $key = $2;
$result = 1-$result if length($1) & 1; }
if ($key =~ /^(.*?)\@([^\@]*)\z/s) { $found=1 if $localpart eq ($lpcs?$1:lc($1)) && $domain eq lc($2);
} elsif ($key =~ /^\.(.*)\z/s) { my($key_t) = lc($1);
$found=1 if $domain eq $key_t || $domain =~ /(\.|\z)\Q$key_t\E\z/s;
} else { $found=1 if $domain eq lc($key);
}
last if $found;
}
$matchingkey = $result = undef if !$found;
do_log(5, "lookup_acl(%s)%s", $addr,
(!$found ? ", no match" : " matches key \"$matchingkey\", result=$result"));
!wantarray ? $result : ($result, $matchingkey);
}
sub lookup($$@) {
my($get_all, $addr, @tables) = @_;
lookup2($get_all, $addr, \@tables);
}
sub lookup2($$$%) {
my($get_all, $addr, $tables_ref, %options) = @_;
(@_ - 3) % 2 == 0 or die "lookup2: options argument not in pairs (not hash)";
my($label, @result,@matchingkey);
for my $tb (!$tables_ref ? () : @$tables_ref) {
my($t) = ref($tb) eq 'REF' ? $$tb : $tb; if (!ref($t) || ref($t) eq 'SCALAR') { my($r) = ref($t) ? $$t : $t; if (defined $r) {
do_log(5,'lookup: (scalar) matches, result="%s"', $r);
push(@result,$r); push(@matchingkey,"(constant:$r)");
}
} elsif (ref($t) eq 'HASH') {
my($r,$mk) = lookup_hash($addr,$t,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} elsif (ref($t) eq 'ARRAY') {
my($r,$mk) = lookup_acl($addr,$t,%options);
if (defined $r) { push(@result,$r); push(@matchingkey,$mk) }
} elsif ($t->isa('Amavis::Lookup::Label')) { $label = $t->display; } elsif ($t->isa('Amavis::Lookup::RE')) {
my($r,$mk) = $t->lookup_re($addr,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} elsif ($t->isa('Amavis::Lookup::SQL')) {
my($r,$mk) = $t->lookup_sql($addr,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} elsif ($t->isa('Amavis::Lookup::SQLfield')) {
my($r,$mk) = $t->lookup_sql_field($addr,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} elsif ($t->isa('Amavis::Lookup::LDAP')) {
my($r,$mk) = $t->lookup_ldap($addr,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} elsif ($t->isa('Amavis::Lookup::LDAPattr')) {
my($r,$mk) = $t->lookup_ldap_attr($addr,$get_all,%options);
if (!defined $r) {}
elsif (!$get_all) { push(@result,$r); push(@matchingkey,$mk) }
elsif (@$r) { push(@result,@$r); push(@matchingkey,@$mk) }
} else {
die "TROUBLE: lookup table is an unknown object: " . ref($t);
}
last if @result && !$get_all;
}
if (ll(4)) { my($opt_label); $opt_label = $options{Label};
my(@lbl) = grep { defined $_ && $_ ne '' } ($opt_label,$label);
$label = " [" . join(",",@lbl) . "]" if @lbl;
if (!$tables_ref || !@$tables_ref) {
do_log(4, "lookup%s => undef, %s, no lookup tables",
$label, fmt_struct($addr));
} elsif (!@result) {
do_log(4, "lookup%s => undef, %s does not match",
$label, fmt_struct($addr));
} elsif (!$get_all) { do_log(4, 'lookup%s => %-6s %s matches, result=%s, matching_key="%s"',
$label, $result[0] ? 'true,' : 'false,',
fmt_struct($addr), fmt_struct($result[0]), $matchingkey[0]);
} else { do_log(4, 'lookup%s, %d matches for %s, results: %s',
$label, scalar(@result), fmt_struct($addr),
join(', ',map { sprintf('"%s"=>%s',
$matchingkey[$_], fmt_struct($result[$_]))
} (0..$ }
}
if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
else { !wantarray ? \@result : (\@result, \@matchingkey) }
}
1;
package Amavis::Expand;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&expand &tokenize);
import Amavis::Util qw(ll do_log);
}
use subs @EXPORT_OK;
use vars qw(%builtins_cached %lexmap %esc);
use vars qw($lx_lb $lx_lbS $lx_lbT $lx_lbA $lx_lbC $lx_lbE $lx_lbQQ
$lx_rbQQ $lx_rb $lx_sep $lx_h $lx_ph);
BEGIN {
no warnings 'qw'; my(@lx_str) = qw( [ [? [~ [@ [: [= [" "] ] | %0 %1 %2 %3 %4 %5 %6 %7 %8 %9); $lexmap{$_} = \$_ for @lx_str; ($lx_lb, $lx_lbS, $lx_lbT, $lx_lbA, $lx_lbC, $lx_lbE, $lx_lbQQ, $lx_rbQQ,
$lx_rb, $lx_sep, $lx_h, $lx_ph) = map { $lexmap{$_} } @lx_str;
%esc = (n => \"\n", r => "\r", f => "\f", b => "\b",
e => "\e", a => "\a", t => "\t");
# NOTE that \n is specific, it is represented by a ref to a newline and not
# by a newline itself; this makes it possible for a macro '#' to skip input
# to a true newline from source, making it possible to comment-out entire
# lines even if containing "\n" tokens
}
# make an object out of the supplied list of tokens
sub newmacro { my($class) = shift; bless [@_], $class }
# turn a ref to a list of tokens into a single plain string
sub tokens_list_to_str($) { join('', map {ref($_) ? $$_ : $_ } @{$_[0]}) }
sub tokenize($;$) {
my($str_ref,$tokens_ref) = @_; local($1);
$tokens_ref = [] if !defined $tokens_ref;
# parse lexically, replacing lexical element strings with references,
# unquoting backslash-quoted characters and %%, and dropping \NL and \_
@$tokens_ref = map {
exists $lexmap{$_} ? $lexmap{$_} # replace with ref
: $_ eq "\\\n" || $_ eq "\\_" ? '' # drop \NEWLINE and \_
: /^%%\z/ ? '%' # %% -> %
: /^(%#?.)\z/s ? \"$1" : /^\\([0-7]{1,3})\z/ ? chr(oct($1)) : /^\\(.)\z/s ? (exists($esc{$1}) ? $esc{$1} : $1) : /^(_ [A-Z]+ (?: \( [^)]* \) )? _)\z/sx ? \"$1" # SpamAssassin-compatible
: $_ }
$$str_ref =~ /\G \# | \[ [?~\@:="]? | "\] | \] | \| | % \#? . | \\ [^0-7] |
\\ [0-7]{1,3} | _ [A-Z]+ (?: \( [^)]* \) )? _ |
[^\[\]\\|%\n#"_]+ | [^\n]+? | \n /gcsx;
$tokens_ref;
}
sub evalmacro($$;@) {
my($macro_type,$builtins_href,@args) = @_;
my(@result); local($1,$2);
if ($macro_type == $lx_lbS) { my($sel) = tokens_list_to_str(shift(@args));
if ($sel =~ /^\s*\z/) { $sel = 0 }
elsif ($sel =~ /^\s*(\d+)\s*\z/) { $sel = 0+$1 } else { $sel = 1 }
if (@args < 2) {} elsif ($sel > $ @result = @{$args[$sel]} if $sel >= 0 && $sel <= $ } elsif ($macro_type == $lx_lbT) { my($str) = tokens_list_to_str(shift(@args)); my($match,@repl);
while (@args >= 2) { @repl = ();
my($regexp) = tokens_list_to_str(shift(@args)); ""=~/x{0}/; eval { local($1,$2,$3,$4,$5,$6,$7,$8,$9);
$match = $str=~/$regexp/ ? 1 : 0;
@repl = ($1,$2,$3,$4,$5,$6,$7,$8,$9) if $match;
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; do_log(2,"invalid macro regexp arg: %s", $eval_stat);
$match = 0; @repl = ();
};
if ($match) { last } else { shift(@args) } }
if (@args > 0) {
unshift(@repl,$str); @result = map { !ref || $$_ !~ /^%([0-9])\z/ ? $_ : $repl[$1] }
@{$args[0]};
}
} elsif ($macro_type == $lx_lb) { my($cvar_r,$sep_r,$body_r); my($cvar); if (@args >= 3) { ($cvar_r,$body_r,$sep_r) = @args }
else { ($body_r,$sep_r) = @args; $cvar_r = $body_r }
for (@$cvar_r) { if (ref && $$_ =~ /^%(.)\z/s) { $cvar = $1; last } }
my($name) = $cvar; if (@args >= 3 && !defined($name)) {
$name = tokens_list_to_str($cvar_r);
$name =~ s/^[ \t\n]+//; $name =~ s/[ \t\n]+\z//; # trim whitespace
if ($name eq '') { $name = undef } else { $cvar = 'x' }
}
if (exists($builtins_href->{$name})) {
my($s) = $builtins_href->{$name};
if (ref($s) eq 'Amavis::Expand') { my(@margs) = ($name); my(@res) = map { !ref || $$_ !~ /^%([0-9])\z/ ? $_
: ref($margs[$1]) ? @{$margs[$1]} : () } @$s;
$s = tokens_list_to_str(\@res);
} elsif (ref($s) eq 'CODE') {
if (exists($builtins_cached{$name})) {
$s = $builtins_cached{$name};
} else {
while (ref($s) eq 'CODE') { $s = &$s($name) }
$builtins_cached{$name} = $s;
}
}
my($ind) = 0;
for my $val (ref($s) ? @$s : $s) { push(@result, @$sep_r) if ++$ind > 1 && ref($sep_r);
push(@result, map {ref && $$_ eq "%$cvar" ? $val : $_} @$body_r);
}
}
} elsif ($macro_type == $lx_lbE) { my($name) = tokens_list_to_str(shift(@args)); $name =~ s/^[ \t\n]+//; $name =~ s/[ \t\n]+\z//; # trim whitespace on name
delete $builtins_cached{$name};
$builtins_href->{$name} = Amavis::Expand->newmacro(@{$args[0]});
} elsif ($macro_type == $lx_lbA || $macro_type == $lx_lbC || $$macro_type =~ /^%(\ my($name); my($cardinality_only) = 0;
if ($macro_type == $lx_lbA || $macro_type == $lx_lbC) {
$name = tokens_list_to_str($args[0]); $name =~ s/^[ \t\n]+//; $name =~ s/[ \t\n]+\z//; # trim whitespace
} else { $name = $2;
$cardinality_only = 1 if defined $1;
}
my($s) = $builtins_href->{$name};
if (!ref($s)) { if (!$cardinality_only) { @result = $s }
else { @result = $s !~ /^\s*\z/ ? 1 : 0 }; } elsif (ref($s) eq 'Amavis::Expand') { $args[0] = $name; @result = map { !ref || $$_ !~ /^%([0-9])\z/ ? $_
: ref($args[$1]) ? @{$args[$1]} : () } @$s;
if ($cardinality_only) { @result = tokens_list_to_str(\@result) !~ /^\s*\z/ ? 1 : 0;
}
} else { if (ref($s) eq 'CODE') {
if (exists($builtins_cached{$name}) && @args <= 1) {
$s = $builtins_cached{$name};
} elsif (@args <= 1) {
while (ref($s) eq 'CODE') { $s = &$s($name) } $builtins_cached{$name} = $s;
} else {
shift(@args); while (ref($s) eq 'CODE') { $s = &$s($name, map { tokens_list_to_str($_) } @args) }
}
}
if ($cardinality_only) { @result = ref($s) ? scalar(@$s) : $s !~ /^\s*\z/ ? 1 : 0;
} else { @result = ref($s) ? join(', ',@$s) : $s;
}
}
}
\@result;
}
sub expand($$) {
my($str_ref) = shift; my($builtins_href) = shift; my(@tokens);
if (ref($str_ref) eq 'ARRAY') { @tokens = @$str_ref }
else { tokenize($str_ref,\@tokens) }
my($call_level) = 0; my($quote_level) = 0;
my(@arg); my(@macro_type); my(@implied_q); my(@open_quote); %builtins_cached = (); my($output_str) = ''; my($whereto); local($1,$2);
while (@tokens) {
my($t) = shift(@tokens);
if (!ref($t)) { if (defined $whereto) { push(@$whereto,$t) } else { $output_str .= $t }
} elsif ($quote_level > 0 && $$t =~ /^\[/) { $quote_level += ($t == $lx_lbQQ) ? 2 : 1; unshift(@open_quote,$t);
if (defined $whereto) { push(@$whereto,$t) } else { $output_str .= $$t }
} elsif ($t == $lx_lbQQ) { $quote_level += 2; unshift(@open_quote,$t);
} elsif ($$t =~ /^\[/) { $call_level++; unshift(@arg, [[]]); unshift(@macro_type, $t); unshift(@implied_q, 0);
$whereto = $arg[0][0];
if ($t == $lx_lb) { $quote_level++; unshift(@open_quote,$t); $implied_q[0] = 1;
}
} elsif ($quote_level <= 1 && $call_level>0 && $t == $lx_sep) { unshift(@{$arg[0]}, []); $whereto = $arg[0][0];
if ($macro_type[0]==$lx_lbS && @{$arg[0]} == 2) {
$quote_level++; unshift(@open_quote,$macro_type[0]); $implied_q[0] = 1;
}
} elsif ($quote_level > 1 && ($t == $lx_rb || $t == $lx_rbQQ)) {
$quote_level -= ($open_quote[0] == $lx_lbQQ) ? 2 : 1;
shift(@open_quote); if ($t == $lx_rb || $quote_level > 0) { if (defined $whereto) { push(@$whereto,$t) } else { $output_str .= $$t}
}
} elsif ($call_level > 0 && ($t == $lx_rb || $t == $lx_rbQQ)) { $call_level--; my($m_type) = $macro_type[0];
if ($t == $lx_rbQQ) { if (defined $whereto) { push(@$whereto,'"') } else { $output_str.='"' }
}
if ($implied_q[0] && $quote_level > 0) {
$quote_level -= ($open_quote[0] == $lx_lbQQ) ? 2 : 1;
shift(@open_quote); }
my($result_ref) = evalmacro($m_type, $builtins_href, reverse @{$arg[0]});
shift(@macro_type); shift(@arg); shift(@implied_q); $whereto = $call_level > 0 ? $arg[0][0] : undef;
if ($m_type == $lx_lbC) { if (defined $whereto) { push(@$whereto, @$result_ref) }
else { $output_str .= tokens_list_to_str($result_ref) }
} else { unshift(@tokens, @$result_ref);
}
} elsif ($quote_level > 0 ) { if (defined $whereto) { push(@$whereto,$t) } else { $output_str .= $$t }
} elsif ($t == $lx_h) { while (@tokens) { last if shift(@tokens) eq "\n" }
} elsif ($$t =~ /^%\ my($result_ref) = evalmacro($t, $builtins_href);
if (defined $whereto) { push(@$whereto,@$result_ref) }
else { $output_str .= join('', map {ref($_) ? $$_ : $_ } @$result_ref) }
} elsif ($$t =~ /^_ ([A-Z]+) (?: \( ( [^)]* ) \) )? _\z/sx) {
my($result_ref) = evalmacro($lx_lbC, $builtins_href, [$1],
!defined($2) ? () : [$2] );
if (defined $whereto) { push(@$whereto, @$result_ref) }
else { $output_str .= tokens_list_to_str($result_ref) }
} else { if (defined $whereto) { push(@$whereto,$t) } else { $output_str .= $$t }
}
}
%builtins_cached = (); \$output_str;
}
1;
package Amavis::TempDir;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars);
import Amavis::Timing qw(section_time);
import Amavis::Util qw(ll do_log add_entropy rmdir_recursively);
import Amavis::rfc2821_2822_Tools qw(iso8601_timestamp);
}
use Errno qw(ENOENT EACCES);
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
sub new {
my($class) = @_;
my($self) = bless {}, $class;
undef $self->{tempdir_path};
undef $self->{tempdir_dev}; undef $self->{tempdir_ino};
undef $self->{fh_pers}; undef $self->{fh_dev}; undef $self->{fh_ino};
$self->{empty} = 1; $self->{preserve} = 0;
$self;
}
sub path { my($self)=shift; !@_ ? $self->{tempdir_path} : ($self->{tempdir_path}=shift)
}
sub fh { my($self)=shift; !@_ ? $self->{fh_pers} : ($self->{fh_pers}=shift);
}
sub empty { my($self)=shift; !@_ ? $self->{empty} : ($self->{empty}=shift)
}
sub preserve { my($self)=shift; !@_ ? $self->{preserve} : ($self->{preserve}=shift);
}
sub DESTROY {
my($self) = shift; local($@,$!);
if (defined($my_pid) && $$ != $my_pid) {
eval { do_log(5,"Amavis::TempDir DESTROY skip, clone [%s] (born as [%s])",
$$,$my_pid) };
} else {
eval { do_log(5,"Amavis::TempDir DESTROY called") };
eval {
$self->{fh_pers}->close
or do_log(-1,"Error closing temp file: %s",$!) if $self->{fh_pers};
undef $self->{fh_pers};
my($errn) = $self->{tempdir_path} eq '' ? ENOENT
: (lstat($self->{tempdir_path}) ? 0 : 0+$!);
if (defined $self->{tempdir_path} && $errn != ENOENT) {
if ($self->{preserve} && !$self->{empty}) {
do_log(-1,"TempDir removal: tempdir is to be PRESERVED: %s",
$self->{tempdir_path});
} else {
do_log(3, "TempDir removal: %s is being removed: %s%s",
$self->{empty} ? 'empty tempdir' : 'tempdir',
$self->{tempdir_path},
$self->{preserve} ? ', nothing to preserve' : '');
rmdir_recursively($self->{tempdir_path});
}
};
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
eval { do_log(1,"TempDir removal: %s",$eval_stat) };
};
}
}
sub prepare {
my($self) = @_;
if (! defined $self->{tempdir_path} ) {
my($now_iso8601) = iso8601_timestamp(time,1); $self->{tempdir_path} = sprintf("%s/amavis-%s-%05d",
$TEMPBASE, $now_iso8601, $$);
}
my($dname) = $self->{tempdir_path};
my(@stat_list) = lstat($dname); my($errn) = @stat_list ? 0 : 0+$!;
if ($errn == ENOENT) {
do_log(4,"TempDir::prepare: creating directory %s", $dname);
mkdir($dname,0750) or die "Can't create directory $dname: $!";
@stat_list = lstat($dname);
@stat_list or die "Failed to access directory $dname: $!";
($self->{tempdir_dev},$self->{tempdir_ino}) = @stat_list;
$self->{empty} = 1; add_entropy(@stat_list);
section_time('mkdir tempdir');
} elsif ($errn != 0) {
die "TempDir::prepare: Can't access temporary directory $dname: $!";
} elsif (! -d _) { die "TempDir::prepare: $dname is not a directory!!!";
} else { my($dev,$ino,$mode,$nlink) = @stat_list;
if ($dev != $self->{tempdir_dev} || $ino != $self->{tempdir_ino}) {
do_log(-1,"TempDir::prepare: %s is no longer the same directory!!!",
$dname);
($self->{tempdir_dev},$self->{tempdir_ino}) = @stat_list;
}
if ($nlink > 3) {
do_log(5, "TempDir::prepare: directory %s has %d subdirectories",
$dname, $nlink-2);
}
}
}
sub prepare_file {
my($self) = @_;
my($fname) = $self->path . '/email.txt';
my(@stat_list) = lstat($fname); my($errn) = @stat_list ? 0 : 0+$!;
if ($errn == ENOENT) { do_log(0,"%s no longer exists, can't re-use it",
$fname) if $self->{fh_pers};
undef $self->{fh_pers};
} elsif ($errn != 0) { undef $self->{fh_pers};
die "TempDir::prepare_file: can't access temporary file $fname: $!";
} elsif (! -f _) { undef $self->{fh_pers};
die "TempDir::prepare_file: $fname is not a regular file!!!";
} elsif ($self->{fh_pers}) {
my($dev,$ino) = @stat_list;
if ($dev != $self->{file_dev} || $ino != $self->{file_ino}) {
undef $self->{fh_pers};
do_log(1,"%s is no longer the same file, won't re-use it, deleting",
$fname);
unlink($fname) or die "Can't remove file $fname: $!";
}
}
if ($self->{fh_pers} && !$can_truncate) { undef $self->{fh_pers};
do_log(1,"Unable to truncate temporary file %s, deleting it", $fname);
unlink($fname) or die "Can't remove file $fname: $!";
}
if ($self->{fh_pers}) { $self->{fh_pers}->seek(0,0) or die "Can't rewind mail file: $!";
$self->{fh_pers}->truncate(0) or die "Can't truncate mail file: $!";
} else {
do_log(4,"TempDir::prepare_file: creating file %s", $fname);
my($newfh) = IO::File->new;
$newfh->open($fname, O_CREAT|O_EXCL|O_RDWR, 0640)
or die "Can't create file $fname: $!";
if ($unicode_aware) {
binmode($newfh,":bytes") or die "Can't cancel :utf8 mode on $fname: $!";
if (ll(5) && $] >= 5.008001) { my(@layers) = PerlIO::get_layers($newfh);
do_log(5,"TempDir::prepare_file: layers: %s", join(",",@layers));
}
}
$self->{fh_pers} = $newfh;
@stat_list = lstat($fname);
@stat_list or die "Failed to access temporary file $fname: $!";
add_entropy(@stat_list);
($self->{file_dev}, $self->{file_ino}) = @stat_list;
section_time('create email.txt');
}
}
sub clean {
my($self) = @_;
if ($self->{preserve} && !$self->{empty}) {
do_log(-1,"PRESERVING EVIDENCE in %s", $self->{tempdir_path});
if ($self->{fh_pers}) {
$self->{fh_pers}->close or die "Error closing mail file: $!"
}
undef $self->{fh_pers}; undef $self->{tempdir_path}; $self->{empty} = 1;
}
if ($self->{fh_pers} && !$can_truncate) {
$self->{fh_pers}->close or die "Error closing mail file: $!";
undef $self->{fh_pers};
unlink($self->{tempdir_path}.'/email.txt')
or die "Can't delete file ".$self->{tempdir_path}."/email.txt: $!";
section_time('delete email.txt');
}
if (defined $self->{tempdir_path}) { $self->strip; $self->{empty} = 1;
}
$self->{preserve} = 0; }
sub strip {
my($self) = shift;
my($dir) = $self->{tempdir_path};
do_log(4, "TempDir::strip: %s", $dir);
my($errn) = lstat("$dir/parts") ? 0 : 0+$!;
if ($errn == ENOENT) {} elsif ($errn != 0) { die "TempDir::strip: error accessing $dir/parts: $!" }
elsif ( -l _) { die "TempDir::strip: $dir/parts is a symbolic link" }
elsif (!-d _) { die "TempDir::strip: $dir/parts is not a directory" }
else { rmdir_recursively("$dir/parts", 1) }
$self->check;
1;
}
sub check {
my($self) = shift;
my($eval_stat); my($dir) = $self->{tempdir_path};
local(*DIR); opendir(DIR,$dir) or die "Can't open directory $dir: $!";
eval {
$! = 0; my($f);
while (defined($f = readdir(DIR))) {
next if $f eq '.' || $f eq '..';
my(@stat_list) = lstat("$dir/$f");
my($errn) = @stat_list ? 0 : 0+$!;
if ($errn) {
die "Inaccessible $dir/$f: $!";
} elsif (-f _) {
if ($f ne 'email.txt') { die "Unexpected file $dir/$f" }
} elsif (-d _) {
if ($f ne 'parts') {
die "Unexpected directory $dir/$f";
} elsif ($stat_list[3] > 2) { die "Directory $dir/$f has subdirectories: ".($stat_list[3]-2);
}
} else {
die "Unexpected non-regular file $dir/$f";
}
}
1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
closedir(DIR) or die "Error closing directory $dir: $!";
if (defined $eval_stat) {
chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; die "TempDir::check: $eval_stat\n";
}
1;
}
1;
package Amavis::IO::FileHandle;
use strict;
use re 'taint';
no warnings 'uninitialized';
use warnings FATAL => 'utf8';
use Errno qw(EAGAIN);
sub new { shift->TIEHANDLE(@_) }
sub TIEHANDLE {
my($class) = shift;
my($self) = bless { 'fileno' => undef }, $class;
if (@_) { $self->OPEN(@_) or return undef }
$self;
}
sub UNTIE {
my($self,$count) = @_;
$self->CLOSE if !$count && defined $self->FILENO;
1;
}
sub DESTROY {
my($self) = @_; local($@,$!);
$self->CLOSE if defined $self->FILENO;
1;
}
sub BINMODE { 1 }
sub FILENO { my($self) = @_; $self->{'fileno'} }
sub CLOSE { my($self) = @_; undef $self->{'fileno'}; 1 }
sub EOF { my($self) = @_; defined $self->{'fileno'} ? $self->{'eof'} : 1 }
sub OPEN {
my($self, $filehandle,$prefix_lines_ref,$size_limit) = @_;
$self->CLOSE if defined $self->FILENO;
$self->{'fileno'} = 9999; $self->{'eof'} = 0;
$self->{'prefix'} = $prefix_lines_ref;
$self->{'prefix_n'} = 0; $self->{'prefix_l'} = 0; $self->{'pos'} = 0; $self->{'rec_ind'} = 0;
$self->{'size_limit'} = $size_limit; if (ref $prefix_lines_ref) {
my($len) = 0; for (@$prefix_lines_ref) { $len += length($_) }
$self->{'prefix_l'} = $len;
$self->{'prefix_n'} = @$prefix_lines_ref;
}
$self->{'handle'} = $filehandle;
seek($filehandle, 0,0); };
sub SEEK {
my($self,$offset,$whence) = @_;
$whence == 0 or die "Only absolute SEEK is supported on this file";
$offset == 0 or die "Only SEEK(0,0) is supported on this file";
$self->{'eof'} = 0; $self->{'pos'} = 0; $self->{'rec_ind'} = 0;
seek($self->{'handle'}, 0,0); }
sub READLINE {
my($self) = @_; $! = 0;
my($size_limit) = $self->{'size_limit'};
my($pos) = $self->{'pos'};
if ($self->{'eof'}) {
return undef;
} elsif (defined $size_limit && $pos >= $size_limit) {
$self->{'eof'} = 1;
return undef;
} elsif (wantarray) { my($rec_ind) = $self->{'rec_ind'}; $self->{'eof'} = 1;
my($fh) = $self->{'handle'};
if (!defined $size_limit) {
$self->{'rec_ind'} = $self->{'prefix_n'}; $self->{'pos'} = $self->{'prefix_l'}; if ($rec_ind >= $self->{'prefix_n'}) {
return readline($fh);
} elsif ($rec_ind == 0) { return ( @{$self->{'prefix'}}, readline($fh) );
} else {
return ( @{$self->{'prefix'}}[ $rec_ind .. $ readline($fh) );
}
} else {
my(@array); my($beyond_limit) = 0;
if ($rec_ind == 0) {
@array = @{$self->{'prefix'}};
} elsif ($rec_ind < $self->{'prefix_n'}) {
@array = @{$self->{'prefix'}}[ $rec_ind .. $ }
for my $j (0..$ $pos += length($array[$j]);
if ($pos >= $size_limit && $j < $ $ }
}
my($nread) = 0;
if (!$beyond_limit) {
my($inbuf,$carry);
while ( $nread=read($fh,$inbuf,16384) ) { if ($pos+$nread > $size_limit) {
my($k) = index($inbuf, "\n", $pos >= $size_limit ? 0 : $size_limit-$pos);
$inbuf = substr($inbuf, 0, $k >= 0 ? $k+1 : $size_limit-$pos);
$beyond_limit = 1;
}
$pos += $nread;
my($k) = $ push(@array, split(/^/m, $inbuf, -1));
if (defined $carry) { $array[$k] = $carry.$array[$k]; undef $carry }
$carry = pop(@array) if substr($array[-1],-1,1) ne "\n";
last if $beyond_limit;
}
push(@array,$carry) if defined $carry;
}
$self->{'rec_ind'} = $rec_ind + @array;
$self->{'pos'} = $pos;
if (!defined $nread) {
@array = ();
}
return @array;
}
} elsif ($self->{'rec_ind'} < $self->{'prefix_n'}) {
my($line) = $self->{'prefix'}->[$self->{'rec_ind'}];
$self->{'rec_ind'}++; $self->{'pos'} += length($line);
return $line;
} else {
my($line) = scalar(readline($self->{'handle'}));
if (!defined($line)) { $self->{'eof'} = 1 }
else { $self->{'rec_ind'}++; $self->{'pos'} += length($line) }
return $line;
}
}
sub READ { my($self) = shift; my($len) = $_[1]; my($offset) = $_[2];
my($str) = ''; my($nbytes) = 0;
my($pos) = $self->{'pos'};
my($beyond_limit) = 0;
my($size_limit) = $self->{'size_limit'};
if (defined $size_limit && $pos+$len > $size_limit) {
$len = $pos < $size_limit ? $size_limit - $pos : 0;
$beyond_limit = 1;
}
if ($len > 0 && $pos < $self->{'prefix_l'}) {
$str = substr(join('',@{$self->{'prefix'}}), $pos, $len);
$nbytes += length($str); $len -= $nbytes;
}
my($msg); my($buff_directly_accessed) = 0; $! = 0;
if ($len > 0) {
$buff_directly_accessed = $nbytes == 0;
my($nb) = $buff_directly_accessed
? read($self->{'handle'}, $_[0], $len, $offset)
: read($self->{'handle'}, $str, $len, $nbytes);
if (!defined $nb) {
$msg = "Error reading: $!";
} elsif ($nb < 1) { $self->{'eof'} = 1;
} else {
$nbytes += $nb; $len -= $nb;
}
}
if (defined $msg) {
undef $nbytes; } elsif ($beyond_limit && $nbytes == 0) {
$self->{'eof'} = 1;
} else {
if (!$buff_directly_accessed) {
($offset ? substr($_[0],$offset) : $_[0]) = $str;
}
$pos += $nbytes; $self->{'pos'} = $pos;
}
$nbytes; }
sub close { shift->CLOSE(@_) }
sub fileno { shift->FILENO(@_) }
sub binmode { shift->BINMODE(@_) }
sub seek { shift->SEEK(@_) }
sub read { shift->READ(@_) }
sub readline { shift->READLINE(@_) }
sub getlines { shift->READLINE(@_) }
sub getline { scalar(shift->READLINE(@_)) }
1;
package Amavis::IO::Zlib;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
}
use Errno qw(EIO);
use Compress::Zlib;
sub new {
my($class) = shift; my($self) = bless {}, $class;
if (@_) { $self->open(@_) or return undef }
$self;
}
sub close {
my($self) = shift;
my($status); my($eval_stat);
eval { $status = $self->{fh}->gzclose; 1 }
or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
delete $self->{fh};
if ($status != Z_OK || defined $eval_stat) {
chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; die "gzclose error: $gzerrno"; $! = EIO; return undef; }
1;
}
sub DESTROY {
my($self) = shift; local($@,$!);
if (ref $self && $self->{fh}) { eval { $self->close } }
}
sub open {
my($self,$fname,$mode) = @_;
if (exists($self->{fh})) { eval { $self->close }; delete $self->{fh} }
$self->{fname} = $fname; $self->{mode} = $mode; $self->{pos} = 0;
my($gz) = gzopen($fname,$mode);
if ($gz) { $self->{fh} = $gz }
else {
die "gzopen error: $gzerrno"; $! = EIO; undef $gz; }
$gz;
}
sub seek {
my($self,$pos,$whence) = @_;
$whence == 0 or die "Only absolute seek is supported on gzipped file";
$pos >= 0 or die "Can't seek to a negative absolute position";
$self->{mode} eq 'rb'
or die "Seek to $whence,$pos on gzipped file only supported for 'rb' mode";
if ($pos < $self->{pos}) {
$self->close or die "seek: can't close gzipped file: $!";
$self->open($self->{fname},$self->{mode})
or die "seek: can't reopen gzipped file: $!";
}
my($skip) = $pos - $self->{pos};
while ($skip > 0) {
my($s); my($nbytes) = $self->read($s,$skip); defined $nbytes && $nbytes > 0
or die "seek: error skipping $skip bytes on gzipped file: $!";
$skip -= $nbytes;
}
1; }
sub read { my($self) = shift; my($len) = $_[1]; my($offset) = $_[2];
defined $len or die "Amavis::IO::Zlib::read: length argument undefined";
my($nbytes);
if (!defined($offset) || $offset == 0) {
$nbytes = $self->{fh}->gzread($_[0], $len);
} else {
my($buff);
$nbytes = $self->{fh}->gzread($buff, $len);
substr($_[0],$offset) = $buff;
}
if ($nbytes < 0) {
die "gzread error: $gzerrno"; $! = EIO; undef $nbytes; }
$self->{pos} += $nbytes;
$nbytes; }
sub getline {
my($self) = shift; my($nbytes,$line);
$nbytes = $self->{fh}->gzreadline($line);
if ($nbytes <= 0) { $! = 0; undef $line;
if ($nbytes < 0 && $gzerrno != Z_STREAM_END) {
die "gzreadline error: $gzerrno"; $! = EIO; }
}
$self->{pos} += $nbytes;
$line; }
sub print {
my($self) = shift;
my($buff_ref) = @_ == 1 ? \$_[0] : \join('',@_);
my($nbytes); my($len) = length($$buff_ref);
if ($len <= 0) { $nbytes = "0 but true" }
else {
$nbytes = $self->{fh}->gzwrite($$buff_ref); $self->{pos} += $len;
if ($nbytes <= 0) {
die "gzwrite error: $gzerrno"; $! = EIO; undef $nbytes; }
}
$nbytes;
}
sub printf { shift->print(sprintf(shift,@_)) }
1;
package Amavis::In::Connection;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
}
sub new
{ my($class) = @_; bless {}, $class }
sub client_ip { my($self)=shift; !@_ ? $self->{client_ip} : ($self->{client_ip}=shift) }
sub socket_ip { my($self)=shift; !@_ ? $self->{socket_ip} : ($self->{socket_ip}=shift) }
sub socket_port { my($self)=shift; !@_ ? $self->{socket_port}: ($self->{socket_port}=shift) }
sub socket_proto { my($self)=shift; !@_ ? $self->{socket_proto}:($self->{socket_proto}=shift)}
sub appl_proto { my($self)=shift; !@_ ? $self->{appl_proto} : ($self->{appl_proto}=shift) }
sub smtp_helo { my($self)=shift; !@_ ? $self->{smtp_helo} : ($self->{smtp_helo}=shift) }
1;
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.207';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(setting_by_given_contents_category_all
setting_by_given_contents_category cmp_ccat);
}
sub new { my($class) = @_; bless [(undef) x 35], $class }
sub recip_addr { my($self)=shift; !@_ ? $$self[0] : ($$self[0]=shift) }
sub recip_addr_smtp { my($self)=shift; !@_ ? $$self[1] : ($$self[1]=shift) }
sub recip_addr_modified { my($self)=shift; !@_ ? $$self[2] : ($$self[2]=shift) }
sub recip_is_local { my($self)=shift; !@_ ? $$self[3] : ($$self[3]=shift) }
sub recip_maddr_id { my($self)=shift; !@_ ? $$self[4] : ($$self[4]=shift) }
sub recip_penpals_age { my($self)=shift; !@_ ? $$self[5] : ($$self[5]=shift) }
sub recip_penpals_score { my($self)=shift; !@_ ? $$self[6] : ($$self[6]=shift) }
sub dsn_notify { my($self)=shift; !@_ ? $$self[7] : ($$self[7]=shift) }
sub dsn_orcpt { my($self)=shift; !@_ ? $$self[8] : ($$self[8]=shift) }
sub dsn_suppress_reason { my($self)=shift; !@_ ? $$self[9] : ($$self[9]=shift) }
sub recip_destiny { my($self)=shift; !@_ ? $$self[10] : ($$self[10]=shift) }
sub recip_done { my($self)=shift; !@_ ? $$self[11] : ($$self[11]=shift) }
sub recip_smtp_response { my($self)=shift; !@_ ? $$self[12] : ($$self[12]=shift) }
sub recip_remote_mta_smtp_response { my($self)=shift; !@_ ? $$self[13] : ($$self[13]=shift) }
sub recip_remote_mta { my($self)=shift; !@_ ? $$self[14] : ($$self[14]=shift) }
sub recip_mbxname { my($self)=shift; !@_ ? $$self[15] : ($$self[15]=shift) }
sub recip_whitelisted_sender { my($self)=shift; !@_ ? $$self[16] : ($$self[16]=shift) }
sub recip_blacklisted_sender { my($self)=shift; !@_ ? $$self[17] : ($$self[17]=shift) }
sub recip_score_boost { my($self)=shift; !@_ ? $$self[18] : ($$self[18]=shift) }
sub infected { my($self)=shift; !@_ ? $$self[19] : ($$self[19]=shift) }
sub bypass_virus_checks { my($self)=shift; !@_ ? $$self[20] : ($$self[20]=shift) }
sub bypass_banned_checks { my($self)=shift; !@_ ? $$self[21] : ($$self[21]=shift) }
sub bypass_spam_checks { my($self)=shift; !@_ ? $$self[22] : ($$self[22]=shift) }
sub banned_parts { my($self)=shift; !@_ ? $$self[23] : ($$self[23]=shift) }
sub banning_rule_key { my($self)=shift; !@_ ? $$self[24] : ($$self[24]=shift) }
sub banning_rule_comment { my($self)=shift; !@_ ? $$self[25] : ($$self[25]=shift) }
sub banning_reason_short { my($self)=shift; !@_ ? $$self[26] : ($$self[26]=shift) }
sub banning_rule_rhs { my($self)=shift; !@_ ? $$self[27] : ($$self[27]=shift) }
sub mail_body_mangle { my($self)=shift; !@_ ? $$self[28] : ($$self[28]=shift) }
sub contents_category { my($self)=shift; !@_ ? $$self[29] : ($$self[29]=shift) }
sub blocking_ccat { my($self)=shift; !@_ ? $$self[30] : ($$self[30]=shift) }
sub user_id { my($self)=shift; !@_ ? $$self[31] : ($$self[31]=shift) }
sub user_policy_id { my($self)=shift; !@_ ? $$self[32] : ($$self[32]=shift) }
sub courier_control_file { my($self)=shift; !@_ ? $$self[33] : ($$self[33]=shift) }
sub courier_recip_index { my($self)=shift; !@_ ? $$self[34] : ($$self[34]=shift) }
sub recip_final_addr { my($self)=shift;
my($newaddr) = $self->recip_addr_modified;
defined $newaddr ? $newaddr : $self->recip_addr;
}
sub add_contents_category {
my($self) = shift; my($major,$minor) = @_;
my($aref) = $self->contents_category || [];
if (defined $minor && $minor > 0) { my($el) = sprintf("%d,%d",$major,$minor); my($j)=0;
for (@$aref) { if (cmp_ccat($_,$el) <= 0) { last } else { $j++ } };
if ($j > $ elsif (cmp_ccat($aref->[$j],$el) != 0) { splice(@$aref,$j,0,$el) }
}
my($el) = sprintf("%d",$major); my($j)=0;
for (@$aref) { if (cmp_ccat($_,$el) <= 0) { last } else { $j++ } };
if ($j > $ elsif (cmp_ccat($aref->[$j],$el) != 0)
{ splice(@$aref,$j,0,$el) } $self->contents_category($aref);
}
sub is_in_contents_category {
my($self) = shift; my($major,$minor) = @_;
my($el) = sprintf("%d,%d",$major,$minor);
my($aref) = $self->contents_category;
!defined($aref) ? undef : scalar(grep { cmp_ccat($_,$el) == 0 } @$aref);
}
sub setting_by_main_contents_category($@) {
my($self) = shift; my(@settings_href_list) = @_;
return undef if !@settings_href_list;
my($aref) = $self->contents_category;
setting_by_given_contents_category($aref, @settings_href_list);
}
sub setting_by_main_contents_category_all($@) {
my($self) = shift; my(@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) = shift; my(@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) = shift; my(@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;
package Amavis::In::Message;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::rfc2821_2822_Tools qw(rfc2822_timestamp quote_rfc2821_local
qquote_rfc2821_local);
import Amavis::Util qw(orcpt_encode);
import Amavis::In::Message::PerRecip;
}
sub new
{ my($class) = @_; my($self)=bless({},$class); $self->skip_bytes(0); $self }
sub conn_obj { my($self)=shift; !@_ ? $self->{conn} : ($self->{conn}=shift) }
sub rx_time { my($self)=shift; !@_ ? $self->{rx_time} : ($self->{rx_time}=shift) }
sub partition_tag { my($self)=shift; !@_ ? $self->{partition} : ($self->{partition}=shift) }
sub client_proto { my($self)=shift; !@_ ? $self->{cli_proto} : ($self->{cli_proto}=shift) }
sub client_addr { my($self)=shift; !@_ ? $self->{cli_ip} : ($self->{cli_ip}=shift) }
sub client_addr_mynets { my($self)=shift; !@_ ? $self->{cli_mynets} : ($self->{cli_mynets}=shift) }
sub client_name { my($self)=shift; !@_ ? $self->{cli_name} : ($self->{cli_name}=shift) }
sub client_port { my($self)=shift; !@_ ? $self->{cli_port} : ($self->{cli_port}=shift) }
sub client_source { my($self)=shift; !@_ ? $self->{cli_source} : ($self->{cli_source}=shift) }
sub client_helo { my($self)=shift; !@_ ? $self->{cli_helo} : ($self->{cli_helo}=shift) }
sub client_os_fingerprint { my($self)=shift; !@_ ? $self->{cli_p0f} : ($self->{cli_p0f}=shift) }
sub originating { my($self)=shift; !@_ ? $self->{originating}: ($self->{originating}=shift) }
sub queue_id { my($self)=shift; !@_ ? $self->{queue_id} : ($self->{queue_id}=shift) }
sub log_id { my($self)=shift; !@_ ? $self->{log_id} : ($self->{log_id}=shift) }
sub mail_id { my($self)=shift; !@_ ? $self->{mail_id} : ($self->{mail_id}=shift) }
sub secret_id { my($self)=shift; !@_ ? $self->{secret_id} : ($self->{secret_id}=shift) }
sub msg_size { my($self)=shift; !@_ ? $self->{msg_size} : ($self->{msg_size}=shift) }
sub auth_user { my($self)=shift; !@_ ? $self->{auth_user} : ($self->{auth_user}=shift) }
sub auth_pass { my($self)=shift; !@_ ? $self->{auth_pass} : ($self->{auth_pass}=shift) }
sub auth_submitter { my($self)=shift; !@_ ? $self->{auth_subm} : ($self->{auth_subm}=shift) }
sub tls_cipher { my($self)=shift; !@_ ? $self->{auth_tlscif}: ($self->{auth_tlscif}=shift) }
sub dsn_ret { my($self)=shift; !@_ ? $self->{dsn_ret} : ($self->{dsn_ret}=shift) }
sub dsn_envid { my($self)=shift; !@_ ? $self->{dsn_envid} : ($self->{dsn_envid}=shift) }
sub dsn_passed_on { my($self)=shift; !@_ ? $self->{dsn_pass_on}: ($self->{dsn_pass_on}=shift) }
sub requested_by { my($self)=shift; !@_ ? $self->{requested_by}:($self->{requested_by}=shift)}
sub body_type { my($self)=shift; !@_ ? $self->{body_type} : ($self->{body_type}=shift) }
sub header_8bit { my($self)=shift; !@_ ? $self->{header_8bit}: ($self->{header_8bit}=shift) }
sub body_8bit { my($self)=shift; !@_ ? $self->{body_8bit}: ($self->{body_8bit}=shift) }
sub sender { my($self)=shift; !@_ ? $self->{sender} : ($self->{sender}=shift) }
sub sender_smtp { my($self)=shift; !@_ ? $self->{sender_smtp}: ($self->{sender_smtp}=shift) }
sub sender_credible { my($self)=shift; !@_ ? $self->{sender_cred}: ($self->{sender_cred}=shift) }
sub sender_contact { my($self)=shift; !@_ ? $self->{sender_c} : ($self->{sender_c}=shift) }
sub sender_source { my($self)=shift; !@_ ? $self->{sender_src} : ($self->{sender_src}=shift) }
sub sender_maddr_id { my($self)=shift; !@_ ? $self->{maddr_id} : ($self->{maddr_id}=shift) }
sub mime_entity { my($self)=shift; !@_ ? $self->{mime_entity}: ($self->{mime_entity}=shift)}
sub parts_root { my($self)=shift; !@_ ? $self->{parts_root} : ($self->{parts_root}=shift)}
sub skip_bytes { my($self)=shift; !@_ ? $self->{file_ofs} : ($self->{file_ofs}=shift) }
sub mail_text { my($self)=shift; !@_ ? $self->{mail_text} : ($self->{mail_text}=shift) }
sub mail_text_fn { my($self)=shift; !@_ ? $self->{mailtextfn} : ($self->{mailtextfn}=shift) }
sub mail_tempdir { my($self)=shift; !@_ ? $self->{mailtempdir}: ($self->{mailtempdir}=shift)}
sub header_edits { my($self)=shift; !@_ ? $self->{hdr_edits} : ($self->{hdr_edits}=shift) }
sub rfc2822_from { my($self)=shift; !@_ ? $self->{hdr_from} : ($self->{hdr_from}=shift) }
sub rfc2822_sender { my($self)=shift; !@_ ? $self->{hdr_sender} : ($self->{hdr_sender}=shift) }
sub rfc2822_resent_from { my($self)=shift; !@_ ? $self->{hdr_rfrom} : ($self->{hdr_rfrom}=shift) }
sub rfc2822_resent_sender { my($self)=shift; !@_ ? $self->{hdr_rsender}: ($self->{hdr_rsender}=shift) }
sub rfc2822_to { my($self)=shift; !@_ ? $self->{hdr_to} : ($self->{hdr_to}=shift) }
sub rfc2822_cc { my($self)=shift; !@_ ? $self->{hdr_cc} : ($self->{hdr_cc}=shift) }
sub orig_header_fields { my($self)=shift; !@_ ? $self->{orig_hdr_f} : ($self->{orig_hdr_f}=shift) }
sub orig_header { my($self)=shift; !@_ ? $self->{orig_header}: ($self->{orig_header}=shift) }
sub orig_header_size { my($self)=shift; !@_ ? $self->{orig_hdr_s} : ($self->{orig_hdr_s}=shift) }
sub orig_body_size { my($self)=shift; !@_ ? $self->{orig_bdy_s} : ($self->{orig_bdy_s}=shift) }
sub body_digest { my($self)=shift; !@_ ? $self->{body_digest}: ($self->{body_digest}=shift) }
sub is_mlist { my($self)=shift; !@_ ? $self->{is_mlist} : ($self->{is_mlist}=shift) }
sub is_auto { my($self)=shift; !@_ ? $self->{is_auto} : ($self->{is_auto}=shift) }
sub is_bulk { my($self)=shift; !@_ ? $self->{is_bulk} : ($self->{is_bulk}=shift) }
sub dkim_signatures_all { my($self)=shift; !@_ ? $self->{dkim_sall} : ($self->{dkim_sall}=shift) }
sub dkim_signatures_valid { my($self)=shift; !@_ ? $self->{dkim_sval} : ($self->{dkim_sval}=shift) }
sub dkim_author_sig { my($self)=shift; !@_ ? $self->{dkim_auth_s}: ($self->{dkim_auth_s}=shift) }
sub dkim_thirdparty_sig { my($self)=shift; !@_ ? $self->{dkim_3rdp_s}: ($self->{dkim_3rdp_s}=shift) }
sub dkim_sender_sig { my($self)=shift; !@_ ? $self->{dkim_sndr_s}: ($self->{dkim_sndr_s}=shift) }
sub dkim_envsender_sig { my($self)=shift; !@_ ? $self->{dkim_envs_s}: ($self->{dkim_envs_s}=shift) }
sub quarantined_to { my($self)=shift; !@_ ? $self->{quarantine} : ($self->{quarantine}=shift) }
sub quar_type { my($self)=shift; !@_ ? $self->{quar_type} : ($self->{quar_type}=shift) }
sub dsn_sent { my($self)=shift; !@_ ? $self->{dsn_sent} : ($self->{dsn_sent}=shift) }
sub delivery_method { my($self)=shift; !@_ ? $self->{deliv_method}:($self->{deliv_method}=shift)}
sub client_delete { my($self)=shift; !@_ ? $self->{client_del} :($self->{client_del}=shift)}
sub contents_category { my($self)=shift; !@_ ? $self->{category} : ($self->{category}=shift) }
sub blocking_ccat { my($self)=shift; !@_ ? $self->{bl_ccat} : ($self->{bl_ccat}=shift) }
sub virusnames { my($self)=shift; !@_ ? $self->{virusnames} : ($self->{virusnames}=shift) }
sub spam_level
{ my($self)=shift; !@_ ? $self->{spam_level} :($self->{spam_level}=shift)}
sub spam_status { my($self)=shift; !@_ ? $self->{spam_status} :($self->{spam_status}=shift)}
sub spam_report { my($self)=shift; !@_ ? $self->{spam_report} :($self->{spam_report}=shift)}
sub spam_summary { my($self)=shift; !@_ ? $self->{spam_summary}:($self->{spam_summary}=shift)}
sub supplementary_info { my($self)=shift; my($key)=shift;
!@_ ? $self->{info_tag}{$key} : ($self->{info_tag}{$key}=shift);
}
*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;
sub per_recip_data { my($self) = shift;
if (@_) { $self->{recips} = [@{$_[0]}] }
$self->{recips}; }
sub recips { my($self)=shift;
if (@_) { 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(orcpt_encode($per_recip_obj->recip_addr_smtp))
if $set_dsn_orcpt_too;
$per_recip_obj->recip_destiny(D_PASS); $per_recip_obj } @{$recips_list_ref} ]);
}
return if !defined wantarray; [ map { $_->recip_addr } @{$self->per_recip_data} ];
}
sub header_field_signed_by {
my($self,$header_field_index) = @_; shift; shift;
my($h) = $self->{hdr_sig_ind}; my($hf);
if (@_) {
$self->{hdr_sig_ind} = $h = [] if !$h;
$hf = $h->[$header_field_index];
$h->[$header_field_index] = $hf = [] if !$hf;
push(@$hf, @_); }
$hf = $h->[$header_field_index] if $h && !$hf;
$hf ? @{$hf} : ();
}
sub get_header_field {
my($self,$field_name,$j) = @_;
my($field_ind,$field); my($all_fields) = $self->orig_header;
$field_name = lc($field_name) if defined $field_name;
if (!ref($all_fields)) {
} elsif (defined($field_name) && (!defined($j) || $j == -1)) {
$field_ind = $self->orig_header_fields->{$field_name};
} elsif ($j >= 0) { if (!defined($field_name)) { $field_ind = $j if $j <= $ } else {
my($ind) = 0; my($cnt) = 0; local($1);
for my $f (@$all_fields) {
if ($f =~ /^([^: \t]+)[ \t]*:/s && lc($1) eq $field_name) {
if ($cnt++ == $j) { $field_ind = $ind; last }
}
$ind++;
}
}
} else { if (!defined($field_name)) { $j += @$all_fields; $field_ind = $j if $j >= 0;
} else {
my($cnt) = 0; local($1); $j = -1 - $j;
for (my $ind = $ my($f) = $all_fields->[$ind];
if ($f =~ /^([^: \t]+)[ \t]*:/s && lc($1) eq $field_name) {
if ($cnt++ == $j) { $field_ind = $ind; last }
}
}
}
}
if (defined($field_ind) && wantarray) {
$field = $all_fields->[$field_ind];
$field_name = lc($1) if $field =~ /^([^: \t]+)[ \t]*:/s;
}
!wantarray ? $field_ind : ($field_ind, $field_name, $field);
}
sub get_header_field_body {
my($self,$field_name,$j) = @_;
my($k); my($f_i,$f_n,$f) = $self->get_header_field($field_name,$j);
defined $f && ($k=index($f,':')) >= 0 ? substr($f,$k+1) : $f;
}
1;
package Amavis::Out::EditHeader;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&hdr);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(wrap_string);
import Amavis::Util qw(ll do_log safe_encode q_encode);
}
use MIME::Words;
sub new { my($class) = @_; bless {}, $class }
sub prepend_header($$$;$) {
my($self, $field_name, $field_body, $structured) = @_;
unshift(@{$self->{prepend}}, hdr($field_name,$field_body,$structured));
}
sub append_header($$$;$) {
my($self, $field_name, $field_body, $structured) = @_;
push(@{$self->{append}}, hdr($field_name,$field_body,$structured));
}
sub append_header_above_received($$$;$) {
my($self, $field_name, $field_body, $structured) = @_;
push(@{$self->{addrcvd}}, hdr($field_name,$field_body,$structured));
}
sub add_header($$$;$) {
my($self, $field_name, $field_body, $structured) = @_;
push(@{$self->{addrcvd}}, hdr($field_name,$field_body,$structured));
}
sub delete_header($$) {
my($self, $field_name) = @_;
$self->{edit}{lc($field_name)} = [undef];
}
sub edit_header($$$;$) {
my($self, $field_name, $field_edit_sub, $structured) = @_;
!defined($field_edit_sub) || ref($field_edit_sub) eq 'CODE'
or die "edit_header: arg#3 must be undef or a subroutine ref";
$field_name = lc($field_name);
if (!exists($self->{edit}{$field_name})) {
$self->{edit}{$field_name} = [$field_edit_sub];
} else {
do_log(2, "INFO: multiple header edits: %s", $field_name);
push(@{$self->{edit}{$field_name}}, $field_edit_sub);
}
}
sub inherit_header_edits($$) {
my($self, $other_edits) = @_;
if (defined $other_edits) {
for (qw(prepend addrcvd append))
{ unshift(@{$self->{$_}}, @{$other_edits->{$_}}) if $other_edits->{$_} }
if ($other_edits->{edit}) {
for (keys %{$other_edits->{edit}})
{ $self->{edit}{$_} = [ @{$other_edits->{edit}{$_}} ] } }
}
}
sub hdr($$$;$) {
my($field_name, $field_body, $structured, $wrap_char) = @_;
$wrap_char = "\t" if !defined $wrap_char;
local($1);
if ($field_name =~ /^ (?: Subject\z | Comments\z |
X- (?! Envelope- (?:From|To)\z ) )/six &&
$field_body !~ /^[\t\n\040-\176]*\z/ ) { $field_body =~ s/\n(?=[ \t])//gs; # unfold
chomp($field_body);
my($field_body_octets);
my($chset) = c('hdr_encoding'); my($qb) = c('hdr_encoding_qb');
if (!$unicode_aware) { $field_body_octets = $field_body }
else {
$field_body_octets = safe_encode($chset, $field_body);
}
my($encoder_func) = uc($qb) eq 'Q' ? \&q_encode
: \&MIME::Words::encode_mimeword;
$field_body = join("\n", map { /^[\001-\011\013\014\016-\177]*\z/ ? $_
: &$encoder_func($_,$qb,$chset) }
split(/\n/, $field_body_octets, -1));
} else { $field_body = safe_encode('ascii', $field_body);
}
$field_name = safe_encode('ascii', $field_name);
my($str) = $field_name . ':';
$str .= ' ' if $field_body !~ /^[ \t\n]/;
$str .= $field_body;
if ($structured == 2) { 1 while $str =~ s/^([ \t]*)\n/$1/; $str =~ s/\n(?=[ \t]*(\n|\z))//g; # whitespace lines within or at end
$str =~ s/\n(?![ \t])/\n /g; } else {
$wrap_char = "\t" if !defined $wrap_char;
$str = wrap_string($str, 78, '', $wrap_char, $structured
) if $structured==1 || length($str) > 78;
}
if (length($str) > 998) {
my(@lines) = split(/\n/,$str); my($trunc) = 0;
for (@lines)
{ if (length($_) > 998) { $_ = substr($_,0,998-3).'...'; $trunc = 1 } }
if ($trunc) {
do_log(0, "INFO: truncating long header field (len=%d): %s[...]",
length($str), substr($str,0,100) );
$str = join("\n",@lines);
}
}
$str .= "\n" if $str !~ /\n\z/; do_log(5, "header: %s", $str);
$str;
}
sub write_header($$$$) {
my($self, $msg, $out_fh, $noninitial_submission) = @_;
my($fix_whitespace_lines) = 0; my($fix_long_header_lines) = 0;
my($fix_bare_cr) = 0;
if ($noninitial_submission && c('allow_fixing_improper_header')) {
$fix_bare_cr = 1;
$fix_long_header_lines = 1 if c('allow_fixing_long_header_lines');
$fix_whitespace_lines = 1 if c('allow_fixing_improper_header_folding');
}
my($is_mime) = ref($msg) && $msg->isa('MIME::Entity') ? 1 : 0;
do_log(5, "write_header: %s, %s", $is_mime,$out_fh);
my(@header);
if ($is_mime) {
@header = map { /^[ \t]*\n?\z/ ? () : (/\n\z/ ? $_ : $_ . "\n") } @{$msg->header};
}
my($received_cnt) = 0; my($str) = '';
for (@{$self->{prepend}}) { $str .= $_ }
for (@{$self->{addrcvd}}) { $str .= $_ }
if ($str ne '') { $out_fh->print($str) or die "sending mail header1: $!" }
if (!defined($msg)) {
} else {
local($1,$2); my($curr_head,$next_head); my($eof) = 0;
my($ill_white_cnt) = 0; my($ill_long_cnt) = 0; my($ill_bare_cr) = 0;
for (;;) {
if ($eof) {
$next_head = "\n"; } elsif ($is_mime) {
if (@header) { $next_head = shift @header }
else { $eof = 1; $next_head = "\n" }
} else {
$! = 0; $next_head = $msg->getline;
if (!defined($next_head)) {
$eof = 1; $next_head = "\n";
$!==0 or die "Error reading mail header section: $!";
}
}
if ($next_head =~ /^[ \t]/) {
$curr_head .= $next_head; } else { if (!defined($curr_head)) {
} elsif ($curr_head !~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s) { } else { my($field_name, $field_body) = ($1, $2);
my($field_name_lc) = lc($field_name);
$received_cnt++ if $field_name_lc eq 'received';
if (exists($self->{edit}{$field_name_lc})) {
chomp($field_body);
my($edit) = $self->{edit}{$field_name_lc}; for my $e (@$edit) { if (!defined($e)) { undef $curr_head; last } my($new_fbody,$verbatim) = &$e($field_name,$field_body);
if (!defined($new_fbody)) { undef $curr_head; last } $curr_head = $verbatim ? ($field_name . ':' . $new_fbody)
: hdr($field_name, $new_fbody, 0);
chomp($curr_head); $curr_head .= "\n";
$curr_head =~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s;
$field_body = $2; chomp($field_body); }
}
}
if (defined $curr_head) {
if ($fix_bare_cr) { $curr_head =~ tr/\r//d and $ill_bare_cr++;
}
if ($fix_whitespace_lines) { $curr_head =~ s/\n(?=[ \t]*\n)//g and $ill_white_cnt++;
}
if ($fix_long_header_lines) { $curr_head =~ s{^(.{995}).{4,}$}{$1...}mg and $ill_long_cnt++;
}
$out_fh->print($curr_head) or die "sending mail header2: $!";
}
last if $next_head eq "\n"; last if $next_head =~ /^--/; $curr_head = $next_head;
}
}
do_log(0, "INFO: unfolded %d illegal all-whitespace ".
"continuation lines", $ill_white_cnt) if $ill_white_cnt;
do_log(0, "INFO: truncated %d header line(s) longer than 998 characters",
$ill_long_cnt) if $ill_long_cnt;
do_log(0, "INFO: removed bare CR from %d header line(s)",
$ill_bare_cr) if $ill_bare_cr;
}
$str = '';
for (@{$self->{append}}) { $str .= $_ }
$str .= "\n"; $out_fh->print($str) or die "sending mail header7: $!";
section_time('write-header');
$received_cnt;
}
1;
package Amavis::Out;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_dispatch);
import Amavis::Conf qw(:platform :confvars c cr ca $relayhost_is_client);
import Amavis::Util qw(ll do_log dynamic_destination);
}
sub mail_dispatch($$$$;$) {
my($conn) = shift;
my($msginfo,$initial_submission,$dsn_per_recip_capable,$filter) = @_;
my($tmp_hdr_edits);
my($saved_hdr_edits) = $msginfo->header_edits;
if ($enable_dkim_signing) { my(@signatures) = Amavis::DKIM::dkim_make_signatures($msginfo,0);
if (@signatures && !defined($tmp_hdr_edits)) {
$tmp_hdr_edits = Amavis::Out::EditHeader->new;
$tmp_hdr_edits->inherit_header_edits($msginfo->header_edits);
}
for my $signature (@signatures) {
my($s) = $signature->as_string;
local($1); $s =~ s{\015\012}{\n}gs; $s =~ s{\n+\z}{}gs;
$s =~ s/^((?:DKIM|DomainKey)-Signature):[ \t]*//si;
$tmp_hdr_edits->prepend_header($1, $s, 2);
}
$msginfo->header_edits($tmp_hdr_edits) if defined $tmp_hdr_edits;
}
my($via) = $msginfo->delivery_method;
if ($via =~ /^(?:smtp|lmtp):/i) {
Amavis::Out::SMTP::mail_via_smtp(
dynamic_destination($via,$conn,$relayhost_is_client), @_);
} elsif ($via =~ /^pipe:/i) {
Amavis::Out::Pipe::mail_via_pipe($via, @_);
} elsif ($via =~ /^bsmtp:/i) {
Amavis::Out::BSMTP::mail_via_bsmtp($via, @_);
} elsif ($via =~ /^sql:/i) {
$Amavis::extra_code_sql_quar && $Amavis::sql_storage
or die "SQL quarantine code not enabled";
Amavis::Out::SQL::Quarantine::mail_via_sql(
$Amavis::sql_dataset_conn_storage, @_);
} elsif ($via =~ /^local:/i) {
Amavis::Out::Local::mail_to_local_mailbox(
$via, $msginfo, $initial_submission,
sub { shift->recip_final_addr !~ /\@/ ? 1 : 0 });
if (grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
my($nm) = c('notify_method'); if ($nm =~ /^(?:smtp|lmtp):/i) {
Amavis::Out::SMTP::mail_via_smtp(
dynamic_destination($nm,$conn,$relayhost_is_client),@_) }
elsif ($nm =~ /^pipe:/i) { Amavis::Out::Pipe::mail_via_pipe($nm, @_) }
elsif ($nm =~ /^bsmtp:/i) { Amavis::Out::BSMTP::mail_via_bsmtp($nm, @_) }
elsif ($nm =~ /^sql:/i) {
$Amavis::extra_code_sql_quar && $Amavis::sql_storage
or die "SQL quarantine code not enabled";
Amavis::Out::SQL::Quarantine::mail_via_sql(
$Amavis::sql_dataset_conn_storage, @_);
}
}
}
$msginfo->header_edits($saved_hdr_edits) if defined $tmp_hdr_edits;
}
1;
package Amavis::UnmangleSender;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&parse_ip_address_from_received &best_try_originator
&first_received_from);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Util qw(ll do_log unique_list);
import Amavis::rfc2821_2822_Tools qw(
split_address parse_received fish_out_ip_from_received);
import Amavis::Lookup qw(lookup lookup2);
import Amavis::Lookup::IP qw(lookup_ip_acl);
}
use subs @EXPORT_OK;
sub first_received_from($) {
my($msginfo) = @_;
my($first_received);
my($fields_ref) =
parse_received($msginfo->get_header_field_body('received')); if (exists $fields_ref->{'from'}) {
$first_received = join(' ', unique_list(grep { defined }
@$fields_ref{qw(from from-tcp from-com)}));
do_log(5, "first_received_from: %s", $first_received);
}
$first_received;
}
use vars qw(@nonhostlocalnetworks_maps @publicnetworks_maps);
sub parse_ip_address_from_received($;$) {
my($msginfo,$search_top_down) = @_;
$search_top_down = 0 if !defined $search_top_down;
@publicnetworks_maps = (
Amavis::Lookup::Label->new('publicnetworks'),
Amavis::Lookup::IP->new(qw(
!0.0.0.0/8 !127.0.0.0/8 !169.254.0.0/16 !:: !::1 !FE80::/10
!172.16.0.0/12 !192.168.0.0/16 !10.0.0.0/8 !FEC0::/10
!192.88.99.0/24 !240.0.0.0/4 !224.0.0.0/4 !FF00::/8
::FFFF:0:0/96 ::/0)) ) if !@publicnetworks_maps; my($received_from_ip);
my(@search_list) = $search_top_down ? (0,1) : (-1,-2,-3,-4,-5,-6); for my $j (@search_list) { my($r) = $msginfo->get_header_field_body('received',$j);
last if !defined $r;
$received_from_ip = fish_out_ip_from_received($r);
if ($received_from_ip ne '') {
last if $search_top_down; my($is_public,$fullkey,$err) =
lookup_ip_acl($received_from_ip,@publicnetworks_maps);
last if (!defined($err) || $err eq '') && $is_public;
}
}
do_log(5, "parse_ip_address_from_received: %s", $received_from_ip);
$received_from_ip;
}
sub best_try_originator($) {
my($msginfo) = @_;
my($sender_contact,$sender_source);
$sender_contact = $sender_source = $msginfo->sender;
my($virusname_list) = $msginfo->virusnames;
for my $vn (!defined($virusname_list) ? () : @$virusname_list) {
my($result,$match) = lookup2(0,$vn, ca('viruses_that_fake_sender_maps'));
if ($result) { do_log(2,"Virus %s matches %s, sender addr ignored",$vn,$match);
undef $sender_contact; undef $sender_source;
my($first_rcvd_from_ip) = parse_ip_address_from_received($msginfo);
if ($first_rcvd_from_ip ne '') {
$sender_source = sprintf('?@[%s]', $first_rcvd_from_ip);
}
last;
}
}
($sender_contact, $sender_source);
}
1;
package Amavis::Unpackers::NewFilename;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&consumed_bytes);
import Amavis::Conf qw(c cr ca
$MIN_EXPANSION_QUOTA $MIN_EXPANSION_FACTOR
$MAX_EXPANSION_QUOTA $MAX_EXPANSION_FACTOR);
import Amavis::Util qw(ll do_log min max);
}
use vars qw($avail_quota); use vars qw($rem_quota);
sub new($;$$) { my($class, $maxfiles,$mail_size) = @_;
$avail_quota = $rem_quota = max($MIN_EXPANSION_QUOTA, $mail_size * $MIN_EXPANSION_FACTOR,
min($MAX_EXPANSION_QUOTA, $mail_size * $MAX_EXPANSION_FACTOR));
do_log(4,"Original mail size: %d; quota set to: %d bytes",
$mail_size,$avail_quota);
bless {
num_of_issued_names => 0, first_issued_ind => 1, last_issued_ind => 0,
maxfiles => $maxfiles, objlist => [],
}, $class;
}
sub parts_list_reset($) { my($self) = shift;
$self->{num_of_issued_names} = 0;
$self->{first_issued_ind} = $self->{last_issued_ind} + 1;
$self->{objlist} = [];
}
sub parts_list($) { my($self) = shift;
$self->{objlist};
}
sub parts_list_add($$) { my($self, $part) = @_;
push(@{$self->{objlist}}, $part);
}
sub generate_new_num($$) { my($self, $ignore_limit) = @_;
$ignore_limit = 0 if !defined $ignore_limit;
if (!$ignore_limit && defined($self->{maxfiles}) &&
$self->{num_of_issued_names} >= $self->{maxfiles}) {
die "Maximum number of files ($self->{maxfiles}) exceeded";
}
$self->{num_of_issued_names}++; $self->{last_issued_ind}++;
$self->{last_issued_ind};
}
sub consumed_bytes($$;$$) {
my($bytes, $bywhom, $tentatively, $exquota) = @_;
if (ll(4)) {
my($perc) = !$avail_quota ? '' : sprintf(", (%.0f%%)",
100 * ($avail_quota - ($rem_quota - $bytes)) / $avail_quota);
do_log(4,"Charging %d bytes to remaining quota %d (out of %d%s) - by %s",
$bytes, $rem_quota, $avail_quota, $perc, $bywhom);
}
if ($bytes > $rem_quota && $rem_quota >= 0) {
my($msg) = "Exceeded storage quota $avail_quota bytes by $bywhom; ".
"last chunk $bytes bytes";
do_log(-1, "%s", $msg);
die "$msg\n" if !$exquota; }
$rem_quota -= $bytes unless $tentatively;
$rem_quota; }
1;
package Amavis::Unpackers::Part;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log);
}
use vars qw($file_generator_object);
sub init($) { $file_generator_object = shift }
sub new($;$$$) { my($class, $dir_name,$parent,$ignore_limit) = @_;
my($self) = bless {}, $class;
if (!defined($dir_name) && !defined($parent)) {
} else {
$self->number($file_generator_object->generate_new_num($ignore_limit));
$self->dir_name($dir_name) if defined $dir_name;
if (defined $parent) {
$self->parent($parent);
my($ch_ref) = $parent->children;
push(@$ch_ref,$self); $parent->children($ch_ref);
}
$file_generator_object->parts_list_add($self); ll(4) && do_log(4, "Issued a new %s: %s",
defined $dir_name ? "file name" : "pseudo part", $self->base_name);
}
$self;
}
sub number
{ my($self)=shift; !@_ ? $self->{number} : ($self->{number}=shift) };
sub dir_name
{ my($self)=shift; !@_ ? $self->{dir_name} : ($self->{dir_name}=shift) };
sub parent
{ my($self)=shift; !@_ ? $self->{parent} : ($self->{parent}=shift) };
sub children
{ my($self)=shift; !@_ ? $self->{children}||[] : ($self->{children}=shift) };
sub mime_placement { my($self)=shift; !@_ ? $self->{place} : ($self->{place}=shift) };
sub type_short { my($self)=shift; !@_ ? $self->{ty_short} : ($self->{ty_short}=shift) };
sub type_long
{ my($self)=shift; !@_ ? $self->{ty_long} : ($self->{ty_long}=shift) };
sub type_declared
{ my($self)=shift; !@_ ? $self->{ty_decl} : ($self->{ty_decl}=shift) };
sub name_declared { my($self)=shift; !@_ ? $self->{nm_decl} : ($self->{nm_decl}=shift) };
sub report_type { my($self)=shift; !@_ ? $self->{rep_typ} : ($self->{rep_typ}=shift) };
sub size
{ my($self)=shift; !@_ ? $self->{size} : ($self->{size}=shift) };
sub exists
{ my($self)=shift; !@_ ? $self->{exists} : ($self->{exists}=shift) };
sub attributes { my($self)=shift; !@_ ? $self->{attr} : ($self->{attr}=shift) };
sub attributes_add { my($self)=shift; my($a) = $self->{attr} || [];
for my $arg (@_) { push(@$a,$arg) if $arg ne '' && !grep {$_ eq $arg} @$a }
$self->{attr} = $a;
};
sub base_name { my($self)=shift; sprintf("p%03d",$self->number) }
sub full_name {
my($self)=shift; my($d) = $self->dir_name;
!defined($d) ? undef : $d.'/'.$self->base_name;
}
sub path {
my($self)=shift;
my(@path);
for (my($p)=$self; defined($p); $p=$p->parent) { unshift(@path,$p) }
\@path;
};
1;
package Amavis::Unpackers::OurFiler;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter MIME::Parser::Filer); }
sub new($$$) {
my($class, $dir, $parent_obj) = @_;
$dir =~ s{/+\z}{}; bless {parent => $parent_obj, directory => $dir}, $class;
}
sub output_path($@) {
my($self, $head) = @_;
my($newpart_obj) =
Amavis::Unpackers::Part->new($self->{directory}, $self->{parent}, 1);
get_amavisd_part($head, $newpart_obj); $newpart_obj->full_name;
}
sub get_amavisd_part($;$) {
my($head) = shift;
!@_ ? $head->{amavisd_parts_obj} : ($head->{amavisd_parts_obj} = shift);
}
1;
package Amavis::Unpackers::Validity;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&check_header_validity &check_for_banned_names);
import Amavis::Util qw(ll do_log min max sanitize_str);
import Amavis::Conf qw(:platform %banned_rules c cr ca);
import Amavis::Lookup qw(lookup lookup2);
}
use subs @EXPORT_OK;
sub check_header_validity($$) {
my($conn, $msginfo) = @_;
local($1,$2,$3); my(@bad); my($minor_badh_category) = 0;
my(%field_head_counts);
my($allowed_tests) = cr('allowed_header_tests');
my(%t) = !ref($allowed_tests) ? () : %$allowed_tests;
for my $curr_head (@{$msginfo->orig_header}) { my($field_name,$msg1,$msg2); my($pre,$mid,$post);
$field_name = $1 if $curr_head =~ /^([!-9;-\176]+)[ \t]*:/s;
$field_head_counts{lc($field_name)}++ if defined $field_name;
if (!defined($field_name) || $field_name =~ /^--/) {
if ($t{'syntax'}) {
$msg1 = "Invalid header field syntax";
$pre = ''; $mid = ''; $post = $curr_head;
$minor_badh_category = max(6, $minor_badh_category);
}
} elsif ($t{'empty'} && $curr_head =~ /^(.*?)^([ \t]+)(?=\n|\z)/gms) {
$msg1 ="Improper folded header field made up entirely of whitespace";
$pre = $1; $mid = $2; $post = substr($curr_head,pos($curr_head));
$minor_badh_category = max(4, $minor_badh_category);
} elsif ($t{'long'} &&
$curr_head =~ /^(.*?)^([^\n]{999,})(?=\n|\z)/gms) {
$msg1 = "Header line longer than 998 characters";
$pre = $1; $mid = $2; $post = substr($curr_head,pos($curr_head));
$minor_badh_category = max(5, $minor_badh_category);
} elsif ($t{'control'} && $curr_head =~ /^(.*?)([\000\015])/gs) {
$msg1 = "Improper use of control character";
$pre = $1; $mid = $2; $post = substr($curr_head,pos($curr_head));
$minor_badh_category = max(3, $minor_badh_category);
} elsif ($t{'8bit'} && $curr_head =~ /^(.*?)([\200-\377])/gs) {
$msg1 = "Non-encoded 8-bit data";
$pre = $1; $mid = $2; $post = substr($curr_head,pos($curr_head));
$minor_badh_category = max(2, $minor_badh_category);
} elsif ($t{'8bit'} && $curr_head =~ /^(.*?)([^\000-\377])/gs) {
$msg1 = "Non-encoded Unicode character"; $pre = $1; $mid = $2; $post = substr($curr_head,pos($curr_head));
$minor_badh_category = max(2, $minor_badh_category);
}
if (defined $msg1) {
chomp($post);
if (length($mid) > 20) { $mid = substr($mid, 0,15) . "..." }
if (length($post) > 20) { $post = substr($post,0,15) . "[...]" }
if (length($pre)-length($field_name)-2 > 50-length($post)) {
$pre = "$field_name: ..."
. substr($pre, length($pre) - (45-length($post)));
}
$msg1 .= sprintf(" (char %02X hex)", ord($mid)) if length($mid)==1;
$msg2 = sanitize_str($pre); my($msg2_pre_l) = length($msg2);
$msg2 .= sanitize_str($mid . $post);
push(@bad, "$msg1: $msg2");
}
last if @bad >= 100; }
for (qw(Date From Sender Reply-To To Cc Bcc Subject Message-ID References
In-Reply-To MIME-Version Content-Type Content-Transfer-Encoding
Content-ID Content-Description Content-Disposition Auto-Submitted)) {
my($n) = $field_head_counts{lc($_)};
if ($n < 1 && $t{'missing'} && /^(?:Date|From)\z/i) {
push(@bad, "Missing required header field: \"$_\"");
$minor_badh_category = max(7, $minor_badh_category);
} elsif ($n > 1 && $t{'multiple'}) {
if ($n == 2) {
push(@bad, "Duplicate header field: \"$_\"");
} else {
push(@bad, sprintf('Header field occurs more than once: "%s" '.
'occurs %d times', $_, $n));
}
$minor_badh_category = max(8, $minor_badh_category);
}
}
if (!@bad)
{ do_log(5,"check_header: %d, OK", $minor_badh_category) }
elsif (ll(2))
{ do_log(2,"check_header: %d, %s", $minor_badh_category, $_) for @bad }
(\@bad, $minor_badh_category);
}
sub check_for_banned_names($) {
my($msginfo) = @_;
do_log(3, "Checking for banned types and filenames");
my($bfnmr) = ca('banned_filename_maps'); my(@recip_tables); my($any_table_in_recip_tables) = 0; my($any_not_bypassed) = 0;
for my $r (@{$msginfo->per_recip_data}) {
my($recip) = $r->recip_addr;
my(@tables,@tables_m); if (!$r->bypass_banned_checks) { $any_not_bypassed = 1;
my($t_ref,$m_ref) = lookup2(1,$recip,$bfnmr);
if (defined $t_ref) {
for my $ti (0..$ my($t) = $t_ref->[$ti];
if (!defined($t)) { } elsif (ref($t) eq 'ARRAY') { push(@tables, @$t);
push(@tables_m, ($m_ref->[$ti]) x @$t);
} else { my(@names); my(@rawnames) = grep { !/^[, ]*\z/ }
($t =~ /\G (?: " (?: \\. | [^"\\] ){0,999} "
| [^, ] )+ | [, ]+/gcsx);
# in principle quoted strings could be used
# to construct lookup tables on-the-fly (not implemented)
for my $n (@rawnames) { # collect only valid names
if (!exists($banned_rules{$n})) {
do_log(2,"INFO: unknown banned table name %s, recip=%s",
$n,$recip);
} elsif (!defined($banned_rules{$n})) { # ignore undef
} else { push(@names,$n) }
}
ll(3) && do_log(3,"collect banned table[%d]: %s, tables: %s",
$ti,$recip, join(', ',map { $_.'=>'.$banned_rules{$_} } @names));
if (@names) { # any known and valid table names?
push(@tables, map { $banned_rules{$_} } @names);
push(@tables_m, ($m_ref->[$ti]) x @names);
}
}
}
}
}
push(@recip_tables, { r => $r, recip => $recip,
tables => \@tables, tables_m => \@tables_m } );
$any_table_in_recip_tables=1 if @tables;
}
my($bnpre) = cr('banned_namepath_re');
$bnpre = $$bnpre if ref($bnpre) eq 'REF'; # allow one level of indirection
if (!$any_not_bypassed) {
do_log(3,"skipping banned check: all recipients bypass banned checks");
} elsif (!$any_table_in_recip_tables && !ref($bnpre)) {
do_log(3,"skipping banned check: no applicable lookup tables");
} else {
do_log(4,"starting banned checks - traversing message structure tree");
my($parts_root) = $msginfo->parts_root;
my($part);
for (my(@unvisited)=($parts_root);
@unvisited and $part=shift(@unvisited);
push(@unvisited,@{$part->children}))
{ # traverse decomposed parts tree breadth-first
my(@path) = @{$part->path};
next if @path <= 1;
shift(@path); # ignore place-holder root node
next if @{$part->children}; # ignore non-leaf nodes
my(@descr_trad); # a part path: list of predecessors of a message part
my(@descr); # same, but in form suitable for check on banned_namepath_re
for my $p (@path) {
my(@k,$n);
$n = $p->base_name;
if ($n ne '') { $n=~s/[\t\n]/ /g; push(@k,"P=$n") }
$n = $p->mime_placement;
if ($n ne '') { $n=~s/[\t\n]/ /g; push(@k,"L=$n") }
$n = $p->type_declared;
$n = [$n] if !ref($n);
for (@$n) {if ($_ ne ''){my($m)=$_; $m=~s/[\t\n]/ /g; push(@k,"M=$m")}}
$n = $p->type_short;
$n = [$n] if !ref($n);
for (@$n) {if (defined($_) && $_ ne '')
{my($m)=$_; $m=~s/[\t\n]/ /g; push(@k,"T=$m")} }
$n = $p->name_declared;
$n = [$n] if !ref($n);
for (@$n) {if (defined($_) && $_ ne '')
{my($m)=$_; $m=~s/[\t\n]/ /g; push(@k,"N=$m")} }
$n = $p->attributes;
$n = [$n] if !ref($n);
for (@$n) {if (defined($_) && $_ ne '')
{my($m)=$_; $m=~s/[\t\n]/ /g; push(@k,"A=$m")} }
push(@descr, join("\t",@k));
push(@descr_trad, [map { local($1,$2);
/^([a-zA-Z0-9])=(.*)\z/s; my($key_what,$key_val) = ($1,$2);
$key_what eq 'M' || $key_what eq 'N' ? $key_val
: $key_what eq 'T' ? ('.'.$key_val) # prepend a dot (compatibility)
: $key_what eq 'A' && $key_val eq 'U' ? 'UNDECIPHERABLE' : ()} @k]);
}
# we have obtained a description of a part as a list of its predecessors
# in a message structure including the part itself at the end of the list
my($key_val_str) = join(' | ',@descr); $key_val_str =~ s/\t/,/g;
my($key_val_trad_str) = join(' | ', map {join(',',@$_)} @descr_trad);
# simplified result to be presented in a SMTP response and DSN
my($simple_part_name) = join(',', @{$descr_trad[-1]}); # just leaf node
# evaluate current mail component path against each recipients' tables
ll(4) && do_log(4, "check_for_banned (%s) %s",
join(',', map {$_->base_name} @path), $key_val_trad_str);
my($result,$matchingkey); my($t_ref_old);
for my $e (@recip_tables) { # for each recipient and his tables
my($found,$recip,$t_ref) = @$e{'found','recip','tables'};
if (!$e->{result} && $t_ref && @$t_ref) {
my($same_as_prev) = $t_ref_old && @$t_ref_old==@$t_ref &&
!(grep { $t_ref_old->[$_] ne $t_ref->[$_] }
(0..$#$t_ref)) ? 1 : 0;
if ($same_as_prev) {
do_log(4,
"skip banned check for %s, same tables as previous, result => %s",
$recip,$result);
} else {
do_log(5,"doing banned check for %s on %s",
$recip,$key_val_trad_str);
($result,$matchingkey) =
lookup2(0, [map {@$_} @descr_trad], # check all attribs in one go
[map { ref($_) eq 'ARRAY' ? @$_ : $_ } @$t_ref],
Label=>"check_bann:$recip");
$t_ref_old = $t_ref;
}
@$e{'found','result','matchk','part_descr','part_name'} =
(1,$result,$matchingkey,$key_val_trad_str,$simple_part_name)
if defined $result;
}
}
if (ref $bnpre && grep {!$_->{result}} @recip_tables) { # any non-true?
# try new style: banned_namepath_re; it is global, not per-recipient
my($result,$matchingkey) = lookup2(0, join("\n",@descr), [$bnpre],
Label=>'banned_namepath_re');
if (defined $result) {
for my $e (@recip_tables) {
@$e{'found','result','matchk','part_descr','part_name'} =
(1,$result,$matchingkey,$key_val_str,$simple_part_name)
if !$e->{found};
}
}
}
my(%esc) = (r => "\r", n => "\n", f => "\f", b => "\b",
e => "\e", a => "\a", t => "\t"); # for pretty-printing
my($ll) = (grep {$_->{result}} @recip_tables) ? 1 : 3; # log level
for my $e (@recip_tables) { # log and store results
my($r,$recip,$result,$matchingkey,$part_descr,$part_name) =
@$e{'r','recip','result','matchk','part_descr','part_name'};
if (ll($ll)) { # only bother with logging when needed
local($1);
my($mk) = defined $matchingkey ? $matchingkey : ''; # pretty-print
$mk =~ s{ \\(.) }{ exists($esc{$1}) ? $esc{$1} : '\\'.$1 }egsx;
do_log($result?1:3, 'p.path%s %s: "%s"%s',
!$result?'':" BANNED:$result", $recip, $key_val_str,
!defined $result ? '' : ", matching_key=\"$mk\"");
}
my($a);
if ($result) { # the part being tested is banned for this recipient
$a = $r->banned_parts || [];
push(@$a,$part_descr); $r->banned_parts($a);
$a = $r->banning_rule_rhs || [];
push(@$a,$result); $r->banning_rule_rhs($a);
$a = $r->banning_rule_key || [];
$matchingkey = "$matchingkey"; # make a plain string out of a qr
push(@$a,$matchingkey); $r->banning_rule_key($a);
my(@comments) = $matchingkey =~ / \( \? \# \s* (.*?) \s* \) /gsx;
$a = $r->banning_rule_comment || [];
push(@$a, @comments ? join(' ',@comments) : $matchingkey);
$r->banning_rule_comment($a);
if (!defined($r->banning_reason_short)) { # just the first
my($s) = $part_name;
$s =~ s/[ \t]{6,}/ ... /g; # compact whitespace
$s = join(' ',@comments) . ':' . $s if @comments;
$r->banning_reason_short($s);
}
}
}
last if !grep {!$_->{result}} @recip_tables; # stop if all recips true
} # endfor: message tree traversal
} # endif: doing parts checking
}
1;
#
package Amavis::Unpackers::MIME;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&mime_decode);
import Amavis::Conf qw(:platform c cr ca $MAXFILES);
import Amavis::Timing qw(section_time);
import Amavis::Util qw(snmp_count untaint ll do_log);
import Amavis::Unpackers::NewFilename qw(consumed_bytes);
}
use subs @EXPORT_OK;
use Errno qw(ENOENT EACCES);
use IO::File qw(O_CREAT O_EXCL O_WRONLY);
use MIME::Parser;
use MIME::Words;
# save MIME preamble and epilogue (if nontrivial) as extra (pseudo)parts
sub mime_decode_pre_epi($$$$$) {
my($pe_name, $pe_lines, $tempdir, $parent_obj, $placement) = @_;
if (defined $pe_lines && @$pe_lines) {
do_log(5, "mime_decode_%s: %d lines", $pe_name, scalar(@$pe_lines));
if (@$pe_lines > 5 || "@$pe_lines" !~ m{^[a-zA-Z0-9/\@:;,. \t\n_-]*\z}s) {
my($newpart_obj) =
Amavis::Unpackers::Part->new("$tempdir/parts",$parent_obj,1);
$newpart_obj->mime_placement($placement);
$newpart_obj->name_declared($pe_name);
my($newpart) = $newpart_obj->full_name;
my($outpart) = IO::File->new;
# O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
$outpart->open($newpart, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
or die "Can't create $pe_name file $newpart: $!";
binmode($outpart, ":bytes") or die "Can't cancel :utf8 mode: $!"
if $unicode_aware;
my($len);
for (@$pe_lines) {
$outpart->print($_) or die "Can't write $pe_name to $newpart: $!";
$len += length($_);
}
$outpart->close or die "Error closing $pe_name $newpart: $!";
$newpart_obj->size($len);
consumed_bytes($len, "mime_decode_$pe_name", 0, 1);
}
}
}
# traverse MIME::Entity object depth-first,
# extracting preambles and epilogues as extra (pseudo)parts, and
# filling-in additional information into Amavis::Unpackers::Part objects
sub mime_traverse($$$$$); # prototype
sub mime_traverse($$$$$) {
my($entity, $tempdir, $parent_obj, $depth, $placement) = @_;
mime_decode_pre_epi('preamble', $entity->preamble,
$tempdir, $parent_obj, $placement);
my($mt, $et) = ($entity->mime_type, $entity->effective_type);
my($part); my($head) = $entity->head; my($body) = $entity->bodyhandle;
if (!defined($body)) { # a MIME container only contains parts, no bodypart
# create pseudo-part objects for MIME containers (e.g. multipart/* )
$part = Amavis::Unpackers::Part->new(undef,$parent_obj,1);
# $part->type_short('no-file');
do_log(2, "%s %s Content-Type: %s", $part->base_name, $placement, $mt);
} else { # does have a body part (i.e. not a MIME container)
my($fn) = $body->path; my($size);
if (!defined($fn)) { $size = length($body->as_string) }
else {
my($msg); my($errn) = lstat($fn) ? 0 : 0+$!;
if ($errn == ENOENT) { $msg = "does not exist" }
elsif ($errn) { $msg = "is inaccessible: $!" }
elsif (!-r _) { $msg = "is not readable" }
elsif (!-f _) { $msg = "is not a regular file" }
else {
$size = -s _;
do_log(4,"mime_traverse: file %s is empty", $fn) if $size==0;
}
do_log(-1,"WARN: mime_traverse: file %s %s", $fn,$msg) if defined $msg;
}
consumed_bytes($size, 'mime_decode', 0, 1);
# retrieve Amavis::Unpackers::Part object (if any), stashed into head obj
$part = Amavis::Unpackers::OurFiler::get_amavisd_part($head);
if (defined $part) {
$part->size($size);
if (defined($size) && $size==0)
{ $part->type_short('empty'); $part->type_long('empty') }
ll(2) && do_log(2, "%s %s Content-Type: %s, size: %d B, name: %s",
$part->base_name, $placement, $mt, $size,
$entity->head->recommended_filename);
my($old_parent_obj) = $part->parent;
if ($parent_obj ne $old_parent_obj) { # reparent if necessary
ll(5) && do_log(5,"reparenting %s from %s to %s", $part->base_name,
$old_parent_obj->base_name, $parent_obj->base_name);
my($ch_ref) = $old_parent_obj->children;
$old_parent_obj->children([grep {$_ ne $part} @$ch_ref]);
$ch_ref = $parent_obj->children;
push(@$ch_ref,$part); $parent_obj->children($ch_ref);
$part->parent($parent_obj);
}
}
}
if (defined $part) {
$part->mime_placement($placement);
$part->type_declared($mt eq $et ? $mt : [$mt, $et]);
$part->attributes_add('U','C') if $mt =~ m{/encrypted}i ||
$et =~ m{/encrypted}i;
my(@rn); # recommended file names, both raw and RFC 2047 decoded
my($val, $val_decoded);
$val = $head->mime_attr('content-disposition.filename');
if ($val ne '') {
push(@rn, $val);
$val_decoded = MIME::Words::decode_mimewords($val);
push(@rn, $val_decoded) if $val_decoded ne $val;
}
$val = $head->mime_attr('content-type.name');
if (defined($val) && $val ne '') {
$val_decoded = MIME::Words::decode_mimewords($val);
push(@rn, $val_decoded) if !grep { $_ eq $val_decoded } @rn;
push(@rn, $val) if !grep { $_ eq $val } @rn;
}
$part->name_declared(@rn==1 ? $rn[0] : \@rn) if @rn;
$val = $head->mime_attr('content-type.report-type');
$part->report_type($val) if $val ne '';
}
mime_decode_pre_epi('epilogue', $entity->epilogue,
$tempdir, $parent_obj, $placement);
my($item_num) = 0;
for my $e ($entity->parts) { # recursive descent
$item_num++;
mime_traverse($e,$tempdir,$part,$depth+1,"$placement/$item_num");
}
}
# Break up mime parts, return a MIME::Entity object
sub mime_decode($$$) {
my($fileh, $tempdir, $parent_obj) = @_;
# $fileh may be an open file handle, or a file name
my($parser) = MIME::Parser->new;
$parser->filer(Amavis::Unpackers::OurFiler->new("$tempdir/parts",
$parent_obj));
$parser->ignore_errors(1); # also is the default
# if bounce killer is enabled, extract_nested_messages must be off,
# otherwise we lose headers of attached message/rfc822 messages
$parser->extract_nested_messages(0);
# $parser->extract_nested_messages("NEST"); # parse embedded message/rfc822
# "NEST" complains with "part did not end with expected boundary" when
# the outer message is message/partial and the inner message is chopped
$parser->extract_uuencode(1); # to enable or not to enable ???
$parser->max_parts($MAXFILES) if $MAXFILES > 0;
my($entity);
snmp_count('OpsDecByMimeParser');
if (ref($fileh)) { # assume open file handle
do_log(4, "Extracting mime components");
$fileh->seek(0,0) or die "Can't rewind mail file: $!";
local($1,$2,$3,$4); # avoid Perl 5.8.0 & 5.8.2 bug, $1 gets tainted !
$entity = $parser->parse($fileh);
} else { # assume $fileh is a file name
do_log(4, "Extracting mime components from %s", $fileh);
local($1,$2,$3,$4); # avoid Perl 5.8.0 & 5.8.2 bug, $1 gets tainted !
$entity = $parser->parse_open("$tempdir/parts/$fileh");
}
my($mime_err) = $parser->results->errors;
if (defined $mime_err) {
$mime_err=~s/\s+\z//; $mime_err=~s/[ \t\r]*\n+/; /g; $mime_err=~s/\s+/ /g;
$mime_err = substr($mime_err,0,250) . '[...]' if length($mime_err) > 250;
do_log(1, "WARN: MIME::Parser %s", $mime_err) if $mime_err ne '';
} elsif (!defined($entity)) {
$mime_err = "Unable to parse, perhaps message contains too many parts";
do_log(1, "WARN: MIME::Parser %s", $mime_err);
$entity = '';
}
mime_traverse($entity, $tempdir, $parent_obj, 0, '1') if $entity;
section_time('mime_decode');
($entity, $mime_err);
}
1;
#
package Amavis::MIME::Body::OnOpenFh;
# A body class that keeps data on an open file handle, read-only,
# while allowing to prepend a couple of lines when reading from it.
# $skip_bytes bytes at the beginning of a given open file are ignored.
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter MIME::Body); # subclass of MIME::Body
import Amavis::Util qw(ll do_log);
}
sub init {
my($self, $fh,$prefix_lines,$skip_bytes) = @_;
$self->{MB_Am_fh} = $fh;
$self->{MB_Am_prefix} = defined $prefix_lines ? join('',@$prefix_lines) : '';
$self->{MB_Am_prefix_l} = length($self->{MB_Am_prefix});
$self->{MB_Am_skip_bytes} = !defined $skip_bytes ? 0 : $skip_bytes;
$self->is_encoded(1);
$self;
}
sub open {
my($self,$mode) = @_;
$mode eq 'r' or die "Only offers read-only access, mode: $mode";
my($fh) = $self->{MB_Am_fh}; my($skip) = $self->{MB_Am_skip_bytes};
$fh->seek($skip,0) or die "Can't rewind mail file: $!";
$self->{MB_Am_pos} = 0;
bless { parent => $self };
}
sub close { 1 }
sub read { # SCALAR,LENGTH,OFFSET
my($self) = shift; my($len) = $_[1]; my($offset) = $_[2];
my($parent) = $self->{parent}; my($pos) = $parent->{MB_Am_pos};
my($str1) = ''; my($str2) = ''; my($nbytes) = 0;
if ($len > 0 && $pos < $parent->{MB_Am_prefix_l}) {
$str1 = substr($parent->{MB_Am_prefix}, $pos, $len);
$nbytes += length($str1); $len -= $nbytes;
}
my($msg); $! = 0;
if ($len > 0) {
my($nb) = $parent->{MB_Am_fh}->read($str2,$len);
if (!defined $nb) {
$msg = "Error reading: $!";
} elsif ($nb < 1) {
# read returns 0 at eof
} else {
$nbytes += $nb; $len -= $nb;
}
}
if (defined $msg) {
undef $nbytes; # $! already set by a failed read
} else {
($offset ? substr($_[0],$offset) : $_[0]) = $str1.$str2;
$pos += $nbytes; $parent->{MB_Am_pos} = $pos;
}
$nbytes; # eof: 0; error: undef
}
1;
#
package Amavis::Notify;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&delivery_status_notification &delivery_short_report
&build_mime_entity &defanged_mime_entity
&msg_from_quarantine &expand_variables);
import Amavis::Util qw(ll do_log safe_encode sanitize_str
orcpt_decode xtext_decode ccat_split ccat_maj);
import Amavis::Timing qw(section_time);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Out::EditHeader qw(hdr);
import Amavis::Lookup qw(lookup lookup2);
import Amavis::Expand qw(expand);
import Amavis::rfc2821_2822_Tools;
}
use subs @EXPORT_OK;
use MIME::Entity;
use Time::HiRes ();
# use Encode; # Perl 5.8 UTF-8 support
# replace substring ${myhostname} with a value of a corresponding variable
sub expand_variables($) {
my($str) = @_; local($1,$2);
$str =~ s{ \$ (?: \{ ([^\}]+) \} |
([a-zA-Z](?:[a-zA-Z0-9_-]*[a-zA-Z0-9])?\b) ) }
{ { 'myhostname' => c('myhostname') }->{lc($1.$2)} }egx;
$str;
}
# Create a MIME::Entity object. If $mail_as_string_ref points to a string
# (multiline mail header with a plain text body) it is added as the first
# MIME part. Optionally attach a message header section from original mail,
# or attach a complete original message.
#
sub build_mime_entity($$$$$$) {
my($mail_as_string_ref, $msginfo, $mime_type, $flat,
$attach_orig_headers, $attach_orig_message) = @_;
if (!defined $mime_type || $mime_type !~ m{^multipart(/|\z)}i) {
my($multipart_cnt) = 0;
$multipart_cnt++ if $mail_as_string_ref;
$multipart_cnt++ if defined $msginfo &&
($attach_orig_headers || $attach_orig_message);
$mime_type = 'multipart/mixed' if $multipart_cnt > 1;
}
my($entity,$m_hdr,$m_body);
if (!$mail_as_string_ref) {
# no plain text part
} elsif (substr($$mail_as_string_ref, 0,1) eq "\n") { # empty header section?
$m_hdr = ''; $m_body = substr($$mail_as_string_ref,1);
} else {
# calling index and substr is much faster than an equiv. split into $1,$2
# by a regular expression: /^( (?!\n) .*? (?:\n|\z))? (?: \n (.*) )? \z/sx
my($ind) = index($$mail_as_string_ref,"\n\n"); # find hdr/body separator
if ($ind < 0) { $m_hdr = $$mail_as_string_ref; $m_body = '' } # no body
else { # normal mail structure, nonempty header section and nonempty body
$m_hdr = substr($$mail_as_string_ref, 0, $ind+1);
$m_body = substr($$mail_as_string_ref, $ind+2);
}
}
$m_body = safe_encode(c('bdy_encoding'), $m_body) if defined $m_body;
# make sure _our_ source line number is reported in case of failure
my($multipart_cnt) = 0;
eval {
my($nxmh) = c('notify_xmailer_header');
$entity = MIME::Entity->build(
defined $nxmh && $nxmh eq '' ? () # leave the MIME::Entity default
: ('X-Mailer' => $nxmh), # X-Mailer hdr or undef
Type => defined $mime_type ? $mime_type : 'multipart/mixed',
Encoding => '7bit',
); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
if (defined $m_hdr) { # insert header fields into MIME::Head entity
# Mail::Header::modify allows all-or-nothing control over automatic header
# fields folding by Mail::Header, which is too bad - we would prefer
# to have full control on folding of header fields that are explicitly
# inserted here, and let Mail::Header handle the rest. Sorry, can't be
local($1,$2);
my($head) = $entity->head; $head->modify(0);
$m_hdr =~ s/\r?\n(?=[ \t])//gs; # unfold header fields in a template
for my $hdr_line (split(/\r?\n/, $m_hdr)) {
if ($hdr_line =~ /^([^:]*):[ \t]*(.*)\z/s) {
my($fhead,$fbody) = ($1,$2);
my($str) = hdr($fhead,$fbody,0,' '); ($fhead,$fbody) = ($1,$2) if $str =~ /^([^:]*):[ \t]*(.*)\z/s;
chomp($fbody);
do_log(5, "build_mime_entity %s: %s", $fhead,$fbody);
eval { $head->replace($fhead,$fbody); 1;
} or do {
$@ = "errno=$!" if $@ eq ''; chomp $@;
die $@ if $@ =~ /^timed out\b/; die sprintf("%s header field '%s: %s'",
($@ eq '' ? "invalid" : "$@, "), $fhead,$fbody);
};
}
}
}
my(@prefix_lines);
if (defined $m_body) {
if ($flat && $attach_orig_message) {
my($pos,$j); for ($pos=0; ($j=index($m_body,"\n",$pos)) >= 0; $pos = $j+1)
{ push(@prefix_lines, substr($m_body,$pos,$j-$pos+1)) }
push(@prefix_lines, substr($m_body,$pos)) if $pos < length($m_body);
} else {
eval { $entity->attach(
Type => 'text/plain', Data => $m_body,
Encoding => '-SUGGEST', Charset => c('bdy_encoding'),
); $multipart_cnt++; 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
}
}
push(@prefix_lines, "\n") if @prefix_lines; push(@prefix_lines, sprintf("Return-Path: %s\n",$msginfo->sender_smtp));
if (defined($msginfo) && $attach_orig_message) {
do_log(4, "build_mime_entity: attaching entire original message");
my($orig_mail_as_body) =
Amavis::MIME::Body::OnOpenFh->new($msginfo->mail_text,
\@prefix_lines, $msginfo->skip_bytes);
$orig_mail_as_body or die "Can't create a MIME::Body object: $!";
eval { my($att) = $entity->attach( Type => $flat ? 'text/plain' : 'message/rfc822',
Encoding => ($msginfo->header_8bit || $msginfo->body_8bit) ?
'8bit' : '7bit',
Data => [], $flat ? () : (Disposition => 'attachment', Filename => 'message',
Description => 'Original message'),
);
$att->bodyhandle($orig_mail_as_body); $multipart_cnt++; 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
} elsif (defined($msginfo) && $attach_orig_headers) {
do_log(4, "build_mime_entity: attaching original header section");
eval { $entity->attach(
Type => $flat ? 'text/plain' : 'text/rfc822-headers', Encoding => $msginfo->header_8bit ? '8bit' : '7bit',
Data => [@prefix_lines, @{$msginfo->orig_header}],
Disposition => 'inline', Filename => 'header',
Description => 'Message header section',
); $multipart_cnt++; 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
}
$entity->make_singlepart if $multipart_cnt < 2;
$entity; }
sub delivery_status_notification($$$$;$$$$) { my($conn,$msginfo,$dsn_per_recip_capable,$builtins_ref,
$notif_recips,$request_type,$feedback_type,$msg_format) = @_;
my($notification); my($suppressed) = 0;
if (!defined($msg_format)) {
$msg_format = $request_type eq 'dsn' ? 'dsn'
: $request_type eq 'report' ? c('report_format')
: c('release_format');
}
my($is_arf) = 0; my($is_dsn) = 0; my($is_attach) = 0; my($is_plain) = 0;
if ($msg_format eq 'dsn') { $is_dsn = 1 }
elsif ($msg_format eq 'arf') { $is_arf = 1 }
elsif ($msg_format eq 'attach') { $is_attach = 1 }
else { $is_plain = 1 } my($dsn_time) = $msginfo->rx_time; $dsn_time = Time::HiRes::time if !defined($dsn_time) || $dsn_time==0; my($rfc2822_dsn_time) = rfc2822_timestamp($dsn_time);
my($sender) = $msginfo->sender;
my($dsn_passed_on) = $msginfo->dsn_passed_on; my($delivery_method) = $msginfo->delivery_method;
my($per_recip_data) = $msginfo->per_recip_data;
my($txt_recip) = ''; my($all_rejected) = 0;
if (@$per_recip_data) {
$all_rejected = 1;
for my $r (@$per_recip_data) {
if ($r->recip_destiny != D_REJECT || $r->recip_smtp_response !~ /^5/)
{ $all_rejected = 0; last }
}
}
my($spam_level) = $msginfo->spam_level;
my($is_credible) = $msginfo->sender_credible || '';
my($os_fingerprint) = $msginfo->client_os_fingerprint;
my($cutoff_byrecip_maps, $cutoff_bysender_maps);
my($dsn_cutoff_level_bysender, $dsn_cutoff_level);
if ($is_dsn && $sender ne '') {
if ($is_credible) {
do_log(3, "DSN: sender is credible (%s), SA: %.3f, <%s>",
$is_credible,$spam_level,$sender);
$cutoff_byrecip_maps = ca('spam_crediblefrom_dsn_cutoff_level_maps');
$cutoff_bysender_maps =
ca('spam_crediblefrom_dsn_cutoff_level_bysender_maps');
} else {
do_log(5, "DSN: sender NOT credible, SA: %.3f, <%s>",
$spam_level,$sender);
$cutoff_byrecip_maps = ca('spam_dsn_cutoff_level_maps');
$cutoff_bysender_maps = ca('spam_dsn_cutoff_level_bysender_maps');
}
$dsn_cutoff_level_bysender = lookup2(0,$sender,$cutoff_bysender_maps);
}
my($any_succ,$any_fail,$any_delayed) = (0,0,0); local($1);
for my $r (!$is_dsn ? () : @$per_recip_data) { my($recip) = $r->recip_addr;
my($smtp_resp) = $r->recip_smtp_response;
my($recip_done) = $r->recip_done; my($ccat_name) = $r->setting_by_contents_category(\%ccat_display_names);
$ccat_name = "NonBlocking:$ccat_name" if !defined($r->blocking_ccat);
my($boost) = $r->recip_score_boost;
if (!$recip_done) {
if ($delivery_method eq '') { $smtp_resp = "250 2.5.0 Ok, continue delivery";
} else {
do_log(-2,"TROUBLE: recipient not done: <%s> %s", $recip,$smtp_resp);
}
}
my($smtp_resp_class) = $smtp_resp =~ /^(\d)/ ? $1 : '0';
my($smtp_resp_code) = $smtp_resp =~ /^(\d+)/ ? $1 : '0';
my($dsn_notify) = $r->dsn_notify;
my($notify_on_failure,$notify_on_success,$notify_on_delay,$notify_never) =
(0,0,0,0);
if (!defined($dsn_notify)) { $notify_on_failure = $notify_on_delay = 1 }
else {
for (@$dsn_notify) { if ($_ eq 'FAILURE') { $notify_on_failure = 1 }
elsif ($_ eq 'SUCCESS') { $notify_on_success = 1 }
elsif ($_ eq 'DELAY') { $notify_on_delay = 1 }
elsif ($_ eq 'NEVER') { $notify_never = 1 }
}
}
if ($notify_never || $sender eq '')
{ $notify_on_failure = $notify_on_success = $notify_on_delay = 0 }
my($dest) = $r->recip_destiny;
my($remote_or_local) = $recip_done==2 ? 'from MTA' :
$recip_done==1 ? '.' : 'status-to-be-passed-back';
my($warn_sender) =
$notify_on_delay && $smtp_resp_class eq '2' && $recip_done==2 &&
$r->setting_by_contents_category(cr('warnsender_by_ccat'));
ll(5) && do_log(5,
"dsn: %s %s %s <%s> -> <%s>: on_succ=%d, on_dly=%d, on_fail=%d,".
" never=%d, warn_sender=%s, DSN_passed_on=%s, mta_resp: \"%s\"",
$remote_or_local, $smtp_resp_code, $ccat_name, $sender, $recip,
$notify_on_success, $notify_on_delay, $notify_on_failure,
$notify_never, $warn_sender, $dsn_passed_on, $smtp_resp);
if ($smtp_resp_class eq '4') {
do_log(4, "DSN: TMPFAIL %s %s %s, need not be reported: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif ($smtp_resp_class eq '5' && $dest==D_REJECT &&
($dsn_per_recip_capable || $all_rejected)) {
do_log(4, "DSN: FAIL %s %s %s, status propagated back: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif ($smtp_resp_class eq '5' && !$notify_on_failure) {
$suppressed = 1;
do_log($recip_done==2 ? 0 : 4, "DSN: FAIL %s %s %s, %s requested to be IGNORED: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,
$notify_never?'explicitly':'implicitly', $sender, $recip);
} elsif ($smtp_resp_class eq '2' && !$notify_on_success && !$warn_sender) {
my($fmt) = $dest==D_DISCARD
? "SUCC (discarded) %s %s %s, destiny=DISCARD"
: "SUCC %s %s %s, no DSN requested";
do_log(5, "DSN: $fmt: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif ($smtp_resp_class eq '2' && $notify_on_success && $dsn_passed_on &&
!$warn_sender) {
do_log(5, "DSN: SUCC %s %s %s, DSN parameters PASSED-ON: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif ($notify_never || $sender eq '') { $suppressed = 1;
do_log(5, "DSN: NEVER %s %s, <%s> -> %s",
$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif ($dest==D_DISCARD) { $suppressed = 1;
do_log(4, "DSN: FILTER %s %s %s, destiny=DISCARD: <%s> -> <%s>",
$remote_or_local,$smtp_resp_code,$ccat_name,$sender,$recip);
} elsif (defined $r->dsn_suppress_reason) {
$suppressed = 1;
do_log(3, "DSN: FILTER %s %s, %s <%s> -> <%s>",
$smtp_resp_code,$ccat_name, $r->dsn_suppress_reason,
$sender,$recip);
} elsif (!defined($msginfo->sender_contact)) { $suppressed = 1;
do_log(3, "DSN: FILTER %s %s, %s <%s> -> <%s>",
$smtp_resp_code,$ccat_name, '(faked?)', $sender,$recip);
} elsif (defined($dsn_cutoff_level_bysender) &&
($spam_level+$boost >= $dsn_cutoff_level_bysender)) {
$suppressed = 1;
do_log(3, "DSN: FILTER %s %s, spam level %.3f exceeds cutoff %s%s, ".
"<%s> -> <%s>", $smtp_resp_code, $ccat_name,
$spam_level+$boost, $dsn_cutoff_level_bysender,
!$is_credible ? '' : ", (credible: $is_credible)",
$sender, $recip);
} elsif (defined($cutoff_byrecip_maps) &&
( $dsn_cutoff_level=lookup2(0,$recip,$cutoff_byrecip_maps),
defined($dsn_cutoff_level) &&
( $spam_level+$boost >= $dsn_cutoff_level ||
( $r->recip_blacklisted_sender &&
!$r->recip_whitelisted_sender) )
) ) {
$suppressed = 1;
do_log(3, "DSN: FILTER %s %s, spam level %.3f exceeds ".
"by-recipient cutoff %s%s, <%s> -> <%s>",
$smtp_resp_code, $ccat_name,
$spam_level+$boost, $dsn_cutoff_level,
!$is_credible ? '' : ", (credible: $is_credible)",
$sender, $recip);
} elsif (defined($msginfo->is_bulk) &&
ccat_maj($r->contents_category) > CC_CLEAN) {
$suppressed = 1;
do_log(3, "DSN: FILTER %s %s, suppressed, bulk mail (%s), <%s> -> <%s>",
$smtp_resp_code,$ccat_name,$msginfo->is_bulk,$sender,$recip);
} elsif ($os_fingerprint =~ /^Windows\b/ && !$msginfo->dkim_envsender_sig && $spam_level+$boost >=
($os_fingerprint=~/^Windows XP(?![^(]*\b2000 SP)/ ? 5 : 8)) {
$os_fingerprint =~ /^(\S+\s+\S+)/;
do_log(3, "DSN: FILTER %s %s, suppressed for mail from %s ".
"at %s, score=%s, <%s> -> <%s>", $smtp_resp_code, $ccat_name,
$1, $msginfo->client_addr, $spam_level+$boost, $sender,$recip);
} else {
$txt_recip .= "\n"; my($dsn_orcpt) = $r->dsn_orcpt;
if (defined $dsn_orcpt) {
my($addr_type,$orcpt) = orcpt_decode($dsn_orcpt);
$txt_recip .= "Original-Recipient: " .
sanitize_str($addr_type.';'.$orcpt) . "\n";
}
my($remote_mta) = $r->recip_remote_mta;
if (!defined($dsn_orcpt) && $remote_mta ne '' &&
$r->recip_final_addr ne $recip) {
$txt_recip .= "X-NextToLast-Final-Recipient: rfc822;" .
quote_rfc2821_local($recip) . "\n";
$txt_recip .= "Final-Recipient: rfc822;" .
quote_rfc2821_local($r->recip_final_addr) . "\n";
} else {
$txt_recip .= "Final-Recipient: rfc822;" .
quote_rfc2821_local($recip) . "\n";
}
local($1,$2,$3); my($smtp_resp_code,$smtp_resp_enhcode,$smtp_resp_msg);
if ($smtp_resp =~ /^ (\d{3}) [ \t]+ ([245] \. \d{1,3} \. \d{1,3})?
\s* (.*) \z/xs) {
($smtp_resp_code, $smtp_resp_enhcode, $smtp_resp_msg) = ($1,$2,$3);
} else {
$smtp_resp_msg = $smtp_resp;
}
if ($smtp_resp_enhcode eq '' && $smtp_resp_class =~ /^([245])\z/) {
$smtp_resp_enhcode = "$1.0.0";
}
my($action); if ($recip_done == 2) { $action = $smtp_resp_class eq '5' ? 'failed' : $smtp_resp_class ne '2' ? undef : !$dsn_passed_on ? 'relayed' : $warn_sender ? 'delayed' : undef; } elsif ($recip_done == 1) { $action = $smtp_resp_class eq '5' ? 'failed' : $smtp_resp_class eq '2' ? 'delivered' : undef; } elsif (!defined($recip_done) || $recip_done == 0) {
$action = $smtp_resp_class eq '2' ? 'relayed' : undef; }
defined $action
or die "Assert failed: $smtp_resp_class, $recip_done, $dsn_passed_on";
if ($action eq 'failed') { $any_fail=1 }
elsif ($action eq 'delayed') { $any_delayed=1 } else { $any_succ=1 }
$txt_recip .= "Action: $action\n";
$txt_recip .= "Status: $smtp_resp_enhcode\n";
my($rem_smtp_resp) = $r->recip_remote_mta_smtp_response;
if ($warn_sender && $action eq 'delayed') {
$smtp_resp = '250 2.6.0 Bad message, but will be delivered anyway';
} elsif ($remote_mta ne '' && $rem_smtp_resp ne '') {
$txt_recip .= "Remote-MTA: dns; $remote_mta\n";
$smtp_resp = $rem_smtp_resp;
} elsif ($smtp_resp !~ /\n/ && length($smtp_resp) > 78-23) { $smtp_resp = wrap_string("x" x (23-11) . $smtp_resp, 78-11,'','',0);
$smtp_resp =~ s/^x{12}//;
$smtp_resp = join("\n", @{wrap_smtp_resp($smtp_resp)});
}
$smtp_resp =~ s/\n(?![ \t])/\n /gs;
$txt_recip .= "Diagnostic-Code: smtp; $smtp_resp\n";
$txt_recip .= "Last-Attempt-Date: $rfc2822_dsn_time\n";
$txt_recip .= sprintf("Final-Log-ID: %s/%s\n",
$msginfo->log_id, $msginfo->mail_id);
do_log(2, "DSN: NOTIFICATION: Action:%s, %s %s %s, spam level %.3f, ".
"<%s> -> <%s>", $action,
$recip_done==2 && $action ne 'delayed' ? 'RELAYED' : 'LOCAL',
$smtp_resp_code, $ccat_name, $spam_level+$boost,
$sender, $recip);
}
} if ( $is_arf || $is_plain || $is_attach ||
($is_dsn && ($any_succ || $any_fail || $any_delayed)) ) {
my(@hdr_to) = defined $notif_recips ? qquote_rfc2821_local(@$notif_recips)
: map { $_->recip_addr_smtp } @$per_recip_data;
my($hdr_from) = $msginfo->setting_by_contents_category(
$is_dsn ? cr('hdrfrom_notify_sender_by_ccat') :
$request_type eq 'report' ? cr('hdrfrom_notify_report_by_ccat') :
cr('hdrfrom_notify_release_by_ccat') );
$hdr_from = expand_variables($hdr_from);
my(%mybuiltins) = %$builtins_ref; $mybuiltins{'f'} = $hdr_from;
$mybuiltins{'T'} = \@hdr_to;
$mybuiltins{'d'} = $rfc2822_dsn_time;
$mybuiltins{'report_format'} = $msg_format;
$mybuiltins{'feedback_type'} = $feedback_type;
my($dsn_ret) = $msginfo->dsn_ret;
my($attach_full_msg) =
!$is_dsn ? 1 : (defined $dsn_ret && $dsn_ret eq 'FULL' && $any_fail);
if ($attach_full_msg && $is_dsn) {
do_log(1, "DSN RET=%s requested, but we'll only attach a header section",
$dsn_ret);
$attach_full_msg = 0; }
my($template_ref) = $msginfo->setting_by_contents_category(
$is_dsn ? cr('notify_sender_templ_by_ccat') :
$request_type eq 'report' ? cr('notify_report_templ_by_ccat') :
cr('notify_release_templ_by_ccat') );
my($report_str_ref) = expand($template_ref, \%mybuiltins);
my($report_entity) = build_mime_entity($report_str_ref,$msginfo,
$is_dsn ? 'multipart/report; report-type=delivery-status' :
$is_arf ? 'multipart/report; report-type=feedback-report' :
'multipart/mixed',
$is_plain, 1, $attach_full_msg);
my($head) = $report_entity->head;
eval { $head->replace('From', $hdr_from); 1 }
or do { chomp $@; die $@ };
eval { $head->replace('To', join(', ',@hdr_to)); 1 }
or do { chomp $@; die $@ };
eval { $head->replace('Date', $rfc2822_dsn_time); 1 }
or do { chomp $@; die $@ };
my($dsn_envid) = $msginfo->dsn_envid; $dsn_envid = sanitize_str(xtext_decode($dsn_envid)) if defined $dsn_envid;
my($txt_msg) = ''; if ($is_arf) { $txt_msg .= "Feedback-Type: $feedback_type\n";
$txt_msg .= "Version: 0.1\n";
$txt_msg .= "Reporting-MTA: dns; " . c('myhostname') . "\n";
$txt_msg .= "User-Agent: $myproduct_name\n";
$txt_msg .= "Arrival-Date: ". rfc2822_timestamp($msginfo->rx_time) ."\n";
$txt_msg .= "Source-IP: " . $msginfo->client_addr . "\n"
if defined $msginfo->client_addr;
if ($enable_dkim_verification) {
for my $h (Amavis::DKIM::generate_authentication_results($msginfo))
{ $txt_msg .= "Authentication-Results: $h\n" }
}
$txt_msg .= "Original-Envelope-Id: $dsn_envid\n" if defined $dsn_envid;
$txt_msg .= "Original-Mail-From: " . $msginfo->sender_smtp . "\n";
for my $r (@$per_recip_data)
{ $txt_msg .= "Original-Rcpt-To: " . $r->recip_addr_smtp . "\n" }
} elsif ($is_dsn) { my($from_mta) = $conn->smtp_helo;
my($client_ip) = $conn->client_ip;
$txt_msg .= "Reporting-MTA: dns; " . c('myhostname') . "\n";
$txt_msg .= "Received-From-MTA: smtp; $from_mta ([$client_ip])\n"
if $from_mta ne '';
$txt_msg .= "Arrival-Date: ". rfc2822_timestamp($msginfo->rx_time) ."\n";
$txt_msg .= "Original-Envelope-Id: $dsn_envid\n" if defined $dsn_envid;
}
if ($is_dsn || $is_arf) { eval { $report_entity->add_part(
MIME::Entity->build(Top => 0,
Type => $is_dsn ? 'message/delivery-status'
: 'message/feedback-report',
Encoding => '7bit', Disposition => 'inline',
Filename => $is_arf ? 'arf_status' : 'dsn_status',
Description => $is_arf ? "\u$feedback_type report" :
$any_fail ? 'Delivery error report' :
$any_delayed ? 'Delivery delay report' :
'Delivery report',
Data => $txt_msg.$txt_recip),
1); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
}
my($mailfrom) = $is_dsn ? '' : unquote_rfc2821_local( (parse_address_list($hdr_from))[0] );
$notification = Amavis::In::Message->new;
$notification->rx_time($dsn_time);
$notification->log_id($msginfo->log_id);
$notification->partition_tag($msginfo->partition_tag);
$notification->conn_obj($msginfo->conn_obj);
$notification->originating(1);
$notification->mail_text($report_entity);
$notification->delivery_method(c('notify_method'));
$notification->sender($mailfrom);
$notification->sender_smtp(qquote_rfc2821_local($mailfrom));
$notification->auth_submitter('<>');
$notification->auth_user(c('amavis_auth_user'));
$notification->auth_pass(c('amavis_auth_pass'));
if (defined $hdr_from) {
my(@rfc2822_from) = map { unquote_rfc2821_local($_) }
parse_address_list($hdr_from);
$notification->rfc2822_from($rfc2822_from[0]);
}
my($bcc) = $msginfo->setting_by_contents_category(cr('dsn_bcc_by_ccat'));
$notification->recips([(defined $notif_recips ? @$notif_recips
: map { $_->recip_addr } @$per_recip_data),
defined $bcc && $bcc ne '' ? $bcc : () ], 1);
}
($notification,$suppressed);
}
sub delivery_short_report($) {
my($msginfo) = @_;
my(@succ_recips, @failed_recips, @failed_recips_full);
for my $r (@{$msginfo->per_recip_data}) {
my($remote_mta) = $r->recip_remote_mta;
my($smtp_resp) = $r->recip_smtp_response;
my($qrecip_addr) = scalar(qquote_rfc2821_local($r->recip_addr));
if ($r->recip_destiny == D_PASS && ($smtp_resp=~/^2/ || !$r->recip_done)) {
push(@succ_recips, $qrecip_addr);
} else {
push(@failed_recips, $qrecip_addr);
push(@failed_recips_full, sprintf("%s:%s\n %s", $qrecip_addr,
(!defined($remote_mta)||$remote_mta eq '' ?'' :" [$remote_mta] said:"),
$smtp_resp));
}
}
(\@succ_recips, \@failed_recips, \@failed_recips_full);
}
sub defanged_mime_entity($$$) {
my($conn,$msginfo,$first_part) = @_;
my($new_entity);
$_ = safe_encode(c('bdy_encoding'), $_)
for (ref $first_part ? @$first_part : $first_part);
eval { my($nxmh) = c('notify_xmailer_header');
$new_entity = MIME::Entity->build(
Type => 'multipart/mixed',
(defined $nxmh && $nxmh eq '' ? () : ('X-Mailer' => $nxmh) ) ); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
my($hdr_edits) = $msginfo->header_edits;
if (!$hdr_edits) {
$hdr_edits = Amavis::Out::EditHeader->new;
$msginfo->header_edits($hdr_edits);
}
my(%desired_field);
for (qw(Received From Sender To Cc Reply-To Date Message-ID
Resent-From Resent-Sender Resent-To Resent-Cc
Resent-Date Resent-Message-ID In-Reply-To References Subject
Comments Keywords Organization Organisation User-Agent X-Mailer
DKIM-Signature DomainKey-Signature))
{ $desired_field{lc($_)} = 1 };
local($1,$2);
for my $curr_head (@{$msginfo->orig_header}) { my($field_name, $field_body) =
$curr_head =~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s
? ($1, $2) : (undef, $curr_head);
if ($desired_field{lc($field_name)}) { $field_body =~ s{ ( [^\001-\014\016-\177] ) }
{ sprintf(ord($1)>255 ? '\\x{%04x}' : '\\%03o',
ord($1)) }gsxe;
$field_body =~ s{\n([ \t]*)(?=\n)}{\\012$1}gs;
$field_body =~ s{^(.{995}).{4,}$}{$1...}mg; chomp($field_body); if (lc($field_name) eq 'subject') {
eval { $new_entity->head->add($field_name,$field_body); 1 }
or do {chomp $@; die $@};
} else {
$hdr_edits->append_header($field_name,$field_body,2);
}
}
}
eval {
$new_entity->attach(
Type => 'text/plain',
Encoding => '-SUGGEST', Charset => c('bdy_encoding'),
Data => $first_part);
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
my($rp) = sprintf("Return-Path: %s\n",$msginfo->sender_smtp);
my($orig_mail_as_body) =
Amavis::MIME::Body::OnOpenFh->new($msginfo->mail_text,
[$rp], $msginfo->skip_bytes);
$orig_mail_as_body or die "Can't create a MIME::Body object: $!";
eval {
my($att) = $new_entity->attach( Type => 'message/rfc822; x-spam-type=original',
Encoding =>($msginfo->header_8bit || $msginfo->body_8bit) ?'8bit':'7bit',
Data => [], Description => 'Original message',
Filename => 'message', Disposition => 'attachment',
);
$att->bodyhandle($orig_mail_as_body); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
die $eval_stat;
};
$new_entity;
}
sub msg_from_quarantine($$$$) {
my($conn,$msginfo,$request_type,$feedback_type) = @_;
my($fh) = $msginfo->mail_text;
my($sender_override) = $msginfo->sender;
my($recips_data_override) = $msginfo->per_recip_data;
my($quarantine_id) = $msginfo->mail_id;
my($reporting) = $request_type eq 'report';
my($release_m);
if ($request_type eq 'requeue') {
$release_m = c('requeue_method');
$release_m ne '' or die "requeue_method is unspecified";
} else { $release_m = c('release_method');
$release_m = c('notify_method') if $release_m eq '';
$release_m ne '' or die "release_method and notify_method are unspecified";
}
$msginfo->originating(0); $msginfo->delivery_method($release_m);
$msginfo->auth_submitter('<>');
$msginfo->auth_user(c('amavis_auth_user'));
$msginfo->auth_pass(c('amavis_auth_pass'));
$fh->seek($msginfo->skip_bytes, 0) or die "Can't rewind mail file: $!";
my($bsmtp) = 0; my($qid,$sender,@recips_all,@recips_blocked);
my($have_recips_blocked) = 0; my($curr_head);
my($ln); my($eof) = 0; my($position) = 0;
my($offset_bytes) = 0; do_log(4, "msg_from_quarantine: releasing %s", $quarantine_id);
for (;;) {
if ($eof) { $ln = "\n" }
else {
$! = 0; $ln = $fh->getline;
if (!defined($ln)) {
$eof = 1; $ln = "\n"; $!==0 or die "Error reading file ".$msginfo->mail_text_fn.": $!";
}
}
if ($ln =~ /^[ \t]/) { $curr_head .= $ln }
else {
my($next_head) = $ln; local($1,$2);
local($_) = $curr_head; chomp; s/\n(?=[ \t])//gs; # unfold
if (!defined($curr_head)) { } elsif (/^(EHLO|HELO)( |$)/i) { $bsmtp = 1;
} elsif (/^MAIL FROM:[ \t]*(<.*>)(.*)$/i) {
$bsmtp = 1; $sender = $1; $sender = unquote_rfc2821_local($sender);
} elsif ( $bsmtp && /^RCPT TO:[ \t]*(<.*>)(.*)$/i) {
push(@recips_all, unquote_rfc2821_local($1));
} elsif ( $bsmtp && /^(DATA|NOOP)$/i) {
} elsif ( $bsmtp && /^RSET$/i) {
undef $sender; @recips_all = (); @recips_blocked = (); undef $qid;
} elsif ( $bsmtp && /^QUIT$/i) { last;
} elsif (!$bsmtp && /^Return-Path:[ \t]*(.*)$/si) {
} elsif (!$bsmtp && /^Delivered-To:[ \t]*(.*)$/si) {
} elsif (!$bsmtp && /^X-Envelope-From:[ \t]*(.*)$/si) {
if (!defined $sender) {
my(@addr_list) = parse_address_list($1);
@addr_list >= 1 or die "Address missing in X-Envelope-From";
@addr_list <= 1 or die "More than one address in X-Envelope-From";
$sender = unquote_rfc2821_local($addr_list[0]);
}
} elsif (!$bsmtp && /^X-Envelope-To:[ \t]*(.*)$/si) {
my(@addr_list) = parse_address_list($1);
push(@recips_all, map { unquote_rfc2821_local($_) } @addr_list);
} elsif (!$bsmtp && /^X-Envelope-To-Blocked:[ \t]*(.*)$/si) {
my(@addr_list) = parse_address_list($1);
push(@recips_blocked, map { unquote_rfc2821_local($_) } @addr_list);
$have_recips_blocked = 1;
} elsif (/^X-Quarantine-ID:[ \t]*(.*)$/si) {
$qid = $1; $qid = $1 if $qid =~ /^<(.*)>\z/s;
} elsif (!$reporting &&
/^X-Amavis-(?:Hold|Alert|Modified|PenPals|PolicyBank):/si) {
} elsif (!$reporting &&
/^X-Spam- (?:
Flag|Score|Level|Status|Report|Tests|Checker-Version):/six) {
} else {
last; }
last if $next_head eq "\n"; $offset_bytes = $position; $curr_head = $next_head;
}
$position += length($ln);
}
@recips_blocked = @recips_all if !$have_recips_blocked; my(@except);
if (@recips_blocked < @recips_all) {
for my $rec (@recips_all)
{ push(@except,$rec) if !grep { $rec eq $_ } @recips_blocked }
}
my($sender_smtp) = qquote_rfc2821_local($sender);
do_log(0,"Quarantined message %s (%s): %s %s -> %s%s",
$request_type, $feedback_type, $quarantine_id, $sender_smtp,
join(',', qquote_rfc2821_local(@recips_blocked)),
!@except ? '' : (", (excluded: ".
join(',', qquote_rfc2821_local(@except)) . " )" ));
my(@m);
if (!defined($qid)) { push(@m, 'missing X-Quarantine-ID') }
elsif ($qid ne $quarantine_id) {
push(@m, sprintf("stored quar. ID '%s' does not match requested ID '%s'",
$qid,$quarantine_id));
}
push(@m, 'missing '.($bsmtp?'MAIL FROM':'X-Envelope-From or Return-Path'))
if !defined $sender;
push(@m, 'missing '.($bsmtp?'RCPT TO' :'X-Envelope-To')) if !@recips_all;
do_log(0, "Quarantine %s %s: %s",
$request_type, $quarantine_id, join("; ",@m)) if @m;
if ($qid ne $quarantine_id)
{ die "Stored quarantine ID '$qid' does not match ".
"requested ID '$quarantine_id'" }
if ($bsmtp)
{ die "Releasing messages in BSMTP format not yet supported ".
"(dot de-stuffing not implemented)" }
$msginfo->sender($sender); $msginfo->sender_smtp($sender_smtp);
$msginfo->recips(\@recips_all);
$msginfo->skip_bytes($offset_bytes);
my($msg_format) = $request_type eq 'dsn' ? 'dsn'
: $request_type eq 'report' ? c('report_format')
: c('release_format');
my($hdr_edits) = Amavis::Out::EditHeader->new;
$msginfo->header_edits($hdr_edits);
if ($msg_format ne 'resend') {
Amavis::get_body_digest($msginfo, 'MD5');
Amavis::collect_some_info($msginfo);
my($notification,$suppressed) = delivery_status_notification(
$conn, $msginfo, 0, \%Amavis::builtins,
!defined($recips_data_override) ? \@recips_blocked
: [ map { $_->recip_addr } @$recips_data_override ],
$request_type, $feedback_type, undef);
$msginfo = $notification;
}
if (defined $sender_override) {
do_log(5, "overriding sender %s by %s", $sender, $sender_override);
$msginfo->sender($sender_override);
$msginfo->sender_smtp(qquote_rfc2821_local($sender_override));
}
if (!defined($recips_data_override)) {
$msginfo->recips(\@recips_blocked); } else { ll(5) && do_log(5, "overriding recips %s by %s",
join(',', qquote_rfc2821_local(@recips_blocked)),
join(',', map { $_->recip_addr_smtp } @$recips_data_override));
$msginfo->per_recip_data($recips_data_override);
}
if ($msg_format eq 'resend') { my($hdrfrom_recip) = $msginfo->setting_by_contents_category(
cr('hdrfrom_notify_recip_by_ccat'));
$hdrfrom_recip = expand_variables($hdrfrom_recip);
if ($msginfo->requested_by eq '') {
$hdr_edits->add_header('Resent-From', $hdrfrom_recip);
} else {
$hdr_edits->add_header('Resent-From',
qquote_rfc2821_local($msginfo->requested_by));
$hdr_edits->add_header('Resent-Sender',
$hdrfrom_recip) if $hdrfrom_recip ne '';
}
my($prd) = $msginfo->per_recip_data;
$hdr_edits->add_header('Resent-To',
$prd && @$prd==1 ? $prd->[0]->recip_addr_smtp
: 'undisclosed-recipients:;');
$hdr_edits->add_header('Resent-Date', rfc2822_timestamp($msginfo->rx_time));
$hdr_edits->add_header('Resent-Message-ID',
sprintf('<QRR%s@%s>', $msginfo->mail_id, c('myhostname')) );
}
$hdr_edits->add_header('Received',
make_received_header_field($conn,$msginfo,$msginfo->mail_id,1), 1);
my($bcc) = $msginfo->setting_by_contents_category(cr('always_bcc_by_ccat'));
if (defined $bcc && $bcc ne '' && $request_type ne 'report') {
my($recip_obj) = Amavis::In::Message::PerRecip->new;
$recip_obj->recip_addr_modified($bcc);
$recip_obj->recip_destiny(D_PASS);
$recip_obj->dsn_notify(['NEVER']);
$recip_obj->contents_category(CC_CLEAN);
$msginfo->per_recip_data([@{$msginfo->per_recip_data}, $recip_obj]);
do_log(2,"adding recipient - always_bcc: %s", $bcc);
}
$msginfo;
}
1;
package Amavis::Cache;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.2071';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log freeze thaw);
}
sub new { my($class,$keysize) = @_;
do_log(5,"BerkeleyDB-based Amavis::Cache not available, ".
"using memory-based local cache");
bless {}, $class;
}
sub get { my($self,$key) = @_; thaw($self->{$key}) }
sub set { my($self,$key,$obj) = @_; $self->{$key} = freeze($obj) }
1;
package Amavis::Custom;
sub new { my($class,$conn,$msginfo) = @_; undef }
sub checks { my($self,$conn,$msginfo) = @_; undef }
sub before_send { my($self,$conn,$msginfo) = @_; undef }
sub after_send { my($self,$conn,$msginfo) = @_; undef }
sub mail_done { my($self,$conn,$msginfo) = @_; undef }
1;
package Amavis;
require 5.005; use strict;
use re 'taint';
BEGIN {
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.207';
import Amavis::Conf qw(:platform :sa :confvars c cr ca);
import Amavis::Util qw(untaint min max unique_list unique_ref
ll do_log sanitize_str debug_oneshot
am_id add_entropy generate_mail_id
prolong_timer waiting_for_client
switch_to_my_time switch_to_client_time
snmp_counters_init snmp_count dynamic_destination
ccat_split ccat_maj cmp_ccat cmp_ccat_maj
setting_by_given_contents_category_all
setting_by_given_contents_category orcpt_encode);
import Amavis::ProcControl qw(exit_status_str proc_status_ok
cloexec run_command collect_results);
import Amavis::Log qw(open_log close_log collect_log_stats);
import Amavis::Timing qw(section_time get_time_so_far);
import Amavis::rfc2821_2822_Tools;
import Amavis::Lookup qw(lookup lookup2);
import Amavis::Lookup::IP qw(lookup_ip_acl);
import Amavis::Out;
import Amavis::Out::EditHeader;
import Amavis::UnmangleSender qw(parse_ip_address_from_received
best_try_originator first_received_from);
import Amavis::Unpackers::Validity qw(
check_header_validity check_for_banned_names);
import Amavis::Unpackers::MIME qw(mime_decode);
import Amavis::Expand qw(expand tokenize);
import Amavis::Notify qw(delivery_status_notification delivery_short_report
build_mime_entity defanged_mime_entity expand_variables);
import Amavis::In::Connection;
import Amavis::In::Message;
}
use Errno qw(ENOENT EACCES EAGAIN ESRCH EBADF);
use POSIX qw(locale_h);
use IO::Handle;
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use Time::HiRes ();
use Digest::MD5;
use Net::Server 0.87; use MIME::Base64;
use vars qw(
$extra_code_db $extra_code_cache
$extra_code_sql_base $extra_code_sql_log $extra_code_sql_quar
$extra_code_sql_lookup $extra_code_ldap
$extra_code_in_amcl $extra_code_in_smtp $extra_code_in_courier
$extra_code_out_smtp $extra_code_out_pipe
$extra_code_out_bsmtp $extra_code_out_local $extra_code_p0f
$extra_code_antivirus $extra_code_antispam
$extra_code_antispam_extprog
$extra_code_antispam_spamc $extra_code_antispam_sa
$extra_code_unpackers $extra_code_dkim $extra_code_tools);
use vars qw(%modules_basic %got_signals);
use vars qw($user_id_sql $user_policy_id_sql $wb_listed_sql);
use vars qw($implicit_maps_inserted);
use vars qw($db_env $snmp_db);
use vars qw($body_digest_cache);
use vars qw(%builtins); use vars qw($last_task_completed_at);
use vars qw($child_invocation_count $child_task_count);
use vars qw($child_init_hook_was_called);
use vars qw(@config_files); use vars qw($MSGINFO);
use vars qw($av_output @virusname @detecting_scanners
$banned_filename_any $banned_filename_all @bad_headers);
use vars qw($amcl_in_obj $smtp_in_obj $courier_in_obj);
use vars qw($sql_dataset_conn_lookups); use vars qw($sql_dataset_conn_storage); use vars qw($sql_storage); use vars qw($sql_policy $sql_wblist); use vars qw($ldap_connection); use vars qw($ldap_policy);
sub new {
my($class) = shift;
@ISA = !$daemonize && $max_servers==1 ? 'Net::Server' : defined $min_servers ? 'Net::Server::PreFork'
: 'Net::Server::PreForkSimple';
bless { server => $_[0] }, $class; }
sub report_rusage() {
my($have_getrusage) = Unix::Getrusage->UNIVERSAL::can("getrusage");
if ($have_getrusage) {
my($usage) = Unix::Getrusage::getrusage();
my(@order) = qw(minflt majflt nswap inblock oublock msgsnd msgrcv nsignals
nvcsw nivcsw maxrss ixrss idrss isrss utime stime);
my(@result) = map { $_ . '=' . $usage->{'ru_'.$_} } @order; delete $usage->{'ru_'.$_} for @order;
push(@result, map { $_ . '=' . $usage->{$_} } keys %$usage); do_log(2,"RUSAGE: %s", join(', ',@result));
}
}
sub macro_tests {
my($msginfo,$recip_index,$name,$sep) = @_;
my(@s) = split(/,/, $msginfo->spam_status);
my(@reported_boost);
if (defined $recip_index) { my($r) = $msginfo->per_recip_data->[$recip_index];
my($boost) = $r->recip_score_boost;
@reported_boost = ($boost) if $boost;
} else {
@reported_boost = grep { defined($_) && abs($_) >= 0.0005 }
map { $_->recip_score_boost }
@{$msginfo->per_recip_data};
}
if (@reported_boost == 1) {
unshift(@s, 'AM:BOOST=' . (0+sprintf("%.3f",$reported_boost[0])));
} elsif (@reported_boost > 1) {
unshift(@s, sprintf("AM:BOOST=%s", join('', unique_list(
map { my($s) = sprintf("%+.3f",$_); $s=~s/\.?0*\z//; $s }
@reported_boost ))));
}
if (@s > 50) { $ @s = map {my($tn,$ts)=split(/=/); $tn} @s if $name eq 'TESTS';
if ($name eq 'T' || !defined($sep)) { \@s } else { join($sep,@s) }
};
sub macro_score {
my($msginfo,$recip_index,$name,$arg) = @_;
my($result); my(@boost); my($w) = '';
if ($name eq 'SCORE' && defined($arg) && $arg=~/^(0+| +)\z/)
{ $w = length($arg)+4; $w = $arg=~/^0/ ? "0$w" : "$w" } my($fmt) = "%$w.3f"; my($fmts) = "%+$w.3f"; if (defined $recip_index) { my($r) = $msginfo->per_recip_data->[$recip_index];
@boost = ( !defined($r) ? undef : $r->recip_score_boost );
} else { @boost = map { $_->recip_score_boost } @{$msginfo->per_recip_data};
}
my($sl) = $msginfo->spam_level;
if ($name eq 'STARS') {
my($slc) = $arg ne '' ? $arg : c('sa_spam_level_char');
$result = $slc eq '' || !defined($sl) ?'' : $slc x min(50,$sl+min(@boost));
} elsif (!defined($sl) && max(map {abs($_)} @boost) <= 1) { $result = '-';
} else {
$sl = 0 if !defined $sl; @boost = unique_list(\@boost);
if (!grep {abs($_) >= 0.0005} @boost) { $result = sprintf($fmt,$sl); $result =~ s/\.?0*\z//; # trim fraction
} elsif ($name eq 'SCORE') { $result = sprintf($fmt,$sl+min(@boost)); $result =~ s/\.?0*\z//; # trim
} else { $sl = sprintf($fmt,$sl); $sl =~ s/\.?0*\z//; # trim trailing zeroes
if (@boost <= 1) {
$result = sprintf($fmts,$boost[0]); $result=~s/\.?0*\z//; # with sign
} else {
$result = sprintf("+(%s)",
join(',',map {my($s)=sprintf($fmt,$_); $s=~s/\.?0*\z//; $s} @boost));
}
$result = $sl . $result;
}
}
$result;
};
sub macro_header_field {
my($msginfo,$name,$header_field_name,$limit) = @_;
local($_) = $msginfo->get_header_field_body($header_field_name);
if (defined $_) { chomp; s/\n(?=[ \t])//gs; s/^[ \t]+//; s/[ \t\n]+\z//;
if ($header_field_name =~
/^(?:Message-ID|Resent-Message-ID|In-Reply-To|References)\z/i) {
$_ = join(' ',parse_message_id($_)) if $_ ne ''; }
s{([\r\n\000\200])}{sprintf("\\%03o",ord($1))}eg;
};
!defined($limit) || $limit < 6 || length($_) <= $limit ? $_
: substr($_,0,$limit-5) . '[...]';
};
sub dkim_test {
my($name,$which) = @_;
my($w) = lc($which);
my($sigs_ref) = $MSGINFO->dkim_signatures_valid;
!defined($sigs_ref) || !@$sigs_ref ? undef
: $w eq 'any' || $w eq '' ? 1
: $w eq 'author' ? $MSGINFO->dkim_author_sig
: $w eq 'sender' ? $MSGINFO->dkim_sender_sig
: $w eq 'thirdparty' ? $MSGINFO->dkim_thirdparty_sig
: $w eq 'envsender' ? $MSGINFO->dkim_envsender_sig
: $w eq 'identity' ? join(',', map { $_->identity } @$sigs_ref)
: $w eq 'domain' ? join(',', map { $_->domain } @$sigs_ref)
: dkim_acceptable_identity($MSGINFO,$which);
}
sub dkim_acceptable_identity($@) {
my($msginfo,@acceptable_id) = @_;
my($matches) = 0;
my($sigs_ref) = $msginfo->dkim_signatures_valid;
if (defined($sigs_ref) && @$sigs_ref) {
for (@acceptable_id) {
my($acceptable_id) = $_;
$acceptable_id = '' if !defined $acceptable_id;
if ($acceptable_id eq '') { $matches = 1 if $msginfo->dkim_author_sig;
} else {
local($1,$2);
$acceptable_id = '@'.$acceptable_id if $acceptable_id !~ /\@/;
$acceptable_id =~ /^ (.*?) \@ ([^\@]*) \z/xs; my($acceptable_id_mbx, $acceptable_id_dom) = ($1,$2);
for my $sig (@$sigs_ref) {
my($identity) = $sig->identity; if ($acceptable_id_mbx ne '') { $matches = 1 if lc($identity) eq lc($acceptable_id);
} else { $identity =~ /^ (.*?) \@ ([^\@]*) \z/xs; my($identity_mbx, $identity_dom) = ($1,$2);
$matches = 1 if $identity_dom=~/(^|\.)\Q$acceptable_id_dom\E\z/si;
}
last if $matches;
}
}
last if $matches;
}
}
$matches;
};
sub init_builtin_macros() {
%builtins = (
'.' => undef,
p => sub {c('policy_bank_path')},
DATE => sub {rfc2822_timestamp($MSGINFO->rx_time)},
d => sub {rfc2822_timestamp($MSGINFO->rx_time)}, U => sub {iso8601_utc_timestamp($MSGINFO->rx_time)}, u => sub {sprintf("%010d",int($MSGINFO->rx_time))}, date_unix_utc => sub {sprintf("%010d",int($MSGINFO->rx_time))},
date_iso8601_utc => sub {iso8601_utc_timestamp($MSGINFO->rx_time)},
date_iso8601_local => sub {iso8601_timestamp($MSGINFO->rx_time)},
date_rfc2822_local => sub {rfc2822_timestamp($MSGINFO->rx_time)},
week_iso8601 => sub {iso8601_week($MSGINFO->rx_time)},
y => sub {sprintf("%.0f", 1000*get_time_so_far())}, h => sub {c('myhostname')}, HOSTNAME => sub {c('myhostname')},
l => sub {$MSGINFO->originating ? 1 : undef}, s => sub {$MSGINFO->sender_smtp}, S => sub { sanitize_str($MSGINFO->sender_contact) }, o => sub { sanitize_str($MSGINFO->sender_source) }, R => sub {$MSGINFO->recips}, D => sub {my($y,$n,$f)=delivery_short_report($MSGINFO); $y}, O => sub {my($y,$n,$f)=delivery_short_report($MSGINFO); $n}, N => sub {my($y,$n,$f)=delivery_short_report($MSGINFO); $f}, Q => sub {$MSGINFO->queue_id}, m => sub {macro_header_field($MSGINFO,'header','Message-ID')},
r => sub {macro_header_field($MSGINFO,'header','Resent-Message-ID')},
j => sub {macro_header_field($MSGINFO,'header','Subject')},
rfc2822_sender => sub {my($s) = $MSGINFO->rfc2822_sender;
!defined($s) ? undef : qquote_rfc2821_local($s) },
rfc2822_from => sub {my($f) = $MSGINFO->rfc2822_from;
!defined($f) ? undef :
qquote_rfc2821_local(ref $f ? @$f : $f)},
rfc2822_resent_sender => sub {my($rs) = $MSGINFO->rfc2822_resent_sender;
!defined($rs) ? undef :
qquote_rfc2821_local(grep {defined $_} @$rs)},
rfc2822_resent_from => sub {my($rf) = $MSGINFO->rfc2822_resent_from;
!defined($rf) ? undef :
qquote_rfc2821_local(grep {defined $_} @$rf)},
'x-mailer' => sub {macro_header_field($MSGINFO,'header','X-Mailer')},
header_field => sub {macro_header_field($MSGINFO,@_)},
HEADER => sub {macro_header_field($MSGINFO,@_)},
useragent => sub { my($macro_name,$which_part) = @_; my($head,$body);
$body = macro_header_field($MSGINFO,'header', $head='User-Agent');
$body = macro_header_field($MSGINFO,'header', $head='X-Mailer')
if !defined $body;
!defined($body) ? undef
: lc($which_part) eq 'name' ? $head
: lc($which_part) eq 'body' ? $body : "$head: $body";
},
ccat =>
sub {
my($name,$attr,$which) = @_;
$attr = lc($attr); $which = lc($which); my($result) = ''; my($blocking_ccat) = $MSGINFO->blocking_ccat;
if ($attr eq 'is_blocking') {
$result = defined($blocking_ccat) ? 1 : '';
} elsif ($attr eq 'is_nonblocking') {
$result = !defined($blocking_ccat) ? 1 : '';
} elsif ($attr eq 'is_blocked_by_nonmain') {
if (defined($blocking_ccat)) {
my($aref) = $MSGINFO->contents_category;
$result = 1 if ref($aref) && @$aref > 0
&& $blocking_ccat ne $aref->[0];
}
} elsif ($attr eq 'name') {
$result =
$which eq 'main' ?
$MSGINFO->setting_by_main_contents_category(\%ccat_display_names)
: $which eq 'blocking' ?
$MSGINFO->setting_by_blocking_contents_category(
\%ccat_display_names)
: $MSGINFO->setting_by_contents_category( \%ccat_display_names);
} else { my($maj,$min) = ccat_split(
($which eq 'blocking' ||
$which ne 'main' && defined $blocking_ccat)
? $blocking_ccat : $MSGINFO->contents_category);
$result = $attr eq 'major' ? $maj
: $attr eq 'minor' ? sprintf("%d",$min)
: sprintf("(%d,%d)",$maj,$min);
}
$result;
},
ccat_maj => sub { my($blocking_ccat) = $MSGINFO->blocking_ccat;
(ccat_split(defined $blocking_ccat ? $blocking_ccat
: $MSGINFO->contents_category))[0];
},
ccat_min => sub { my($blocking_ccat) = $MSGINFO->blocking_ccat;
(ccat_split(defined $blocking_ccat ? $blocking_ccat
: $MSGINFO->contents_category))[1];
},
ccat_name => sub { $MSGINFO->setting_by_contents_category(\%ccat_display_names) },
dsn_notify => sub {
return 'NEVER' if $MSGINFO->sender eq '';
my(%merged);
for my $r (@{$MSGINFO->per_recip_data}) {
my($dn) = $r->dsn_notify;
for ($dn ? @$dn : ('FAILURE')) { $merged{uc($_)} = 1 }
}
uc(join(',', sort keys %merged));
},
b => sub {$MSGINFO->body_digest}, n => sub {$MSGINFO->log_id}, i => sub {$MSGINFO->mail_id}, LOGID => sub {$MSGINFO->log_id}, MAILID => sub {$MSGINFO->mail_id}, P => sub {$MSGINFO->partition_tag}, partition_tag => sub {$MSGINFO->partition_tag}, q => sub {my($q) = $MSGINFO->quarantined_to;
!defined($q) ? undef :
[map { my($m)=$_; $m=~s{^\Q$QUARANTINEDIR\E/}{}; $m } @$q];
}, v => sub {[split(/[ \t]*\r?\n/,$av_output)]}, V => sub {my($vn) = $MSGINFO->virusnames; !defined($vn) ? undef : unique_ref($vn)},
F => sub { my($b);
for my $r (@{$MSGINFO->per_recip_data}) {
$b = $r->banning_reason_short;
last if defined $b;
}
$b },
banning_rule_key => sub {
unique_ref(map { my($v) = $_->banning_rule_key;
!defined($v) ? () : @$v }
@{$MSGINFO->per_recip_data});
},
banning_rule_comment => sub {
unique_ref(map { my($v) = $_->banning_rule_comment;
!defined($v) ? () : @$v }
@{$MSGINFO->per_recip_data});
},
banning_rule_rhs => sub {
unique_ref(map { my($v) = $_->banning_rule_rhs;
!defined($v) ? () : @$v }
@{$MSGINFO->per_recip_data});
},
banned_parts => sub { my($b) = unique_ref(map { @{$_->banned_parts} }
grep { defined($_->banned_parts) }
@{$MSGINFO->per_recip_data});
my($b_chopped) = @$b > 2; @$b = (@$b[0,1],'...') if $b_chopped;
s/[ \t]{6,}/ ... /g for @$b;
$b },
X => sub {\@bad_headers},
W => sub {\@detecting_scanners}, H => sub {[map {split(/\n/,$_)} @{$MSGINFO->orig_header}]}, A => sub {[split(/\r?\n/, $MSGINFO->spam_summary)]}, SUMMARY => sub {$MSGINFO->spam_summary},
REPORT => sub {sanitize_str($MSGINFO->spam_report,1)}, TESTSSCORES => sub {macro_tests($MSGINFO,undef,@_)}, TESTS => sub {macro_tests($MSGINFO,undef,@_)}, z => sub {$MSGINFO->msg_size}, t => sub { sanitize_str(first_received_from($MSGINFO)) },
e => sub { sanitize_str(parse_ip_address_from_received($MSGINFO)) },
a => sub {$MSGINFO->client_addr}, g => sub { sanitize_str($MSGINFO->client_name) },
remote_mta => sub { unique_ref(map {$_->recip_remote_mta}
@{$MSGINFO->per_recip_data}) },
smtp_response => sub { unique_ref(map {$_->recip_smtp_response}
@{$MSGINFO->per_recip_data}) },
remote_mta_smtp_response =>
sub { unique_ref(map {$_->recip_remote_mta_smtp_response}
@{$MSGINFO->per_recip_data}) },
REMOTEHOSTADDR => sub { my($c) = $MSGINFO->conn_obj; !$c ? '' : $c->client_ip },
REMOTEHOSTNAME =>
sub { my($c) = $MSGINFO->conn_obj;
my($ip) = !$c ? '' : $c->client_ip;
$ip ne '' ? "[$ip]" : 'localhost' },
AUTOLEARN => sub {$MSGINFO->supplementary_info('AUTOLEARN')},
supplementary_info => sub { my($name,$key,$fmt)=@_;
my($info) = $MSGINFO->supplementary_info($key);
$info eq '' ? '' : $fmt eq '' ? $info : sprintf($fmt,$info);
},
REQD => sub { my($tag2_level);
for (@{$MSGINFO->per_recip_data}) { my($tag2_l) = lookup2(0,$_->recip_addr,
ca('spam_tag2_level_maps'));
$tag2_level = $tag2_l if defined($tag2_l) &&
(!defined($tag2_level) || $tag2_l < $tag2_level);
}
!defined($tag2_level) ? '-' : 0+sprintf("%.3f",$tag2_level);
},
'1'=> sub { (grep { $_->is_in_contents_category(CC_CLEAN,1) }
@{$MSGINFO->per_recip_data}) ? 'Y' : '0' },
'2'=> sub { (grep { $_->is_in_contents_category(CC_SPAMMY) }
@{$MSGINFO->per_recip_data}) ? 'Y' : '0' },
YESNO => sub { (grep { $_->is_in_contents_category(CC_SPAMMY) }
@{$MSGINFO->per_recip_data}) ? 'Yes' : 'No' },
YESNOCAPS => sub { (grep { $_->is_in_contents_category(CC_SPAMMY) }
@{$MSGINFO->per_recip_data}) ? 'YES' : 'NO' },
'k'=> sub { (grep { $_->is_in_contents_category(CC_SPAM) }
@{$MSGINFO->per_recip_data}) ? 'Y' : '0' },
score_boost => sub {0+sprintf("%.3f",min(map {$_->recip_score_boost}
@{$MSGINFO->per_recip_data}))},
c => sub {macro_score($MSGINFO,undef,@_)}, SCORE => sub {macro_score($MSGINFO,undef,@_)}, STARS => sub {macro_score($MSGINFO,undef,@_)}, dkim => \&dkim_test,
tls_in => sub {$MSGINFO->tls_cipher}, report_format => undef, feedback_type => undef, wrap => sub {my($name,$width,$prefix,$indent,$str) = @_;
wrap_string($str,$width,$prefix,$indent)},
lc => sub {my($name)=shift; lc(join('',@_))}, uc => sub {my($name)=shift; uc(join('',@_))}, substr => sub {my($name,$s,$ofs,$len) = @_;
defined $len ? substr($s,$ofs,$len) : substr($s,$ofs)},
index => sub {my($name,$s,$substr,$pos) = @_;
index($s, $substr, defined $pos?$pos:0)},
len => sub {my($name,$s) = @_; length($s)},
incr => sub {my($name,$v,@rest) = @_;
if (!@rest) { $v++ } else { $v += $_ for @rest }; "$v"},
decr => sub {my($name,$v,@rest) = @_;
if (!@rest) { $v-- } else { $v -= $_ for @rest }; "$v"},
min => sub {my($name,@args) = @_; min(map {/^\s*\z/?undef:$_} @args)},
max => sub {my($name,@args) = @_; max(map {/^\s*\z/?undef:$_} @args)},
sprintf=> sub {my($name,$fmt,@args) = @_; sprintf($fmt,@args)},
join => sub {my($name,$sep,@args) = @_; join($sep,@args)},
limit => sub {my($name,$lim,$s) = @_; $lim < 6 || length($s) <= $lim ? $s
: substr($s,0,$lim-5).'[...]' },
dquote => sub {my($nm)=shift; join('', map { s{"}{""}g; '"'.$_.'"' } @_)},
uquote => sub {my($nm)=shift; join('', map { s{[ \t]+}{_}g; $_ } @_)},
b64encode => sub {my($nm)=shift; join(' ', map {encode_base64($_,'')} @_)},
# macros f, T, C, B will be defined for each notification as appropriate
# (representing From:, To:, Cc:, and Bcc: respectively)
# remaining free letters: wxEGIJKLMYZ
);
}
# initialize %local_delivery_aliases
sub init_local_delivery_aliases() {
# The %local_delivery_aliases maps local virtual 'localpart' to a mailbox
# (e.g. to a quarantine filename or a directory). Used by method 'local:',
# i.e. in mail_to_local_mailbox(), for direct local quarantining.
# The hash value may be a ref to a pair of fixed strings, or a subroutine ref
# (which must return a pair of strings (a list, not a list ref)) which makes
# possible lazy evaluation when some part of the pair is not known before
# the final delivery time. The first string in a pair must be either:
# - empty or undef, which will disable saving the message,
# - a filename, indicating a Unix-style mailbox,
# - a directory name, indicating a maildir-style mailbox,
# in which case the second string may provide a suggested file name.
#
%Amavis::Conf::local_delivery_aliases = (
'virus-quarantine' => sub { ($QUARANTINEDIR, undef) },
'banned-quarantine' => sub { ($QUARANTINEDIR, undef) },
'spam-quarantine' => sub { ($QUARANTINEDIR, undef) },
'bad-header-quarantine' => sub { ($QUARANTINEDIR, undef) },
'clean-quarantine' => sub { ($QUARANTINEDIR, undef) },
'other-quarantine' => sub { ($QUARANTINEDIR, undef) },
'archive-quarantine' => sub { ($QUARANTINEDIR, undef) },
# some more examples:
'archive-files' => sub { ("$QUARANTINEDIR", undef) },
'archive-mbox' => sub { ("$QUARANTINEDIR/archive.mbox", undef) },
'recip-quarantine' => sub { ("$QUARANTINEDIR/recip-archive.mbox",undef) },
'sender-quarantine' =>
sub { my($s) = $MSGINFO->sender;
$s = substr($s,0,100)."..." if length($s) > 100+3;
$s =~ tr/a-zA-Z0-9@._+-/=/c; $s =~ s/\@/_at_/g;
$s = untaint($s) if $s =~ /^(?:[a-zA-Z0-9%=._+-]+)\z/; # untaint
($QUARANTINEDIR, "sender-$s-%m.gz"); # suggested file name
},
# 'recip-quarantine2' => sub {
# my(@fnames);
# my($myfield) =
# Amavis::Lookup::SQLfield->new($sql_policy,'some_field_name','S');
# for my $r (@{$MSGINFO->recips}) {
# my($field_value) = lookup(0,$r,$myfield);
# my($fname) = $field_value; # or perhaps: my($fname) = $r;
# local($1); $fname =~ s/[^a-zA-Z0-9._\@]/=/g; $fname =~ s/\@/%/g;
# $fname = untaint($fname) if $fname =~ /^([a-zA-Z0-9._=%]+)\z/;
# $fname =~ s/%/%%/g; # protect %
# do_log(3, "Recipient: %s, field: %s, fname: %s",
# $r, $field_value, $fname);
# push(@fnames, $fname);
# }
# # ???what file name to choose if there is more than one recipient???
# ( $QUARANTINEDIR, "sender-$fnames[0]-%i-%n.gz" ); # suggested file name
# },
);
}
# tokenize templates (input to macro expansion), after dropping privileges
sub init_tokenize_templates() {
my(@templ_names) = qw(log_templ log_recip_templ
notify_sender_templ notify_virus_recips_templ
notify_virus_sender_templ notify_virus_admin_templ
notify_spam_sender_templ notify_spam_admin_templ
notify_release_templ notify_report_templ notify_autoresp_templ);
for my $bank_name (keys %policy_bank) {
for my $n (@templ_names) { # tokenize templates to speed up macro expansion
my($s) = $policy_bank{$bank_name}{$n}; $s = $$s if ref($s) eq 'SCALAR';
$policy_bank{$bank_name}{$n} = tokenize(\$s) if defined $s;
}
}
}
# pre-parse IP lookup tables to speed up lookups, after dropping privileges
sub init_preparse_ip_lookups() {
for my $bank_name (keys %policy_bank) {
my($r) = $policy_bank{$bank_name}{'inet_acl'};
if (ref($r) eq 'ARRAY') # should be a ref to single IP lookup table
{ $policy_bank{$bank_name}{'inet_acl'} = Amavis::Lookup::IP->new(@$r) }
$r = $policy_bank{$bank_name}{'client_ipaddr_policy'}; # listref of pairs
if (ref($r) eq 'ARRAY') { # should be an array, test just to make sure
my($odd) = 1;
for my $table (@$r) { # replace plain lists with Amavis::Lookup::IP obj.
$table = Amavis::Lookup::IP->new(@$table)
if $odd && ref($table) eq 'ARRAY';
$odd = !$odd;
}
}
}
}
# initialize some remaining global variables in a master process;
# invoked after chroot and after privileges have been dropped, before forking
sub after_chroot_init() {
$child_invocation_count = $child_task_count = 0;
%modules_basic = %INC; # helps to track missing modules in chroot
do_log(5,"after_chroot_init: EUID: %s (%s); EGID: %s (%s)", $>,$<, $),$( );
my(@msg);
my($euid) = $>; # effective UID
$> = 0; # try to become root
POSIX::setuid(0) if $> != 0; # and try some more
if ($> == 0 || $euid == 0) { # succeded? panic!
@msg = ("It is possible to change EUID from $euid to root, ABORTING!",
"Please use a recent version of Net::Server",
"or start as non-root, e.g. by su(1) or using option -u user");
} elsif ($daemon_chroot_dir eq '') {
# A quick check on vulnerability/protection of a config file
# (non-exhaustive: doesn't test for symlink tricks and higher directories).
# The config file has already been executed by now, so it may be
# too late to feel sorry now, but better late then never.
my(@actual_c_f) = Amavis::Conf::get_config_files_read();
do_log(2,"config files read: %s", join(", ",@actual_c_f));
for my $config_file (@actual_c_f) {
local($1); # IO::Handle::_open_mode_string can taint $1 if mode is '+<'
my($fh) = IO::File->new;
my($errn) = stat($config_file) ? 0 : 0+$!;
if ($errn) { # not accessible, don't bother to test further
} elsif ($fh->open($config_file,O_RDWR)) {
push(@msg, "Config file \"$config_file\" is writable, ".
"UID $<, EUID $>, EGID $)" );
$fh->close; # close, ignoring status
} elsif (rename($config_file, $config_file.'.moved')) {
my($m) = 'appears writable (unconfirmed)';
my($errn_cf_orig) = stat($config_file) ? 0 : 0+$!;
my($errn_cf_movd) = stat($config_file.'.moved') ? 0 : 0+$!;
if ($errn_cf_orig==ENOENT && $errn_cf_movd!=ENOENT) {
# try to rename back, ignoring status
rename($config_file.'.moved', $config_file);
$m = 'is writable (confirmed)';
}
push(@msg, "Directory of a config file \"$config_file\" $m, ".
"UID $<, EUID $>, EGID $)" );
}
last if @msg;
}
}
if (@msg) {
do_log(-3,"FATAL: %s",$_) for @msg;
print STDERR (map {"$_\n"} @msg);
die "SECURITY PROBLEM, ABORTING";
exit 1; # just in case
}
init_tokenize_templates();
init_preparse_ip_lookups();
# report versions of some (more interesting) modules
for my $m ('Amavis::Conf',
sort map { s/\.pm\z//; s[/][::]g; $_ } grep { /\.pm\z/ } keys %INC) {
next if !grep { $_ eq $m } qw(Amavis::Conf
Archive::Tar Archive::Zip Compress::Zlib Convert::TNEF Convert::UUlib
MIME::Entity MIME::Parser MIME::Tools Mail::Header Mail::Internet
Digest::MD5 Digest::SHA Digest::SHA1 Authen::SASL Crypt::OpenSSL::RSA
Socket6 IO::Socket::INET6 IO::Socket::SSL Net::SSLeay Net::Server
Mail::ClamAV Mail::SpamAssassin Mail::DKIM::Verifier Mail::DKIM::Signer
Mail::SPF Mail::SPF::Query NetAddr::IP URI Razor2::Client::Version
Net::LDAP DBI DBD::mysql DBD::Pg DBD::SQLite BerkeleyDB DB_File
Net::DNS Unix::Syslog Time::HiRes SAVI Anomy::Sanitizer Unix::Getrusage);
do_log(0, "Module %-19s %s", $m, $m->VERSION || '?');
}
do_log(0,"Amavis::DB code %s loaded", $extra_code_db ?'':" NOT");
do_log(0,"Amavis::Cache code %s loaded", $extra_code_cache ?'':" NOT");
do_log(0,"SQL base code %s loaded", $extra_code_sql_base ?'':" NOT");
do_log(0,"SQL::Log code %s loaded", $extra_code_sql_log ?'':" NOT");
do_log(0,"SQL::Quarantine %s loaded", $extra_code_sql_quar ?'':" NOT");
do_log(0,"Lookup::SQL code %s loaded", $extra_code_sql_lookup ?'':" NOT");
do_log(0,"Lookup::LDAP code %s loaded", $extra_code_ldap ?'':" NOT");
do_log(0,"AM.PDP-in proto code%s loaded", $extra_code_in_amcl ?'':" NOT");
do_log(0,"SMTP-in proto code %s loaded", $extra_code_in_smtp ?'':" NOT");
do_log(0,"Courier proto code %s loaded", $extra_code_in_courier ?'':" NOT");
do_log(0,"SMTP-out proto code %s loaded", $extra_code_out_smtp ?'':" NOT");
do_log(0,"Pipe-out proto code %s loaded", $extra_code_out_pipe ?'':" NOT");
do_log(0,"BSMTP-out proto code%s loaded", $extra_code_out_bsmtp ?'':" NOT");
do_log(0,"Local-out proto code%s loaded", $extra_code_out_local ?'':" NOT");
do_log(0,"OS_Fingerprint code %s loaded", $extra_code_p0f ?'':" NOT");
do_log(0,"ANTI-VIRUS code %s loaded", $extra_code_antivirus ?'':" NOT");
do_log(0,"ANTI-SPAM code %s loaded", $extra_code_antispam ?'':" NOT");
do_log(0,"ANTI-SPAM-EXT code %s loaded",
$extra_code_antispam_extprog ?'':" NOT");
do_log(0,"ANTI-SPAM-C code %s loaded",
$extra_code_antispam_spamc ?'':" NOT");
do_log(0,"ANTI-SPAM-SA code %s loaded", $extra_code_antispam_sa?'':" NOT");
do_log(0,"Unpackers code %s loaded", $extra_code_unpackers ?'':" NOT");
do_log(0,"DKIM code %s loaded", $extra_code_dkim ?'':" NOT");
do_log(0,"Tools code %s loaded", $extra_code_tools ?'':" NOT");
# store policy names into 'policy_bank_name' fields, if not explicitly set
for my $name (keys %policy_bank) {
if (ref($policy_bank{$name}) eq 'HASH' &&
!exists($policy_bank{$name}{'policy_bank_name'})) {
$policy_bank{$name}{'policy_bank_name'} = $name;
$policy_bank{$name}{'policy_bank_path'} = $name;
}
}
};
# overlay the current policy bank by settings from the
# $policy_bank{$policy_bank_name}, or load the default policy bank (empty name)
sub load_policy_bank($) {
my($policy_bank_name) = @_;
if (!exists $policy_bank{$policy_bank_name}) {
do_log(-1,'policy bank "%s" does not exist, ignored', $policy_bank_name);
} elsif ($policy_bank_name eq '') {
%current_policy_bank = %{$policy_bank{$policy_bank_name}}; # copy base
do_log(4,'loaded base policy bank');
} else {
my($cpbp) = c('policy_bank_path'); # currently loaded bank
my($new_bank_ref) = $policy_bank{$policy_bank_name};
my($do_log5) = ll(5);
for my $k (keys %$new_bank_ref) {
do_log(-1,'loading policy bank "%s": unknown field "%s"',
$policy_bank_name,$k) if !exists $current_policy_bank{$k};
if (ref($new_bank_ref->{$k}) ne 'HASH' ||
ref($current_policy_bank{$k}) ne 'HASH') {
$current_policy_bank{$k} = $new_bank_ref->{$k};
} else { # new hash to be merged into an existing hash
if ($new_bank_ref->{REPLACE}) { # replace the entire hash
$current_policy_bank{$k} = { %{$new_bank_ref->{$k}} }; # copy of new
do_log(5,"loading policy bank %s, curr{%s} hash replaced",
$policy_bank_name, $k) if $do_log5;
} else { # merge field-by-field, old fields missing in new are retained
$current_policy_bank{$k} = { %{$current_policy_bank{$k}} }; # copy
my($key,$val);
while (($key,$val) = each %{$new_bank_ref->{$k}}) {
do_log(5,"loading policy bank %s, curr{%s}{%s} = %s, %s",
$policy_bank_name, $k, $key, $val,
!exists($current_policy_bank{$k}{$key}) ? 'new'
: 'replaces '.$current_policy_bank{$k}{$key}
) if $do_log5;
$current_policy_bank{$k}{$key} = $val;
}
}
delete $current_policy_bank{$k}{REPLACE};
}
}
$current_policy_bank{'policy_bank_path'} =
($cpbp eq '' ? '' : $cpbp.'/') . $policy_bank_name;
do_log(2,'loaded policy bank "%s"%s', $policy_bank_name,
$cpbp eq '' ? '' : " over \"$cpbp\"");
}
}
### Net::Server hook
### Occurs in the parent (master) process after (possibly) opening a log file,
### creating pid file, reopening STDIN/STDOUT to /dev/null and daemonizing;
### but before binding to sockets
sub post_configure_hook {
# umask(0007); # affect protection of Unix sockets created by Net::Server
}
### Net::Server hook
### Occurs in the parent (master) process after binding to sockets,
### but before chrooting and dropping privileges
sub post_bind_hook {
umask(0027); # restore our preferred umask
}
### Net::Server hook
### This hook occurs in the parent (master) process after chroot,
### after change of user, and change of group has occured.
### It allows for preparation before forking and looping begins.
sub pre_loop_hook {
my($self) = @_;
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered pre_loop_hook");
eval {
after_chroot_init(); # the rest of the top-level initialization
# this needs to be done only after chroot, otherwise paths will be wrong
find_external_programs([split(/:/,$path,-1)]); # path, decoders, scanners
# do some sanity checking
my($name) = $TEMPBASE;
$name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne '';
my($errn) = stat($TEMPBASE) ? 0 : 0+$!;
if ($errn==ENOENT) { die "No TEMPBASE directory: $name" }
elsif ($errn) { die "TEMPBASE directory inaccessible, $!: $name" }
elsif (!-d _) { die "TEMPBASE is not a directory: $name" }
elsif (!-w _) { die "TEMPBASE directory is not writable: $name" }
if ($enable_global_cache && $extra_code_db) {
my($name) = $db_home;
$name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne '';
$errn = stat($db_home) ? 0 : 0+$!;
if ($errn == ENOENT) {
die "Please create an empty directory $name to hold a database".
" (config variable \$db_home)\n" }
elsif ($errn) { die "db_home $name inaccessible: $!" }
elsif (!-d _) { die "db_home $name is not a directory" }
elsif (!-w _) { die "db_home $name directory is not writable" }
# Amavis::DB::init(1, 15+1+40); # SHA-1 (160 bits)
Amavis::DB::init(1, 15+1+32); # MD5 (128 bits)
}
if (!defined($sql_quarantine_chunksize_max)) {
die "Variable \$sql_quarantine_chunksize_max is undefined\n";
} elsif ($sql_quarantine_chunksize_max < 1024) {
die "Setting of \$sql_quarantine_chunksize_max is too small: ".
"$sql_quarantine_chunksize_max bytes, it would be inefficient\n";
} elsif ($sql_quarantine_chunksize_max > 1024*1024) {
do_log(-1, "Setting of %s is quite large: %d kB, it unnecessarily ".
"wastes memory", '$sql_quarantine_chunksize_max',
$sql_quarantine_chunksize_max/1024);
}
if ($QUARANTINEDIR ne '') {
my($name) = $QUARANTINEDIR;
$name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne '';
$errn = stat($QUARANTINEDIR) ? 0 : 0+$!;
if ($errn == ENOENT) { } # ok
elsif ($errn) { die "QUARANTINEDIR $name inaccessible: $!" }
elsif (-d _ && !-w _){ die "QUARANTINEDIR directory $name not writable"}
}
$spamcontrol_obj->init_pre_fork if $spamcontrol_obj;
my(@modules_extra) = grep {!exists $modules_basic{$_}} keys %INC;
if (@modules_extra) {
do_log(1, "extra modules loaded after daemonizing/chrooting: %s",
join(", ", sort @modules_extra));
%modules_basic = %INC;
}
do_log(0, "DKIM signature verification disabled, corresponding features ".
"not available. If not intentional, consider enabling it by setting: ".
"\$enable_dkim_verification to 1, or explicitly disable it by setting ".
"it to 0 to quench down this warning."
) if !$enable_dkim_verification && !defined($enable_dkim_verification);
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
my($msg) = "TROUBLE in pre_loop_hook: $eval_stat"; do_log(-2,"%s",$msg);
die("Suicide (" . am_id() . ") " . $msg . "\n");
};
1;
}
### log routine Net::Server hook
### (Sys::Syslog MUST NOT be specified as a value of 'log_file'!)
#
# Redirect Net::Server logging to use Amavis' do_log().
# The main reason is that Net::Server uses Sys::Syslog
# (and has two bugs in doing it, at least the Net-Server-0.82),
# and Amavis users are acustomed to Unix::Syslog.
sub write_to_log_hook {
my($self,$level,$msg) = @_;
my($prop) = $self->{server};
local $SIG{CHLD} = 'DEFAULT';
$level = 0 if $level < 0; $level = 4 if $level > 4;
# my($ll) = (-2,-1,0,1,3)[$level]; # 0=err, 1=warn, 2=notice, 3=info, 4=debug
my($ll) = (-1, 0,1,3,4)[$level]; # 0=err, 1=warn, 2=notice, 3=info, 4=debug
chomp($msg); # just call Amavis' traditional logging
ll($ll) && do_log($ll, "Net::Server: %s", $msg);
1;
}
### user customizable Net::Server hook (Net::Server 0.88 or later),
### hook occurs in the master process !!!
sub run_n_children_hook {
# do_log(5, "entered run_n_children_hook");
Amavis::AV::sophos_savi_reload()
if $extra_code_antivirus && Amavis::AV::sophos_savi_stale();
add_entropy(Time::HiRes::gettimeofday);
}
### compatibility with patched Net::Server by SAVI patch (Net::Server <= 0.87)
sub parent_fork_hook { my($self) = @_; $self->run_n_children_hook }
### user customizable Net::Server hook,
### run by every child process during its startup
sub child_init_hook {
my($self) = @_;
local $SIG{CHLD} = 'DEFAULT';
# reset log counters inherited from a master process
collect_log_stats();
do_log(5, "entered child_init_hook");
$child_init_hook_was_called = 1;
$my_pid = $$; $0 = 'amavisd (virgin child)';
# my(@signames) = qw(HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV
# SYS PIPE ALRM TERM URG TSTP CONT TTIN TTOU IO
# XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2);
# my($h) = sub { my($s) = $_[0]; $got_signals{$s}++;
# local($SIG{$s})='IGNORE'; kill($$,$s) };
# @SIG{@signames} = ($h) x @signames;
my($inherited_entropy);
eval {
# if ($> == 0 || $< == 0) { # last resort, in case Net::Server didn't do it
# do_log(2, "child_init_hook: dropping privileges, user=%s, group=%s",
# $daemon_user,$daemon_group);
# drop_priv($daemon_user,$daemon_group);
# }
$db_env = $snmp_db = $body_digest_cache = undef; # just in case
Amavis::Timing::init(); snmp_counters_init();
close_log(); open_log(); # reopen syslog or log file to get per-process fd
if ($extra_code_db) {
# Berkeley DB handles should not be shared across process forks,
# each forked child should acquire its own Berkeley DB handles
$db_env = Amavis::DB->new; # get access to a bdb environment
$snmp_db = Amavis::DB::SNMP->new($db_env);
$snmp_db->register_proc(0,1,'') if defined $snmp_db; # alive and idle
my($var_ref) = $snmp_db->read_snmp_variables('entropy');
$inherited_entropy = $var_ref->[0] if $var_ref && @$var_ref;
}
# if $db_env is undef the Amavis::Cache::new creates a memory-based cache
# $body_digest_cache = Amavis::Cache->new($db_env, 15+1+40); # SHA-1 (160 b)
$body_digest_cache = Amavis::Cache->new($db_env, 15+1+32); # MD5 (128 b)
if ($extra_code_db) { # is it worth reporting the timing? (probably not)
section_time('bdb-open');
do_log(2, "%s", Amavis::Timing::report()); # report elapsed times
}
# Prepare permanent SQL dataset connection objects, does not connect yet!
# $sql_dataset_conn_lookups and $sql_dataset_conn_storage may be the
# same dataset (one connection used), or they may be separate objects,
# which will make separate connections to (same or distinct) datasets,
# possibly using different SQL engine types or servers
if ($extra_code_sql_lookup && @lookup_sql_dsn) {
$sql_dataset_conn_lookups =
Amavis::Out::SQL::Connection->new(@lookup_sql_dsn);
}
if ($extra_code_sql_log && @storage_sql_dsn) {
if (!$sql_dataset_conn_lookups || @storage_sql_dsn != @lookup_sql_dsn
|| grep { $storage_sql_dsn[$_] ne $lookup_sql_dsn[$_] }
(0..$#storage_sql_dsn) )
{ # DSN differs or no SQL lookups, storage needs its own connection
$sql_dataset_conn_storage =
Amavis::Out::SQL::Connection->new(@storage_sql_dsn);
if ($sql_dataset_conn_lookups) {
do_log(2,"storage and lookups will use separate connections to SQL");
} else {
do_log(5,"only storage connections to SQL, no lookups");
}
} else { # same dataset, use the same database connection object
$sql_dataset_conn_storage = $sql_dataset_conn_lookups;
do_log(2,"storage and lookups will use the same connection to SQL");
}
}
# Make storage/lookup objs to hold DBI handles and 'prepared' statements.
$sql_storage = Amavis::Out::SQL::Log->new($sql_dataset_conn_storage)
if $sql_dataset_conn_storage;
$sql_policy = Amavis::Lookup::SQL->new($sql_dataset_conn_lookups,
'sel_policy') if $sql_dataset_conn_lookups;
$sql_wblist = Amavis::Lookup::SQL->new($sql_dataset_conn_lookups,
'sel_wblist') if $sql_dataset_conn_lookups;
$spamcontrol_obj->init_child if $spamcontrol_obj;
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-2, "TROUBLE in child_init_hook: %s", $eval_stat);
die "Suicide in child_init_hook: $eval_stat\n";
};
add_entropy($$, Time::HiRes::gettimeofday, $inherited_entropy);
Amavis::Timing::go_idle('vir');
}
### user customizable Net::Server hook
sub post_accept_hook {
my($self) = @_;
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered post_accept_hook");
if (!$child_init_hook_was_called) {
# this can happen with base Net::Server (not PreFork nor PreForkSiple)
do_log(5, "post_accept_hook: invoking child_init_hook which was skipped");
$self->child_init_hook;
}
$child_invocation_count++;
$0 = sprintf("amavisd (ch%d-accept)", $child_invocation_count);
Amavis::Timing::go_busy('hi ');
# establish initial time right after 'accept'
Amavis::Timing::init(); snmp_counters_init();
$snmp_db->register_proc(1,1,'A') if defined $snmp_db; # enter 'accept' state
load_policy_bank(''); # start with a builtin baseline policy bank
}
### user customizable Net::Server hook, load a by-interface policy bank;
### if this hook returns 1 the request is processed
### if this hook returns 0 the request is denied
sub allow_deny_hook {
my($self) = @_;
local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server !
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered allow_deny_hook");
my($prop) = $self->{server}; my($sock) = $prop->{client}; my($bank_name);
my($is_ux) = UNIVERSAL::can($sock,'NS_proto') && $sock->NS_proto eq 'UNIX';
if ($is_ux) {
$bank_name = $interface_policy{"SOCK"}; # possibly undef
} else {
my($myif,$myport) = ($prop->{sockaddr}, $prop->{sockport});
if (defined $interface_policy{"$myif:$myport"}) {
$bank_name = $interface_policy{"$myif:$myport"};
} elsif (defined $interface_policy{$myport}) {
$bank_name = $interface_policy{$myport};
}
}
load_policy_bank($bank_name) if defined $bank_name &&
$bank_name ne c('policy_bank_name');
# note that the new policy bank may have replaced the inet_acl access table
if ($is_ux) {
# always permit access - unix sockets are immune to this check
} else {
my($permit,$fullkey,$err) = lookup_ip_acl($prop->{peeraddr},
Amavis::Lookup::Label->new('inet_acl'), ca('inet_acl'));
if (defined($err) && $err ne '') {
do_log(-1, "DENIED ACCESS due to INVALID PEER IP ADDRESS %s: %s",
$prop->{peeraddr}, $err);
return 0;
} elsif (!$permit) {
do_log(-1, "DENIED ACCESS from IP %s, policy bank '%s'%s",
$prop->{peeraddr}, c('policy_bank_name'),
!defined $fullkey ? '' : ", blocked by rule $fullkey");
return 0;
}
}
1;
}
### The heart of the program
### user customizable Net::Server hook
sub process_request {
my($self) = shift;
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered process_request");
local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server !
my($prop) = $self->{server}; my($sock) = $prop->{client};
ll(3) && do_log(3, "process_request: fileno sock=%s, STDIN=%s, STDOUT=%s",
fileno($sock), fileno(STDIN), fileno(STDOUT));
# Net::Server 0.91 dups a socket to STDIN and STDOUT, which we do not want;
# it also forgets to close STDIN & STDOUT afterwards, so session remains
# open (smtp QUIT does not work), fixed in 0.92;
# Net::Server 0.92 introduced option no_client_stdout, but it
# breaks Net::Server::get_client_info by setting it, so we can't use it;
# On NetBSD closing fh STDIN (on fd0) somehow leaves fd0 still assigned to
# a socket (Net::Server 0.91) and cannot be closed even by a POSIX::close
# Let's just leave STDIN and STDOUT as they are, which works for versions
# of Net::Server 0.90 and older, is wasteful with 0.91 and 0.92, and is
# fine with 0.93.
binmode($sock) or die "Can't set socket to binmode: $!";
local $SIG{ALRM} = sub { die "timed out\n" }; # do not modify the sig text!
my($eval_stat);
eval {
# if ($] < 5.006) # Perl older than 5.6.0 did not set FD_CLOEXEC on sockets
# { cloexec($_,1,$_) for @{$prop->{sock}} }
switch_to_my_time('new request'); # timer init
if ($extra_code_ldap && !defined $ldap_policy) {
# make LDAP lookup object
$ldap_connection = Amavis::LDAP::Connection->new($default_ldap);
$ldap_policy = Amavis::Lookup::LDAP->new($default_ldap,$ldap_connection)
if $ldap_connection;
}
if (defined $ldap_policy && !$implicit_maps_inserted) {
# make LDAP field lookup objects with incorporated field names
# fieldtype: B=boolean, N=numeric, S=string, L=list
# B-, N-, S-, L- returns undef if field does not exist
# B0: boolean, nonexistent field treated as false,
# B1: boolean, nonexistent field treated as true
my $lf = sub{Amavis::Lookup::LDAPattr->new($ldap_policy,@_)};
unshift(@Amavis::Conf::virus_lovers_maps, $lf->('amavisVirusLover', 'B-'));
unshift(@Amavis::Conf::spam_lovers_maps, $lf->('amavisSpamLover', 'B-'));
unshift(@Amavis::Conf::banned_files_lovers_maps, $lf->('amavisBannedFilesLover', 'B-'));
unshift(@Amavis::Conf::bad_header_lovers_maps, $lf->('amavisBadHeaderLover', 'B-'));
unshift(@Amavis::Conf::bypass_virus_checks_maps, $lf->('amavisBypassVirusChecks', 'B-'));
unshift(@Amavis::Conf::bypass_spam_checks_maps, $lf->('amavisBypassSpamChecks', 'B-'));
unshift(@Amavis::Conf::bypass_banned_checks_maps,$lf->('amavisBypassBannedChecks', 'B-'));
unshift(@Amavis::Conf::bypass_header_checks_maps,$lf->('amavisBypassHeaderChecks', 'B-'));
unshift(@Amavis::Conf::spam_tag_level_maps, $lf->('amavisSpamTagLevel', 'N-'));
unshift(@Amavis::Conf::spam_tag2_level_maps, $lf->('amavisSpamTag2Level', 'N-'));
unshift(@Amavis::Conf::spam_kill_level_maps, $lf->('amavisSpamKillLevel', 'N-'));
unshift(@Amavis::Conf::spam_dsn_cutoff_level_maps,$lf->('amavisSpamDsnCutoffLevel','N-'));
unshift(@Amavis::Conf::spam_quarantine_cutoff_level_maps,$lf->('amavisSpamQuarantineCutoffLevel','N-'));
unshift(@Amavis::Conf::spam_subject_tag_maps, $lf->('amavisSpamSubjectTag', 'S-'));
unshift(@Amavis::Conf::spam_subject_tag2_maps, $lf->('amavisSpamSubjectTag2', 'S-'));
unshift(@Amavis::Conf::spam_modifies_subj_maps, $lf->('amavisSpamModifiesSubj', 'B-'));
unshift(@Amavis::Conf::message_size_limit_maps, $lf->('amavisMessageSizeLimit', 'N-'));
unshift(@Amavis::Conf::virus_quarantine_to_maps, $lf->('amavisVirusQuarantineTo', 'S-'));
unshift(@Amavis::Conf::banned_quarantine_to_maps, $lf->('amavisBannedQuarantineTo','S-'));
unshift(@Amavis::Conf::spam_quarantine_to_maps, $lf->('amavisSpamQuarantineTo', 'S-'));
unshift(@Amavis::Conf::bad_header_quarantine_to_maps, $lf->('amavisBadHeaderQuarantineTo', 'S-'));
unshift(@Amavis::Conf::clean_quarantine_to_maps, $lf->('amavisCleanQuarantineTo', 'S-'));
unshift(@Amavis::Conf::archive_quarantine_to_maps, $lf->('amavisArchiveQuarantineTo', 'S-'));
unshift(@Amavis::Conf::local_domains_maps, $lf->('amavisLocal', 'B1'));
unshift(@Amavis::Conf::warnvirusrecip_maps, $lf->('amavisWarnVirusRecip', 'B-'));
unshift(@Amavis::Conf::warnbannedrecip_maps, $lf->('amavisWarnBannedRecip', 'B-'));
unshift(@Amavis::Conf::warnbadhrecip_maps, $lf->('amavisWarnBadHeaderRecip', 'B-'));
unshift(@Amavis::Conf::virus_admin_maps, $lf->('amavisVirusAdmin', 'S-'));
unshift(@Amavis::Conf::newvirus_admin_maps, $lf->('amavisNewVirusAdmin', 'S-'));
unshift(@Amavis::Conf::spam_admin_maps, $lf->('amavisSpamAdmin', 'S-'));
unshift(@Amavis::Conf::banned_admin_maps, $lf->('amavisBannedAdmin', 'S-'));
unshift(@Amavis::Conf::bad_header_admin_maps, $lf->('amavisBadHeaderAdmin', 'S-'));
unshift(@Amavis::Conf::banned_filename_maps, $lf->('amavisBannedRuleNames', 'S-'));
# unshift(@Amavis::Conf::disclaimer_options_bysender_maps,
# $lf->('amavisDisclaimerOptions', 'S-'));
section_time('ldap-prepare');
}
if (defined $sql_policy && !$implicit_maps_inserted) {
# make SQL field lookup objects with incorporated field names
# fieldtype: B=boolean, N=numeric, S=string,
# B-, N-, S- returns undef if field does not exist
# B0: boolean, nonexistent field treated as false,
# B1: boolean, nonexistent field treated as true
my $nf = sub{Amavis::Lookup::SQLfield->new($sql_policy,@_)}; #shorthand
$user_id_sql = $nf->('id', 'S');
$user_policy_id_sql = $nf->('policy_id', 'S-');
unshift(@Amavis::Conf::local_domains_maps, $nf->('local', 'B1'));
unshift(@Amavis::Conf::virus_lovers_maps, $nf->('virus_lover', 'B-'));
unshift(@Amavis::Conf::spam_lovers_maps, $nf->('spam_lover', 'B-'));
unshift(@Amavis::Conf::banned_files_lovers_maps, $nf->('banned_files_lover', 'B-'));
unshift(@Amavis::Conf::bad_header_lovers_maps, $nf->('bad_header_lover', 'B-'));
unshift(@Amavis::Conf::bypass_virus_checks_maps, $nf->('bypass_virus_checks', 'B-'));
unshift(@Amavis::Conf::bypass_spam_checks_maps, $nf->('bypass_spam_checks', 'B-'));
unshift(@Amavis::Conf::bypass_banned_checks_maps, $nf->('bypass_banned_checks', 'B-'));
unshift(@Amavis::Conf::bypass_header_checks_maps, $nf->('bypass_header_checks', 'B-'));
unshift(@Amavis::Conf::spam_tag_level_maps, $nf->('spam_tag_level', 'N-'));
unshift(@Amavis::Conf::spam_tag2_level_maps, $nf->('spam_tag2_level', 'N-'));
unshift(@Amavis::Conf::spam_kill_level_maps, $nf->('spam_kill_level', 'N-'));
unshift(@Amavis::Conf::spam_dsn_cutoff_level_maps,$nf->('spam_dsn_cutoff_level','N-'));
unshift(@Amavis::Conf::spam_quarantine_cutoff_level_maps,$nf->('spam_quarantine_cutoff_level','N-'));
unshift(@Amavis::Conf::spam_modifies_subj_maps, $nf->('spam_modifies_subj', 'B-'));
unshift(@Amavis::Conf::spam_subject_tag_maps, $nf->('spam_subject_tag', 'S-'));
unshift(@Amavis::Conf::spam_subject_tag2_maps, $nf->('spam_subject_tag2', 'S-'));
unshift(@Amavis::Conf::virus_quarantine_to_maps, $nf->('virus_quarantine_to', 'S-'));
unshift(@Amavis::Conf::banned_quarantine_to_maps, $nf->('banned_quarantine_to', 'S-'));
unshift(@Amavis::Conf::spam_quarantine_to_maps, $nf->('spam_quarantine_to', 'S-'));
unshift(@Amavis::Conf::bad_header_quarantine_to_maps, $nf->('bad_header_quarantine_to','S-'));
unshift(@Amavis::Conf::clean_quarantine_to_maps, $nf->('clean_quarantine_to', 'S-'));
unshift(@Amavis::Conf::archive_quarantine_to_maps,$nf->('archive_quarantine_to', 'S-'));
unshift(@Amavis::Conf::message_size_limit_maps, $nf->('message_size_limit', 'N-'));
unshift(@Amavis::Conf::addr_extension_virus_maps, $nf->('addr_extension_virus', 'S-'));
unshift(@Amavis::Conf::addr_extension_spam_maps, $nf->('addr_extension_spam', 'S-'));
unshift(@Amavis::Conf::addr_extension_banned_maps,$nf->('addr_extension_banned','S-'));
unshift(@Amavis::Conf::addr_extension_bad_header_maps,$nf->('addr_extension_bad_header','S-'));
unshift(@Amavis::Conf::warnvirusrecip_maps, $nf->('warnvirusrecip', 'B-'));
unshift(@Amavis::Conf::warnbannedrecip_maps, $nf->('warnbannedrecip', 'B-'));
unshift(@Amavis::Conf::warnbadhrecip_maps, $nf->('warnbadhrecip', 'B-'));
unshift(@Amavis::Conf::newvirus_admin_maps, $nf->('newvirus_admin', 'S-'));
unshift(@Amavis::Conf::virus_admin_maps, $nf->('virus_admin', 'S-'));
unshift(@Amavis::Conf::banned_admin_maps, $nf->('banned_admin', 'S-'));
unshift(@Amavis::Conf::bad_header_admin_maps, $nf->('bad_header_admin', 'S-'));
unshift(@Amavis::Conf::spam_admin_maps, $nf->('spam_admin', 'S-'));
unshift(@Amavis::Conf::banned_filename_maps, $nf->('banned_rulenames', 'S-'));
# unshift(@Amavis::Conf::disclaimer_options_bysender_maps,
# $nf->('disclaimer_options', 'S-'));
section_time('sql-prepare');
}
Amavis::Conf::label_default_maps() if !$implicit_maps_inserted;
$implicit_maps_inserted = 1;
my($conn) = Amavis::In::Connection->new; # keeps info about connection
$conn->socket_proto($sock->NS_proto);
my($suggested_protocol) = c('protocol'); # suggested by the policy bank
$suggested_protocol = '' if !defined $suggested_protocol;
ll(5) && do_log(5,"process_request: suggested_protocol=\"%s\" on %s",
$suggested_protocol,$sock->NS_proto);
# $snmp_db->register_proc(2,0,'b') if defined $snmp_db; # begin protocol
my($ns_proto) = $sock->NS_proto;
if ($ns_proto eq 'TCP') {
$conn->socket_ip($prop->{sockaddr});
$conn->socket_port($prop->{sockport});
$conn->client_ip($prop->{peeraddr});
}
if ($suggested_protocol eq 'SMTP' || $suggested_protocol eq 'LMTP' ||
$suggested_protocol eq '' && $ns_proto eq 'TCP') {
if (!$extra_code_in_smtp) {
die "incoming TCP connection, but dynamic SMTP/LMTP code not loaded";
}
$smtp_in_obj = Amavis::In::SMTP->new if !$smtp_in_obj;
$smtp_in_obj->process_smtp_request(
$sock, ($suggested_protocol eq 'LMTP'?1:0), $conn, \&check_mail);
} elsif ($suggested_protocol eq 'AM.PDP') {
# amavis policy delegation protocol (e.g. new milter or amavisd-release)
$amcl_in_obj = Amavis::In::AMCL->new if !$amcl_in_obj;
$amcl_in_obj->process_policy_request($sock, $conn, \&check_mail, 0);
} elsif ($suggested_protocol eq 'COURIER') {
die "unavailable support for protocol: $suggested_protocol";
} elsif ($suggested_protocol eq 'QMQPqq') {
die "unavailable support for protocol: $suggested_protocol";
} elsif ($suggested_protocol eq 'TCP-LOOKUP') { #postfix maps, experimental
process_tcp_lookup_request($sock, $conn);
do_log(2, "%s", Amavis::Timing::report()); # report elapsed times
} elsif ($suggested_protocol eq 'AM.CL' ||
$suggested_protocol eq '' && $ns_proto eq 'UNIX') {
# defaults to old amavis helper program protocol
$amcl_in_obj = Amavis::In::AMCL->new if !$amcl_in_obj;
$amcl_in_obj->process_policy_request($sock, $conn, \&check_mail, 1);
} else {
die "unsupported protocol: $suggested_protocol, $ns_proto";
}
Amavis::Out::SMTP::Session::rundown_stale_sessions(0)
if $extra_code_out_smtp;
1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
alarm(0); # stop the timer
if (defined $eval_stat) {
chomp $eval_stat; my($timed_out) = $eval_stat =~ /^timed out\b/;
if ($timed_out) {
my($msg) = "Requesting process rundown, task exceeded allowed time";
$msg .= " during waiting for input from client" if waiting_for_client();
do_log(-1, $msg);
} else {
do_log(-2, "TROUBLE in process_request: %s", $eval_stat);
$smtp_in_obj->preserve_evidence(1) if $smtp_in_obj;
do_log(-1, "Requesting process rundown after fatal error");
}
undef $smtp_in_obj; undef $amcl_in_obj; undef $courier_in_obj;
$self->done(1);
} elsif ($max_requests > 0 && $child_task_count >= $max_requests) {
# in case of multiple-transaction protocols (e.g. SMTP, LMTP)
# we do not like to keep running indefinitely at the mercy of MTA
my($have_sawampersand)=Devel::SawAmpersand->UNIVERSAL::can("sawampersand");
do_log(2, "Requesting process rundown after %d tasks (and %s sessions)%s",
$child_task_count, $child_invocation_count,
!$have_sawampersand ? '' : Devel::SawAmpersand::sawampersand() ?
", SawAmpersand is TRUE!" : ", SawAmpersand is false");
undef $smtp_in_obj; undef $amcl_in_obj; undef $courier_in_obj;
$self->done(1);
} elsif ($extra_code_antivirus && Amavis::AV::sophos_savi_stale() ) {
do_log(0, "Requesting process rundown due to stale Sophos virus data");
undef $smtp_in_obj; undef $amcl_in_obj; undef $courier_in_obj;
$self->done(1);
}
my(@modules_extra) = grep {!exists $modules_basic{$_}} keys %INC;
# do_log(2, "modules loaded: %s", join(", ", sort keys %modules_basic));
if (@modules_extra) {
do_log(1, "extra modules loaded: %s", join(", ", sort @modules_extra));
%modules_basic = %INC;
}
do_log(5, "exiting process_request");
}
### After processing of a request, but before client connection has been closed
### user customizable Net::Server hook
sub post_process_request_hook {
my($self) = @_;
my($prop) = $self->{server}; my($sock) = $prop->{client};
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered post_process_request_hook");
debug_oneshot(0);
$0 = sprintf("amavisd (ch%d-avail)", $child_invocation_count);
my($remaining_time) = alarm(0);
do_log(5,"post_process_request_hook: %s",
$remaining_time==0 ? "timer was not running" : "timer stopped");
$snmp_db->register_proc(1,0,'') if defined $snmp_db; # alive and idle again
Amavis::Timing::go_idle('bye');
if (ll(3)) {
my($load_report) = Amavis::Timing::report_load();
do_log(3,$load_report) if defined $load_report;
}
# workaround: Net::Server 0.91 forgets to disconnect session
if (Net::Server->VERSION eq '0.91') { close STDIN; close STDOUT }
}
### Child is about to be terminated
### user customizable Net::Server hook
sub child_finish_hook {
my($self) = @_;
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered child_finish_hook");
# for my $m (sort map { s/\.pm\z//; s[/][::]g; $_ } grep {/\.pm\z/} keys %INC){
# do_log(0, "Module %-19s %s", $m, $m->VERSION || '?')
# if grep {$m=~/^$_/} qw(Mail::ClamAV Mail::SpamAssassin Razor2 Net::DNS);
# }
Amavis::Out::SMTP::Session::rundown_stale_sessions(1)
if $extra_code_out_smtp;
$spamcontrol_obj->rundown_child if $spamcontrol_obj;
report_rusage();
$0 = sprintf("amavisd (ch%d-finish)", $child_invocation_count);
do_log(5,"child_finish_hook: invoking DESTROY methods");
undef $smtp_in_obj; undef $amcl_in_obj; undef $courier_in_obj;
undef $sql_storage; undef $sql_wblist; undef $sql_policy; undef $ldap_policy;
undef $sql_dataset_conn_lookups; undef $sql_dataset_conn_storage;
undef $ldap_connection; undef $body_digest_cache;
eval { $snmp_db->register_proc(0,0,undef) } if defined $snmp_db; # unregister
undef $snmp_db; undef $db_env;
}
sub END { # runs before exiting the module
# do_log(5,"at the END handler: invoking DESTROY methods");
undef $smtp_in_obj; undef $amcl_in_obj; undef $courier_in_obj;
undef $sql_storage; undef $sql_wblist; undef $sql_policy; undef $ldap_policy;
undef $sql_dataset_conn_lookups; undef $sql_dataset_conn_storage;
undef $ldap_connection; undef $body_digest_cache;
eval { $snmp_db->register_proc(0,0,undef) } if defined $snmp_db; # unregister
undef $snmp_db; undef $db_env;
}
# implements Postfix TCP lookup server, see tcp_table(5) man page; experimental
sub process_tcp_lookup_request($$) {
my($sock, $conn) = @_;
local($/) = "\012"; # set line terminator to LF (regardless of platform)
my($req_cnt); my($ln);
for ($! = 0; defined($ln=$sock->getline); $! = 0) {
$req_cnt++; my($level) = 0; local($1);
my($resp_code, $resp_msg) = (400, 'INTERNAL ERROR');
if ($ln =~ /^get (.*?)\015?\012\z/si) {
my($key) = tcp_lookup_decode($1);
my($sl); $sl = lookup2(0,$key, ca('spam_lovers_maps'));
$resp_code = 200; $level = 2;
$resp_msg = $sl ? "OK Recipient <$key> IS spam lover"
: "DUNNO Recipient <$key> is NOT spam lover";
} elsif ($ln =~ /^put ([^ ]*) (.*?)\015?\012\z/si) {
$resp_code = 500; $resp_msg = 'request not implemented: ' . $ln;
} else {
$resp_code = 500; $resp_msg = 'illegal request: ' . $ln;
}
do_log($level, "tcp_lookup(%s): %s %s", $req_cnt,$resp_code,$resp_msg);
$sock->printf("%03d %s\012", $resp_code, tcp_lookup_encode($resp_msg))
or die "Can't write to tcp_lookup socket: $!";
}
defined $ln || $!==0 or die "Error reading from socket: $!";
do_log(0, "tcp_lookup: RUNDOWN after %d requests", $req_cnt);
}
sub tcp_lookup_encode($) {
my($str) = @_; local($1);
$str =~ s/([^\041-\044\046-\176])/sprintf("%%%02x",ord($1))/egs;
$str;
}
sub tcp_lookup_decode($) {
my($str) = @_; local($1);
$str =~ s/%([0-9a-fA-F]{2})/pack("C",hex($1))/egs;
$str;
}
sub check_mail_begin_task() {
# The check_mail_begin_task (and check_mail) may be called several times
# per child lifetime and/or per-SMTP session. The variable $child_task_count
# is mainly used by AV-scanner interfaces, e.g. to initialize when invoked
# for the first time during child process lifetime
$child_task_count++;
do_log(4, "check_mail_begin_task: task_count=%d", $child_task_count);
# comment out to retain SQL/LDAP cache entries for the whole child lifetime:
$sql_policy->clear_cache if defined $sql_policy;
$sql_wblist->clear_cache if defined $sql_wblist;
$ldap_policy->clear_cache if defined $ldap_policy;
# reset certain global variables for each task
undef $av_output; @detecting_scanners = ();
@virusname = (); @bad_headers = ();
$banned_filename_any = $banned_filename_all = 0;
undef $MSGINFO; # just in case
}
# Collects some information derived from the envelope and the message,
# do some common lookups, storing the information into a $msginfo object
# to make commonly used information quickly and readily avaliable to the
# rest of the program, e.g. avoiding a need for repeated lookups or parsing
# of the same attribute
#
sub collect_some_info($) {
my($msginfo) = @_;
my($partition_tag) = c('sql_partition_tag');
$partition_tag = &$partition_tag($msginfo) if ref $partition_tag eq 'CODE';
$partition_tag = 0 if !defined $partition_tag;
$msginfo->partition_tag($partition_tag);
# obtain rfc2822 From and Sender from the mail header section, parsed/clean
my($rfc2822_sender) = $msginfo->get_header_field_body('sender');
my($rfc2822_from_field) = $msginfo->get_header_field_body('from');
my(@rfc2822_from); # rfc5322 (ex rfc2822) allows multiple author's addresses
if (defined $rfc2822_sender) {
my(@sender_parsed) = map { unquote_rfc2821_local($_) }
parse_address_list($rfc2822_sender);
$rfc2822_sender = !@sender_parsed ? '' : $sender_parsed[0]; # none or one
$msginfo->rfc2822_sender($rfc2822_sender);
}
if (defined $rfc2822_from_field) {
@rfc2822_from = map { unquote_rfc2821_local($_) }
parse_address_list($rfc2822_from_field);
# rfc2822_from is a ref to a list when there are multiple author addresses!
$msginfo->rfc2822_from(@rfc2822_from < 1 ? undef :
@rfc2822_from < 2 ? $rfc2822_from[0]
: \@rfc2822_from);
}
if (defined $msginfo->get_header_field('to')) {
my($rfc2822_to) = $msginfo->get_header_field_body('to');
my(@to_parsed) = map { unquote_rfc2821_local($_) }
parse_address_list($rfc2822_to);
$msginfo->rfc2822_to(@to_parsed<2 ? $to_parsed[0] : \@to_parsed);
}
if (defined $msginfo->get_header_field('cc')) {
my($rfc2822_cc) = $msginfo->get_header_field_body('cc');
my(@cc_parsed) = map { unquote_rfc2821_local($_) }
parse_address_list($rfc2822_cc);
$msginfo->rfc2822_cc(@cc_parsed<2 ? $cc_parsed[0] : \@cc_parsed);
}
my(@rfc2822_resent_from, @rfc2822_resent_sender);
if (defined $msginfo->get_header_field('resent-from') ||
defined $msginfo->get_header_field('resent-sender')) { # triage
# Each Resent block should have exactly one Resent-From, and none or one
# Resent-Sender address. A HACK: undef in each list is used to separate
# addresses obtained from different resent blocks, for the benefit of
# those interested in traversing them block by block (e.g. when choosing
# a DKIM signing key). The rfc5322 section 3.6.6 says: All of the resent
# fields corresponding to a particular resending of the message SHOULD be
# grouped together.
my(@r_from, @r_sender); local($1);
for (my $j = 0; ; $j++) { # traverse header section by fields, top-down
my($f_i,$f_n,$f) = $msginfo->get_header_field(undef,$j);
if ( @r_from && (
!defined($f) || # end of a header section
$f !~ /^Resent-/si || # presumably end of a resent block
$f =~ /^Resent-From\s*:/si || # another Resent-From encountered
$f =~ /^Resent-Sender\s*:/si && @r_sender # another Resent-Sender
) ) { # ends of a current resent block
# a hack: undef in a list is used to separate addresses
# from different resent blocks
push(@rfc2822_resent_from, undef, @r_from); @r_from = ();
push(@rfc2822_resent_sender, undef, @r_sender); @r_sender = ();
}
last if !defined $f;
if ($f =~ /^Resent-From\s*:(.*)\z/si) {
push(@r_from, map {unquote_rfc2821_local($_)} parse_address_list($1));
} elsif ($f =~ /^Resent-Sender\s*:(.*)\z/si) {
# multiple Resent-Sender in a block are illegal, store them all anyway
push(@r_sender,map {unquote_rfc2821_local($_)} parse_address_list($1));
}
}
if (@r_from || @r_sender) { # any leftovers not forming a resent block?
push(@rfc2822_resent_from, undef, @r_from);
push(@rfc2822_resent_sender, undef, @r_sender);
}
shift(@rfc2822_resent_from) if @rfc2822_resent_from; # remove undef
shift(@rfc2822_resent_sender) if @rfc2822_resent_sender; # remove undef
# rfc2822_resent_from and rfc2822_resent_sender are listrefs (or undef)
$msginfo->rfc2822_resent_from(\@rfc2822_resent_from)
if @rfc2822_resent_from;
$msginfo->rfc2822_resent_sender(\@rfc2822_resent_sender)
if @rfc2822_resent_sender;
}
my($mail_size) = $msginfo->msg_size; # use corrected ESMTP size if avail.
if (!defined($mail_size) || $mail_size <= 0) { # not yet known?
$mail_size = $msginfo->orig_header_size + $msginfo->orig_body_size;
$msginfo->msg_size($mail_size); # store back
do_log(4,"mail size unknown, size set to %d", $mail_size);
}
# check for mailing lists, bulk mail and auto-responses
my($sender) = $msginfo->sender;
my($is_mlist); # mail from a mailing list
my($is_auto); # bounce, auto-response, challenge-reesponse, ...
my($is_bulk); # bulk mail or $is_mlist or $is_auto
if (defined $msginfo->get_header_field('list-id')) { # rfc2919
$is_mlist = $msginfo->get_header_field_body('list-id');
} elsif (defined $msginfo->get_header_field('list-post')) {
$is_mlist = $msginfo->get_header_field_body('list-post');
} elsif (defined $msginfo->get_header_field('list-unsubscribe')) {
$is_mlist = $msginfo->get_header_field_body('list-unsubscribe');
} elsif (defined $msginfo->get_header_field('mailing-list')) {
$is_mlist = $msginfo->get_header_field_body('mailing-list'); # non-std.
} elsif ($sender =~ /^ (?: [^\@]+ -(?:request|bounces|owner|admin) |
owner- [^\@]+ ) (?: \@ | \z )/xsi) {
$is_mlist = 'sender=' . $sender;
} elsif ($rfc2822_from[0] =~ /^ (?: [^\@]+ -(?:request|bounces|owner) |
owner- [^\@]+ ) (?: \@ | \z )/xsi) {
$is_mlist = 'From:' . $rfc2822_from[0];
}
if (defined $is_mlist) { # sanitize a bit
local($1); $is_mlist = $1 if $is_mlist =~ / < (.*) > [^>]* \z/xs;
$is_mlist =~ s/\s+/ /g; $is_mlist =~ s/^ //; $is_mlist =~ s/ \z//;
$is_mlist =~ s/^mailto://i;
$is_mlist = 'ml:' . $is_mlist;
}
if (defined $msginfo->get_header_field('precedence')) {
my($prec) = $msginfo->get_header_field_body('precedence');
$prec =~ s/^[ \t]+//; local($1);
$is_mlist = $1 if !defined($is_mlist) && $prec =~ /^(list)/si;
$is_auto = $1 if $prec =~ /^(auto.?reply)\b/si;
$is_bulk = $1 if $prec =~ /^(bulk|junk)\b/si;
}
if (defined $is_auto) {
# already set
} elsif (defined $msginfo->get_header_field('auto-submitted')) {
my($auto) = $msginfo->get_header_field_body('auto-submitted');
$auto =~ s/ \( [^)]* \) //gx; $auto =~ s/^[ \t]+//; $auto =~ s/[ \t]+\z//;
$is_auto = 'Auto-Submitted:' . $auto if lc($auto) ne 'no';
} elsif ($sender eq '') {
$is_auto = 'sender=<>';
} elsif ($sender =~
/^ (?: mailer-daemon|double-bounce|mailer|autoreply )
(?: \@ | \z )/xsi) {
# 'postmaster' is also common, but a bit risky
$is_auto = 'sender=' . $sender;
} elsif ($rfc2822_from[0] =~ # just checks the first author, good enough
/^ (?: mailer-daemon|double-bounce|mailer|autoreply )
(?: \@ | \z )/xsi) {
$is_auto = 'From:' . $rfc2822_from[0];
}
if (defined $is_mlist) {
$is_bulk = $is_mlist;
} elsif (defined $is_auto) {
$is_bulk = $is_auto;
} elsif (defined $is_bulk) {
# already set
} elsif ($rfc2822_from[0] =~ # just checks the first author, good enough
/^ (?: [^\@]+ -relay | postmaster | uucp ) (?: \@ | \z )/xsi) {
$is_bulk = 'From:' . $rfc2822_from[0];
}
$is_mlist = 1 if defined $is_mlist && !$is_mlist; # make sure it is true
$is_auto = 1 if defined $is_auto && !$is_auto; # make sure it is true
$is_bulk = 1 if defined $is_bulk && !$is_bulk; # make sure it is true
$msginfo->is_mlist($is_mlist) if defined $is_mlist;
$msginfo->is_auto($is_auto) if defined $is_auto;
$msginfo->is_bulk($is_bulk) if defined $is_bulk;
# now that we have a parsed From, check if we have a valid author signature
# and do other DKIM pre-processing
my(@bank_names, %bank_names, %bn_auth_already_queried);
my($atpbm) = ca('author_to_policy_bank_maps');
my(@signatures_valid);
my($sigs_ref) = $msginfo->dkim_signatures_all;
my($sig_ind) = 0; # index of a signature in a signature array
for my $sig (!defined($sigs_ref) ? () : @$sigs_ref) { # for each signature
my($valid) = lc($sig->result) eq 'pass';
my($expiration_time) = $sig->expiration;
my($expired) =
defined $expiration_time && $expiration_time =~ /^\d{1,12}\z/ &&
$msginfo->rx_time > $expiration_time;
my($timestamp_age); my($creation_time);
if (!$sig->isa('Mail::DKIM::DkSignature')) {
$creation_time = $sig->timestamp; # method only implemented for DKIM sig
$timestamp_age = $msginfo->rx_time - $creation_time
if defined $creation_time && $creation_time =~ /^\d{1,12}\z/;
}
local($1,$2);
my($identity) = $sig->identity; # already QP-decoded since 0.32
$identity = $1 . lc($2) if defined $identity &&
$identity =~ /^(.*)(\@[^\@]*)\z/s;
# See if a signature matches address in any of the sender/author fields.
# In the absence of an explicit Sender header field, the first author
# acts as the 'agent responsible for the transmission of the message'.
my(@addr_list) = ($msginfo->sender,
defined $rfc2822_sender ? $rfc2822_sender : $rfc2822_from[0],
@rfc2822_from);
for my $addr (@addr_list) {
$addr = $1 . lc($2) if defined $addr && $addr =~ /^(.*)(\@[^\@]*)\z/s;
}
# turn addresses in @addr_list into booleans, representing a match success
# ADSP+RFC5321: localpart is case sensitive, domain is case insensitive
if ($identity =~ /.\@[^\@]*\z/s) { # identity has a localpart
for (@addr_list) { if (defined) { $_ = $_ eq $identity } }
} else { # ignore localpart if identity doesn't have a localpart
for (@addr_list) {
if (defined) { /(\@[^\@]*)?\z/s; $_ = $1 eq $identity }
}
}
# label which header fields are covered by each signature;
# doesn't work for old DomainKeys signatures where h may be missing
# and where recurring header fields may only be listed once
my(@signed_header_field_names) = map { lc($_) } $sig->headerlist; # 'h' tag
{ my(%field_counts);
$field_counts{$_}++ for @signed_header_field_names;
for (my $j=-1; ; $j--) { # walk through header fields, bottom-up
my($f_ind,$f_name,$fld) = $msginfo->get_header_field(undef,$j);
last if !defined $f_ind; # reached the top
if ($field_counts{$f_name} > 0) { # header field is covered by this sig
$msginfo->header_field_signed_by($f_ind,$sig_ind); # store sig index
$field_counts{$f_name}--;
}
}
}
if ($valid && !$expired) {
push(@signatures_valid, $sig);
my($sig_domain) = $sig->domain;
$sig_domain = '?' if !$sig_domain; # make sure it is true as a boolean
#
# note that only the author signature (based on rfc2822.From) is a valid
# concept in DKIM/ADSP; we are also using the same rules to match against
# rfc2822.Sender and envelope sender address, but results are only of
# informational/curiosity interest and deeper significance must not be
# attributed to dkim_envsender_sig and dkim_sender_sig!
#
$msginfo->dkim_envsender_sig($sig_domain) if $addr_list[0];
$msginfo->dkim_sender_sig($sig_domain) if $addr_list[1];
$msginfo->dkim_author_sig($sig_domain)
if grep { $_ } @addr_list[2..$#addr_list]; # identity matches addr
$msginfo->dkim_thirdparty_sig($sig_domain) if !$msginfo->dkim_author_sig;
if (@$atpbm) { # any author to policy bank name mappings?
for my $j (0..$#rfc2822_from) { # for each author (usually only one)
my($key) = $rfc2822_from[$j];
# query key: as-is author address for author signatures, and
# author address with '/@signer-domain' appended for 3rd party sign.
# e.g.: 'user@example.com', 'user@sub.example.com/@example.org'
for my $opt ( ($addr_list[$j+2] ? '' : ()), '/@'.lc($sig->domain) ) {
next if $bn_auth_already_queried{$key.$opt};
my($result,$matchingkey) = lookup2(0,$key,$atpbm,
Label=>'AuthToPB', $opt eq '' ? () : (AppendStr=>$opt));
$bn_auth_already_queried{$key.$opt} = 1;
if ($result) {
if ($result eq '1') {
# a handy usability trick to supply a hardwired policy bank
# name when acl-style lookup table is used, which can only
# return a boolean (undef, 0, or 1)
$result = 'AUTHOR_APPROVED';
}
# $result is a list of policy banks as a comma-separated string
my(@pbn); # collect list of newly encountered policy bank names
for (map { s/^[ \t]+//; s/[ \t]+\z//; $_ } split(/,/,$result)) {
next if $_ eq '' || $bank_names{$_};
push(@pbn,$_); $bank_names{$_} = 1;
}
if (@pbn) {
push(@bank_names,@pbn);
ll(2) && do_log(2, "dkim: policy bank %s by %s",
join(',',@pbn), $matchingkey);
}
}
}
}
}
}
if (ll(5)) {
my($pubkey);
# Mail::DKIM >=0.31 caches result; it can die with "not available"
eval { $pubkey = $sig->get_public_key };
if (!$pubkey) {
do_log(5, "dkim: no public key s=%s d=%s",$sig->selector,$sig->domain);
} else {
do_log(5, "dkim: public key s=%s d=%s (testing=%d) f=%s n=\"%s\"",
$sig->selector, $sig->domain,
$pubkey->testing, $pubkey->flags, $pubkey->notes);
}
}
ll(2) && do_log(2, "dkim: %s%s%s %s signature by i=%s, From: %s, ".
"a=%s, c=%s, s=%s, d=%s%s%s%s",
$valid ? 'VALID' : 'FAILED', $expired ? ', EXPIRED' : '',
$timestamp_age >= -1 ? ''
: ', IN_FUTURE:('.format_time_interval(-$timestamp_age).')',
join('+', (map { $_ ? 'Author' : () } @addr_list[2..$#addr_list]),
$addr_list[1] ? 'Sender' : (),
$addr_list[0] ? 'MailFrom' : (),
!(grep {$_} @addr_list) ? 'third-party' : ()),
$identity, join(", ", qquote_rfc2821_local(@rfc2822_from)),
$sig->algorithm, scalar($sig->canonicalization),
$sig->selector, $sig->domain,
!$msginfo->originating ? ''
: ', ORIG ['.$msginfo->client_addr.':'.$msginfo->client_port.']',
!defined($msginfo->is_mlist) ? '' : ", m.list(".$msginfo->is_mlist.")",
$valid ? '' : ', '.$sig->result_detail,
);
$sig_ind++;
}
if (@bank_names) {
@bank_names = grep { defined $policy_bank{$_} } unique_list(\@bank_names);
if (@bank_names) {
Amavis::load_policy_bank($_) for @bank_names;
$msginfo->originating(c('originating')); # may have changed
}
}
$msginfo->dkim_signatures_valid(\@signatures_valid) if @signatures_valid;
# if (ll(5) && $sig_ind > 0) {
# # show which header fields are covered by which signature
# for (my $j=0; ; $j++) {
# my($f_ind,$f_name,$fld) = $msginfo->get_header_field(undef,$j);
# last if !defined $f_ind;
# my(@sig_ind) = $msginfo->header_field_signed_by($f_ind);
# do_log(5, "dkim: %-5s %s.", !@sig_ind ? '' : '['.join(',',@sig_ind).']',
# substr($fld,0,54));
# }
# }
if ($sender ne '') { # provide some initial default for sender_credible
my(@cred) = ( $msginfo->originating ? 'orig' : (),
$msginfo->dkim_envsender_sig ? 'dkim' : () );
$msginfo->sender_credible(join(",",@cred)) if @cred;
}
}
# Checks the message stored on a file. File must already
# be open on file handle $msginfo->mail_text; it need not be positioned
# properly, check_mail must not close the file handle.
#
sub check_mail($$$) {
my($conn, $msginfo, $dsn_per_recip_capable) = @_;
my($which_section) = 'check_init'; my(%elapsed,$t0_sect);
$elapsed{'TimeElapsedReceiving'} = Time::HiRes::time - $msginfo->rx_time;
my($point_of_no_return) = 0; # past the point where mail or DSN was sent
my($am_id) = $msginfo->log_id;
if (!defined($am_id)) { $am_id = am_id(); $msginfo->log_id($am_id) }
$snmp_db->register_proc(1,0,'=',$am_id) if defined $snmp_db; # check begins
my($smtp_resp, $exit_code, $preserve_evidence);
my($mail_id, $custom_object);
my($hold); # set to some string causes the message to be placed on hold
# (frozen) by MTA. This can be used in cases when we stumble
# across some permanent problem making us unable to decide
# if the message is to be really delivered.
# is any mail component password protected or otherwise non-decodable?
my($any_undecipherable) = 0;
my($mime_err); # undef, or MIME parsing error string as given by MIME::Parser
if (defined $last_task_completed_at) {
my($dt) = $msginfo->rx_time - $last_task_completed_at;
do_log(3,"smtp connection cache, dt: %.1f, state: %d",
$dt, $smtp_connection_cache_enable);
if (!$smtp_connection_cache_on_demand) {}
elsif (!$smtp_connection_cache_enable && $dt < 5) {
do_log(3,"smtp connection cache, dt: %.1f -> enabling", $dt);
$smtp_connection_cache_enable = 1;
} elsif ($smtp_connection_cache_enable && $dt >= 15) {
do_log(3,"smtp connection cache, dt: %.1f -> disabling", $dt);
$smtp_connection_cache_enable = 0;
}
}
# ugly - save in a global to make it accessible to %builtins
$MSGINFO = $msginfo;
eval {
$msginfo->add_contents_category(CC_CLEAN,0); # CC_CLEAN is always present
$_->add_contents_category(CC_CLEAN,0) for @{$msginfo->per_recip_data};
$msginfo->header_edits(Amavis::Out::EditHeader->new);
add_entropy(Time::HiRes::gettimeofday, $child_task_count, $am_id,
$msginfo->queue_id, $msginfo->mail_text_fn, $msginfo->sender);
section_time($which_section);
$which_section = 'check_init2';
# compute body digest, measure mail size, check for 8-bit data, add entropy
# get_body_digest($msginfo, 'SHA-1');
get_body_digest($msginfo, 'MD5');
$which_section = 'check_init3';
collect_some_info($msginfo);
my($mail_size) = $msginfo->msg_size; # use corrected ESMTP size
if (!defined($msginfo->client_addr)) { # fetch missing address from header
my($ip) = parse_ip_address_from_received($msginfo,1);
do_log(3,"client IP address unknown, fetching from Received: %s", $ip);
$msginfo->client_addr($ip);
}
$which_section = 'check_init4';
my($file_generator_object) = # maxfiles 0 disables the $MAXFILES limit
Amavis::Unpackers::NewFilename->new($MAXFILES?$MAXFILES:undef,$mail_size);
Amavis::Unpackers::Part::init($file_generator_object); # fudge: keep in var
my($parts_root) = Amavis::Unpackers::Part->new;
$msginfo->parts_root($parts_root);
# section_time($which_section);
$which_section = 'gen_mail_id';
$snmp_db->register_proc(2,0,'G',$am_id) if defined $snmp_db; # gen mail_id
# create unique mail_id and save preliminary info. to SQL (if enabled)
for (my($attempt)=5;;) { # sanity limit on retries
my($secret_id);
($mail_id,$secret_id) = generate_mail_id();
$msginfo->secret_id($secret_id); $secret_id = '';
$msginfo->mail_id($mail_id); # assign a long-term unique id to the msg
if (!$sql_storage) {
last; # no need to store and no way to check for uniqueness
} else {
# attempt to save a message placeholder to SQL, ensuring it is unique
$which_section = 'sql-enter';
$sql_storage->save_info_preliminary($conn,$msginfo) and last;
if (--$attempt <= 0) {
do_log(-2,"ERROR sql_storage: too many retries ".
"on storing preliminary, info not saved");
last;
} else {
snmp_count('GenMailIdRetries');
do_log(2,"sql_storage: retrying preliminary, %d attempts remain",
$attempt);
sleep(int(1+rand(3)));
add_entropy(Time::HiRes::gettimeofday,$$,$attempt);
}
}
};
section_time($which_section);
$which_section = "custom-new";
eval {
my($old_orig) = c('originating');
# may load policy banks
$custom_object = Amavis::Custom->new($conn,$msginfo);
my($new_orig) = c('originating'); # may have changed by a p.b.load
$msginfo->originating($new_orig) if ($old_orig?1:0) != ($new_orig?1:0);
1;
} or do {
undef $custom_object;
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"custom new err: %s", $eval_stat);
};
if (ref $custom_object) {
do_log(5,"Custom hooks enabled"); section_time($which_section);
}
my($cl_ip) = $msginfo->client_addr;
my($os_fingerprint_obj,$os_fingerprint);
my($os_fingerprint_method) = c('os_fingerprint_method');
if (!defined($os_fingerprint_method) || $os_fingerprint_method eq '') {
# no fingerprinting service configured
} elsif ($cl_ip eq '' || $cl_ip eq '0.0.0.0' || $cl_ip eq '::') {
# original client IP address not available, can't query p0f
} else { # launch a query
$which_section = "os_fingerprint";
my($dst) = c('os_fingerprint_dst_ip_and_port');
my($dst_ip,$dst_port); local($1,$2,$3);
($dst_ip,$dst_port) = ($1.$2, $3) if defined($dst) &&
$dst =~ m{^(?: \[ ([^\]]*) \] | ([^:]*) ) : ([^:]*) }six;
$os_fingerprint_obj = Amavis::OS_Fingerprint->new(
dynamic_destination($os_fingerprint_method,$conn,0),
0.050, $cl_ip, $msginfo->client_port, $dst_ip, $dst_port, $mail_id);
}
my($sender) = $msginfo->sender;
my(@recips) = map { $_->recip_addr } @{$msginfo->per_recip_data};
my($rfc2822_sender) = $msginfo->rfc2822_sender;
my($fm) = $msginfo->rfc2822_from;
my(@rfc2822_from) = !defined($fm) ? () : ref $fm ? @$fm : $fm;
$mail_size = $msginfo->msg_size; # refresh after custom hook, just in case
add_entropy("$cl_ip $mail_size $sender", \@recips);
if (ll(1)) {
my($pbn) = c('policy_bank_path');
do_log(1,"Checking: %s %s%s%s -> %s", $mail_id,
$pbn eq '' ? '' : "$pbn ", $cl_ip eq '' ? '' : "[$cl_ip] ",
qquote_rfc2821_local($sender),
join(',', qquote_rfc2821_local(@recips)) );
}
if (ll(3)) {
my($envsender) = qquote_rfc2821_local($sender);
my($hdrsender) = qquote_rfc2821_local($rfc2822_sender),
my($hdrfrom) = qquote_rfc2821_local(@rfc2822_from);
do_log(3,"2822.From: %s%s%s", $hdrfrom,
!defined($rfc2822_sender) ? '' : ", 2822.Sender: $hdrsender",
defined $rfc2822_sender && $envsender eq $hdrsender ? ''
: $envsender eq $hdrfrom ? '' : ", 2821.Mail_From: $envsender");
}
my($cnt_local) = 0; my($cnt_remote) = 0;
for my $r (@{$msginfo->per_recip_data}) {
my($recip) = $r->recip_addr;
my($is_local) = lookup2(0,$recip, ca('local_domains_maps'));
$is_local ? $cnt_local++ : $cnt_remote++;
$r->recip_is_local($is_local);
if (!defined($r->bypass_virus_checks)) {
my($bypassed_v) = lookup2(0,$recip, ca('bypass_virus_checks_maps'));
$r->bypass_virus_checks($bypassed_v);
}
if (!defined($r->bypass_banned_checks)) {
my($bypassed_b) = lookup2(0,$recip, ca('bypass_banned_checks_maps'));
$r->bypass_banned_checks($bypassed_b);
}
if (!defined($r->bypass_spam_checks)) {
my($bypassed_s) = lookup2(0,$recip, ca('bypass_spam_checks_maps'));
$r->bypass_spam_checks($bypassed_s);
}
# if (defined $user_id_sql) { #(for future version)
# my($user_id_ref,$mk_ref) = # list of all id's that match
# lookup2(1, $recip, [$user_id_sql], Label=>"users.id");
# $r->user_id($user_id_ref) if ref $user_id_ref; # listref or undef
# }
# if (defined $user_policy_id_sql) {
# my($user_policy_id) = lookup2(0, $recip, [$user_policy_id_sql],
# Label=>"users.policy_id");
# $r->user_policy_id($user_policy_id); # just the first match
# }
}
# update message count and mesage size snmp counters
# orig local
# 0 0 InMsgsOpenRelay
# 0 1 InMsgsInbound
# 0 x (non-originating: inbound or open relay)
# 1 0 InMsgsOutbound
# 1 1 InMsgsInternal
# 1 x InMsgsOriginating (outbound or internal)
# x 0 (departing: outbound or open relay)
# x 1 (local: inbound or internal)
# x x InMsgs
snmp_count('InMsgs');
snmp_count('InMsgsBounceNullRPath') if $sender eq '';
snmp_count( ['InMsgsRecips', $cnt_local+$cnt_remote]); # recipients count
snmp_count( ['InMsgsSize', $mail_size, 'C64'] );
if ($msginfo->originating) {
snmp_count('InMsgsOriginating');
snmp_count( ['InMsgsRecipsOriginating', $cnt_local+$cnt_remote]);
snmp_count( ['InMsgsSizeOriginating', $mail_size, 'C64'] );
}
if ($cnt_local > 0) {
my($d) = $msginfo->originating ? 'Internal' : 'Inbound';
snmp_count('InMsgs'.$d);
snmp_count( ['InMsgsRecips'.$d, $cnt_local]);
snmp_count( ['InMsgsRecipsLocal', $cnt_local]);
snmp_count( ['InMsgsSize'.$d, $mail_size, 'C64'] );
}
if ($cnt_remote > 0) {
my($d) = $msginfo->originating ? 'Outbound' : 'OpenRelay';
snmp_count('InMsgs'.$d);
snmp_count( ['InMsgsRecips'.$d, $cnt_remote]);
snmp_count( ['InMsgsSize'.$d, $mail_size, 'C64'] );
if (!$msginfo->originating) {
do_log(1,'Open relay? Nonlocal recips but not originating: %s',
join(', ',map { $_->recip_addr } grep { !$_->recip_is_local }
@{$msginfo->per_recip_data}));
}
}
# mkdir can be a costly operation (must be atomic, flushes buffers).
# If we can re-use directory 'parts' from the previous invocation it saves
# us precious time. Together with matching rmdir this can amount to 10-15 %
# of total elapsed time! (no spam checking, depending on file system)
$which_section = "creating_partsdir";
{ my($tempdir) = $msginfo->mail_tempdir;
my($errn) = lstat("$tempdir/parts") ? 0 : 0+$!;
if ($errn == ENOENT) { # needs to be created
mkdir("$tempdir/parts", 0750)
or die "Can't create directory $tempdir/parts: $!";
section_time('mkdir parts'); }
elsif ($errn != 0) { die "$tempdir/parts is not accessible: $!" }
elsif (!-d _) { die "$tempdir/parts is not a directory" }
else {} # fine, directory already exists and is accessible
chdir($tempdir) or die "Can't chdir to $tempdir: $!";
}
# FIRST: what kind of e-mail did we get? call content scanners
my($virus_presence_checked,$spam_presence_checked);
my($virus_dejavu) = 0;
# already in cache?
$which_section = "cached";
snmp_count('CacheAttempts');
my($cache_entry); my($now) = Time::HiRes::time;
my($cache_entry_ttl) =
max($virus_check_negative_ttl, $virus_check_positive_ttl,
$spam_check_negative_ttl, $spam_check_positive_ttl);
my($now_utc_iso8601) = iso8601_utc_timestamp($now,1);
my($expires_utc_iso8601) = iso8601_utc_timestamp($now+$cache_entry_ttl,1);
my($body_digest) = $msginfo->body_digest;
$cache_entry = $body_digest_cache->get($body_digest)
if $body_digest_cache && defined $body_digest;
if (!defined $cache_entry) {
snmp_count('CacheMisses');
$cache_entry->{'ctime'} = $now_utc_iso8601; # create a new cache record
} else {
snmp_count('CacheHits');
$virus_presence_checked = defined $cache_entry->{'VN'} ? 1 : 0;
# spam level and spam report may be influenced by a mail header section
# too, not only by a mail body, so caching based on body is only a close
# approximation; ignore spam cache if body is too small
$spam_presence_checked = defined $cache_entry->{'SL'} ? 1 : 0;
if ($msginfo->orig_body_size < 200) { $spam_presence_checked = 0 }
if ($virus_presence_checked && defined $cache_entry->{'Vt'}) {
# check for expiration of cached virus test results
my($ttl) = !@{$cache_entry->{'VN'}} ? $virus_check_negative_ttl
: $virus_check_positive_ttl;
if ($now > $cache_entry->{'Vt'} + $ttl) {
do_log(2,"Cached virus check expired, TTL = %d s", $ttl);
$virus_presence_checked = 0;
}
}
if ($spam_presence_checked && defined $cache_entry->{'St'}) {
# check for expiration of cached spam test results
# (note: hard-wired spam level 6)
my($ttl) = $cache_entry->{'SL'} < 6 ? $spam_check_negative_ttl
: $spam_check_positive_ttl;
if ($now > $cache_entry->{'St'} + $ttl) {
do_log(2,"Cached spam check expired, TTL = %d s", $ttl);
$spam_presence_checked = 0;
}
}
if ($virus_presence_checked) {
$av_output = $cache_entry->{'VO'};
@virusname = @{$cache_entry->{'VN'}};
@detecting_scanners = @{$cache_entry->{'VD'}};
$virus_dejavu = 1;
}
if ($spam_presence_checked) {
# my($spam_level,$spam_status,$spam_report,$spam_summary) =
# @$cache_entry{'SL','SS','SR','SY'};
my($spam_level,$spam_status,$spam_report,$spam_summary,
$crm114_status,$crm114_cacheid) =
@$cache_entry{'SL','SS','SR','SY','SCT','SCI'};
$msginfo->spam_level($spam_level);
$msginfo->spam_status($spam_status);
$msginfo->spam_report($spam_report);
$msginfo->spam_summary($spam_summary);
$msginfo->supplementary_info('CRM114STATUS',
$crm114_status) if defined $crm114_status;
$msginfo->supplementary_info('CRM114CACHEID',
$crm114_cacheid) if defined $crm114_cacheid;
}
do_log(1,"cached %s from <%s> (%s,%s)", $body_digest, $sender,
$virus_presence_checked, $spam_presence_checked);
snmp_count('CacheHitsVirusCheck') if $virus_presence_checked;
snmp_count('CacheHitsVirusMsgs') if @virusname;
snmp_count('CacheHitsSpamCheck') if $spam_presence_checked;
snmp_count('CacheHitsSpamMsgs') if $msginfo->spam_level >= 5; # a hack
ll(5) && do_log(5,"cache entry age: %s c=%s a=%s",
(@virusname ? 'V' : $msginfo->spam_level >= 5 ? 'S' : '.'),
$cache_entry->{'ctime'}, $cache_entry->{'atime'} );
} # end if defined $cache_entry
my($will_do_virus_scanning, $all_bypass_virus_checks);
if ($extra_code_antivirus) {
$all_bypass_virus_checks =
!grep {!$_->bypass_virus_checks} @{$msginfo->per_recip_data};
$will_do_virus_scanning =
!$virus_presence_checked && !$all_bypass_virus_checks;
}
my($will_do_banned_checking) = # banned name checking will be needed?
@{ca('banned_filename_maps')} || cr('banned_namepath_re');
my($bounce_header_fields_ref,$bounce_msgid,$bounce_type);
if (c('bypass_decode_parts')) {
do_log(5, "decoding bypassed");
} elsif (!$will_do_virus_scanning && !$will_do_banned_checking &&
c('bounce_killer_score') <= 0) {
do_log(5, "decoding not needed");
} else {
# decoding parts can take a lot of time
$which_section = "mime_decode-1";
$snmp_db->register_proc(2,0,'D',$am_id) if defined $snmp_db; # decoding
$t0_sect = Time::HiRes::time;
$mime_err = ensure_mime_entity($msginfo)
if !defined($msginfo->mime_entity);
prolong_timer($which_section);
if (c('bounce_killer_score') > 0) {
$which_section = "dsn_parse";
# analyze a bounce after MIME decoding but before further archive
# decoding (which often replaces original MIME parts by decoded files)
eval { # just in case
($bounce_header_fields_ref,$bounce_type) =
inspect_a_bounce_message($msginfo);
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1, "inspect_a_bounce_message failed: %s", $eval_stat);
};
$bounce_msgid = $bounce_header_fields_ref->{'message-id'}
if $bounce_header_fields_ref &&
exists $bounce_header_fields_ref->{'message-id'};
prolong_timer($which_section);
}
$which_section = "parts_decode_ext";
snmp_count('OpsDec');
($hold,$any_undecipherable) =
Amavis::Unpackers::decompose_mail($msginfo->mail_tempdir,
$file_generator_object);
if ($hold ne '' || $any_undecipherable) {
$msginfo->add_contents_category(CC_UNCHECKED,0);
for my $r (@{$msginfo->per_recip_data}) {
$r->add_contents_category(CC_UNCHECKED,0)
if !$r->bypass_virus_checks;
}
}
$elapsed{'TimeElapsedDecoding'} = Time::HiRes::time - $t0_sect;
}
my($bphcm) = ca('bypass_header_checks_maps');
if (grep {!lookup2(0,$_->recip_addr,$bphcm)} @{$msginfo->per_recip_data}) {
$which_section = "check_header";
my($allowed_tests) = cr('allowed_header_tests');
my($allowed_mime_test) = $allowed_tests && $allowed_tests->{'mime'};
# check for bad headers and for bad MIME subheaders / bad MIME structure
if ($allowed_mime_test && defined $mime_err && $mime_err ne '') {
push(@bad_headers, "MIME error: ".$mime_err);
$msginfo->add_contents_category(CC_BADH,1);
}
my($badh_ref,$minor_badh_cc) = check_header_validity($conn,$msginfo);
if (@$badh_ref) {
push(@bad_headers, @$badh_ref);
$msginfo->add_contents_category(CC_BADH,$minor_badh_cc);
}
for my $r (@{$msginfo->per_recip_data}) {
my($bypassed) = lookup2(0,$r->recip_addr,$bphcm);
if (!$bypassed && $allowed_mime_test &&
defined $mime_err && $mime_err ne '')
{ $r->add_contents_category(CC_BADH,1) } # CC_BADH min: 1=broken mime
if (!$bypassed && @$badh_ref)
{ $r->add_contents_category(CC_BADH,$minor_badh_cc) }
}
section_time($which_section);
}
if ($will_do_banned_checking) { # check for banned file contents
$which_section = "check-banned";
check_for_banned_names($msginfo); # saves results in $msginfo
$banned_filename_any = 0; $banned_filename_all = 1;
for my $r (@{$msginfo->per_recip_data}) {
next if $r->bypass_banned_checks;
my($a) = $r->banned_parts;
if (!defined $a || !@$a) {
$banned_filename_all = 0;
} else {
my($rhs) = $r->banning_rule_rhs;
if (defined $rhs) {
for my $j (0..$#{$a}) {
$r->dsn_suppress_reason(sprintf("BANNED:%s suggested by rule",
$rhs->[$j])) if $rhs->[$j] =~ /^DISCARD/;
}
}
$banned_filename_any = 1;
$r->add_contents_category(CC_BANNED,0);
}
}
$msginfo->add_contents_category(CC_BANNED,0) if $banned_filename_any;
ll(4) && do_log(4,"banned check: any=%d, all=%s (%d)",
$banned_filename_any, $banned_filename_all?'Y':'N',
scalar(@{$msginfo->per_recip_data}));
}
if ($virus_presence_checked) {
do_log(5, "virus_presence cached, skipping virus_scan");
} elsif (!$extra_code_antivirus) {
do_log(5, "no anti-virus code loaded, skipping virus_scan");
} elsif ($all_bypass_virus_checks) {
do_log(5, "bypassing of virus checks requested");
} elsif (defined $hold && $hold ne '') { # protect virus scanner from bombs
do_log(0, "NOTICE: Virus scanning skipped: %s", $hold);
$will_do_virus_scanning = 0;
} else {
if (!$will_do_virus_scanning)
{ do_log(-1, "NOTICE: will_do_virus_scanning is false???") }
$mime_err = ensure_mime_entity($msginfo)
if !defined($msginfo->mime_entity) && !c('bypass_decode_parts');
# special case to make available a complete mail file for inspection
if ((defined($mime_err) && $mime_err ne '') ||
!defined($msginfo->mime_entity) ||
lookup2(0,'MAIL',\@keep_decoded_original_maps) ||
$any_undecipherable && lookup2(0,'MAIL-UNDECIPHERABLE',
\@keep_decoded_original_maps)) {
# keep the email.txt by making a hard link to it in ./parts/
$which_section = "linking-to-MAIL";
my($tempdir) = $msginfo->mail_tempdir;
my($newpart_obj) =
Amavis::Unpackers::Part->new("$tempdir/parts",$parts_root,1);
my($newpart) = $newpart_obj->full_name;
do_log(3, "presenting full original message to scanners as %s%s%s",
$newpart,
!$any_undecipherable ? '' :", $any_undecipherable undecipherable",
$mime_err eq '' ? '' : ", MIME error: $mime_err");
link($msginfo->mail_text_fn, $newpart)
or die sprintf("Can't create hard link %s to %s: %s",
$newpart, $msginfo->mail_text_fn, $!);
$newpart_obj->type_short('MAIL'); # case sensitive
$newpart_obj->type_declared('message/rfc822');
}
$which_section = "virus_scan";
$snmp_db->register_proc(2,0,'V',$am_id) if defined $snmp_db; # virus scan
my($av_ret); $t0_sect = Time::HiRes::time;
eval {
my($vn, $ds);
($av_ret, $av_output, $vn, $ds) =
Amavis::AV::virus_scan($conn,$msginfo, $child_task_count==1);
@virusname = @$vn; @detecting_scanners = @$ds; # copy
1;
} or do {
$@ = "errno=$!" if $@ eq ''; chomp $@;
if ($@ =~ /^timed out\b/) { # not supposed to happen
@virusname = (); $av_ret = 0; # assume not a virus!
do_log(-1, "virus_scan TIMED OUT, ASSUME NOT A VIRUS !!!");
} else {
$hold = "AV: $@"; # request HOLD
$av_ret = 0; # pretend it was ok (msg should be held)
die "$hold\n"; # die, TEMPFAIL is preferred to HOLD
}
};
$elapsed{'TimeElapsedVirusCheck'} = Time::HiRes::time - $t0_sect;
snmp_count('OpsVirusCheck');
defined($av_ret) or die "All virus scanners failed!";
@$cache_entry{'Vt','VO','VN','VD'} =
(int($now), $av_output, \@virusname, \@detecting_scanners);
if (defined($msginfo->spam_level)) { #also spam results if provided by av
@$cache_entry{'St','SL','SS','SR','SY'} =
(int($now), $msginfo->spam_level, $msginfo->spam_status,
$msginfo->spam_report, $msginfo->spam_summary);
}
$virus_presence_checked = 1;
if (defined $snmp_db && @virusname) {
$which_section = "read_snmp_variables";
$virus_dejavu = 1
if !grep {!defined($_) || $_ == 0} # none with counter zero or undef
@{$snmp_db->read_snmp_variables(map {"virus.byname.$_"} @virusname)};
section_time($which_section);
}
}
$which_section = "post_virus_scan";
if ($virus_presence_checked) {
for my $r (@{$msginfo->per_recip_data}) {
my($bypassed) = $r->bypass_virus_checks;
$r->infected($bypassed ? undef : @virusname ? 1 : 0);
$r->add_contents_category(CC_VIRUS,0) if !$bypassed && @virusname;
}
}
$msginfo->add_contents_category(CC_VIRUS,0) if @virusname;
$msginfo->virusnames([@virusname]) if @virusname; # copy names to object
{ my($sender_contact,$sender_source);
if (!@virusname) { $sender_contact = $sender_source = $sender }
else {
($sender_contact,$sender_source) = best_try_originator($msginfo);
section_time('best_try_originator');
}
$msginfo->sender_contact($sender_contact); # save it
$msginfo->sender_source($sender_source); # save it
}
if (defined($os_fingerprint_obj)) {
$which_section = "fingerprint_collect";
$os_fingerprint = $os_fingerprint_obj->collect_response;
if (defined $os_fingerprint && $os_fingerprint ne '') {
# if (c('policy_bank_path') =~ m{(^|/)MYNETS(/|\z)})
# if ($msginfo->client_addr_mynets)
if ($msginfo->originating)
{ $os_fingerprint = 'MYNETWORKS' } # blank-out our smtp clients info
$msginfo->client_os_fingerprint($os_fingerprint); # store info
}
}
chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!";
my($bypass_spam_checks_by_bounce_killer) = 0;
if (!$bounce_header_fields_ref) {
# not a bounce
} elsif ($msginfo->originating) {
# rescued by originating
} elsif (defined($bounce_msgid) && $bounce_msgid =~ /(\@[^\@>]+)>?\z/ &&
lookup2(0,$1, ca('local_domains_maps'))) {
# rescued by a local domain in referenced Message-ID
} elsif (c('bounce_killer_score') > 20) {
$bypass_spam_checks_by_bounce_killer = 1;
}
# consider doing spam scanning
if (!$extra_code_antispam) {
do_log(5, "no anti-spam code loaded, skipping spam_scan");
} elsif ($bypass_spam_checks_by_bounce_killer) {
do_log(5, "bypassing of spam checks by a bounce killer");
} elsif (!grep {!$_->bypass_spam_checks} @{$msginfo->per_recip_data}) {
do_log(5, "bypassing of spam checks requested for all recips");
} else {
# preliminary test - would a message be allowed to pass for any recipient
# based on evidence collected so far (virus, banned)
my($any_pass) = 0; my($prelim_blocking_ccat);
for my $r (@{$msginfo->per_recip_data}) {
my($final_destiny) = D_PASS;
my(@fd_tuples) = $r->setting_by_main_contents_category_all(
cr('final_destiny_by_ccat'), cr('lovers_maps_by_ccat'));
for my $tuple (@fd_tuples) {
my($cc, $fd, $lovers_map_ref) = @$tuple;
if (!defined($fd) || $fd == D_PASS) {
} elsif (defined($lovers_map_ref) &&
lookup2(0, $r->recip_addr, $lovers_map_ref,
Label=>'Lovers1')) {
} else {
$prelim_blocking_ccat = $cc; $final_destiny = $fd;
last;
}
}
$any_pass = 1 if $final_destiny == D_PASS;
}
if (!$any_pass) {
do_log(5, "bypassing of spam checks, message will be blocked anyway ".
"due to %s", $prelim_blocking_ccat);
} else {
$which_section = "spam-wb-list";
my($any_wbl, $all_wbl) = Amavis::SpamControl::white_black_list(
$conn, $msginfo, $sql_wblist, $user_id_sql, $ldap_policy);
section_time($which_section);
if ($all_wbl) {
do_log(5, "sender white/blacklisted, skipping spam_scan");
} elsif ($spam_presence_checked) {
do_log(5, "spam_presence cached, skipping spam_scan");
} else {
$which_section = "spam_scan";
$snmp_db->register_proc(2,0,'S',$am_id) if defined $snmp_db;
$t0_sect = Time::HiRes::time;
# sets $msginfo->spam_level, spam_status,
# spam_report, spam_summary, supplementary_info
$spamcontrol_obj->spam_scan($conn,$msginfo) if $spamcontrol_obj;
prolong_timer($which_section);
$elapsed{'TimeElapsedSpamCheck'} = Time::HiRes::time - $t0_sect;
snmp_count('OpsSpamCheck');
@$cache_entry{'St','SL','SS','SR','SY','SCT','SCI'} =
(int($now), $msginfo->spam_level, $msginfo->spam_status,
$msginfo->spam_report, $msginfo->spam_summary,
$msginfo->supplementary_info('CRM114STATUS'),
$msginfo->supplementary_info('CRM114CACHEID'));
$spam_presence_checked = 1;
}
}
}
if (ref $custom_object) {
$which_section = "custom-checks";
eval {
$custom_object->checks($conn,$msginfo); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"custom checks error: %s", $eval_stat);
};
section_time($which_section);
}
# store to cache
$which_section = 'update_cache';
$cache_entry->{'atime'} = $now_utc_iso8601; # update accessed timestamp
$body_digest_cache->set($body_digest,$cache_entry,
$now_utc_iso8601,$expires_utc_iso8601)
if $body_digest_cache && defined $body_digest;
$cache_entry = undef; # discard the object, it is no longer needed
section_time($which_section);
snmp_count("virus.byname.$_") for @virusname;
my(@sa_tests,%sa_tests);
{ my($tests) = $msginfo->supplementary_info('TESTS');
if (defined($tests) && $tests ne 'none') {
@sa_tests = $tests =~ /([^=,;]+)(?==)/g;
%sa_tests = map { ($_,1) } @sa_tests;
}
}
# SECOND: now that we know what we got, decide what to do with it
$which_section = 'after_scanning';
Amavis::DKIM::adjust_score_by_signer_reputation($msginfo)
if $enable_dkim_verification;
$which_section = "penpals_check";
my($pp_age);
my($spam_level) = $msginfo->spam_level;
if (defined $sql_storage && !$msginfo->is_in_contents_category(CC_VIRUS)) {
my($pp_bonus) = c('penpals_bonus_score'); # score points
my($pp_halflife) = c('penpals_halflife'); # seconds
my(@boost_list);
@boost_list = map {$_->recip_score_boost} @{$msginfo->per_recip_data}
if $pp_bonus > 0 && $pp_halflife > 0 &&
(defined $penpals_threshold_low || defined $penpals_threshold_high);
if ($pp_bonus <= 0 || $pp_halflife <= 0) {
# penpals disabled
} elsif (defined($penpals_threshold_low) && !defined($bounce_msgid) &&
$spam_level + max(@boost_list) < $penpals_threshold_low) {
# low score for all recipients, no need for aid
do_log(5,"penpals: low score, no need for penpals aid");
} elsif (defined($penpals_threshold_high) && !defined($bounce_msgid) &&
$spam_level + min(@boost_list) - $pp_bonus
> $penpals_threshold_high) {
# spam, can't get below threshold_high even under best circumstances
do_log(5,"penpals: high score, penpals won't help");
} elsif ($sender ne '' && !$msginfo->originating &&
lookup2(0,$sender, ca('local_domains_maps'))) {
# no bonus to unauthent. senders from outside claiming a local domain
do_log(5,"penpals: local sender from outside, ignored: %s", $sender);
} else {
$t0_sect = Time::HiRes::time;
$snmp_db->register_proc(2,0,'P',$am_id) if defined $snmp_db; # penpals
my($sid) = $msginfo->sender_maddr_id;
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; # already dealt with
my($recip) = $r->recip_addr;
my($rid) = $r->recip_maddr_id;
if (defined($rid) && $sid ne $rid && $r->recip_is_local) {
# inbound or internal_to_internal, except self_to_self
my($refs_str) = $msginfo->get_header_field_body('in-reply-to') .
$msginfo->get_header_field_body('references');
my(@refs) = $refs_str eq '' ? () : parse_message_id($refs_str);
push(@refs,$bounce_msgid) if defined $bounce_msgid &&
$bounce_msgid ne '';
do_log(4,"penpals: references: %s", join(", ",@refs)) if @refs;
# NOTE: swap $rid and $sid as args here, as we are now checking
# for a potential reply mail - whether the current recipient has
# recently sent any mail to the sender of the current mail:
my($pp_mail_id,$pp_subj);
($pp_age,$pp_mail_id,$pp_subj) =
$sql_storage->penpals_find($rid,$sid,\@refs,$msginfo->rx_time);
if (defined $pp_age) { # found info about previous correspondence
$r->recip_penpals_age($pp_age); # save the information
my($weight) = exp(-($pp_age/$pp_halflife) * log(2));
# weight is a factor between 1 and 0, representing
# exponential decay: weight(t) = 1 / 2^(t/halflife)
# i.e. factors 1, 1/2, 1/4, 1/8... at age 0, hl, 2*hl, 3*hl...
my($boost) = $r->recip_score_boost;
my($adj) = $weight * $pp_bonus; $boost -= $adj;
$r->recip_score_boost($boost); # save adjusted result to object
$r->recip_penpals_score(-$adj);
if (ll(2)) {
do_log(2,"penpals: bonus %.3f, age %s (%d), ".
"SA score %.3f, <%s> replying to <%s>, ref mail_id: %s",
$adj, format_time_interval($pp_age), $pp_age,
$spam_level, $sender,$recip, $pp_mail_id);
my($this_subj) = $msginfo->get_header_field_body('subject');
$this_subj = $1 if $this_subj =~ /^\s*(.*?)\s*$/;
do_log(2,"penpals: prev Subject: %s", $pp_subj);
do_log(2,"penpals: this Subject: %s", $this_subj);
}
}
}
}
section_time($which_section);
$elapsed{'TimeElapsedPenPals'} = Time::HiRes::time - $t0_sect;
}
}
$which_section = "bounce_killer";
if ($bounce_header_fields_ref) { # message looks like a DSN
snmp_count('InMsgsBounce');
my($bounce_rescued);
if (defined $pp_age && $pp_age < 8*24*3600) { # less than 8 days ago
# found by pen pals by a Message-ID in attachment and recip. address;
# is a bounce, refers to our previous outgoing message, treat it kindly
snmp_count('InMsgsBounceRescuedByPenPals');
$bounce_rescued = 'by penpals';
} elsif ($msginfo->originating) {
snmp_count('InMsgsBounceRescuedByOriginating');
$bounce_rescued = 'by originating';
} elsif (defined($bounce_msgid) && $bounce_msgid =~ /(\@[^\@>]+)>?\z/ &&
lookup2(0,$1, ca('local_domains_maps'))) {
# not in pen pals, but domain in Message-ID is a local domain;
# it is only useful until spamers figure out the trick,
# then it should be disabled
snmp_count('InMsgsBounceRescuedByDomain');
$bounce_rescued = 'by domain';
} elsif (!defined($sql_storage) ||
c('penpals_bonus_score') <= 0 || c('penpals_halflife') <= 0) {
$bounce_rescued = 'by: pen pals disabled';
}
ll(2) && do_log(2, "bounce %s (%s), %s -> %s, %s",
defined $bounce_rescued ?'rescued '.$bounce_rescued :'killed',
$bounce_type, qquote_rfc2821_local($sender),
join(',', qquote_rfc2821_local(@recips)),
join(', ', map { $_ . ': ' . $bounce_header_fields_ref->{$_} }
sort( grep { /^(?:From|Return-Path|Message-ID|Date)\z/i }
keys %$bounce_header_fields_ref)) );
if (!$bounce_rescued) {
snmp_count('InMsgsBounceKilled');
my($bounce_killer_score) = c('bounce_killer_score');
for my $r (@{$msginfo->per_recip_data}) {
my($boost) = $r->recip_score_boost || 0;
$r->recip_score_boost($boost + $bounce_killer_score);
}
}
} elsif ($msginfo->is_auto ||
$sender =~ /^postmaster(?:\@|\z)/si ||
$rfc2822_from[0] =~ /^postmaster(?:\@|\z)/si ||
$sa_tests{'ANY_BOUNCE_MESSAGE'} ) {
# message could be some kind of non-standard bounce or autoresponse, but
# lacks recognizable structure and a header section from original mail
ll(2) && do_log(2, "bounce unverifiable%s, %s -> %s",
!$msginfo->originating ? '' : ', originating',
qquote_rfc2821_local($sender),
join(',', qquote_rfc2821_local(@recips)));
snmp_count('InMsgsBounce'); snmp_count('InMsgsBounceUnverifiable');
}
$which_section = "decide_mail_destiny";
$snmp_db->register_proc(2,0,'r',$am_id) if defined $snmp_db; # results...
my($considered_oversize_by_some_recips);
my($mslm) = ca('message_size_limit_maps');
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; # already dealt with
my($recip) = $r->recip_addr;
# consider adding CC_SPAM or CC_SPAMMY to the contents_category list;
# spaminess is an individual matter, we must compare spam level
# with each recipient setting, there is no single global criterium
my($tag_level,$tag2_level,$tag3_level,$kill_level);
my($bypassed) = $r->bypass_spam_checks;
if (!$bypassed) {
$tag_level = lookup2(0,$recip, ca('spam_tag_level_maps'));
$tag2_level = lookup2(0,$recip, ca('spam_tag2_level_maps'));
$tag3_level = lookup2(0,$recip, ca('spam_tag3_level_maps'));
$kill_level = lookup2(0,$recip, ca('spam_kill_level_maps'));
}
my($blacklisted) = $r->recip_blacklisted_sender;
my($whitelisted) = $r->recip_whitelisted_sender;
my($boost) = $r->recip_score_boost;
$boost = 0 if !defined $boost; # avoid uninitialized value warning
# penpals_score is already accounted for in recip_score_boost,
# it is provided here separately for informational/logging purposes
my($penpals_score) = $r->recip_penpals_score; # is zero or negative!
my($do_tag) = !$bypassed && (
$blacklisted || !defined $tag_level || $tag_level eq '' ||
($spam_level+$boost + ($whitelisted?-10:0) >= $tag_level));
my($do_tag2,$do_tag3,$do_kill) =
map { !$bypassed && !$whitelisted &&
($blacklisted || (defined($_) && $spam_level+$boost >= $_) ) }
($tag2_level,$tag3_level,$kill_level);
$do_tag2 = $do_tag2 || $do_tag3; # tag3 implies tag2, just in case
if ($do_tag) { # spaminess is at or above tag level
$msginfo->add_contents_category(CC_CLEAN,1);
$r->add_contents_category(CC_CLEAN,1) if !$bypassed;
}
if ($do_tag2) { # spaminess is at or above tag2 level
$msginfo->add_contents_category(CC_SPAMMY);
$r->add_contents_category(CC_SPAMMY) if !$bypassed;
}
if ($do_tag3) { # spaminess is at or above tag3 level
$msginfo->add_contents_category(CC_SPAMMY,1);
$r->add_contents_category(CC_SPAMMY,1) if !$bypassed;
}
if ($do_kill) { # spaminess is at or above kill level
$msginfo->add_contents_category(CC_SPAM,0);
$r->add_contents_category(CC_SPAM,0) if !$bypassed;
}
# consider adding CC_OVERSIZED to the contents_category list;
if (@$mslm) { # checking of mail size is needed?
my($size_limit) = lookup2(0,$r->recip_addr,$mslm);
if ($enforce_smtpd_message_size_limit_64kb_min &&
$size_limit && $size_limit < 65536)
{ $size_limit = 65536 } # rfc2821 requires at least 64k
if ($size_limit && $mail_size > $size_limit) {
do_log(1,"OVERSIZED from %s to %s: size %s B, limit %s B",
$msginfo->sender_smtp, $r->recip_addr_smtp,
$mail_size, $size_limit)
if !$considered_oversize_by_some_recips;
$considered_oversize_by_some_recips = 1;
$r->add_contents_category(CC_OVERSIZED,0);
$msginfo->add_contents_category(CC_OVERSIZED,0);
}
}
# determine true reason for blocking,considering lovers and final_destiny
my($blocking_ccat); my($final_destiny) = D_PASS; my($to_be_mangled);
my(@fd_tuples) = $r->setting_by_main_contents_category_all(
cr('final_destiny_by_ccat'), cr('lovers_maps_by_ccat'),
cr('defang_maps_by_ccat') );
for my $tuple (@fd_tuples) {
my($cc, $fd, $lovers_map_ref, $mangle_map_ref) = @$tuple;
if (!defined($fd) || $fd == D_PASS) {
do_log(5, "final_destiny (ccat=%s) is PASS, recip %s", $cc,$recip);
} elsif (defined($lovers_map_ref) &&
lookup2(0,$recip,$lovers_map_ref, Label=>'Lovers2')) {
do_log(5, "contents lover (ccat=%s) %s", $cc,$recip);
} elsif ($fd == D_BOUNCE &&
($sender eq '' || defined($msginfo->is_bulk)) &&
ccat_maj($cc) == CC_BADH) {
# have mercy on bad header section in mail from mailing lists and
# in DSN: since a bounce for such mail will be suppressed, it is
# probably better to just let a mail with a bad header section pass,
# it is rather innocent
my($is_bulk) = $msginfo->is_bulk;
do_log(1, "allow bad header section from %s<%s> -> <%s>: %s",
!defined($is_bulk) ? '' : "($is_bulk) ",
$sender, $recip, $bad_headers[0]);
} else {
$blocking_ccat = $cc; $final_destiny = $fd;
my($cc_main) = $r->contents_category;
$cc_main = $cc_main->[0] if $cc_main;
if ($blocking_ccat eq $cc_main) {
do_log(3, "blocking contents category is (%s) for %s",
$blocking_ccat,$recip);
} else {
do_log(3, "blocking ccat (%s) differs from ccat_maj=%s, %s",
$blocking_ccat,$cc_main,$recip);
}
last; # first blocking wins, also skips turning on mangling
}
# topmost mangling reason wins
if (!defined($to_be_mangled) && defined($mangle_map_ref)) {
my($mangle_type) =
!ref($mangle_map_ref) ? $mangle_map_ref # compatibility
: lookup2(0,$recip,$mangle_map_ref, Label=>'Mangling1');
$to_be_mangled = $mangle_type if $mangle_type ne '';
}
}
$r->recip_destiny($final_destiny);
if (defined $blocking_ccat) { # save a blocking contents category
$r->blocking_ccat($blocking_ccat);
# summarize per-recipient blocking_ccat to a message level
my($msg_bl_ccat) = $msginfo->blocking_ccat;
if (!defined($msg_bl_ccat) || cmp_ccat($blocking_ccat,$msg_bl_ccat)>0)
{ $msginfo->blocking_ccat($blocking_ccat) }
} else { # defanging/mangling only has effect on passed mail
# defang_all serves mostly for testing purposes and compatibility
$to_be_mangled = 1 if !$to_be_mangled && c('defang_all');
if ($to_be_mangled) {
my($orig_to_be_mangled) = $to_be_mangled;
if ($to_be_mangled =~ /^(?:disclaimer|nulldisclaimer)\z/i) {
# disclaimers can only go to mail originating from internal
# networks - the 'allow_disclaimers' should (only) be enabled
# by an appropriate policy bank, e.g. MYNETS and/or ORIGINATING
if (!c('allow_disclaimers')) {
$to_be_mangled = 0; # not for remote or unauthorized clients
} else {
my($rf) = $msginfo->rfc2822_resent_from;
my($rs) = $msginfo->rfc2822_resent_sender;
# disclaimers should only go to mail with 2822.From or
# 2822.Sender or 2822.Resent-From or 2822.Resent-Sender
# or 2821.mail_from address matching local domains
if (!grep { defined($_) && $_ ne '' &&
lookup2(0,$_, ca('local_domains_maps')) }
unique_list( (!$rf ? () : @$rf), (!$rs ? () : @$rs),
@rfc2822_from, $rfc2822_sender, $sender)) {
$to_be_mangled = 0; # not for foreign 'Sender:' or 'From:'
do_log(5,"will not add disclaimer, originator not local");
}
}
} else { # defanging (not disclaiming)
# defanging and other mail mangling/munging only applies to
# incoming mail, i.e. for recipients matching local_domains_maps
$to_be_mangled = 0 if !$r->recip_is_local;
}
# store a boolean or a mangling name (defang, disclaimer, ...)
$r->mail_body_mangle($to_be_mangled) if $to_be_mangled;
ll(2) && do_log(2, "mangling %s: %s (orig: %s), ".
"discl_allowed=%d, <%s> -> <%s>", $to_be_mangled ? 'YES' : 'NO',
$to_be_mangled, $orig_to_be_mangled, c('allow_disclaimers'),
$sender, $recip);
}
}
if ($penpals_score < 0) {
# only for logging and statistics purposes
my($do_tag2_nopp,$do_tag3_nopp,$do_kill_nopp) =
map { !$whitelisted &&
($blacklisted ||
(defined($_) && $spam_level+$boost-$penpals_score >= $_) ) }
($tag2_level,$tag3_level,$kill_level);
$do_tag2_nopp = $do_tag2_nopp || $do_tag3_nopp;
my($which) = $do_kill_nopp && !$do_kill ? 'kill'
: $do_tag3_nopp && !$do_tag3 ? 'tag3'
: $do_tag2_nopp && !$do_tag2 ? 'tag2' : '';
if ($which ne '') {
snmp_count("PenPalsSavedFrom\u$which") if $final_destiny==D_PASS;
do_log(2, "PenPalsSavedFrom%s %.3f%.3f%s, <%s> -> <%s>", "\u$which",
$spam_level+$boost-$penpals_score, $penpals_score,
($final_destiny==D_PASS ? '' : ', but mail still blocked'),
$sender, $recip);
}
}
if ($final_destiny == D_PASS) {
# recipient wants this message, malicious or not
do_log(5, "final_destiny PASS, recip %s", $recip);
} else { # recipient does not want this content
# supply RFC 3463 enhanced status codes
my($status) = setting_by_given_contents_category(
$blocking_ccat,
{ CC_VIRUS, "554 5.7.0",
CC_BANNED, "554 5.7.0",
CC_UNCHECKED, "554 5.7.0",
CC_SPAM, "554 5.7.0",
CC_SPAMMY, "554 5.7.0",
CC_BADH.",2", "554 5.6.3", # nonencoded 8-bit character
CC_BADH, "554 5.6.0",
CC_OVERSIZED, "552 5.3.4",
CC_CATCHALL, "554 5.7.0",
});
$final_destiny!=D_PASS or die "Assert failed: $final_destiny==pass";
if ($final_destiny == D_DISCARD) {
local($1,$2);
$status =~ s{^5(\d\d) 5(\.\d\.\d)\z}{250 2$2}; # 5xx -> 250
}
# get the custom smtp response reason text
my($smtp_reason) = setting_by_given_contents_category(
$blocking_ccat, cr('smtp_reason_by_ccat'));
$smtp_reason = '' if !defined $smtp_reason;
if ($smtp_reason ne '') {
my(%mybuiltins) = %builtins; # make a local copy
$smtp_reason = expand(\$smtp_reason, \%mybuiltins);
$smtp_reason = !ref($smtp_reason) ? '' : $$smtp_reason;
chomp($smtp_reason); $smtp_reason = sanitize_str($smtp_reason,1);
$smtp_reason = substr($smtp_reason,0,100) . "..."
if length($smtp_reason) > 100+3;
}
my($response) = sprintf("%s %s%s", $status,
($final_destiny == D_PASS ? "Ok" :
$final_destiny == D_DISCARD ? "Ok, discarded" : "Reject"),
$smtp_reason eq '' ? '' : ', '.$smtp_reason);
ll(4) && do_log(4, "blocking ccat=%s, SMTP response: %s",
$blocking_ccat,$response);
$r->recip_smtp_response($response);
$r->recip_done(1); # fake a delivery (confirm delivery to a bit bucket)
# note that 5xx status rejects may later be converted to bounces
}
}
section_time($which_section);
$which_section = "quar+notif"; $t0_sect = Time::HiRes::time;
$snmp_db->register_proc(2,0,'Q',$am_id) if defined $snmp_db; # notify, quar
do_notify_and_quarantine($conn, $msginfo, $virus_dejavu);
# $which_section = "aux_quarantine";
# do_quarantine($conn, $msginfo, undef,
# ['archive-files'], 'local:archive/%m');
# do_quarantine($conn, $msginfo, undef,
# ['archive@localhost'], 'local:all-%m');
# do_quarantine($conn, $msginfo, undef,
# ['sender-quarantine'], 'local:user-%m'
# ) if lookup(0,$sender, ['user1@domain','user2@domain']);
# section_time($which_section);
$elapsed{'TimeElapsedQuarantineAndNotify'} = Time::HiRes::time - $t0_sect;
if (defined $hold && $hold ne '')
{ do_log(-1, "NOTICE: HOLD reason: %s", $hold) }
# THIRD: now that we know what to do with it, do it! (deliver or bounce)
{ # update Content*Msgs* counters
my($ccat_name) =
$msginfo->setting_by_contents_category(\%ccat_display_names_major);
my($counter_name) = 'Content'.$ccat_name.'Msgs';
snmp_count($counter_name);
if ($msginfo->originating) {
snmp_count($counter_name.'Originating');
}
if ($cnt_local > 0) {
my($d) = $msginfo->originating ? 'Internal' : 'Inbound';
snmp_count($counter_name.$d);
}
if ($cnt_remote > 0) {
my($d) = $msginfo->originating ? 'Outbound' : 'OpenRelay';
snmp_count($counter_name.$d);
}
}
if (ref $custom_object) {
$which_section = "custom-before_send";
eval {
$custom_object->before_send($conn,$msginfo); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"custom before_send error: %s", $eval_stat);
};
section_time($which_section);
}
my($bcc)= $msginfo->setting_by_contents_category(cr('always_bcc_by_ccat'));
if (defined $bcc && $bcc ne '') {
my($recip_obj) = Amavis::In::Message::PerRecip->new;
# leave recip_addr and recip_addr_smtp undefined!
$recip_obj->recip_addr_modified($bcc);
$recip_obj->recip_destiny(D_PASS);
$recip_obj->dsn_notify(['NEVER']);
$recip_obj->contents_category($msginfo->contents_category);
# $recip_obj->contents_category(CC_CLEAN);
$msginfo->per_recip_data([@{$msginfo->per_recip_data}, $recip_obj]);
do_log(2,"adding recipient - always_bcc: %s", $bcc);
}
my($hdr_edits) = $msginfo->header_edits;
if ($msginfo->delivery_method eq '') { # AM.PDP or AM.CL (milter)
$which_section = "AM.PDP headers";
$hdr_edits = add_forwarding_header_edits_common(
$conn, $msginfo, $hdr_edits, $hold, $any_undecipherable,
$virus_presence_checked, $spam_presence_checked);
my($done_all);
my($recip_cl); # ref to a list of similar recip objects
($hdr_edits, $recip_cl, $done_all) =
add_forwarding_header_edits_per_recip(
$conn, $msginfo, $hdr_edits, $hold, $any_undecipherable,
$virus_presence_checked, $spam_presence_checked, undef);
if ($enable_dkim_signing) { # add DKIM signatures
for my $signature (Amavis::DKIM::dkim_make_signatures($msginfo,0)) {
my($s) = $signature->as_string;
local($1); $s =~ s{\015\012}{\n}gs; $s =~ s{\n+\z}{}gs;
$s =~ s/^((?:DKIM|DomainKey)-Signature):[ \t]*//si;
$hdr_edits->prepend_header($1, $s, 2);
}
}
$msginfo->header_edits($hdr_edits); # store edits (redundant)
if (@$recip_cl && !$done_all) {
do_log(-1, "AM.PDP: CLIENTS REQUIRE DIFFERENT HEADERS");
};
} elsif (grep { !$_->recip_done } @{$msginfo->per_recip_data}) { # forward
# To be delivered explicitly - only to those recipients not yet marked
# as 'done' by the above content filtering sections.
$which_section = "forwarding"; $t0_sect = Time::HiRes::time;
$snmp_db->register_proc(2,0,'F',$am_id) if defined $snmp_db; # forwardng
$hdr_edits = add_forwarding_header_edits_common(
$conn, $msginfo, $hdr_edits, $hold, $any_undecipherable,
$virus_presence_checked, $spam_presence_checked);
for (;;) { # do the delivery, in batches if necessary
my($r_hdr_edits) = Amavis::Out::EditHeader->new; # per-recip edits set
$r_hdr_edits->inherit_header_edits($hdr_edits);
my($done_all);
my($recip_cl); # ref to a list of recip objects needing same mail edits
# prepare header section edits, clusterize
($r_hdr_edits, $recip_cl, $done_all) =
add_forwarding_header_edits_per_recip(
$conn, $msginfo, $r_hdr_edits, $hold, $any_undecipherable,
$virus_presence_checked, $spam_presence_checked, undef);
last if !@$recip_cl;
$msginfo->header_edits($r_hdr_edits); # store edits for this batch
# preserve information that may be changed by prepare_modified_mail()
my($m_t,$m_tfn) = ($msginfo->mail_text, $msginfo->mail_text_fn);
my($m_dm) = $msginfo->delivery_method;
# mail body mangling/defanging/sanitizing
my($body_modified) = prepare_modified_mail($conn,$msginfo,
$hold,$any_undecipherable,$recip_cl);
# defanged_mime_entity have modifed header edits, refetch just in case
$r_hdr_edits = $msginfo->header_edits;
if ($body_modified) {
my($resend_m) = c('resend_method');
do_log(3, "mail body mangling in effect, %s", $resend_m);
$msginfo->delivery_method($resend_m) if $resend_m ne '';
}
mail_dispatch($conn, $msginfo, 0, $dsn_per_recip_capable,
sub { my($r) = @_; grep { $_ eq $r } @$recip_cl });
$point_of_no_return = 1; # now past the point where mail was sent
# close and delete replacement file, if any
my($tmp_fh) = $msginfo->mail_text; # replacement file, to be removed
if ($tmp_fh && !$tmp_fh->isa('MIME::Entity') && $tmp_fh ne $m_t) {
$tmp_fh->close or do_log(-1,"Can't close replacement: %s", $!);
if (debug_oneshot()) {
do_log(5, "defanging+debug, preserving %s",$msginfo->mail_text_fn);
} else {
unlink($msginfo->mail_text_fn)
or do_log(-1,"Can't remove %s: %s", $msginfo->mail_text_fn, $!);
}
}
# restore temporarily modified settings
$msginfo->mail_text($m_t); $msginfo->mail_text_fn($m_tfn);
$msginfo->delivery_method($m_dm);
last if $done_all;
}
# turn on CC_MTA in case of MTA trouble (e.g, rejected by MTA on fwding)
for my $r (@{$msginfo->per_recip_data}) {
my($smtp_resp) = $r->recip_smtp_response;
# skip successful deliveries and non- MTA-generated status codes
next if $smtp_resp =~ /^2/ || $r->recip_done != 2;
my($min_ccat) = $smtp_resp =~ /^5/ ? 2 : $smtp_resp =~ /^4/ ? 1 : 0;
$r->add_contents_category(CC_MTA,$min_ccat);
$msginfo->add_contents_category(CC_MTA,$min_ccat);
my($blocking_ccat) = sprintf("%d,%d", CC_MTA,$min_ccat);
$r->blocking_ccat($blocking_ccat) if !defined($r->blocking_ccat);
$msginfo->blocking_ccat($blocking_ccat)
if !defined($msginfo->blocking_ccat);
}
$msginfo->header_edits($hdr_edits); # restore original edits just in case
$elapsed{'TimeElapsedForwarding'} = Time::HiRes::time - $t0_sect;
}
prolong_timer($which_section);
if (ref $custom_object) {
$which_section = "custom-after_send";
eval {
$custom_object->after_send($conn,$msginfo); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"custom after_send error: %s", $eval_stat);
};
section_time($which_section);
}
$which_section = "delivery-notification"; $t0_sect = Time::HiRes::time;
# generate a delivery status notification according to rfc3462 & rfc3464
my($notification,$suppressed) = delivery_status_notification(
$conn, $msginfo, $dsn_per_recip_capable, \%builtins,
[$sender], 'dsn', undef, undef);
my($ndn_needed);
($smtp_resp, $exit_code, $ndn_needed) =
one_response_for_all($msginfo, $dsn_per_recip_capable,
$suppressed && !defined($notification) );
do_log(4, "notif=%s, suppressed=%d, ndn_needed=%s, exit=%s, %s",
defined $notification ? 'Y' : 'N', $suppressed,
$ndn_needed, $exit_code, $smtp_resp);
section_time('prepare-dsn');
if ($suppressed && !defined($notification)) {
$msginfo->dsn_sent(2); # would-be-bounced, but bounce was suppressed
} elsif (defined $notification) { # dsn needed, send delivery notification
mail_dispatch($conn, $notification, 'Dsn', 0);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($notification, 0); # check status
if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { # dsn successful?
$msginfo->dsn_sent(1); # mark the message as bounced
$point_of_no_return = 2; # now past the point where DSN was sent
} elsif ($n_smtp_resp =~ /^4/) {
die sprintf("temporarily unable to send DSN to <%s>: %s",
$msginfo->sender, $n_smtp_resp);
} else {
do_log(-1,"NOTICE: UNABLE TO SEND DSN to <%s>: %s",
$sender, $n_smtp_resp);
# # if dsn cannot be sent, try to send it to postmaster
# $notification->recips(['postmaster']);
# # attempt double bounce
# mail_dispatch($conn, $notification, 'Notif', 0);
}
# $notification->purge;
}
{ my($which_counter) = 'Unknown';
if ($smtp_resp =~ /^4/) { $which_counter = 'TempFailed' }
elsif ($smtp_resp =~ /^5/) { $which_counter = 'Rejected' }
elsif ($smtp_resp =~ /^2/) {
if (!grep { $_->recip_destiny != D_DISCARD }
@{$msginfo->per_recip_data}) { # all D_DISCARD
$which_counter = 'Discarded';
} elsif ($msginfo->dsn_sent) {
$which_counter = $msginfo->dsn_sent==1 ? 'Bounced' : 'NoBounce';
} else {
$which_counter = $msginfo->delivery_method eq ''
? 'Accepted' : 'Relayed';
}
}
snmp_count('InMsgsStatus'.$which_counter) if defined $which_counter;
}
prolong_timer($which_section);
$elapsed{'TimeElapsedDSN'} = Time::HiRes::time - $t0_sect;
# generate customized log report at log level 0 - this is usually the
# only log entry interesting to administrators during normal operation
$which_section = 'main_log_entry';
my(%mybuiltins) = %builtins; # make a local copy
{ # do a per-message log entry
# macro %T has overloaded semantics, ugly
$mybuiltins{'T'} = $mybuiltins{'TESTSSCORES'};
my($y,$n,$f) = delivery_short_report($msginfo);
@mybuiltins{'D','O','N'} = ($y,$n,$f);
my($ll) = 0; # log level for the main log entry
# $ll = 1 if !@$n; # tame down the log level if all passed
if (ll($ll)) {
my($strr) = expand(cr('log_templ'), \%mybuiltins);
for my $logline (split(/[ \t]*\n/, $$strr)) {
do_log($ll, "%s", $logline) if $logline ne '';
}
}
}
# if (@virusname || $spam_level > 10) {
# use IO::Socket::UNIX;
# my($socketname) = '/var/tmp/some-socket';
# my($sock);
# $sock = IO::Socket::UNIX->new(Type => SOCK_STREAM)
# or die "Can't create UNIX socket: $!";
# if (!$sock->connect(pack_sockaddr_un($socketname))) {
# do_log(0, "Can't connect to UNIX socket %s: %s", $socketname, $!);
# } else {
# my($sr) = expand(\'-envelope="%s", -first="%e" -last="%a"',
if (c('log_recip_templ') ne '') { my($j) = 0;
for my $r (@{$msginfo->per_recip_data}) {
$j++; $mybuiltins{'.'} = sprintf("%d",$j);
my($recip) = $r->recip_addr;
my($qrecip_addr) = scalar(qquote_rfc2821_local($recip));
my($remote_mta) = $r->recip_remote_mta;
my($smtp_resp) = $r->recip_smtp_response;
$mybuiltins{'remote_mta'} = $remote_mta;
$mybuiltins{'smtp_response'} = $smtp_resp;
$mybuiltins{'remote_mta_smtp_response'} =
$r->recip_remote_mta_smtp_response;
$mybuiltins{'D'} = $mybuiltins{'O'} = $mybuiltins{'N'} = undef;
if ($r->recip_destiny==D_PASS &&($smtp_resp=~/^2/ || !$r->recip_done)){
$mybuiltins{'D'} = $qrecip_addr;
} else {
$mybuiltins{'O'} = $qrecip_addr;
$mybuiltins{'N'} = sprintf("%s:%s\n %s", $qrecip_addr,
($remote_mta eq '' ?'' :" [$remote_mta] said:"), $smtp_resp);
}
my(@b); @b = @{$r->banned_parts} if defined $r->banned_parts;
my($b_chopped) = @b > 2; @b = (@b[0,1],'...') if $b_chopped;
s/[ \t]{6,}/ ... /g for @b;
$mybuiltins{'banned_parts'} = \@b; $mybuiltins{'F'} = $r->banning_reason_short; $mybuiltins{'banning_rule_comment'} =
!defined($r->banning_rule_comment) ? undef
: unique_ref($r->banning_rule_comment);
$mybuiltins{'banning_rule_rhs'} =
!defined($r->banning_rule_rhs) ? undef
: unique_ref($r->banning_rule_rhs);
my($dn) = $r->dsn_notify;
$mybuiltins{'dsn_notify'} =
uc(join(',', $sender eq '' ? 'NEVER' : !$dn ? 'FAILURE' : @$dn));
my($boost) = $r->recip_score_boost;
$mybuiltins{'score_boost'} = 0+sprintf("%.3f",0+$boost);
my($tag_level,$tag2_level,$kill_level);
if (!$r->bypass_spam_checks) {
$tag_level = lookup2(0,$recip, ca('spam_tag_level_maps'));
$tag2_level = lookup2(0,$recip, ca('spam_tag2_level_maps'));
$kill_level = lookup2(0,$recip, ca('spam_kill_level_maps'));
}
my($is_local) = $r->recip_is_local;
my($do_tag) = $r->is_in_contents_category(CC_CLEAN,1);
my($do_tag2) = $r->is_in_contents_category(CC_SPAMMY);
my($do_kill) = $r->is_in_contents_category(CC_SPAM);
for ($do_tag,$do_tag2,$do_kill) { $_ = $_ ? 'Y' : '0' } for ($is_local) { $_ = $_ ? 'L' : '0' } for ($tag_level,$tag2_level,$kill_level) { $_ = 'x' if !defined($_) }
$mybuiltins{'R'} = $recip;
$mybuiltins{'c'} = $mybuiltins{'SCORE'} = $mybuiltins{'STARS'} =
sub { macro_score($msginfo, $j-1, @_) }; $mybuiltins{'T'} = $mybuiltins{'TESTSSCORES'} = $mybuiltins{'TESTS'} =
sub { macro_tests($msginfo, $j-1, @_)}; $mybuiltins{'tag_level'} = !defined($tag_level) ? '-' : 0+sprintf("%.3f",$tag_level);
$mybuiltins{'tag2_level'} = $mybuiltins{'REQD'} = !defined($tag2_level) ? '-' : 0+sprintf("%.3f",$tag2_level);
$mybuiltins{'kill_level'} = !defined($kill_level) ? '-' : 0+sprintf("%.3f",$kill_level);
@mybuiltins{('0','1','2','k')} = ($is_local,$do_tag,$do_tag2,$do_kill);
@mybuiltins{('3','4','5')} = ($tag_level,$tag2_level,$kill_level);
$mybuiltins{'ccat'} =
sub {
my($name,$attr,$which) = @_;
$attr = lc($attr); $which = lc($which); my($result) = ''; my($blocking_ccat) = $r->blocking_ccat;
if ($attr eq 'is_blocking') {
$result = defined($blocking_ccat) ? 1 : '';
} elsif ($attr eq 'is_nonblocking') {
$result = !defined($blocking_ccat) ? 1 : '';
} elsif ($attr eq 'is_blocked_by_nonmain') {
if (defined($blocking_ccat)) {
my($aref) = $r->contents_category;
$result = 1 if ref($aref) && @$aref > 0
&& $blocking_ccat ne $aref->[0];
}
} elsif ($attr eq 'name') {
$result =
$which eq 'main' ?
$r->setting_by_main_contents_category(\%ccat_display_names)
: $which eq 'blocking' ?
$r->setting_by_blocking_contents_category(
\%ccat_display_names)
: $r->setting_by_contents_category( \%ccat_display_names);
} else { my($maj,$min) = ccat_split(
($which eq 'blocking' ||
$which ne 'main' && defined $blocking_ccat)
? $blocking_ccat : $r->contents_category);
$result = $attr eq 'major' ? $maj
: $attr eq 'minor' ? sprintf("%d",$min)
: sprintf("(%d,%d)",$maj,$min);
}
$result;
};
my($strr) = expand(cr('log_recip_templ'), \%mybuiltins);
for my $logline (split(/[ \t]*\n/, $$strr)) {
do_log(0, "%s", $logline) if $logline ne '';
}
}
}
section_time($which_section);
prolong_timer($which_section);
if (defined $os_fingerprint) { my($spam_ham_level) = 2.0; local($1); my($os_short); $os_short = $1 if $os_fingerprint =~ /^([^,([]*)/;
$os_short = $1 if $os_short =~ /^[ \t,-]*(.*?)[ \t,-]*\z/;
if ($os_short ne '') {
$os_short = $1 if $os_short =~ /^(Windows [^ ]+|[^ ]+)/; $os_short =~ s{[^0-9A-Za-z:./_+-]}{-}g; $os_short =~ s{\.}{,}g;
my($snmp_counter_name) = $msginfo->setting_by_contents_category(
{ CC_VIRUS,'virus', CC_BANNED,'banned',
CC_SPAM,'spam', CC_SPAMMY,'spammy', CC_CATCHALL,'clean' });
if ($snmp_counter_name eq 'clean')
{ $snmp_counter_name = $spam_level<=$spam_ham_level ? 'ham' : undef }
if (defined $snmp_counter_name) {
snmp_count("$snmp_counter_name.byOS.$os_short");
do_log(3, 'Ham from Windows XP? Most weird! %s [%s] score=%.3f',
$mail_id, $cl_ip, $spam_level)
if $snmp_counter_name eq 'ham' &&
$os_fingerprint =~ /^Windows XP(?![^(]*\b2000 SP)/;
}
}
}
if ($sql_storage) { $which_section = 'sql-update';
my($ds) = $msginfo->dsn_sent;
$ds = !$ds ? 'N' : $ds==1 ? 'Y' : $ds==2 ? 'q' : '?';
for (my($attempt)=5; $attempt>0; ) { if ($sql_storage->save_info_final($conn,$msginfo,$ds)) {
last;
} elsif (--$attempt <= 0) {
do_log(-2,"ERROR sql_storage: too many retries ".
"on storing final, info not saved");
} else {
do_log(2,"sql_storage: retrying on final, %d attempts remain",
$attempt);
sleep(int(1+rand(3))); }
};
section_time($which_section);
}
if (ll(2)) { my($sa_tim) = $msginfo->supplementary_info('TIMING');
do_log(2, "TIMING-SA %s", $sa_tim) if defined($sa_tim) && $sa_tim ne '';
}
if (defined $snmp_db) {
$which_section = 'update_snmp';
my($log_lines, $log_entries_by_level_ref,
$log_retries, $log_status_counts_ref) = collect_log_stats();
snmp_count( ['LogLines', $log_lines, 'C64'] );
my($log_entries_all_cnt) = 0;
for my $level_str (keys %$log_entries_by_level_ref) {
my($level) = 0+$level_str;
my($cnt) = $log_entries_by_level_ref->{$level_str};
$log_entries_all_cnt += $cnt;
snmp_count( ['LogEntriesCrit', $cnt, 'C64'] ) if $level <= -3;
snmp_count( ['LogEntriesErr', $cnt, 'C64'] ) if $level <= -2;
snmp_count( ['LogEntriesWarning', $cnt, 'C64'] ) if $level <= -1;
snmp_count( ['LogEntriesNotice', $cnt, 'C64'] ) if $level <= 0;
snmp_count( ['LogEntriesInfo', $cnt, 'C64'] ) if $level <= 1;
snmp_count( ['LogEntriesDebug', $cnt, 'C64'] );
if ($level < 0) { $level_str = "0" }
elsif ($level > 5) { $level_str = "5" }
snmp_count( ['LogEntriesLevel'.$level_str, $cnt, 'C64'] );
}
snmp_count( ['LogEntries', $log_entries_all_cnt, 'C64'] );
if ($log_retries > 0) {
snmp_count( ['LogRetries', $log_retries] );
do_log(3,"Syslog retries: %d x %s", $log_status_counts_ref->{$_}, $_)
for (keys %$log_status_counts_ref);
}
$elapsed{'TimeElapsedSending'} += delete $elapsed{$_} for ('TimeElapsedQuarantineAndNotify',
'TimeElapsedForwarding', 'TimeElapsedDSN');
snmp_count( ['entropy',0,'STR'] );
$elapsed{'TimeElapsedTotal'} = Time::HiRes::time - $msginfo->rx_time;
snmp_count([$_, int(1000*$elapsed{$_}+0.5), 'C32']) for (keys %elapsed);
$snmp_db->update_snmp_variables;
section_time($which_section);
}
if (ref $custom_object) {
$which_section = "custom-mail_done";
eval {
$custom_object->mail_done($conn,$msginfo); 1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"custom mail_done error: %s", $eval_stat);
};
section_time($which_section);
}
$which_section = 'finishing';
1;
} or do {
my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
$preserve_evidence = 1;
my($msg) = "$which_section FAILED: $eval_stat";
if ($point_of_no_return) {
do_log(-2, "TROUBLE in check_mail, but must continue (%s): %s",
$point_of_no_return,$msg);
} else {
do_log(-2, "TROUBLE in check_mail: %s", $msg);
$smtp_resp = "451 4.5.0 Error in processing, id=$am_id, $msg";
$exit_code = EX_TEMPFAIL;
for my $r (@{$msginfo->per_recip_data})
{ $r->recip_smtp_response($smtp_resp); $r->recip_done(1) }
}
};
if (!$preserve_evidence && debug_oneshot()) {
do_log(0, "DEBUG_ONESHOT CAUSES EVIDENCE TO BE PRESERVED");
$preserve_evidence = 1;
}
$snmp_db->register_proc(1,0,'.') if defined $snmp_db; do_log(-1, "signal: %s", join(', ',keys %got_signals)) if %got_signals;
undef $MSGINFO; ($smtp_resp, $exit_code, $preserve_evidence);
}
sub ensure_mime_entity($) {
my($msginfo) = @_;
my($ent,$mime_err);
if (!defined($msginfo->mime_entity)) {
($ent,$mime_err) = mime_decode($msginfo->mail_text, $msginfo->mail_tempdir,
$msginfo->parts_root);
$msginfo->mime_entity($ent);
prolong_timer('mime_decode');
}
$mime_err;
}
sub inspect_a_bounce_message($) {
my($msginfo) = @_;
my(%header_field,$bounce_type); my($is_true_bounce) = 0;
my($parts_root) = $msginfo->parts_root;
if (!defined($parts_root)) {
do_log(5, 'inspect_dsn: no parts root');
} else {
my($sender) = $msginfo->sender;
my($structure_type) = '?';
my($top_main); my($top) = $parts_root->children;
for my $e (!defined $top ? () : @$top) {
my($name) = $e->name_declared;
next if !defined($e->type_declared) && defined($name) &&
($name eq 'preamble' || $name eq 'epilogue');
next if $e->type_short eq 'MAIL' &&
lc($e->type_declared) eq 'message/rfc822';
$top_main = $e; last;
}
my(@parts); my($fname_ind); my($plaintext) = 0;
if (defined $top_main) { my($ch) = $top_main->children;
@parts = ($top_main, !defined $ch ? () : @$ch);
}
my(@t) =
map { my($t)=$_->type_declared; lc(ref $t ? $t->[0] : $t) } @parts;
ll(5) && do_log(5, "inspect_dsn: parts: %s", join(", ",@t));
my($fm) = $msginfo->rfc2822_from;
my(@rfc2822_from) = !defined $fm ? () : ref $fm ? @$fm : $fm;
if ( @parts >= 2 && @parts <= 4 &&
$t[0] eq 'multipart/report' &&
( $t[2] eq 'message/delivery-status' || $t[2] eq 'message/global-delivery-status' || $t[2] eq 'message/disposition-notification' || $t[2] eq 'message/global-disposition-notification' || $t[2] eq 'message/feedback-report' ) && $t[2] eq 'message/'.lc($parts[0]->report_type) &&
( $t[3] eq 'text/rfc822-headers' || $t[3] eq 'message/rfc822' ||
$t[3] eq 'message/rfc822-headers' ) )
{ $bounce_type = $t[2] eq 'message/disposition-notification' ? 'MDN'
: $t[2] eq 'message/global-disposition-notification' ? 'MDN'
: $t[2] eq 'message/feedback-report' ? 'ARF' : 'DSN';
$structure_type = 'standard ' . $bounce_type;
$fname_ind = 3; $is_true_bounce = 1;
} elsif ( @parts >= 2 && @parts <= 4 &&
$t[0] eq 'multipart/report' &&
$t[2] eq 'message/delivery-status' &&
$t[2] eq 'message/'.lc($parts[0]->report_type) &&
$t[3] eq 'text/plain' ) {
$fname_ind = 3; $structure_type = 'nostandard DSN-plain';
$plaintext = 1; $bounce_type = 'DSN';
} elsif (@parts >= 3 && @parts <= 4 && $t[0] eq 'multipart/report' &&
lc($parts[0]->report_type) eq 'delivery-status' &&
( $t[-1] eq 'text/rfc822-headers' || $t[-1] eq 'message/rfc822' )) {
$fname_ind = -1; $is_true_bounce = 1; $bounce_type = 'DSN';
$structure_type = 'DSN, missing delivery-status part';
} elsif (@parts >= 3 && @parts <= 5 &&
$t[0] eq 'multipart/mixed' &&
( $t[-1] eq 'text/rfc822-headers' || $t[-1] eq 'message/rfc822' ||
$t[-1] eq 'message/rfc822-headers') && ( $msginfo->is_auto || $msginfo->is_mlist ||
$msginfo->get_header_field_body('subject') =~
/\bDelivery Failure Notification\b/
) ) {
$fname_ind = -1;
$structure_type = 'multipart/mixed(' . $msginfo->is_bulk . ')';
} elsif (@parts == 3 &&
$t[0] eq 'multipart/mixed' &&
$t[-1] eq 'application/octet-stream' &&
$parts[-1]->name_declared =~ /\.eml\z/) {
$fname_ind = -1;
$structure_type = 'multipart/mixed with binary .eml';
} elsif ( @parts == 1 && $t[0] ne 'multipart/report' &&
( $msginfo->is_auto ||
$rfc2822_from[0] =~ /^postmaster(?:\@|\z)/si ) ) {
$fname_ind = 0; $plaintext = 1;
$structure_type = 'nonstructured(' . $msginfo->is_auto . ')';
} elsif ( $msginfo->is_auto && @parts == 2 &&
$t[0] eq 'multipart/mixed' && $t[1] eq 'text/plain' ) {
$fname_ind = 1; $plaintext = 1;
$structure_type = $t[0] .' with '. $t[1] .'(' . $msginfo->is_auto .')';
} elsif ( $msginfo->is_auto && @parts == 3 &&
$t[0] eq 'multipart/alternative' &&
$t[1] eq 'text/plain' && $t[2] eq 'text/html' ) {
$fname_ind = 1; $plaintext = 1;
$structure_type = $t[0] .' with '. $t[1] .'(' . $msginfo->is_auto .')';
}
if (defined $fname_ind) {
$fname_ind = $ my($fname) = $parts[$fname_ind]->full_name;
ll(5) && do_log(5,'inspect_dsn: struct: "%s", basenm(%s): %s, fname: %s',
$structure_type, $fname_ind, $parts[$fname_ind]->base_name, $fname);
if (defined $fname) {
my(%collectable_header_fields);
$collectable_header_fields{lc($_)} = 1
for qw(From To Return-Path Message-ID Date Received Subject
MIME-Version Content-Type);
my($fh) = IO::File->new;
$fh->open($fname,'<') or die "Can't open file $fname: $!";
binmode($fh,":bytes") or die "Can't cancel :utf8 mode: $!"
if $unicode_aware;
my($have_header_fields_cnt) = 0; my($nonheader_cnt) = 0;
my($curr_head,$ln); my($nr) = 0; my($eof) = 0; local($1,$2);
my($line_limit) = $plaintext ? 200 : 1000;
for (;;) {
if ($eof) {
$ln = "\n"; } else {
$! = 0; $ln = $fh->getline;
if (!defined($ln)) {
$eof = 1; $ln = "\n";
$!==0 or $!==EBADF ? do_log(0,"Error reading mail header section: $!")
: die "Error reading mail header section: $!";
}
}
last if ++$nr > $line_limit; if ($ln =~ /^[ \t]/) { $curr_head .= $ln if length($curr_head) < 2000; } else { if (defined $curr_head) {
$curr_head =~ s/^[> ]+// if $plaintext;
if ($curr_head !~ /^([a-zA-Z0-9._-]{1,60})[ \t]*:(.*)\z/s) {
$nonheader_cnt++;
} else {
my($hfname) = lc($1);
if ($collectable_header_fields{$hfname}) {
$have_header_fields_cnt++ if !exists $header_field{$hfname};
$header_field{$hfname} = $2;
}
}
}
$curr_head = $ln;
if (!$plaintext) {
last if $ln eq "\n" || $ln =~ /^--/;
} elsif ($ln =~ /^\s*$/ || $ln =~ /^--/) {
if (exists $header_field{'from'} &&
$have_header_fields_cnt >= 4 && $nonheader_cnt <= 1) {
last;
} else { $have_header_fields_cnt = 0; $nonheader_cnt = 0;
%header_field = (); undef $curr_head;
}
}
}
}
defined $ln || $!==0 or $!==EBADF ? do_log(1,"Error reading from %s: %s", $fname,$!)
: die "Error reading from $fname: $!";
$fh->close or die "Error closing $fname: $!";
my($thd) = exists $header_field{'message-id'} ? 3 : 5;
$is_true_bounce = 1 if exists $header_field{'from'} &&
$have_header_fields_cnt >= $thd;
if ($is_true_bounce) {
ll(5) && do_log(5, "inspect_dsn: plain=%s, got %d: %s",
$plaintext?"Y":"N", scalar(keys %header_field),
join(", ", sort keys %header_field));
for (@header_field{keys %header_field})
{ s/\n(?=[ \t])//gs; s/^[ \t]+//; s/[ \t\n]+\z// }
if (!defined($header_field{'message-id'}) &&
$have_header_fields_cnt >= 5 && $nonheader_cnt <= 1) {
$header_field{'message-id'} = ''; do_log(5, "inspect_dsn: a header section with no Message-ID");
} elsif (defined($header_field{'message-id'})) {
$header_field{'message-id'} =
(parse_message_id($header_field{'message-id'}))[0]
if defined $header_field{'message-id'};
}
}
section_time("inspect_dsn");
}
}
$bounce_type = 'bounce' if !defined $bounce_type;
if ($is_true_bounce) {
do_log(3, 'inspect_dsn: is a %s, struct: "%s", part(%s/%d), <%s>',
$bounce_type, $structure_type,
!defined($fname_ind) ? '-' : $fname_ind, scalar(@parts),
$sender) if ll(3);
} elsif ($msginfo->is_auto) { do_log(3, 'inspect_dsn: possibly a %s, unrecognizable, '.
'struct: "%s", parts(%s/%d): %s',
$bounce_type, $structure_type,
!defined($fname_ind) ? '-' : $fname_ind, scalar(@parts),
join(", ",@t)) if ll(3);
} else { do_log(3, 'inspect_dsn: not a bounce');
}
}
undef $bounce_type if !$is_true_bounce;
!$is_true_bounce ? () : (\%header_field,$bounce_type);
}
sub add_forwarding_header_edits_common($$$$$$$) {
my($conn, $msginfo, $hdr_edits, $hold, $any_undecipherable,
$virus_presence_checked, $spam_presence_checked) = @_;
my($allowed_hdrs) = cr('allowed_added_header_fields');
if ($allowed_hdrs && $allowed_hdrs->{lc('X-Amavis-Hold')}) {
$hdr_edits->delete_header('X-Amavis-Hold');
if ($hold ne '') {
$hdr_edits->add_header('X-Amavis-Hold', $hold);
do_log(-1, "Inserting header field: X-Amavis-Hold: %s", $hold);
}
}
$hdr_edits->edit_header('Authentication-Results',
sub { my($h,$b)=@_; my($lh)=c('myhostname');
$b=~/\b\Q$lh\E\b.*\bamavisd/si ? (undef,0) : ($b,1) });
if ($extra_code_antivirus) {
$hdr_edits->delete_header(c('X_HEADER_TAG'))
if c('remove_existing_x_scanned_headers') &&
(c('X_HEADER_LINE') ne '' && c('X_HEADER_TAG') =~ /^[!-9;-\176]+\z/);
}
if ($extra_code_antispam_sa &&
$allowed_hdrs && $allowed_hdrs->{lc('X-Spam-Checker-Version')}) {
$hdr_edits->add_header('X-Spam-Checker-Version',
sprintf("SpamAssassin %s (%s) on %s", Mail::SpamAssassin::Version(),
$Mail::SpamAssassin::SUB_VERSION, c('myhostname')));
}
$hdr_edits;
}
sub add_forwarding_header_edits_per_recip($$$$$$$$) {