Server IP : 85.214.239.14 / Your IP : 3.129.210.35 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/3/root/usr/share/perl5/Amavis/ |
Upload File : |
# 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;