--- amavisd~ Thu Nov 21 22:56:25 2002 +++ amavisd Mon Dec 9 18:09:11 2002 @@ -61,8 +61,6 @@ # Amavis::Log # Amavis::Util # Amavis::rfc2821_2822_Tools -# Amavis::Lookup::SQL -# Amavis::Lookup::SQLfield # Amavis::Lookup::RE # Amavis::Lookup # Amavis::Expand @@ -79,6 +77,8 @@ # Amavis::Notify # Amavis #optionally compiled-in packages: --------------------------------------------- +# Amavis::Lookup::SQLfield +# Amavis::Lookup::SQL # Amavis::In::AMCL # Amavis::In::SMTP # Amavis::AV @@ -126,7 +126,6 @@ $MAX_EXPANSION_QUOTA $MAX_EXPANSION_FACTOR $bypass_decode_parts $banned_filename_re $keep_decoded_original_re - %bypass_checks @bypass_checks_acl %bypass_virus_checks @bypass_virus_checks_acl $bypass_virus_checks_re %bypass_spam_checks @bypass_spam_checks_acl $bypass_spam_checks_re %virus_lovers @virus_lovers_acl $virus_lovers_re @@ -136,6 +135,7 @@ %blacklist_sender @blacklist_sender_acl $blacklist_sender_re $viruses_that_fake_sender_re @lookup_sql_dsn + @local_domains $local_domains_re )], 'notifyconf' => [qw( $notify_method @@ -149,7 +149,7 @@ $notify_virus_sender_templ $notify_spam_sender_templ $notify_virus_admin_templ $notify_spam_admin_templ $notify_virus_recips_templ $notify_spam_recips_templ - $warn_offsite @local_domains $local_domains_re + $warn_offsite $virus_quarantine_to $spam_quarantine_to )], 'unpack' => [qw( @@ -259,56 +259,7 @@ $sa_local_tests_only = 0; $sa_debug = 0; - -# ISP features: -# -# Exclude certain recipients from virus filtering by adding their lower-cased -# e-mail address (or domain only) to the hash %virus_lovers, or to the -# access list @virus_lovers_acl - see README.lookups and examples at -# subroutines lookup_hash() and lookup_acl(). Make sure the appropriate -# form (e.g. external/internal) of address is used in case of virtual domains, -# or when mapping external to internal addresses, etc. - this is MTA dependent. -# -# Notifications would still be generated however, and infected mail -# (if passed) gets additional header: -# X-AMaViS-Alert: INFECTED, message contains virus: ... -# (header not inserted with milter interface!) -# -# NOTE (milter interface only): in case of multiple recipients, -# it is only possible to drop or accept the message in its entirety - for all -# recipients. If all of them are virus lovers, we'll accept mail, but if -# at least one recipient is not a virus lover, we'll discard it. -# -# Similar in concept to %virus_lovers, a hash %bypass_checks, and access list -# @bypass_checks_acl, are used to skip entirely the decoding, unpacking -# and content checking, but only if ALL mail recipients are members of the -# hash %bypass_checks or match the list @bypass_checks_acl. -# This is mainly a time-saving option. -# -# %bypass_checks/@bypass_checks_acl does NOT GUARANTEE the message -# will NOT be checked for viruses - this may still happen when there is -# more than one recipient for a message, and not all of them match -# %bypass_checks/@bypass_checks_acl. To guarantee virus delivery -# (but see milter limitations above), a recipient must also match -# %virus_lovers/@virus_lovers_acl/$virus_lovers_re. - -# NOTE: it would not be clever to base this check on sender address, -# since there are no guarantees that it is genuine. Many viruses -# and spam messages fake sender address. To achieve selective filtering -# based on the source of the mail (e.g. IP address, MTA port number, ...), -# use mechanisms provided by MTA if available. - -# Similar to %bypass_checks/@bypass_checks_acl but affecting only -# virus scanning or spam scanning respectively, are the lookup tables: -# %bypass_virus_checks/@bypass_virus_checks_acl/$bypass_virus_checks_re, and -# %bypass_spam_checks/@bypass_spam_checks_acl/$bypass_spam_checks_re - -# Hashes for many entries are faster but more limited, acl is more general -# but can be slower if list is long. For lots of entries or for dynamically -# changing settings use SQL lookups. - -# See README.lookups for further detail. - +# See amavisd.conf and README.lookups for details. # What to do with the message (this is independent of quarantining): # reject: tell MTA to generate a non-delivery notification @@ -355,7 +306,7 @@ # If you decide to pass viruses (or spam) to certain users using # %virus_lovers/@virus_lovers_acl/$virus_lovers_re, (or *spam_lovers*), -# %bypass_checks/@bypass_checks_acl, or $final_virus_destiny=1 +# %bypass_virus_checks/@bypass_virus_checks_acl, or $final_virus_destiny=1 # ($final_spam_destiny=1), you can set the variable $addr_extension_virus # ($addr_extension_spam) to some string, and the recipient address will have # this string appended as an address extension to the local-part of the @@ -565,7 +516,7 @@ strftime("%b %e %H:%M:%S", localtime), $myhostname, $myname, $$); } - if (length($errmsg) > 2000) { # crop at some arbitrary limit + if (length($errmsg) > 2000) { # crop at some arbitrary limit (< LINE_MAX) $errmsg = substr($errmsg,0,2000) . "..."; } $logline .= (!defined($am_id) ? '' : "($am_id) ") . $errmsg; @@ -1066,189 +1017,6 @@ 1; # -package Amavis::Lookup::SQL; -use strict; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - $VERSION = '1.00'; - @ISA = qw(Exporter); -} -BEGIN { - import Amavis::Util qw(do_log); - import Amavis::Conf qw($recipient_delimiter $localpart_is_case_sensitive - @local_domains $local_domains_re); - import Amavis::Timing qw(section_time); - import Amavis::rfc2821_2822_Tools qw(split_address split_localpart); -} - -sub new($$$$$$) { - my($class, $dbh, - $keyname, $tablenames, $fieldnames, $joins_ref, $order) = @_; - # $tablenames and $fieldnames are comma-separated lists (a string) - my($self) = bless {}, $class; - $self->{dbh} = $dbh; # save DBI handle - for my $n (1..6) { # prepare select statements with different no. of args - my($sel) = sprintf("SELECT %s FROM %s", - join(',', $keyname, split(/\s*,\s*/,$fieldnames,-1)), - $tablenames); - my(@where) = sprintf("%s IN (%s)", $keyname, join(',', ('?')x$n ) ); - $sel .= ' WHERE '.join(' AND ', - map{"($_)"} @$joins_ref,@where) if @$joins_ref+@where; - $sel .= ' ORDER BY '.$order if $order ne ''; - do_log(5,"SQL prepare: ".$sel); - $self->{"sth$n"} = $dbh->prepare($sel); $self->{keyname} = $keyname; - } - $self; -} - -# lookup_sql() performs a lookup for an e-mail address against a SQL map. -# If a match is found it returns whatever the map returns (a reference -# to a hash containing values of requested fields), otherwise returns undef. -# A match aborts further fetching sequence. -# -# SQL lookups (e.g. for user+foo@example.com) are performed in order -# which can be requested by 'ORDER BY' in the SELECT statement, -# otherwise it is unspecified, which is only useful if just specific entries -# exist in a database (full address, not only domain part or mailbox part). -# -# The following order is recommended: -# - lookup for user+foo@example.com -# - lookup for user@example.com (only if $recipient_delimiter nonempty) -# - lookup for user+foo (only if domain part is local) -# - lookup for user (only local; only if $recipient_delimiter is nonempty) -# - lookup for @example.com -# - lookup for @. (catchall) -# NOTE: -# this is different from hash and ACL lookups in three important aspects: -# - naked key (without '@') implies mailbox name, not domain name; -# - subdomains are not looked at, only full domain names are matched; -# - the naked mailbox name lookups are only performed when the domain part -# matches the '@local_domains' ACL, or the full address matches -# the $local_domains_re regexp list. -# -# The domain part is always lowercased when constructing a key, -# the localpart is not lowercased when $localpart_is_case_sensitive is true. -# -sub lookup_sql($$) { - my($self,$addr) = @_; - if (exists $self->{cache} && exists $self->{cache}->{$addr}) { # cached ? - my($match) = $self->{cache}->{$addr}; - if (!defined($match)) { - do_log(5, "lookup_sql (cached): \"$addr\" no match"); - } else { - do_log(5, "lookup_sql (cached): \"$addr\" matches, result=(". - join(", ", map {$_.'=>"'.$match->{$_}.'"'} sort keys(%$match)) - .")" ); - } - return $match; - } - my($localpart,$domain) = split_address($addr); - $domain = lc($domain); - $localpart = lc($localpart) if !$localpart_is_case_sensitive; - # chop off leading @, and trailing dots - $domain = $1 if $domain =~ /^\@?(.*?)\.*$/s; - my(@keys); my($extension); - if ($recipient_delimiter ne '') { - ($localpart, $extension) = - split_localpart($localpart, $recipient_delimiter); - } - push(@keys, $localpart.$recipient_delimiter.$extension.'@'.$domain) - if $extension ne ''; # user+foo@example.com - push(@keys, $localpart.'@'.$domain); # user@example.com - if (Amavis::Lookup::lookup($addr, \@local_domains, $local_domains_re)) { - push(@keys, $localpart.$recipient_delimiter.$extension) - if $extension ne ''; # user+foo - push(@keys, $localpart); # user - } - push(@keys, '@'.$domain); # @example.com - push(@keys, '@.'); # @. (catchall) - for (@keys) { $_=$1 if /^(.*)$/ } # untaint keys - do_log(5, "lookup_sql - query keys: ".join(', ', map{"\"$_\""}@keys)); - my($n) = sprintf("%d",scalar(@keys)); - my($sth) = $self->{"sth$n"}; - $sth->execute(@keys); # do the query - my($a_ref,$found,$match); $match = {}; - while ( defined($a_ref=$sth->fetch) ) { # fetch query results - my(@names) = @{$sth->{NAME_lc}}; - $found = 1; $match = {}; @$match{@names} = @$a_ref; - my($keyname) = @names[0]; my($keyvalue) = $a_ref->[0]; - do_log(5, "lookup_sql: key($keyname)=\"$keyvalue\" matches, result=(". - join(", ", map {$_.'=>"'.$match->{$_}.'"'} @names) .")" ); - last if $found; # first match wins, the loop is for possible future use - } - $sth->finish(); - if (!$found) { - $match = undef; - do_log(5, "lookup_sql, no match"); - } - # save for future use, but only within processing of this message - $self->{cache}->{$addr} = $match; - section_time('lookup_sql'); - $match; -} - -1; - -# -package Amavis::Lookup::SQLfield; -use strict; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - @ISA = qw(Exporter); -} -BEGIN { import Amavis::Util qw(do_log) } - -sub new($$$;$) { - my($class, $sql_query,$fieldname, $fieldtype) = @_; - return undef if !defined($sql_query); - my($self) = bless {}, $class; - $self->{sql_query} = $sql_query; - $self->{fieldname} = lc($fieldname); - $self->{fieldtype} = uc($fieldtype); # B=boolean, N=numeric, other:string - $self; -} - -sub lookup_sql_field($$) { - my($self,$addr) = @_; - my($match); - if (!defined($self)) { - do_log(5, "lookup_sql_field - undefined, no match"); - } else { - my($field) = $self->{fieldname}; - if (!defined($self->{sql_query})) { - do_log(5, "lookup_sql_field($field) - null query, no match"); - } else { - my($h_ref) = $self->{sql_query}->lookup_sql($addr); - if (!defined($h_ref)) { - do_log(5, "lookup_sql_field($field), no match"); - } elsif (!exists($h_ref->{$field})) { - $match = 1; # a special case: just a key present and no fields - do_log(5, "lookup_sql_field($field) (no such field), ". - "matches, result=$match"); - } else { - $match = $h_ref->{$field}; my($found) = defined $match; - if (!defined($match)) { # keep undef for NULL field values - } elsif ($self->{fieldtype} eq 'B') { # boolean - # convert values 'N' 'F' and ' ' to 0 - # to allow value to be used directly as a Perl boolean - $match = 0 if $match =~ /^\s*[NnFf ]\s*$/; - } elsif ($self->{fieldtype} eq 'N') { # numeric - $match = $match + 0; # unify different numeric forms - } elsif ($self->{fieldtype} eq 'S') { # string - $match =~ s/ +$//; # trim trailing spaces - } - do_log(5, "lookup_sql_field($field)" . - (!$found ? ", no match" : " matches, result=$match") ); - } - } - } - $match; -} -1; - -# package Amavis::Lookup::RE; use strict; BEGIN { @@ -1896,7 +1664,7 @@ # per-recipient data are kept in an array of n-tuples: # (recipient-address, destiny, done, smtp-response-text, remote-mta, ...) sub new # NOTE: this class is a list, not hash - { my($class) = @_; bless [(undef) x 6], $class } + { my($class) = @_; bless [(undef) x 8], $class } # subs to set or access individual elements of a n-tuple by name sub recip_addr # recipient envelope e-mail address @@ -1909,8 +1677,12 @@ { my($self)=shift; !@_ ? $$self[3] : ($$self[3]=shift) } sub recip_smtp_response # rfc2821 response (3-digit + enhanced resp + text) { my($self)=shift; !@_ ? $$self[4] : ($$self[4]=shift) } -sub recip_remote_mta # remote MTA that issued the smtp response +sub recip_remote_mta_smtp_response # smtp response as issued by remote MTA { my($self)=shift; !@_ ? $$self[5] : ($$self[5]=shift) } +sub recip_remote_mta # remote MTA that issued the smtp response + { my($self)=shift; !@_ ? $$self[6] : ($$self[6]=shift) } +sub recip_mbxname # mailbox file name when delivered to 'local:' + { my($self)=shift; !@_ ? $$self[7] : ($$self[7]=shift) } sub recip_final_addr { # return recip_addr_modified if set, else recip_addr my($self)=shift; @@ -1966,6 +1738,8 @@ { my($self)=shift; !@_ ? $self->{orig_bdy_s} : ($self->{orig_bdy_s}=shift) } sub body_digest # message digest of original body { my($self)=shift; !@_ ? $self->{body_digest}: ($self->{body_digest}=shift) } +sub quarantined_to # list of quarantine mailbox names or addresses if quarantined + { my($self)=shift; !@_ ? $self->{quarantine} : ($self->{quarantine}=shift) } # The order of entries in the list is the original order in which # recipient addresses (e.g. obtained via 'MAIL TO:') were received. @@ -2222,6 +1996,7 @@ # (lazy) evaluation when some part of the pair is not yet known # at initialization time. + my($mbxname, $suggested_filename); { # a block is used as a 'switch' statement - 'last' will exit from it if (!exists $local_delivery_aliases{$localpart}) { do_log(2, "skip local delivery(1): <$sender> -> <$recip>"); @@ -2229,7 +2004,6 @@ last; # exit block, not the loop } my($alias) = $local_delivery_aliases{$localpart}; - my($mbxname, $suggested_filename); if (ref($alias) eq 'ARRAY') { ($mbxname, $suggested_filename) = @$alias; } elsif (ref($alias) eq 'CODE') { # lazy evaluation @@ -2349,6 +2123,7 @@ $smtp_response .= ", id=" . am_id(); $r->recip_smtp_response($smtp_response); $r->recip_done(2); + $r->recip_mbxname($mbxname) if defined $mbxname; section_time('save-to-local-mailbox'); } } @@ -2493,6 +2268,8 @@ $smtp_msg =~ s/\s+$//; # trim trailing white space my($smtp_resp) = "$smtp_code $smtp_msg"; do_log(5, "response to RCPT TO: \"$smtp_resp\""); + $r->recip_remote_mta($relayhost); + $r->recip_remote_mta_smtp_response($smtp_resp); if ($smtp_resp =~ /^ (\d{3}) \s+ ([245] \. \d{1,3} \. \d{1,3})? \s* (.*) $/xs) { my($resp_code,$resp_enhcode,$resp_msg) = ($1,$2,$3); @@ -2502,7 +2279,6 @@ } } $r->recip_smtp_response($smtp_resp); - $r->recip_remote_mta($relayhost); $r->recip_done(2); } } @@ -2549,6 +2325,11 @@ $smtp_msg =~ s/\s+$//; # trim trailing white space $smtp_response = "$smtp_code $smtp_msg"; do_log(5, "response to data end: \"$smtp_response\""); + for my $r (@per_recip_data) { + next if $r->recip_done; + $r->recip_remote_mta($relayhost); + $r->recip_remote_mta_smtp_response($smtp_response); + } if ($smtp_response =~ /^[245]/) { $smtp_response = sprintf("%s %d.6.0 %s, id=%s, from MTA: %s", $smtp_code, $smtp_status, @@ -2613,7 +2394,6 @@ for my $r (@per_recip_data) { next if $r->recip_done; $r->recip_smtp_response($smtp_response); - $r->recip_remote_mta($relayhost); $r->recip_done(2); } } @@ -2650,11 +2430,20 @@ my(@pipe_args) = split(' ',$pipe_args); my(@command) = shift @pipe_args; for (@pipe_args) { + # The sendmail command line expects addresses quoted as per RFC 822. + # "funny user"@some.domain + # For compatibility with Sendmail, the Postfix sendmail command line + # also accepts address formats that are legal in RFC 822 mail headers: + # Funny Dude <"funny user"@some.domain> + # Although addresses passed as args to sendmail initial submission + # should not be <...> bracketed, for some reason original sendmail + # issues a warning on null reverse-path, but gladly accepty <>. + # As this is not strictly wrong, we comply to make it happy. if (/^\${sender}$/i) { - push(@command, map { $_ eq '' ? '' : quote_rfc2821_local($_) } + push(@command, map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } $msginfo->sender); } elsif (/^\${recipient}$/i) { - push(@command, map { $_ eq '' ? '' : quote_rfc2821_local($_) } + push(@command, map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } map { $_->recip_final_addr } @per_recip_data); } else { push(@command, $_) } } @@ -2663,11 +2452,6 @@ my($pid) = open(MP, '|-'); defined($pid) or die "Can't fork: $!"; if (!$pid) { # child - # The sendmail command line expects addresses quoted as per RFC 822. - # "funny user"@some.domain - # For compatibility with Sendmail, the Postfix sendmail command line - # also accepts address formats that are legal in RFC 822 mail headers: - # Funny Dude <"funny user"@some.domain> exec(@command); exec('/bin/false');# must not exit, we have to avoid DESTROY handlers exit EX_TEMPFAIL; # just in case @@ -3049,11 +2833,13 @@ if (@$pe_lines>5 || "@$pe_lines" !~ m(^[a-zA-Z0-9/\@:;,. \t\n_-]*$)s) { my($newpart) = "$tempdir/parts/" . getfilename(); open(PRE, ">$newpart") or die "Can't create $pe_name $newpart: $!"; + my($len); for (@$pe_lines) { print PRE $_ or die "Can't write $pe_name to $newpart: $!"; - consumed_bytes(length($_),'mime_decode_pre_epi'); + $len += length($_); } close(PRE) or die "Can't close $pe_name $newpart: $!"; + consumed_bytes($len,'mime_decode_pre_epi'); } } } @@ -3067,6 +2853,7 @@ $parser->filer(Amavis::Unpackers::OurFiler->new( "$tempdir/parts", $file_generator_object)); $parser->ignore_errors(1); # also is the default +# $parser->extract_nested_messages(0); $parser->extract_nested_messages("NEST"); # parse embedded message/rfc822 $parser->extract_uuencode(1); my($entity); @@ -3194,7 +2981,7 @@ /^(ASCII|text|uuencoded|xxencoded|binhex)/i and $ty = '.asc'; ### 'file' is a bit too trigger happy to claim something is 'mail text' -# /mail text/i and $ty = '.mail'; +# /RFC 822 mail text/ and $ty = '.mail'; /^ISO-8859.*\btext/i and $ty = '.txt'; /^Non-ISO.*ASCII\b.*\btext/i and $ty = '.txt'; @@ -3887,7 +3674,7 @@ $builtins_ref, $template_ref) = @_; my($dsn_time) = time; # time of dsn creation - now my($notification); - if ($msginfo->sender eq '') { # must not respond to null return path + if ($msginfo->sender eq '') { # must not respond to null reverse path do_log(4, "Not sending DSN to empty return path"); } elsif ($msginfo->sender_contact eq '') { do_log(4, "Not sending DSN to believed-to-be-faked return path"); @@ -3941,8 +3728,13 @@ $msg .= "Action: " . ($smtp_resp_class eq '2' ? 'delivered' : 'failed') . "\n"; $msg .= "Status: $smtp_resp_enhcode\n"; - $msg .= "Diagnostic-Code: smtp; $smtp_resp\n"; - $msg .= "Remote-MTA: dns; $remote_mta\n" if $remote_mta ne ''; + my($rem_smtp_resp) = $r->recip_remote_mta_smtp_response; + if ($remote_mta eq '' || $rem_smtp_resp eq '') { + $msg .= "Diagnostic-Code: smtp; $smtp_resp\n"; + } else { + $msg .= "Remote-MTA: dns; $remote_mta\n"; + $msg .= "Diagnostic-Code: smtp; $rem_smtp_resp\n"; + } $msg .= "Last-Attempt-Date: " . rfc2822_timestamp($dsn_time) ."\n"; } return $notification if !$any; # don't bother, we won't be sending DSN @@ -3953,7 +3745,7 @@ : "amavisd-new "; # rfc1894: The From field of the message header of the DSN SHOULD contain # the address of a human who is responsible for maintaining the mail system -# at the Reporting MTA site (e.g. Postmaster), so that a reply to the +# at the Reporting MTA site (e.g. Postmaster), so that a reply to the # DSN will reach that person. # use the provided template text @@ -4030,7 +3822,6 @@ use Digest::MD5; use Net::Server 0.83; use Net::Server::PreForkSimple; -use DBI; BEGIN { import Amavis::Conf qw(:confvars :notifyconf :sa); @@ -4059,7 +3850,7 @@ delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; -use vars qw($extra_code_in_amcl $extra_code_in_smtp +use vars qw($extra_code_sql $extra_code_in_amcl $extra_code_in_smtp $extra_code_antivirus $extra_code_antispam); use vars qw($spam_level $spam_status $spam_report); @@ -4152,58 +3943,6 @@ 1; } -# "safely" connect to a database. take a list of database connection -# parameters and try each until one succeeds. -# -- based on code from Ben Ransford 2002-09-22 -sub connect_to_sql(@) { - my(@dsns) = @_; # a list of DSNs to try connecting to sequentially - my($dbh); - for my $tmpdsn (@dsns) { - my($dsn, $username, $password) = @$tmpdsn; - do_log(5, "connect_to_sql: trying '$dsn'"); - $dbh = DBI->connect($dsn, $username, $password, - {PrintError => 0, RaiseError => 0, Taint => 1} ); - if ($dbh) { do_log(5,"connect_to_sql: '$dsn' succeeded"); last } - do_log(0, "connect_to_sql: unable to connect to DSN '$dsn'"); - } - do_log(0, "connect_to_sql: unable to connect to any DSN at all!" - ) if !$dbh && @dsns>1; - $dbh; -} - -# connect to the SQL server and prepare queries -# (called at the beginning of child's life from process_request) -sub prepare_sql_queries() { - return if !@lookup_sql_dsn; - my($sql_dbh) = connect_to_sql(@lookup_sql_dsn); - section_time('sql-connect'); - if (!defined($sql_dbh)) { - do_log(0, "Error connecting to database, SQL lookups disabled: " . - $DBI::errstr); - } else { - $sql_dbh->{'RaiseError'} = 1; - # prepare SELECT statements - my($sql) = Amavis::Lookup::SQL->new($sql_dbh, - 'users.email', 'users, policy', 'policy.*', - ['users.policy_id=policy.id'], 'users.priority DESC'); - # prepare lookup objects with incorporated field names - $virus_lovers_sql = - Amavis::Lookup::SQLfield->new($sql, 'virus_lover', 'B'); - $banned_files_lovers_sql = - Amavis::Lookup::SQLfield->new($sql, 'banned_file_lover', 'B'); - $bypass_virus_checks_sql = - Amavis::Lookup::SQLfield->new($sql, 'bypass_virus_checks','B'); - $bypass_spam_checks_sql = - Amavis::Lookup::SQLfield->new($sql, 'bypass_spam_checks', 'B'); - $spam_tag_level_sql = - Amavis::Lookup::SQLfield->new($sql, 'spam_tag_level', 'N'); - $spam_kill_level_sql = - Amavis::Lookup::SQLfield->new($sql, 'spam_kill_level', 'N'); - section_time('sql-prepare'); - } - undef @lookup_sql_dsn; # destroy sensitive information -} - ### The heart of the program ### user customizable Net::Server hook sub process_request { @@ -4217,9 +3956,15 @@ local $SIG{ALRM} = sub { die "timed out\n" }; # do not modify the sig text! eval { alarm($child_timeout); - - prepare_sql_queries() if $child_invocation_count == 1; - + if ($extra_code_sql && @lookup_sql_dsn && $child_invocation_count==1) { + my($sql) = Amavis::Lookup::SQL::prepare_sql_queries( + [ \$virus_lovers_sql, 'virus_lover', 'B'], + [ \$banned_files_lovers_sql, 'banned_file_lover', 'B'], + [ \$bypass_virus_checks_sql, 'bypass_virus_checks','B'], + [ \$bypass_spam_checks_sql, 'bypass_spam_checks', 'B'], + [ \$spam_tag_level_sql, 'spam_tag_level', 'N'], + [ \$spam_kill_level_sql, 'spam_kill_level', 'N'] ); + } my($conn) = Amavis::In::Connection->new; $CONN = $conn; # ugly - save in a global @@ -4364,11 +4109,7 @@ # FIRST: what kind of e-mail did we get? call content scanners # already in cache? - if (!grep {!lookup($_,\%bypass_checks,\@bypass_checks_acl)} @recips) { - $which_section = "bypass"; # skip all content checks - do_log(1, "BYPASS checks for recip " . - join(",",map {"<$_>"}@recips)); - } elsif (defined($body_digest) && exists($scan_cache{$body_digest})) { + if (defined($body_digest) && exists($scan_cache{$body_digest})) { # cached $which_section = "cached"; do_log(1, "cached $body_digest from <".$msginfo->sender.">"); @@ -4477,7 +4218,6 @@ Amavis::AV::virus_scan($tempdir, $child_task_count==1); @virusname = @$virusname_list; # copy }; - section_time('AV-scan'); prolong_timer($which_section, $remaining_time); # restart the timer if ($@ ne '') { chomp($@); @@ -4513,25 +4253,8 @@ } } } - - $msginfo->sender_contact($msginfo->sender); # save the original addr - $msginfo->sender_source($msginfo->sender); # save the original addr - # ensure we have $entity defined when we expect we'll need it - if (@virusname) { - # if the result was cached, header hasn't been parsed yet, - # but we need it to construct notifications - if (!defined($msginfo->mime_entity)) { - $which_section = "mime_decode"; - $msginfo->mime_entity(mime_decode($fh,$tempdir)); - prolong_timer($which_section); - } - # best attempt at determining true sender of the junk - normally - # the same as envelope sender - my($sender_contact,$sender_source) = best_try_originator( - $msginfo->sender, $msginfo->mime_entity, \@virusname); - $msginfo->sender_contact($sender_contact); # save it - $msginfo->sender_source($sender_source); # save it - } + $msginfo->sender_contact($msginfo->sender); # store the original addr + $msginfo->sender_source($msginfo->sender); # store the original addr # SECOND: now that we know what we got, decide what to do with it @@ -4591,6 +4314,7 @@ } } $which_section = "virus_or_banned quar+notif"; + ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); do_virus($conn,$msginfo); # send notifications, quarantine it } else { # not a virus, perhaps some recipients consider it spam? @@ -4637,8 +4361,11 @@ } } $considered_spam_by_some_recips = scalar(@offended_recips); - $which_section = "spam quar+notif"; - do_spam($conn,$msginfo) if $considered_spam_by_some_recips; + if ($considered_spam_by_some_recips) { + $which_section = "spam quar+notif"; + ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); + do_spam($conn,$msginfo); + } } # THIRD: now that we know what to do with it, do it! @@ -4672,7 +4399,10 @@ ($smtp_resp, $exit_code, $dsn_needed) = one_response_for_all($msginfo); if ($dsn_needed && !$dsn_per_recip_capable || $warnvirussender && @virusname || - $warnspamsender && $considered_spam_by_some_recips) { + $warnspamsender && $considered_spam_by_some_recips) + { + # need header parsed + ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); # generate delivery status notification according to rfc1892 # and rfc1894, but only if necessary my($notification) = delivery_status_notification( @@ -4684,7 +4414,7 @@ mail_dispatch($notify_method,$notification,1); # send delivery notification my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = one_response_for_all($notification); # check status - # if dsn can not be delivered, try to send it to postmaster + # if dsn can not be sent, try to send it to postmaster if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) { # double bounce? do_log(0, "DOUBLE BOUNCE: can not send DSN: $n_smtp_resp"); $notification->recips(['postmaster']); @@ -4724,6 +4454,27 @@ ($smtp_resp,$exit_code,$preserve_evidence); } +# Ensure we have $msginfo->$entity defined when we expect we'll need it, +# e.g. to construct notifications. While at it, also get us some additional +# information on sender from the header. +# +sub ensure_mime_entity($$$$) { + my($msginfo,$fh,$tempdir,$virusname_list) = @_; + if (!defined($msginfo->mime_entity)) { + # header may not have been parsed yet, e.g. if the result was cached + $msginfo->mime_entity(mime_decode($fh,$tempdir)); + prolong_timer("ensure_mime_entity"); + } + # best attempt at determining true sender of the junk - normally + # the same as envelope sender, unless certain viruses mangle it + if (@$virusname_list) { + my($sender_contact,$sender_source) = best_try_originator( + $msginfo->sender, $msginfo->mime_entity, $virusname_list); + $msginfo->sender_contact($sender_contact); # save it + $msginfo->sender_source($sender_source); # save it + } +} + sub add_forwarding_header_edits_common($$$$) { my($conn, $msginfo, $hdr_edits, $hold) = @_; @@ -4794,15 +4545,15 @@ my($key) = join("\000", $do_tag, $do_kill, $spam_level_bar, $full_spam_status); if ($first) { - do_log(5, "headers CLUSTERING: NEW CLUSTER <$recip>: $do_tag, $do_kill"); + do_log(5, "headers CLUSTERING: NEW CLUSTER <$recip>: tag=$do_tag, kill=$do_kill"); $cluster_key = $key; } elsif ($key eq $cluster_key) { do_log(5, "headers CLUSTERING: <$recip> joining cluster"); } else { - do_log(5, "headers CLUSTERING: skipping <$recip> ($do_tag, $do_kill)" ); + do_log(5, "headers CLUSTERING: skipping <$recip> (tag=$do_tag, kill=$do_kill)" ); next; } - if ($do_tag || $do_kill) { + if ($first && ($do_tag || $do_kill)) { $hdr_edits->delete_header('X-Spam-Status'); $hdr_edits->delete_header('X-Spam-Level'); $hdr_edits->delete_header('X-Spam-Flag'); @@ -4861,6 +4612,12 @@ # abort if quarantining not successful die "Can not quarantine: '$n_smtp_resp'"; } + my(@qa); # list of quarantine mailboxes or addresses + for my $r (@{$quar_msg->per_recip_data}) { + my($addr) = $r->recip_final_addr; + push(@qa, $addr=~/\@/ ? $addr : $r->recip_mbxname); + } + $msginfo->quarantined_to(\@qa); do_log(5, "DO_QUARANTINE done"); } @@ -4977,7 +4734,7 @@ push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr; } if (!@q_addr) { - do_log(0, sprintf("spam from=<%s>, to=%s, %s", + do_log(0, sprintf("SPAM, <%s> -> %s, %s", $msginfo->sender_source, join(',', map{"<$_>"} @{$msginfo->recips}), $s)); @@ -4988,7 +4745,7 @@ $hdr_edits->append_header('X-Spam-Level', '*' x (min( max(int($spam_level+0.5),0), 40) )); do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr); - do_log(0, sprintf("spam from=<%s>, to=%s, %s, quarantine %s (%s)", + do_log(0, sprintf("SPAM, <%s> -> %s, %s, quarantine %s (%s)", $msginfo->sender_source, join(',', map{"<$_>"} @{$msginfo->recips}), $s, $VIRUSFILE, join(',',@q_addr) )); @@ -5012,7 +4769,7 @@ ? qquote_rfc2821_local($mailfrom_notify_spamadmin) : "amavisd-new "; $notification->mail_text(string_to_mime_entity( - expand(\$notify_virus_admin_templ,\%mybuiltins) )); + expand(\$notify_spam_admin_templ,\%mybuiltins) )); $notification->header_edits($hdr_edits); mail_dispatch($notify_method,$notification,1); my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = @@ -5063,15 +4820,6 @@ $signature; } -# Obtain Message-ID header -sub get_msg_id($) { - my($entity) = @_; - my($msgid); - if (defined $entity) - { $msgid = $entity->head->get("Message-ID"); chomp($msgid) } - $msgid; -} - sub find_program_path($$) { my($fv_list, $path_list_ref) = @_; $fv_list = [$fv_list] if !ref $fv_list; @@ -5112,7 +4860,8 @@ } } for my $f (@av_scanners) { # map program name hints to full paths - if (ref($f->[1]) eq 'CODE') { + if (!defined $f || !ref $f) { # empty, skip + } elsif (ref($f->[1]) eq 'CODE') { do_log(0, "Using internal av scanner code for ".$f->[0]); } else { my($found) = $f->[1] = find_program_path($f->[1],$path_list_ref); @@ -5138,7 +4887,8 @@ # do{ local($/) = "__DATA__\n"; # set line terminator to this string map { chomp($_ = ) } - ($extra_code_in_amcl, $extra_code_in_smtp, + ($extra_code_sql, + $extra_code_in_amcl, $extra_code_in_smtp, $extra_code_antivirus, $extra_code_antispam, $log_templ, $notify_sender_templ, @@ -5177,6 +4927,11 @@ # Master configuration +if (!@lookup_sql_dsn) { $extra_code_sql = undef } +else { + eval $extra_code_sql or die "Problem in the Lookup::SQL code: $@"; + $extra_code_sql = 1; # release memory occupied by the source code +} if ($unix_socketname eq '') { $extra_code_in_amcl = undef } else { eval $extra_code_in_amcl or die "Problem in the In::AMCL code: $@"; @@ -5190,18 +4945,18 @@ if (!@av_scanners) { $extra_code_antivirus = undef; -} elsif (lookup("\001", \%bypass_virus_checks, \@bypass_virus_checks_acl, - $bypass_virus_checks_re)) { - # do a simple test which (by using an impossible domain) - # which should indicate if the lookup tables contain a catchall +} elsif (!%bypass_virus_checks && + @bypass_virus_checks_acl==1 && @bypass_virus_checks_acl[0] eq '.') { + # do a simple-minded test to make it easy to turn off virus checks $extra_code_antivirus = undef; } else { eval $extra_code_antivirus or die "Problem in the antivirus code: $@"; $extra_code_antivirus = 1; # release memory occupied by the source code } -if (lookup("\001", \%bypass_spam_checks, \@bypass_spam_checks_acl, - $bypass_spam_checks_re)) { +if (!%bypass_spam_checks && + @bypass_spam_checks_acl==1 && @bypass_spam_checks_acl[0] eq '.') { + # do a simple-minded test to make it easy to turn off spam checks $extra_code_antispam = undef; } else { eval $extra_code_antispam or die "Problem in the antispam code: $@"; @@ -5249,6 +5004,7 @@ MIME::Decoder::NBit MIME::Decoder::QuotedPrint MIME::Decoder::UU ); # auto::POSIX::setgid auto::POSIX::setuid +push(@modules, 'DBI') if $extra_code_sql; my(@missing); for my $m (@modules) { $_ = $m; $_ .= /^auto::/ ? '.al' : '.pm'; s[::][/]g; @@ -5256,6 +5012,18 @@ } die "ERROR: MISSING REQUIRED MODULES: ".join(", ",@missing)."\n" if @missing; +# load optional module SAVI if available and desired +if ($extra_code_antivirus) { + my($savi); my($first)=1; + for (grep {ref($_) eq 'ARRAY' && $_->[0] eq 'Sophos SAVI' } @av_scanners) { + if ($first) { + eval {require SAVI} and $savi = Amavis::AV::sophos_savi_init(@$_); + } + if (!defined $savi) { $_->[1] = undef } else { $_->[2] = $savi }; + $first = 0; + } +} + Amavis::Log::init("amavis", !$daemonize, $DO_SYSLOG, $SYSLOG_LEVEL, $LOGFILE, $log_level); @@ -5265,6 +5033,7 @@ $extra_code_in_smtp = undef; } do_log(1, "Found myself: $amavisd_path -c $config_file"); +do_log(1, "Lookup::SQL code ".($extra_code_sql ?'':" NOT")." loaded"); do_log(1, "AMCL-in protocol code ".($extra_code_in_amcl?'':" NOT")." loaded"); do_log(1, "SMTP-in protocol code ".($extra_code_in_smtp?'':" NOT")." loaded"); do_log(1, "ANTI-VIRUS code ".($extra_code_antivirus?'':" NOT")." loaded"); @@ -5301,15 +5070,18 @@ D => sub {my($y,$n)=delivery_short_report($MSGINFO); $y}, # short dns: succ N => sub {my($y,$n)=delivery_short_report($MSGINFO); $n}, # short dns: fail t => sub {first_received_from($MSGINFO->mime_entity)}, # first entry in the Received: trace - m => sub {get_msg_id($MSGINFO->mime_entity)}, # Message-ID of the message + m => sub { local($_) = $MSGINFO->mime_entity; # Message-ID of the message + if (defined) { $_ = $_->head->get("Message-ID"); chomp; $_ } }, + j => sub { local($_) = $MSGINFO->mime_entity; # Subject of the message + if (defined) { $_ = $_->head->get("Subject"); chomp; $_ } }, n => \&am_id, # amavis internal message id (for log entries) i => sub {$VIRUSFILE}, # some quarantine id, e.g. quarantine filename - q => sub { $virus_quarantine_to =~ /\@/ ? $virus_quarantine_to - : (-d $QUARANTINEDIR ? "$QUARANTINEDIR/$VIRUSFILE" - : $QUARANTINEDIR) }, - v => sub {$av_output}, # scanner output, usually a list of viruses - F => sub {\@banned_filename}, # list of banned file names + q => sub {$MSGINFO->quarantined_to}, # list of quarantine mailboxes +# q => sub {map {my($q)=$_; $q=~s[^.*/([^/]+)$][$1]; $q} # basename +# $MSGINFO->quarantined_to}, # list of quarantine mailboxes + v => sub {[split(/[ \t]*\r?\n/,$av_output)]}, # anti-virus scanner output V => sub {\@virusname}, # list of virus names + F => sub {\@banned_filename}, # list of banned file names H => sub {[map {my $h=$_; chomp($h); $h} @{$MSGINFO->orig_header}]},# orig hdr A => sub {[split(/\n/, $spam_report)]}, # SpamAssassin report lines # macros f, T, C, B will be defined by each warn_* as appropriate @@ -5389,6 +5161,240 @@ # of special characters (e.g. \ or ') by Perl # __DATA__ + +# +package Amavis::Lookup::SQLfield; +use strict; +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + @ISA = qw(Exporter); +} +BEGIN { import Amavis::Util qw(do_log) } + +sub new($$$;$) { + my($class, $sql_query,$fieldname, $fieldtype) = @_; + return undef if !defined($sql_query); + my($self) = bless {}, $class; + $self->{sql_query} = $sql_query; + $self->{fieldname} = lc($fieldname); + $self->{fieldtype} = uc($fieldtype); # B=boolean, N=numeric, other:string + $self; +} + +sub lookup_sql_field($$) { + my($self,$addr) = @_; + my($match); + if (!defined($self)) { + do_log(5, "lookup_sql_field - undefined, no match"); + } else { + my($field) = $self->{fieldname}; + if (!defined($self->{sql_query})) { + do_log(5, "lookup_sql_field($field) - null query, no match"); + } else { + my($h_ref) = $self->{sql_query}->lookup_sql($addr); + if (!defined($h_ref)) { + do_log(5, "lookup_sql_field($field), no match"); + } elsif (!exists($h_ref->{$field})) { + $match = 1; # a special case: just a key present and no fields + do_log(5, "lookup_sql_field($field) (no such field), ". + "matches, result=$match"); + } else { + $match = $h_ref->{$field}; my($found) = defined $match; + if (!defined($match)) { # keep undef for NULL field values + } elsif ($self->{fieldtype} eq 'B') { # boolean + # convert values 'N' 'F' and ' ' to 0 + # to allow value to be used directly as a Perl boolean + $match = 0 if $match =~ /^\s*[NnFf ]\s*$/; + } elsif ($self->{fieldtype} eq 'N') { # numeric + $match = $match + 0; # unify different numeric forms + } elsif ($self->{fieldtype} eq 'S') { # string + $match =~ s/ +$//; # trim trailing spaces + } + do_log(5, "lookup_sql_field($field)" . + (!$found ? ", no match" : " matches, result=$match") ); + } + } + } + $match; +} + +1; + +# +package Amavis::Lookup::SQL; +use strict; +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + $VERSION = '1.00'; + @ISA = qw(Exporter); + @EXPORT_OK = qw(&prepare_sql_queries); +} +use subs @EXPORT_OK; + +use DBI; + +BEGIN { + import Amavis::Util qw(do_log); + import Amavis::Conf qw(:confvars); + import Amavis::Timing qw(section_time); + import Amavis::rfc2821_2822_Tools qw(split_address split_localpart); +} + +# Connect to a database. Take a list of database connection +# parameters and try each until one succeeds. +# -- based on code from Ben Ransford 2002-09-22 +sub connect_to_sql(@) { + my(@dsns) = @_; # a list of DSNs to try connecting to sequentially + my($dbh); + for my $tmpdsn (@dsns) { + my($dsn, $username, $password) = @$tmpdsn; + do_log(5, "connect_to_sql: trying '$dsn'"); + $dbh = DBI->connect($dsn, $username, $password, + {PrintError => 0, RaiseError => 0, Taint => 1} ); + if ($dbh) { do_log(5,"connect_to_sql: '$dsn' succeeded"); last } + do_log(0, "connect_to_sql: unable to connect to DSN '$dsn'"); + } + do_log(0, "connect_to_sql: unable to connect to any DSN at all!" + ) if !$dbh && @dsns>1; + $dbh; +} + +# connect to the SQL server and prepare queries +# (called at the beginning of child's life from process_request) +sub prepare_sql_queries() { + my(@fields) = @_; + my($sql_dbh) = connect_to_sql(@lookup_sql_dsn); + section_time('sql-connect'); + if (!defined($sql_dbh)) { + do_log(0, "Error connecting to database, SQL lookups disabled: " . + $DBI::errstr); + } else { + $sql_dbh->{'RaiseError'} = 1; + # prepare SELECT statements + my($sql) = Amavis::Lookup::SQL->new($sql_dbh, + 'users.email', 'users, policy', 'policy.*', + ['users.policy_id=policy.id'], 'users.priority DESC'); + # prepare lookup objects with incorporated field names + for my $f (@fields) { + my($var_ref, $f_name, $f_type) = @$f; + $$var_ref = Amavis::Lookup::SQLfield->new($sql, $f_name, $f_type); + } + section_time('sql-prepare'); + } + undef @lookup_sql_dsn; # destroy sensitive information +} + +sub new($$$$$$) { + my($class, $dbh, + $keyname, $tablenames, $fieldnames, $joins_ref, $order) = @_; + # $tablenames and $fieldnames are comma-separated lists (a string) + my($self) = bless {}, $class; + $self->{dbh} = $dbh; # save DBI handle + for my $n (1..6) { # prepare select statements with different no. of args + my($sel) = sprintf("SELECT %s FROM %s", + join(',', $keyname, split(/\s*,\s*/,$fieldnames,-1)), + $tablenames); + my(@where) = sprintf("%s IN (%s)", $keyname, join(',', ('?')x$n ) ); + $sel .= ' WHERE '.join(' AND ', + map{"($_)"} @$joins_ref,@where) if @$joins_ref+@where; + $sel .= ' ORDER BY '.$order if $order ne ''; + do_log(5,"SQL prepare: ".$sel); + $self->{"sth$n"} = $dbh->prepare($sel); $self->{keyname} = $keyname; + } + $self; +} + +# lookup_sql() performs a lookup for an e-mail address against a SQL map. +# If a match is found it returns whatever the map returns (a reference +# to a hash containing values of requested fields), otherwise returns undef. +# A match aborts further fetching sequence. +# +# SQL lookups (e.g. for user+foo@example.com) are performed in order +# which can be requested by 'ORDER BY' in the SELECT statement, +# otherwise it is unspecified, which is only useful if just specific entries +# exist in a database (full address, not only domain part or mailbox part). +# +# The following order is recommended: +# - lookup for user+foo@example.com +# - lookup for user@example.com (only if $recipient_delimiter nonempty) +# - lookup for user+foo (only if domain part is local) +# - lookup for user (only local; only if $recipient_delimiter is nonempty) +# - lookup for @example.com +# - lookup for @. (catchall) +# NOTE: +# this is different from hash and ACL lookups in three important aspects: +# - naked key (without '@') implies mailbox name, not domain name; +# - subdomains are not looked at, only full domain names are matched; +# - the naked mailbox name lookups are only performed when the domain part +# matches the '@local_domains' ACL, or the full address matches +# the $local_domains_re regexp list. +# +# The domain part is always lowercased when constructing a key, +# the localpart is not lowercased when $localpart_is_case_sensitive is true. +# +sub lookup_sql($$) { + my($self,$addr) = @_; + if (exists $self->{cache} && exists $self->{cache}->{$addr}) { # cached ? + my($match) = $self->{cache}->{$addr}; + if (!defined($match)) { + do_log(5, "lookup_sql (cached): \"$addr\" no match"); + } else { + do_log(5, "lookup_sql (cached): \"$addr\" matches, result=(". + join(", ", map {$_.'=>"'.$match->{$_}.'"'} sort keys(%$match)) + .")" ); + } + return $match; + } + my($localpart,$domain) = split_address($addr); + $domain = lc($domain); + $localpart = lc($localpart) if !$localpart_is_case_sensitive; + # chop off leading @, and trailing dots + $domain = $1 if $domain =~ /^\@?(.*?)\.*$/s; + my(@keys); my($extension); + if ($recipient_delimiter ne '') { + ($localpart, $extension) = + split_localpart($localpart, $recipient_delimiter); + } + push(@keys, $localpart.$recipient_delimiter.$extension.'@'.$domain) + if $extension ne ''; # user+foo@example.com + push(@keys, $localpart.'@'.$domain); # user@example.com + if (Amavis::Lookup::lookup($addr, \@local_domains, $local_domains_re)) { + push(@keys, $localpart.$recipient_delimiter.$extension) + if $extension ne ''; # user+foo + push(@keys, $localpart); # user + } + push(@keys, '@'.$domain); # @example.com + push(@keys, '@.'); # @. (catchall) + for (@keys) { $_=$1 if /^(.*)$/ } # untaint keys + do_log(5, "lookup_sql - query keys: ".join(', ', map{"\"$_\""}@keys)); + my($n) = sprintf("%d",scalar(@keys)); + my($sth) = $self->{"sth$n"}; + $sth->execute(@keys); # do the query + my($a_ref,$found,$match); $match = {}; + while ( defined($a_ref=$sth->fetch) ) { # fetch query results + my(@names) = @{$sth->{NAME_lc}}; + $found = 1; $match = {}; @$match{@names} = @$a_ref; + my($keyname) = @names[0]; my($keyvalue) = $a_ref->[0]; + do_log(5, "lookup_sql: key($keyname)=\"$keyvalue\" matches, result=(". + join(", ", map {$_.'=>"'.$match->{$_}.'"'} @names) .")" ); + last if $found; # first match wins, the loop is for possible future use + } + $sth->finish(); + if (!$found) { + $match = undef; + do_log(5, "lookup_sql, no match"); + } + # save for future use, but only within processing of this message + $self->{cache}->{$addr} = $match; + section_time('lookup_sql'); + $match; +} + +1; + +__DATA__ # package Amavis::In::AMCL; use strict; @@ -5716,7 +5722,6 @@ /^MAIL$/ && do { # begin new transaction if (defined($sender)) { $self->smtp_resp(0,"503 5.5.1 Error: nested MAIL command", 1, $cmd); - $sender = undef; @recips = (); $got_rcpt = 0; last; } # begin SMTP transaction @@ -6003,6 +6008,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '1.00'; @ISA = qw(Exporter); + @EXPORT_OK = qw(&sophos_savi_init); } use Errno qw(EPIPE ENOTCONN); @@ -6016,6 +6022,7 @@ BEGIN { import Amavis::Conf qw(:confvars); import Amavis::Util qw(do_log am_id retcode sanitize_str); + import Amavis::Timing qw(section_time); } # same args and returns as run_av() below, @@ -6034,7 +6041,9 @@ $sock->close or die "Can't close connection: $!"; do_log(2,"$av_name result: ".sanitize_str($output)); if ($output =~ /$sts_infected/) { - @virusname = $output =~ /$how_to_get_names/g; + @virusname = ref($how_to_get_names) eq 'CODE' + ? &$how_to_get_names($output) + : $output =~ /$how_to_get_names/gm; $scan_status = 1; # no errors, virus(es) } elsif ($output =~ /$sts_clean/) { $scan_status = 0; # no errors, no viruses @@ -6138,6 +6147,72 @@ ($scan_status,$output,\@virusname); } +sub sophos_savi_init { + my($av_name, $command) = @_; + my(@savi_bool_options) = qw( + FullSweep DynamicDecompression FullMacroSweep OLE2Handling + IgnoreTemplateBit VBA3Handling VBA5Handling + !OF95DecryptHandling HelpHandling DecompressVBA5 Emulation + PEHandling ExcelFormulaHandling + PowerPointMacroHandling PowerPointEmbeddedHandling ProjectHandling + ZipDecompression ArjDecompression RarDecompression UueDecompression + !GZipDecompression TarDecompression CmzDecompression HqxDecompression + MbinDecompression !LoopBackEnabled Lha SfxArchives + MSCabinet TnefAttachmentHandling MSCompress OF95DecryptHandling + !DeleteAllMacros !Vbe !ExecFileDisinfection VisioFileHandling + ); + # What about these? - set by Sophie: + # SOPHOS_MIME, SOPHOS_SCRAP_OBJECT_HANDLING, SOPHOS_SRP_STREAM_HANDLING, + # SOPHOS_OFFICE2001_HANDLING, SOPHOS_PALM_PILOT_HANDLING, + # SOPHOS_RTF, SOPHOS_HTML, SOPHOS_ELF, SOPHOS_WORDB + my($savi) = SAVI->new; + ref $savi or die "$av_name: Can't create a SAVI object, err=$savi"; + my($version) = $savi->version; + ref $version or die "$av_name: Can't get SAVI version, err=$version"; + do_log(3, sprintf("$av_name: Version %s (engine %d.%d) recognizing %d viruses\n", + $version->string, $version->major, $version->minor, $version->count)); +# for ($version->ide_list) +# { do_log(3, sprintf("$av_name: IDE %s released %s\n", $_->name, $_->date)) } + my($error) = $savi->set('MaxRecursionDepth', 16, 1); + !defined $error or die "$av_name: error setting MaxRecursionDepth: err=$error"; + for (@savi_bool_options) { + my($value) = /^!/ ? 0 : 1; s/^!+//; + $error = $savi->set($_, $value); + !defined $error or die "$av_name: Error setting $_: err=$error"; + } + $savi; +} + +# same args and returns as run_av() below +# +sub sophos_savi { + my($tempdir, $av_name, $command, $savi) = @_; + $savi = sophos_savi_init() if !defined($savi); + my($scan_status,$output,@virusname); + local(*DIR); my($f); + opendir(DIR, "$tempdir/parts") or die "$av_name: Can't open directory $tempdir/parts: $!"; + while (defined($f = readdir(DIR))) { + my($fname) = "$tempdir/parts/$f"; + next if ($f =~ /^\.\.?$/) && -d $fname; + do_log(5, "$av_name: checking $fname"); + my($result) = $savi->scan($fname); + if (!ref($result)) { # error + my($msg) = "$av_name: error scanning file $fname, " . + $savi->error_string($result) . " ($result) $!"; + # don't panic on non-fatal (encrypted, corrupted, partial) + grep{$result==$_}(514,530,538,549) ? do_log(0,$msg) : die $msg; + } elsif ($result->infected) { + my($msg) = "INFECTED $fname: " . join(", ",$result->viruses); + $output .= $msg."\n"; do_log(2,"$av_name result: $msg"); + push(@virusname, $result->viruses); $scan_status = 1; # no errors, virus(es) + } + } + closedir(DIR) or die "$av_name: Can't close directory: $!"; + if (!defined($scan_status)) { $scan_status = 0 } # no errors, no viruses + do_log(2,"$av_name result: clean") if !$scan_status; + ($scan_status,$output,\@virusname); +} + # Call a virus scanner and parse the its output. # Returns a triplet (or die in case of failure). # The first element of the triplet is interpreted as follows: @@ -6156,7 +6231,7 @@ $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 ) = @_; - $args =~ s[{}]["$tempdir/parts"]g; # replace {} with directory name + $args =~ s[{}][$tempdir/parts]g; # replace {} with directory name my($scan_status,$output,$virusnames); if (defined $pre_code) { &$pre_code(@_) } if (ref($command) eq 'CODE') { @@ -6172,14 +6247,16 @@ if (ref($sts_infected) eq 'ARRAY' ? (grep {$_==$retval} @$sts_infected) : $output =~ /$sts_infected/) { # is infected $virusnames = []; # get a list of virus names by parsing output - @$virusnames = ref($how_to_get_names) eq 'ARRAY' + @$virusnames = ref($how_to_get_names) eq 'CODE' ? &$how_to_get_names($output) - : $output =~ /$how_to_get_names/g; + : $output =~ /$how_to_get_names/gm; @$virusnames = map {defined $_ ? $_ : ()} @$virusnames; $scan_status = 1; # 'true' indicates virus found + do_log(5,"run_av: INFECTED: ".join(", ",@$virusnames)); } elsif (ref($sts_clean) eq 'ARRAY' ? (grep {$_==$retval} @$sts_clean) : $output =~ /$sts_clean/) { # is clean $scan_status = 0; # 'false' (but defined) indicates no viruses + do_log(5,"run_av: clean"); } else { do_log(0,"Virus scanner failure: $command (error code: $retval)"); } @@ -6192,15 +6269,16 @@ sub virus_scan($$) { my($tempdir,$firsttime) = @_; - my($scan_status,$output,$virusnames); my($anyone_done); my(@errors); + my($scan_status,$output,$virusnames); my($anyone_done); my(@errors); my($j); for my $av (@av_scanners) { - next if !defined $av; + next if !defined $av || !ref $av || !defined $av->[1]; eval { ($scan_status,$output,$virusnames) = run_av($tempdir,@$av) }; if ($@ ne '') { my($err) = $@; chomp($err); $err = "AV ($av->[0]) FAILED: $err"; do_log(0,$err); push(@errors,$err); }; $anyone_done++ if defined $scan_status; + $j++; section_time("AV-scan-$j"); last if $scan_status; # stop if we found a virus } if (!$anyone_done) @@ -6450,8 +6528,8 @@ [? %#N |#|The message WAS NOT delivered to:[ %N] ] -[? %v |#|Virus scanner output: - %v +[? %#v |#|Virus scanner output:[ + %v] ] [? %q |Not quarantined.|The message has been quarantined as: %q @@ -6483,12 +6561,10 @@ %o] -Please contact your system administrator for details. -[? %i || -The ID of your quarantined message is: +[? %q |Not quarantined.|The message has been quarantined as: + %q] - %i -]\ +Please contact your system administrator for details. __DATA__ # # ============================================================================= @@ -6503,8 +6579,9 @@ -> %R] was qualified as unsolicited bulk e-mail (UBE). +Subject: %j -[? %q |Not quarantined.|The message has been quarantined as ID: +[? %q |Not quarantined.|The message has been quarantined as: %q] SpamAssassin report: @@ -6527,6 +6604,7 @@ Unsolicited bulk email \ [? %o |from unknown or forged sender.|from: %o] +Subject: %j [? %t |#|According to the 'Received:' trace, the message originated at: %t