Server IP : 85.214.239.14 / Your IP : 3.149.29.190 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/2/task/2/root/usr/share/perl5/Amavis/ |
Upload File : |
# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::SpamControl; use strict; use re 'taint'; use warnings; use warnings FATAL => qw(utf8 void); no warnings 'uninitialized'; # use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict'; use Fcntl qw(:flock); use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL); use Amavis::Lookup::Label; BEGIN { require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '2.412'; @ISA = qw(Exporter); } use Amavis::Conf qw(:platform c cr ca); use Amavis::Lookup qw(lookup lookup2); use Amavis::Lookup::SQLfield; use Amavis::rfc2821_2822_Tools qw(make_query_keys qquote_rfc2821_local); use Amavis::Util qw(ll do_log min max minmax untaint untaint_inplace unique_list); sub new { my $class = $_[0]; my $self = bless { scanners_list => [] }, $class; for my $as (@{ca('spam_scanners')}) { if (ref $as && defined $as->[1] && $as->[1] ne '') { my($scanner_name,$module,@args) = @$as; my $scanner_obj; do_log(5, "SpamControl: attempting to load scanner %s, module %s", $scanner_name,$module); { no strict 'subs'; $scanner_obj = $module->new($scanner_name,$module,@args); } if ($scanner_obj) { push(@{$self->{scanners_list}}, [$scanner_obj, @$as]); do_log(2, "SpamControl: scanner %s, module %s", $scanner_name,$module); } else { do_log(5, "SpamControl: no scanner %s, module %s", $scanner_name,$module); } } } $self; } # called at startup, before chroot and before main fork # sub init_pre_chroot { my $self = $_[0]; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; if ($scanner_obj && $scanner_obj->UNIVERSAL::can('init_pre_chroot')) { $scanner_obj->init_pre_chroot; do_log(1, "SpamControl: init_pre_chroot on %s done", $scanner_name); } } } # called at startup, after chroot and changing UID, but before main fork # sub init_pre_fork { my $self = $_[0]; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; if ($scanner_obj && $scanner_obj->UNIVERSAL::can('init_pre_fork')) { $scanner_obj->init_pre_fork; do_log(1, "SpamControl: init_pre_fork on %s done", $scanner_name); } } } # called during child process initialization # sub init_child { my $self = $_[0]; my $failure_msg; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; if ($scanner_obj && $scanner_obj->UNIVERSAL::can('init_child')) { eval { $scanner_obj->init_child; do_log(5, "SpamControl: init_child on %s done", $scanner_name); 1; } or do { my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; do_log(-1, "init_child on spam scanner %s failed: %s", $scanner_name, $eval_stat); $failure_msg = "init_child $scanner_name failed: $eval_stat" if !defined $failure_msg; }; } } if (defined $failure_msg) { die $failure_msg } } sub lock { my($self,$scanner_obj,$lock_type_name) = @_; my $lock_file = $scanner_obj->{options}->{'lock_file'}; if (defined $lock_file && $lock_file ne '') { my $lock_type = $scanner_obj->{options}->{$lock_type_name}; $lock_type = $scanner_obj->{options}->{'lock_type'} if !defined $lock_type; $lock_type = 'exclusive' if !defined $lock_type; if ($lock_type ne '' && lc($lock_type) ne 'none') { my $lock_fh = IO::File->new; $lock_fh->open($lock_file, O_CREAT|O_RDWR, 0640) or die "Can't open a lock file $lock_file: $!"; $scanner_obj->{lock_fh} = $lock_fh; my $lock_type_displ; if (defined $lock_type && lc($lock_type) eq 'shared') { $lock_type = LOCK_SH; $lock_type_displ = 'a shared'; } else { $lock_type = LOCK_EX; $lock_type_displ = 'an exclusive'; } do_log(5,"acquring %s lock on %s for %s", $lock_type_displ, $lock_file, $scanner_obj->{scanner_name}); flock($lock_fh, $lock_type) or die "Can't acquire $lock_type_displ lock on $lock_file: $!"; } } } sub unlock { my($self,$scanner_obj) = @_; my $lock_fh = $scanner_obj->{lock_fh}; if ($lock_fh) { my $scanner_name = $scanner_obj->{scanner_name}; do_log(5, "releasing a lock for %s", $scanner_name); # close would unlock automatically, but let's check for locking mistakes flock($lock_fh, LOCK_UN) or die "Can't release a lock for $scanner_name: $!"; $lock_fh->close or die "Can't close a lock file for $scanner_name: $!"; undef $scanner_obj->{lock_fh}; } } # actual spam checking for every message # sub spam_scan { my($self,$msginfo) = @_; my $failure_msg; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; next if !$scanner_obj && !$scanner_obj->UNIVERSAL::can('check'); do_log(5, "SpamControl: calling spam scanner %s", $scanner_name); $self->lock($scanner_obj, 'classifier_lock_type'); eval { $scanner_obj->check($msginfo); 1; } or do { my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; do_log(-1, "checking with spam scanner %s failed: %s", $scanner_name, $eval_stat); $failure_msg = "$scanner_name failed: $eval_stat" if !defined $failure_msg; }; $self->unlock($scanner_obj); } if (defined $failure_msg) { die $failure_msg } 1; } sub auto_learn { my($self,$msginfo) = @_; my $failure_msg; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; next if !$scanner_obj || !$scanner_obj->UNIVERSAL::can('auto_learn'); next if !$scanner_obj->UNIVERSAL::can('can_auto_learn') || !$scanner_obj->can_auto_learn; # learn-on-error logic: what was the final outcome my($min_spam_level, $max_spam_level) = minmax(map($_->spam_level, @{$msginfo->per_recip_data})); next if !defined $min_spam_level || !defined $max_spam_level; # learn-on-error logic: what this scanner thinks my $my_verdict = $msginfo->supplementary_info('VERDICT-'.$scanner_name); $my_verdict = !defined $my_verdict ? '' : lc $my_verdict; my $my_score = $msginfo->supplementary_info('SCORE-'.$scanner_name); $my_score = 0 if !defined $my_score; # learn-on-error logic: opinions differ? my $learn_as; # leaving out a contribution by this spam scanner if ($my_verdict ne 'ham' && $max_spam_level-$my_score < 0.5) { $learn_as = 'ham'; } elsif ($my_verdict ne 'spam' && $min_spam_level-$my_score >= 5) { $learn_as = 'spam'; } next if !defined $learn_as; ll(2) && do_log(2, "SpamControl: scanner %s, auto-learn as %s / %.3f (was: %s / %s)", $scanner_name, $learn_as, $my_verdict ne 'ham' ? $max_spam_level : $min_spam_level, $my_verdict, !$my_score ? '0' : sprintf("%.3f",$my_score)); $self->lock($scanner_obj, 'learner_lock_type'); eval { $scanner_obj->auto_learn($msginfo,$learn_as); 1; } or do { my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; do_log(-1, "auto-learning with spam scanner %s failed: %s", $scanner_name, $eval_stat); $failure_msg = "$scanner_name failed: $eval_stat" if !defined $failure_msg; }; $self->unlock($scanner_obj); } if (defined $failure_msg) { die $failure_msg } 1; } # called during child process shutdown # sub rundown_child() { my $self = $_[0]; for my $as (@{$self->{scanners_list}}) { my($scanner_obj,$scanner_name) = @$as; if ($scanner_obj && $scanner_obj->UNIVERSAL::can('rundown_child')) { eval { $scanner_obj->rundown_child; do_log(5, "SpamControl: rundown_child on %s done", $scanner_name); 1; } or do { my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; do_log(-1, "rundown_child on spam scanner %s failed: %s", $scanner_name, $eval_stat); }; } } } # check envelope sender and author for white or blacklisting by each recipient; # Saves the result in recip_blacklisted_sender and recip_whitelisted_sender # properties of each recipient object, and updates spam score for each # recipient according to soft-w/b-listing. # sub white_black_list($$$$) { my($msginfo,$sql_wblist,$user_id_sql,$ldap_lookups) = @_; my $fm = $msginfo->rfc2822_from; my(@rfc2822_from) = !defined($fm) ? () : ref $fm ? @$fm : $fm; my(@senders) = ($msginfo->sender, @rfc2822_from); @senders = unique_list(\@senders); # remove possible duplicates ll(4) && do_log(4,"wbl: checking sender %s", scalar(qquote_rfc2821_local(@senders))); my($any_w,$any_b,$all,$wr,$br); $any_w = 0; $any_b = 0; $all = 1; for my $r (@{$msginfo->per_recip_data}) { # for each recipient next if $r->recip_done; # already dealt with my($wb,$boost); my $found = 0; my $recip = $r->recip_addr; my($user_id_ref,$mk_ref); $user_id_ref = $r->user_id; $user_id_ref = [] if !defined $user_id_ref; do_log(5,"wbl: (SQL) recip <%s>, %s matches", $recip, scalar(@$user_id_ref)) if $sql_wblist && ll(5); for my $sender (@senders) { for my $ind (0..$#{$user_id_ref}) { # for ALL SQL sets matching the recip my $user_id = $user_id_ref->[$ind]; my $mkey; ($wb,$mkey) = lookup(0,$sender, Amavis::Lookup::SQLfield->new($sql_wblist,'wb','S',$user_id) ); do_log(4,'wbl: (SQL) recip <%s>, rid=%s, got: "%s"', $recip,$user_id,$wb); if (!defined($wb)) { # NULL field or no match: remains undefined } elsif ($wb =~ /^ *([+-]?\d+(?:\.\d*)?) *\z/) { # numeric my $val = 0+$1; # penalty points to be added to the score $boost += $val; ll(2) && do_log(2, 'wbl: (SQL) soft-%slisted (%s) sender <%s> => <%s> (rid=%s)', ($val<0?'white':'black'), $val, $sender, $recip, $user_id); $wb = undef; # not hard- white or blacklisting, does not exit loop } elsif ($wb =~ /^[ \000]*\z/) { # neutral, stops the search $found=1; $wb = 0; do_log(5, 'wbl: (SQL) recip <%s> is neutral to sender <%s>', $recip,$sender); } elsif ($wb =~ /^([BbNnFf])[ ]*\z/) { # blacklisted (B,N(o), F(alse)) $found=1; $wb = -1; $any_b++; $br = $recip; $r->recip_blacklisted_sender(1); do_log(5, 'wbl: (SQL) recip <%s> blacklisted sender <%s>', $recip,$sender); } else { # whitelisted (W, Y(es), T(true), or anything else) if ($wb =~ /^([WwYyTt])[ ]*\z/) { do_log(5, 'wbl: (SQL) recip <%s> whitelisted sender <%s>', $recip,$sender); } else { do_log(-1,'wbl: (SQL) recip <%s> whitelisted sender <%s>, '. 'unexpected wb field value: "%s"', $recip,$sender,$wb); } $found=1; $wb = +1; $any_w++; $wr = $recip; $r->recip_whitelisted_sender(1); } last if $found; } if (!$found && $ldap_lookups && c('enable_ldap')) { # LDAP queries my $wblist; my($keys_ref,$rhs_ref) = make_query_keys($sender,0,0); my(@keys) = @$keys_ref; unshift(@keys, '<>') if $sender eq ''; # a hack for a null return path untaint_inplace($_) for @keys; # untaint keys $_ = Net::LDAP::Util::escape_filter_value($_) for @keys; do_log(5,'wbl: (LDAP) query keys: %s', join(', ',map("\"$_\"",@keys))); $wblist = lookup(0,$recip,Amavis::Lookup::LDAPattr->new( $ldap_lookups, 'amavisBlacklistSender', 'L-')); for my $key (@keys) { if (grep(lc($_) eq lc($key), @$wblist)) { $found=1; $wb = -1; $br = $recip; $any_b++; $r->recip_blacklisted_sender(1); do_log(5,'wbl: (LDAP) recip <%s> blacklisted sender <%s>', $recip,$sender); } } $wblist = lookup(0,$recip,Amavis::Lookup::LDAPattr->new( $ldap_lookups, 'amavisWhitelistSender', 'L-')); for my $key (@keys) { if (grep(lc($_) eq lc($key), @$wblist)) { $found=1; $wb = +1; $wr = $recip; $any_w++; $r->recip_whitelisted_sender(1); do_log(5,'wbl: (LDAP) recip <%s> whitelisted sender <%s>', $recip,$sender); } } } if (!$found) { # fall back to static lookups if no match # sender can be both white- and blacklisted at the same time my($val, $r_ref, $mk_ref, @t); # NOTE on the specifics of $per_recip_blacklist_sender_lookup_tables : # the $r_ref below is supposed to be a ref to a single lookup table # for compatibility with pre-2.0 versions of amavisd-new; # Note that this is different from @score_sender_maps, which is # supposed to contain a ref to a _list_ of lookup tables as a result # of the first-level lookup (on the recipient address as a key). # ($r_ref,$mk_ref) = lookup(0,$recip, Amavis::Lookup::Label->new("blacklist_recip<$recip>"), cr('per_recip_blacklist_sender_lookup_tables')); @t = ((defined $r_ref ? $r_ref : ()), @{ca('blacklist_sender_maps')}); $val = lookup2(0,$sender,\@t,Label=>"blacklist_sender<$sender>") if @t; if ($val) { $found=1; $wb = -1; $br = $recip; $any_b++; $r->recip_blacklisted_sender(1); do_log(5,'wbl: recip <%s> blacklisted sender <%s>', $recip,$sender); } # similar for whitelists: ($r_ref,$mk_ref) = lookup(0,$recip, Amavis::Lookup::Label->new("whitelist_recip<$recip>"), cr('per_recip_whitelist_sender_lookup_tables')); @t = ((defined $r_ref ? $r_ref : ()), @{ca('whitelist_sender_maps')}); $val = lookup2(0,$sender,\@t,Label=>"whitelist_sender<$sender>") if @t; if ($val) { $found=1; $wb = +1; $wr = $recip; $any_w++; $r->recip_whitelisted_sender(1); do_log(5,'wbl: recip <%s> whitelisted sender <%s>', $recip,$sender); } } if (!defined($boost)) { # lookup @score_sender_maps if no match with SQL # note the first argument of lookup() is true, requesting ALL matches my($r_ref,$mk_ref) = lookup2(1,$recip, ca('score_sender_maps'), Label=>"score_recip<$recip>"); for my $j (0..$#{$r_ref}) { # for ALL tables matching the recipient my($val,$key) = lookup2(0,$sender,$r_ref->[$j], Label=>"score_sender<$sender>"); if (defined $val && $val != 0) { $boost += $val; ll(2) && do_log(2,'wbl: soft-%slisted (%s) sender <%s> => <%s>, '. 'recip_key="%s"', ($val<0?'white':'black'), $val, $sender, $recip, $mk_ref->[$j]); } } } } # endfor on @senders if ($boost) { # defined and nonzero $r->spam_level( ($r->spam_level || 0) + $boost); my $spam_tests = 'AM.WBL=' . (0+sprintf("%.3f",$boost)); if (!$r->spam_tests) { $r->spam_tests([ \$spam_tests ]); } else { unshift(@{$r->spam_tests}, \$spam_tests); } } $all = 0 if !$wb; } # endfor on recips if (!ll(2)) { # don't bother preparing a log report which will not be printed } else { my $msg = ''; if ($all && $any_w && !$any_b) { $msg = "whitelisted" } elsif ($all && $any_b && !$any_w) { $msg = "blacklisted" } elsif ($all) { $msg = "black or whitelisted by all recips" } elsif ($any_b || $any_w) { $msg .= "whitelisted by ".($any_w>1?"$any_w recips, ":"$wr, ") if $any_w; $msg .= "blacklisted by ".($any_b>1?"$any_b recips, ":"$br, ") if $any_b; $msg .= "but not by all,"; } do_log(2,"wbl: %s sender %s", $msg, scalar(qquote_rfc2821_local(@senders))) if $msg ne ''; } ($any_w+$any_b, $all); } 1; __DATA__ # package Amavis::Unpackers;