Server IP : 85.214.239.14 / Your IP : 13.58.61.176 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/root/usr/share/perl5/Amavis/SpamControl/ |
Upload File : |
# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::SpamControl::ExtProg; 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'; BEGIN { require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '2.412'; @ISA = qw(Exporter); } use subs @EXPORT_OK; use Errno qw(EIO EINTR EAGAIN ECONNRESET EBADF); use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL); use Time::HiRes (); use Amavis::Conf qw(:platform :confvars :sa c cr ca); use Amavis::ProcControl qw(exit_status_str proc_status_ok kill_proc run_command run_command_consumer); use Amavis::rfc2821_2822_Tools qw(qquote_rfc2821_local); use Amavis::Timing qw(section_time); use Amavis::Util qw(ll do_log sanitize_str min max minmax prolong_timer get_deadline); sub new { my($class, $scanner_name,$module,@args) = @_; my($cmd,$cmdargs,%options) = @args; return if !defined $cmd || $cmd eq ''; bless { scanner_name => $scanner_name, command => $cmd, args => $cmdargs, options => \%options, }, $class; } sub check { my($self,$msginfo) = @_; $self->check_or_learn($msginfo,undef); }; sub auto_learn { my($self,$msginfo,$learn_as) = @_; $self->check_or_learn($msginfo,$learn_as); } sub can_auto_learn { my $self = $_[0]; my $opt = $self->{options}; $opt && defined $opt->{'learn_ham'} && defined $opt->{'learn_spam'}; } # pass a mail message to an external (spam checking) program, # extract interesting header fields from the result # sub check_or_learn { my($self,$msginfo,$learn_as) = @_; my $scanner_name = $self->{scanner_name}; my $cmd = $self->{command}; my $cmdargs; my $auto_learning; if (!defined $learn_as) { $cmdargs = $self->{args}; } elsif ($learn_as eq 'ham') { $cmdargs = $self->{options}->{'learn_ham'}; $auto_learning = 1; } elsif ($learn_as eq 'spam') { $cmdargs = $self->{options}->{'learn_spam'}; $auto_learning = 1; } my $size_limit; my $mbsl = $self->{options}->{'mail_body_size_limit'}; $mbsl = c('sa_mail_body_size_limit') if !defined $mbsl; if (defined $mbsl) { $size_limit = min(64*1024, $msginfo->orig_header_size) + 1 + min($mbsl, $msginfo->orig_body_size); # don't bother if slightly oversized, it's faster without size checks undef $size_limit if $msginfo->msg_size < $size_limit + 5*1024; } my $prefix = ''; # fake a local delivery agent by inserting a Return-Path $prefix .= sprintf("Return-Path: %s\n", $msginfo->sender_smtp); $prefix .= sprintf("X-Envelope-To: %s\n", join(",\n ",qquote_rfc2821_local(@{$msginfo->recips}))); my $os_fp = $msginfo->client_os_fingerprint; $prefix .= sprintf("X-Amavis-OS-Fingerprint: %s\n", sanitize_str($os_fp)) if defined($os_fp) && $os_fp ne ''; my(@av_tests); my $per_recip_data = $msginfo->per_recip_data; $per_recip_data = [] if !$per_recip_data; for my $r (@$per_recip_data) { my $spam_tests = $r->spam_tests; push(@av_tests, grep(/^AV\..+=/, split(/,/, join(',',map($$_,@$spam_tests))))) if $spam_tests; } $prefix .= sprintf("X-Amavis-AV-Status: %s\n", sanitize_str(join(',',@av_tests))) if @av_tests; $prefix .= sprintf("X-Amavis-PolicyBank: %s\n", c('policy_bank_path')); $prefix .= sprintf("X-Amavis-MessageSize: %d%s\n", $msginfo->msg_size, !defined $size_limit ? '' : ", TRUNCATED to $size_limit"); my $resp_stdout_fh = IO::File->new; # parent reading side of the pipe my $child_stdout_fh = IO::File->new; # child stdout writing side of a pipe my $resp_stderr_fh = IO::File->new; # parent reading side of the pipe my $child_stderr_fh = IO::File->new; # child stderr writing side of a pipe pipe($resp_stdout_fh, $child_stdout_fh) or die "$scanner_name: Can't create pipe1: $!"; pipe($resp_stderr_fh, $child_stderr_fh) or die "$scanner_name: Can't create pipe2: $!"; binmode($resp_stdout_fh) or die "Can't set pipe1 to binmode: $!"; binmode($resp_stderr_fh) or die "Can't set pipe2 to binmode: $!"; my($proc_fh,$pid) = run_command_consumer('&='.fileno($child_stdout_fh), '&='.fileno($child_stderr_fh), $cmd, @$cmdargs); $child_stdout_fh->close or die "Parent failed to close child side of the pipe1: $!"; $child_stderr_fh->close or die "Parent failed to close child side of the pipe2: $!"; undef $child_stdout_fh; undef $child_stderr_fh; my($remaining_time, $deadline) = get_deadline($scanner_name.'_scan', 0.8, 5); alarm(0); # stop the timer my $proc_fd = fileno($proc_fh); my $resp_stdout_fd = fileno($resp_stdout_fh); my $resp_stderr_fd = fileno($resp_stderr_fh); my $response = ''; my $response_stderr = ''; my $response_chopped = 0; my $child_stat; my $bytes_sent = 0; my $err_on_child = 0; my $msg = $msginfo->mail_text; my $msg_str_ref = $msginfo->mail_text_str; # have an in-memory copy? $msg = $msg_str_ref if ref $msg_str_ref; eval { if (!defined $msg) { # empty mail } elsif (ref $msg ne 'SCALAR' && $msg->isa('MIME::Entity')) { # $msg->print_body($proc_fh); # flushing the pipe? die "$scanner_name: reading from MIME::Entity is not implemented"; } else { # handles a message in-memory or on a file my $file_position = $msginfo->skip_bytes; if (ref $msg ne 'SCALAR') { $msg->seek($file_position, 0) or die "Can't rewind mail file: $!"; } my $data_source = $prefix; my $eof_on_response = 0; my $eof_on_msg = 0; my $force_eof_on_msg = 0; my($rout,$wout,$eout,$rin,$win,$ein); $rin=$win=$ein=''; vec($rin,$resp_stdout_fd,1) = 1; vec($rin,$resp_stderr_fd,1) = 1; for (;;) { vec($win,$proc_fd,1) = 0; vec($win,$proc_fd,1) = 1 if defined $proc_fh && (!$eof_on_msg || $data_source ne ''); $ein = $rin | $win; my $timeout = max(3, $deadline - Time::HiRes::time); my($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); defined $nfound && $nfound >= 0 or die "$scanner_name: select failed: $!"; if (vec($rout,$resp_stderr_fd,1)) { my $inbuf = ''; $! = 0; my $nread = sysread($resp_stderr_fh, $inbuf, 16384); if ($nread) { # successful read ll(5) && do_log(5, 'rx stderr: %d %s [...]', $nread, substr($inbuf,0,1000)); $response_stderr .= $inbuf if length($response_stderr) < 10000; } elsif (defined $nread) { # defined but zero: EOF # sysread returns 0 at eof } elsif ($! == EAGAIN || $! == EINTR) { Time::HiRes::sleep(0.1); # slow down, just in case } else { # read error do_log(0,"%s: error reading from pipe2: %s", $scanner_name,$!); } } if (vec($rout,$resp_stdout_fd,1)) { my $inbuf = ''; $! = 0; my $nread = sysread($resp_stdout_fh, $inbuf, 16384); if ($nread) { # successful read ll(5) && do_log(5, 'rx: %d %s [...]', $nread, substr($inbuf,0,30)); my $response_l = length($response); if ($response_chopped || $response_l >= 65536) { # ignore the rest of input } else { $response .= $inbuf; my $j = $response_l <= 1 ? 0 : $response_l - 1; # we only need a mail header from the returned text $response_chopped = 1 if index($response,"\n\n",$j) >= 0; } } elsif (defined $nread) { # defined but zero: EOF $eof_on_response = 1; # sysread returns 0 at eof } elsif ($! == EAGAIN || $! == EINTR) { Time::HiRes::sleep(0.1); # slow down, just in case } else { # read error $eof_on_response = 1; die "$scanner_name: error reading from pipe1: $!"; } } if (vec($wout,$proc_fd,1)) { # subprocess is ready to receive more if ($data_source eq '' && !$eof_on_msg) { # get more data my $nread = 0; if ($force_eof_on_msg) { # pretend to already be at eof } elsif (ref $msg ne 'SCALAR') { # message is on a file $nread = $msg->read($data_source,32768); } elsif ($file_position < length($$msg)) { # message in memory # do it in chunks, saves memory, cache friendly $data_source = substr($$msg,$file_position,32768); $nread = length($data_source); } if (!$nread) { $eof_on_msg = 1; defined $nread or die "$scanner_name: error reading message: $!"; if (defined $proc_fh) { $proc_fh->close or $err_on_child=$! }; undef $proc_fh; do_log(5,"tx: eof"); } $file_position += $nread; if (defined $size_limit) { my $remaining_room = $size_limit - $bytes_sent; $remaining_room = 0 if $remaining_room < 0; if ($nread > $remaining_room) { substr($data_source, $remaining_room) = ''; do_log(5,"tx: (size limit) %d -> %d", $nread,$remaining_room); $force_eof_on_msg = 1; } } } if ($data_source ne '' && defined $proc_fh) { ll(5) && do_log(5, "tx: %d %s [...]", length($data_source), substr($data_source,0,30)); # syswrite does a write(2), no need to call $proc_fh->flush my $nwrite = syswrite($proc_fh, $data_source); if (!defined($nwrite)) { if ($! == EAGAIN || $! == EINTR) { Time::HiRes::sleep(0.1); # slow down, just in case } else { $data_source = ''; $eof_on_msg = 1; # simulate an eof do_log(-1,"%s: error writing to pipe: %s", $scanner_name,$!); $proc_fh->close or $err_on_child=$!; undef $proc_fh; do_log(5,"tx: eof (wr err)"); } } elsif ($nwrite > 0) { # successful write $bytes_sent += $nwrite; if ($nwrite < length($data_source)) { substr($data_source,0,$nwrite) = ''; } else { $data_source = ''; } } } } last if $eof_on_response; if (Time::HiRes::time >= $deadline) { die "$scanner_name: exceeded allowed time\n"; } } } if (defined $proc_fh) { $proc_fh->close or $err_on_child=$! } $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef; undef $proc_fh; undef $pid; 1; } or do { my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; do_log(-1,"%s failed: %s", $scanner_name,$eval_stat); kill_proc($pid,$scanner_name,1,$proc_fh,$eval_stat) if defined $pid; undef $proc_fh; undef $pid; }; prolong_timer($scanner_name); # restart timer substr($response_stderr,2000) = '[...]' if length($response_stderr) > 2000; if (proc_status_ok($child_stat,$err_on_child)) { do_log(2, "%s stderr: %s", $scanner_name,$response_stderr) if $response_stderr ne ''; } else { do_log(-1,"%s stderr: %s", $scanner_name,$response_stderr) if $response_stderr ne ''; die "$scanner_name: error running program $cmd: " . exit_status_str($child_stat,$err_on_child) . "\n"; } # keep just a header section in $response if ($response eq '') { # empty mail } elsif (substr($response, 0,1) eq "\n") { $response = ''; # empty header section } else { my $ind = index($response,"\n\n"); # find header/body separator substr($response, $ind+1) = '' if $ind >= 0; } my $crm114_score; if ($cmd =~ /\bcrm/ && $response =~ /^\s*([+-]?\d*(?:\.\d*)?)\s*$/) { $crm114_score = $1; $response = ''; # skip the header parsing loop below } my(@response_lines) = split(/^/m, $response, -1); push(@response_lines, "\n", "\n"); # insure a trailing NL and a separator undef $response; my(%header_field, @header_field_name, $curr_head); # scan mail header section retrieved from an external program on its stdout for my $ln (@response_lines) { # guaranteed to contain header/body separator if ($ln =~ /^[ \t]/) { # folded $curr_head .= $ln; } else { # a new header field, process previous if any if (defined $curr_head) { local($1,$2); if ($curr_head =~ /^ ( (?: X-DSPAM | X-CRM114 | X-Bogosity) [^:]*? ) [ \t]* : [ \t]* (.*) $/xs) { my($hn,$hb) = ($1,$2); my $hnlc = lc $hn; push(@header_field_name, $hn) if !exists($header_field{$hnlc}); $header_field{$hnlc} = $hb; # keep last } } $curr_head = $ln; last if $ln eq "\n"; } } my($spam_score, $spam_tests); my $score_factor = $self->{options}->{'score_factor'}; my $dspam_result = $header_field{lc('X-DSPAM-Result')}; if (defined $dspam_result) { if ($dspam_result =~ /\b(signature|result|probability|confidence)=.*;/) { # combined result, split my(%attribute); for my $attr (split(/;\s*/, $dspam_result)) { local($1,$2); my($n,$v) = ($attr =~ /^([^=]*)=(.*)\z/s) ? ($1,$2) : ('user',$attr); $v =~ s/^"//; $v =~ s/"\z//; $attribute{$n} = $v; } # simulate separate header fields @header_field_name = qw(X-DSPAM-Result X-DSPAM-Class X-DSPAM-Confidence X-DSPAM-Probability X-DSPAM-Signature); for my $hn (@header_field_name) { my $hnlc = lc $hn; my $name = $hnlc; $name =~ s/^X-DSPAM-//i; $header_field{$hnlc} = $attribute{$name}; } } $dspam_result = $header_field{lc('X-DSPAM-Result')}; my $dspam_signature = $header_field{lc('X-DSPAM-Signature')}; $dspam_result = '' if !defined $dspam_result; $dspam_signature = '' if !defined $dspam_signature; chomp($dspam_result); chomp($dspam_signature); $dspam_signature = '' if $dspam_signature eq 'N/A'; if (!$auto_learning) { $msginfo->supplementary_info('DSPAMRESULT', $dspam_result); $msginfo->supplementary_info('DSPAMSIGNATURE', $dspam_signature); $msginfo->supplementary_info('VERDICT-'.$scanner_name, $dspam_result); $spam_score = $dspam_result eq 'Spam' ? 10 : -1; # fabricated $score_factor = 1 if !defined $score_factor; $spam_score *= $score_factor; $spam_tests = sprintf("%s.%s=%.3f", $scanner_name, $dspam_result, $spam_score); do_log(2,"%s result: %s, score=%.3f, sig=%s", $scanner_name, $dspam_result, $spam_score, $dspam_signature); } } my $crm114_status = $header_field{lc('X-CRM114-Status')}; if (defined $crm114_score || defined $crm114_status) { local($1,$2); if (!defined $crm114_status) { # presumably using --stats_only # fabricate a Status from score $crm114_status = !defined $crm114_score ? 'unknown' : $crm114_score <= -10 ? uc('spam') : $crm114_score >= +10 ? 'GOOD' : 'UNSURE'; $header_field{lc('X-CRM114-Status')} = sprintf("%s ( %s )", $crm114_status, $crm114_score); @header_field_name = qw(X-CRM114-Status); } elsif ($crm114_status =~ /^([A-Z]+)\s+\(\s+([-\d\.]+)\s+\)/) { $crm114_status = $1; $crm114_score = $2; } my $crm114_cacheid = $header_field{lc('X-CRM114-CacheID')}; if (defined $crm114_cacheid && $crm114_cacheid =~ /^sfid-\s*$/i) { delete $header_field{lc('X-CRM114-CacheID')}; $crm114_cacheid = undef; } s/[ \t\r\n]+\z// for ($crm114_status, $crm114_score, $crm114_cacheid); $score_factor = -0.10 if !defined $score_factor; $spam_score = $score_factor * $crm114_score; $spam_tests = sprintf("%s.%s(%s)=%.3f", $scanner_name, $crm114_status, $crm114_score, $spam_score); if (!$auto_learning) { $msginfo->supplementary_info('VERDICT-'.$scanner_name, uc $crm114_status eq 'GOOD' ? 'Ham' : $crm114_status); $msginfo->supplementary_info('CRM114STATUS', sprintf("%s ( %s )", $crm114_status,$crm114_score)); $msginfo->supplementary_info('CRM114SCORE', $crm114_score); $msginfo->supplementary_info('CRM114CACHEID', $crm114_cacheid); do_log(2,"%s result: score=%s (%s), status=%s, cacheid=%s", $scanner_name, $spam_score, $crm114_score, $crm114_status, $crm114_cacheid); } } my $bogo_line = $header_field{lc('X-Bogosity')}; my($bogo_status, $bogo_score, $bogo_tests); if (defined $bogo_line) { ($bogo_status, $bogo_tests, $bogo_score) = split(/,\s*/,$bogo_line); local($1); $bogo_score =~ s/^spamicity=([0-9.+-]*).*\z/$1/s; $spam_score = $bogo_status eq 'Spam' ? 5 : $bogo_status eq 'Ham' ? -5 : 0; $score_factor = 1 if !defined $score_factor; $spam_score = $score_factor * $spam_score; # trim trailing fraction zeroes $spam_score = 0 + sprintf("%.3f",$spam_score); $spam_tests = sprintf("%s=%s", $scanner_name, $spam_score); # $spam_tests = sprintf("%s(%s/%s)=%s", # $scanner_name, $bogo_status, $bogo_score, $spam_score); if (!$auto_learning) { $msginfo->supplementary_info('VERDICT-'.$scanner_name, $bogo_status); $msginfo->supplementary_info('BOGOSTATUS', sprintf("%s ( %s )", $bogo_status, $bogo_score)); $msginfo->supplementary_info('BOGOSCORE', $bogo_score); do_log(2,"%s result: score=%s (%s), status=%s", $scanner_name, $spam_score, $bogo_score, $bogo_status); } } if (!$auto_learning) { my $hdr_edits = $msginfo->header_edits; my $use_our_hdrs = cr('prefer_our_added_header_fields'); my $allowed_hdrs = cr('allowed_added_header_fields'); my $all_local = !grep(!$_->recip_is_local, @$per_recip_data); for my $hn (@header_field_name) { my $hnlc = lc $hn; my $hb = $header_field{$hnlc}; if (defined $hb) { $hb =~ s/[ \t\r\n]+\z//; # trim trailing whitespace and eol do_log(5,"%s: suppl attr: %s = '%s'", $scanner_name,$hn,$hb); $msginfo->supplementary_info($hn,$hb); # add header fields to passed mail for all recipients if ($all_local && $allowed_hdrs && $allowed_hdrs->{$hnlc} && !($use_our_hdrs && $use_our_hdrs->{$hnlc})) { $hdr_edits->add_header($hn,$hb,2); } } } if (defined $spam_score) { $msginfo->supplementary_info('SCORE-'.$scanner_name, $spam_score); for my $r (@$per_recip_data) { $r->spam_level( ($r->spam_level || 0) + $spam_score ); if (!$r->spam_tests) { $r->spam_tests([ \$spam_tests ]); } else { push(@{$r->spam_tests}, \$spam_tests); } } } } section_time($scanner_name); } 1;