File: //usr/share/perl5/vendor_perl/Amavis/AV.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::AV;
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 vars @EXPORT;
use POSIX qw(WIFEXITED WIFSIGNALED WIFSTOPPED
WEXITSTATUS WTERMSIG WSTOPSIG);
use Errno qw(EPIPE ENOTCONN ENOENT EACCES EINTR EAGAIN ECONNRESET);
use Time::HiRes ();
use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::In::Message;
use Amavis::IO::RW;
use Amavis::Lookup qw(lookup lookup2);
use Amavis::Out qw(mail_dispatch);
use Amavis::ProcControl qw(exit_status_str proc_status_ok
run_command run_as_subprocess
collect_results collect_results_structured);
use Amavis::rfc2821_2822_Tools qw(one_response_for_all);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll untaint min max minmax unique_list do_log
add_entropy proto_decode rmdir_recursively
prolong_timer get_deadline generate_mail_id);
use vars qw(%st_socket_created %st_sock); # keep persistent state (per-socket)
sub clamav_module_init($) {
my $av_name = $_[0];
# each child should reinitialize clamav module to reload databases
my $clamav_version = Mail::ClamAV->VERSION;
my $dbdir = Mail::ClamAV::retdbdir();
my $clamav_obj = Mail::ClamAV->new($dbdir);
ref $clamav_obj
or die "$av_name: Can't load db from $dbdir: $Mail::ClamAV::Error";
$clamav_obj->buildtrie;
$clamav_obj->maxreclevel($MAXLEVELS) if $MAXLEVELS > 0;
$clamav_obj->maxfiles($MAXFILES) if $MAXFILES > 0;
$clamav_obj->maxfilesize($MAX_EXPANSION_QUOTA || 50*1024*1024);
if ($clamav_version >= 0.12) {
$clamav_obj->maxratio($MAX_EXPANSION_FACTOR);
# $clamav_obj->archivememlim(0); # limit memory usage for bzip2 (0/1)
}
do_log(3,"clamav_module_init: %s init", $av_name);
section_time('clamav_module_init');
($clamav_obj,$clamav_version);
}
# called from sub ask_clamav or ask_daemon, should not run as a subprocess
#
use vars qw($clamav_obj $clamav_version);
sub clamav_module_internal_pre($) {
my $av_name = $_[0];
if (!defined $clamav_obj) {
($clamav_obj,$clamav_version) = clamav_module_init($av_name); # first time
} elsif ($clamav_obj->statchkdir) { # db reload needed?
do_log(2, "%s: reloading virus database", $av_name);
($clamav_obj,$clamav_version) = clamav_module_init($av_name);
}
}
# called from sub ask_clamav or ask_daemon, may be called directly
# or in a subprocess
#
sub clamav_module_internal($@) {
my($query, $bare_fnames,$names_to_parts,$tempdir, $av_name) = @_;
$query = join(' ',@$query) if ref $query;
my $fname = "$tempdir/parts/$query"; # file to be checked
my $part = $names_to_parts->{$query}; # get corresponding parts object
my $options = 0; # bitfield of options to Mail::ClamAV::scan
my($opt_archive,$opt_mail);
if ($clamav_version < 0.12) {
$opt_archive = &Mail::ClamAV::CL_ARCHIVE;
$opt_mail = &Mail::ClamAV::CL_MAIL;
} else { # >= 0.12, reflects renamed flags in libclamav 0.80
$opt_archive = &Mail::ClamAV::CL_SCAN_ARCHIVE;
$opt_mail = &Mail::ClamAV::CL_SCAN_MAIL;
}
# see clamav.h for standard options enabled by CL_SCAN_STDOPT
$options |= &Mail::ClamAV::CL_SCAN_STDOPT if $clamav_version >= 0.13;
$options |= $opt_archive; # turn on ARCHIVE
$options &= ~$opt_mail; # turn off MAIL
my $type_decl = $part->type_declared;
if (ref $part &&
($part->type_short eq 'MAIL' ||
defined $type_decl && $type_decl=~m{^message/(?:rfc822|global)\z}si)) {
do_log(2, "%s: $query - enabling option CL_MAIL", $av_name);
$options |= $opt_mail; # turn on MAIL
}
my $ret = $clamav_obj->scan(untaint($fname), $options);
my($output,$status);
if ($ret->virus) { $status = 1; $output = "INFECTED: $ret" }
elsif ($ret->clean) { $status = 0; $output = "CLEAN" }
else { $status = 2; $output = $ret->error.", errno=".$ret->errno }
($status,$output); # return synthesised status and a result string
}
# subroutine available for calling from @av_scanners list entries;
# it has the same args and returns as run_av() below
#
sub ask_clamav {
my($bare_fnames,$names_to_parts,$tempdir, $av_name) = @_;
clamav_module_internal_pre($av_name); # must not run as a subprocess
# my(@results) = ask_av(\&clamav_module_internal, @_); # invoke directly
my($proc_fh,$pid) = run_as_subprocess(\&ask_av, \&clamav_module_internal,@_);
my($results_ref,$child_stat) =
collect_results_structured($proc_fh,$pid,$av_name,200*1024);
!$results_ref ? () : @$results_ref;
}
my $savi_obj;
sub sophos_savi_init {
my($av_name, $command) = @_;
my(@savi_bool_options) = qw(
GrpArchiveUnpack GrpSelfExtract GrpExecutable GrpInternet GrpMSOffice
GrpMisc !GrpDisinfect !GrpClean EnableAutoStop FullSweep FullPdf Xml
);
$savi_obj = SAVI->new;
ref $savi_obj or die "$av_name: Can't create SAVI object, err=$savi_obj";
my $status = $savi_obj->load_data;
!defined($status) or die "$av_name: Failed to load SAVI virus data " .
$savi_obj->error_string($status) . " ($status)";
my $version = $savi_obj->version;
ref $version or die "$av_name: Can't get SAVI version, err=$version";
do_log(2,"%s init: Version %s (engine %d.%d) recognizing %d viruses",
$av_name, $version->string, $version->major, $version->minor,
$version->count);
my $error;
if ($MAXLEVELS > 0) {
$error = $savi_obj->set('MaxRecursionDepth', $MAXLEVELS);
!defined $error
or die "$av_name: error setting MaxRecursionDepth: err=$error";
}
$error = $savi_obj->set('NamespaceSupport', 3); # new with Sophos 3.67
!defined $error
or do_log(-1,"%s: error setting NamespaceSupport: err=%s",$av_name,$error);
for (@savi_bool_options) {
my $value = /^!/ ? 0 : 1; s/^!+//;
$error = $savi_obj->set($_, $value);
!defined $error or die "$av_name: Error setting $_: err=$error";
}
section_time('sophos_savi_init');
1;
}
sub sophos_savi_stale {
defined $savi_obj && $savi_obj->stale;
}
# run by a master(!) process, invoked from a hook run_n_children_hook
#
sub sophos_savi_reload {
if (defined $savi_obj) {
do_log(3,"sophos_savi_reload: about to reload SAVI data");
eval {
my $status = $savi_obj->load_data;
do_log(-1,"sophos_savi_reload: failed to load SAVI virus data %s (%s)",
$savi_obj->error_string($status), $status) if defined $status;
1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1,"sophos_savi_reload failed: %s", $eval_stat);
};
my $version = $savi_obj->version;
if (!ref($version)) {
do_log(-1,"sophos_savi_reload: Can't get SAVI version: %s", $version);
} else {
do_log(2,"Updated SAVI data: Version %s (engine %d.%d) ".
"recognizing %d viruses", $version->string,
$version->major, $version->minor, $version->count);
}
}
}
# to be called from sub sophos_savi
#
sub sophos_savi_internal {
my($query,
$bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args) = @_;
$query = join(' ',@$query) if ref $query;
my $fname = "$tempdir/parts/$query"; # file to be checked
if (!c('bypass_decode_parts')) {
my $part = $names_to_parts->{$query}; # get corresponding parts object
my $mime_option_value = 0;
my $type_decl = $part->type_declared;
if (ref $part &&
($part->type_short eq 'MAIL' ||
defined $type_decl && $type_decl=~m{^message/(?:rfc822|global)\z}si)){
do_log(2, "%s: %s - enabling option Mime", $av_name, $query);
$mime_option_value = 1;
}
my $error = $savi_obj->set('Mime', $mime_option_value);
!defined $error or die sprintf("%s: Error %s option Mime: err=%s",
$av_name, $mime_option_value ? 'setting' : 'clearing', $error);
}
my($output,$status); $!=0; my $result = $savi_obj->scan($fname);
if (!ref($result)) { # error
my $msg = "error scanning file $fname, " .
$savi_obj->error_string($result) . " ($result)"; # ignore $! ?
if ( !grep($result == $_, (514,527,530,538,549)) ) {
$status = 2; $output = "ERROR $query: $msg";
} else { # don't panic on non-fatal (encrypted, corrupted, partial)
$status = 0; $output = "CLEAN $query: $msg";
}
do_log(5,"%s: %s", $av_name,$output);
} elsif ($result->infected) {
$status = 1; $output = join(", ", $result->viruses) . " FOUND";
} else {
$status = 0; $output = "CLEAN $query";
}
($status,$output); # return synthesised status and a result string
}
# implements client side of the Sophos SSSP protocol
#
sub sophos_sssp_internal {
my($query,
$bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args) = @_;
my($query_template, $socket_specs) = !$args ? () : @$args;
# short timeout for connect and sending a request
prolong_timer('sophos_sssp_connect', undef, undef, 10);
my($remaining_time, $deadline) = get_deadline('sophos_sssp_internal');
# section_time('sssp-pre');
my $sssp_handle =
Amavis::IO::RW->new($socket_specs, Eol => "\015\012", Timeout => 10);
defined $sssp_handle or die "Can't connect to savdid";
# section_time('sssp-conn');
my $ln; local($1);
$ln = $sssp_handle->get_response_line; # greeting
defined $ln && $ln ne '' or die "sssp no greeting";
do_log(5,"sssp greeting %s", $ln);
$ln =~ m{^OK\s+SSSP/(\d+.*)\015\012\z}s or die "sssp bad greeting '$ln'";
# section_time('sssp-greet');
# # Use the SSSP OPTIONS request only if necessary, it is cheaper to have the
# # options set in the configuration file. If a client has needs different
# # from other clients, create another channel tailored for that client.
# #
# $sssp_handle->print("SSSP/1.0 OPTIONS\015\012".
# "savists:zipdecompression 1\015\012".
# "output: brief\015\012\015\012")
# or die "Error writing to sssp socket";
# $sssp_handle->flush or die "Error flushing sssp socket";
# $ln = $sssp_handle->get_response_line;
# defined $ln && $ln ne '' or die "sssp no response to OPTIONS";
# do_log(5,"sssp response to OPTIONS: %s", $ln);
# $ln =~ /^ACC\s+(\S*)/ or die "sssp OPTIONS request not accepted";
# while (defined($ln = $sssp_handle->get_response_line)) {
# last if $ln eq "\015\012";
# do_log(5,"sssp result of OPTIONS: %s", $ln);
# }
# # section_time('sssp-opts');
my $output = '';
# normal timeout for reading a response
prolong_timer('sophos_sssp_scan');
$sssp_handle->timeout(max(3, $deadline - Time::HiRes::time));
for my $fname (!ref($query) ? $query : @$query) {
my $fname_enc = $fname;
$fname_enc =~ s/([%\000-\040\177\377])/sprintf("%%%02X",ord($1))/gse;
$sssp_handle->print("SSSP/1.0 SCANDIRR $fname_enc\015\012")
or die "Error writing to sssp socket";
$sssp_handle->flush or die "Error flushing sssp socket";
$ln = $sssp_handle->get_response_line;
defined $ln && $ln ne '' or die "sssp no response to SCANDIRR";
do_log(5,"sssp response to SCANDIRR: %s", $ln);
# section_time('sssp-scan-ack');
$ln =~ /^ACC\s+(\S*)/ or die "sssp SCANDIRR request not accepted";
while (defined($ln = $sssp_handle->get_response_line)) {
last if $ln eq "\015\012";
do_log(3,"sssp result: %s", $ln);
$output .= $ln if length($output) < 10000;
}
}
$output = proto_decode($output);
# section_time('sssp-scan-result');
$sssp_handle->print("BYE\015\012") or die "Error writing to sssp socket";
$sssp_handle->flush or die "Error flushing sssp socket";
$sssp_handle->timeout(max(3, $deadline - Time::HiRes::time));
while (defined($ln = $sssp_handle->get_response_line)) {
do_log(5,"sssp response to BYE: %s", $ln);
last if $ln eq "\015\012" || $ln =~ /^BYE/;
}
# section_time('sssp-bye');
$sssp_handle->close or do_log(-1, "sssp - error closing session: $!");
# section_time('sssp-close');
(0,$output); # return synthesised status and a result string
}
# implements client side of the AVIRA SAVAPI3 protocol
#
sub avira_savapi_internal {
my($query,
$bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args) = @_;
my($query_template, $socket_specs, $product_id) = !$args ? () : @$args;
# short timeout for connect and sending a request
prolong_timer('avira_savapi_connect', undef, undef, 10);
my($remaining_time, $deadline) = get_deadline('avira_savapi_internal');
# section_time('savapi-pre');
my $savapi_handle =
Amavis::IO::RW->new($socket_specs, Eol => "\012", Timeout => 10);
defined $savapi_handle or die "Can't connect to savapi daemon";
# section_time('savapi-conn');
my $ln; local($1);
$ln = $savapi_handle->get_response_line; # greeting
defined $ln && $ln ne '' or die "savapi no greeting";
do_log(5,"savapi greeting %s", $ln);
$ln =~ m{^100 SAVAPI:(\d+.*)\012\z}s or die "savapi bad greeting '$ln'";
# section_time('savapi-greet');
$remaining_time = int(max(3, $deadline - Time::HiRes::time + 0.5));
for my $cmd ("SET PRODUCT $product_id",
"SET SCAN_TIMEOUT $remaining_time",
"SET CWD $tempdir/parts",
) {
# consider: "SET MAILBOX_SCAN 1", "SET ARCHIVE_SCAN 1", "SET HEUR_LEVEL 2"
$savapi_handle->print($cmd."\012") or die "Error writing '$cmd' to socket";
$savapi_handle->flush or die "Error flushing socket";
$ln = $savapi_handle->get_response_line;
defined $ln && $ln ne '' or die "savapi: no response to $cmd";
do_log(5,"savapi response to '%s': %s", $cmd,$ln);
$ln =~ /^100/ or die "savapi: $cmd request not accepted: $ln";
}
# section_time('savapi-settings');
# set a normal timeout for reading a response
prolong_timer('avira_savapi_scan');
$savapi_handle->timeout(max(3, $deadline - Time::HiRes::time));
my $keep_one_success; my $output = '';
for my $fname (!ref($query) ? $query : @$query) {
my $cmd = "SCAN $fname"; # files only, no directories
$savapi_handle->print($cmd."\012") or die "Error writing '$cmd' to socket";
$savapi_handle->flush or die "Error flushing socket";
while (defined($ln = $savapi_handle->get_response_line)) {
do_log(5,"savapi response to '%s': %s", $cmd,$ln);
if ($ln =~ /^200/) { # clean
$keep_one_success = $ln if !defined $keep_one_success;
} else {
$output .= $ln if length($output) < 10000; # sanity limit
}
last if $ln =~ /^([0125-9]\d\d|300|319).*\012/; # terminal status
# last if $ln =~ !/^(310|420|421|422|430).*\012/; # nonterminal status
}
}
$output = $keep_one_success if $output eq '' && defined $keep_one_success;
do_log(5,"savapi result: %s", $output);
# section_time('savapi-scan-result');
$savapi_handle->print("QUIT\012")
or do_log(-1, "savapi - error writing QUIT to socket");
$savapi_handle->flush
or do_log(-1, "savapi - error flushing socket after QUIT");
$savapi_handle->close
or do_log(-1, "savapi - error closing session: $!");
# section_time('savapi-close');
(0,$output); # return synthesised status and a result string
}
# implements client side of the ClamAV clamd protocol
#
sub clamav_clamd_internal {
my($query,
$bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args) = @_;
my($query_template, $socket_specs, $product_id) = !$args ? () : @$args;
# short timeout for connect
prolong_timer('clamav_connect', undef, undef, 10);
my($remaining_time, $deadline) = get_deadline('clamav_internal');
my $clamav_handle =
Amavis::IO::RW->new($socket_specs, Eol => "\000", Timeout => 10);
$clamav_handle or die "Can't connect to a clamd daemon";
# set a normal timeout
prolong_timer('clamav_scan');
$clamav_handle->timeout(max(3, $deadline - Time::HiRes::time));
$clamav_handle->print("zIDSESSION\0")
or die "Error writing 'zIDSESSION' to a clamd socket: $!";
my(@requests, @requests_filename, @requests_timestamp, $end_sent);
my($req_id, $requests_pending) = (0,0);
my $requests_remaining = !ref $query ? 1 : scalar @$query;
my($keep_one_success, $aborted_id, $found_infected);
my $output = '';
while ($requests_remaining > 0 || $requests_pending > 0) {
my $throttling = $requests_pending >= 8;
if ($throttling) {
# wait first for some of the pending results before sending new requests
$clamav_handle->flush or die "Error flushing socket: $!";
do_log(5,'clamav: throttling: %d pending, %d remaining',
$requests_pending, $requests_remaining);
} elsif ($requests_remaining > 0) {
my $fname = !ref $query ? $query : $query->[$req_id];
$req_id++;
$requests[$req_id] = 'INITIATING';
$requests_filename[$req_id] = $fname;
ll(5) && do_log(5,'clamav: sending contents of %s, req_id %d',
$fname, $req_id);
$clamav_handle->print("zINSTREAM\0")
or die "Error writing 'zINSTREAM' to a clamd socket: $!";
$requests[$req_id] = 'OPEN';
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: $!";
eval {
my($nbytes,$buff); $buff = pack('N',0);
while (($nbytes=$fh->read($buff, 32768-4, 4)) > 0) {
$requests[$req_id] = 'SENDING';
substr($buff,0,4) = pack('N',$nbytes); # 32 bits len -> 4 bytes
$clamav_handle->print($buff)
or die "Error writing $nbytes bytes to a clamd socket: $!";
}
defined $nbytes or die "Error reading from $fname: $!";
my $eod = pack('N',0); # length zero indicates end of data
if ($requests_remaining <= 0) { $eod .= "zEND\0"; $end_sent = 1 }
$clamav_handle->print($eod)
or die "Error writing end-of-data to a clamd socket: $!";
$clamav_handle->flush or die "Error flushing clamd socket: $!";
$requests[$req_id] = 'SENT';
1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
$requests[$req_id] = 'ABORTED: '.$eval_stat;
$aborted_id = $req_id; # also boolean true, request IDs start with 1
do_log(-1,'clamav: while feeding req_id %d: %s', $req_id, $eval_stat);
my $disc_len = $clamav_handle->discard_pending_output;
do_log(2,'clamav: discarding %d bytes', $disc_len) if $disc_len;
};
$requests_timestamp[$req_id] = Time::HiRes::time;
$requests_remaining--; $requests_pending++;
$fh->close or die "Error closing file $fname: $!";
do_log(5,'clamav: finished sending %s, req_id %d', $fname, $req_id);
}
while ( ($requests_pending > 0 && !$aborted_id) ||
$clamav_handle->response_line_available ) {
my $ln = $clamav_handle->get_response_line;
last if !defined $ln;
my $rx_time = Time::HiRes::time;
do_log(5,'clamav: got response %s', $ln);
my($id, $id_n, $resp); local($1,$2);
if ($ln =~ /^(\d+):\s*(.*?)\000\z/s) {
($id,$resp) = ($1,$2); $id_n = 0+$id;
} elsif ($ln =~ / ERROR\000\z/) {
if ($aborted_id) {
$id = $aborted_id; $id_n = 0+$id;
do_log(-1,'clamav: (possibly id=%d) error response: %s', $id,$ln);
} else {
do_log(-1,'clamav: error response: %s', $ln);
}
} else {
do_log(-1,'clamav: unparseable response %s', $ln);
next;
}
if (!defined $id) {
# failure already reported
} elsif (!defined $requests[$id_n]) {
do_log(-1,'clamav: bogus id %s in response ignored: %s', $id,$ln);
} elsif ($requests[$id_n] eq 'DONE') {
do_log(-1,'clamav: duplicate result for id %s: %s', $id,$ln);
} else {
ll(5) && do_log(5,'clamav: request id %s on %s took %.1f ms',
$id, $requests_filename[$id_n],
1000 * ($rx_time - $requests_timestamp[$id_n]));
if ($requests[$id_n] ne 'SENT') {
do_log(2,'clamav: result based on incomplete data, state %s: %s',
$requests[$id_n], $ln);
}
$ln =~ s/\000\z/\n/s;
$ln =~ s/^\Q$id\E:\s*stream:\s*/$requests_filename[$id_n]: /s;
if (defined $resp && $resp =~ /\bOK\z/) { # clean
$keep_one_success = $ln if !defined $keep_one_success;
} else {
$output .= $ln if length($output) < 10000; # sanity limit
}
$requests[$id_n] = 'DONE';
$requests_pending-- if $requests_pending > 0;
undef $requests_filename[$id_n];
undef $requests_timestamp[$id_n];
if ($resp =~ /\bFOUND\z/) {
$found_infected = 1;
if ($requests_remaining > 0 && c('first_infected_stops_scan')) {
do_log(2,'clamav: first infected stops scan');
$requests_remaining = 0;
}
}
}
}
if ($aborted_id) {
do_log(-1,'clamav: aborting: %d pending, %d remaining',
$requests_pending, $requests_remaining);
$clamav_handle->close
or do_log(5,'clamav: error closing session: %s', $!);
undef $clamav_handle;
if ($found_infected) {
# just normally return an infection report,
# even though not all content has been scanned
do_log(5,'clamav: result: %s', $output);
return (0,$output); # return synthesised status and a result string
} else {
die 'clamav: '.$requests[$aborted_id];
}
}
}
$output = $keep_one_success if $output eq '' && defined $keep_one_success;
do_log(5,'clamav: result: %s', $output);
if ($clamav_handle) {
if (!$end_sent) {
$clamav_handle->print("zEND\0")
or do_log(-1,"clamav: error writing 'zEND' to a clamd socket: %s", $!);
}
$clamav_handle->close
or do_log(-1,'clamav: error closing session: %s', $!);
}
(0,$output); # return synthesised status and a result string
}
sub av_smtp_client($$$$) {
my($msginfo,$av_name,$av_test_method,$av_test_recip) = @_;
$av_test_recip = 'dummy@localhost' if !defined $av_test_recip;
my $test_msg = Amavis::In::Message->new;
$test_msg->rx_time($msginfo->rx_time); # copy the reception time
$test_msg->log_id($msginfo->log_id); # use the same log_id
$test_msg->partition_tag($msginfo->partition_tag); # same partition_tag
$test_msg->parent_mail_id($msginfo->mail_id);
$test_msg->mail_id(scalar generate_mail_id());
$test_msg->conn_obj($msginfo->conn_obj);
$test_msg->mail_id($msginfo->mail_id); # use the same mail_id
$test_msg->body_type($msginfo->body_type); # use the same BODY= type
$test_msg->header_8bit($msginfo->header_8bit);
$test_msg->body_8bit($msginfo->body_8bit);
$test_msg->body_digest($msginfo->body_digest); # copy original digest
$test_msg->dsn_ret($msginfo->dsn_ret);
$test_msg->dsn_envid($msginfo->dsn_envid);
$test_msg->smtputf8($msginfo->smtputf8);
$test_msg->sender($msginfo->sender); # original sender
$test_msg->sender_smtp($msginfo->sender_smtp);
$test_msg->auth_submitter($msginfo->sender_smtp);
$test_msg->auth_user(c('amavis_auth_user'));
$test_msg->auth_pass(c('amavis_auth_pass'));
$test_msg->recips([$av_test_recip]); # made-up recipient
$_->delivery_method($av_test_method) for @{$test_msg->per_recip_data};
$test_msg->originating(0); # disables DKIM signing
$test_msg->mail_text($msginfo->mail_text); # the original mail contents
$test_msg->mail_text_str($msginfo->mail_text_str);
$test_msg->body_start_pos($msginfo->body_start_pos);
$test_msg->skip_bytes($msginfo->skip_bytes);
# NOTE: $initial_submission argument is typically treated as a boolean
# but here a value of 2 is supplied to allow a forwarding method to
# distinguish it from ordinary submissions
mail_dispatch($test_msg, 'AV', 0);
my($smtp_resp, $exit_code, $dsn_needed) =
one_response_for_all($test_msg, 0); # check status
do_log(2, "av_smtp_client %s: %s, %s", $av_name,$av_test_method,$smtp_resp);
(0, $smtp_resp);
}
# same args and returns as run_av() below,
# but prepended by a $query, which is a string to be sent to the daemon.
# Handles UNIX, INET and INET6 domain sockets.
# More than one socket may be specified for redundancy, they will be tried
# one after the other until one succeeds.
#
sub ask_daemon_internal {
my($query, # expanded query template, often a command and a file or dir name
$bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args,
$sts_clean,$sts_infected,$how_to_get_names, # regexps
) = @_;
my($query_template_orig,$socket_specs) = @$args;
my $output = '';
$socket_specs = [ $socket_specs ] if !ref($socket_specs);
my($remaining_time, $deadline) =
get_deadline('ask_daemon_internal_connect_pre');
my $max_retries = 2 * @$socket_specs; my $retries = 0;
# Sophie, Trophie and fpscand can accept multiple requests per session
# and return a single line response each time
my $multisession = $av_name =~ /\b(Sophie|Trophie|fpscand)\b/i ? 1 : 0;
for (;;) { # gracefully handle cases when av process times out or restarts
# short timeout for connect and sending a request
prolong_timer('ask_daemon_internal_connect', undef, undef, 10);
@$socket_specs or die "panic, no sockets specified!?"; # sanity
# try the first one in the current list
my $socketname = $socket_specs->[0];
my $sock = $st_sock{$socketname};
my $eval_stat;
eval {
if (!$st_socket_created{$socketname}) {
ll(3) && do_log(3, "%s: Connecting to socket %s %s%s",
$av_name, $daemon_chroot_dir, $socketname,
!$retries ? '' : ", retry #$retries" );
$sock = Amavis::IO::RW->new($socketname, Timeout => 10);
$st_sock{$socketname} = $sock;
defined $sock or die "Can't connect to socket $socketname\n";
$st_socket_created{$socketname} = 1;
}
$query = join(' ',@$query) if ref $query;
ll(3) && do_log(3,"%s: Sending %s to socket %s",
$av_name, $query, $socketname);
$sock->print($query) or die "Error writing to socket $socketname\n";
$sock->flush or die "Error flushing socket $socketname\n";
# normal timeout for reading a response
prolong_timer('ask_daemon_internal_scan');
$sock->timeout(max(3, $deadline - Time::HiRes::time));
if ($multisession) {
# depends on TCP segment boundaries, unreliable
my $nread = $sock->read($output,16384);
defined $nread or die "Error reading from $socketname: $!\n";
# and keep the socket open
} else { # single request/response per connection
my $buff = '';
for (;;) {
my $nread = $sock->read($buff,16384);
if (!defined($nread)) {
die "Error reading from $socketname: $!\n";
} elsif ($nread < 1) {
last; # sysread returns 0 at eof
} else { # successful read
$output .= $buff if length($output) < 100000; # sanity
}
}
$sock->close or die "Error closing socket $socketname\n";
$st_sock{$socketname} = $sock = undef;
$st_socket_created{$socketname} = 0;
}
$output ne '' or die "Empty result from $socketname\n";
1;
} or do {
$eval_stat = $@ ne '' ? $@ : "errno=$!";
};
prolong_timer('ask_daemon_internal');
last if !defined $eval_stat; # mission accomplished
# error handling (the most interesting error codes are EPIPE and ENOTCONN)
chomp $eval_stat; my $err = "$!"; my $errn = 0+$!;
# close socket through its DESTROY method, ignoring status
$st_sock{$socketname} = $sock = undef;
$st_socket_created{$socketname} = 0;
if (Time::HiRes::time >= $deadline) {
die "ask_daemon_internal: Exceeded allowed time";
}
++$retries <= $max_retries
or die "Too many retries to talk to $socketname ($eval_stat)";
if ($retries <= 1 && $errn == EPIPE) { # common, don't cause concern
do_log(2,"%s broken pipe (don't worry), retrying (%d)",
$av_name,$retries);
} else {
do_log( ($retries > 1 ? -1 : 1),
"%s: %s, retrying (%d)", $av_name,$eval_stat,$retries);
if ($retries % @$socket_specs == 0) { # every time the list is exhausted
my $dly = min(20, 1 + 5 * ($retries/@$socket_specs - 1));
do_log(3,"%s: sleeping for %s s", $av_name,$dly);
sleep($dly); # slow down a possible runaway
}
}
# leave good socket as the first entry in the list
# so that it will be tried first when needed again
if (@$socket_specs > 1) {
push(@$socket_specs, shift @$socket_specs); # circular shift left
}
}
(0,$output); # return synthesised status and a result string
}
# subroutine is available for calling from @av_scanners list entries;
# it has the same args and returns as run_av() below.
# Based on an implied protocol, or on an explicitly specified protocol name
# in the second element of array @$args, it determines a subroutine needed
# to implement the required protocol (defaulting to &ask_daemon_internal)
# and replaces $command in the argument list by this subroutine reference,
# then calls run_av with adjusted arguments. So, its main purpose is to map
# a protocol name (a string) into an internal code reference.
#
sub ask_daemon {
my($bare_fnames,$names_to_parts,$tempdir, $av_name,$command,$args,
$sts_clean,$sts_infected,$how_to_get_names) = @_;
my($av_method,$av_protocol); local($1);
# determine a protocol name from the second element of array @$args
$av_method = $args->[1] if $args && @$args >= 2;
$av_method = $av_method->[0] if ref $av_method;
$av_protocol = lc($1) if defined $av_method &&
$av_method =~ /^([a-z][a-z0-9.+-]*):/si;
my $code; my $run_spawned = 0;
if (!defined $av_protocol) {
# for compatibility with old style socket specification with
# no protocol (scheme) field, equivalent to a former call to ask_av()
# Sophie, Trophie, ClamAV-clamd, OpenAntiVirus, AVG,
# F-Prot fpscand, F-Prot f-protd, DrWebD, avast, ESET NOD32SS
$code = \&ask_daemon_internal;
} elsif ($av_protocol =~ /^(simple|sophie|trophie)\z/) {
# same as default, but with an explicit protocol prefix
$code = \&ask_daemon_internal;
} elsif ($av_protocol eq 'sssp') { # Sophos SSSP
$code = \&sophos_sssp_internal;
} elsif ($av_protocol eq 'savapi') { # Avira SAVAPI3
$code = \&avira_savapi_internal;
} elsif ($av_protocol eq 'clamd') { # ClamAV clamd protocol
$code = \&clamav_clamd_internal;
} elsif ($av_protocol eq 'smtp' || $av_protocol eq 'lmtp') {
$code = sub { av_smtp_client($Amavis::MSGINFO, $av_name,
$av_method, $args->[2]) };
} elsif ($av_protocol eq 'savi-perl') { # using SAVI-Perl perl module
if (@_ < 3+6) { # supply default arguments for backward compatibility
$args = ['*']; $sts_clean = [0]; $sts_infected = [1];
$how_to_get_names = qr/^(.*) FOUND$/m;
}
$code = \&sophos_savi_internal;
} elsif ($av_protocol eq 'clamav-perl') { # using Mail::ClamAV perl module
clamav_module_internal_pre($av_name); # must not run as a subprocess
$code = \&clamav_module_internal; $run_spawned = 1;
}
ll(5) && do_log(5, "ask_daemon: proto=%s, spawn=%s, (%s) %s",
!defined $av_protocol ? 'DFLT' : $av_protocol,
$run_spawned, $av_name, $av_method);
ref $code or die "Unsupported AV protocol name: $av_method";
$command = $code;
# reassemble arguments, after possibly being modified
my(@run_av_args) = ($bare_fnames,$names_to_parts,$tempdir,
$av_name,$command,$args, $sts_clean,$sts_infected,$how_to_get_names);
my(@results);
if (!$run_spawned) {
@results = run_av(@run_av_args); # invoke directly
} else {
my($proc_fh,$pid) = run_as_subprocess(\&ask_av, @run_av_args);
my($results_ref,$child_stat) =
collect_results_structured($proc_fh,$pid,$av_name,200*1024);
@results = @$results_ref if $results_ref;
}
@results; # ($scan_status,$output,$virusnames)
}
# for compatibility with pre-2.6.0 versions of amavisd-new and
# old @av_scanners entries; use ask_daemon and/or run_av instead
sub ask_av(@) {
my($code, @run_av_args) = @_;
$run_av_args[4] = $code; # replaces $command with a supplied $code
run_av(@run_av_args);
}
# Call a virus scanner and parse its output.
# Returns a triplet, or dies in case of failure.
# The first element of the triplet has the following semantics:
# - true if virus found,
# - 0 if no viruses found,
# - undef if it did not complete its job;
# the second element is a string, the text as provided by the virus scanner;
# the third element is ref to a list of virus names found (if any).
# (it is guaranteed the list will be nonempty if virus was found)
#
# If there is at least one glob character '*' present in a query template, the
# subroutine will traverse supplied files (@$bare_fnames) and call a supplied
# subroutine or program for each file to be scanned, summarizing the final
# av scan result. If there are no glob characters in a template, the result
# is a single call to a supplied subroutine or program, which will presumably
# traverse a directory by itself.
#
sub run_av(@) {
my($bare_fnames, # a ref to a list of filenames to scan (basenames)
$names_to_parts, # ref to a hash that maps base file names to parts object
$tempdir, # temporary directory
# n-tuple from an @av_scanners list entry starts here
$av_name, $command, $args,
$sts_clean, # a ref to a list of status values, or a regexp
$sts_infected, # a ref to a list of status values, or a regexp
$how_to_get_names, # ref to sub, or a regexp to get list of virus names
$pre_code, $post_code, # routines to be invoked before and after av
) = @_;
my($scan_status,@virusnames,$error_str); my $output = '';
return (0,$output,\@virusnames) if !defined($bare_fnames) || !@$bare_fnames;
my($query_template, $socket_specs); my $av_protocol = '';
if (!ref $args) {
$query_template = $args;
} else {
($query_template, $socket_specs) = @$args;
$socket_specs = $socket_specs->[0] if ref $socket_specs;
if (defined $socket_specs) {
local($1);
$av_protocol = lc($1) if $socket_specs =~ /^([a-z][a-z0-9.+-]*):/si;
}
}
my $one_at_a_time = 0;
$one_at_a_time = 1 if ref $command &&
$av_protocol !~ /^(?:sssp|savapi|clamd)\z/;
my(@query_template) = $one_at_a_time ? $query_template # treat it as one arg
: split(' ',$query_template); # shell-like
my $bare_fnames_last = $#{$bare_fnames};
do_log(5,"run_av (%s): query template(%s,%d): %s",
$av_name,$one_at_a_time,$bare_fnames_last,$query_template);
my($remaining_time, $deadline) = prolong_timer('run_av_pre');
my $cwd = "$tempdir/parts";
chdir($cwd) or die "Can't chdir to $cwd: $!";
&$pre_code(@_) if defined $pre_code;
# a '{}' will be replaced by a directory name, '{}/*' and '*' by file names
local($1);
my(@query_expanded) = map($_ eq '*' || $_ eq '{}/*' ? []
: m{^ \{ \} ( / .* )? \z}xs ? "$tempdir/parts$1"
: $_, @query_template);
my $eval_stat;
eval {
for (my $k = 0; $k <= $bare_fnames_last; ) { # traverse fnames in chunks
my(@processed_filenames);
my $arglist_size = 0; # size of a command with its arguments so far
for ($command,@query_expanded) { $arglist_size+=length($_)+1 if !ref $_ }
for (@query_expanded) { @$_ = () if ref $_ } # reset placeholder lists
while ($k <= $bare_fnames_last) { # traverse fnames individually
my $f = $bare_fnames->[$k]; my $multi = 0;
if ($one_at_a_time) { # glob templates may be substrings anywhere
local($1); @query_expanded = @query_template; # start afresh
s{ ( \{\} (?: / \* )? | \* ) }
{ $1 eq '{}' ? "$tempdir/parts"
: $1 eq '{}/*' ? ($multi=1,"$tempdir/parts/$f")
: $1 eq '*' ? ($multi=1,$f) : $1
}xgse for @query_expanded;
} else {
# collect as many filename arguments as suitable, but at least one
my $arg_size = 0;
for (@query_template) {
if ($_ eq '{}/*') { $arg_size += length("$tempdir/parts/$f") + 1 }
elsif ($_ eq '*') { $arg_size += length($f) + 1 }
}
# do_log(5,"run_av arglist size: %d + %d", $arglist_size,$arg_size);
if (@processed_filenames && $arglist_size + $arg_size > 4000) {
# POSIX requires 4 kB as a minimum buffer size for program args
last; # enough collected for now, the rest on the next iteration
}
# exact matching on command arguments, no substring matches
for my $j (0..$#query_template) {
if (ref $query_expanded[$j]) { # placeholders collecting fnames
my $arg = $query_template[$j];
my $repl = $arg eq '{}/*' ? "$tempdir/parts/$f"
: $arg eq '*' ? $f : undef;
$multi = 1;
push(@{$query_expanded[$j]}, untaint($repl));
$arglist_size += length($repl) + 1;
}
}
}
$k = $multi ? $k+1 : $bare_fnames_last+1;
push(@processed_filenames, $multi ? $f : "$tempdir/parts");
last if $one_at_a_time;
}
# now that arguments have been expanded, invoke the scanner
my($child_stat,$t_status,$t_output);
prolong_timer('run_av_scan'); # restart timer
if (ref $command) {
my(@q) = map(ref $_ ? @$_ : $_, @query_expanded);
ll(3) && do_log(3, "run_av Using (%s): (code) %s",
$av_name, join(' ',@q));
# call subroutine directly, passing all our arguments to it
($t_status,$t_output) = &$command(!@q ? '' : @q==1 ? $q[0] : \@q, @_);
prolong_timer('run_av_3'); # restart timer
$child_stat = 0; # no spawned process, just declare success
do_log(4,"run_av (%s) result: %s", $av_name,$t_output);
} else {
my($proc_fh,$pid); my $results_ref;
my $eval_stat2;
eval {
my(@q) = map(ref $_ ? @$_ : $_, @query_expanded);
ll(3) && do_log(3,"run_av Using (%s): %s %s",
$av_name,$command,join(' ',@q));
($proc_fh,$pid) = run_command(undef, '&1', $command, @q);
($results_ref,$child_stat) =
collect_results($proc_fh,$pid, $av_name,200*1024);
1;
} or do { $eval_stat2 = $@ ne '' ? $@ : "errno=$!" };
undef $proc_fh; undef $pid;
$error_str = exit_status_str($child_stat,0);
$t_status = WEXITSTATUS($child_stat) if defined $child_stat;
prolong_timer('run_av_4'); # restart timer
if (defined $eval_stat2) {
chomp $eval_stat2; $error_str = $eval_stat2;
do_log(-1, "run_av (%s): %s", $av_name,$eval_stat2);
}
if (defined $results_ref)
{ $t_output = $$results_ref; undef $results_ref }
chomp($t_output); my $t_output_trimmed = $t_output;
$t_output_trimmed =~ s/\r\n/\n/gs; local($1);
$t_output_trimmed =~ s/([ \t\n\r])[ \t\n\r]{4,}/$1.../gs;
$t_output_trimmed = "..." . substr($t_output_trimmed,-800)
if length($t_output_trimmed) > 800;
do_log(3, "run_av: %s %s, %s", $command,$error_str,$t_output_trimmed);
}
if (!defined($child_stat) || !WIFEXITED($child_stat)) {
# leave $scan_status undefined, indicating an error
# braindamaged Perl: empty string implies the last successfully
# matched regular expression; we must avoid this
} elsif (defined $sts_infected && (
ref($sts_infected) eq 'ARRAY' ? (grep($_==$t_status, @$sts_infected))
: $sts_infected eq '' ? 1 # avoid m// stupidity
: $t_output=~/$sts_infected/m)) { # is infected
# test for infected first, in case both expressions match
$scan_status = 1; # 'true' indicates virus found
my(@t_virusnames) = ref($how_to_get_names) eq 'CODE'
? &$how_to_get_names($t_output)
: $how_to_get_names eq '' ? ()
: $t_output=~/$how_to_get_names/gm;
@t_virusnames = grep(defined $_, @t_virusnames);
push(@virusnames, @t_virusnames);
$output .= $t_output . "\n";
do_log(2,"run_av (%s): %s INFECTED: %s", $av_name,
join(' ',@processed_filenames), join(', ',@t_virusnames) );
} elsif (!defined($sts_clean)) { # clean, but inconclusive
# by convention: undef $sts_clean means result is inconclusive,
# file appears clean, but continue scanning with other av scanners,
# the current scanner does not want to vouch for it; useful for a
# scanner like jpeg checker which tests for one vulnerability only
do_log(3,"run_av (%s): CLEAN, but inconclusive", $av_name);
} elsif (ref($sts_clean) eq 'ARRAY'
? (grep($_==$t_status, @$sts_clean))
: ""=~/x{0}/ && $t_output=~/$sts_clean/m) { # is clean
# 'false' (but defined) indicates no viruses
$scan_status = 0 if !$scan_status; # no viruses, no errors
do_log(3,"run_av (%s): CLEAN", $av_name);
} else {
# $error_str = "unexpected $error_str, output=\"$t_output_trimmed\"";
$error_str = "unexpected $error_str, output=\"$t_output\"";
do_log(-1,"run_av (%s) FAILED - %s", $av_name,$error_str);
last; # error, bail out
}
die "Exceeded allowed time\n" if time >= $deadline;
}
1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
&$post_code(@_) if defined $post_code;
@virusnames = ('') if $scan_status && !@virusnames; # ensure nonempty list
do_log(3,"run_av (%s) result: clean", $av_name)
if defined($scan_status) && !$scan_status;
chdir($tempdir) or die "Can't chdir to $tempdir: $!";
if (defined $eval_stat) {
prolong_timer('run_av_5'); # restart timer
die "run_av error: $eval_stat\n";
}
if (!defined($scan_status) && defined($error_str)) {
die "$command $error_str"; # die is more informative than a return value
}
($scan_status, $output, \@virusnames);
}
# @av_scanners is a list of n-tuples, where fields semantics is:
# 1. name: an AV scanner plain name, to be used in log and reports;
# 2a. program: a scanner program name; this string will be submitted to
# subroutine find_external_programs(), which will try to find the full
# program path name during startup according to a search path in variable
# $path; if program is not found, this scanner is disabled. Besides a
# simple string (a full program path name or just the basename to be
# looked for in PATH), this may be an array ref of alternative program
# names or full paths - the first match in the list will be used;
# 2b. subroutine: alternatively, this second field may be a subroutine
# reference, and the whole n-tuple entry is passed to it as args;
# it should return a triple: ($scan_status,$output,$virusnames_ref),
# where:
# - $scan_status is: true if a virus was found, 0 if no viruses,
# undef if scanner was unable to complete its job (failed);
# - $output is an optional result string to appear in logging and macro %v;
# - $virusnames_ref is a ref to a list of detected virus names (may be
# undef or a ref to an empty list);
# 3. args: command arguments to be given to the scanner program;
# a substring {} will be replaced by the directory name to be scanned, i.e.
# "$tempdir/parts", a "*" will be replaced by base file names of parts;
# 4. clean: an array ref of av scanner exit status values, or a regexp
# (to be matched against scanner output), indicating NO VIRUSES found;
# a special case is a value undef, which does not claim file to be clean
# (i.e. it never matches, similar to []), but suppresses a failure warning;
# to be used when the result is inconclusive (useful for specialized and
# quick partial scanners such as jpeg checker);
# 5. infected: an array ref of av scanner exit status values, or a regexp
# (to be matched against scanner output), indicating VIRUSES WERE FOUND;
# a value undef may be used and it never matches (for consistency with 4.);
# Note: the virus match prevails over a 'not found' match, so it is safe
# even if the no. 4. matches for viruses too;
# 6. virus name: a regexp (to be matched against scanner output), returning
# a list of virus names found, or a sub ref, returning such a list when
# given scanner output as argument;
# 7. and 8.: (optional) subroutines to be executed before and after scanner
# (e.g. to set environment or current directory);
# see examples for these at KasperskyLab AVP and NAI uvscan.
sub virus_scan($$) {
my($msginfo,$firsttime) = @_;
my $tempdir = $msginfo->mail_tempdir;
my($scan_status,$output,@virusname);
my(@detecting_scanners,@av_scanners_results);
my $anyone_done = 0; my $anyone_tried = 0;
my($bare_fnames_ref,$names_to_parts);
my $j; my $tier = 'primary';
for my $av (@{ca('av_scanners')}, "\000", @{ca('av_scanners_backup')}) {
next if !defined $av;
if ($av eq "\000") { # 'magic' separator between lists
last if $anyone_done;
do_log(-1,"WARN: all %s virus scanners failed, considering backups",
$tier);
$tier = 'secondary'; next;
}
next if !ref $av || !defined $av->[1];
if (!defined $bare_fnames_ref) { # first time: collect file names to scan
my $parts_root = $msginfo->parts_root;
($bare_fnames_ref,$names_to_parts) =
files_to_scan("$tempdir/parts", $parts_root);
if (!@$bare_fnames_ref) {
do_log(2, "Not calling virus scanners, no files to scan in %s/parts",
$tempdir);
} else {
do_log(5, "Calling virus scanners, %d files to scan in %s/parts",
scalar(@$bare_fnames_ref), $tempdir);
}
}
my($scanner_name,$command) = @$av;
$anyone_tried = 1; my($this_status,$this_output,$this_vn);
if (!@$bare_fnames_ref) { # no files to scan?
($this_status,$this_output,$this_vn) = (0, '', undef); # declare clean
} else { # call virus scanner
do_log(5, "invoking av-scanner %s", $scanner_name);
eval {
($this_status,$this_output,$this_vn) = ref $command eq 'CODE'
? &$command($bare_fnames_ref,$names_to_parts,$tempdir, @$av)
: run_av($bare_fnames_ref,$names_to_parts,$tempdir, @$av);
1;
} or do {
my $err = $@ ne '' ? $@ : "errno=$!"; chomp $err;
$err = sprintf("%s av-scanner FAILED: %s", $scanner_name, $err);
do_log(-1, "%s", $err);
$this_status = undef;
};
}
$anyone_done = 1 if defined $this_status;
$j++; section_time("AV-scan-$j");
if ($this_status && $this_vn && @$this_vn) {
@$this_vn = unique_list($this_vn);
# virus is reported by this scanner; is it for real, or is it just spam?
my(@spam_hits); my $vnts = ca('virus_name_to_spam_score_maps');
@spam_hits = # map each reported virus name to spam score or to undef
map(scalar(lookup2(0,$_,$vnts)), @$this_vn) if ref $vnts;
if (@spam_hits && !grep(!defined($_), @spam_hits)) { # all defined
# AV scanner did trigger, but all provided names are actually spam!
my(%seen);
for my $r (@{$msginfo->per_recip_data}) {
my $spam_tests = $r->spam_tests;
if ($spam_tests) {
local($1,$2);
for (split(/,/, join(',',map($$_,@$spam_tests)))) {
$seen{$1} = $2 if /^AV\.([^=]*)=([0-9.+-]+)\z/;
}
}
}
my(@vnms,@hits);
# remove already detected virus names and duplicates from the list
for my $j (0..$#$this_vn) {
my $vname = $this_vn->[$j];
if (!exists($seen{$vname})) {
push(@vnms,$vname); push(@hits,$spam_hits[$j]);
$seen{$vname} = $spam_hits[$j]; # keep only one copy
}
}
@$this_vn = @vnms; @spam_hits = @hits;
if (!@spam_hits) {
do_log(2,"Turning AV infection into a spam report, ".
"name already accounted for");
} else {
my $spam_level = max(@spam_hits);
my $spam_tests = join(',',
map(sprintf("AV:%s=%s", $this_vn->[$_], $spam_hits[$_]),
(0..$#$this_vn) ));
for my $r (@{$msginfo->per_recip_data}) {
$r->spam_level( ($r->spam_level || 0) + $spam_level );
if (!$r->spam_tests) {
$r->spam_tests([ \$spam_tests ]);
} else {
push(@{$r->spam_tests}, \$spam_tests);
}
}
my $spam_report = $spam_tests;
my $spam_summary =
sprintf("AV scanner %s reported spam (not infection):\n%s\n",
$scanner_name, join(',',@$this_vn));
do_log(2,"Turning AV infection into a spam report: score=%s, %s",
$spam_level, $spam_tests);
if (defined($msginfo->spam_report)||defined($msginfo->spam_summary)){
$spam_report = $msginfo->spam_report . ', ' . $spam_report
if $msginfo->spam_report ne '';
$spam_summary = $msginfo->spam_summary . "\n\n" . $spam_summary
if $msginfo->spam_summary ne '';
}
$msginfo->spam_report($spam_report);
$msginfo->spam_summary($spam_summary);
}
$this_status = 0; @$this_vn = (); # TURN OFF ALERT for this AV scanner!
}
}
push(@av_scanners_results,
[$av, $this_status, !$this_vn ? () : @$this_vn]);
if ($this_status) { # a virus detected by this scanner, really! (not spam)
push(@detecting_scanners, $scanner_name);
if (!@virusname) { # store results of the first scanner detecting
@virusname = @$this_vn if $this_vn;
$scan_status = $this_status; $output = $this_output;
}
last if c('first_infected_stops_scan'); # stop now if we found a virus?
} elsif (!defined($scan_status)) { # tentatively keep regardless of status
$scan_status = $this_status; $output = $this_output;
}
}
if (ll(2) && @virusname && @detecting_scanners) {
my(@ds) = @detecting_scanners; s/,/;/ for @ds; # facilitates parsing
do_log(2, "virus_scan: (%s), detected by %d scanners: %s",
join(', ',@virusname), scalar(@ds), join(', ',@ds));
}
$output =~ s{\Q$tempdir\E/parts/?}{}gs if defined $output; # hide path info
if (!$anyone_tried) { die "NO VIRUS SCANNERS AVAILABLE\n" }
elsif (!$anyone_done) { die "ALL VIRUS SCANNERS FAILED\n" }
($scan_status, $output, \@virusname,
\@detecting_scanners, \@av_scanners_results); # return a 5-tuple
}
# return a ref to a list of files to be scanned in a given directory
#
sub files_to_scan($$) {
my($dir,$parts_root) = @_;
my $names_to_parts = {}; # a hash that maps base file names
# to Amavis::Unpackers::Part object
# traverse decomposed parts tree breadth-first, match it to actual files
for (my $part, my(@unvisited)=($parts_root);
@unvisited and $part=shift(@unvisited);
push(@unvisited,@{$part->children}))
{ $names_to_parts->{$part->base_name} = $part if $part ne $parts_root }
my $bare_fnames_ref = []; my(%bare_fnames);
# traverse parts directory and check for actual files
local(*DIR); opendir(DIR,$dir) or die "Can't open directory $dir: $!";
# modifying a directory while traversing it can cause surprises, avoid;
# avoid slurping the whole directory contents into memory
my($f, @rmfiles, @rmdirs);
while (defined($f = readdir(DIR))) {
next if $f eq '.' || $f eq '..';
my $fname = $dir . '/' . $f;
my(@stat_list) = lstat($fname); my $errn = @stat_list ? 0 : 0+$!;
next if $errn == ENOENT;
if ($errn) { die "files_to_scan: file $fname inaccessible: $!" }
add_entropy(@stat_list);
if (!-r _) { # attempting to gain read access to the file
do_log(3,"files_to_scan: attempting to gain read access to %s", $fname);
chmod(0750, untaint($fname))
or die "files_to_scan: Can't change protection on $fname: $!";
$errn = lstat($fname) ? 0 : 0+$!;
if ($errn) { die "files_to_scan: file $fname inaccessible: $!" }
if (!-r _) { die "files_to_scan: file $fname not readable" }
}
if (!-f _ || !exists $names_to_parts->{$f}) {
# not a regular file or unexpected
my $what = -l _ ? 'symlink' : -d _ ? 'directory' : -f _ ? 'file'
: 'non-regular file';
my $msg = "removing unexpected $what $fname";
$msg .= ", it has no corresponding parts object"
if !exists $names_to_parts->{$f};
do_log(-1, "WARN: files_to_scan: %s", $msg);
if (-d _) { push(@rmdirs, $f) } else { push(@rmfiles, $f) }
} elsif (-z _) {
# empty file
} else {
if ($f !~ /^[A-Za-z0-9_.-]+\z/s) {
do_log(-1,"WARN: files_to_scan: unexpected/suspicious file name: %s",
$f);
}
push(@$bare_fnames_ref,$f); $bare_fnames{$f} = 1;
}
}
closedir(DIR) or die "Error closing directory $dir: $!";
for my $f (@rmfiles) {
my $fname = $dir . '/' . untaint($f);
do_log(5,"files_to_scan: deleting file %s", $fname);
unlink($fname) or die "Can't delete $fname: $!";
}
undef @rmfiles;
for my $d (@rmdirs) {
my $dname = $dir . '/' . untaint($d);
do_log(5,"files_to_scan: deleting directory %s", $dname);
rmdir_recursively($dname);
}
undef @rmdirs;
# remove entries from %$names_to_parts that have no corresponding files
my($fname,$part);
while ( ($fname,$part) = each %$names_to_parts ) {
next if exists $bare_fnames{$fname};
if (ll(4) && $part->exists) {
my $type_short = $part->type_short;
do_log(4,"files_to_scan: info: part %s (%s) no longer present",
$fname, (!ref $type_short ? $type_short : join(', ',@$type_short)) );
}
delete $names_to_parts->{$fname}; # delete is allowed for the current elem.
}
($bare_fnames_ref, $names_to_parts);
}
1;