Index: amavisd =================================================================== --- amavisd (.../vendor/amavisd/20030616-p10) (revision 39233) +++ amavisd (.../branches/dev-v3.5/email/amavisd-new-20030616) (revision 39233) @@ -1,4 +1,4 @@ -#!/usr/bin/perl -T +#!/usr/bin/perl #------------------------------------------------------------------------------ # This is amavisd-new. @@ -90,28 +90,28 @@ # package Amavis::Boot; use strict; +#use Devel::DProf; # Fetch all required modules (or nicely report missing ones), and compile them # once-and-for-all at the parent process, so that forked children can inherit # and share already compiled code in memory. Children will still need to 'use' # modules if they want to inherit from their name space. # -sub fetch_modules($$@) { - my($reason,$required,@modules) = @_; +sub fetch_modules($@) { + my($reason,@modules) = @_; my(@missing); for my $m (@modules) { - local($_) = $m; $_ .= /^auto::/ ? '.al' : '.pm'; s[::][/]g; + $_ = $m; $_ .= /^auto::/ ? '.al' : '.pm'; s[::][/]g; eval {require $_} or push(@missing,$m); } die "ERROR: MISSING $reason:\n" . - join('', map {" $_\n"} @missing) if $required && @missing; + join('', map {" $_\n"} @missing) if @missing; }; BEGIN { - fetch_modules('REQUIRED BASIC MODULES', 1, qw( + fetch_modules('REQUIRED BASIC MODULES', qw( Exporter POSIX Fcntl Socket Errno Carp Time::HiRes - IO::File IO::Socket IO::Socket::UNIX IO::Socket::INET - IO::Handle IO::Wrap IO::Stringy + IO::File IO::Socket IO::Wrap IO::Stringy Digest::MD5 Unix::Syslog File::Basename File::Copy Mail::Field Mail::Address Mail::Header Mail::Internet MIME::Base64 MIME::QuotedPrint MIME::Words @@ -119,12 +119,11 @@ Net::Cmd Net::SMTP Net::Server Net::Server::PreForkSimple MIME::Decoder::Base64 MIME::Decoder::Binary MIME::Decoder::Gzip64 MIME::Decoder::NBit MIME::Decoder::QuotedPrint MIME::Decoder::UU + Barracuda::Environment + Barracuda::MIME + Barracuda::Footer ) ); - # with earlier versions of Perl one may need to add additional modules - # to the list, such as: auto::POSIX::setgid auto::POSIX::setuid ... - fetch_modules('OPTIONAL BASIC MODULES', 0, qw( - Carp::Heavy auto::POSIX::setgid auto::POSIX::setuid - ) ); + # auto::POSIX::setgid auto::POSIX::setuid }; 1; @@ -145,13 +144,23 @@ @EXPORT_OK = (); %EXPORT_TAGS = ( 'confvars' => [qw( + $set_low_priority + $default_domain + $block_pw_prot_zip + $quarantine_pw_prot_zip + $per_user_quar_enable + $per_user_scan_enable + $per_user_scoring_enable + $per_user_wblist_enable + $machine_url $myversion $mydomain $MYHOME $TEMPBASE $QUARANTINEDIR + $LARGE_MSG_HOME $DEBUG @debug_sender_acl $daemonize $pid_file $lock_file $daemon_user $daemon_group $daemon_chroot_dir $path - $DO_SYSLOG $SYSLOG_LEVEL $LOGFILE $log_level - @av_scanners @av_scanners_backup $first_infected_stops_scan + $DO_SYSLOG $SYSLOG_LEVEL $DO_SYSLOG_STATS $SYSLOG_STATS_LEVEL $DO_SYSLOG_DEBUG $SYSLOG_DEBUG_LEVEL $LOGFILE $log_level + @av_scanners @av_scanners_backup $max_servers $max_requests $child_timeout $warnvirussender $warnspamsender $warnbannedsender $warnbadhsender @@ -163,10 +172,11 @@ $mta_in_type $gets_addr_in_quoted_form $mta_out_type $forward_method $relayhost_is_client - $X_HEADER_TAG $X_HEADER_LINE $undecipherable_subject_tag + $X_HEADER_TAG $X_HEADER_LINE $remove_existing_x_scanned_headers $remove_existing_spam_headers %local_delivery_aliases - $hdr_encoding $bdy_encoding + $hdr_encoding $spf_tag_only $perform_spf_check @spf_trusted_forwarders $default_encoding $BSF_def_lang $bdy_encoding $DEFAULT_LOCALE_CHARSET + $perform_spf_check_for_dsn $final_virus_destiny $final_spam_destiny $final_banned_destiny $final_bad_header_destiny $recipient_delimiter $replace_existing_extension @@ -176,8 +186,35 @@ $MAXLEVELS $MAXFILES $MIN_EXPANSION_QUOTA $MIN_EXPANSION_FACTOR $MAX_EXPANSION_QUOTA $MAX_EXPANSION_FACTOR - $bypass_decode_parts $banned_filename_re - $keep_decoded_original_re + + $bypass_decode_parts $banned_filename_re $quarantined_filename_re + @blocked_subject_re_report + @quarantined_subject_re_report + @tagged_subject_re_report + @blocked_header_re_report + @quarantined_header_re_report + @tagged_header_re_report + @tagged_body_re_report + @quarantined_body_re_report + @blocked_body_re_report + $scana_use_bfs + $scana_use_fingerprints + $outbound_footer_attachment + @outbound_footer_exclude_email_list + $outbound_do_quarantine_ndr + $outbound_bypass_sa + $scana_quarantine_ldap_only + @whitelisted_body_re_report + @whitelisted_subject_re_report + @whitelisted_header_re_report + $tagged_subject_re + $quarantined_subject_re + $blocked_subject_re + $tagged_header_re + $quarantined_header_re + $blocked_header_re + $scan_headers_as_body $tagged_body_re $quarantined_body_re $blocked_body_re + $whitelisted_subject_re $whitelisted_header_re $whitelisted_body_re $keep_decoded_original_re %bypass_virus_checks @bypass_virus_checks_acl $bypass_virus_checks_re %bypass_spam_checks @bypass_spam_checks_acl $bypass_spam_checks_re %bypass_banned_checks @bypass_banned_checks_acl $bypass_banned_checks_re @@ -199,6 +236,14 @@ $spam_tag2_level_ldap $spam_kill_level_ldap $spam_modifies_subj_ldap $local_domains_ldap %local_domains @local_domains_acl $local_domains_re + $use_barracuda_bayes $enable_user_bayes + $syslog_emit_size + $inbound_relay_bypass_sa + $global_lines_added + $journaling_dest_addr $journaling_bounce_addr + $brts_enabled + %ndr_reason + $ndr_reason_default )], 'notifyconf' => [qw( $notify_method @@ -213,26 +258,28 @@ $hdrfrom_notify_sender $hdrfrom_notify_admin $hdrfrom_notify_spamadmin - %virus_admin %spam_admin $virus_admin $spam_admin $mailto + %virus_admin %spam_admin %quarantine_admin %pd_quarantine_email $virus_admin $spam_admin $quarantine_admin $mailto $notify_sender_templ $notify_virus_sender_templ $notify_spam_sender_templ $notify_virus_admin_templ $notify_spam_admin_templ $notify_virus_recips_templ $notify_spam_recips_templ + $notify_banned_sender_templ $notify_banned_recips_templ + $notify_policy_sender_templ $warn_offsite $virus_quarantine_to $spam_quarantine_to $spam_quarantine_bysender_to )], 'unpack' => [qw( - $file $arc $gzip $bzip2 $lzop $lha $unarj $uncompress $unfreeze - $unrar $zoo $cpio $rpm2cpio $cabextract + $arc $gzip $bzip2 $file $lha $unarj $uncompress $unrar $zoo )], 'sa' => [qw( $helpers_home - $sa_tag_level_deflt $sa_tag2_level_deflt - $sa_kill_level_deflt $sa_dsn_cutoff_level - $sa_spam_subject_tag $sa_spam_modifies_subj + $sa_tag_level_deflt $sa_quarantine_level_deflt $sa_tag2_level_deflt %sa_block_level_deflt %sa_quarantine_level_deflt %sa_tag_level_deflt $sa_kill_level_deflt + $convert_tagged_subject_2_utf8 $mime_encode_tagged_subject + $quarantine_subject_tag $quarantine_subject_fallback_tag $sa_spam_subject_tag $sa_spam_subject_fallback_tag + $sa_spam_modifies_subj $sa_local_tests_only $sa_debug $sa_mail_body_size_limit - $sa_auto_whitelist $sa_timeout + $sa_auto_whitelist )], 'platform' => [qw( $can_truncate @@ -248,8 +295,9 @@ use Errno qw(ENOENT); use vars @EXPORT; +use utf8; -$myversion = 'amavisd-new-20030616-p10'; +$myversion = 'amavisd-new-20030616'; $eol = "\n"; # native record separator in files: LF or CRLF or even CR $unicode_aware = $]>=5.008 && length("\x{263a}")==1 && eval { require Encode }; @@ -265,6 +313,9 @@ # resulting in the program to detach itself from the terminal $daemonize = 1; +# debug for scan cache +my $debug_cache = 0; + # Net::Server pre-forking settings - defaults, overruled by amavisd.conf $max_servers = 2; # number of pre-forked children $max_requests = 10; # retire a child after that many accepts @@ -321,8 +372,6 @@ # (amavisBlacklistSender=%s))', # res_filter => 'OK'}; # -# $spam_quarantine_to_ldap = {res_attr => 'amavisSpamQuarantineTo'}; -# # $local_domains_ldap = { # query_filter => '(&(objectClass=mailDomain)(dc=%m)) # res_filter => 'OK'}; @@ -330,6 +379,8 @@ # Customizable notification messages, logging $SYSLOG_LEVEL = "mail.info"; +$SYSLOG_STATS_LEVEL = "mail.notice"; +$SYSLOG_DEBUG_LEVEL = "mail.debug"; # Where to find SQL server(s) and database to support SQL lookups? # A list of triples: (dsn,user,passw). Specify more than one @@ -355,8 +406,8 @@ # the %k will be sender addresses (e.g. full address, domain only, catchall). $sql_select_white_black_list = 'SELECT wb FROM wblist,mailaddr'. - ' WHERE (wblist.rid=?) AND (wblist.sid=mailaddr.id) AND (mailaddr.email IN (%k))'. - ' ORDER BY mailaddr.priority DESC'; + ' WHERE (rid=?) AND (sid=mailaddr.id) AND (mailaddr.email IN (%k))'. + ' ORDER BY mailaddr.priority DESC, wblist.wb DESC'; # # Receiving mail related @@ -371,7 +422,7 @@ $gets_addr_in_quoted_form = 1; $notify_method = 'smtp:127.0.0.1:10025'; -$forward_method = 'smtp:127.0.0.1:10025'; +$forward_method = 'smtp:127.0.0.1:10025'; # overridden in conf file. $virus_quarantine_method = 'local:virus-%i-%n'; $spam_quarantine_method = 'local:spam-%b-%i-%n'; @@ -381,8 +432,8 @@ # encoding (charset in MIME context terminology) # to be used in RFC 2047-encoded ... -$hdr_encoding = 'iso-8859-1'; # ... header field bodies -$bdy_encoding = 'iso-8859-1'; # ... notification body text +$hdr_encoding = 'utf-8'; # ... header field bodies +$bdy_encoding = 'utf-8'; # ... notification body text $smtpd_recipient_limit = 1000; # max recipients (RCPT TO) - sanity limit @@ -417,14 +468,25 @@ # (only used if $virus_quarantine_to specifies direct local delivery) $QUARANTINEDIR = undef; # no quarantine unless overridden by config + + # string to prepend to Subject header field when message qualifies as spam $sa_spam_subject_tag = undef; # example: '***SPAM*** ' +$quarantine_subject_tag = undef; # example: '***QUARANTINE*** ' $sa_spam_modifies_subj = 1; # true for compatibility; can be a lookup table -$undecipherable_subject_tag = '***UNCHECKED*** '; $sa_local_tests_only = 0; $sa_debug = 0; -$sa_timeout = 30; # timeout in seconds for a call to SpamAssassin + +$use_barracuda_bayes = 0; +$enable_user_bayes = 0; +$global_lines_added = 0; + +# Temporary variables used to check previous x-headers for sequential duplicates +my $prev_hdr1 = ''; +my $prev_hdr2 = ''; + +# End Barracuda-specific config # See amavisd.conf and README.lookups for details. @@ -568,6 +630,7 @@ elsif (! -f _) { $msg = "not a regular file" } elsif (! -r _) { $msg = "not readable" } if (defined $msg) { die "Config file $config_file $msg" } + # Lets untaint the config_file do $config_file; if ($@ ne '') { die "Error in config file $config_file: $@" } # compatibility with $mailfrom: @@ -577,7 +640,7 @@ $mailfrom_notify_spamadmin = $mailfrom; } # compatibility with "yes"/"no" for some variables - for ($DEBUG, $DO_SYSLOG, $warn_offsite, $warnvirussender, $warnvirusrecip, + for ($DEBUG, $DO_SYSLOG, $DO_SYSLOG_STATS, $DO_SYSLOG_DEBUG, $warn_offsite, $warnvirussender, $warnvirusrecip, $warnspamsender, $warnbannedsender, $warnbadhsender) { $_ = 0 if /^\s*NO\s*$/i } # some sensible defaults for essential settings @@ -631,33 +694,48 @@ use Time::HiRes qw(time); use vars qw(@timing); +use vars qw(@utiming); -# clear array @timing and enter start time +# clear array @timing and @utiming and enter start time sub init() { @timing = (); + @utiming = (); section_time('init'); } -# enter current time reading into array @timing +# enter current realtime clock, user cpu time into array @timing and array @utiming sub section_time($) { - push(@timing, shift, time); + my $cputime = times(); + push(@timing, shift, time); # push realtime clock into array + push(@utiming, $cputime); # push current user cpu time into array } # returns a string - a report of elapsed time by section +# t0 = realtimeclock u0 = usertime sub report() { section_time('rundown'); my($notneeded, $t0) = (shift(@timing), shift(@timing)); + my($u0) = (shift(@utiming)); my($total) = $timing[$#timing] - $t0; + my($utotal) = $utiming[$#utiming] - $u0; if ($total < 0.0000001) { $total = 0.0000001 } + if ($utotal < 0.0000001) { $utotal = 0.0000001 } my(@sections); while (@timing) { my($section, $t) = (shift(@timing), shift(@timing)); - push(@sections, sprintf("%s: %.0f (%.0f%%)", - $section, ($t-$t0)*1000, ($t-$t0)*100.0/$total ) ); + my($u) = (shift(@utiming)); + # WARNING DO NOT CHANGE THE FORMAT OF FOLLOWING LINE - timescan.pl depends on it + push(@sections, sprintf("%s: %.0f(%.0f%%)/ %.0f(%.0f%%)", + $section, ($t-$t0)*1000, ($t-$t0)*100.0/$total, + ($u-$u0)*1000, ($u-$u0)*100.0/$utotal + ) ); $t0 = $t; + $u0 = $u; } - sprintf("TIMING [total %.0f ms] - %s", - $total*1000, join(", ", @sections)); + + # WARNING DO NOT CHANGE THE FORMAT OF FOLLOWING LINE - timescan.pl depends on it + sprintf("TIMING [total elapsed %.0f ms/ cpu %.0f ms] - %s", + $total*1000,$utotal*1000, join(", ", @sections)); } 1; @@ -693,6 +771,7 @@ # package Amavis::Log; use strict; +use utf8; BEGIN { use Exporter (); @@ -701,7 +780,7 @@ @ISA = qw(Exporter); %EXPORT_TAGS = (); @EXPORT = (); - @EXPORT_OK = qw(&init &write_log); + @EXPORT_OK = qw(&init &write_log &write_debug_log &write_stats_log); } use subs @EXPORT_OK; @@ -711,18 +790,20 @@ use File::Basename; BEGIN { - import Amavis::Conf qw(:platform $myversion $myhostname $daemon_user); + import Amavis::Conf qw(:platform $myversion $myhostname); import Amavis::Lock; } use vars qw($loghandle); # log file handle use vars qw($myname); use vars qw($syslog_facility $syslog_priority); -use vars qw($log_to_stderr $do_syslog $logfile $log_lvl); - -sub init($$$$$$) { - my($ident, $syslog_level); - ($ident,$log_to_stderr,$do_syslog,$syslog_level,$logfile,$log_lvl) = @_; +use vars qw($syslog_stats_facility $syslog_stats_priority); +use vars qw($syslog_debug_facility $syslog_debug_priority); +use vars qw($log_to_stderr $do_syslog $do_syslog_stats $do_syslog_debug $logfile $log_lvl); + +sub init($$$$$$$$$$) { + my($ident, $syslog_level, $syslog_stats_level, $syslog_debug_level); + ($ident,$log_to_stderr,$do_syslog,$syslog_level,$do_syslog_stats,$syslog_stats_level,$do_syslog_debug,$syslog_debug_level,$logfile,$log_lvl) = @_; # Avoid taint bug in some versions of Perl (likely in 5.004, 5.005). # The 5.6.1 is fine. To test, run this one-liner: @@ -738,21 +819,34 @@ if ($do_syslog) { openlog($ident, LOG_PID, $syslog_facility); } else { - $loghandle = IO::File->new($logfile, '>>') + $loghandle = IO::File->new($logfile, 'a') or die "Failed to open log file $logfile: $!"; $loghandle->autoflush(1); - my($uid) = $daemon_user=~/^(\d+)$/ ? $1 : (getpwnam($daemon_user))[2]; - if ($> == 0 && defined $uid) { - chown($uid,-1,$logfile) - or warn "Can't chown logfile $logfile to $uid: $!"; } + if ($syslog_stats_level =~ /^\s*([a-z0-9]+)\.([a-z0-9]+)\s*$/i) { + $syslog_stats_facility = eval("LOG_\U$1"); + $syslog_stats_priority = eval("LOG_\U$2"); + } + $syslog_stats_facility = LOG_DAEMON if $syslog_stats_facility !~ /^\d+$(?!\n)/; + $syslog_stats_priority = LOG_WARNING if $syslog_stats_priority !~ /^\d+$(?!\n)/; + if ($do_syslog_stats) { + openlog($ident, LOG_PID, $syslog_stats_facility); + } + if ($syslog_debug_level =~ /^\s*([a-z0-9]+)\.([a-z0-9]+)\s*$/i) { + $syslog_debug_facility = eval("LOG_\U$1"); + $syslog_debug_priority = eval("LOG_\U$2"); + } + $syslog_debug_facility = LOG_DAEMON if $syslog_debug_facility !~ /^\d+$(?!\n)/; + $syslog_debug_priority = LOG_WARNING if $syslog_debug_priority !~ /^\d+$(?!\n)/; + if ($do_syslog_debug) { + openlog($ident, LOG_PID, $syslog_debug_facility); } + my($msg) = "starting. $myname at $myhostname $myversion"; $msg .= ", eol=\"$eol\"" if $eol ne "\n"; $msg .= ", Unicode aware" if $unicode_aware; $msg .= ", LC_ALL=$ENV{LC_ALL}" if $ENV{LC_ALL} ne ''; - $msg .= ", LC_TYPE=$ENV{LC_TYPE}" if $ENV{LC_TYPE} ne ''; - $msg .= ", LC_CTYPE=$ENV{LC_CTYPE}" if $ENV{LC_CTYPE} ne ''; + $msg .= ", LC_TYPE=$ENV{LANG}" if $ENV{LC_TYPE} ne ''; $msg .= ", LANG=$ENV{LANG}" if $ENV{LANG} ne ''; write_log($msg, undef); } @@ -790,6 +884,39 @@ unlock($loghandle); } } +# Log either to syslog or a file +sub write_stats_log($$) { + my($errmsg,$am_id) = @_; + $am_id = "($am_id) " if defined $am_id; + $errmsg = Amavis::Util::sanitize_str($errmsg); + if ($do_syslog_stats) { + my($pre); my($logline_size) = 980; # less than 1023 - prefix + while (length($am_id.$pre.$errmsg) > $logline_size) { + my($avail) = $logline_size - length($am_id.$pre."..."); + syslog($syslog_stats_priority, "%s", + $am_id . $pre . substr($errmsg,0,$avail) . "..."); + $pre = "..."; $errmsg = substr($errmsg,$avail); + } + syslog($syslog_stats_priority, "%s", $am_id.$pre.$errmsg); + } +} + +sub write_debug_log($$) { + my($errmsg,$am_id) = @_; + $am_id = "($am_id) " if defined $am_id; + $errmsg = Amavis::Util::sanitize_str($errmsg); + if ($do_syslog_debug) { +# my($pre); my($logline_size) = 980; # less than 1023 - prefix +# while (length($am_id.$pre.$errmsg) > $logline_size) { +# my($avail) = $logline_size - length($am_id.$pre."..."); +# syslog($syslog_debug_priority, "%s", +# $am_id . $pre . substr($errmsg,0,$avail) . "..."); +# $pre = "..."; $errmsg = substr($errmsg,$avail); +# } +# syslog($syslog_debug_priority, "%s", $am_id.$pre.$errmsg); + syslog($syslog_debug_priority, "%s", $errmsg); + } +} 1; @@ -804,8 +931,9 @@ @ISA = qw(Exporter); %EXPORT_TAGS = (); @EXPORT = (); - @EXPORT_OK = qw(&safe_encode &am_id &do_log &debug_oneshot - &retcode &prolong_timer &sanitize_str &min &max + @EXPORT_OK = qw(&safe_encode &am_id &do_log &set_debug_id &do_debug_log &debug_oneshot + &set_mta_id &set_multi_recip + &retcode &prolong_timer &sanitize_str &min &max &cleanup_and_die &strip_tempdir &rmdir_recursively &rmdir_flat &read_text &read_l10n_templates &read_hash &run_command); } @@ -815,12 +943,23 @@ # use Encode; # Perl 5.8 UTF-8 support BEGIN { - import Amavis::Conf qw(:platform :notifyconf $DEBUG $log_level - $localpart_is_case_sensitive); - import Amavis::Log qw(write_log); + import Amavis::Conf qw(:platform :notifyconf $DEBUG $log_level); + import Amavis::Log qw(write_log write_debug_log write_stats_log); import Amavis::Timing qw(section_time); } +my $debug_id = ''; +my $mta_id = ''; +my $multi_recip = 0; + +sub cleanup_and_die($) +{ + my($msg) = @_; + do_log(1, "cleanup_and_die exiting. Dieing last breath=$msg"); + exit 1; +} + + # A wrapper for Encode::encode, avoiding a bug in Perl 5.8.0 which causes # Encode::encode to loop and fill memory when given a tainted string sub safe_encode($$;$) { @@ -829,8 +968,8 @@ my($encoding, $str, $check) = @_; $check = 0 if !defined($check); my($taint) = substr($str,0,0); # taintedness of the string - local($1); $str =~ /^(.*)$(?!\n)/s; $str = $1; # untaint - $taint . Encode::encode($encoding, $str, $check); # retain taintedness + $str =~ /^(.*)$(?!\n)/s; $str = $1; # untaint + eval{ $taint . Encode::encode($encoding, $str, $check); }; # retain taintedness } } @@ -854,6 +993,28 @@ write_log($errmsg, am_id()) if $level <= $log_level; } +# write debug log entry +sub do_debug_log($) { + my($errmsg) = @_; + write_debug_log("$errmsg", am_id()); +} +# store the debug_id in a local variable +sub set_debug_id($) { + ($debug_id) = @_; + $debug_id =~ s/\n//g; +} + +# store the mta_id in a local variable +sub set_mta_id($) { + ($mta_id) = @_; + $mta_id =~ s/\s//g; +} + +# store whether this is multi-recipient in a local variable +sub set_multi_recip($) { + ($multi_recip) = @_; +} + use vars qw($debug_oneshot); sub debug_oneshot(;$$) { if (@_) { @@ -879,10 +1040,10 @@ sub prolong_timer($;$) { my($which_section,$child_remaining_time) = @_; if (!defined($child_remaining_time)) { - $child_remaining_time = alarm(0); # check how much time is left + $child_remaining_time = Time::HiRes::alarm(0); # check how much time is left } - do_log(4, "prolong_timer after $which_section: ". - "remaining time = $child_remaining_time s"); + do_log(4, sprintf("prolong_timer after $which_section: ". + "remaining time = %.3f s", $child_remaining_time)); $child_remaining_time = 60 if $child_remaining_time < 60; alarm($child_remaining_time); # restart/prolong the timer } @@ -893,6 +1054,9 @@ # and Unicode characters to \x{xxxx}, returning the sanitized string. sub sanitize_str { my($str,$keep_eol) = @_; + + $str = join "", map {ord($_) == 0 ? "\\0" : $_} split //, $str; #map won't work on \0 + my(%map) = ("\r"=>'\\r', "\n"=>'\\n', "\f"=>'\\f', "\t"=>'\\t', "\b"=>'\\b', "\e"=>'\\e', "\\"=>'\\\\'); if ($keep_eol) { @@ -948,18 +1112,13 @@ local(*DIR); opendir(DIR, $dir) or die "Can't open directory $dir: $!"; while (defined($f = readdir(DIR))) { - my($msg); my($errn) = lstat("$dir/$f") ? 0 : 0+$!; - if ($errn == ENOENT) { $msg = "does not exist" } - elsif ($errn) { $msg = "inaccessible: $!" } - if (defined $msg) { die "rmdir_recursively: \"$dir/$f\" $msg" } - next if ($f eq '.' || $f eq '..') && -d _; - local($1); - $f = $1 if $f =~ /^(.+)\z/s; # untaint - if (-d _) { - rmdir_recursively("$dir/$f",0); + next if $f !~ /^(.+)$(?!\n)/s; + $f = $1; # untaint + if (-d "$dir/$f") { + rmdir_recursively("$dir/$f",0) unless ($f eq '.' || $f eq '..'); } else { $cnt++; - unlink("$dir/$f") or die "Can't remove file $dir/$f: $!"; + unlink("$dir/$f") or do_log(1, "Can't remove file $dir/$f: $!"); } } closedir(DIR) or die "Can't close directory $dir: $!"; @@ -980,14 +1139,9 @@ my $f; opendir(DIR, $dir) or die "Can't open directory $dir: $!"; while (defined($f = readdir(DIR))) { - my($msg); my($errn) = lstat("$dir/$f") ? 0 : 0+$!; - if ($errn == ENOENT) { $msg = "does not exist" } - elsif ($errn) { $msg = "inaccessible: $!" } - if (defined $msg) { die "rmdir_flat: \"$dir/$f\" $msg" } - next if ($f eq '.' || $f eq '..') && -d _; - local($1); - $f = $1 if $f =~ /^(.+)\z/s; # untaint - if (-d _) { + next if $f !~ /^(.+)$(?!\n)/s; + $f = $1; # untaint + if (-d "$dir/$f") { die "Refused to unlink a subdirectory $dir/$f" unless ($f eq '.' || $f eq '..'); } else { @@ -1017,15 +1171,16 @@ sub read_text($;$) { my($filename,$encoding) = @_; my($inp) = IO::File->new; - $inp->open($filename,'<') - or die "Can't open file $filename for reading: $!"; + $inp->open($filename,'r') + or Amavis::Util::cleanup_and_die "Can't open file $filename for reading: $!"; if ($unicode_aware && $encoding ne '') { binmode($inp,":encoding($encoding)") - or die "Can't set :encoding($encoding) on file $filename: $!"; + or Amavis::Util::cleanup_and_die "Can't set :encoding($encoding) on file $filename: $!"; } my($str) = ''; # must not be undef, work around a Perl UTF8 bug - while(<$inp>) { $str .= $_ } - $inp->close or die "Can't close file $filename: $!"; + while(<$inp>) { $_=~ s/([^\\])([\@\$])/$1\\$2/g; $str .= $_ } + $inp->close or Amavis::Util::cleanup_and_die "Can't close file $filename: $!"; + #eval {require Encode; $str = Encode::decode($encoding, $str);}; $str; } @@ -1041,24 +1196,40 @@ my($dir) = @_; if (@_ > 1) # compatibility with Debian { my($l10nlang,$l10nbase) = @_; $dir = "$l10nbase/$l10nlang" } - my($file_chset) = Amavis::Util::read_text("$dir/charset"); + + my $file_chset = 'utf-8'; + my($taint) = substr($file_chset,0,0); if ($file_chset =~ m{^(?:#[^\n]*\n)*([^./\n\s]+)(\s*[#\n].*)?$}s) { - $file_chset = $1; + $file_chset = $1.$taint; } else { die "Invalid charset $file_chset\n"; } - $notify_sender_templ = - Amavis::Util::read_text("$dir/template-dsn.txt", $file_chset); +# $notify_sender_templ = +# Amavis::Util::read_text("$dir/template-dsn.txt", $file_chset); + + $notify_banned_recips_templ = + Amavis::Util::read_text("$dir/template-banned_recip.txt", $file_chset); + + $notify_banned_sender_templ = + Amavis::Util::read_text("$dir/template-banned_sender.txt", $file_chset); + $notify_virus_sender_templ = - Amavis::Util::read_text("$dir/template-virus-sender.txt", $file_chset); + Amavis::Util::read_text("$dir/template-virus_sender.txt", $file_chset); + $notify_virus_admin_templ = - Amavis::Util::read_text("$dir/template-virus-admin.txt", $file_chset); + Amavis::Util::read_text("$dir/template-virus_admin.txt", $file_chset); + $notify_virus_recips_templ = - Amavis::Util::read_text("$dir/template-virus-recipient.txt",$file_chset); + Amavis::Util::read_text("$dir/template-virus_recip.txt",$file_chset); + $notify_spam_sender_templ = - Amavis::Util::read_text("$dir/template-spam-sender.txt", $file_chset); - $notify_spam_admin_templ = - Amavis::Util::read_text("$dir/template-spam-admin.txt", $file_chset); + Amavis::Util::read_text("$dir/template-spam_sender.txt", $file_chset); + + $notify_policy_sender_templ = + Amavis::Util::read_text("$dir/template-policy_sender.txt", $file_chset); + +# $notify_spam_admin_templ = +# Amavis::Util::read_text("$dir/template-spam-admin.txt", $file_chset); } # read a lookup hash from file - may be called from amavisd.conf . @@ -1081,8 +1252,7 @@ my($hashref,$filename,$keep_case) = @_; my($inp) = IO::File->new; - $inp->open($filename,'<') - or die "Can't open file $filename for reading: $!"; + $inp->open($filename,'r') or die "Can't open file $filename for reading: $!"; while(<$inp>) { # carefully handle comments, # within "" does not count chomp; my($line)=''; for my $t (/\G (" (?: \\" | [^"] )* " | [^#"]+ | . ) /gcx) { @@ -1121,12 +1291,10 @@ # close all unneeded files close(STDIN) or die "Can't close STDIN: $!"; close(main::stdin) or die "Can't close main::stdin: $!"; - open(STDIN,"<$stdin_from\0") - or die "Can't reopen STDIN on $stdin_from: $!"; + open(STDIN,"< $stdin_from\0") or die "Can't reopen STDIN on $stdin_from: $!"; fileno(STDIN)==0 or die "run_command: STDIN not fd0"; if ($stderr_to ne '') { - close(STDERR) or die "Can't close STDERR: $!"; - open(STDERR, ">$stderr_to") + open(STDERR, "> $stderr_to\0") or die "Can't open STDERR to $stderr_to: $!"; fileno(STDERR)==2 or die "run_command: STDERR not fd2"; } @@ -1135,14 +1303,14 @@ }; chomp($@); do_log(0,"run_command: child process [$$] failed ". "to exec $cmd_text: $@"); - exec('/usr/bin/false'); # must not exit, we have to avoid DESTROY handlers - exec('/bin/false'); exec('false'); exec('true'); # still kicking? die! - exit 1; # we shouldn't be here, but just in case + exec('/bin/false'); # must not exit, we have to avoid DESTROY handlers + exit 1; # better safe than sorry # NOTREACHED } # parent do_log(5, "run_command: [$pid] $msg"); - binmode($proc_fh) or die "Can't set pipe to binmode: $!"; # dflt Perl 5.8.1 + binmode($proc_fh,":bytes") + or die "Can't cancel :utf8 mode on pipe: $!" if $unicode_aware; $proc_fh; # return subprocess file handle } @@ -1159,11 +1327,10 @@ @ISA = qw(Exporter); %EXPORT_TAGS = (); @EXPORT = qw( - &rfc2822_timestamp &received_line &parse_received - &fish_out_ip_from_received &split_address &split_localpart + &rfc2822_timestamp &received_line &split_address &split_localpart "e_rfc2821_local &qquote_rfc2821_local &unquote_rfc2821_local &one_response_for_all - &EX_OK &EX_NOUSER &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM); + &EX_OK &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM); } use subs @EXPORT; @@ -1174,7 +1341,6 @@ eval {require 'sysexits.ph'}; # try to use the installed version # define the most important constants if undefined do { sub EX_OK() {0} } unless defined(&EX_OK); - do { sub EX_NOUSER() {67} } unless defined(&EX_NOUSER); do { sub EX_UNAVAILABLE() {69} } unless defined(&EX_UNAVAILABLE); do { sub EX_TEMPFAIL() {75} } unless defined(&EX_TEMPFAIL); do { sub EX_NOPERM() {77} } unless defined(&EX_NOPERM); @@ -1183,7 +1349,7 @@ BEGIN { import Amavis::Conf qw(:platform $myhostname $localhost_name $forward_method); - import Amavis::Util qw(do_log); + import Amavis::Util qw(do_log set_debug_id do_debug_log); } # Given a Unix time, return the local time zone offset at that time @@ -1223,20 +1389,30 @@ $s; }; +sub iso_8601_timestamp(;$) { + my ($t) = @_ ? shift : time; + my (@lt) = localtime($t); + + my ($old_locale) = setlocale(LC_TIME, "C"); + my ($zone_name) = strftime("%Z", @lt); + my ($s) = strftime("%Y-%m-%d %H:%M:%S ", @lt); + + $s .= get_zone_offset($t); + $s .= " ($zone_name)" if ($zone_name !~ /^\s*$(?!\n)/); + setlocale(LC_CTYPE, $old_locale); + $s; +} + sub received_line($$$$) { my($conn, $msginfo, $id, $folded) = @_; my($smtp_proto,$recips) = ($conn->smtp_proto, $msginfo->recips); - my($client_ip) = $conn->client_ip; - if ($client_ip =~ /:/ && $client_ip !~ /^IPv6:/i) { - $client_ip = 'IPv6:' . $client_ip; - } - my($s) = sprintf("from %s%s\n by %s%s (amavisd-new, %s)", - ($conn->smtp_helo eq '' ? 'unknown' : $conn->smtp_helo), - ($client_ip eq '' ? '' : " ([$client_ip])"), + my($s) = sprintf("from %s%s\n by %s%s (amavisd-new, port %s)", + $conn->smtp_helo, + ($conn->client_ip eq '' ? '' : " ([".$conn->client_ip."])"), $localhost_name, ($conn->socket_ip eq '' ? '' : sprintf(" (%s [%s])", $myhostname, $conn->socket_ip)), - ($conn->socket_port eq '' ? 'unix socket' : "port ".$conn->socket_port)); + $conn->socket_port); $s .= "\n with $smtp_proto" if $smtp_proto =~ /^(ES|S|L)MTP$/i; $s .= "\n id $id" if $id ne ''; # do not disclose if many @@ -1246,65 +1422,6 @@ $s; } -sub parse_received($) { - my($received) = @_; - local($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11); - my($taint) = substr($received,0,0); # taintedness - $received =~ s/\n([ \t])/$1/g; # unfold - $received =~ s/[\n\r]//g; # delete remaining newlines if any - my(%fields); - while ($received =~ m{\G\s* - ( \b(from|by) \s+ ( (?: \[ (?: \\. | [^\]\\] )* \] | [^;\s\[] )+ ) - (?: \s* \( (?: ( [^\s\[]+ ) \s+ )? - \[ ( (?: \\. | [^\]\\] )* ) \] \s* - \) )? - (?: .*? ) (?= \(|;|\z|\b(?:from|by|via|with|id|for)\b ) # junk - | \b(via|with|id|for) \s+ - ( (?: " (?: \\. | [^"\\] )* " - | \[ (?: \\. | [^\]\\] )* \] - | \\. | . - )+? (?= \(|;|\z|\b(?:from|by|via|with|id|for)\b ) ) - | (;) \s* ( .*? ) \s* \z # time - | (.*?) (?= \(|;|\z|\b(?:from|by|via|with|id|for)\b ) # junk - ) ( (?: \s+ | (?: \( (?: \\. | [^)\\] )* \) ) )* ) }xgcsi ) { - my($v1,$v2,$v3,$comment); - my($item,$field) = ( $1, lc($2||$6||$8) ); - if ($field eq 'from' || $field eq 'by') { - ($v1,$v2,$v3,$comment) = ($3,$4,$5,$11); - } elsif ($field eq ';') { # time - ($v1,$comment) = ($9,$11); - } elsif ($10 eq '') { # via|with|id|for - ($v1,$comment) = ($7,$11); - } else { # junk - ($v1,$comment) = ($10,$11); - } - $comment =~ s/^\s+//; $comment =~ s/\s+$//; - $item =~ s/^\Q$field\E\s*//i; - if (!exists $fields{$field}) { - $fields{$field} = [map { $_.$taint} ($item,$v1,$v2,$v3,$comment)]; - } - } - \%fields; -}; - -sub fish_out_ip_from_received($) { - my($received) = @_; - my($ip); my($taint) = substr($received,0,0); # taintedness of the string - my($fields_ref) = parse_received($received); - if (defined $fields_ref && exists $fields_ref->{'from'}) { - my($item,$v1,$v2,$v3,$comment) = @{$fields_ref->{'from'}}; - for ($v3, $v2, $v1, $comment, $item) { - if (/ \[ (\d{1,3} \. \d{1,3} \. \d{1,3} \. \d{1,3}) \] /x) { - $ip = $1; last; - } elsif (/ (\d{1,3} \. \d{1,3} \. \d{1,3} \. \d{1,3}) (?!\d) /x) { - $ip = $1; last; - } - } - do_log(5, "fish_out_ip_from_received: $ip, $item"); - }; - !defined($ip) ? undef : $ip.$taint; -}; - # Splits unquoted fully qualified e-mail address, or an address # with missing domain part. Returns a pair: (localpart, domain). # The domain part (if nonemty) includes the '@' as the first character. @@ -1313,8 +1430,8 @@ # sub split_address($) { my($mailbox) = @_; - local($1,$2); my($taint) = substr($mailbox,0,0); - $mailbox =~ /^ (.*?) ( \@ (?: \[ (?: \\. | [^\]\\] )* \] + my($taint) = substr($mailbox,0,0); + $mailbox =~ /^ (.*?) ( \@ (?: \[ (?: \\. | [^\[\]\\] )* \] | [^@"<>\[\]\\\s] )* ) $(?!\n)/xs ? ($1.$taint, $2.$taint) : ($mailbox,''); } @@ -1331,7 +1448,7 @@ sub split_localpart($$) { my($localpart, $delimiter) = @_; my($owner_request_special) = 0; # configurable ??? - local($1,$2); my($extension); my($taint) = substr($localpart,0,0); + my($extension); my($taint) = substr($localpart,0,0); if ($localpart =~ /^(postmaster|mailer-daemon|double-bounce)$(?!\n)/i) { # do not split these, regardless of what the delimiter is } elsif ($delimiter eq '-' && $owner_request_special @@ -1406,8 +1523,8 @@ # from individual per-recipient response codes, taking into account # sendmail milter specifics. Returns a pair: (smtp response, exit status). # -sub one_response_for_all($$$) { - my($msginfo,$dsn_per_recip_capable,$am_id) = @_; +sub one_response_for_all($$) { + my($msginfo,$dsn_per_recip_capable) = @_; my($smtp_resp,$exit_code,$dsn_needed); my($sender) = $msginfo->sender; @@ -1416,16 +1533,20 @@ if ($forward_method ne '' && $any_not_done) { die "Explicit forwarding, but not all recips done" } if (!@$per_recip_data) { # no recipients, nothing to do - $smtp_resp = "250 2.5.0 Ok, id=$am_id"; $exit_code = EX_OK; + $smtp_resp = "250 2.5.0 Ok"; $exit_code = EX_OK; do_log(5, "one_response_for_all <$sender>: no recipients, '$smtp_resp'"); } if (!defined $smtp_resp) { for my $r (@$per_recip_data) { # any 4xx code ? + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } if ($r->recip_smtp_response =~ /^4/) # pick the first 4xx code { $smtp_resp = $r->recip_smtp_response; last } } if (!defined $smtp_resp) { for my $r (@$per_recip_data) { # any invalid code ? + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } if ($r->recip_done && $r->recip_smtp_response !~ /^[245]/) { $smtp_resp = '451 4.5.0 Bad SMTP response code??? "' . $r->recip_smtp_response . '"'; @@ -1446,6 +1567,8 @@ # if destiny for _all_ recipients is D_DISCARD => Discard my($notall); for my $r (@$per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } if ($r->recip_destiny == D_DISCARD) { # pick the first DISCARD code $smtp_resp = $r->recip_smtp_response if !defined $smtp_resp; } else { $notall++; last } # one is not a discard, nogood @@ -1461,6 +1584,8 @@ # (and there is at least one Reject) my($notall,$done_level); my($bounce_cnt) = 0; for my $r (@$per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } my($dest,$resp) = ($r->recip_destiny, $r->recip_smtp_response); if ($dest == D_DISCARD) { # ok, this one is discard, let's see the rest @@ -1482,6 +1607,8 @@ # mixed destiny => 2xx, but generate dsn for bounces and rejects my($rej_cnt) = 0; my($bounce_cnt) = 0; my($drop_cnt) = 0; for my $r (@$per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } my($dest,$resp) = ($r->recip_destiny, $r->recip_smtp_response); if ($resp=~/^2/ && $dest==D_PASS) { # genuine successful delivery $smtp_resp = $resp if !defined $smtp_resp; @@ -1492,20 +1619,15 @@ } $exit_code = EX_OK; if (!defined $smtp_resp) { # no genuine Pass/2xx - # declare success, we'll handle bounce - $smtp_resp = "250 2.5.0 Ok, id=$am_id"; + $smtp_resp = "250 2.5.0 Ok"; # declare success, we'll handle bounce if ($any_not_done) { $smtp_resp .= ", continue delivery" } elsif ($forward_method eq '') { $exit_code = 99 } # milter DISCARD } - if ($rej_cnt+$bounce_cnt+$drop_cnt > 0) { - $smtp_resp .= ", "; - $smtp_resp .= "but " - if $rej_cnt+$bounce_cnt+$drop_cnt < @$per_recip_data; - $smtp_resp .= join ", and ", map { my($cnt,$nm) = @$_; - !$cnt ? () : $cnt==@$per_recip_data ? $nm : "$cnt $nm" } - ( [$rej_cnt,'REJECT'], [$bounce_cnt,'BOUNCE'], - [$drop_cnt,'DISCARD'] ); - } + $smtp_resp .= ", but " if $rej_cnt+$bounce_cnt+$drop_cnt > 0; + $smtp_resp .= join(", and ", + (!$rej_cnt ? () : "$rej_cnt REJECT"), + (!$bounce_cnt ? () : "$bounce_cnt BOUNCE"), + (!$drop_cnt ? () : "$drop_cnt DISCARD") ); $dsn_needed = ( $bounce_cnt > 0 || ($rej_cnt > 0 && !$dsn_per_recip_capable) ) ? 1 : 0; do_log(5, "one_response_for_all <$sender>: " . @@ -1520,12 +1642,13 @@ # package Amavis::Lookup::RE; use strict; +use utf8; BEGIN { use Exporter (); use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); @ISA = qw(Exporter); } -BEGIN { import Amavis::Util qw(do_log) } +BEGIN { import Amavis::Util qw(do_log set_debug_id do_debug_log) } # Make an object out of the supplied access control list # to make it easier later to distinguish it from simple ACL array @@ -1573,11 +1696,10 @@ # 'user@them.co.uk' matches .uk, returns true and search stops # 'user@some.com' does not match anything, falls through and returns false (undef) -sub lookup_re($$) { - my($self,$addr) = @_; - local($1,$2,$3,$4); +sub lookup_re($$;$$) { + my($self,$addr, $get_regexp, $strip_html,$report) = @_; my($taint) = substr($addr,0,0); # empty string, tainted if $addr tainted - my($found, $fullkey, $result); + my($found, $fullkey, $result, $regexp); for my $e (@$self) { my($key); # missing value implies result 1 if (ref($e) eq 'ARRAY') { # a pair: (regexp,result) @@ -1585,22 +1707,82 @@ } else { # a single regexp ($key,$result) = ($e,1); } - # do_log(5, "lookup_RE: key=\"$addr\", matching against RE $key"); - my(@m) = $addr =~ /$key/; + + # Do the lookup without any html in place if desired + if ( $strip_html ) { + # This isn't the best way to accomplish this, and may + # miss a few or be inaccurate on some ... but it is fast, + # and should get most of the crap out of the way so that + # we can match keywords properly + $addr =~ s// $1 /gi; + $addr =~ s// $1 /gi; + $addr =~ s/<.*?>//gi; + } + + ####my(@m) = $addr =~ /$key/; + + # split $addr into lines of approximately 1000 bytes + # (try to split at spaces) + my $desired_sub_addr_size = 1000; + my @m; + my $curr_pos = 0; + # loop until we've slurped past the end + + utf8::decode($key); + + while (length($addr) > $curr_pos) { + # find the first space after the desired length + my $space_pos = index($addr, ' ', $curr_pos + $desired_sub_addr_size); + # if first space is not within 200 chars of desired length increment + if (($space_pos - $curr_pos) > $desired_sub_addr_size + 200 || + $space_pos < ($curr_pos + $desired_sub_addr_size)) { + # just use desired length + $space_pos = $desired_sub_addr_size; + } + do_log(6, "Grabbing next $space_pos characters"); + my $sub_addr = substr($addr, $curr_pos, $space_pos); + do_log(6, "Grabbed: $sub_addr"); + + chomp $sub_addr; + + + + push (@m, ($sub_addr =~ /$key/)) if ($sub_addr =~ /$key/); + $curr_pos += $space_pos; + } + if (@m) { $found++; $fullkey = $key; my($any) = - $result =~ s[ \$ ( (\d+) | \{ (\d+) \} | \( (\d+) \) ) ] + $result =~ s[ \$ ( (\d+) | { (\d+) } | \( (\d+) \) ) ] [ my($j)=$2+$3+$4; $j<1 ? '' : $m[$j-1] ]gxse; # bring taintedness of input to the result $result .= $taint if $any; + + # Determine the regular exp we matched if we were told to do so + if ( $get_regexp && defined($report)) { + + foreach my $report_re (@{$report}) + { + #do_log(1, "MATCHING REPORT: ".$report_re." ".$addr); + eval {$report_re = Encode::decode("utf8", $report_re);}; + + + if (($addr =~ /$report_re/) || ($addr =~ /$report_re/i)) { + + $regexp = $report_re; + utf8::upgrade($regexp); last; } } - $fullkey = $result = undef if !$found; + } + last; + } + } + $regexp = $fullkey = $result = undef if !$found; do_log(5, "lookup_RE: key=\"$addr\"" . (!$found ? ", no match" - : " matches \"$fullkey\", result=$result") ); - !wantarray ? $result : ($result,$fullkey); + : " matches \"$fullkey\", result=$result regexp=$regexp") ); + !wantarray ? $result : ($result, $fullkey, $regexp); } 1; @@ -1621,7 +1803,7 @@ use subs @EXPORT_OK; BEGIN { - import Amavis::Util qw(do_log); + import Amavis::Util qw(do_log set_debug_id do_debug_log); import Amavis::Conf qw(:platform $recipient_delimiter $localpart_is_case_sensitive %local_domains @local_domains_acl $local_domains_re); @@ -1652,7 +1834,7 @@ my($addr, $hash_ref) = @_; (ref($hash_ref) eq 'HASH') or die "lookup_hash: arg2 must be a hash ref"; return undef if !%$hash_ref; # empty hash can't match anything - local($1,$2); my($taint) = substr($addr,0,0); + my($taint) = substr($addr,0,0); my($localpart,$domain) = split_address($addr); $domain = lc($domain); $localpart = lc($localpart) if !$localpart_is_case_sensitive; # chop off leading @, and trailing dots @@ -1763,7 +1945,8 @@ sub lookup_acl($$) { my($addr, $acl_ref) = @_; (ref($acl_ref) eq 'ARRAY') or die "lookup_acl: arg2 must be a list ref"; - local($1,$2); my($taint) = substr($addr,0,0); + my($taint) = substr($addr,0,0); + my($lcaddr) = lc($addr); my($localpart,$domain) = split_address($addr); $domain = lc($domain); @@ -1780,6 +1963,8 @@ $found++ if $lcaddr eq $key; } elsif ($key =~ /^\.(.*)$(?!\n)/s) {# leading dot: domain or subdomain $found++ if $domain =~ /^ (.*? (\.|$(?!\n)))? \Q$1\E $(?!\n)/xs; + } elsif ($key eq '*') {# single asterisk - wildcard + $found++; } else { # match domain (but not its subdomains) $found++ if $domain eq $key; } @@ -1862,7 +2047,7 @@ my($ip, $nets_ref) = @_; (ref($nets_ref) eq 'ARRAY') or die "lookup_ip_acl: arg2 must be a list ref"; my($ipbin) = unpack('N', pack('C4', split(/\./, $ip, -1))); - local($1,$2); my($found, $fullkey, $result); + my($found, $fullkey, $result); for my $net (@$nets_ref) { $fullkey = $net; my($key) = $fullkey; $result = 1; my($taint) = substr($key,0,0); @@ -2145,6 +2330,8 @@ ref($whereto) eq 'ARRAY' ? push(@$whereto, $s) : ($$whereto .= $s); } } + utf8::encode($output_str); + utf8::upgrade($output_str); return \$output_str; } @@ -2187,6 +2374,10 @@ use strict; +use constant NULL_DICTIONARY => 0; +use constant GLOBAL_DICTIONARY => 1; +use constant USER_DICTIONARY => 2; + BEGIN { use Exporter (); use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); @@ -2196,8 +2387,22 @@ # 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 10], $class } +sub new { # NOTE: this class is a list, not hash + my($class) = @_; + my(%bayes) = ( # Bayes score located at array index 11 + isspam => 0, + probability => 0, + confidence => 0, + dictionary => NULL_DICTIONARY, + weight => 0 + ); + bless [(undef) x 14,\%bayes], $class; + # XXX: (WA) I think this used to be an off-by-one bug; the per_user sub + # referencing past what was initialized. So, I've incremented the undef + # list AND added the Bayesian initialization after. Index 13 as used + # recip_bayes_score should refer to the 14th item in the array. + # dk: add 'quarantined' member +} # &new # subs to set or access individual elements of a n-tuple by name sub recip_addr # recipient envelope e-mail address @@ -2218,8 +2423,18 @@ { my($self)=shift; !@_ ? $$self[7] : ($$self[7]=shift) } sub recip_whitelisted_sender # recip considers this sender whitelisted { my($self)=shift; !@_ ? $$self[8] : ($$self[8]=shift) } +sub recip_whitelisted # recip was whitelisted + { my($self)=shift; !@_ ? $$self[11] : ($$self[11]=shift) } sub recip_blacklisted_sender # recip considers this sender blacklisted { my($self)=shift; !@_ ? $$self[9] : ($$self[9]=shift) } +sub per_user # is this user a per-user enabled one + { my($self)=shift; !@_ ? $$self[10] : ($$self[10]=shift) } +sub quarantined # quarantined or not? + { my($self)=shift; !@_ ? $$self[12] : ($$self[12]=shift) } +sub recip_addr_orig + { my($self)=shift; !@_ ? $$self[13] : ($$self[13]=shift) } +sub recip_bayes_score # hashref->{isspam,probability,confidence,dictionary,weight} + { my($self)=shift; !@_ ? $$self[14] : ($$self[14]=shift) } sub recip_final_addr { # return recip_addr_modified if set, else recip_addr my($self)=shift; @@ -2276,6 +2491,8 @@ { my($self)=shift; !@_ ? $self->{orig_bdy_s} : ($self->{orig_bdy_s}=shift) } sub body_digest # message digest of message body { my($self)=shift; !@_ ? $self->{body_digest}: ($self->{body_digest}=shift) } +sub msg_xsize # dk: message size to be reported + { my($self)=shift; !@_ ? $self->{msg_xsize}: ($self->{msg_xsize}=shift) } sub quarantined_to # list of quarantine mailbox names or addresses if quarantined { my($self)=shift; !@_ ? $self->{quarantine} : ($self->{quarantine}=shift) } sub dsn_sent # delivery status notification was sent(1) or faked(2) @@ -2305,6 +2522,7 @@ $self->per_recip_data([ map { my($per_recip_obj) = Amavis::In::Message::PerRecip->new; $per_recip_obj->recip_addr($_); + $per_recip_obj->per_user(0); $per_recip_obj->recip_destiny(D_PASS); # default is Pass $per_recip_obj } @{$_[0]} ]); } @@ -2333,7 +2551,7 @@ BEGIN { import Amavis::Conf qw(:platform $hdr_encoding); import Amavis::Timing qw(section_time); - import Amavis::Util qw(do_log safe_encode); + import Amavis::Util qw(do_log set_debug_id do_debug_log safe_encode); } use MIME::Words; @@ -2348,6 +2566,7 @@ sub append_header($$$;$) { my($self, $field_name, $field_body, $structured) = @_; push(@{$self->{append}}, hdr($field_name, $field_body, $structured)); + } sub delete_header($$) { my($self, $field_name) = @_; @@ -2374,20 +2593,21 @@ # sub hdr($$;$) { my($field_name, $field_body, $structured) = @_; - if ($field_name =~ /^(X-.*|Subject|Comments)$(?!\n)/si && - $field_body =~ /[^\011\012\040-\176]/ # nonprintable except TAB and LF? - ) { # encode according to RFC 2047 - $field_body =~ s/\n[ \t]/ /g; chomp($field_body); # unfold - my($field_body_octets) = safe_encode($hdr_encoding, $field_body); - $field_body = q_encode($field_body_octets, 'Q', $hdr_encoding); - } else { # supposed to be in plain ASCII, let's make sure it is - $field_body = safe_encode('ascii', $field_body); - } - $field_name = safe_encode('ascii', $field_name); +# if ($field_name =~ /^(X-.*|Subject|Comments)$(?!\n)/si && +# $field_body =~ /[^\011\012\040-\176]/ # nonprintable except TAB and LF? +# ) { # encode according to RFC 2047 +# $field_body =~ s/\n[ \t]/ /g; chomp($field_body); # unfold +# my($field_body_octets) = safe_encode($hdr_encoding, $field_body); +# $field_body = MIME::Words::encode_mimeword($field_body_octets, +# 'Q', $hdr_encoding); +# } else { # supposed to be in plain ASCII, let's make sure it is +# $field_body = safe_encode('ascii', $field_body); +# } +# $field_name = safe_encode('ascii', $field_name); my($str) = $field_name . ':'; - $str .= ' ' if $field_body !~ /^[ \t]/; + $str .= " " if $field_body !~ /^[ \t]/; $str .= $field_body; - $str =~ s/\n([^ \t\n])/\n $1/g; # insert a space at line folds if missing + $str =~ s/\n([^ \t\n])/\n\t$1/g; # insert a space at line folds if missing $str =~ s/\n([ \t]*\n)+/\n/g; # remove empty lines chomp($str); # chop off trailing NL if present if ($structured) { @@ -2404,38 +2624,15 @@ $str .= "\n" if $str ne ''; $str .= $s; } - } elsif (length($str) > 998) { - # truncate the damn thing (to be done better) - $str = substr($str,0,998); + } elsif (length($str) > 999) { + ## to be done } $str .= "\n"; # append final NL do_log(5, "header: $str"); + $str =~ s/^ /\t/gm; $str; } -# Do the Q-encoding manually, the MIME::Words::encode_mimeword does not -# encode spaces and does not limit to 75 ch, which violates the RFC 2047 -sub q_encode($) { - my($octets,$encoding,$charset) = @_; - my($prefix) = '=?' . $charset . '?' . $encoding . '?'; - my($suffix) = '?='; local($1,$2,$3); - # FWS | utext (= NO-WS-CTL|rest of US-ASCII) - $octets =~ /^ ( [\001-\011\013\014\016-\177]* [ \t] )? (.*?) - ( [ \t] [\001-\011\013\014\016-\177]* )? \z/sx; - my($head,$rest,$tail) = ($1,$2,$3); - # Q-encode $rest according to RFC 2047 - # more restricted than =?_ so that it may be used in 'phrase' - $rest =~ s{([^ 0-9a-zA-Z!*/+-])}{sprintf('=%02X',ord($1))}egs; - $rest =~ tr/ /_/; # turn spaces into _ (rfc2047 allows it) - my($s) = $head; my($len) = 75 - (length($prefix)+length($suffix)) - 2; - while ($rest ne '') { - $s .= ' ' if $s !~ /[ \t]\z/; # encoded words must be separated by FWS - $rest =~ /^ ( .{0,$len} [^=] (?: [^=] | \z ) ) (.*) \z/sx; - $s .= $prefix.$1.$suffix; $rest = $2; - } - $s.$tail; -} - # Copy mail header to the supplied method (line by line) # while adding, removing, or changing certain header lines as required; # Returns number of original 'Received:' lines to make simple loop detection @@ -2455,7 +2652,7 @@ } my($received_cnt) = 0; my($str) = ''; for (@{$self->{prepend}}) { $str .= $_ } - if ($str ne '') { $out_fh->print($str) or die "sending mail header1: $!" } + if ($str ne '') { $out_fh->print($str) or Amavis::Util::cleanup_and_die "sending mail header1: $!" } if (!defined($msg)) { # existing header empty } elsif (!exists($self->{edit}) || !scalar(%{$self->{edit}})) { @@ -2463,32 +2660,31 @@ if ($is_mime) { # NOTE: can't use method print_header, as it assumes file glob for my $h (@header) { - $out_fh->print($h) or die "sending mail header2: $!"; + $out_fh->print($h) or Amavis::Util::cleanup_and_die "sending mail header2: $!"; } } else { # assume file handle while (<$msg>) { # copy header only, read line by line last if $_ eq $eol; # end of header - $out_fh->print($_) or die "sending mail header3: $!"; + $out_fh->print($_) or Amavis::Util::cleanup_and_die "sending mail header3: $!"; } } } else { my($curr_head, $next_head); - push(@header, $eol) if $is_mime; # append empty line as end-of-header while ( defined($next_head = $is_mime ? shift @header : <$msg>) ) { if ($next_head =~ /^[ \t]/) { $curr_head .= $next_head } # folded else { # new header if (!defined($curr_head)) { # no previous complete header } elsif ($curr_head !~ /^([!-9;-\176]+)[ \t]*:(.*)$(?!\n)/s) { # invalid header, but we don't care - $out_fh->print($curr_head) or die "sending mail header4: $!"; + $out_fh->print($curr_head) or Amavis::Util::cleanup_and_die "sending mail header4: $!"; } else { # count, edit, or delete # obsolete rfc822 syntax allowed whitespace before colon - local($1,$2); my($taint) = substr($curr_head,0,0); + my($taint) = substr($curr_head,0,0); my($field_name,$field_body) = ($1.$taint, $2.$taint); my($field_name_lc) = lc($field_name); $received_cnt++ if $field_name_lc eq 'received'; if (! exists($self->{edit}{$field_name_lc})) { # unchanged - $out_fh->print($curr_head) or die "sending mail header5: $!"; + $out_fh->print($curr_head) or Amavis::Util::cleanup_and_die "sending mail header5: $!"; } else { my($edit) = $self->{edit}{$field_name_lc}; if (defined($edit)) { # edit, not delete @@ -2496,7 +2692,7 @@ ### $field_body =~ s/\n([ \t])/$1/g; # unfold $out_fh->print(hdr($field_name, &$edit($field_name,$field_body))) - or die "sending mail header6: $!"; + or Amavis::Util::cleanup_and_die "sending mail header6: $!"; } } } @@ -2508,7 +2704,7 @@ $str = ''; for (@{$self->{append}}) { $str .= $_ } $str .= $eol; # end of header - separator line - $out_fh->print($str) or die "sending mail header7: $!"; + $out_fh->print($str) or Amavis::Util::cleanup_and_die "sending mail header7: $!"; section_time('write-header'); $received_cnt; } @@ -2534,7 +2730,7 @@ import Amavis::Conf qw(:platform $gzip $bzip2 %local_delivery_aliases $notify_method); import Amavis::Lock; - import Amavis::Util qw(do_log am_id); + import Amavis::Util qw(do_log set_debug_id do_debug_log am_id); import Amavis::Timing qw(section_time); import Amavis::rfc2821_2822_Tools; import Amavis::Out::EditHeader; @@ -2542,17 +2738,23 @@ use subs @EXPORT_OK; +use POSIX qw(strftime); +use File::Copy; + # Deliver to local mailboxes only, ignore the rest: either to directory # (maildir style), or file (Unix mbox). (normally used as a quarantine method) # +my $use_hard_links = 1; #Global to determine if we have a seperate quarantine + # partition and hard linking will fail. sub mail_to_local_mailbox(@) { my($via,$msginfo,$initial_submission,$filter) = @_; - local($1,$2); # avoid Perl taint bug ($1 and $2 were tainted, taints $via) + my($taint) = substr($via,0,0); - $via =~ /^local:(.*)$(?!\n)/si or die "Bad local method: $via"; + $via =~ /^local:(.*)$(?!\n)/si or Amavis::Util::cleanup_and_die "Bad local method: $via"; my($via_arg) = $1.$taint; - my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))} - @{$msginfo->per_recip_data}; + #my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))} + # @{$msginfo->per_recip_data}; + my(@per_recip_data) = @{$msginfo->per_recip_data}; return 1 if !@per_recip_data; my($msg) = $msginfo->mail_text; # a scalar reference, or a file handle if (defined($msg) && !$msg->isa('MIME::Entity')) { @@ -2562,11 +2764,31 @@ } my($sender) = $msginfo->sender; for my $r (@per_recip_data) { - my($recip) = $r->recip_final_addr; + # Use the original recipient if we have one (used for global + # quarantining) + my($recip) = $r->recip_addr_orig || $r->recip_final_addr; + + + # dk: no outbound special case -- file saved here is only for msglog viewing + + + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $recip eq ''; my($localpart,$domain) = split_address($recip); my($smtp_response); + # ZL: try to use the LDAP true email address - if not, use the LDAP + # uid - if those fail, base it on the recipient + # + # CH - note that this is only for per-user quarantine. For msg log + # stuff we need the orig recipient since that is what we will log + # with and display in the message log. + my $folder = $r->recip_addr_orig || $r->recip_final_addr; + my $quar_folder = $Amavis::PU_REAL_EMAIL_MAP{$recip} || + $Amavis::PU_UID_MAP{$recip} || + $recip; + + # %local_delivery_aliases emulates aliases map - this would otherwise # be done by MTA's local delivery agent if we gave the message to MTA. # This way we keep interface compatible with other mail delivery @@ -2577,9 +2799,10 @@ # If no matching entry is found, the key ($localpart) is treated as # a mailbox filename if nonempty, or else quarantining is skipped. - my($mbxname, $suggested_filename); + my($mbxname, $suggested_filename, $quarantine_full_file_name, $quarantine_dir, $quarantine_queue_dir, $quarantine_queue_filename); { # a block is used as a 'switch' statement - 'last' will exit from it - my($alias) = $local_delivery_aliases{$localpart}; + #my($alias) = $local_delivery_aliases{$localpart}; + my($alias) = $local_delivery_aliases{barracuda}; if (ref($alias) eq 'ARRAY') { ($mbxname, $suggested_filename) = @$alias; } elsif (ref($alias) eq 'CODE') { # lazy evaluation @@ -2597,9 +2820,6 @@ last; # exit block, not the loop } my($ux); # is it a UNIX-style mailbox? - if (!-d $mbxname) { # assume a filename (need not exist yet) - $ux = 1; # $mbxname is a UNIX-style mailbox (one file) - } else { # a directory $ux = 0; # $mbxname is a amavis/maildir style mailbox (a directory) if ($suggested_filename eq '') { $suggested_filename = $via_arg ne '' ? $via_arg : 'msg-%i-%n'; @@ -2607,10 +2827,86 @@ $suggested_filename =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; $suggested_filename =~ s/%n/am_id()/eg; } + # one mail per file, will create specified file - $mbxname = "$mbxname/$suggested_filename"; + + # Untaint the folder name, remove slash + $folder =~ s/[^-\w.\@]//g; + $quar_folder =~ s/[^-\w.\@]//g; + if ($folder =~ /^([-\w.\/\@]+)$/) + { + $folder = $1; + } + if ($quar_folder =~ /^([-\w.\/\@]+)$/) + { + $quar_folder = $1; + } + + # make sure the folder is all lower case + $folder = lc($folder); + $quar_folder = lc($quar_folder); + + # build the queue directory for clustering + $quarantine_queue_dir = "/mail/message_log/q"; + + # dk outbound: _quarantine@localhost + if( $Barracuda::Environment::mode eq 'outbound' ) { + $quarantine_queue_filename = "$quarantine_queue_dir/_quarantine\@localhost_$suggested_filename"; + } else { + $quarantine_queue_filename = "$quarantine_queue_dir/${quar_folder}_$suggested_filename"; + } + + + # mbxname should be determined by messagestore module + require Barracuda::MessageStore; + $mbxname = Barracuda::MessageStore::get_location( + $suggested_filename, '/mail/mstore'); + # get the path so we can create the directory if necessary + my $folder = undef; + if ($mbxname =~ /^(.*)\//) { + $folder = $1; + } + else { + # if we couldn't figure out where to store this, we've + # got a big problem + + # dk: fix bug #10375 FIXME -- we need to investigate and prevent + # these msgs without debug-id's from occurring. Most likely + # postfix bounces + # in the meantime, do NOT 'cleanup_and_die()' + do_log(0, "Unable to store message -- no debugid"); + return; + #Amavis::Util::cleanup_and_die "Unable to store message"; + } + if (! -d $folder) { + # make any necessary folders and be permissive + umask 0000; + my @dirs = split(/\//, $folder); + my $path = ''; + for (my $level = 0; $level <= $#dirs; $level++) { + $path .= $dirs[$level]."/"; + if (! -d $path) { + `sudo mkdir $path`; + `sudo chmod 777 $path`; + } + } } + do_log(1, "local delivery: <$sender> -> <$recip>, mbx=$mbxname"); + my($failed) = 0; + # ZL: untaint mbxname and quarantine full file name AND queue filename + $mbxname =~ s/[^-\w.\/\@]//g; + if ($mbxname =~ /^([-\w.\/\@]+)$/) { + $mbxname = $1; + } + $quarantine_full_file_name =~ s/[^-\w.\/\@]//g; + if ($quarantine_full_file_name =~ /^([-\w.\/\@]+)$/) { + $quarantine_full_file_name = $1; + } + $quarantine_queue_filename =~ s/[^-\w.\/\@]//g; + if ($quarantine_queue_filename =~ /^([-\w.\/\@]+)$/) { + $quarantine_queue_filename = $1; + } my($pos,$pipe); my($errn) = stat($mbxname) ? 0 : 0+$!; local $SIG{CHLD} = 'DEFAULT'; @@ -2620,33 +2916,35 @@ if (!$ux) { # new file, traditional amavis, or maildir if ($errn == ENOENT) { # good, no file, as expected } elsif (!$errn && -e _) { - die "File $mbxname already exists, refuse to overwrite"; + do_log(1, "File $mbxname already exists, refuse to overwrite"); + goto file_complete; } if (defined($gzip) && $mbxname =~ /\.gz$(?!\n)/) { - open(MP,"|$gzip >$mbxname") # uses shell! - or die "gzip failed: $!"; + open(MP,"|$gzip -c >$mbxname") # uses shell! + or Amavis::Util::cleanup_and_die "gzip failed: $!"; $pipe = 1; } else { - open(MP,"> $mbxname\0") or die "Can't create $mbxname: $!"; + open(MP,"> $mbxname") or Amavis::Util::cleanup_and_die "Can't create $mbxname: $!"; } } else { # append to UNIX-style mailbox # deliver only to non-executable regular files if ($errn == ENOENT) { - open(MP,"> $mbxname\0") or die "Can't create $mbxname: $!"; + open(MP,"> $mbxname\0") or Amavis::Util::cleanup_and_die "Can't create $mbxname: $!"; } elsif (!$errn && !-f _) { die "Mailbox $mbxname is not a regular file, refuse to deliver"; } elsif (-x _ || -X _) { die "Mailbox file $mbxname is executable, refuse to deliver"; } else { - open(MP,">> $mbxname\0") or die "Can't append to $mbxname: $!"; + open(MP,">> $mbxname\0") or Amavis::Util::cleanup_and_die "Can't append to $mbxname: $!"; } binmode(MP,":bytes") - or die "Can't cancel :utf8 mode: $!" if $unicode_aware; + or Amavis::Util::cleanup_and_die "Can't cancel :utf8 mode: $!" if $unicode_aware; lock(\*MP); # also seeks to the end, so we don't have to $pos = tell MP; } + if (defined($msg) && !$msg->isa('MIME::Entity')) { - $msg->seek(0,0) or die "Can't rewind mail file: $!"; + $msg->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; } }; if ($@ ne '') { @@ -2658,14 +2956,14 @@ eval { # if things fail from here on, try to restore mailbox state printf MP ("From %s %s$eol", quote_rfc2821_local($sender), scalar(localtime) ) - or die "Can't write to $mbxname: $!" if $ux; + or Amavis::Util::cleanup_and_die "Can't write to $mbxname: $!" if $ux; my($hdr_edits) = $msginfo->header_edits; $hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits; - $hdr_edits->delete_header('Return-Path'); - $hdr_edits->prepend_header('Delivered-To', - quote_rfc2821_local($recip)); - $hdr_edits->prepend_header('Return-Path', - qquote_rfc2821_local($sender)); + #$hdr_edits->delete_header('Return-Path'); + #$hdr_edits->prepend_header('Delivered-To', + # quote_rfc2821_local($recip)); + #$hdr_edits->prepend_header('Return-Path', + # qquote_rfc2821_local($sender)); my($received_cnt) = $hdr_edits->write_header($msg,\*MP); if ($received_cnt > 110) { # loop detection required by rfc2821 section 6.2 @@ -2674,33 +2972,76 @@ } if (!$ux) { # do it in blocks for speed if we can while ( $msg->read($_,16384) > 0 ) { - print MP $_ or die "Can't write to $mbxname: $!"; + print MP $_ or Amavis::Util::cleanup_and_die "Can't write to $mbxname: $!"; } } else { # for UNIX-style mailbox delivery: escape 'From ' my($blank_line) = 1; while(<$msg>) { - print MP '>' or die "Can't write to $mbxname: $!" + print MP '>' or Amavis::Util::cleanup_and_die "Can't write to $mbxname: $!" if $blank_line && /^From /; - print MP $_ or die "Can't write to $mbxname: $!"; + print MP $_ or Amavis::Util::cleanup_and_die "Can't write to $mbxname: $!"; $blank_line = $_ eq "\n"; } } # must append an empty line for a Unix mailbox format - print MP $eol or die "Can't write to $mbxname: $!" if $ux; + print MP $eol or Amavis::Util::cleanup_and_die "Can't write to $mbxname: $!" if $ux; }; - my($failed) = 0; if ($@ ne '') { # trouble chomp($@); if ($ux && defined($pos) && $can_truncate) { # try to restore UNIX-style mailbox to previous size; # Produces a fatal error if truncate isn't implemented # on your system. - truncate(MP,$pos) or die "Can't truncate file $mbxname: $!"; + truncate(MP,$pos) or Amavis::Util::cleanup_and_die "Can't truncate file $mbxname: $!"; } $failed = 1; } unlock(\*MP) if $ux; - close(MP) or die ("Can't close $mbxname: " . ($pipe ? $? : $!) ); + close(MP) or Amavis::Util::cleanup_and_die ("Can't close $mbxname: " . ($pipe ? $? : $!) ); +file_complete: + + my($s) = -s "$mbxname"; # get it from a file system + $msginfo->msg_xsize( $s ); + + # Make sure our file has proper permissions since amavisd is retarded + `sudo /bin/chmod 0666 $mbxname`; + + # Let our log monitor know we delivered a file to this location + # also go ahead and create link to the quarantine dir if needed + if( $r->per_user ) + { + # dk: do we still need to do this? + # Build the quarantine directory as well (in case we need it) + #$quarantine_dir = "/mail/message_log/messages/$folder/q"; + + #$quarantine_full_file_name = "$quarantine_dir/$suggested_filename"; + # Is this directory alredy in existence? + + #if (! -d $quarantine_dir) + #{ + #`sudo /bin/mkdir -p -m 777 $quarantine_dir`; + #} + + # Hard link our file + #link $mbxname, $quarantine_full_file_name; + #`sudo /bin/chmod 0666 $quarantine_full_file_name`; + do_log(1, "linking to: $quarantine_queue_filename"); + if (! -e $quarantine_queue_filename) { + if ($use_hard_links) { + if (! link $mbxname, $quarantine_queue_filename) { + $use_hard_links = 0; + copy($mbxname, $quarantine_queue_filename); + } + } + else { + copy($mbxname, $quarantine_queue_filename); + } + } + `sudo /bin/chmod 0666 $quarantine_queue_filename`; + + } + + if (!$failed) { $smtp_response = "250 2.6.0 Ok, delivered to $mbxname"; } elsif ($@ eq "timed out") { $smtp_response = @@ -2713,9 +3054,9 @@ } # end of block, 'last' within block brings us here do_log(0, $smtp_response) if $smtp_response !~ /^2/; $smtp_response .= ", id=" . am_id(); - $r->recip_smtp_response($smtp_response); - $r->recip_done(2); - $r->recip_mbxname($mbxname) if defined $mbxname; + #$r->recip_smtp_response($smtp_response); + #$r->recip_done(2); + #$r->recip_mbxname($mbxname) if defined $mbxname; section_time('save-to-local-mailbox'); } } @@ -2733,7 +3074,16 @@ @ISA = qw(Exporter); %EXPORT_TAGS = (); @EXPORT = qw(&mail_dispatch - &EX_OK &EX_NOUSER &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM); + &EX_OK &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM); +} + +BEGIN { + eval {require 'sysexits.ph'}; # try to use the installed version + # define the most important constants if undefined + do { sub EX_OK() {0} } unless defined(&EX_OK); + do { sub EX_UNAVAILABLE() {69} } unless defined(&EX_UNAVAILABLE); + do { sub EX_TEMPFAIL() {75} } unless defined(&EX_TEMPFAIL); + do { sub EX_NOPERM() {77} } unless defined(&EX_NOPERM); } use IO::File; @@ -2743,9 +3093,8 @@ use POSIX qw(strftime); BEGIN { - import Amavis::Conf qw(:platform $DEBUG $localhost_name - $notify_method $relayhost_is_client); - import Amavis::Util qw(do_log debug_oneshot am_id retcode min max + import Amavis::Conf qw(:platform $DEBUG $localhost_name $notify_method); + import Amavis::Util qw(do_log set_debug_id do_debug_log debug_oneshot am_id retcode min max prolong_timer); import Amavis::Timing qw(section_time); import Amavis::rfc2821_2822_Tools; @@ -2753,56 +3102,17 @@ import Amavis::Out::EditHeader; } -BEGIN { - eval {require 'sysexits.ph'}; # try to use the installed version - # define the most important constants if undefined - do { sub EX_OK() {0} } unless defined(&EX_OK); - do { sub EX_NOUSER() {67} } unless defined(&EX_NOUSER); - do { sub EX_UNAVAILABLE() {69} } unless defined(&EX_UNAVAILABLE); - do { sub EX_TEMPFAIL() {75} } unless defined(&EX_TEMPFAIL); - do { sub EX_NOPERM() {77} } unless defined(&EX_NOPERM); -} - -# modify delivery method string if $relayhost_is_client and mail came in by TCP -sub dynamic_destination($$) { - my($method,$conn) = @_; - if ($relayhost_is_client && $method =~ /^smtp\b/i - && defined($conn) && $conn->client_ip ne '') { - my($new_method) = sprintf("smtp:%s:%d", - $conn->client_ip, $conn->socket_port + 1); - if ($new_method ne $method) { - do_log(3,"dynamic destination override: $method -> $new_method"); - $method = $new_method; - } - } - $method; -} +sub mail_dispatch($$$;$) { + my($via) = shift; -sub mail_dispatch($$$$;$) { - my($via,$conn) = (shift,shift); - if ($via =~ /^smtp\b/i) { - mail_via_smtp(dynamic_destination($via,$conn), @_); + if ($via =~ /^smtp:/i) { + mail_via_smtp($via,@_); } elsif ($via =~ /^pipe:/i) { mail_via_pipe($via,@_); } elsif ($via =~ /^bsmtp:/i) { mail_via_bsmtp($via,@_); } elsif ($via =~ /^local:/i) { - # used by the quarantine code to relieve it of the need to know - # which delivery method needs to be used - my($msginfo,$initial_submission,$filter) = @_; - # deliver what is local (does not contain '@') - mail_to_local_mailbox($via,$msginfo,$initial_submission, - sub {shift->recip_final_addr !~ /\@/ ? 1 : 0} ); - if (grep {! $_->recip_done } @{$msginfo->per_recip_data}) { - # deliver the rest - if ($notify_method =~ /^smtp:/i) { - mail_via_smtp(dynamic_destination($notify_method,$conn), @_); - } elsif ($notify_method =~ /^pipe:/i) { - mail_via_pipe($notify_method,@_); - } elsif ($notify_method =~ /^bsmtp:/i) { - mail_via_bsmtp($notify_method,@_); - } - } + mail_to_local_mailbox($via,@_); }; } @@ -2817,7 +3127,7 @@ sub print { my($self) = shift; $$self->datasend(\@_) # datasend may be given an array ref - or die "datasend timed out while sending header\n"; + or Amavis::Util::cleanup_and_die "datasend timed out while sending header\n"; } # Send mail using SMTP - do multiple transactions if necessary @@ -2839,7 +3149,7 @@ last; } if ($num_recips_undone_after > 0) { - do_log(1, sprintf("Sent to %s recipients via SMTP, %s still to go", + do_log(0, sprintf("Sent to %s recipients via SMTP, %s still to go", $num_recips_undone - $num_recips_undone_after, $num_recips_undone_after)); } @@ -2856,14 +3166,13 @@ my($via,$msginfo,$initial_submission,$filter) = @_; my($which_section) = 'fwd_init'; - # avoid Perl 5.8.2 taint bug, $1 and $2 is tainted - local($1,$2,$3); my($taint) = substr($via,0,0); - $via =~ /^smtp: (?: \[ ([^\]]*) \] | ([^:]*) ) : ([^:]*) /six - or die "Bad fwd method syntax: $via"; - my($relayhost, $relayhost_port) = ($1.$2.$taint, $3.$taint); + my($taint) = substr($via,0,0); + $via =~ /^smtp:([^:]*):([^:]*)(:.*)?$(?!\n)/si + or Amavis::Util::cleanup_and_die "Bad fwd method: $via"; + my($relayhost,$relayhost_port) = ($1.$taint, $2.$taint); my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))} @{$msginfo->per_recip_data}; - my($logmsg) = sprintf("%s via SMTP: [%s]:%s <%s>", + my($logmsg) = sprintf("%s via SMTP: [%s:%s] <%s>", ($initial_submission ? 'SEND' : 'FWD'), $relayhost, $relayhost_port, $msginfo->sender); if (!@per_recip_data) { do_log(5, "$logmsg, nothing to do"); return 1 } @@ -2878,7 +3187,7 @@ # at this point, we have no idea what the user gave us... # a globref? a FileHandle? $msg = IO::Wrap::wraphandle($msg); # now we have an IO::Handle-like obj - $msg->seek(0,0) or die "Can't rewind mail file: $!"; + $msg->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; } # NOTE: Net::SMTP uses alarm to do its own timing. # We need to restart our timer when Net::SMTP is done using it !!! @@ -2897,20 +3206,28 @@ # LocalAddr => 10.11.12.13, # (bind) source IP address ); defined($smtp_handle) - or die "Can't connect to $relayhost port $relayhost_port, $!"; - do_log(5, "Remote host introduces itself as: ".$smtp_handle->domain); + or Amavis::Util::cleanup_and_die "Can't connect to $relayhost port $relayhost_port, $!"; + do_log(5, "Remote host claims to be ".$smtp_handle->domain); section_time($which_section); prolong_timer($which_section, $remaining_time); # restart timer $remaining_time = undef; $which_section = 'fwd-mail-from'; - $smtp_handle->mail(qquote_rfc2821_local($msginfo->sender)) - or die "sending MAIL FROM\n"; + # dk: communicate debug id to mta outbound to adding it to envelope FROM + # dk: fix bug 6526: do not tack on debug id when we're sending to notify + # mta - we're sending a bounce, and don't want to relate this to the + # original msg in the msglog + my $added_debug_id = ($relayhost_port eq 20025) ? "" : " DEBUGID=$debug_id"; + $smtp_handle->mail(qquote_rfc2821_local($msginfo->sender) . + $added_debug_id ) + or Amavis::Util::cleanup_and_die "sending MAIL FROM\n"; section_time($which_section); prolong_timer($which_section); $which_section = 'fwd-rcpt-to'; my($skipping_resp); for my $r (@per_recip_data) { # send recipient addresses + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } if (defined $skipping_resp) { $r->recip_smtp_response($skipping_resp); $r->recip_done(2); next; @@ -2925,11 +3242,10 @@ # timeout, what to do, this is bad do_log(0, "response to RCPT TO not yet available, assuming it will be ok"); } else { # not ok - local($1,$2,$3); - do_log(3, "response to RCPT TO: \"$smtp_resp\""); + do_log(5, "response to RCPT TO: \"$smtp_resp\""); $r->recip_remote_mta($relayhost); $r->recip_remote_mta_smtp_response($smtp_resp); - # $smtp_resp =~ s/^552/452/; # compatibility advised by rfc2821 + $smtp_resp =~ s/^552/452/; # compatibility advised by rfc2821 if ($smtp_resp =~ /^ (\d{3}) \s+ ([245] \. \d{1,3} \. \d{1,3})? \s* (.*) $(?!\n)/xs) { my($resp_code,$resp_enhcode,$resp_msg) = ($1,$2,$3); @@ -2946,10 +3262,7 @@ $skipping_resp = $smtp_resp; } elsif ($smtp_resp =~ /^4/) { $any_tempfail_recips++; - $smtp_response = $smtp_resp if !defined($smtp_response); } - $smtp_response = $smtp_resp - if $smtp_resp=~/^5/ && $smtp_response!~/^5/; #keep first 5x $r->recip_smtp_response($smtp_resp); $r->recip_done(2); } } @@ -2958,7 +3271,7 @@ if ($any_valid_recips && !$any_tempfail_recips) { # send the message $which_section = 'fwd-data'; - $smtp_handle->data or die "sending DATA command\n"; + $smtp_handle->data or Amavis::Util::cleanup_and_die "sending DATA command\n"; $in_datasend_mode = 1; my($smtp_resp) = $smtp_handle->code . " " . $smtp_handle->message; @@ -2990,7 +3303,7 @@ while ( $msg->read($_,16384) > 0 ) { $smtp_handle->datasend($_) - or die "datasend timed out while sending body\n"; + or Amavis::Util::cleanup_and_die "datasend timed out while sending body\n"; } } @@ -3013,6 +3326,8 @@ $smtp_response = "$smtp_code $smtp_msg"; do_log(5, "response to data end: \"$smtp_response\""); for my $r (@per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; $r->recip_remote_mta($relayhost); $r->recip_remote_mta_smtp_response($smtp_response); @@ -3092,6 +3407,8 @@ } if (defined $smtp_response) { for my $r (@per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } if (! $r->recip_done) { # mark it as done $r->recip_smtp_response($smtp_response); $r->recip_done(2); } elsif ($any_valid_recips_and_data_sent && @@ -3113,7 +3430,7 @@ sub mail_via_pipe(@) { my($via,$msginfo,$initial_submission,$filter) = @_; my($taint) = substr($via,0,0); - $via =~ /^pipe:(.*)$(?!\n)/si or die "Bad fwd method: $via"; + $via =~ /^pipe:(.*)$(?!\n)/si or Amavis::Util::cleanup_and_die "Bad fwd method: $via"; my($pipe_args) = $1.$taint; $pipe_args =~ s/^flags=\S*\s*//i; # flags are currently ignored, q implied $pipe_args =~ s/^argv=//i; @@ -3129,7 +3446,7 @@ # at this point, we have no idea what the user gave us... # a globref? a FileHandle? $msg = IO::Wrap::wraphandle($msg); # now we have an IO::Handle-like obj - $msg->seek(0,0) or die "Can't rewind mail file: $!"; + $msg->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; } return 1 if !@per_recip_data; my(@pipe_args) = split(' ',$pipe_args); @@ -3144,14 +3461,11 @@ # 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. - local($1); - if (/^\$\{sender\}$(?!\n)/i) { - push(@command, map { /^(.*)$(?!\n)/s; $1 } # untaint - map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } + if (/^\${sender}$(?!\n)/i) { + push(@command, map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } $msginfo->sender); - } elsif (/^\$\{recipient\}$(?!\n)/i) { - push(@command, map { /^(.*)$(?!\n)/s; $1 } # untaint - map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } + } elsif (/^\${recipient}$(?!\n)/i) { + push(@command, map { $_ eq '' ? '<>' : quote_rfc2821_local($_) } map { $_->recip_final_addr } @per_recip_data); } else { push(@command, $_) } } @@ -3161,15 +3475,15 @@ local(*MP); my($pid); eval { $pid = open(MP,'|-') }; # fork if ($@ ne '') { chomp($@); die "mail_via_pipe (open pipe): $@" } - defined($pid) or die "mail_via_pipe: can't fork: $!"; + defined($pid) or Amavis::Util::cleanup_and_die "mail_via_pipe: can't fork: $!"; if (!$pid) { # child exec {$command[0]} (@command); - exec('/usr/bin/false'); # must not exit, we have to avoid DESTROY handlers + exec('/bin/false'); # must not exit, we have to avoid DESTROY handlers exit EX_TEMPFAIL; # just in case # NOTREACHED } # parent - binmode(MP) or die "Can't set pipe to binmode: $!"; # dflt since Perl 5.8.1 + binmode(MP,":bytes") or Amavis::Util::cleanup_and_die "Can't cancel :utf8 $!" if $unicode_aware; my($hdr_edits) = $msginfo->header_edits; $hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits; my($received_cnt) = $hdr_edits->write_header($msg,\*MP); @@ -3181,7 +3495,7 @@ $msg->print_body(\*MP); } else { while ( $msg->read($_,16384) > 0 ) { - print MP $_ or die "Submitting mail text failed: $!"; + print MP $_ or Amavis::Util::cleanup_and_die "Submitting mail text failed: $!"; } } my($smtp_response); @@ -3194,13 +3508,11 @@ } else { my($err); close(MP) or $err=$!; my($status) = retcode($?); # sendmail program (Postfix variant) can return the following exit codes: - # EX_OK, EX_DATAERR, EX_SOFTWARE, EX_TEMPFAIL, EX_NOUSER, EX_UNAVAILABLE + # EX_OK (=0), EX_DATAERR, EX_SOFTWARE, EX_TEMPFAIL, EX_UNAVAILABLE if ($status == EX_OK) { $smtp_response = "250 2.6.0 Ok"; # submitted to MTA } elsif ($status == EX_TEMPFAIL) { $smtp_response = "450 4.5.0 Temporary failure submitting message"; - } elsif ($status == EX_NOUSER) { - $smtp_response = "550 5.1.1 Recipient unknown"; } elsif ($status == EX_UNAVAILABLE) { $smtp_response = "550 5.5.0 Mail submission service unavailable"; } else { @@ -3210,6 +3522,8 @@ } $smtp_response .= ", id=" . am_id(); for my $r (@per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; $r->recip_smtp_response($smtp_response); $r->recip_done(2); @@ -3221,7 +3535,7 @@ sub mail_via_bsmtp(@) { my($via,$msginfo,$initial_submission,$filter) = @_; my($taint) = substr($via,0,0); - $via =~ /^bsmtp:(.*)$(?!\n)/si or die "Bad fwd method: $via"; + $via =~ /^bsmtp:(.*)$(?!\n)/si or Amavis::Util::cleanup_and_die "Bad fwd method: $via"; my($bsmtp_file_final) = $1.$taint; $bsmtp_file_final =~ s/%b/$msginfo->body_digest/eg; $bsmtp_file_final =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; @@ -3240,22 +3554,24 @@ # at this point, we have no idea what the user gave us... # a globref? a FileHandle? $msg = IO::Wrap::wraphandle($msg); # now we have an IO::Handle-like obj - $msg->seek(0,0) or die "Can't rewind mail file: $!"; + $msg->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; } local(*MP); eval { open(MP,"> $bsmtp_file_tmp\0") - or die "Can't create BSMTP file $bsmtp_file_tmp: $!"; - binmode(MP,":bytes") or die "Can't set :bytes, $!" if $unicode_aware; - print MP ("EHLO ",$localhost_name,$eol) or die "print failed (EHLO): $!"; + or Amavis::Util::cleanup_and_die "Can't create BSMTP file $bsmtp_file_tmp: $!"; + binmode(MP,":bytes") or Amavis::Util::cleanup_and_die "Can't set :bytes, $!" if $unicode_aware; + print MP ("EHLO ",$localhost_name,$eol) or Amavis::Util::cleanup_and_die "print failed (EHLO): $!"; printf MP ("MAIL FROM:%s BODY=8BITMIME$eol", # avoid conversion to 7bit qquote_rfc2821_local($msginfo->sender)) - or die "print failed (MAIL FROM): $!"; + or Amavis::Util::cleanup_and_die "print failed (MAIL FROM): $!"; for my $r (@per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } print MP ("RCPT TO:",qquote_rfc2821_local($r->recip_final_addr),$eol) - or die "print failed (RCPT TO): $!"; + or Amavis::Util::cleanup_and_die "print failed (RCPT TO): $!"; } - print MP ("DATA",$eol) or die "print failed (DATA): $!"; + print MP ("DATA",$eol) or Amavis::Util::cleanup_and_die "print failed (DATA): $!"; my($hdr_edits) = $msginfo->header_edits; $hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits; my($received_cnt) = $hdr_edits->write_header($msg,\*MP); @@ -3266,15 +3582,15 @@ $msg->print_body(\*MP); } else { while (<$msg>) { - print MP "." or die "print failed-.data: $!" if /^\./; - print MP $_ or die "print failed-data: $!"; + print MP "." or Amavis::Util::cleanup_and_die "print failed-.data: $!" if /^\./; + print MP $_ or Amavis::Util::cleanup_and_die "print failed-data: $!"; } } - print MP (".",$eol) or die "print failed (final dot): $!"; - # print MP ("QUIT",$eol) or die "print failed (QUIT): $!"; - close(MP) or die "Can't close BSMTP file $bsmtp_file_tmp: $!"; + print MP (".",$eol) or Amavis::Util::cleanup_and_die "print failed (final dot): $!"; + # print MP ("QUIT",$eol) or Amavis::Util::cleanup_and_die "print failed (QUIT): $!"; + close(MP) or Amavis::Util::cleanup_and_die "Can't close BSMTP file $bsmtp_file_tmp: $!"; rename($bsmtp_file_tmp, $bsmtp_file_final) - or die "Can't rename BSMTP file to $bsmtp_file_final: $!"; + or Amavis::Util::cleanup_and_die "Can't rename BSMTP file to $bsmtp_file_final: $!"; }; my($err) = $@; my($smtp_response); if ($err eq '') { @@ -3292,6 +3608,8 @@ } $smtp_response .= ", id=" . am_id(); for my $r (@per_recip_data) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; $r->recip_smtp_response($smtp_response); $r->recip_done(2); @@ -3319,9 +3637,8 @@ BEGIN { import Amavis::Conf qw(:platform $viruses_that_fake_sender_re); - import Amavis::Util qw(do_log); - import Amavis::rfc2821_2822_Tools qw( - split_address parse_received fish_out_ip_from_received); + import Amavis::Util qw(do_log set_debug_id do_debug_log); + import Amavis::rfc2821_2822_Tools qw(split_address); } use Mail::Address; @@ -3340,7 +3657,7 @@ my($localpart,$domain) = split_address($sender); # extract the RFC2822 'from' address, ignoring phrase and comment chomp($from); - { local($1,$2,$3,$4); # avoid Perl 5.8.0 & 5.8.2 bug, $1 gets tainted ! + { local($1,$2,$3,$4); # avoid Perl 5.8.0 bug, $1 gets tainted $from = (Mail::Address->parse($from))[0]; } $from = $from->address if $from ne ''; @@ -3376,7 +3693,6 @@ && lc($sender) ne lc($1); } } - if (defined $viruses_that_fake_sender_re) { for my $vn (@$virusname_list) { my($result,$patt) = $viruses_that_fake_sender_re->lookup_re($vn); if ($result) { @@ -3385,7 +3701,6 @@ last; } } - } $best_try_originator; } @@ -3396,22 +3711,16 @@ sub ip_addr_to_name($) { my($addr) = shift; # quad-dot address string my($binaddr) = pack('C4',split(/\./,$addr)); # to binary string - do_log(5, "ip_addr_to_name: DNS reverse-resolving: $addr"); my(@addr) = gethostbyaddr($binaddr,2); # IP -> name - my($result) = '['.$addr.']'; # IP address in brackets if nothing matches if (@addr) { my($name,$aliases,$addrtype,$length,@addrs) = @addr; if ($name =~ /\.[a-zA-Z]+$(?!\n)/) { - do_log(5, "ip_addr_to_name: DNS forward-resolving: $name"); my(@raddr) = gethostbyname($name); # name -> IP my($rname,$raliases,$raddrtype,$rlength,@raddrs) = @raddr; - for my $ra (@raddrs) { - if (lc($ra) eq lc($binaddr)) { $result = $name; last } + for my $ra (@raddrs) { return $name if lc($ra) eq lc($binaddr) } } } - } - do_log(3, "ip_addr_to_name: returning: $result"); - $result; + '[' . $addr . ']'; # return IP address in brackets if nothing matches } # Obtain and parse the first entry (chronologically) in the 'Received:' header @@ -3421,12 +3730,20 @@ my($entity) = shift; my($first_received); if (defined($entity)) { - my($fields) = parse_received($entity->head->get('received',-1)); - if (exists $fields->{'from'}) { - my($item,$v1,$v2,$v3,$comment) = @{$fields->{'from'}}; - $first_received = join(' ',$item,$comment); - }; - do_log(5, "first_received_from: $first_received"); + my($received) = $entity->head->get('received',-1); # last Received: + $received =~ s/\n([ \t])/$1/g; # unfold + $received =~ s/[\r\n]/ /g; # turn remaining CR or NL into spaces + $first_received = $received; + if ($received =~ # not an exact science this parsing + /^ (?: \( [^)]* \) | < [^>]* > | \[ [^]]* \] | [^(<\[] )*? + \b from \s+ + ( (?: \( [^)]* \) | < [^>]* > | \[ [^]]* \] | [^(<\[] )*? ) + (\s+ (by|via|with|id|for) \s+ .*)? + \s* ; [^;]*? $(?!\n)/xi) { + my($taint) = substr($received,0,0); + $first_received = $1.$taint; + } + $received =~ s/[ \t]+$(?!\n)//; # trim trailing spaces } $first_received; }; @@ -3446,16 +3763,17 @@ my($originator) = unmangle_sender($sender, $entity->head->get('from',0), $virusname_list); return ($originator,$originator) if defined $originator; + my($first_received) = first_received_from($entity); my($first_received_from_ip); - my(@received) = $entity->head->get('received'); - if (@received > 0) { - $first_received_from_ip = fish_out_ip_from_received($received[-1]); - } - if ($first_received_from_ip eq '' && @received > 1) { - $first_received_from_ip = fish_out_ip_from_received($received[-2]); + if ($first_received =~ + / \[ (\d{1,3} \. \d{1,3} \. \d{1,3} \. \d{1,3}) \] /x) { + $first_received_from_ip = $1; + } elsif ($first_received =~ + / (\d{1,3} \. \d{1,3} \. \d{1,3} \. \d{1,3}) (?!\d) /x) { + $first_received_from_ip = $1; } $originator = '?@' . ip_addr_to_name($first_received_from_ip) - if $first_received_from_ip ne ''; + if defined $first_received_from_ip; (undef, $originator); } @@ -3472,7 +3790,7 @@ @ISA = qw(Exporter); } BEGIN { - import Amavis::Util qw(do_log); + import Amavis::Util qw(do_log set_debug_id do_debug_log); } sub new($;$) { # create a file name generator object @@ -3580,7 +3898,6 @@ &check_header_validity); } use Errno qw(ENOENT); -use POSIX qw(WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED); use MIME::Parser; use MIME::Words; use Convert::TNEF; @@ -3591,7 +3908,7 @@ use File::Copy; BEGIN { - import Amavis::Util qw(do_log retcode prolong_timer sanitize_str min max + import Amavis::Util qw(do_log set_debug_id do_debug_log retcode prolong_timer sanitize_str min max rmdir_flat rmdir_recursively run_command); import Amavis::Timing qw(section_time); import Amavis::Conf qw(:platform :confvars :unpack); @@ -3605,11 +3922,13 @@ use vars qw($rem_quota); # remaining bytes quota for unpacked mail use vars qw($file_generator_object); -# is any mail component password protected or otherwise non-decodable? -use vars qw($any_undecipherable); + +my %attachfiletype_list; + sub init($$) { my($mail_size); ($file_generator_object,$mail_size) = @_; + %attachfiletype_list = {}; # init $threshold = 14; $avail_quota = $rem_quota = # quota in bytes max($MIN_EXPANSION_QUOTA, @@ -3644,15 +3963,15 @@ "@$pe_lines" !~ m{^[a-zA-Z0-9/\@:;,. \t\n_-]*$(?!\n)}s) { my($newpart) = "$tempdir/parts/" . getfilename(); local *PRE; - open(PRE, ">$newpart") or die "Can't create $pe_name $newpart: $!"; + open(PRE, ">$newpart") or Amavis::Util::cleanup_and_die "Can't create $pe_name $newpart: $!"; binmode(PRE,":bytes") - or die "Can't cancel :utf8 mode: $!" if $unicode_aware; + or Amavis::Util::cleanup_and_die "Can't cancel :utf8 mode: $!" if $unicode_aware; my($len); for (@$pe_lines) { - print PRE $_ or die "Can't write $pe_name to $newpart: $!"; + print PRE $_ or Amavis::Util::cleanup_and_die "Can't write $pe_name to $newpart: $!"; $len += length($_); } - close(PRE) or die "Can't close $pe_name $newpart: $!"; + close(PRE) or Amavis::Util::cleanup_and_die "Can't close $pe_name $newpart: $!"; consumed_bytes($len,'mime_decode_pre_epi'); } } @@ -3664,6 +3983,7 @@ # $fileh may be an open file handle, or a file name of a part my($parser) = MIME::Parser->new; + section_time('mime_decode_pre'); $parser->filer(Amavis::Unpackers::OurFiler->new( "$tempdir/parts", $file_generator_object)); $parser->ignore_errors(1); # also is the default @@ -3673,8 +3993,8 @@ my($entity); if (ref($fileh)) { # assume open file handle do_log(4,"Extracting mime components"); - $fileh->seek(0,0) or die "Can't rewind mail file: $!"; - local($1,$2,$3,$4); # avoid Perl 5.8.0 & 5.8.2 bug, $1 gets tainted! + $fileh->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; + local($1,$2,$3,$4); # avoid Perl 5.8.0 bug, $1 gets tainted $entity = $parser->parse($fileh); } else { # assume $fileh is a file name do_log(4,"Extracting mime components from $fileh"); @@ -3715,7 +4035,7 @@ else { # new header if (!defined($curr_head)) { # no previous complete header } else { - local($1,$2,$3); my($taint) = substr($curr_head,0,0); + my($taint) = substr($curr_head,0,0); # obsolete rfc822 syntax allowed whitespace before colon my($field_name,$field_body) = $curr_head =~ /^([!-9;-\176]+)[ \t]*:(.*)$(?!\n)/s @@ -3727,9 +4047,6 @@ $msg1 = "Non-encoded 8-bit data"; } elsif ($curr_head =~ /^(.*?)([^\000-\377])(.*)$(?!\n)/s) { $msg1 = "Non-encoded Unicode character"; - } elsif ($curr_head =~ /^()()([ \t]+)$/m) { - $msg1 ="Improper folded header field ". - "made up entirely of whitespace"; } if (defined $msg1) { my($pre,$ch,$post) = ($1.$taint, $2.$taint, $3.$taint); @@ -3766,7 +4083,13 @@ $file_generator_object->file_type_long($part) ) { next if $ft eq ''; do_log(5, "check_for_banned ($part) - file type: $ft"); - my($result,$patt) = $acl_re->lookup_re($ft); + my($result,$patt); + if (ref($acl_re) !~ /CODE/) { + ($result,$patt) = $acl_re->lookup_re($ft); + } + else{ + ($result,$patt) = &$acl_re($ft); + } if ($result) { push(@banned, $ft); do_log(2, "Banned file contents type: $ft (patt: $patt)"); @@ -3783,14 +4106,14 @@ my($head) = $ent->head; my($val,$val_decoded); $val = $head->mime_attr('content-disposition.filename'); if ($val ne '') { - push(@rn,$val); - $val_decoded = MIME::Words::decode_mimewords($val); + eval { $val_decoded = Encode::decode('MIME-Header', $val); }; + utf8::decode($val_decoded); push(@rn,$val_decoded) if $val_decoded ne $val; } $val = $head->mime_attr('content-type.name'); if ($val ne '') { - push(@rn,$val) if !grep {$_ eq $val} @rn; - $val_decoded = MIME::Words::decode_mimewords($val); + eval { $val_decoded = Encode::decode('MIME-Header', $val); }; + utf8::decode($val_decoded); push(@rn,$val_decoded) if !grep {$_ eq $val_decoded} @rn; } } @@ -3798,20 +4121,39 @@ do_log(5, "check_for_banned - mime-type: $mt"); do_log(5, "check_for_banned - eff. mime-type: $et") if $et ne $mt; do_log(5, "check_for_banned - declared names: ".join(", ",@rn)) if @rn; - my($result,$patt) = $acl_re->lookup_re($mt); # mime type + + my($result,$patt); + if (ref($acl_re) !~ /CODE/) { + ($result,$patt) = $acl_re->lookup_re($mt); # mime type + } + else{ + ($result,$patt) = &$acl_re($mt); # effective mime type + } + if ($result) { push(@banned, $mt); do_log(2, "Banned Content-Type: $mt (patt: $patt)"); } if ($et ne $mt) { + if (ref($acl_re) !~ /CODE/) { ($result,$patt) = $acl_re->lookup_re($et); # effective mime type + } + else{ + ($result,$patt) = &$acl_re($et); # effective mime type + } + if ($result) { push(@banned, $et); do_log(2, "Banned efective Content-Type: $et (patt: $patt)"); } } for my $rn (@rn) { + if (ref($acl_re) !~ /CODE/) { ($result,$patt) = $acl_re->lookup_re($rn); # recommended file name + } + else { + ($result,$patt) = &$acl_re($rn); # effective mime type + } if ($result) { push(@banned, $rn); do_log(2, "Banned declared file name: $rn (patt: $patt)"); @@ -3819,7 +4161,6 @@ } push(@unvisited, $ent->parts); } - for (@banned) { $_ = sanitize_str($_); $_ = '"'.$_.'"' if / / } \@banned; # return a listref of violations, possibly empty } @@ -3829,29 +4170,24 @@ sub determine_file_types($$$) { my($partslist,$tempdir,$file_generator_object) = @_; - $file ne '' or die "Unix utility file(1) not available, but is needed"; + $file ne '' or Amavis::Util::cleanup_and_die "Unix utility file(1) not available, but is needed"; for my $part (@$partslist) { my($filename) = "$tempdir/parts/$part"; my($filetype) = ''; - my($proc_fh) = run_command(undef, undef, $file, $filename); + my($proc_fh) = run_command(undef, '/dev/null', $file, $filename); while( defined($_ = $proc_fh->getline) ) { $filetype .= $_ } my($err); $proc_fh->close or $err=$!; my($ret) = retcode($?); - $ret==0 or die "'file' utility ($file) failed, status=$ret ($? $err)"; + #$ret==0 or Amavis::Util::cleanup_and_die "'file' utility ($file) failed, status=$ret ($? $err)"; + next if( $ret != 0 ); chomp($filetype); my($taint) = substr($filetype,0,0); # remove file name - $filetype = $1.$taint if $filetype=~/^.+?:[\t ](.*)$(?!\n)/s; - section_time('get-file-type'); + $filetype = $1.$taint if $filetype=~/^.+?: (.*)$(?!\n)/s; local($_) = $filetype; my($ty); # try to classify some common types and give them short type name - # _last_ match wins! /^(ASCII|text|uuencoded|xxencoded|binhex)/i and $ty = '.asc'; - /^Emacs.*byte-compiled Lisp data/i and $ty = '.asc'; # a BinHex perhaps - - /^(uuencoded|xxencoded)/i and $ty = '.uue'; - /^(binhex)/i and $ty = '.hqx'; ### 'file' is a bit too trigger happy to claim something is 'mail text' # /RFC 822 mail text/ and $ty = '.mail'; @@ -3860,8 +4196,9 @@ /^Non-ISO.*ASCII\b.*\btext/i and $ty = '.txt'; /^Unicode\b.*\btext/i and $ty = '.txt'; /HTML document text/i and $ty = '.html'; - /^PGP encrypted data\b/ and $ty = '.pgp'; - /^PGP armored\b/ and $ty = '.pgp.asc'; + /^PGP armored data/i and $ty = '.pgp.asc'; + /^PGP armored data signed message/i and $ty = '.pgp.asc'; + /^JPEG image data/i and $ty = '.jpg'; /^GIF image data/i and $ty = '.gif'; /^PNG image data/i and $ty = '.png'; @@ -3881,32 +4218,36 @@ /^compiled Java class data/i and $ty = '.java'; /^data$/i and $ty = '.dat'; - /^frozen/i and $ty = '.F'; - /^compress'd/i and $ty = '.Z'; /^gzip compressed/i and $ty = '.gz'; - /^bzip2? compressed/i and $ty = '.bz2'; - /^lzop compressed/i and $ty = '.lzo'; + /^compress'd/i and $ty = '.Z'; + /^bzip2 compressed/i and $ty = '.bz2'; + /^(?:GNU |POSIX )?tar archive/i and $ty = '.tar'; /^Zip archive/i and $ty = '.zip'; /^RAR archive/i and $ty = '.rar'; - /^LHA.*archive/i and $ty = '.lha'; # or .lzh + /^LHA.*archive/i and $ty = '.lha'; /^ARC archive/i and $ty = '.arc'; /^ARJ archive/i and $ty = '.arj'; /^Zoo archive/i and $ty = '.zoo'; - /^(?:GNU |POSIX )?tar archive\b/i and $ty = '.tar'; - /^(?:ASCII )?cpio archive\b/i and $ty = '.cpio'; /^(Transport Neutral Encapsulation Format|TNEF)/i and $ty = '.tnef'; /executable/i and $ty = '.exe'; + /executable.*\((?:DLL|driver|device driver)\)/i and $ty = '.dll'; /script text executable/i and $ty = '.txt'; /^can't stat\b/ and $ty = '.empty'; # file(1) diagnostics /^empty$/i and $ty = '.empty'; + # Bug#12738, in case of no magic header scripts, such as .vbs + /^ASCII English text/i and $ty = ''; + + do_log(4, "File-type of $part: $filetype" . (defined $ty ? "; ($ty)" : "") ); + + if ($ty eq '' && $attachfiletype_list{$filename}) { + $ty = "." . $attachfiletype_list{$filename}; + } - do_log(4, "File-type of $part: $filetype" . - (defined $ty ? "; ($ty)" : "") ); $file_generator_object->file_type_long($part, $filetype); $file_generator_object->file_type($part, $ty); - $any_undecipherable++ if $ty eq '.pgp'; }; + section_time('get-file-type'); } # recursively descend into a directory $dir containing potentially unsafe @@ -3920,39 +4261,37 @@ do_log(4,"flatten_and_tidy_dir: processing directory \"$dir\""); my($f); my($cnt_r,$cnt_u) = (0,0); my($consumed_bytes) = 0; local(*DIR); - chmod(0750, $dir) or die "Can't change protection of \"$dir\": $!"; - opendir(DIR, $dir) or die "Can't open directory $dir: $!"; + opendir(DIR, $dir) or Amavis::Util::cleanup_and_die "Can't open directory $dir: $!"; while (defined($f = readdir(DIR))) { my($msg); my($errn) = lstat("$dir/$f") ? 0 : 0+$!; if ($errn == ENOENT) { $msg = "does not exist" } elsif ($errn) { $msg = "inaccessible: $!" } + elsif (!-r _) { $msg = "not readable" } if (defined $msg) { die "flatten_and_tidy_dir: \"$dir/$f\" $msg" } next if ($f eq '.' || $f eq '..') && -d _; - local($1); $f = $1 if $f =~ /^(.+)$(?!\n)/s; # untaint if (-d _) { $consumed_bytes += flatten_and_tidy_dir("$dir/$f",$outdir); } elsif (-l _) { - $cnt_u++; unlink("$dir/$f") or die "Can't remove soft link \"$dir/$f\": $!"; + $cnt_u++; unlink("$dir/$f") or Amavis::Util::cleanup_and_die "Can't remove soft link \"$dir/$f\": $!"; } elsif (!-f _) { do_log(4,"flatten_and_tidy_dir: NONREGULAR FILE \"$dir/$f\""); - $cnt_u++; unlink("$dir/$f") or die "Can't remove nonregular file \"$dir/$f\": $!"; + $cnt_u++; unlink("$dir/$f") or Amavis::Util::cleanup_and_die "Can't remove nonregular file \"$dir/$f\": $!"; } elsif (-z _) { - $cnt_u++; unlink("$dir/$f") or die "Can't remove \"$dir/$f\": $!"; + $cnt_u++; unlink("$dir/$f") or Amavis::Util::cleanup_and_die "Can't remove \"$dir/$f\": $!"; } else { - chmod(0750,"$dir/$f") - or die "Can't change protection of file \"$dir/$f\": $!"; $consumed_bytes += -s _; my($newpart) = $outdir . '/' . getfilename(); do_log(5,"flatten_and_tidy_dir: renaming \"$dir/$f\" to $newpart"); $cnt_r++; rename("$dir/$f", $newpart) - or die "Can't rename \"$dir/$f\" to $newpart: $!"; + or Amavis::Util::cleanup_and_die "Can't rename \"$dir/$f\" to $newpart: $!"; } } - closedir(DIR) or die "Can't close directory \"$dir\": $!"; - rmdir($dir) or die "Can't remove directory \"$dir\": $!"; + closedir(DIR) or Amavis::Util::cleanup_and_die "Can't close directory \"$dir\": $!"; section_time("ren${cnt_r}-unl${cnt_u}-files"); + rmdir($dir) or Amavis::Util::cleanup_and_die "Can't remove directory \"$dir\": $!"; + section_time('rmdir'); $consumed_bytes; } @@ -3963,7 +4302,6 @@ my($filename) = "$tempdir/parts/$part"; my($filetype) = $file_generator_object->file_type_long($part); my($ty) = $file_generator_object->file_type($part); - $any_undecipherable = 0; # ugly use of module-global variable my($hold); # do_log(4, "decompose_part: $part $filetype ($ty)"); @@ -3976,26 +4314,20 @@ local($_) = $ty; /^\.mail$/ && return do {mime_decode($part,$tempdir); 2}; - /^\.(asc|uue|hqx)$/ && return do_ascii($part,$tempdir); - /^\.F$/ && defined $unfreeze - && return do_uncompress($part,$tempdir,$unfreeze); + /^\.asc$/ && return do_ascii($part,$tempdir); /^\.Z$/ && defined $uncompress - && return do_uncompress($part,$tempdir,$uncompress); + && return do_uncompress($part,$tempdir,"$uncompress -c"); /^\.bz2$/ && defined $bzip2 - && return do_uncompress($part,$tempdir,"$bzip2 -d"); + && return do_uncompress($part,$tempdir,"$bzip2 -d -c"); /^\.gz$/ && defined $gzip - && return do_uncompress($part,$tempdir,"$gzip -d"); + && return do_uncompress($part,$tempdir,"$gzip -d -c"); /^\.gz$/ && return do_gunzip($part,$tempdir); # fallback - /^\.lzo$/ && defined $lzop - && return do_uncompress($part,$tempdir,"$lzop -d"); - /^\.cpio$/ && defined $cpio && return do_cpio($part,$tempdir); -# /^\.tar$/ && defined $cpio && return do_cpio($part,$tempdir); - /^\.tar$/ && return do_tar($part,$tempdir); # fallback + /^\.tar$/ && return do_tar($part,$tempdir); /^\.zip$/ && return do_unzip($part,0,$tempdir); /^\.rar$/ && return do_unrar($part,0,$tempdir); - /^\.(lha|lzh)$/ && return do_lha($part,0,$tempdir); + /^\.lha$/ && return do_lha($part,0,$tempdir); /^\.arc$/ && return do_arc($part,$tempdir); - /^\.arj$/ && return do_unarj($part,0,$tempdir); + /^\.arj$/ && return do_unarj($part,$tempdir); /^\.zoo$/ && return do_zoo($part,$tempdir); /^\.tnef$/ && return do_tnef($part,$tempdir); /^\.exe$/ && return do_executable($part,$tempdir); @@ -4019,14 +4351,13 @@ do_log(5, "file type is $filetype, retain original $part"); $sts = 2; } - if ($sts == 1) { - do_log(5, "decompose_part: deleting $filename, it has done its job"); - unlink($filename) or die "Can't unlink $filename: $!"; - } + #if ($sts == 1) { + #unlink($filename) or die "Can't unlink $filename: $!"; + #} do_log(4, "decompose_part: $part - " . ['atomic', 'archive, unpacked', 'source retained']->[$sts]); section_time('decompose_part'); - ($hold, $any_undecipherable); + $hold; } # @@ -4046,7 +4377,7 @@ $ENV{TMPDIR} = $TEMPBASE if $ENV{TMPDIR} eq ''; $sts = Convert::UUlib::Initialize(); - $sts==RET_OK or die "Convert::UUlib::Initialize failed: " . + $sts==RET_OK or Amavis::Util::cleanup_and_die "Convert::UUlib::Initialize failed: " . Convert::UUlib::strerror($sts); ($sts,$count) = Convert::UUlib::LoadFile("$tempdir/parts/$part"); if ($sts != RET_OK) { @@ -4067,22 +4398,21 @@ $uu->size, $uu->filename)); if (! ($uu->state & FILE_OK) ) { $any_errors++; - do_log(1, "do_ascii: Convert::UUlib info: $j not decodable, " . + do_log(1, "do_ascii: Convert::UUlib info: $j not decodeable, " . $uu->state); } else { my($newpart) = "$tempdir/parts/" . getfilename(); $! = undef; $sts = $uu->decode($newpart); # decode to file $newpart my($err_decode) = "$!"; - chmod(0750,$newpart) or $!==ENOENT # chmod, don't panic if no file - or die "Can't change protection of \"$newpart\": $!"; + my($statmsg); my($errn) = stat($newpart) ? 0 : 0+$!; if ($errn == ENOENT) { $statmsg = "does not exist" } elsif ($errn) { $statmsg = "inaccessible: $!" } elsif (! -f _) { $statmsg = "not a regular file" } if (defined $statmsg) - { $statmsg = "; result file status: $newpart $statmsg" } + { $statmsg = ", stat on decoded: $newpart $statmsg" } consumed_bytes(0+(-s _), 'do_ascii'); if ($sts==RET_OK && !defined($statmsg)) { @@ -4125,6 +4455,11 @@ local *OUTPART; my($any_unsupp_compmeth, $any_encrypted); for my $mem ($zip->members()) { + # track the special false positive of Worm.Bagle.Gen-zippwd + if ($mem->fileName =~ /\.[KT]32$/ || $mem->fileName =~ /SENDEXT\.[LS]..$/ + ||$mem->fileName =~ /SECURITY\.CHK/ ) { + push(@Amavis::virus_exception, $mem->fileName); + } my($compmeth) = $mem->compressionMethod; if ($compmeth!=COMPRESSION_DEFLATED && $compmeth!=COMPRESSION_STORED) { $any_unsupp_compmeth = $compmeth; @@ -4134,30 +4469,38 @@ my($oldc) = $mem->desiredCompressionMethod(COMPRESSION_STORED); $sts = $mem->rewindData(); $sts == AZ_OK - or die "$part: error rew. member data: $err_nm[$sts] ($sts)"; + or Amavis::Util::cleanup_and_die "$part: error rew. member data: $err_nm[$sts] ($sts)"; my($newpart) = "$tempdir/parts/" . getfilename(); - open(OUTPART,">$newpart") or die "Can't create file $newpart: $!"; - binmode(OUTPART) or die "Can't set $newpart to binmode: $!"; + + # bug12738 - save given file extention into hash {part0001 : file extension} + my @arrs = split /\./, $mem->fileName; + $attachfiletype_list{$newpart} = pop (@arrs); + + open(OUTPART,">$newpart") or Amavis::Util::cleanup_and_die "Can't create file $newpart: $!"; + binmode(OUTPART) or Amavis::Util::cleanup_and_die "Can't set $newpart to binmode: $!"; while ($sts == AZ_OK) { my($buf_ref); ($buf_ref,$sts) = $mem->readChunk(); $sts == AZ_OK || $sts == AZ_STREAM_END - or die "$part: error reading member: $err_nm[$sts] ($sts)"; - print OUTPART ($$buf_ref) or die "Can't write to $newpart: $!"; + or Amavis::Util::cleanup_and_die "$part: error reading member: $err_nm[$sts] ($sts)"; + print OUTPART ($$buf_ref) or Amavis::Util::cleanup_and_die "Can't write to $newpart: $!"; consumed_bytes(length($$buf_ref), 'do_unzip'); } - close(OUTPART) or die "Can't close $newpart: $!"; + close(OUTPART) or Amavis::Util::cleanup_and_die "Can't close $newpart: $!"; $mem->desiredCompressionMethod($oldc); $mem->endRead(); } } - if ($any_unsupp_compmeth) { - $any_undecipherable++; - do_log(0, "do_unzip: $part, unsupported compr. method: $any_unsupp_compmeth"); - } - if ($any_encrypted) { - $any_undecipherable++; - do_log(1, "do_unzip: $part, $any_encrypted members encrypted, archive retained"); - return 2; + if ($any_unsupp_compmeth) + { do_log(0, "do_unzip: $part, unsupported compr. method: $any_unsupp_compmeth") } + if ($any_encrypted) + { + if ($block_pw_prot_zip eq 'Yes') { + push(@Amavis::banned_filename, "Password protected archive"); + } + elsif ($quarantine_pw_prot_zip eq 'Yes') { + push(@Amavis::quarantined_filename, "Password protected archive"); + } + do_log(4, "do_unzip: $part, skipped $any_encrypted encrypted member(s)") } $exec ? 2 : 1; } @@ -4172,13 +4515,12 @@ my($rv) = run_command_copy($newpart, run_command("$tempdir/parts/$part", undef, split(' ',$decompressor) )); - if ($rv) { unlink($newpart) or die "Can't unlink $newpart: $!" }; - if (!WIFEXITED($rv)) { - die sprintf('Error running decompressor %s on %s, DIED on signal %d', - $decompressor, $part, WTERMSIG($rv)); - } elsif (WEXITSTATUS($rv) != 0) { - die sprintf('Error running decompressor %s on %s, exit status %d', - $decompressor, $part, WEXITSTATUS($rv)); + my($retcode) = retcode($rv); + do_log(5, sprintf('do_uncompress(%s) status %d (signal %d)', + $decompressor, $rv>>8, $rv&255)); + if ($retcode) { + unlink($newpart) or Amavis::Util::cleanup_and_die "Can't unlink $newpart: $!"; + die "Error running $decompressor on $part, status: $retcode"; } 1; } @@ -4191,19 +4533,19 @@ local *OUTPART; my($gz) = gzopen("$tempdir/parts/$part", "rb") - or die "do_gunzip: Error opening $tempdir/parts/$part: $gzerrno"; + or Amavis::Util::cleanup_and_die "do_gunzip: Error opening $tempdir/parts/$part: $gzerrno"; my($newpart) = "$tempdir/parts/" . getfilename(); - open(OUTPART, ">$newpart") or die "Can't create $newpart: $!"; - binmode(OUTPART) or die "Can't set $newpart to binmode: $!"; + open(OUTPART, ">$newpart") or Amavis::Util::cleanup_and_die "Can't create $newpart: $!"; + binmode(OUTPART) or Amavis::Util::cleanup_and_die "Can't set $newpart to binmode: $!"; my($buffer); while ($gz->gzread($buffer) > 0) { - print OUTPART $buffer or die "Can't write to $newpart: $!"; + print OUTPART $buffer or Amavis::Util::cleanup_and_die "Can't write to $newpart: $!"; consumed_bytes(length($buffer),'do_gunzip'); } - close(OUTPART) or die "Can't close $newpart: $!"; + close(OUTPART) or Amavis::Util::cleanup_and_die "Can't close $newpart: $!"; if ($gzerrno != Z_STREAM_END) { do_log(0,"do_gunzip: Error reading $tempdir/parts/$part: $gzerrno"); - unlink($newpart) or die "Can't unlink $newpart: $!"; + unlink($newpart) or Amavis::Util::cleanup_and_die "Can't unlink $newpart: $!"; $gz->gzclose(); return 0; } @@ -4211,7 +4553,8 @@ 1; } -# untar any tar archives with Archive-Tar, extract each file individually +# untar any tar archives with Archive-Tar +# extract each file individually sub do_tar($$) { my($part,$tempdir) = @_; @@ -4230,11 +4573,16 @@ # need some error handling, too my $data = $tar->get_content($_); my $newpart = "$tempdir/parts/" . getfilename(); - open(OUTPART, ">$newpart") or die "Can't create $newpart: $!"; - binmode(OUTPART) or die "Can't set $newpart to binmode: $!"; - print OUTPART $data or die "Can't write to $newpart: $!"; + + # Bug13184- save given file extention into hash {part0001 : file extension} + my @arrs = split /\./, $_; + $attachfiletype_list{$newpart} = pop (@arrs); + + open(OUTPART, ">$newpart") or Amavis::Util::cleanup_and_die "Can't create $newpart: $!"; + binmode(OUTPART) or Amavis::Util::cleanup_and_die "Can't set $newpart to binmode: $!"; + print OUTPART $data or Amavis::Util::cleanup_and_die "Can't write to $newpart: $!"; consumed_bytes(length($data),'do_tar'); - close(OUTPART) or die "Can't close $newpart: $!"; + close(OUTPART) or Amavis::Util::cleanup_and_die "Can't close $newpart: $!"; } 1; } @@ -4244,45 +4592,38 @@ my($part,$exec,$tempdir) = @_; return 0 if !$unrar; - my(@common_rar_switches) = qw(-c- -p- -av- -idp); - my($err,$retval,$rv1); - - # unrar exit codes: SUCCESS=0, WARNING=1, FATAL_ERROR=2, CRC_ERROR=3, - # LOCK_ERROR=4, WRITE_ERROR=5, OPEN_ERROR=6, USER_ERROR=7, MEMORY_ERROR=8, - # CREATE_ERROR=9, USER_BREAK=255 # Check whether we can really unrar it - $rv1 = system($unrar, 't', '-inul', @common_rar_switches, '--', + my($rv1) = system($unrar, qw(t -inul -p- -c- -av- -idp --), "$tempdir/parts/$part"); - $err = $!; $retval = retcode($rv1); - if ($retval == 7) { # USER_ERROR - do_log(0, "do_unrar: $unrar does not recognize all switches, ". - "it is probably too old. Retrying without '-av- -idp'. ". - "Upgrade: http://www.rarlab.com/"); - @common_rar_switches = qw(-c- -p-); # retry without new switches - $rv1 = system($unrar, 't', '-inul', @common_rar_switches, '--', - "$tempdir/parts/$part"); - $err = $!; $retval = retcode($rv1); - } - if (!grep {$_==$retval} (0,1,3)) { - # not one of: SUCCESS, WARNING, CRC_ERROR - # NOTE: password protected files in the archive cause CRC_ERROR + my($err) = $!; my($retval) = retcode($rv1); + if (!grep {$_==$retval} (0,1,3)) { #not one of: SUCCESS, WARNING, CRC_ERROR do_log(4, sprintf("unrar 't' returned status %d (signal %d, %s), command: %s", $retval, $rv1&255, $err, $unrar)); return 0; } + # NOTE: password protected files in the archive cause CRC_ERROR + if ($retval == 3) { + if ($block_pw_prot_zip eq 'Yes') { + push(@Amavis::banned_filename, "Password protected archive"); + } + elsif ($quarantine_pw_prot_zip eq 'Yes') { + push(@Amavis::quarantined_filename, "Password protected archive"); + } + do_log(4, "do_unrar: $part, skipped encrypted member(s)"); + return 0; + } - # We have to jump hoops because there is no simple way to - # just list all the files do_log(4,"Expanding RAR archive $part"); - my(@list); my($hypcount) = 0; my($encryptedcount) = 0; my($lcnt) = 0; - my($member_name); my($bytes) = 0; my($last_line); + # We have to jump hoops because there is no simple way to + # just list all the files - my($proc_fh) = run_command(undef,undef, $unrar, - 'v', @common_rar_switches, '--', "$tempdir/parts/$part"); + my(@list); my($hypcount) = 0; my($encryptedcount) = 0; my($lcnt) = 0; + my($member_name); my($bytes) = 0; + my($proc_fh) = run_command(undef,undef, $unrar, qw(v -p- -c- -av- -idp --), + "$tempdir/parts/$part"); while( defined($_ = $proc_fh->getline) ) { - $last_line = $_ if !/^\s*$/; # last nonempty line chomp; if (/^unexpected end of archive/) { last; @@ -4292,7 +4633,7 @@ } elsif ($hypcount == 1) { $lcnt++; if ($lcnt % 2 == 0) { # information line (every other line) - if (!/^\s+(\d+)\s+(\d+)\s+(\d+%|-->|<--)/) { + if (!/^\s+(\d+)\s+(\d+)\s+\d+%/) { do_log(0, "do_unrar: can't parse info line for \"$member_name\": $_"); } elsif (defined $member_name) { do_log(5, "do_unrar: member: \"$member_name\", size: $1"); @@ -4309,17 +4650,9 @@ } } # consume all remaining output to avoid broken pipe - while (defined($_ = $proc_fh->getline)) { $last_line = $_ if !/^\s*$/ } + while( defined($proc_fh->getline) ) {} $err=undef; $proc_fh->close or $err=$!; $retval = retcode($?); - local($1,$2); - if ($last_line !~ /^\s*(\d+)\s+(\d+)/s) { - do_log(4,"do_unrar: WARN: unable to obtain orig total size: $last_line"); - } else { - do_log(4,"do_unrar: summary size: $2, sum of sizes: $bytes") - if abs($bytes - $2) > 100; - $bytes = $2 if $2 > $bytes; - } my($rem_quota_saved) = $rem_quota; consumed_bytes($bytes,'do_unrar-pre'); # pre-check on estimated size $rem_quota = $rem_quota_saved; # if it survives, do it for real later @@ -4327,15 +4660,16 @@ if (!grep {$_==$retval} (0,1)) { # not one of: SUCCESS, WARNING die "unrar: can't get a list of archive members: status=$retval ($? $err)"; } - if (!@list) { - do_log(4, "do_unrar: no archive members, or not an archive altogether"); - return 0 if $exec; - } else { + if (!@list && $encryptedcount > 0) { + do_log(0, sprintf("unrar: all %d members are encrypted, AV checks skipped", + $encryptedcount)); + } + if (@list) { # my $rv = store_mgr($tempdir, \@list, $unrar, - # qw(p -inul -kb), @common_rar_switches, '--', + # qw(p -inul -p- -av- -kb -idp --), # "$tempdir/parts/$part"); - my($proc_fh) = run_command(undef, "&1", $unrar, - qw(x -inul -ver -o- -kb), @common_rar_switches, '--', + my($proc_fh) = run_command(undef, '/dev/null', $unrar, + qw(x -inul -ver -p- -o- -av- -kb -idp --), "$tempdir/parts/$part", "$tempdir/parts/rar/"); my($output) = ''; while( defined($_ = $proc_fh->getline) ) { $output .= $_ } @@ -4349,11 +4683,6 @@ consumed_bytes($b,'do_unrar'); } } - if ($encryptedcount) { - $any_undecipherable++; - do_log(1, "do_unrar: $part, $encryptedcount members encrypted, archive retained"); - return 2; - } $exec ? 2 : 1; } @@ -4363,43 +4692,31 @@ return 0 if !$lha; - # lha needs extension .exe to understand SFX! - symlink("$tempdir/parts/$part", "$tempdir/parts/$part.exe") - or die "Can't symlink $tempdir/parts/$part $tempdir/parts/$part.exe: $!"; - - my($retval) = $exec ? 2 : 1; # Check whether we can really lha it my($checkerr); - my($proc_fh) = run_command(undef,"&1", $lha, 'lq', "$tempdir/parts/$part.exe"); + my($proc_fh) = run_command(undef,"&1", $lha, 'lq', "$tempdir/parts/$part"); while( defined($_ = $proc_fh->getline) ) { $checkerr = 1 if /Checksum error/i; } $proc_fh->close; - if ($? || $checkerr) { - $retval = 0; # consider atomic - } else { - do_log(4,"Expanding LHA archive $part.exe"); + return 0 if $? || $checkerr; + + do_log(4,"Expanding LHA archive $part"); + my(@list); - $proc_fh = run_command(undef, undef, $lha, 'lq', "$tempdir/parts/$part.exe"); + $proc_fh = run_command(undef, undef, $lha, 'lq', "$tempdir/parts/$part"); while( defined($_ = $proc_fh->getline) ) { chomp; next if /\/$(?!\n)/; # ignore directories push(@list, (split(/\s+/))[-1] ); #***??? split on whitespace ??? } - $proc_fh->close or die "Error2 running LHA: $?, $!"; - if (!@list) { - do_log(4, "do_lha: no archive members, or not an archive altogether"); - $retval = 0 if $exec; # consider atomic - } else { - my $rv = store_mgr($tempdir, \@list, $lha, 'pq', "$tempdir/parts/$part.exe"); + $proc_fh->close or Amavis::Util::cleanup_and_die "Error2 running LHA: $?, $!"; + if (@list) { + my $rv = store_mgr($tempdir, \@list, $lha, 'pq', "$tempdir/parts/$part"); do_log(0, sprintf("lha returned status %d (signal %d)", $rv>>8, $rv&255)) if $rv; - $retval = 1; # consider decoded - } } - unlink("$tempdir/parts/$part.exe") - or die "Can't unlink $tempdir/parts/$part.exe: $!"; - $retval; + $exec ? 2 : 1; } # use external program to expand ARC archives; @@ -4438,8 +4755,7 @@ do_log(4,"Expanding ZOO archive $part"); # Zoo needs extension of .zoo! - symlink("$tempdir/parts/$part", "$tempdir/parts/$part.zoo") - or die "Can't symlink $tempdir/parts/$part $tempdir/parts/$part.zoo: $!"; + symlink("$tempdir/parts/$part", "$tempdir/parts/$part.zoo"); my($proc_fh) = run_command(undef, undef, $zoo, 'lf1q', "$tempdir/parts/$part.zoo"); @@ -4454,56 +4770,50 @@ do_log(0, sprintf("zoo returned status %d (signal %d)", $rv>>8, $rv&255)) if $rv; unlink("$tempdir/parts/$part.zoo") - or die "Can't unlink $tempdir/parts/$part.zoo: $!"; + or Amavis::Util::cleanup_and_die "Can't unlink $tempdir/parts/$part.zoo: $!"; } 1; } # use external program to expand ARJ archives -sub do_unarj($$$) { - my($part,$exec,$tempdir) = @_; +sub do_unarj($$) { + my($part,$tempdir) = @_; return 0 if !$unarj; do_log(4,"Expanding ARJ archive $part"); - # options to arj, ignored by unarj - # provide some password in -g to turn fatal error into 'bad password' error - $ENV{ARJ_SW} = "-i -jo -b5 -2h -jyc -ja1 -gsecret -w$TEMPBASE"; + $ENV{ARJ_SW}='-i -jo -b5 -2h -jyc -ja1'; # options to arj, ignored by unarj # unarj needs extension of .arj! symlink("$tempdir/parts/$part", "$tempdir/parts/$part.arj") - or die "Can't symlink $tempdir/parts/$part $tempdir/parts/$part.arj: $!"; + or Amavis::Util::cleanup_and_die "Can't symlink $tempdir/parts/$part $tempdir/parts/$part.arj: $!"; - # obtain total original size of archive members from the index/listing - my($proc_fh) = run_command(undef,'/dev/null',$unarj,'l',"$tempdir/parts/$part.arj"); - my($last_line); - while (defined($_ = $proc_fh->getline)) { $last_line = $_ if !/^\s*$/ } - my($err) = undef; $proc_fh->close or $err = $!; my($retval) = retcode($?); - if (!grep { $_ == $retval } (0,1,3)) { # not one of: success, warn, CRC err - die "unarj: can't get a list of archive members: status=$retval ($? $err)"; - } - local($1,$2); - if ($last_line !~ /^\s*(\d+)\s*files\s*(\d+)/s) { - do_log(0,"do_unarj: WARN: unable to obtain orig size of files: $last_line"); - } else { - my($rem_quota_saved) = $rem_quota; - consumed_bytes($2,'do_unarj-pre'); # pre-check on estimated size - $rem_quota = $rem_quota_saved; # if it survives, do it for real later - } - # unarj has very limited extraction options, arj is much better! - mkdir("$tempdir/parts/arj", 0750) or die "Can't mkdir $tempdir/parts/arj: $!"; - chdir("$tempdir/parts/arj") or die "Can't chdir to $tempdir/parts/arj: $!"; + # unarj has very limited extraction options! This may not be secure! + mkdir("$tempdir/parts/arj", 0750) or Amavis::Util::cleanup_and_die "Can't mkdir $tempdir/parts/arj: $!"; + chdir("$tempdir/parts/arj") or Amavis::Util::cleanup_and_die "Can't chdir to $tempdir/parts/arj: $!"; # avoiding shell: don't call system("... >/dev/null") - my($proc_fh) = run_command(undef,"&1",$unarj,'e',"$tempdir/parts/$part.arj"); - my($encryptedcount,$skippedcount) = (0,0); - while (defined($_ = $proc_fh->getline)) { - $encryptedcount++ - if /^(Extracting.*\bBad file data or bad password|File is password encrypted, Skipped)\b/s; - $skippedcount++ - if /(\bexists|^File is password encrypted|^Unsupported .*), Skipped\b/s; + my($proc_fh) = run_command(undef, '/dev/null', + $unarj, 'e', "$tempdir/parts/$part"); + my($output) = ''; + while( defined($_ = $proc_fh->getline) ) { $output .= $_ } + my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?); + + # check for password encrypted arj file and bann it if necessary + if ($output =~ /File is password encrypted, Skipped/) { + if ($block_pw_prot_zip eq 'Yes') { + push(@Amavis::banned_filename, "Password protected archive"); } - $err; $proc_fh->close or $err=$!; $retval = retcode($?); - chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!"; + elsif ($quarantine_pw_prot_zip eq 'Yes') { + push(@Amavis::quarantined_filename, "Password protected archive"); + } + do_log(4, "do_unarj: $part, skipped encrypted member(s)"); + } + + + + # nonzero exit status does not mean no files were extracted! + # (example: status 1 may indicate one of members has a bad CRC) + chdir($TEMPBASE) or Amavis::Util::cleanup_and_die "Can't chdir to $TEMPBASE: $!"; my($errn) = stat("$tempdir/parts/arj") ? 0 : 0+$!; if ($errn != ENOENT) { @@ -4511,16 +4821,9 @@ consumed_bytes($bytes, 'do_unarj'); } unlink("$tempdir/parts/$part.arj") - or die "Can't unlink $tempdir/parts/$part.arj: $!"; - if (!grep { $_== $retval } (0,1,3)) { # not one of: success, warn, CRC err - die "unarj: can't extract archive members: status=$retval ($? $err)"; - } - if ($encryptedcount || $skippedcount) { - $any_undecipherable++; - do_log(1, "do_unarj: $part, $encryptedcount members encrypted, $skippedcount skipped, archive retained"); - return 2; - } - $exec ? 2 : 1; + or Amavis::Util::cleanup_and_die "Can't unlink $tempdir/parts/$part.arj: $!"; + die "unarj returned status $retval ($err)" if $retval; + 1; } # use Convert-TNEF @@ -4529,71 +4832,31 @@ do_log(4,"Extracting TNEF attachment $part"); - chdir("$tempdir/parts") or die "Can't chdir to $tempdir/parts: $!"; + chdir("$tempdir/parts") or Amavis::Util::cleanup_and_die "Can't chdir to $tempdir/parts: $!"; my $tnef = Convert::TNEF->read_in("$tempdir/parts/$part",{ignore_checksum=>"true"}); if (!$tnef) { - chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!"; + chdir($TEMPBASE) or Amavis::Util::cleanup_and_die "Can't chdir to $TEMPBASE: $!"; return 0; # Not TNEF - treat as atomic } local *OUTPART; for ($tnef->attachments) { if (my $handle = $_->datahandle) { my $newpart = "$tempdir/parts/" . getfilename(); - open(OUTPART, ">$newpart") or die "Can't create $newpart: $!"; - binmode(OUTPART) or die "Can't set $newpart to binmode: $!"; + open(OUTPART, ">$newpart") or Amavis::Util::cleanup_and_die "Can't create $newpart: $!"; + binmode(OUTPART) or Amavis::Util::cleanup_and_die "Can't set $newpart to binmode: $!"; if (defined(my $file = $handle->path)) { copy($file, \*OUTPART); } else { my($s) = $handle->as_string; - print OUTPART $s or die "Can't write to $newpart: $!"; + print OUTPART $s or Amavis::Util::cleanup_and_die "Can't write to $newpart: $!"; consumed_bytes(length($s),'do_tnef'); } - close(OUTPART) or die "Can't close $newpart: $!"; + close(OUTPART) or Amavis::Util::cleanup_and_die "Can't close $newpart: $!"; consumed_bytes(-s($newpart), 'do_tnef'); } } $tnef->purge; - chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!"; - 1; -} - -# cpio supports the following archive formats: binary, old ASCII, -# new ASCII, crc, HPUX binary, HPUX old ASCII, old tar, and POSIX.1 tar -sub do_cpio($$) { - my($part,$tempdir) = @_; - return 0 if !$cpio; - do_log(4,"Expanding cpio archive $part"); my($bytes) = 0; - my($proc_fh) = run_command("$tempdir/parts/$part", undef, - $cpio, qw(-t -v -n --quiet) ); - while( defined($_ = $proc_fh->getline) ) { - chomp; - next if /^\d+ blocks\z/; # needed if --quiet is not specified - if (!/^(?:\S+\s+){4}(\d+)\s+((?:\S+\s+){2}\S+)\s+(.*)$/) { - do_log(0, "do_cpio: can't parse toc line: $_"); - } else { - do_log(5, "do_cpio: member: \"$3\", size: $1"); - $bytes += $1 if $1>0; - } - } - # consume remaining output to avoid broken pipe - while( defined($proc_fh->getline) ) {} - my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?); - - my($rem_quota_saved) = $rem_quota; - consumed_bytes($bytes,'do_cpio-pre'); # pre-check on estimated size - $rem_quota = $rem_quota_saved; # if it survives, do it for real - - mkdir("$tempdir/parts/cpio", 0750) or die "Can't mkdir $tempdir/parts/cpio: $!"; - chdir("$tempdir/parts/cpio") or die "Can't chdir to $tempdir/parts/cpio: $!"; - my($proc_fh) = run_command("$tempdir/parts/$part", '/dev/null', $cpio, - qw(-i -d --no-absolute-filenames --no-preserve-owner --quiet)); - my($output) = ''; - while( defined($_ = $proc_fh->getline) ) { $output .= $_ } - $err=undef; $proc_fh->close or $err=$!; $retval = retcode($?); - do_log(0, "cpio returned status $retval ($? $err) $output") if $retval; - chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!"; - my($b)=flatten_and_tidy_dir("$tempdir/parts/cpio","$tempdir/parts"); - consumed_bytes($b,'do_cpio'); + chdir($TEMPBASE) or Amavis::Util::cleanup_and_die "Can't chdir to $TEMPBASE: $!"; 1; } @@ -4620,11 +4883,6 @@ chomp($@); do_log(0,"do_executable/do_unlha failed, ignoring: $@") if $@; -# # ARJ? -# return 2 if eval{do_unarj($part,1,$tempdir)}; -# chomp($@); -# do_log(0,"do_executable/do_unarj failed, ignoring: $@") if $@; - return 0; } @@ -4639,31 +4897,32 @@ sub run_command_copy($$) { my($outfile,$ifh) = @_; my($ofh) = IO::File->new; - $ofh->open($outfile,'>') or die "Can't create file $outfile: $!"; - binmode($ofh) or die "Can't set file $outfile to binmode: $!"; - binmode($ifh) or die "Can't set binmode on pipe: $!"; + $ofh->open($outfile,'w') or Amavis::Util::cleanup_and_die "Can't create file $outfile: $!"; + binmode($ofh) or Amavis::Util::cleanup_and_die "Can't set file $outfile to binmode: $!"; + binmode($ifh) or Amavis::Util::cleanup_and_die "Can't set binmode on pipe: $!"; my($len, $buf, $offset, $written); while ($len = $ifh->sysread($buf,16384)) { $offset = 0; while ($len > 0) { # handle partial writes $written = syswrite($ofh, $buf, $len, $offset); - defined($written) or die "syswrite to $outfile failed: $!"; + defined($written) or Amavis::Util::cleanup_and_die "syswrite to $outfile failed: $!"; consumed_bytes($written, "run_command_copy"); $len -= $written; $offset += $written; } } $ifh->close; my($rv) = $?; - $ofh->close or die "Can't close $outfile: $!"; + $ofh->close or Amavis::Util::cleanup_and_die "Can't close $outfile: $!"; $rv; # return subprocess termination status } # extract listed files from archive and store in new file sub store_mgr($$$@) { my($tempdir, $list, $cmd, @args) = @_; + + local *FH; my(@rv); for my $f (@$list) { next if $f =~ /\/$(?!\n)/; # ignore directories - local($1); if ($f =~ m{^(\.?[A-Za-z0-9_][A-Za-z0-9/._=~-]*)$(?!\n)} ) { $f = $1; # untaint apparently safe arguments } else { # this is not too bad, as run_command does not use shell @@ -4702,7 +4961,7 @@ } BEGIN { - import Amavis::Util qw(do_log safe_encode); + import Amavis::Util qw(do_log set_debug_id do_debug_log safe_encode); import Amavis::Timing qw(section_time); import Amavis::Conf qw(:platform :notifyconf $myhostname $forward_method $hdr_encoding $bdy_encoding); @@ -4722,17 +4981,18 @@ sub string_to_mime_entity($) { my($mail_as_string_ref) = @_; my($entity); my($m_hdr,$m_body); - local($1,$2,$3); my($taint) = substr($$mail_as_string_ref,0,0); + my($taint) = substr($$mail_as_string_ref,0,0); ($m_hdr,$m_body) = ($1.$taint, $3.$taint) if $$mail_as_string_ref =~ /^(.*?\r?\n)(\r?\n|$(?!\n))(.*)$(?!\n)/s; - $m_body = safe_encode($bdy_encoding, $m_body); - # make sure _our_ source line number is reported in case of failure + + utf8::decode($m_hdr); eval {$entity = MIME::Entity->build( - Type => 'text/plain', Encoding => '-SUGGEST', Charset => $bdy_encoding, + Type => 'text/plain', Encoding => 'base64', Charset => 'utf-8', #$bdy_encoding, (defined $notify_xmailer_header && $notify_xmailer_header eq '' ? () # leave the MIME::Entity default : ('X-Mailer' => $notify_xmailer_header) ), # X-Mailer hdr or undef - Data => $m_body); 1} or do {chomp($@); die $@}; + Data => $m_body);1} or do {chomp($@); do_log(1,"Died in String to mime entity 1");die "I Died $@"}; + my($head) = $entity->head; # insert header fields from template into MIME::Head entity $m_hdr =~ s/\r?\n([ \t])/$1/g; # unfold template header @@ -4749,19 +5009,13 @@ do_log(5,"string_to_mime_entity UTF-8 body: $fbody"); do_log(5,"string_to_mime_entity body octets: $fbody_octets"); } - $fbody = MIME::Words::encode_mimeword($fbody_octets, - 'Q', $hdr_encoding); - } else { # supposed to be in plain ASCII, let's make sure it is - $fbody = safe_encode('ascii', $fbody); +# $fbody = MIME::Words::encode_mimeword($fbody_octets, +# 'Q', $hdr_encoding); + $fbody = Encode::encode('MIME-Header', $fbody); } - $fhead = safe_encode('ascii', $fhead); do_log(5, sprintf("string_to_mime_entity %s: %s", $fhead,$fbody)); # make sure _our_ source line number is reported in case of failure - if (! eval {$head->replace($fhead,$fbody); 1} ) { - chomp($@); - die sprintf("%s header field '%s: %s'", - ($@ eq '' ? "invalid" : "$@, "), $fhead, $fbody); - } + eval {$head->replace($fhead,$fbody); 1} or do {chomp($@); die $@}; } } $entity; # return the built MIME::Entity @@ -4787,6 +5041,8 @@ my($any); # any recipients with failed delivery? for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } my($remote_mta) = $r->recip_remote_mta; my($smtp_resp) = $r->recip_smtp_response; if (! $r->recip_done) { @@ -4799,7 +5055,6 @@ } } my($smtp_resp_code, $smtp_resp_enhcode, $smtp_resp_msg); - local($1,$2,$3); if ($smtp_resp =~ /^ (\d{3}) \s+ ([245] \. \d{1,3} \. \d{1,3})? \s* (.*) $(?!\n)/xs) { ($smtp_resp_code,$smtp_resp_enhcode,$smtp_resp_msg)=($1,$2,$3); @@ -4841,28 +5096,28 @@ my(%mybuiltins) = %$builtins_ref; # make a local copy $mybuiltins{'f'} = $hdrfrom_notify_sender; $mybuiltins{'T'} = $to_hdr; $mybuiltins{'d'} = rfc2822_timestamp($dsn_time); - my($dsn) = expand($template_ref,\%mybuiltins); + my($dsn) = expand($template_ref,\%mybuiltins); my($dsn_entity) = string_to_mime_entity($dsn); $dsn_entity->make_multipart; my($head) = $dsn_entity->head; -# 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 -# DSN will reach that person. - eval {$head->replace('From',$hdrfrom_notify_sender); 1} or do {chomp($@); die $@}; eval {$head->replace('To', $to_hdr); 1} or do {chomp($@); die $@}; eval {$head->replace('Date',rfc2822_timestamp($dsn_time)); 1} or do {chomp($@); die $@}; my($field) = Mail::Field->new('Content_type'); # underline, not hyphen! - $field->type("multipart/report; report-type=delivery-status"); + $field->type("multipart/report; report-type=delivery-status; charset=utf-8"); $field->boundary(MIME::Entity::make_boundary()); $head->replace('Content-type', $field->stringify); $head = undef; + #Remove the Barracuda headers from the attachment. + my $tmp_ref = $msginfo->orig_header; + my $header_txt = [map {my $h=$_; $h='' if $h=~/X-Barracuda/ || $h =~ /X-ASG/; $h} @$tmp_ref ]; + # make sure _our_ source line number is reported in case of failure + utf8::encode($msg); eval {$dsn_entity->attach( Type => 'message/delivery-status', Encoding => '7bit', Description => 'Delivery error report', @@ -4870,9 +5125,9 @@ eval {$dsn_entity->attach( Type => 'text/rfc822-headers', Encoding => '-SUGGEST', Description => 'Undelivered-message headers', - Data => $msginfo->orig_header); 1} or do {chomp($@); die $@}; + Data => $header_txt); 1} or do {chomp($@); die $@}; $notification = Amavis::In::Message->new; - $notification->sender($mailfrom_notify_sender); # should be empty! + $notification->sender($mailfrom_notify_sender); $notification->recips([$msginfo->sender_contact]); $notification->mail_text($dsn_entity); } @@ -4888,6 +5143,8 @@ my($msginfo) = @_; my(@succ_entries, @other_entries); for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } my($remote_mta) = $r->recip_remote_mta; my($smtp_resp) = $r->recip_smtp_response; my($qrecip_addr) = scalar(qquote_rfc2821_local($r->recip_addr)); @@ -4917,10 +5174,16 @@ use Digest::MD5; use Net::Server 0.83; use Net::Server::PreForkSimple; +use Encode; +use Barracuda::Cache; +use Barracuda::Journal; # joe b8619 9-14-06 +use Barracuda::StatsCollector; +use IPC::ShareLite; +use Fcntl qw(:flock); BEGIN { import Amavis::Conf qw(:platform :confvars :notifyconf :sa); - import Amavis::Util qw(do_log debug_oneshot am_id prolong_timer + import Amavis::Util qw(do_log set_debug_id set_mta_id set_multi_recip do_debug_log debug_oneshot am_id prolong_timer min max); import Amavis::Timing qw(section_time); import Amavis::Log; @@ -4939,6 +5202,62 @@ import Amavis::In::Message; } +use vars qw($avresults_cache $saresults_cache $quarantine_cache $journal_object $stats_collector); +# set up global caches +# av and sa results are stored in a smaller ramdisk cache +$avresults_cache = new Barracuda::Cache(path=>'/mail/scan/avresults_cache.gdbm', himark=>2**5, lomark=>2**4); +$saresults_cache = new Barracuda::Cache(path=>'/mail/scan/saresults_cache.gdbm', himark=>2**5, lomark=>2**4); +# quarantine cache needs to be persistent +$quarantine_cache = new Barracuda::Cache(path=>'/mail/message_log/message_id_cache.gdbm'); +# joe b8619 9-14-06 +$journal_object = new Barracuda::Journal(); + +# constant used by $HIT_CLASS +use constant CLASS_SUBJECT => 1; +use constant CLASS_HEADER => 2; +use constant CLASS_BODY => 3; +use constant CLASS_BFS => 4; +use constant CLASS_SPF => 5; +use constant CLASS_RBL => 6; +use constant CLASS_FP => 7; +use constant CLASS_BNDFILE => 8; # to use in the future +use constant CLASS_BRL => 9; +use constant CLASS_DKIM => 10; + +# constants used by $HIT_TYPE +# these constants should be better qualified +use constant TYPE_WHITELIST => 1; +use constant TYPE_NONE => 0; +use constant TYPE_TAG => -1; +use constant TYPE_QUARANTINE => -2; +use constant TYPE_BLOCK => -3; + +my @spam_log_message_table; +my @reason_lookup; + +$spam_log_message_table[0] = ''; +$reason_lookup[0] = 0; +$spam_log_message_table[CLASS_SUBJECT] = 'Subject'; +$reason_lookup[CLASS_SUBJECT] = 9; +$spam_log_message_table[CLASS_HEADER] = 'Header'; +$reason_lookup[CLASS_HEADER] = 34; +$spam_log_message_table[CLASS_BODY] = 'Body'; +$reason_lookup[CLASS_BODY] = 37; +$spam_log_message_table[CLASS_BFS] = 'Intent'; +$reason_lookup[CLASS_BFS] = 39; +$spam_log_message_table[CLASS_SPF] = 'SPF/Caller ID'; +$reason_lookup[CLASS_SPF] = 40; +$spam_log_message_table[CLASS_RBL] = 'RBL'; +$reason_lookup[CLASS_RBL] = 3; +$spam_log_message_table[CLASS_BRL] = 'BRL'; +$reason_lookup[CLASS_RBL] = 62; +$spam_log_message_table[CLASS_DKIM] = 'DomainKeys'; +$reason_lookup[CLASS_DKIM] = 63; + +my $spam_lover_db1; +my $spam_lover_db2; +my $userSAenable_overrides_domainSAdisable = 0; + # Make it a subclass of Net::Server::PreForkSimple # to override method &process_request (and others if desired) use vars qw(@ISA); @@ -4951,12 +5270,13 @@ $extra_code_in_amcl $extra_code_in_smtp $extra_code_antivirus $extra_code_antispam); -use vars qw($spam_level $spam_status $spam_report); +use vars qw($spam_level $spam_status $full_spam_status $spam_report); use vars qw($user_id_sql $virus_lovers_sql $spam_lovers_sql $banned_files_lovers_sql $bad_header_lovers_sql $bypass_virus_checks_sql $bypass_spam_checks_sql + $bypass_quarantine_sql $bypass_banned_checks_sql $bypass_header_checks_sql $spam_tag_level_sql $spam_tag2_level_sql $spam_kill_level_sql $spam_modifies_subj_sql $local_domains_sql $wb_listed_sql @@ -4971,7 +5291,8 @@ $spam_modifies_subj_ldap $local_domains_ldap $wb_listed_ldap $spam_quarantine_to_ldap); -use vars qw(%scan_cache $body_digest); +use vars qw($body_digest); +use vars qw(@msgparts); use vars qw(%builtins); # customizable notification messages use vars qw($child_invocation_count $child_task_count); @@ -4981,9 +5302,12 @@ # SMTP-input there may be more than one message # passed during a single SMTP session -use vars qw($VIRUSFILE $CONN $MSGINFO); -use vars qw($av_output @virusname @detecting_scanners - @banned_filename @bad_headers); +use vars qw($VIRUSFILE $CONN $MSGINFO $DONE_STATS $HIT_TYPE $HIT_CLASS $HIT_REGEXP $MUTEX + $REASON_ID $ACTION_ID $REASON_EXTRA $SUBJECT $SCORE $CLIENT_IP $START_TIME $ENCRYPTED + $PU_SENDER_WHITELIST $BAYES_HEADER %PU_UID_MAP %PU_REAL_EMAIL_MAP ); + +use vars qw($av_output @virusname @detecting_scanners @fingerprints + @virus_exception @banned_filename @quarantined_filename @bad_headers); use vars qw($amcl_in_obj $smtp_in_obj); # Amavis::In::AMCL and In::SMTP objects use vars qw($sql_policy $sql_wblist); # Amavis::Lookup::SQL objects @@ -4993,20 +5317,6 @@ ### occured. It allows for preparation before looping begins. sub pre_loop_hook { local $SIG{CHLD} = 'DEFAULT'; - eval { - my($euid) = $>; # effective UID - $> = 0; # try to become root - POSIX::setuid(0) if $> != 0; # and try some more - if ($> == 0) { # succeded? panic! - my(@msg) = ( - "It is possible to change EUID from $euid to root, ABORTING!", - "Perhaps you forgot to patch the Net::Server - see:", - " http://www.ijs.si/software/amavisd/#net-server-sec", - "or start as non-root, e.g. by using su(1)"); - do_log(0,"FATAL: $_") for @msg; - print STDERR (map {"$_\n"} @msg); die "EUID problem, ABORTING"; - exit 1; # just in case - } # this needs to be done only after chroot, otherwise paths will be wrong find_external_programs( [split(/:/, $path, -1)] ); # do some sanity checking @@ -5016,22 +5326,24 @@ if ($errn == ENOENT) { die "No TEMPBASE directory: $name" } elsif ($errn) { die "TEMPBASE directory inaccessible, $!: $name" } elsif (! -d _) { die "TEMPBASE is not a directory: $name" } - elsif (! -w _) { die "TEMPBASE is not writable: $name" } + elsif (! -w _) { die "TEMPBASE is not writeable: $name" } if ($QUARANTINEDIR ne '') { my($name) = $QUARANTINEDIR; $name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne ''; my($errn) = stat($QUARANTINEDIR) ? 0 : 0+$!; if ($errn == ENOENT) { } # ok elsif ($errn) { die "QUARANTINEDIR inaccessible, $!: $name" } - elsif (-d _ && !-w _) { die "QUARANTINEDIR directory not writable: $name" } + elsif (-d _ && !-w _) { die "QUARANTINEDIR directory not writeable: $name" } } Amavis::SpamControl::init() if $extra_code_antispam; - }; - if ($@ ne '') { - chomp($@); my($msg) = "TROUBLE in pre_loop_hook: $@"; do_log(0,$msg); - die ("Suicide (".am_id().") ".$msg."\n"); # kills child, not parent + + # rename any stats database files that have not been marked "done" + my @statfiles = glob('/mail/scan/cudastats*.gdbm'); + foreach my $statfile (@statfiles) { + my $newfile = sprintf("%s.%.5f.done", $statfile, Time::HiRes::time()); + rename($statfile, $newfile); } - 1; + } ### log routine Net::Server hook @@ -5053,7 +5365,10 @@ sub child_init_hook { my($self) = shift; local $SIG{CHLD} = 'DEFAULT'; + setpriority(0,0,15); # nice us down $0 = 'amavisd (virgin child)'; + # initialize the stats collection object for this child + $Amavis::stats_collector = new Barracuda::StatsCollector(); } ### user customizable Net::Server hook @@ -5073,7 +5388,6 @@ my($prop) = $self->{server}; my($sock) = $prop->{client}; local $SIG{CHLD} = 'DEFAULT'; - local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server ### unix sockets should be immune to this check return 1 if UNIVERSAL::can($sock,'NS_proto') && $sock->NS_proto eq 'UNIX'; @@ -5098,37 +5412,52 @@ my($prop) = $self->{server}; my($sock) = $prop->{client}; local $SIG{CHLD} = 'DEFAULT'; - local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server # Net::Server assigns STDIN and STDOUT to the socket - binmode(STDIN) or die "Can't set STDIN to binmode: $!"; - binmode(STDOUT) or die "Can't set STDOUT to binmode: $!"; - binmode($sock) or die "Can't set socket to binmode: $!"; + if ($unicode_aware) { + binmode(STDIN, ":bytes") or Amavis::Util::cleanup_and_die "Can't cancel :utf8 mode on STDIN: $!"; + binmode(STDOUT,":bytes") or Amavis::Util::cleanup_and_die "Can't cancel :utf8 mode on STDOUT: $!"; + binmode($sock, ":bytes") or Amavis::Util::cleanup_and_die "Can't cancel :utf8 mode on socket: $!"; + } $| = 1; local $SIG{ALRM} = sub { die "timed out\n" }; # do not modify the sig text! eval { prolong_timer('new request - timer reset', $child_timeout); #timer init - if ($extra_code_sql && @lookup_sql_dsn) { - if (!defined $sql_wblist && defined $sql_select_white_black_list) { - $sql_wblist = Amavis::Lookup::SQL->new; - } - if (!defined $sql_policy && defined $sql_select_policy) { - # make SQL lookup object (will carry SELECT and DBI handle) - $sql_policy = Amavis::Lookup::SQL->new; - - # make SQL field lookup objects with incorporated field names + if ($extra_code_sql && @lookup_sql_dsn && $child_invocation_count==1) { + $sql_policy = $sql_wblist = undef; + my $block_on_db = 1; + my $sql_dbh = undef; + while (1) { + $sql_dbh= Amavis::Lookup::SQL::connect_to_sql(@lookup_sql_dsn); + last if defined($sql_dbh); + last if !$block_on_db; + do_log(0, "Waiting for db connect"); + sleep 1; + } + section_time('sql-connect'); + if (!defined($sql_dbh)) { + do_log(0, "SQL lookups disabled: " . $DBI::errstr); + } else { + $sql_dbh->{'RaiseError'} = 1; + $sql_policy = Amavis::Lookup::SQL->new( + $sql_dbh, $sql_select_policy); + $sql_wblist = Amavis::Lookup::SQL->new( + $sql_dbh, $sql_select_white_black_list + ) if defined $sql_select_white_black_list; + # make lookup objects with incorporated field names # fieldtype: B=boolean, N=numeric, S=string, # B-, N-, S- returns undef if field does not exist # B0: boolean, nonexistent field treated as false, # B1: boolean, nonexistent field treated as true my $nf = sub {Amavis::Lookup::SQLfield->new($sql_policy,@_)}; #shorthand - $user_id_sql = $nf->('id', 'S'); + $user_id_sql = $nf->('id', 'N'); $virus_lovers_sql = $nf->('virus_lover', 'B0'); $spam_lovers_sql = $nf->('spam_lover', 'B-'); $banned_files_lovers_sql= $nf->('banned_files_lover', 'B-'); $bad_header_lovers_sql = $nf->('bad_header_lover', 'B-'); $bypass_virus_checks_sql= $nf->('bypass_virus_checks', 'B0'); $bypass_spam_checks_sql = $nf->('bypass_spam_checks', 'B0'); + $bypass_quarantine_sql = $nf->('bypass_quarantine', 'B0'); $bypass_banned_checks_sql=$nf->('bypass_banned_checks','B-'); $bypass_header_checks_sql=$nf->('bypass_header_checks','B-'); $spam_tag_level_sql = $nf->('spam_tag_level', 'N' ); @@ -5139,6 +5468,7 @@ $local_domains_sql = $nf->('local', 'B1'); section_time('sql-prepare'); } + undef @lookup_sql_dsn; # destroy sensitive information } if ($extra_code_ldap && $child_invocation_count==1) { # $ldap_wblist : TODO @@ -5194,11 +5524,11 @@ chomp($@); my($msg) = $@ eq "timed out" ? "Child task exceeded $child_timeout seconds, abort" - : "TROUBLE in process_request: $@"; + : "TROUBLE?: $@"; do_log(0, $msg); $smtp_in_obj->preserve_evidence(1) if $smtp_in_obj; # kills a child, hopefully preserving tempdir, but does not kill parent - die ("Suicide (" . am_id() . ") " . $msg . "\n"); + die ("(" . am_id() . ") " . $msg . "\n"); } if ($child_task_count >= $max_requests && $child_invocation_count < $max_requests) { @@ -5244,6 +5574,7 @@ $amcl_in_obj = undef; # (currently does nothing for Amavis::In::AMCL) } + # Checks the message stored on a file. File must already # be open on file handle $msginfo->mail_text; it need not be positioned # properly, check_mail must not close the file handle. @@ -5253,8 +5584,59 @@ my($fh) = $msginfo->mail_text; my(@recips) = @{$msginfo->recips}; + # ZL: set default domain for recips if desired + if( $Amavis::default_domain && $Amavis::default_domain ne '') + { + foreach (@recips) { s/(?:\@.*|$)/\@$Amavis::default_domain/; } + } + + # DL: initialize spam order for querying database + # This should be done somewhere in real global initialization + if (!defined $spam_lover_db1) + { + if ($userSAenable_overrides_domainSAdisable) # should be set in amavisd.conf + { + $spam_lover_db1 = $spam_lovers_sql; # per user settings + $spam_lover_db2 = \%spam_lovers; # domain level setting + } + else + { + $spam_lover_db1 = \%spam_lovers; # domain level setting takes precedence (now) + $spam_lover_db2 = $spam_lovers_sql; # per user settings + } + } + + # Clear out our stats flag + $DONE_STATS = 0; + + # global cache lock used by av and spam scan + $MUTEX = undef; + + $HIT_REGEXP = ''; + $HIT_TYPE = TYPE_NONE(); + $HIT_CLASS = 0; # 1 = SUBJECT; + + # Clear out the flags for the logging (action/reason/reason_extra/subject) + $REASON_ID = 0; + $ACTION_ID = 0; + $REASON_EXTRA = ''; + $SUBJECT = ''; + $SCORE = '-'; + + $BAYES_HEADER = ''; + + $PU_SENDER_WHITELIST = ''; + %PU_UID_MAP = (); + %PU_REAL_EMAIL_MAP = (); + + # Null out the temporary prev_hdr variables for checking x-headers + $prev_hdr1 = ''; + $prev_hdr2 = ''; + + $MSGINFO = $msginfo; # ugly - save in a global, to make it accessible # to %builtins + # check_mail() may be called several times per child lifetime and/or # per-SMTP session. The variable $child_task_count is mainly used # by AV-scanner interfaces, e.g. to initialize when invoked @@ -5264,7 +5646,9 @@ # reset certain global variables for each task $VIRUSFILE = undef; $av_output = undef; @virusname = (); @detecting_scanners = (); - @banned_filename = (); @bad_headers = (); + @banned_filename = (); @quarantined_filename = (); @bad_headers = (); + @fingerprints = (); # joe 6-6-06 b7485 + @virus_exception = (); $spam_level = undef; $spam_status = undef; $spam_report = undef; # comment out to retain SQL cache entries for the whole child lifetime: @@ -5273,23 +5657,36 @@ $body_digest = get_body_digest($fh,$msginfo); - my($mail_size) = $msginfo->orig_header_size + 1 + $msginfo->orig_body_size; +# dk: following line does not work anymore -- in the amavisd caching/ +# digest calculation, we used to loop over message lines, increasing +# message size ( and therefor $msginfo->orig_body_size() +# +# my($mail_size) = $msginfo->orig_header_size + 1 + $msginfo->orig_body_size; +# +# # my($mail_size2) = $msginfo->msg_size; # use ESMTP size estimate if available -# my($mail_size3) = -s "$tempdir/email.txt"; # get it from a file system + +# dk: use message size from filesystem instead + my($mail_size) = -s "$tempdir/email.txt"; # get it from a file system # do_log(0, "MAIL SIZES: $mail_size, $mail_size2, $mail_size3"); + # dk: and set message size in msginfo object for 'huge message' + # check later on. + $msginfo->orig_body_size( $mail_size ); + my($file_generator_object) = # 0 disables the $MAXFILES limit Amavis::Unpackers::NewFilename->new($MAXFILES ? $MAXFILES : undef); Amavis::Unpackers::init($file_generator_object, $mail_size); my($smtp_resp,$exit_code,$preserve_evidence); - my($banned_filename_checked); +# my($banned_filename_checked); +# my($quarantined_filename_checked); my($virus_presence_checked,$spam_presence_checked); + my $mail_charset='iso-8859-1'; do_log(1, sprintf("Checking: <%s> -> %s", $msginfo->sender, join(',',map{"<$_>"}@recips)) ); my($am_id) = am_id(); - my($any_undecipherable); my($hold); # set to some string to cause the message to be # placed on hold (frozen) by MTA. This can be used # in cases when we stumble across some permanent problem @@ -5305,98 +5702,182 @@ # amount to 10-15 % of total elapsed time !!! } else { mkdir("$tempdir/parts", 0750) - or die "Can't create directory $tempdir/parts: $!"; + or Amavis::Util::cleanup_and_die "Can't create directory $tempdir/parts: $!"; section_time('mkdir parts'); } chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!"; - # FIRST: what kind of e-mail did we get? call content scanners +# Decode the headers so we can pull the info we need out +if (!defined($msginfo->mime_entity)) { + $which_section = "mime_decode"; + $msginfo->mime_entity(mime_decode($fh,$tempdir)); + prolong_timer($which_section); +} - # already in cache? - if (defined($body_digest) && exists($scan_cache{$body_digest})) { - $which_section = "cached"; - my($bs) = $scan_cache{$body_digest}; - $banned_filename_checked = defined $bs->{'FB'} ? 1 : 0; - $virus_presence_checked = defined $bs->{'VN'} ? 1 : 0; - if ($msginfo->orig_body_size < 200) { - $spam_presence_checked = 0; #ignore spam cache if body is small - } else { - $spam_presence_checked = defined $bs->{'SL'} ? 1 : 0; - } - do_log(1, sprintf("cached %s from <%s> (%s,%s,%s)", $body_digest, - $msginfo->sender, $banned_filename_checked, - $virus_presence_checked,$spam_presence_checked)); - @banned_filename = !ref($bs->{'FB'}) ? () : @{$bs->{'FB'}}; # copy - @virusname = !ref($bs->{'VN'}) ? () : @{$bs->{'VN'}}; # copy - @detecting_scanners=!ref($bs->{'VD'}) ? () : @{$bs->{'VD'}}; # copy - $av_output = $bs->{'VO'}; - if ($spam_presence_checked) { - $spam_level = $bs->{'SL'}; - $spam_status = $bs->{'SS'}; $spam_report = $bs->{'SR'}; + +# get the UID from the headers +if (defined($msginfo->mime_entity)) { + # uids are mapped in the X-Barracuda-UID header - " " + my (@UID_maps) = $msginfo->mime_entity->head->get('X-Barracuda-UID'); + + foreach my $UID_map (@UID_maps) { + chomp($UID_map); + if ($UID_map =~ /([^\s\@]+\@[^\s\@]+)\s+(.*)\s+([^\s\@]+\@[^\s\@]+)?/) { + my ($email_address, $UID, $real_email_address) = (lc($1), lc($2), lc($3)); + $PU_UID_MAP{$email_address} = $UID; + # we want to track their real email address for creating + # his/her account and making folders - this is at least + # guaranteed to be unique + $Amavis::PU_REAL_EMAIL_MAP{$email_address} = $real_email_address; + do_log(1, "email address: '$UID_map' $email_address maps to UID: $UID ($real_email_address)"); + } } } - if (grep {!lookup($_, +# Pull the connecting IP and whether we used encryption in recv'ing from the headers +$CLIENT_IP = ''; +$ENCRYPTED = ''; +if( defined($msginfo->mime_entity) ) +{ + $CLIENT_IP = $msginfo->mime_entity->head->get('X-Barracuda-Connect'); + chomp( $CLIENT_IP ); + $START_TIME = $msginfo->mime_entity->head->get('X-Barracuda-Start-Time'); + chomp( $START_TIME ); + $ENCRYPTED = $msginfo->mime_entity->head->get('X-Barracuda-Encrypted'); + chomp( $ENCRYPTED ); +} + +# This is a multi-recipient message if there is a comma-separated list of +# "X-Barracuda-Orig-Rcpt" +set_multi_recip($msginfo->mime_entity->head->get('X-Barracuda-Orig-Rcpt') =~ /,/); + +# +# Do we have a Postfix generated X-ASG-Debug-ID header that looks like: +# +# [Timestamp]-[PID]-[Connect #]-[Envelope #] +# +# If so, split the Postfix generated X-ASG-Debug-ID and re-encode the parts +# as specified below, appending a recipient unique hash at the end. +# Otherwise, since we explode messages with multiple recipients and we +# depend on this header for message identifiaction--but the Postfix header +# is duplicated as-is--these messages would overwrite each other's entries +# in the message_log and create other havoc. +# +set_mta_id(''); +if (defined($msginfo->mime_entity)) { + set_mta_id($msginfo->mime_entity->head->get('X-ASG-Debug-ID')); +} + +if (defined($mta_id) && $mta_id =~ m/^(\d+)-(\d+)-(\d+)-(\d+)/) { + # + # Create an X-ASG-Debug-ID that looks like: + # + # 1141786545-72b400000000-9mwrYb + # + # 32-bit base-10 timestamp, followed by a hyphen and a 16-bit + # fixed-width base-16 PID, then a 16-bit fixed-width base-16 + # connection count, then a 16-bit fixed-width base-16 envelope + # count, then another hyphen and a 36-bit fixed-width modified + # base-64 recipient-unique identifier. + # + my ($ts, $pid, $nconn, $nenv) = ($1, $2, $3, $4); + my ($barracuda_id, $recip_hash); + + require Digest::MD5; + + $recip_hash = Digest::MD5::md5_base64(${$msginfo->per_recip_data}[0]->recip_addr); + + $recip_hash =~ s/[^A-Za-z0-9]//g; # Strip out / and + + + $barracuda_id = sprintf("%u-%s%s%s-%s",$ts, + unpack("H*", pack("n", $pid)), # Network-order 16-bit unsigned short + unpack("H*", pack("n", $nconn)), + unpack("H*", pack("n", $nenv)), + substr($recip_hash, 0, 6) + ); + + set_debug_id($barracuda_id); +} else { + set_debug_id("xxx"); + + do_log(1, "Message missing MTA generated X-ASG-Debug-ID"); +} # if $mta_id + + # FIRST: what kind of e-mail did we get? call content scanners + + # already in cache? +# if (0 && defined($body_digest) && exists($scan_cache{$body_digest})) { +# $which_section = "cached"; +# my($bs) = $scan_cache{$body_digest}; +# $banned_filename_checked = defined $bs->{'FB'} ? 1 : 0; +# $quarantined_filename_checked = defined $bs->{'FQ'} ? 1 : 0; +# $virus_presence_checked = defined $bs->{'VN'} ? 1 : 0; +# $spam_presence_checked = defined $bs->{'SL'} ? 1 : 0; +# do_log(1, sprintf("cached %s from <%s> (%s,%s,%s,%s)", $body_digest, +# $msginfo->sender, $banned_filename_checked, +# $quarantined_filename_checked, +# $virus_presence_checked,$spam_presence_checked)); +# @banned_filename = !ref($bs->{'FB'}) ? () : @{$bs->{'FB'}}; # copy +# @quarantined_filename = !ref($bs->{'FQ'}) ? () : @{$bs->{'FQ'}}; # copy +# @virusname = !ref($bs->{'VN'}) ? () : @{$bs->{'VN'}}; # copy +# @detecting_scanners=!ref($bs->{'VD'}) ? () : @{$bs->{'VD'}}; # copy +# $av_output = $bs->{'VO'}; $spam_level = $bs->{'SL'}; +# $spam_status = $bs->{'SS'}; $spam_report = $bs->{'SR'}; +# } + + if (grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, $bypass_header_checks_sql, $bypass_header_checks_ldap, \%bypass_header_checks, \@bypass_header_checks_acl, $bypass_header_checks_re)} @recips) { @bad_headers = check_header_validity($conn, $msginfo); } - if ($banned_filename_checked) { - do_log(5, "banned_filename_presence cached, skipping check"); - } elsif (!$banned_filename_re) { - do_log(5, "banned_filename_presence skipped, no tests"); - } elsif (!grep {!lookup($_, - $bypass_banned_checks_sql,$bypass_banned_checks_ldap, - \%bypass_banned_checks, \@bypass_banned_checks_acl, - $bypass_banned_checks_re)} @recips) { - do_log(5, "bypassing of banned_filename_presence requested"); - } else { - # check for banned mime file name or banned mime-type - if (!defined($msginfo->mime_entity)) { - $which_section = "mime_decode-1"; - $msginfo->mime_entity(mime_decode($fh,$tempdir)); - prolong_timer($which_section); - } - $which_section = "filename_check_mime"; - my($banned_filenames_ref) = - check_for_banned_filenames($banned_filename_re, - $msginfo->mime_entity, undef, undef); - push(@banned_filename, @$banned_filenames_ref); - $banned_filename_checked = 1; - } + # joe 5-2-06 b6503 BRTS + # initialize variables used by BRTS + my $brts_spam_score = 0; + my $brts_spam_reason = ''; + my $brts_skip_bounce = 0; - if ($virus_presence_checked) { - do_log(5, "virus_presence cached, skipping virus_scan"); - } else { +# if ($virus_presence_checked) { +# do_log(5, "virus_presence cached, skipping virus_scan"); +# } else { + my $lookup_tmp_rcpt = ${$msginfo->per_recip_data}[0]->recip_addr; my($will_do_virus_scanning) = # virus scanning will be needed? $extra_code_antivirus && - grep {!lookup($_, $bypass_virus_checks_sql, - $bypass_virus_checks_ldap, - \%bypass_virus_checks, - \@bypass_virus_checks_acl, - $bypass_virus_checks_re)} @recips; + grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$lookup_tmp_rcpt} || $lookup_tmp_rcpt, + \%bypass_virus_checks)} @recips; +# +# Fix Bug 8213 +# -- $bypass_virus_checks_sql always returns 0, and we do not use it until now... +# +# grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, $bypass_virus_checks_sql, +# $bypass_virus_checks_ldap, +# \%bypass_virus_checks, +# \@bypass_virus_checks_acl, +# $bypass_virus_checks_re)} @recips; # decoding parts as deep as possible, but only if needed if (!$bypass_decode_parts && - ($will_do_virus_scanning || - ($banned_filename_re && !@banned_filename) ) + ($will_do_virus_scanning || ($scana_use_fingerprints < 0) || + ($banned_filename_re && !@banned_filename) || + ($quarantined_filename_re && !@quarantined_filename) ) ) { # decode_parts can take a lot of time !!! if (!defined($msginfo->mime_entity)) { - $which_section = "mime_decode-2"; + $which_section = "mime_decode"; $msginfo->mime_entity(mime_decode($fh,$tempdir)); prolong_timer($which_section); } $which_section = "decoding"; my(@parts); my($depth) = 1; + @msgparts = (); # fetch all not-yet-visited part names, and start a new cycle TIER: while ( @parts=@{$file_generator_object->parts_list} ) { $which_section = "decoding1"; - if ($MAXLEVELS && $depth > $MAXLEVELS) { + if ($depth > $MAXLEVELS) { $hold = "Maximum decoding depth ($MAXLEVELS) exceeded"; last; } + push(@msgparts, @parts); $file_generator_object->parts_list_reset; # new names cycle # clip to avoid very long log entries my(@chopped_parts) = @parts > 5 ? @parts[0..4] : @parts; @@ -5407,35 +5888,16 @@ $which_section = "decoding2-get-file-types"; determine_file_types(\@parts, $tempdir, $file_generator_object); - if (!$banned_filename_re) { - } elsif (!grep {!lookup($_, - $bypass_banned_checks_sql,$bypass_banned_checks_ldap, - \%bypass_banned_checks, \@bypass_banned_checks_acl, - $bypass_banned_checks_re)} @recips) { - } else { - $which_section = "decoding3-check-banned"; - # check for banned file content as guessed by 'file' - my($banned_filenames_ref) = - check_for_banned_filenames($banned_filename_re, - undef, \@parts, $file_generator_object); - push(@banned_filename, @$banned_filenames_ref); - $scan_cache{$body_digest}{'FB'} = # cache it - [@banned_filename] if defined $body_digest; - } $which_section = "decoding4"; for my $part (@parts) { my($errn) = stat("$tempdir/parts/$part") ? 0 : 0+$!; if ($errn == ENOENT) { do_log(0, "decode_parts: NOTICE: new name requested, but file not created: $part"); } else { + $which_section = "decoding-decompose-parts"; - my($prot); - ($hold,$prot) = decompose_part($part, $tempdir, + $hold = decompose_part($part, $tempdir, $file_generator_object); - if ($prot) { - $any_undecipherable++; - do_log(2, "decode_parts: undecipherable $any_undecipherable"); - } $which_section = "decoding5"; last TIER if defined $hold; } @@ -5444,52 +5906,66 @@ } section_time('parts'); prolong_timer('decoding'); } - if ($any_undecipherable && $banned_filename_re) { - # test if undecipherables are banned - my($rn) = 'UNDECIPHERABLE'; - my($result,$patt) = $banned_filename_re->lookup_re($rn); - if ($result) { - push(@banned_filename, $rn); - do_log(2, "Banned $rn (patt: $patt)"); - } - $scan_cache{$body_digest}{'FB'} = # cache it - [@banned_filename] if defined $body_digest; - } # protect virus scanner from mail bombs - if ($hold ne '') { - if (!$will_do_virus_scanning) { - do_log(4, "Potential hold reason: $hold"); - } else { - do_log(0, "NOTICE: Virus scanning skipped: $hold"); - $will_do_virus_scanning = 0; - } - } + if ($hold ne '') { $will_do_virus_scanning = 0 } # virus scanning if (!$extra_code_antivirus) { do_log(5, "No anti-virus code loaded, skipping this section"); - } elsif ($will_do_virus_scanning) { + } elsif ($will_do_virus_scanning || $scana_use_fingerprints < 0) { if (!defined($msginfo->mime_entity)) { - $which_section = "mime_decode-3"; + $which_section = "mime_decode"; $msginfo->mime_entity(mime_decode($fh,$tempdir)); prolong_timer($which_section); } $which_section = "virus_scan"; - # special case to preserve complete mail file for inspection - if (lookup('MAIL',$keep_decoded_original_re) || - $any_undecipherable && lookup('MAIL-UNDECIPHERABLE', - $keep_decoded_original_re) ) { - do_log(2, "providing full original message to scanners, $any_undecipherable"); - # keep the original email.txt by making a hard link - # to it in ./parts/ - link("$tempdir/email.txt", "$tempdir/parts/part-00000") - or die "Can't create hard link to $tempdir/email.txt: $!"; - } # some virus scanners behave badly if interrupted, # so for now just turn off the timer - my($remaining_time) = alarm(0); # check how much time is left, stop timer my($av_ret); + my $prev_av_results = undef; + if ($multi_recip && $Amavis::avresults_cache && $mta_id) { + # any results already in cache? + $prev_av_results = $Amavis::avresults_cache->read("$mta_id:AV"); + + if (!$prev_av_results) + { + $MUTEX = new IPC::ShareLite( + -key => unpack("L", Digest::MD5::md5($mta_id)), + -create => 'yes', + -destroy => 'yes', + -size => 0, + ); + if (!$MUTEX) + { + do_log(2,"failed to get av cache lock:$mta_id"); + goto compute_av_results; + } + else + { + # lock, this, so only one will run at a time computing results + $MUTEX->lock( LOCK_EX); + # look for results again + $prev_av_results = $Amavis::avresults_cache->read("$mta_id:AV"); + if (!$prev_av_results) + { + # nothing there and we have the lock, go compute them + goto compute_av_results; + } + $MUTEX->unlock(); + } + } + + do_log(2, "AV results cached for $mta_id"); + my $virusnames = []; + my $detecting_scanners = []; + ($av_ret, $virusnames, $detecting_scanners) = @$prev_av_results; + @virusname = @$virusnames; + @detecting_scanners = @$detecting_scanners; + } + compute_av_results: + if (!$prev_av_results) { + my($remaining_time) = alarm(0); # check how much time is left, stop timer eval { my($vn,$ds); ($av_ret,$av_output,$vn,$ds) = Amavis::AV::virus_scan($tempdir, $child_task_count==1); @@ -5502,79 +5978,271 @@ @virusname = (); $av_ret = 0; # assume not a virus! do_log(0, "virus_scan TIMED OUT, ASSUME NOT A VIRUS !!!"); } - defined($av_ret) or die "All virus scanners failed!"; - if (defined $body_digest) { # save results to cache - $scan_cache{$body_digest}{'VO'} = $av_output; - $scan_cache{$body_digest}{'VN'} = [@virusname]; # copy! - $scan_cache{$body_digest}{'VD'} = [@detecting_scanners]; + # cache results + if ($multi_recip && $Amavis::avresults_cache && $mta_id) { + do_log(2, "caching AV results for $mta_id"); + $Amavis::avresults_cache->update("$mta_id:AV", [$av_ret, \@virusname, \@detecting_scanners]); + $MUTEX && $MUTEX->unlock(); + } } + + # if we found one or more files indicative of the false-positive + # virus, and it is a Bagle Virus, don't block + if ($virusname[0] eq 'Worm.Bagle.Gen-zippwd' && scalar(@Amavis::virus_exception) > 0) { + @virusname = (); $av_ret = 0; # assume not a virus! + } + + # joe 6-6-06 rewrote fingerprint detection (md5 from clam) + my @vncopy = @virusname; + @virusname = (); + foreach(@vncopy) { + if ($_ =~ m/^BN\.Signature-(.*?)$/) { push(@fingerprints,$_); } + else { push(@virusname,$_); } + } + # go ahead and log all virus names that are detected + foreach my $virustmp (@virusname) { + $Amavis::stats_collector->record('virus',$virustmp); + } + + if (!$will_do_virus_scanning) { + # joe 2-6-07 b10716 if fingerprinting is enabled and virus scanning disabled, clear out the virusname array + # if any are found + @virusname = (); + } + + + defined($av_ret) or Amavis::Util::cleanup_and_die "All virus scanners failed!"; $virus_presence_checked = 1; } + + # only do BRTS scanning if clam didn't find any viruses + my $brts_running = 0; + use Barracuda::BRTS; + my $brts_object = Barracuda::BRTS->new(scan => "$tempdir/parts/*", email => "$tempdir/email.txt"); + if ($brts_enabled && !@virusname) { + $brts_running = 1; + if (!$brts_object->start_scan()) { + $brts_running = 0; + } + section_time('brts'); + } + + # Determine which recipients were whitelisted by the admin + my $all_recip_whitelist = 0; + my $whitelist_count = 0; + # Note: we need to get all headers for recipient whitelists and store + # into an array since the header name is the same for each instance + my @whitelist_headers; + (@whitelist_headers) = $msginfo->mime_entity->head->get('X-ASG-Recipient-Whitelist'); + foreach my $r (@{$msginfo->per_recip_data}) + { + # Is this address in our list + my ($recip) = lc($r->recip_addr); + + # dk: remove any wildcard characters that can mess up the follow grep + # command -- there are no other occurences of this in the code. + $recip = quotemeta( $recip ); + + next if( !grep( /$recip/i, @whitelist_headers)); + + # Log this whitelist, set the flag to show they were whitelisted + # and increment our total count of whitelisted individuals + do_log(1, "Recipient Whitelist '$recip'"); + $r->recip_whitelisted(1); + $whitelist_count++; } + # Did all of the recipients have a whitelist on them + $all_recip_whitelist = 1 if( scalar(@{$msginfo->per_recip_data}) == $whitelist_count ); + # consider doing spam scanning my($any_wbl, $all_wbl); - ($any_wbl,$all_wbl) = Amavis::SpamControl::white_black_list( - $conn,$msginfo,$sql_wblist,$user_id_sql) if $extra_code_antispam; + ($any_wbl,$all_wbl) = Amavis::SpamControl::white_black_list($conn,$msginfo,$sql_wblist,$user_id_sql) + if ($per_user_wblist_enable eq 'Yes'); + if ($msginfo->mime_entity->head->get('Content-Type') =~ /charset\s*=\s*(.*?)(;|\n|\r\n)/){ + $mail_charset = $1; + $mail_charset =~ tr/\"\'//; + } + + + # joe b7900 now get the results from brts client + if ($brts_running) { + my @brtscmds = $brts_object->finish_scan(); + my $send_brts_evidence = 0; + foreach (@brtscmds) { + if ($brts_object->parse_response($_)) { + if ($brts_object->evidence_requested()) { + $send_brts_evidence = 1; + } + if ($brts_object->prevent_bounce()) { + $brts_skip_bounce = 1; + do_log(2,"BRTS: Preventing NDR/Bounce message to sender"); + } + if ($brts_object->defer_message()) { + do_log(2,"BRTS: Defering message due to possible virus outbreak"); + Amavis::Util::cleanup_and_die("BRTS: Deferring message."); + } + # now determine what BRTS says we should do with the message + # 1. If Spam, we can do 2 things: + # a. Block message as "fingerprint" + # b. Increase spam score of message + # 2. If Virus, we always block as a Virus with reason code from BRTS + if ($brts_object->is_spam()) { + if ($brts_object->block_message()) { + # block the message as a fingerprint + push(@fingerprints,"BN.Signature-*".$brts_object->get_reason()); + } elsif ($brts_object->allow_message() && $brts_object->get_score() > 0) { + # increase the spam score with a fake rule + $brts_spam_score = $brts_object->get_score(); + $brts_spam_reason = "BODY: ".$brts_object->get_reason(); + } + } elsif ($brts_object->is_virus()) { + push(@virusname,"*".$brts_object->get_reason()); + do_log(2,sprintf("BRTS: Blocking zero-hour virus: %s",$brts_object->get_reason())); + } + } else { + # couldn't parse BRTS response, perhaps version mismatch? + do_log(2,"BRTS: could not parse response string: '$_'"); + foreach($brts_object->errors()) { + chomp; + do_log(2,"BRTS Error: $_"); + } + } + } + if ($send_brts_evidence) { + do_log(2,"BRTS: Sending possible virus variant to Barracuda Central") if ($brts_object->send_evidence()); + } + section_time('brts'); + } + + # joe 7-5-06 b8083 -- don't do fingerprint blocking if whitelisted -- + # rcpt/sender w/b/listings are done by Postfix (adds appropriate header) + # Header w/b/listings are done in spam_scan + if (!@virusname && $scana_use_fingerprints < 0 && @fingerprints > 0 && + !$all_wbl && !$all_recip_whitelist && !$msginfo->mime_entity->head->get('X-ASG-Whitelist') && + $HIT_TYPE != TYPE_WHITELIST()) { + # only use the first found fingerprint for reason, if multiple are found + # also, only apply fingerprint action if it is worse than current hit type + # (ie if Fingerprint action is set to quarantine, and current hit type is block, don't + # change it to quaratine, instead allow block for different reason) + if ($scana_use_fingerprints < $HIT_TYPE && $fingerprints[0] =~ m/^BN\.Signature-(.*?)$/) { + $HIT_TYPE = $scana_use_fingerprints; + $HIT_CLASS = CLASS_FP(); + $HIT_REGEXP = $1; + do_log(1, "fpr_($HIT_TYPE): $1"); + # record stats for all fingerprints identified in this message + foreach my $fpid (@fingerprints) { + $fpid =~ s/BN\.Signature-//; + $Amavis::stats_collector->record('fingerprint',$fpid); + } + } + } + if ($spam_presence_checked) { - do_log(5, "spam_presence cached, skipping spam_scan"); + do_log(1, "spam_presence cached, skipping spam_scan"); + } + elsif ($msginfo->mime_entity->head->get('X-ASG-Whitelist')) { + do_log(1, "whitelisted sender...skipping spam check"); + } + elsif ($msginfo->mime_entity->head->get('X-ASG-Block')) { + # I don't believe anything at the mta just adds a header to block + # I am going to leave this out of the reason logging for now + my $spam_log_message = $msginfo->mime_entity->head->get('X-ASG-Block'); + do_log(1, "blocked from postfix ...skipping spam check"); } elsif (!$extra_code_antispam) { - do_log(5, "No anti-spam code loaded, skipping spam_scan"); + do_log(1, "No anti-spam code loaded, skipping spam_scan"); + # joe 2-2-06 - still scan the message if it was quarantined (content filters override quarantine) } elsif (@virusname || @banned_filename) { - do_log(5, "infected or banned contents, skipping spam_scan"); + do_log(1, "infected or banned contents, skipping spam_scan"); } elsif ($all_wbl) { - do_log(5, "sender white/blacklisted, skipping spam_scan"); - } elsif (!grep {!lookup($_, + $Amavis::PU_SENDER_WHITELIST = 1; + do_log(1, "Sender White/Blacklisted - Skipping spam_scan"); + } elsif ($all_recip_whitelist) { + do_log(1, "All Recipients Whitelisted - Skipping spam_scan"); + } elsif ( !grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, \%spam_lovers)} @recips) { + do_log(1, "pd no spam scan, skipping"); + } elsif (($quarantine_admin ne 'PER_USER' || $per_user_scan_enable eq 'Yes') && !grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, $bypass_spam_checks_sql, $bypass_spam_checks_ldap, \%bypass_spam_checks, \@bypass_spam_checks_acl, $bypass_spam_checks_re)} @recips) { - do_log(5, "bypassing of spam checks requested"); + do_log(1, "bypass spam checks qa=$quarantine_admin per_user=$per_user_scan_enable"); } else { $which_section = "spam_scan"; ($spam_level, $spam_status, $spam_report) = - Amavis::SpamControl::spam_scan($conn,$msginfo); - prolong_timer($which_section); - if (defined $body_digest) { # save results to cache - $scan_cache{$body_digest}{'SL'} = $spam_level; - $scan_cache{$body_digest}{'SS'} = $spam_status; - $scan_cache{$body_digest}{'SR'} = $spam_report; + Amavis::SpamControl::spam_scan($conn,$msginfo,$tempdir,$file_generator_object,@recips); + # store spam score + if (defined $spam_level) + { + $SCORE = $spam_level + ${$msginfo->per_recip_data}[0]->recip_bayes_score->{weight}; } + prolong_timer($which_section); $spam_presence_checked = 1; + + # joe 5-2-06 b6503 BRTS + # add the BRTS spam score, if applicable + if ($brts_running && $brts_spam_score) { + do_log(2,"BRTS: passed spam score of $brts_spam_score with reason $brts_spam_reason"); + $spam_level += $brts_spam_score; + $SCORE += $brts_spam_score; + my $brts_id; + if ($brts_spam_reason =~ m/.*?-(\d+)$/) { + $brts_id = $1; + } + chomp($spam_report); + $spam_report .= sprintf("\t%.2f %-22s %s\n\n",$brts_spam_score,"BN_ZH_$brts_id",$brts_spam_reason); + $spam_status .= ", BN-ZH"; + } + # record stats on the rules that this message hit + if ($spam_status =~ /tests=(.*?)$/) { + foreach my $ruleid (split(/,\s*/,$1)) { + $Amavis::stats_collector->record('sarule',$ruleid); + } + } } + + #do_log(1,"after spamscan- hit_class=$HIT_CLASS type=$HIT_TYPE regex=$HIT_REGEXP"); + $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 - my($considered_spam_by_some_recips); + my($considered_spam_by_some_recips,$should_be_killed); - if (@virusname || @banned_filename) { # virus or banned filename found + if (@virusname || @banned_filename) { # virus/banned filename found $which_section = "deal_with_virus_or_banned"; - my($final_destiny) = @virusname ? $final_virus_destiny - : @banned_filename ? $final_banned_destiny : D_PASS; + my $final_destiny = D_PASS; + if (@banned_filename) { $final_destiny = $final_banned_destiny; } + if (@virusname) { $final_destiny = $final_virus_destiny; } + for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; # already dealt with + if ($final_destiny == D_PASS) { # recipient wants this message, malicious or not } elsif ((!@virusname || # not a virus or we want it - lookup($r->recip_addr, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $virus_lovers_sql, $virus_lovers_ldap, \%virus_lovers, \@virus_lovers_acl, $virus_lovers_re)) && (!@banned_filename || # not banned or we want it - lookup($r->recip_addr, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $banned_files_lovers_sql, $banned_files_lovers_ldap, \%banned_files_lovers, \@banned_files_lovers_acl, - $banned_files_lovers_re)) ) { + $banned_files_lovers_re)) + ) { # clean, or recipient wants it } else { # change mail destiny for those not wanting malware $r->recip_destiny($final_destiny); my($reason); - if (@virusname) - { $reason = "VIRUS: " . join(", ", @virusname) } - elsif (@banned_filename) + if (@banned_filename) { $reason = "BANNED: " . join(", ", @banned_filename) } + elsif (@virusname) + { $reason = "VIRUS: " . join(", ", @virusname) } + $r->recip_smtp_response( ($final_destiny == D_DISCARD ? "250 2.7.1 Ok, discarded" : "550 5.7.1 Message content rejected") @@ -5586,7 +6254,7 @@ : @banned_filename ? $addr_extension_banned : ''; if ($recipient_delimiter ne '' && $ext ne '' && $r->recip_destiny == D_PASS && - lookup($r->recip_addr, $local_domains_sql, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $local_domains_sql, $local_domains_ldap, \%local_domains, \@local_domains_acl, $local_domains_re) ) { # append address extensions to mailbox names if desired, @@ -5598,7 +6266,7 @@ s/^(.*?)\Q$recipient_delimiter\E.*$(?!\n)/$1/s; } do_log(5,"adding extension $recipient_delimiter". - "$ext to $localpart\@$domain"); + "$addr_extension_virus to $localpart\@$domain"); $r->recip_addr_modified( $localpart . $recipient_delimiter . $ext . $domain); } @@ -5613,20 +6281,54 @@ # that the mail is spam $which_section = "deal_with_spam"; for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') + { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; # already dealt with - my($should_be_killed) = !$r->recip_whitelisted_sender && - ($r->recip_blacklisted_sender || - defined $spam_level && $spam_level>=lookup($r->recip_addr, + my($mapped_recip) = $Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip; + do_log(1,"pre-Spam level: $spam_level"); + + my $spam_level = do { + if ( defined( $spam_level ) && $use_barracuda_bayes ) + { + $spam_level + $r->recip_bayes_score->{weight}; + } + else + { + $spam_level; + } + }; + #my $spam_level = $spam_level + $r->recip_bayes_score->{weight} + #if defined $spam_level && $use_barracuda_bayes; + # Locally alter the spam_level + + do_log(1,"post-Spam level: $spam_level hit_type=$HIT_TYPE"); + + $should_be_killed = $r->recip_blacklisted_sender || ($HIT_TYPE == TYPE_BLOCK()) || + defined $spam_level && $spam_level>=lookup($mapped_recip, $spam_kill_level_sql, $spam_kill_level_ldap, - $sa_kill_level_deflt)); + \%sa_block_level_deflt, $sa_kill_level_deflt); + #\%sa_block_level_deflt, $sa_kill_level_deflt); + if( $msginfo->mime_entity->head->get('X-ASG-Block')) + { + $should_be_killed = 1; + } next unless $should_be_killed; # message is at or above kill level, or sender is blacklisted - $considered_spam_by_some_recips = 1; - if ($final_spam_destiny == D_PASS || - lookup($r->recip_addr, $spam_lovers_sql,$spam_lovers_ldap, - \%spam_lovers,\@spam_lovers_acl,$spam_lovers_re) ) { + if ($final_spam_destiny == D_PASS || $r->recip_whitelisted_sender || + $r->recip_whitelisted || + lookup($mapped_recip, + $spam_lover_db1, + $spam_lover_db2, + $spam_lovers_ldap, + \%spam_lovers, + $spam_lovers_re) ) { # do nothing, recipient wants this message, even if spam + do_log(5,"do nothing - $recip wants this message"); + next; # essentially should_be_killed is really 0 } else { # change mail destiny for those not wanting spam + $considered_spam_by_some_recips = 1; + do_log(5,"considered spam by $recip"); $r->recip_destiny($final_spam_destiny); my($reason) = $r->recip_blacklisted_sender ? 'sender blacklisted' : 'UBE'; @@ -5635,12 +6337,13 @@ : "550 5.7.1 Message content rejected, $reason") . ", id=$am_id"); $r->recip_done(1); + } # add address extensions if enabled and passing the message if ($recipient_delimiter ne '' && $addr_extension_spam ne '' && $r->recip_destiny == D_PASS && - lookup($r->recip_addr, $local_domains_sql, + lookup($mapped_recip, $local_domains_sql, $local_domains_ldap, \%local_domains, \@local_domains_acl, $local_domains_re) ) { # append address extensions to mailbox names if desired, @@ -5660,6 +6363,7 @@ if ($considered_spam_by_some_recips) { $which_section = "spam quar+notif"; ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); + do_spam($conn,$msginfo); } } @@ -5667,30 +6371,32 @@ if (@bad_headers) { # invalid mail headers $which_section = "deal_with_bad_headers"; ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); - my($is_bulk) = $msginfo->mime_entity->head->get("precedence",0); + my($is_bulk) = $msginfo->mime_entity->head->get("precedence"); chomp($is_bulk); - do_log(1, sprintf("BAD HEADER from %s<%s>: %s", + do_log(0, sprintf("BAD HEADER from %s<%s>: %s", $is_bulk eq '' ? '' : "($is_bulk) ", $msginfo->sender, $bad_headers[0] )); - $is_bulk = $is_bulk=~/(bulk|list)/i ? $1 : undef; + $is_bulk =~ /(bulk|list)/i ? $1 : undef; if (defined $is_bulk || $msginfo->sender eq '') { # have mercy on mailing lists and DSN } else { for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } next if $r->recip_done; # already dealt with if ($final_bad_header_destiny == D_PASS || - lookup($r->recip_addr, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $bad_header_lovers_sql, $bad_header_lovers_ldap, \%bad_header_lovers, \@bad_header_lovers_acl, $bad_header_lovers_re) ) { # recipient wants this message, broken or not } else { # change mail destiny for those not wanting it $r->recip_destiny($final_bad_header_destiny); - my($reason) = (split(/\n/,$bad_headers[0]))[0]; + my($reason) = (split("\n",$bad_headers[0]))[0]; $r->recip_smtp_response( ($final_bad_header_destiny == D_DISCARD ? "250 2.6.0 Ok, message with invalid header discarded" - : "554 5.6.0 Message with invalid header rejected") + : "550 5.6.0 Message with invalid header rejected") . ", id=$am_id - $reason"); $r->recip_done(1); } @@ -5705,110 +6411,237 @@ # THIRD: now that we know what to do with it, do it! + prolong_timer($which_section); + if ($forward_method ne '') { # message must be delivered explicitly + + my($sender) = lc($msginfo->sender); + + # outbound Barracuda or + # basic outbound: non-local rcpt: add footer + # !!! with firmware 3.3.03.x, and msg is relayed through box with + # additional 'local' recipients, the footer still will be added. + # This is kind of ok, since we are relaying... + # dk: bug #3850 + my $recip = ${$msginfo->per_recip_data}[0]->recip_addr; + my($rcpt_is_local) = lookup($recip, \%local_domains ); + + if ( $outbound_footer_attachment eq 'Yes' && + (!$rcpt_is_local || $Barracuda::Environment::mode eq 'outbound') ) + { + my($sender) = quotemeta( lc($msginfo->sender) ); + if( scalar( + grep( /$sender/, @outbound_footer_exclude_email_list)) == 0) + { + # dk: not in exclude list, add footer/disclaimer + $which_section = "add_footer"; + $fh->close() or Amavis::Util::cleanup_and_die "Can't close file to add footer: $!"; + + Barracuda::Footer::add_footers( \$msginfo, $tempdir ); + + # The mail file now has the dislaimer. reset the file handle + $fh = IO::File->new("$tempdir/email.txt") or + die "Can't reopen patched file: $!"; + $fh->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file (9): $!"; + binmode($fh,":bytes") or + die "Can't cancel :utf8 mode: $!" if $unicode_aware; + + # restore mail handle for later use + $msginfo->mail_text($fh); + + prolong_timer($which_section); + } + } + $which_section = "forwarding"; ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); #need header + my($method) = $forward_method; + if ($relayhost_is_client && + $forward_method =~ /^smtp/i && $conn->client_ip ne '') { + $method = sprintf("smtp:%s:%d", + $conn->client_ip, $conn->socket_port + 1); + do_log(3,"\$forward_method override -> $method"); + } + # will forward only to those recipients not yet marked # as 'done' by the above content filtering sections for (;;) { my($hdr_edits) = Amavis::Out::EditHeader->new; $hdr_edits = add_forwarding_header_edits_common( - $conn,$msginfo,$hdr_edits,$hold,$any_undecipherable, + $conn,$msginfo,$hdr_edits,$hold, $virus_presence_checked,$spam_presence_checked); my($done_all); my($recip_cl); # ref to a list of similar recip objects ($hdr_edits,$recip_cl,$done_all) = add_forwarding_header_edits_per_recip( - $conn,$msginfo,$hdr_edits,$hold,$any_undecipherable); - last if !@$recip_cl; + $conn,$msginfo,$hdr_edits,$hold); $msginfo->header_edits($hdr_edits); - mail_dispatch($forward_method,$conn,$msginfo,0, + last if !@$recip_cl; + + # joe b8619 9-13-06 journal message here (forwarding section) + if ($HIT_TYPE != TYPE_BLOCK && !$should_be_killed && $journaling_dest_addr ne '' && $journaling_bounce_addr ne '') { + if ($Amavis::journal_object->journal_message($mta_id,"$tempdir/email.txt",$journaling_dest_addr,$journaling_bounce_addr)) { + do_log(2,"Journalized message $mta_id <$journaling_bounce_addr -> $journaling_dest_addr>"); + } + } + # end joe b8619 9-13-06 + + mail_dispatch($method,$msginfo,0, sub {my($r)=@_; grep {$_ eq $r} @$recip_cl} ); last if $done_all; } } prolong_timer($which_section); + # Send off the message for local delivery and THEN log it + # as finished. + mail_dispatch("local:$debug_id", $msginfo, 0); + + # Spit out a log entry for this in the following format: + # CLIENT MSG_ID START_TIME END_TIME "SCAN" ENCRYPTED SENDER RECIP SCORE ACTION REASON REASON_EXTRA SZ:nnnn "SUBJ:"SUBJECT + my $end_time = time; + $ENCRYPTED ||= '-'; + if( $ENCRYPTED ne '-' ) + { + $ENCRYPTED = "ENC"; + } + # Make sure any of our special scores are ignored and not logged + if( $SCORE < -99 || $SCORE > 99 ) + { + $SCORE = '-' + } + $REASON_EXTRA ||= '-'; + my $sender = $msginfo->sender || '-'; + my $recip = ${$msginfo->per_recip_data}[0]->recip_addr; + my $recip_orig = ${$msginfo->per_recip_data}[0]->recip_addr_orig; + + # We want to log the original address, so the message log picks it up + # properly (for global quarantining) + my $log_recip = $recip_orig || $recip; + + + # joe b5663 5-24-06 set NDR tokens (reason) + $builtins{'r'} = ($ndr_reason{$REASON_ID} || $ndr_reason_default); + $builtins{'e'} = $REASON_EXTRA; + + # dk: msg size + my $size = ''; + if( $syslog_emit_size ) { + $size = " SZ:" . $msginfo->msg_xsize; + } + my $debug_log_msg = "$CLIENT_IP $debug_id $START_TIME $end_time SCAN $ENCRYPTED $sender $log_recip $SCORE $ACTION_ID $REASON_ID $REASON_EXTRA$size SUBJ:"; + + # syslog truncate debug line longer than 1024, + # and this causes broken subject line if subject is encoded (Bug# 11624) + my $base_len = 30 + length($debug_log_msg); + if ($base_len + length($SUBJECT) > 1024 && ($SUBJECT =~ /\=\?.*\?\=/)) { + + my $newsubj = ''; + my @subj_parts = split /\n[ \t]/, $SUBJECT; + foreach my $part (@subj_parts) { + + if ($base_len + length($newsubj) + length($part) < 1024) { + $newsubj .= $part; + } else { + last; + } + } + + $SUBJECT = $newsubj if $newsubj; + } + + # remove continuation character -- see bug# 11624 + $SUBJECT =~ s/\n[ \t]//g; # Remove \n's from the subject (alternatively make them \013) + + do_debug_log("$debug_log_msg$SUBJECT"); + $which_section = "delivery-notification"; my($dsn_needed); ($smtp_resp, $exit_code, $dsn_needed) = - one_response_for_all($msginfo,$dsn_per_recip_capable,$am_id); + one_response_for_all($msginfo,$dsn_per_recip_capable); + + + + # zl - disregard dsn_needed if it is a virus sender + if (@virusname && !$warnvirussender) { + $dsn_needed = 0; + } my($warnsender_with_pass) = $smtp_resp =~ /^2/ && !$dsn_needed && - ( $warnvirussender && @virusname - || $warnbannedsender && @banned_filename - || $warnbadhsender && @bad_headers - || $warnspamsender && $considered_spam_by_some_recips ); - do_log(5, sprintf( - "warnsender_with_pass=%s(%s,%s,%s,%s), dsn_needed=%s, exit=%s, %s", - $warnsender_with_pass,$warnvirussender,$warnbannedsender, - $warnbadhsender,$warnspamsender,$dsn_needed,$exit_code,$smtp_resp)); - if ($dsn_needed || $warnsender_with_pass) { + ( ($warnvirussender && @virusname) + || ($warnbannedsender && @banned_filename) + || ($warnbadhsender && @bad_headers) + || ($warnspamsender && $considered_spam_by_some_recips) ); + do_log(5, "warnsender_with_pass=$warnsender_with_pass, dsn_needed=$dsn_needed, exit=$exit_code, $smtp_resp"); + + my $send_quar_bounce = 0; + if( $Barracuda::Environment::mode eq 'outbound' && + $outbound_do_quarantine_ndr) { + for my $r (@{$msginfo->per_recip_data}) { + if( $r->quarantined ) { + $send_quar_bounce = 1; + $warnsender_with_pass = 1; + } + } + } + + # dk: OR send bounce for outbound quarantine + if (( $dsn_needed || $warnsender_with_pass ) || $send_quar_bounce ) { ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname);# need header - my($what_bad_content) = join(' & ', - !@virusname ? () : 'VIRUS', - !@banned_filename ? () : 'BANNED NAME', - !@bad_headers ? () : 'BAD HEADER', - !$considered_spam_by_some_recips ? () : 'SPAM'); my($notification); - if ($msginfo->sender eq '') { # don't respond to null reverse path - my($msg) = "DSN contains $what_bad_content; bounce is not bouncable"; - if (!$dsn_needed) { do_log(4, $msg) } - else { do_log(0, "NOTICE: $msg, mail intentionally dropped") } - $msginfo->dsn_sent(2); # pretend the message was bounced + # joe b6503 BRTS 5-4-06 + if ($brts_skip_bounce) { + $msginfo->dsn_sent(2); + do_log(2, "BRTS: skipping bounce message"); + } elsif ($msginfo->sender eq '') { # don't respond to null reverse path + do_log(4, "Not sending DSN to empty return path"); } elsif ($msginfo->sender_contact eq '') { - my($msg) = sprintf("Not sending DSN to believed-to-be-faked ". - "sender <%s>, mail containing %s", - $msginfo->sender, $what_bad_content); - if (!$dsn_needed) { do_log(4, $msg) } - else { do_log(2, "NOTICE: $msg intentionally dropped") } - $msginfo->dsn_sent(2); # pretend the message was bounced - } elsif (defined $spam_level && defined $sa_dsn_cutoff_level && - $spam_level >= $sa_dsn_cutoff_level) { - my($msg) = "Not sending DSN, spam level $spam_level exceeds DSN cutoff level"; - if (!$dsn_needed) { do_log(4, $msg) } - else { do_log(0, "NOTICE: $msg, mail intentionally dropped") } + do_log(4, "Not sending DSN to believed-to-be-faked return path"); $msginfo->dsn_sent(2); # pretend the message was bounced - } elsif ((@virusname || @banned_filename || @bad_headers || + } elsif ((@virusname || @banned_filename || $considered_spam_by_some_recips) && - $msginfo->mime_entity->head->get("precedence",0) + $msginfo->mime_entity->head->get("precedence") =~ /bulk|list|junk/i ) { - my($msg) = sprintf("Not sending DSN in response to bulk mail ". - "from <%s> containing %s", - $msginfo->sender, $what_bad_content); - if (!$dsn_needed) { do_log(4, $msg) } - else { do_log(0, "NOTICE: $msg, mail intentionally dropped") } + do_log(4, "Not sending DSN in response to bulk mail"); + $msginfo->dsn_sent(2); # pretend the message was bounced + } elsif ($Amavis::HIT_CLASS eq &Amavis::SpamControl::CLASS_SPF) { + do_log(4, "Not sending DSN for hit type of SPF"); + $msginfo->dsn_sent(2); # pretend the message was bounced + } elsif ($Amavis::Conf::perform_spf_check_for_dsn + && &Amavis::SpamControl::do_spf($msginfo, $msginfo->orig_header()) ) { + # Need to check SPF before we send bounces. + do_log(4, "Not sending DSN: SPF check failed"); $msginfo->dsn_sent(2); # pretend the message was bounced } else { # generate delivery status notification according to rfc1892 # and rfc1894, but only if necessary $notification = delivery_status_notification( $conn, $msginfo, $warnsender_with_pass, \%builtins, - @virusname+@banned_filename ? \$notify_virus_sender_templ - : $considered_spam_by_some_recips ? \$notify_spam_sender_templ + @banned_filename ? + \$notify_banned_sender_templ + : @virusname ? + \$notify_virus_sender_templ + : $considered_spam_by_some_recips ? + \$notify_spam_sender_templ + : $send_quar_bounce ? + \$notify_policy_sender_templ : \$notify_sender_templ); } if (defined $notification) { # dsn needed - # send delivery notification - mail_dispatch($notify_method,$conn,$notification,1); + mail_dispatch($notify_method,$notification,1); # send delivery notification my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = - one_response_for_all($notification,0,$am_id); #check status - if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { # dsn successful? + one_response_for_all($notification,0); # check status + if (!$n_dsn_needed) { # dsn delivery successful? $msginfo->dsn_sent(1); # mark the message as bounced - } elsif ($n_smtp_resp =~ /^4/) { - die sprintf("temporarily unable to send DSN to <%s>: %s", - $msginfo->sender, $n_smtp_resp); } else { - do_log(0, sprintf("NOTICE: UNABLE TO SEND DSN to <%s>: %s", - $msginfo->sender, $n_smtp_resp)); + do_log(0, "UNABLE TO SEND DSN: $n_smtp_resp"); # # if dsn can not be sent, try to send it to postmaster # $notification->recips(['postmaster']); - # # attempt double bounce - # mail_dispatch($notify_method,$conn,$notification,1); + # mail_dispatch($notify_method,$notification,1); # attempt double bounce } # $notification->purge; } - prolong_timer($which_section); } + prolong_timer($which_section); $which_section = "finishing"; # generate customized log report - this is usually the only log entry @@ -5831,10 +6664,7 @@ $r->recip_done(1); } } -# if ($hold ne '') { -# do_log(0, "NOTICE: Evidence is to be preserved: $hold"); -# $preserve_evidence = 1; -# } + if ($hold ne '') { $preserve_evidence = 1 }; if (!$preserve_evidence && debug_oneshot()) { do_log(0, "DEBUG_ONESHOT CAUSES EVIDENCE TO BE PRESERVED"); $preserve_evidence = 1; @@ -5843,6 +6673,7 @@ ($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. @@ -5851,7 +6682,6 @@ 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 - do_log(4, "ensure_mime_entity: headers needed, late MIME parsing"); $msginfo->mime_entity(mime_decode($fh,$tempdir)); prolong_timer("ensure_mime_entity"); } @@ -5865,19 +6695,28 @@ } } -sub add_forwarding_header_edits_common($$$$$) { - my($conn, $msginfo, $hdr_edits, $hold, $any_undecipherable, +sub add_forwarding_header_edits_common($$$$) { + my($conn, $msginfo, $hdr_edits, $hold, $virus_presence_checked, $spam_presence_checked) = @_; + $hdr_edits->prepend_header('Received', received_line($conn,$msginfo,am_id(),1), 1) if $insert_received_line && $forward_method ne ''; # discard existing X-AMaViS-HOLD header field, only allow our own - $hdr_edits->delete_header('X-Amavis-Hold'); + $hdr_edits->delete_header('X-Barracuda-Hold'); if ($hold ne '') { - $hdr_edits->append_header('X-Amavis-Hold', $hold); + $hdr_edits->append_header('X-Barracuda-Hold', $hold); do_log(0, 'Placing on HOLD: '.$hold); } + + # add bayes headers + $hdr_edits->delete_header('X-Barracuda-Bayes'); + if ($BAYES_HEADER && $BAYES_HEADER ne '') { + $BAYES_HEADER =~ s/;/\n\t/; + $hdr_edits->append_header('X-Barracuda-Bayes', $BAYES_HEADER); + } + if ($extra_code_antivirus) { if ($X_HEADER_LINE && $X_HEADER_TAG =~ /^[!-9;-\176]+$(?!\n)/) { if ($remove_existing_x_scanned_headers) @@ -5885,8 +6724,9 @@ $hdr_edits->append_header( $X_HEADER_TAG,$X_HEADER_LINE) if $virus_presence_checked; } - $hdr_edits->delete_header('X-Amavis-Alert'); - $hdr_edits->append_header('X-Amavis-Alert', + + $hdr_edits->delete_header('X-Barracuda-Virus-Alert'); + $hdr_edits->append_header('X-Barracuda-Virus-Alert', "INFECTED, message contains virus:\n " . join(",\n ",@virusname), 1) if @virusname; if (@banned_filename) { @@ -5895,25 +6735,35 @@ my($msg) = "BANNED FILENAME, message contains " . (@banned_filename == 1 ? 'part' : 'parts') . " named:\n ". join(",\n ",@b) . (@banned_filename > @b ? ", ..." : ""); - $hdr_edits->append_header('X-Amavis-Alert', $msg, 1); + $hdr_edits->append_header('X-Barracuda-Filename-Alert', $msg, 1); + } + if (@quarantined_filename) { + my(@b) = @quarantined_filename > 3 ? @quarantined_filename[0..2] + : @quarantined_filename; + my($msg) = "BANNED FILENAME, message contains " . + (@quarantined_filename == 1 ? 'part' : 'parts') . " named:\n ". + join(",\n ",@b) . (@quarantined_filename > @b ? ", ..." : ""); + $hdr_edits->append_header('X-Barracuda-Filename-Alert', $msg, 1); } - $hdr_edits->append_header('X-Amavis-Alert', + $hdr_edits->append_header('X-Barracuda-Header-Alert', "BAD HEADER ".$bad_headers[0], 1) if @bad_headers; } if ($extra_code_antispam) { if ($remove_existing_spam_headers) { - $hdr_edits->delete_header('X-Spam-Status'); - $hdr_edits->delete_header('X-Spam-Level'); - $hdr_edits->delete_header('X-Spam-Flag'); - $hdr_edits->delete_header('X-Spam-Score'); - $hdr_edits->delete_header('X-Spam-Report'); - $hdr_edits->delete_header('X-Spam-Checker-Version'); - $hdr_edits->delete_header('X-Spam-Tests'); + #$hdr_edits->delete_header('X-Spam-Status'); + $hdr_edits->delete_header('X-Barracuda-Spam-Status'); + #$hdr_edits->delete_header('X-Spam-Level'); + $hdr_edits->delete_header('X-Barracuda-Spam-Level'); + #$hdr_edits->delete_header('X-Spam-Flag'); + $hdr_edits->delete_header('X-Barracuda-Spam-Flag'); + #$hdr_edits->delete_header('X-Spam-Report'); + $hdr_edits->delete_header('X-Barracuda-Spam-Report'); + #$hdr_edits->delete_header('X-Spam-Checker-Version'); } # $hdr_edits->append_header('X-Spam-Checker-Version', -# sprintf("SpamAssassin %s (%s) on %s", +# sprintf("SpamAssassin %s (%s)", # Mail::SpamAssassin::Version(), -# $Mail::SpamAssassin::SUB_VERSION, $myhostname)); +# $Mail::SpamAssassin::SUB_VERSION)); } $hdr_edits; } @@ -5923,1273 +6773,2052 @@ # that are receiving the same set of header edits (so the message may be # delivered to them in one transaction). # -sub add_forwarding_header_edits_per_recip($$$$$$) { - my($conn, $msginfo, $hdr_edits, $hold, $any_undecipherable, $filter) = @_; +sub add_forwarding_header_edits_per_recip($$$$$) { + + require Barracuda::HeaderUtils; + import Barracuda::HeaderUtils $DEFAULT_LOCALE_CHARSET; + + my($conn, $msginfo, $hdr_edits, $hold, $filter) = @_; my(@recip_cluster); - my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))} + my(@per_recip_data) = grep {(!$filter || &$filter($_))} @{$msginfo->per_recip_data}; - my($per_recip_data_len) = scalar(@per_recip_data); -# if (!$extra_code_antispam) -# { @recip_cluster = @per_recip_data; @per_recip_data = () } + my(@per_recip_data_remaining) = grep {!$_->recip_done && (!$filter || &$filter($_))} + @{$msginfo->per_recip_data}; + + my($per_recip_data_len) = scalar(@per_recip_data_remaining); + if (!$extra_code_antispam) + { @recip_cluster = @per_recip_data; @per_recip_data = () } my($first) = 1; my($cluster_key); my($cluster_full_spam_status); + my ($subj) = ''; + + my $PER_USER_SCORES; + if( $per_user_scoring_enable eq 'Yes' ) + { + $PER_USER_SCORES = 'using per-user scores of'; + } + else + { + $PER_USER_SCORES = 'using global scores of'; + } + for my $r (@per_recip_data) { - my($recip) = $r->recip_addr; + my($recip) = lc($r->recip_addr); + my($orig_recip) = $recip; + if( $Amavis::default_domain && $Amavis::default_domain ne '') + { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } my($blacklisted) = $r->recip_blacklisted_sender; my($whitelisted) = $r->recip_whitelisted_sender; - my($bypassed) = - lookup($recip, $bypass_spam_checks_sql, - $bypass_spam_checks_ldap, \%bypass_spam_checks, - \@bypass_spam_checks_acl, $bypass_spam_checks_re); - my($is_local) = - lookup($recip, $local_domains_sql, + $whitelisted ||= $r->recip_whitelisted; + my($mapped_recip) = $Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip; + my($is_local) = lookup($mapped_recip, $local_domains_sql, $local_domains_ldap, \%local_domains, \@local_domains_acl, $local_domains_re); - my($tag_level) = - lookup($recip, $spam_tag_level_sql, $spam_tag_level_ldap, - $sa_tag_level_deflt); - my($tag2_level) = # looking for kill_level for compatibility - lookup($recip, $spam_tag2_level_sql, $spam_kill_level_sql, - $spam_tag2_level_ldap, $spam_kill_level_ldap, - $sa_tag2_level_deflt, $sa_kill_level_deflt); - my($do_tag) = $is_local && !$bypassed && - ($blacklisted || - (defined $spam_level ? $spam_level >= $tag_level - : $whitelisted ? -10 >= $tag_level : 0)); - my($do_tag2) = $is_local && !$bypassed && !$whitelisted && - ($blacklisted || defined $spam_level && $spam_level>=$tag2_level); - my($do_subj) = $do_tag2 && $sa_spam_subject_tag ne '' && - lookup($recip, $spam_modifies_subj_sql, - $spam_modifies_subj_ldap,$sa_spam_modifies_subj); - my($do_subj_u); - if ($hold ne '' || $any_undecipherable) { # add *UNCHECKED* subj tag? - $do_subj_u = $undecipherable_subject_tag ne '' && - $is_local && !@virusname && - !lookup($recip, $bypass_virus_checks_sql, - $bypass_virus_checks_ldap, \%bypass_virus_checks, - \@bypass_virus_checks_acl, $bypass_virus_checks_re); - } - for ($do_tag,$do_tag2,$do_subj,$do_subj_u) { $_ = $_?1:0 } # normalize - my($spam_level_bar, $full_spam_status); - if ($do_tag || $do_tag2) { - $spam_level_bar = '*' x min($blacklisted?64:$spam_level+0, 64); - $full_spam_status = sprintf( - "%s,\n hits=%s\n tagged_above=%3.1f\n required=%3.1f\n %s%s", - $do_tag2 ? 'Yes' : 'No', - !defined $spam_level ? '-' : sprintf("%3.1f",$spam_level), - $tag_level, $tag2_level, - join('', $blacklisted ? "BLACKLISTED\n " : (), - $whitelisted ? "WHITELISTED\n " : () ), - $spam_status); + # Lookup and use per-user scores if they are allowed, otherwise + # use the global scores + my($tag_level); + my($quar_level); + my($kill_level); + + my $spam_level = do { + if ( defined( $spam_level ) && $use_barracuda_bayes ) + { + $spam_level + $r->recip_bayes_score->{weight}; } - my($key) = join("\000", $do_tag, $do_tag2, $do_subj, $do_subj_u, - $spam_level_bar, $full_spam_status); - if ($first) { - do_log(5, sprintf("headers CLUSTERING: NEW CLUSTER <%s>: ". - "hits=%s, tag=%s, tag2=%s, subj=%s, subj_u=%s, local=%s, bl=%s", - $recip, - !defined $spam_level ? '-' : sprintf("%3.1f",$spam_level), - $do_tag,$do_tag2,$do_subj,$do_subj_u,$is_local,$blacklisted) ); - $cluster_key = $key; $cluster_full_spam_status = $full_spam_status; - } elsif ($key eq $cluster_key) { - do_log(5, "headers CLUSTERING: <$recip> joining cluster"); - } else { - do_log(5, "headers CLUSTERING: skipping <$recip> (tag=$do_tag, tag2=$do_tag2)" ); - next; + else + { + $spam_level; } - if ($first && $do_tag) { - $hdr_edits->append_header('X-Spam-Status',$full_spam_status,1); - $hdr_edits->append_header('X-Spam-Level',$spam_level_bar); + }; + #my $spam_level = $spam_level + $r->recip_bayes_score->{weight} + #if defined $spam_level && $use_barracuda_bayes; + + + # Locally alter the spam_level + + my $spam_threshold; + if( defined $spam_level ) + { + if( $per_user_scoring_enable eq 'Yes' ) + { + # Per-User scoring enabled + $kill_level = lookup($mapped_recip, $spam_kill_level_sql, \%sa_block_level_deflt, $sa_kill_level_deflt); + $quar_level = lookup($mapped_recip, $spam_tag2_level_sql, \%sa_quarantine_level_deflt, $sa_quarantine_level_deflt); + $tag_level = lookup($mapped_recip, $spam_tag_level_sql, \%sa_tag_level_deflt, $sa_tag2_level_deflt); } - if ($first && ($do_subj || $do_subj_u)) { - my($s) = ''; - if ($do_subj_u) { - $s = $undecipherable_subject_tag; - do_log(3,"adding $undecipherable_subject_tag, $any_undecipherable, $hold"); + else + { + $kill_level = lookup($mapped_recip, \%sa_block_level_deflt, $sa_kill_level_deflt); + $quar_level = lookup($mapped_recip, \%sa_quarantine_level_deflt, $sa_quarantine_level_deflt); + $tag_level = lookup($mapped_recip, \%sa_tag_level_deflt, $sa_tag2_level_deflt); + } + # Bad to assume tag_level is lowest score to determine if spam is yes or no, must use lowest of (tag,quar,kill) + # bug 2598 + $spam_threshold = $tag_level; + if ($spam_threshold > $quar_level) { $spam_threshold = $quar_level; } + if ($spam_threshold > $kill_level) { $spam_threshold = $kill_level; } } - $s .= $sa_spam_subject_tag if $do_subj; my($entity) = $msginfo->mime_entity; - if (defined $entity && defined $entity->head->get('Subject',0)) { - local($1,$2); - $hdr_edits->edit_header('Subject', - sub { $_[1]=~/^([ \t]?)(.*)$(?!\n)/s; - ' '.$s.$2 }); - } else { # no Subject header field present, insert one - $s =~ s/[ \t]+$(?!\n)//; # trim - $hdr_edits->append_header('Subject', $s); - if (!defined $entity) { - do_log(0, "WARN: no MIME entity!? Inserting 'Subject'"); - } elsif (!defined $entity->head->get('Subject',0)) { - do_log(0, "INFO: no existing header field 'Subject'"); - } - } - } - if ($first && $do_tag2) { - $hdr_edits->append_header('X-Spam-Flag', 'YES'); -# $hdr_edits->append_header('X-Spam-Report', -# $spam_report,1) if $spam_report ne ''; + + # dk: fix bug 3850, only tag for local recipients + my $tmp_recip = ${$msginfo->per_recip_data}[0]->recip_addr; + my($rcpt_is_local) = lookup($tmp_recip, \%local_domains ); + + my($do_tag) = ($is_local && $rcpt_is_local) && + ( + (defined $spam_level && ($spam_level >= $tag_level) && ($spam_level < $kill_level) && ($spam_level < $quar_level)) || + ($HIT_TYPE == TYPE_TAG()) || + ( (defined $entity && $entity->head->get('X-ASG')) || + (defined $entity && $entity->head->get('X-ASG-Recipient')) ) + ); + my($do_quarantine_subj) = 0; + + # construct header + # eventually this will be a per recipient header, but for now + # looks like X-ASG-: (regex) + + if ($HIT_CLASS > 0) + { + my $hit_type_text; + my $hit_class_text; + if ($HIT_TYPE == TYPE_BLOCK) { $hit_type_text = 'Block'; } + elsif ($HIT_TYPE == TYPE_QUARANTINE) { $hit_type_text = 'Quarantine'; } + elsif ($HIT_TYPE == TYPE_TAG) { $hit_type_text = 'Tag'; } + elsif ($HIT_TYPE == TYPE_WHITELIST) { $hit_type_text = 'Whitelist'; } + + if ($HIT_CLASS == CLASS_SPF()) { $hit_class_text = 'SPF'; } + elsif ($HIT_CLASS == CLASS_BODY()) { $hit_class_text = 'BODY'; } + elsif ($HIT_CLASS == CLASS_SUBJECT()) { $hit_class_text = 'SUBJECT'; } + elsif ($HIT_CLASS == CLASS_HEADER()) { $hit_class_text = 'HEADER'; } + elsif ($HIT_CLASS == CLASS_BFS()) { + $HIT_REGEXP =~ s/\\//g; + $hit_class_text = 'INTENT'; + } + # joe 6-6-06 b7485 adding fingerprint class + elsif ($HIT_CLASS == CLASS_FP()) { $hit_class_text = 'FINGERPRINT'; } + elsif ($HIT_CLASS == CLASS_RBL()) { $hit_class_text = 'RBL'; } + elsif ($HIT_CLASS == CLASS_BRL()) { $hit_class_text = 'BRL'; } + elsif ($HIT_CLASS == CLASS_DKIM()) { $hit_class_text = 'DomainKeys'; } + + my $hdr_txt1 = 'X-ASG-' . $hit_type_text; + my $hdr_txt2 = $hit_class_text . ' (' . $HIT_REGEXP . ')'; + + foreach (split(//, $hdr_txt2)) { + if(ord($_) > 127) { + $hdr_txt2 = Encode::encode("MIME-B", $hdr_txt2); + last; } - push(@recip_cluster, $r); $first = 0; } - my($done_all); - if (@recip_cluster == $per_recip_data_len) { - do_log(3, "headers CLUSTERING: ". - "done all $per_recip_data_len recips in one go"); - $done_all = 1; - } else { - do_log(3, sprintf("headers CLUSTERING: got %d recips out of %d: %s", - scalar(@recip_cluster), $per_recip_data_len, - join(", ", map {"<".$_->recip_addr.">"} @recip_cluster) )); + + # Check if previous x-header is a duplicate of this one, and not write it if it is + if($prev_hdr1 ne $hdr_txt1 || $prev_hdr2 ne $hdr_txt2) + { + $hdr_edits->append_header($hdr_txt1, $hdr_txt2); + $prev_hdr1 = $hdr_txt1; + $prev_hdr2 = $hdr_txt2; } - if (defined($cluster_full_spam_status) && @recip_cluster) { - my($s) = $cluster_full_spam_status; $s =~ s/\n / /g; - do_log(2, sprintf("SPAM-TAG, <%s> -> %s, %s", $msginfo->sender_source, - join(", ", map {"<".$_->recip_addr.">"} @recip_cluster), $s)); + } - ($hdr_edits, \@recip_cluster, $done_all); + + if ($PU_SENDER_WHITELIST) + { + if ($blacklisted) {$hdr_edits->append_header('X-ASG-Blacklist', "Sender (Per-User)");} + else {$hdr_edits->append_header('X-ASG-Whitelist', "Sender (Per-User)");} } -sub do_quarantine($$$$$) { - my($conn,$msginfo,$hdr_edits,$recips_ref,$quarantine_method) = @_; + $quarantine_admin = lookup($mapped_recip, \%pd_quarantine_email, $quarantine_admin); - # NOTE: RFC2821 mentions possible headers X-SMTP-MAIL and X-SMTP-RCPT - # Inserting return path may be redundant (depending on quarantine method), - # but let's insert X-Envelope-From header unconditionally nevertheless. - $hdr_edits->prepend_header('X-Envelope-From', - qquote_rfc2821_local($msginfo->sender)); - # Exim uses: Envelope-To, Sendmail uses X-Envelope-To - $hdr_edits->prepend_header('X-Envelope-To', - join(",\n ",qquote_rfc2821_local(@{$msginfo->recips})), 1); + # dk outbound: _quarantine@localhost + if( $Barracuda::Environment::mode eq 'outbound' ) { + $quarantine_admin = 'PER_USER'; + } - # ignore status, possible problems were already logged or exception thrown - my($quar_msg) = Amavis::In::Message->new; - $quar_msg->sender(defined $mailfrom_to_quarantine ? - $mailfrom_to_quarantine : $msginfo->sender); - do_log(5, "DO_QUARANTINE, sender: ".$quar_msg->sender); - $quar_msg->recips($quarantine_method =~ /^bsmtp:/i - ? $msginfo->recips # original message recipients, bsmtp: - : $recips_ref); # e.g. per-recip domain quarantine - $quar_msg->header_edits($hdr_edits); - $quar_msg->mail_text($msginfo->mail_text); + # dk: bug #3850/basic outbound:only quarantine for local recipients + # sender_is_local: + my $tmp_recip = ${$msginfo->per_recip_data}[0]->recip_addr; + my($rcpt_is_local) = lookup($tmp_recip, \%local_domains ); - # fudge to get to the body_digest of $msginfo, not of $quar_msg - $quarantine_method =~ s/%b/$msginfo->body_digest/eg; - mail_dispatch($quarantine_method,$conn,$quar_msg,1); + # whitelist people, except with quarantined extension + if( $ACTION_ID == 0 && !@quarantined_filename && + (defined $entity && ($entity->head->get('X-ASG-Whitelist')) || + ($HIT_TYPE == TYPE_WHITELIST()) || $PU_SENDER_WHITELIST || $blacklisted || $whitelisted )) + { - my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = - one_response_for_all($quar_msg,0,am_id()); # check status - if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { - # ok - } elsif ($n_smtp_resp =~ /^4/) { - die "temporarily unable to quarantine: $n_smtp_resp"; - } else { # abort if quarantining not successful - die "Can not quarantine: $n_smtp_resp"; + # log whitelisting + if( !$blacklisted ) + { + # Determine the reason we are whitelisted + my $whitelist_reason; + if( $HIT_TYPE == TYPE_WHITELIST() ) + { + if( $HIT_CLASS == CLASS_SUBJECT() ) + { + $whitelist_reason = "$HIT_REGEXP"; + $REASON_ID = 9; } - 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); + elsif( $HIT_CLASS == CLASS_HEADER() ) + { + $whitelist_reason = "$HIT_REGEXP"; + $REASON_ID = 34; } - $msginfo->quarantined_to(\@qa); - do_log(5, "DO_QUARANTINE done"); + elsif( $HIT_CLASS == CLASS_BODY() ) + { + $whitelist_reason = "$HIT_REGEXP"; + $REASON_ID = 37; } - -# If virus found - quarantine it and send notifications -sub do_virus($$) { - my($conn,$msginfo) = @_; - - # suggest a name to be used as 'X-Quarantine-id:' or file name - local($1); my($taint) = substr($virus_quarantine_method,0,0); - $VIRUSFILE = $virus_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si - ? $1.$taint : "virus-%i-%n"; - $VIRUSFILE =~ s/%b/$msginfo->body_digest/eg; - $VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; - $VIRUSFILE =~ s/%n/am_id()/eg; - my($hdr_edits) = Amavis::Out::EditHeader->new; - $hdr_edits->prepend_header('X-Quarantine-id', "<$VIRUSFILE>"); - $hdr_edits->append_header('X-Amavis-Alert', - "INFECTED, message contains virus:\n " . - join(",\n ",@virusname), 1) if @virusname; - if (@banned_filename) { - my(@b) = @banned_filename>3 ?@banned_filename[0..2] :@banned_filename; - my($msg) = "BANNED FILENAME, message contains " . - (@banned_filename == 1 ? 'part' : 'parts') . " named:\n ". - join(",\n ",@b) . (@banned_filename > @b ? ", ..." : ""); - $hdr_edits->append_header('X-Amavis-Alert', $msg, 1); } - - my(@q_addr); # obtain per-recipient quarantine address(es) - do_log(5, "do_virus: looking for per-recipient quarantine") - if ref($virus_quarantine_to) ne ''; - for my $r (@{$msginfo->per_recip_data}) { - my($a) = lookup($r->recip_addr, $virus_quarantine_to); - push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr; + elsif( $PU_SENDER_WHITELIST ) + { + # Bug#9356: we should not set $whitelist_reason, because $REASON_ID 35 will do that. + #$whitelist_reason = "Per-User"; + $REASON_ID = 35; + } + else + { + # Obtain the reason for this whitelist + $whitelist_reason = $entity->head->get('X-ASG-Whitelist'); + my $whitelist_recipient_reason = $entity->head->get('X-ASG-Recipient-Whitelist'); + + # Check for a normal whitelist + if ($whitelist_reason) { + if( $whitelist_reason =~ /Client/ ) + { + $REASON_ID = 11; + $whitelist_reason = ''; + } + elsif( $whitelist_reason =~ /Recipient/ ) + { + $REASON_ID = 12; + $whitelist_reason = ''; + } + elsif( $whitelist_reason =~ /Sender/ ) + { + $REASON_ID = 15; + $whitelist_reason = ''; + } + else + { + # AK 11/18/06 + # Assume this to be Barracuda Reputation Whitelist + $REASON_ID = 61; + $whitelist_reason = ''; + } + } + # Check for a recipient whitelist + elsif ($whitelist_recipient_reason) { + $REASON_ID = 12; + $whitelist_reason = ''; + } + else { + # Warn that no whitelisting reason was given + do_log(1, 'WARNING: No whitelist header found!'); + } } - do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr, - $virus_quarantine_method) if @q_addr; - - do_log(5, "DO_VIRUS - NOTIFICATIONS, sender: ".$msginfo->sender); - $hdr_edits = Amavis::Out::EditHeader->new; - -# my($notify_virus_admin_only_if_sender_is_local) = 0; - # try to find a per-sender administrator - my($admin) = lookup($msginfo->sender_source, \%virus_admin,$virus_admin,$mailto); - if ($admin eq '') { - do_log(4, "Skip virus_admin notification for <".$msginfo->sender. - ">, no admin specified"); -# } elsif ($notify_virus_admin_only_if_sender_is_local && -# lookup($msginfo->sender, $local_domains_sql, $local_domains_ldap, -# \%local_domains, \@local_domains_acl, $local_domains_re)) { -# do_log(2, "Skip virus_admin notification for <".$msginfo->sender. -# ">, non-local sender"); - } else { # notify virus admin - my($notification) = Amavis::In::Message->new; - $notification->sender($mailfrom_notify_admin); - $notification->recips([$admin]); - my(%mybuiltins) = %builtins; # make a local copy - $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; # used in 'To:' - $mybuiltins{'f'} = $hdrfrom_notify_admin; - $notification->mail_text(string_to_mime_entity( - expand(\$notify_virus_admin_templ,\%mybuiltins) )); - $notification->header_edits($hdr_edits); - mail_dispatch($notify_method,$conn,$notification,1); - my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = - one_response_for_all($notification,0,am_id()); # check status - if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { - # ok - } elsif ($n_smtp_resp =~ /^4/) { - die "temporarily unable to notify virus admin: $n_smtp_resp"; - } else { - do_log(0, "FAILED to notify virus admin: $n_smtp_resp"); + # Store the action/reason_extra for logging + $whitelist_reason =~ s/\n//g; + $REASON_EXTRA = $whitelist_reason; + $ACTION_ID = 7; + } + else + { + # Store the reason/action/reason_extra for logging + $REASON_EXTRA = ''; + $REASON_ID = 35; # Per-User + $ACTION_ID = 2; } - # $notification->purge; } + elsif ((defined $entity && $entity->head->get('X-ASG-Block')) || + ($HIT_TYPE == TYPE_BLOCK()) || + @banned_filename || @virusname || + (defined $spam_level && $spam_level >= $kill_level)) + { - if (! ($warnvirusrecip && @virusname || - $warnbannedrecip && @banned_filename) ) { - # warn_recip disabled (common, enabling is usually counterproductive) -# } elsif (! defined($msginfo->sender_contact) ) { -# do_log(5,"do_virus: skip recipient notifications for unknown senders"); - } else { - my(@local_lookups) = ($local_domains_sql, $local_domains_ldap, - \%local_domains, \@local_domains_acl, $local_domains_re); - my(@bypass_virus_checks_lookups) = ($bypass_virus_checks_sql, - $bypass_virus_checks_ldap, \%bypass_virus_checks, - \@bypass_virus_checks_acl, $bypass_virus_checks_re); - my(@bypass_banned_checks_lookups) = ($bypass_banned_checks_sql, - $bypass_banned_checks_ldap, \%bypass_banned_checks, - \@bypass_banned_checks_acl, $bypass_banned_checks_re); - my(@locals) = - grep { @virusname && !lookup($_,@bypass_virus_checks_lookups) ? - $warnvirusrecip - : @banned_filename && !lookup($_,@bypass_banned_checks_lookups) ? - $warnbannedrecip : 0 } - grep { $warn_offsite || lookup($_,@local_lookups) } - @{$msginfo->recips}; - if (@locals) { - my($notification) = Amavis::In::Message->new; - $notification->sender($mailfrom_notify_recip); - $notification->recips(\@locals); - my(%mybuiltins) = %builtins; # make a local copy - $mybuiltins{'f'} = $hdrfrom_notify_admin; - $mybuiltins{'T'} = [quote_rfc2821_local($locals[0])] # 'To:' - if @locals==1 && $locals[0] ne ''; - $notification->mail_text(string_to_mime_entity( - expand(\$notify_virus_recips_templ,\%mybuiltins) )); - $notification->header_edits($hdr_edits); - mail_dispatch($notify_method,$conn,$notification,1); - my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = - one_response_for_all($notification,0,am_id()); # check status - if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { - # ok - } elsif ($n_smtp_resp =~ /^4/) { - die "temporarily unable to notify virus recipients: $n_smtp_resp"; - } else { - do_log(0, "FAILED to notify virus recipients: $n_smtp_resp"); + # No block action necessary but set the action and reason id + if( $HIT_TYPE == TYPE_BLOCK() ) + { + if ($HIT_CLASS == CLASS_BODY()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 37; } - # $notification->purge; + elsif ($HIT_CLASS == CLASS_SUBJECT()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 9; } + elsif ($HIT_CLASS == CLASS_HEADER()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 34; } - do_log(5, "DO_VIRUS - DONE"); + elsif ($HIT_CLASS == CLASS_SPF()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 40; } - -# -# If Spam found - quarantine it and log report -sub do_spam($$) { - my($conn,$msginfo) = @_; - # suggest a name to be used as 'X-Quarantine-id:' or file name - local($1); my($taint) = substr($spam_quarantine_method,0,0); - $VIRUSFILE = $spam_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si - ? $1.$taint : "spam-%b-%i-%n"; - $VIRUSFILE =~ s/%b/$msginfo->body_digest/eg; - $VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; - $VIRUSFILE =~ s/%n/am_id()/eg; - # use the smallest value as the level reported in quarantined headers! - my($tag_level) = - min(map {lookup($_, $spam_tag_level_sql, $spam_tag_level_ldap, - $sa_tag_level_deflt)} @{$msginfo->recips}); - my($tag2_level) = # looking for kill_level compatibility - min(map {lookup($_, $spam_tag2_level_sql, $spam_kill_level_sql, - $spam_tag2_level_ldap, $spam_kill_level_ldap, - $sa_tag2_level_deflt, $sa_kill_level_deflt)} - @{$msginfo->recips}); - my($kill_level) = - min(map {lookup($_, $spam_kill_level_sql, $spam_kill_level_ldap, - $sa_kill_level_deflt)} @{$msginfo->recips}); - my($blacklisted) = scalar(grep {$_->recip_blacklisted_sender} - @{$msginfo->per_recip_data}); - my($whitelisted) = scalar(grep {$_->recip_whitelisted_sender} - @{$msginfo->per_recip_data}); - my($full_spam_status) = sprintf( - "%s,\n hits=%s\n tag1=%3.1f\n tag2=%3.1f\n kill=%3.1f\n %s%s", - (defined $spam_level && $spam_level>=$tag2_level ? 'Yes' : 'No'), - !defined $spam_level ? '-' : sprintf("%3.1f",$spam_level), - $tag_level, $tag2_level, $kill_level, - join('', $blacklisted ? "BLACKLISTED\n " : (), - $whitelisted ? "WHITELISTED\n " : () ), - $spam_status); -# my($s) = $spam_status; $s =~ s/\n //g; - my($s) = $full_spam_status; $s =~ s/\n / /g; - - do_log(5, "do_spam: looking for a quarantine address"); - my(@q_addr); # quarantine address(es) - if ($spam_quarantine_bysender_to) { # by-sender quarantine - my($a) = lookup($msginfo->sender, $spam_quarantine_bysender_to); - push(@q_addr, $a) if $a ne ''; + elsif ($HIT_CLASS == CLASS_BFS()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 39; } - for my $r (@{$msginfo->per_recip_data}) { # per-recipient quarantine - my($a) = lookup($r->recip_addr, $spam_quarantine_to_sql, - $spam_quarantine_to_ldap, $spam_quarantine_to); - push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr; + # joe 6-6-06 b7485 fingerprint stuff + elsif ($HIT_CLASS == CLASS_FP()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 60; } - if (@q_addr) { # try to quarantine it - my($hdr_edits) = Amavis::Out::EditHeader->new; - $hdr_edits->prepend_header('X-Quarantine-id', "<$VIRUSFILE>"); - $hdr_edits->append_header('X-Spam-Status', $full_spam_status, 1); - $hdr_edits->append_header('X-Spam-Level', '*' x min($spam_level+0,64)); -# $hdr_edits->append_header('X-Spam-Report', $spam_report,1) -# if $spam_report ne ''; - do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr, - $spam_quarantine_method); + elsif ($HIT_CLASS == CLASS_RBL()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 3; } - do_log(1, sprintf("SPAM, <%s> -> %s, %s%s", $msginfo->sender_source, - join(',', map{"<$_>"} @{$msginfo->recips}), $s, - !@q_addr ? '' : sprintf(", quarantine %s (%s)", - $VIRUSFILE, join(',',@q_addr)))); - # try to find a per-sender administrator - my($admin) = lookup($msginfo->sender, \%spam_admin,$spam_admin,$mailto); - if ($admin eq '') { - do_log(4, "Skip spam_admin notification for <".$msginfo->sender. - ">, no admin specified"); - } else { # Notify admin - do_log(5, "DO_SPAM - NOTIFICATIONS, sender: ".$msginfo->sender); - my($notification) = Amavis::In::Message->new; - $notification->sender($mailfrom_notify_spamadmin); - $notification->recips([$admin]); - my(%mybuiltins) = %builtins; # make a local copy - $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; # used in 'To:' - $mybuiltins{'f'} = $hdrfrom_notify_spamadmin; - $notification->mail_text(string_to_mime_entity( - expand(\$notify_spam_admin_templ,\%mybuiltins) )); - my($hdr_edits) = Amavis::Out::EditHeader->new; - $notification->header_edits($hdr_edits); - mail_dispatch($notify_method,$conn,$notification,1); - my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = - one_response_for_all($notification,0,am_id()); # check status - if ($n_smtp_resp =~ /^2/ && !$n_dsn_needed) { - # ok - } elsif ($n_smtp_resp =~ /^4/) { - die "temporarily unable to notify spam admin: $n_smtp_resp"; - } else { - do_log(0, "FAILED to notify spam admin: $n_smtp_resp"); + elsif ($HIT_CLASS == CLASS_BRL()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 62; } - # $notification->purge; + elsif ($HIT_CLASS == CLASS_DKIM()) { + $REASON_EXTRA = "$HIT_REGEXP"; + $REASON_ID = 63; } - do_log(5, "DO_SPAM DONE"); } - -# Calculate message digest; -# While at it, also get the message size and store original header, -# since we need it for the %H macro, and MIME::Tools may modify it. - -sub get_body_digest($$) { - my($fh,$msginfo) = @_; - $fh->seek(0,0) or die "Can't rewind mail file: $!"; - local($_); - -# choose message digest method: - my($ctx) = Digest::MD5->new; # 128 bits (32 hex digits) -# my($ctx) = Digest::SHA1->new; # 160 bits (40 hex digits), slightly slower - - my(@orig_header); my($header_size) = 0; my($body_size) = 0; - while (<$fh>) { # skip mail header - last if $_ eq $eol; - $header_size += length($_); push(@orig_header,$_); # with trailing EOL + elsif( (defined $spam_level && $spam_level >= $kill_level) ) + { + $REASON_EXTRA = ""; + $REASON_ID = 31; } - my($len); - while ( ($len=read($fh,$_,16384)) > 0 ) { - $ctx->add($_); $body_size += $len; + $REASON_EXTRA =~ s/\n//g; + $ACTION_ID = 2; } - my($signature) = $ctx->hexdigest; -# my($signature) = $ctx->b64digest; - if ($signature =~ /^( [0-9a-fA-F]{32} (?: [0-9a-fA-F]{8} )? ) $(?!\n)/x) { - $signature = $1; # checked (either 32 or 40 char), untaint + # dk: bug #3850/basic outbound:only quarantine for local recipients + elsif ( $ACTION_ID == 0 && + (($rcpt_is_local || $Barracuda::Environment::mode eq 'outbound') && + (defined $quarantine_admin && $quarantine_admin ne '') ) && + ( + (defined $entity && + (($entity->head->get('X-ASG-Quarantine') || + $entity->head->get('X-ASG-Recipient-Quarantine')))) || + (defined $spam_level && $spam_level >= $quar_level) || + @quarantined_filename || + ($HIT_TYPE == TYPE_QUARANTINE()) + ) + ) + { + my $quarantine_reason; + if( @quarantined_filename ) + { + my $name = join(",",@quarantined_filename) if @quarantined_filename; + $quarantine_reason = "$name"; + $REASON_ID = 2; } - # store information obtained - $msginfo->orig_header(\@orig_header); - $msginfo->orig_header_size($header_size); - $msginfo->orig_body_size($body_size); - $msginfo->body_digest($signature); - - section_time('body hash'); - do_log(3, "body hash: $signature"); - $signature; + elsif( $HIT_TYPE == TYPE_QUARANTINE() ) + { + if ($HIT_CLASS == CLASS_BODY()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 37; } - -sub find_program_path($$$) { - my($fv_list, $path_list_ref, $may_log) = @_; - $fv_list = [$fv_list] if !ref $fv_list; - my($found) = undef; - for my $fv (@$fv_list) { - my(@fv_cmd) = split(' ',$fv); - if (!@fv_cmd) { # empty, not available - } elsif ($fv_cmd[0] =~ /^\//) { # absolute path - my($errn) = stat($fv_cmd[0]) ? 0 : 0+$!; - if ($errn == ENOENT) {} - elsif ($errn) { do_log(0, "find_program_path: ". - "$fv_cmd[0] inaccessible: $!") if $may_log } - elsif (-x _ && !-d _) { $found = join(' ',@fv_cmd) } - } elsif ($fv_cmd[0] =~ /\//) { # relative path - die "find_program_path: relative paths not implemented: @fv_cmd\n"; - } else { # walk through the specified PATH - for my $p (@$path_list_ref) { - my($errn) = stat("$p/$fv_cmd[0]") ? 0 : 0+$!; - if ($errn == ENOENT) {} - elsif ($errn) { do_log(0, "find_program_path: ". - "$p/$fv_cmd[0] inaccessible: $!") if $may_log } - elsif (-x _ && !-d _) { - $found = $p . '/' . join(' ',@fv_cmd); - last; + elsif ($HIT_CLASS == CLASS_SUBJECT()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 9; } + elsif ($HIT_CLASS == CLASS_HEADER()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 34; } + elsif ($HIT_CLASS == CLASS_RBL()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 3; } - last if defined $found; + elsif ($HIT_CLASS == CLASS_BRL()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 62; } - $found; + elsif ($HIT_CLASS == CLASS_DKIM()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 63; } - -sub find_external_programs($) { - my($path_list_ref) = @_; - for my $f (qw($file $arc $gzip $bzip2 $lzop $lha $unarj - $uncompress $unfreeze $unrar $zoo $cpio)) { - my($g) = $f; $g =~ s/\$/Amavis::Conf::/; - my($fv_list) = eval('$'.$g); - my($found) = find_program_path($fv_list,$path_list_ref,1); - { no strict 'refs'; $$g = $found } # NOTE: a symbolic reference - if (!defined $found) { - do_log(0, sprintf("No %-14s not using it", "$f,")); - } else { - do_log(0, sprintf("Found %-11s at %s%s", $f, - $daemon_chroot_dir ne '' ?"(chroot: $daemon_chroot_dir/) " :'', - $found)); + elsif ($HIT_CLASS == CLASS_BFS()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 39; } + # joe b7485 fingerprint stuff + elsif ($HIT_CLASS == CLASS_FP()) { + $quarantine_reason = "$HIT_REGEXP"; + $REASON_ID = 60; } - # map program name hints to full paths - my($tier) = 'primary'; # primary, secondary, ... av scanners - for my $f (@av_scanners, "\000", @av_scanners_backup) { - if ($f eq "\000") { - $tier = 'secondary'; - } elsif (!defined $f || !ref $f) { # empty, skip - } elsif (ref($f->[1]) eq 'CODE') { - do_log(0, "Using internal av scanner code for ($tier) ".$f->[0]); - } else { - my($found) = $f->[1] = find_program_path($f->[1],$path_list_ref,1); - if (!defined $found) { - do_log(3, "No $tier av scanner: ".$f->[0]); - $f = undef; # release its storage - } else { - do_log(0, sprintf("Found $tier av scanner %-11s at %s%s", - $f->[0], - $daemon_chroot_dir ne '' ? "(chroot: $daemon_chroot_dir/) " - : '', - $found)); } + elsif( (defined $spam_level && $spam_level >= $quar_level) ) + { + $quarantine_reason = ""; + $REASON_ID = 31; } + else + { + # dk: fix bug 6757 - first check per-user quar, then 'global' + # regex quarantine + # + # Obtain the reason for this quarantine + # joe 6-26-06 b7506 -- there could be multiple X-ASG-Recipient-Quarantine headers + # so check them all.. grep for the intended rcpt (first one, since msg is now + # split up before amavisd sees it) + my $tmp_rcpt = ${$msginfo->per_recip_data}[0]->recip_addr; + my $ohref = $msginfo->orig_header; + if (join("\n",@$ohref) =~ m/^X-ASG-Recipient-Quarantine:\s+($tmp_rcpt)$/m) { + $quarantine_reason = $1; + } + if( ! $quarantine_reason ) { + $quarantine_reason = $entity->head->get('X-ASG-Quarantine'); + } + chomp( $quarantine_reason ); + + if( $quarantine_reason =~ /Client/ ) { + $REASON_ID = 11; + $quarantine_reason = ''; + } + # joe 4-6-06 b6326 only quarantine if reason matches the + # recipient + elsif( $quarantine_reason =~ /Recipient$/ ) { + $REASON_ID = 12; + $quarantine_reason = ''; + } + elsif( $quarantine_reason =~ /Sender/ ) { + $REASON_ID = 15; + $quarantine_reason = ''; } + else { + # dk: case insensitive match of current recipient against + # recipient that needs to be quarantined + if ( ${$msginfo->per_recip_data}[0]->recip_addr =~ + m/^$quarantine_reason$/i ) { + $REASON_ID = 12; + $quarantine_reason = ''; + } else { + goto skip_quarantine; } - -# Fetch all remaining modules. -sub fetch_modules_extra() { - my(@modules); - if ($extra_code_sql) { - push(@modules, 'DBI'); - for (@lookup_sql_dsn) { - my(@dsn) = split(/:/,$_->[0],-1); - push(@modules, 'DBD::'.$dsn[1]) if uc($dsn[0]) eq 'DBI'; } } - push(@modules, 'Net::LDAP') if $extra_code_ldap; - push(@modules, qw(Compress::Zlib Convert::TNEF Convert::UUlib - Archive::Zip Archive::Tar)) unless $bypass_decode_parts; - push(@modules, qw(Mail::SpamAssassin)) if $extra_code_antispam; - Amavis::Boot::fetch_modules('REQUIRED ADDITIONAL MODULES', 1, @modules); - if ($extra_code_antispam) { # must be loaded before chroot takes place - Amavis::Boot::fetch_modules('PRE-COMPILE OPTIONAL MODULES', 0, qw( - Mail::SpamAssassin::UnixLocker Mail::SpamAssassin::PerMsgLearner - Mail::SpamAssassin::Locker::UnixNFSSafe - Mail::SpamAssassin::BayesStoreDBM - Mail::SpamAssassin::BayesStore::DBM - Mail::SpamAssassin::DBBasedAddrList - Mail::SpamAssassin::Plugin::URIDNSBL - Mail::SPF::Query Net::CIDR::Lite - Net::DNS::RR::SOA Net::DNS::RR::NS Net::DNS::RR::MX - Net::DNS::RR::A Net::DNS::RR::AAAA Net::DNS::RR::PTR - Net::DNS::RR::CNAME Net::DNS::RR::TXT Net::Ping bytes)); + + # Store the reason_extra for logging + $quarantine_reason =~ s/\n//g; + $REASON_EXTRA = $quarantine_reason; + + # If the quarantine admin is our per user quarantine then set + # the recipient addr to the recipient instead of the quarantine_admin + # otherwise do the normal quarantine_admin reassign + # dk: always send to on-box quarantine user when in outbound mode + if(($quarantine_admin eq 'PER_USER' && + lookup($mapped_recip, $local_domains_sql, + $local_domains_ldap, \%local_domains, \@local_domains_acl, $local_domains_re) ) || + ( $Barracuda::Environment::mode eq 'outbound' ) ) + { + + # Set the recipient and make sure that we write out a header for + # quarantine with the PER_USER value + $r->recip_addr($orig_recip); + + # If we are set to not enable quarantine for this user's policy + # then we need to modify the subject line and not append a quarantine + # header ... otherwise append the header and leave the subject alone. + # also Skip if scana_quarantine_ldap_only is set and we don't + # have a uid + my $bypass_quar = 0; + + # dk: on-box quarantine + if ( $Barracuda::Environment::mode eq 'outbound' ) { + $mapped_recip = '_quarantine@localhost'; + } + + # see if the user already has an account - if so, we want + # to use its policy + my $id = lookup($mapped_recip, $user_id_sql); + if ($scana_quarantine_ldap_only && + lc($scana_quarantine_ldap_only) eq 'yes' && + (!$id || $id == 1 ) && + !$Amavis::PU_UID_MAP{$recip}) { + $bypass_quar = 1; + do_log(1, "Skipping quarantine for non-ldap (uncreated) user:$recip"); + } + # dk: outbound on-box quarantine + if( $Barracuda::Environment::mode ne 'outbound' && + lookup($mapped_recip, $bypass_quarantine_sql) || $bypass_quar) + { + + $do_quarantine_subj = 1; + # Store the action_id for logging + $ACTION_ID = 3; } - # load optional module SAVI if available and desired - if ($extra_code_antivirus) { - my($savi_module_ok,$savi); my($first) = 1; - for (grep {ref($_) eq 'ARRAY' && $_->[0] eq 'Sophos SAVI'} - (@av_scanners, @av_scanners_backup) - ) { - if ($first) { - $savi_module_ok = eval {require SAVI}; + else + { + # Set the envelope from address + $hdr_edits->append_header('X-Barracuda-Envelope-From', $msginfo->sender); -# comment out the following line in order to make SAVI-Perl initialize -# every time a child processs is born (instead of only once at startup time): - $savi = Amavis::AV::sophos_savi_init(@$_) if $savi_module_ok; + # This needs to be delivered to their per-user quarantine mailbox + + $hdr_edits->append_header('X-Barracuda-Quarantine-Per-User', "$quarantine_admin"); + + # Store the action_id for logging + $ACTION_ID = 6; + + # If the admin has set the quarantine score to the tag score, then we + # do the quarantine subject here as well. + # joe 6-26-06 b7605 -- but only tag it if set to global quarantine!!! + if( $tag_level == $quar_level && $quarantine_admin ne 'PER_USER' ) + { + $do_quarantine_subj = 1; + } + + # If this recipient is using the "default" user record instead of their own + # then we need to create them an account + if( !$id || $id == 1 ) + { + # Escape the special characters in the recipient address and then + # create their per-user account + + # ZL: lookup the associated uid and create that account + # instead + my $uid = $Amavis::PU_UID_MAP{$recip} || $recip; + my $real_email_address = $mapped_recip; + + + # dk: on-box quarantine + if ( $Barracuda::Environment::mode eq 'outbound' ) { + $uid = '_quarantine@localhost'; + $real_email_address = '_quarantine@localhost'; + } + $uid = quotemeta($uid); + $real_email_address = quotemeta($real_email_address); + my $command = "/home/emailswitch/code/firmware/current/bin/create_pu_account.pl $real_email_address $uid"; + + # Skip if scana_quarantine_ldap_only is set and we don't + # have a uid + if (!$scana_quarantine_ldap_only || + lc($scana_quarantine_ldap_only) eq 'no' || + $Amavis::PU_UID_MAP{$recip}) { + + do_log(1, "Running command: $command"); + + `$command`; + + # Check return value; if it didn't successfully create, + # then deliver, with [QUAR] tag. + my $raw_exit = $?; + my $exit = $raw_exit >> 8; + my $expected = 1; # create_pu_account returns _ONE_ + # on success!?! + if ($exit != $expected) { + $do_quarantine_subj = 1; + do_log(1, "Create user failed (exit $?); delivering with quarantine tag."); + goto skip_quarantine; + } else { + do_log(1, "Command succeeded."); } - $_->[1] = undef if !$savi_module_ok; - $_->[2] = $savi if defined $savi; - $first = 0; } + else { + do_log(1, "Skipping quarantine for non-ldap user:$recip"); } } + + # joe 3-31-06 - b6159 -- OUTBOUND MODE ONLY -- + # check if this message has already been processed + if( $Barracuda::Environment::mode eq 'outbound') { + if ($Amavis::quarantine_cache) { + if ($multi_recip && $mta_id) { + if ($Amavis::quarantine_cache->update($mta_id)) { + # message already processed, discard this message but give postfix a 250 OK + # message + $r->recip_smtp_response("250 2.6.0 Ok, duplicate quarantine message discarded"); + $r->recip_done(1); + do_log(1, "Discarding duplicate global quarantine message"); + $r->recip_destiny(D_DISCARD); + } else { + # Store a flag for when we do local delivery + $r->per_user(1); + # dk: mark as being quarantined + $r->quarantined( 1 ); + # Mark this recipient as done so it doesn't get delivered + $r->recip_destiny(D_DISCARD); + $r->recip_smtp_response("250 2.6.0 Ok, quarantine message discarded"); + $r->recip_done(1); + } + } elsif($mta_id) { + # Store a flag for when we do local delivery + $r->per_user(1); + # dk: mark as being quarantined + $r->quarantined( 1 ); + # Mark this recipient as done so it doesn't get delivered + $r->recip_destiny(D_DISCARD); + $r->recip_smtp_response("250 2.6.0 Ok, quarantine message discarded"); + $r->recip_done(1); + } else { + do_log(2,"Could not get message id from debug id"); + } + } else { + do_log(2,"No quarantine cache found!"); + } + } else { + # not outbound + # Store a flag for when we do local delivery + $r->per_user(1); + # dk: mark as being quarantined + $r->quarantined( 1 ); + # Mark this recipient as done so it doesn't get delivered + $r->recip_destiny(D_DISCARD); + $r->recip_smtp_response("250 2.6.0 Ok, quarantine message discarded"); + $r->recip_done(1); + } + } + } + else + { # -# Main program starts here + # Global Quarantine Account Redirect. # - -# Read dynamic source code, and logging and notification message templates -# at the end of the Amavis package + # Since Postfix now splits/forks messages for each recipient, we + # may forward the same message to the global quarantine account + # multiple times. Solution is to keep a small cache of + # Message-ID headers, which are message unique (X-Debug-ID was + # changed to be unique to each recipient). If the id existed in + # the header, then discard the message. # -if ($unicode_aware) { - # binmode(\*Amavis::DATA, ":utf8") or die "Can't set \*DATA to utf8: $!"; - # or use: ":encoding(iso-8859-1)" -} -do{ local($/) = "__DATA__\n"; # set line terminator to this string - map { chomp($_ = ) } - ($extra_code_sql, $extra_code_ldap, - $extra_code_in_amcl, $extra_code_in_smtp, - $extra_code_antivirus, $extra_code_antispam, - $log_templ, - $notify_sender_templ, - $notify_virus_sender_templ, - $notify_virus_admin_templ, - $notify_virus_recips_templ, - $notify_spam_sender_templ, - $notify_spam_admin_templ); -}; # restore line terminator -close(\*Amavis::DATA) or die "Can't close *Amavis::DATA: $!"; -# close(STDIN) or die "Can't close STDIN: $!"; -# discarding leading NL inserted by 'configure' -map { s/^\r?\n// } ($log_templ, $notify_sender_templ, - $notify_virus_sender_templ, $notify_spam_sender_templ, - $notify_virus_admin_templ, $notify_spam_admin_templ, - $notify_virus_recips_templ, $notify_spam_recips_templ); -$log_templ = $1 if $log_templ =~ /^(.*?)[\r\n]+$(?!\n)/s; # discard trailing NL + # Keep the original recipient (for global quarantining) + $r->recip_addr_orig($r->recip_addr); -# Be paranoid -umask(0027); + $r->recip_addr($quarantine_admin); -# try to find absolute path name of oneself -my($amavisd_path) = find_program_path($0, [split(/:/, $path, -1)], 0); -$amavisd_path = $1 if $amavisd_path=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)}; # untaint + if ($Amavis::quarantine_cache) { # Use cache defaults + # $debug_id is generated somewhere above us. See it's notes. + if ($multi_recip && $mta_id) { + my $existed = $Amavis::quarantine_cache->update($mta_id); -my($config_file) = '/etc/amavisd.conf'; # default location of config file -if (@ARGV >= 2 && $ARGV[0] eq '-c') { # override by command line option -c - shift @ARGV; $config_file = shift @ARGV; - $config_file = $1 if $config_file=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)};# untaint -} -# Read config file, which may override default settings -Amavis::Conf::read_config($config_file); + if ($existed) { # ... in cache, discard. + use Barracuda::Syslog qw(openlog_r syslog_r); -# Master configuration -my(@modules_basic) = keys %INC; + # Only open the log once. + our $log; -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 (!$enable_ldap) { $extra_code_ldap = undef } -else { - eval $extra_code_ldap or die "Problem in the Lookup::LDAP code: $@"; - $extra_code_ldap = 1; # release memory occupied by the source code + $log = openlog_r("outbound/smtp[$$]",'debug','mail') + unless defined $log; + + unless (defined $log && syslog_r('debug',$log,"127.0.0.1 $debug_id 0 0 SEND - 1 FFFFFFFFFFFF 250 2.6.0 Ok, duplicate quarantine message discarded")) { + do_log(1, "Failed to log delivery status of duplicate quarantine message"); } -if ($unix_socketname eq '') { $extra_code_in_amcl = undef } -else { - eval $extra_code_in_amcl or die "Problem in the In::AMCL code: $@"; - $extra_code_in_amcl = 1; # release memory occupied by the source code + do_log(1, "Discarding duplicate global quarantine message"); + + $r->recip_destiny(D_DISCARD); + $r->recip_smtp_response("250 2.6.0 Ok, duplicate quarantine message discarded"); + $r->recip_done(1); + } else { + do_log(1, "Delivering global quarantine message"); } -if ($inet_socket_port eq '' || ref $inet_socket_port && !@$inet_socket_port) { - $extra_code_in_smtp = undef; } else { - eval $extra_code_in_smtp or die "Problem in the In::SMTP code: $@"; - $extra_code_in_smtp = 1; # release memory occupied by the source code + do_log(1, 'Unknown or invalid $debug_id'); } - -if (!@av_scanners && !@av_scanners_backup) { - $extra_code_antivirus = undef; -} 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 + do_log(1, "No quarantine cache found"); } -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: $@"; - $extra_code_antispam = 1; # release memory occupied by the source code + if ($quarantine_subject_tag) + { + $do_quarantine_subj = 1; } -my($cmd) = lc($ARGV[0]); -if ($cmd =~ /^(start|debug|debug-sa|foreground)?$/) { - $DEBUG=1 if $cmd eq 'debug'; - $daemonize=0 if $cmd eq 'foreground'; - $daemonize=0, $sa_debug=1 if $cmd eq 'debug-sa'; -} elsif ($cmd !~ /^reload|stop$/) { - die "Unknown argument. Usage:\n $0 [ -c config-file ] ( [ start ] | stop | reload | debug | debug-sa | foreground )\n"; -} else { - if ($pid_file eq '') - { die "pid_file config parameter not defined, can't $cmd\n" } - my($errn) = stat($pid_file) ? 0 : 0+$!; - if ($errn == ENOENT) - { die "No pid_file $pid_file, can't $cmd the process\n" } - elsif ($errn) - { die "pid_file $pid_file inaccessible: $!, can't $cmd the process\n" } - my($amavisd_pid); - open(PID_FILE, "< $pid_file\0") or die "Can't read file $pid_file: $!\n"; - while () { chomp; $amavisd_pid = $1 if /^(\d+)$/ } - close(PID_FILE) or die "Can't close file $pid_file: $!"; - defined($amavisd_pid) or die "Invalid PID in the $pid_file, can't $cmd\n"; - my($sig) = $cmd eq 'reload' ? 'HUP' : 'TERM'; - kill($sig,$amavisd_pid) or die "Can't $sig amavisd[$amavisd_pid]: $!\n"; - exit 0; + # Store the action_id for logging + $ACTION_ID = 3; + } } -$daemonize = 0 if $DEBUG; - -# Set path, home and term explictly. Don't trust environment -$ENV{PATH} = $path if $path ne ''; -$ENV{HOME} = $helpers_home if $helpers_home ne ''; -$ENV{TERM} = 'dumb'; $ENV{COLUMNS} = '80'; $ENV{LINES} = '100'; - -Amavis::Log::init("amavis", !$daemonize, - $DO_SYSLOG, $SYSLOG_LEVEL, $LOGFILE, $log_level); -# $SIG{USR2} = sub { -# my($msg) = Carp::longmess("SIG$_[0] received, backtrace:"); -# print STDERR "\n",$msg,"\n"; do_log(0,$msg); -# }; + # joe 4-6-06 b6326 + # we jump to here if we want to bail out of quarantine function + skip_quarantine: -fetch_modules_extra(); # bring additional modules into memory and compile them + # Replace the debug id header with the one we generated which is + # unique to this recipient for this message + $hdr_edits->delete_header('X-ASG-Debug-ID'); + $hdr_edits->prepend_header('X-ASG-Debug-ID', $debug_id); -# my(@modules_extra); -# for my $m (keys %INC) -# { push(@modules_extra, $m) if !grep {$_ eq $m} @modules_basic } -# do_log(0, "modules loaded: " .join(", ", sort @modules_basic)); -# do_log(0, "extra modules loaded: ".join(", ", sort @modules_extra)); + my($do_subj) = $do_tag && $sa_spam_subject_tag ne '' && + lookup($mapped_recip, $spam_modifies_subj_sql, + $spam_modifies_subj_ldap,$sa_spam_modifies_subj); + for ($do_tag,$do_quarantine_subj,$do_subj) { $_ = $_ ? 1 : 0 } # normalize + my($spam_level_bar); + $spam_level_bar = '*' x (min( $blacklisted?64:$spam_level, 64)); + $full_spam_status = sprintf( + "%s, SCORE=%4.2f $PER_USER_SCORES TAG_LEVEL=%3.1f QUARANTINE_LEVEL=%3.1f KILL_LEVEL=%3.1f %s%s", + ( ($blacklisted || defined $spam_level && $spam_level>=$spam_threshold) ? 'Yes' : 'No'), + $spam_level, $tag_level, $quar_level, $kill_level, + join('', $blacklisted ? "BLACKLISTED " : (), + $whitelisted ? "WHITELISTED " : () ), $spam_status); + # $hdr_edits->append_header('X-Sender-Status', + # 'Whitelisted') if $whitelisted; + + my $score_hdr = sprintf("%4.2f", $spam_level); + # my $score_hdr = sprintf("%4.2f", $spam_level - $r->recip_bayes_score->{weight}); + # + # Remove the Bayes weighted score from the X-Barracuda-Spam-Score. + # If $use_barracuda_bayes isn't true weight should be zero, so don't + # bother with a conditional. + # + # 2005-06-10 (wahern) Removed since it was too confusing. The spam_score + # will now always be displayed WITH Bayesian added. + # -# report versions of Perl and modules -do_log(0, "Perl version $]"); -for my $m ('Amavis::Conf', - sort map { s/\.pm$//; s[/][::]g; $_ } grep { /\.pm$/ } keys %INC) { - next if !grep { $_ eq $m } qw( Amavis::Conf - Archive::Tar Archive::Zip Compress::Zlib Convert::TNEF Convert::UUlib - MIME::Entity MIME::Parser MIME::Tools Mail::Header Mail::Internet - Mail::SpamAssassin Net::DNS Net::SMTP Net::Cmd Net::Server Net::LDAP - DBI DB_File SAVI Unix::Syslog Time::HiRes); - do_log(0, sprintf("Module %-19s %s", $m, $m->VERSION || '?')); + my($key) = join("\000", $do_tag, $do_quarantine_subj,$do_subj, + $spam_level_bar, $full_spam_status); + if ($first) { + do_log(5, sprintf("headers CLUSTERING: NEW CLUSTER <%s>: ". + "hits=%3.1f, tag=%d, quar_subj=%d, subj=%d, local=%d, bl=%d", + $recip, $spam_level,$do_tag,$do_quarantine_subj,$do_subj,$is_local,$blacklisted) ); + $cluster_key = $key; $cluster_full_spam_status = $full_spam_status; + } elsif ($key eq $cluster_key) { + do_log(5, "headers CLUSTERING: <$recip> joining cluster"); + } else { + do_log(5, "headers CLUSTERING: skipping <$recip> (tag=$do_tag)" ); + push(@recip_cluster, $r); + next; + } + if ($first && defined $spam_level) { + $hdr_edits->append_header('X-Barracuda-Spam-Score', $score_hdr); + $hdr_edits->append_header('X-Barracuda-Spam-Status',$full_spam_status,1); + $hdr_edits->append_header('X-Barracuda-Spam-Report', + $spam_report,0) if $spam_report ne ''; + #$hdr_edits->append_header('X-Spam-Level',$spam_level_bar); + } + if ( $ACTION_ID == 0 && $first && $do_subj && !$do_quarantine_subj) { + my $tag_reason; + if( $HIT_TYPE == TYPE_TAG() ) + { + if ($HIT_CLASS == CLASS_BODY()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 37; + } + elsif ($HIT_CLASS == CLASS_SUBJECT()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 9; + } + elsif ($HIT_CLASS == CLASS_HEADER()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 34; + } + elsif ($HIT_CLASS == CLASS_SPF()) { + $tag_reason = "-"; + $REASON_ID = 40; + } + elsif ($HIT_CLASS == CLASS_BFS()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 39; + } + elsif ($HIT_CLASS == CLASS_RBL()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 3; + } + elsif ($HIT_CLASS == CLASS_BRL()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 62; + } + elsif ($HIT_CLASS == CLASS_DKIM()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 63; + } + # joe b7485 fingerprint stuff + elsif ($HIT_CLASS == CLASS_FP()) { + $tag_reason = "$HIT_REGEXP"; + $REASON_ID = 60; + } + } + elsif( (defined $spam_level && $spam_level >= $tag_level) ) + { + $tag_reason = ""; + $REASON_ID = 31; + } + else + { + # Obtain the reason for this tag + # joe 6-26-06 b7506 -- there could be multiple X-ASG-Recipient headers (which + # cause amavisd to tag the message as SPAM) so check them all.. + # grep for the intended rcpt (first one, since msg is now + # split up before amavisd sees it) + my $tmp_rcpt = ${$msginfo->per_recip_data}[0]->recip_addr; + my $ohref = $msginfo->orig_header; + if (join("\n",@$ohref) =~ m/^X-ASG-Recipient:\s+($tmp_rcpt)$/m) { + $tag_reason = $1; + } + + # dk: fix bug 6757 - first check per-user tag, then 'global' + # regex tag + if( ! $tag_reason ) { + $tag_reason = $entity->head->get('X-ASG'); + } + + chomp($tag_reason); + if( $tag_reason =~ /Client/ ) { + $REASON_ID = 11; + $tag_reason = ''; + } + # joe 4-6-06 b6326 - for tagging + elsif( $tag_reason =~ /Recipient$/ ) { + $REASON_ID = 12; + $tag_reason = ''; + } + elsif( $tag_reason =~ /Sender/ ) { + $REASON_ID = 15; + $tag_reason = ''; + } + else { + # dk: case insensitive match of current recipient against + # recipient that needs to be quarantined + if ( ${$msginfo->per_recip_data}[0]->recip_addr =~ + m/^$tag_reason$/i ) { + $REASON_ID = 12; + $tag_reason = ''; + } else { + goto skip_tag; + } } - -if ($forward_method eq '' && $extra_code_in_smtp) { - do_log(1, "forward_method is null (probably milter setup), ". - "DISABLING SMTP-in AS A PRECAUTION"); - $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, "Lookup::LDAP code ".($extra_code_ldap ?'':" 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"); -do_log(1, "ANTI-SPAM code ".($extra_code_antispam?'':" NOT")." loaded"); - -# release storage -if (!$extra_code_antivirus) { @av_scanners = @av_scanners_backup = () } -# Prepare a hash of macros to be used in notification message expansion. -# A key (macro name) must be a single character. Most characters are -# allowed, but to be on the safe side and for clarity it is suggested -# that only letters are used. Upper case letters may (as a mnemonic) -# suggest the value is an array, lower case may suggest the value is -# a scalar string - but this is only a convention and not enforced. -# -# A value may be a reference to a subroutine which will be called later at -# the time of macro expansion. This way we can provide a method for obtaining -# information which is not yet available, such as AV scanner results, -# or provide a lazy evaluation for more expensive calculations. -# Subroutine will be called in scalar context with no arguments. -# It may return a scalar string (or undef), or an array reference. + # Store the action/reason_extra for logging + $tag_reason =~ s/\n//g; + $ACTION_ID = 4; + $REASON_EXTRA = $tag_reason; -%builtins = ( - d => sub {rfc2822_timestamp()}, # provide RFC 2822 date-time (current time) - h => $myhostname, # dns name of this host, or configurable name - l => sub {lookup($MSGINFO->sender_source, $local_domains_sql, - $local_domains_ldap, \%local_domains, - \@local_domains_acl, $local_domains_re) - ? 1 : undef}, # sender is local - s => sub {qquote_rfc2821_local($MSGINFO->sender)}, # original envelope sender in <> - S => sub {$MSGINFO->sender_contact}, # unmangled sender / sender address to be notified - o => sub {$MSGINFO->sender_source}, # best attempt at determining - # true sender (origin) of the virus - # - normally the same as %s - R => sub {$MSGINFO->recips},# original message recipients list - D => sub {my($y,$n)=delivery_short_report($MSGINFO); $y}, # short dsn: succ - N => sub {my($y,$n)=delivery_short_report($MSGINFO); $n}, # short dsn: fail - t => sub {first_received_from($MSGINFO->mime_entity)}, # first entry in the Received: trace - m => sub { local($_) = $MSGINFO->mime_entity; # Message-ID of the message - if (defined) { $_ = $_->head->get("Message-ID",0); chomp; $_ }}, - j => sub { local($_) = $MSGINFO->mime_entity; # Subject of the message - if (defined) { $_ = $_->head->get("Subject",0); chomp; $_ }}, - b => sub {$MSGINFO->body_digest}, # original message body digest - n => \&am_id, # amavis internal message id (for log entries) - i => sub {$VIRUSFILE}, # some quarantine id, e.g. quarantine filename - 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 - X => sub {\@bad_headers}, # list of header syntax violations - W => sub {\@detecting_scanners}, # list of av scanners detecting a virus - H => sub {[map {my $h=$_; chomp($h); $h} @{$MSGINFO->orig_header}]},# orig hdr - A => sub {[split(/\r?\n/, $spam_report)]}, # SpamAssassin report lines - c => sub {!defined $spam_level?'-':$spam_level}, # SpamAssassin hits/score - z => sub {$MSGINFO->orig_body_size+1+$MSGINFO->orig_header_size},#mail size - # macros f, T, C, B will be defined by each warn_* as appropriate - # (representing From:, To:, Cc:, and Bcc: respectively) + # Put the subject tag in place -- either insert or replace + my($entity) = $msginfo->mime_entity; + if (defined $entity && defined($entity->head->get('Subject')) ) + { + # check if the tag is already there (and in the first 10 chars) + my $tag_in_subject = index($entity->head->get('Subject'), + $sa_spam_subject_tag); + if ($tag_in_subject == -1 || $tag_in_subject > 10) + { + if ($entity->head->get('Subject') =~ /^([ \t]?)(.*)$(?!\n)/s) + { + $subj = Barracuda::HeaderUtils::tag_header($2, $sa_spam_subject_tag, + $sa_spam_subject_fallback_tag, + $mime_encode_tagged_subject, + $convert_tagged_subject_2_utf8 ); -# Map local virtual username to a mailbox (e.g. to a quarantine filename -# or a directory). Used by mail_to_local_mailbox(), e.g. for direct -# local quarantining. The hash value may be a ref to a pair of fixed -# strings, or a subroutine ref (which must return a pair of strings -# (a list, not a list ref)) which makes possible lazy evaluation -# when some part of the pair is not known before the final delivery time. -# -# The first string in a pair must be either: -# - empty or undef, which will disable saving the message, -# - a filename, indicating a Unix-style mailbox, -# - a directory name, indicating a maildir-style mailbox, -# in which case the second string may provide a suggested file name. -# -%local_delivery_aliases = ( - 'virus-quarantine' => sub { ($QUARANTINEDIR, $VIRUSFILE) }, -# 'spam-quarantine' => sub { ($QUARANTINEDIR, $VIRUSFILE) }, # normal - 'spam-quarantine' => sub { ($QUARANTINEDIR, "$VIRUSFILE.gz") }, # gzipped - 'user-quarantine' => # just an example - sub { my($s) = $MSGINFO->sender; - $s =~ s/[^a-zA-Z0-9._=@]/-/; $s =~ s/\@/=/; - ( $QUARANTINEDIR, - sprintf("user-%s-%s-%05d.gz", # suggested file name - $s, strftime("%Y%m%d-%H%M%S",localtime), $$) ) - }, - 'ham-quarantine' => # another example - sub { ("$QUARANTINEDIR/ham.mbox", undef) }, - 'outgoing-quarantine' => # another example - sub { ("$QUARANTINEDIR/outgoing.mbox", undef) }, - 'incoming-quarantine' => # another example - sub { ("$QUARANTINEDIR/incoming.mbox", undef) }, -); + } -# set up Net::Server configuration -my $server = bless { - server => { - # command line arguments to be used after HUP must be untainted - commandline => [$amavisd_path, '-c', $config_file], # deflt: [$0,@ARGV] + $hdr_edits->edit_header('Subject', sub { $subj }); + } + } + else + { + # no Subject header field present, insert one + my $s = Barracuda::HeaderUtils::tag_header(' ', $sa_spam_subject_tag, + $sa_spam_subject_fallback_tag, + $mime_encode_tagged_subject, + $convert_tagged_subject_2_utf8 + ); + $hdr_edits->append_header('Subject', $s); + $subj = $s; + } - # listen on the following sockets (one or more): - port => [ ($unix_socketname eq '' ? () : - "$unix_socketname|unix"), # traditional amavis client - map { "$_/tcp" } # accept SMTP on this port(s) - (ref $inet_socket_port ? @$inet_socket_port : - $inet_socket_port ne '' ? $inet_socket_port : () ), - ], - # limit socket bind (e.g. to the loopback interface) - host => ($inet_socket_bind eq '' ? '*' : $inet_socket_bind), + # If they want to set the low priority headers do so + if( $set_low_priority eq 'Yes' ) + { + $hdr_edits->append_header('X-Priority', '5 (Lowest)'); + $hdr_edits->append_header('X-MSMail-Priority','Low'); + $hdr_edits->append_header('Importance','Low'); + } + } - max_servers => $max_servers, # number of pre-forked children - max_requests => $max_requests, # restart child after that many accept's + # joe 4-6-06 b6326 + # we jump here if we want to bail out of the middle of tagging a message + skip_tag: - user => $daemon_user, - group => $daemon_group, - pid_file => $pid_file, - lock_file => $lock_file, # serialization lockfile - # serialize => 'flock', # flock, semaphore, pipe - background => $daemonize ? 1 : undef, - setsid => $daemonize ? 1 : undef, - chroot => $daemon_chroot_dir ne '' ? $daemon_chroot_dir : undef, - no_close_by_child => 1, + if (!defined($subj) && defined($entity) && defined($entity->head->get('Subject')) ) + { + $subj = $entity->head->get('Subject'); + } - # controls log level for Net::Server internal log messages: - # 0=err, 1=warning, 2=notice, 3=info, 4=debug - log_level => ($DEBUG ? 4 : 2), - log_file => undef, # will be overridden to call do_log() - }, -}, 'Amavis'; -$0 = 'amavisd (master)'; -$server->run; # transfer control to Net::Server + # place quarantine subject tag in front of all quarantined + # messages + if ($first && $do_quarantine_subj) { + my($entity) = $msginfo->mime_entity; + if (defined $entity && defined($entity->head->get('Subject'))) { # edit + # check if the tag is already there (and in the first 10 chars) + my $tag_in_subject = index($entity->head->get('Subject'), + $quarantine_subject_tag); + if ($tag_in_subject == -1 || $tag_in_subject > 10) { + if ($entity->head->get('Subject') =~ /^([ \t]?)(.*)$(?!\n)/s) { + $subj = Barracuda::HeaderUtils::tag_header($2, $quarantine_subject_tag, + $quarantine_subject_fallback_tag, + $mime_encode_tagged_subject, + $convert_tagged_subject_2_utf8 + ); + } + $hdr_edits->edit_header('Subject', sub { $subj }); + } + } else { # no Subject header field present, insert one + my $s = Barracuda::HeaderUtils::tag_header(' ', $quarantine_subject_tag, + $quarantine_subject_fallback_tag, + $mime_encode_tagged_subject, + $convert_tagged_subject_2_utf8 + ); + $hdr_edits->append_header('Subject', $s); + $subj = $s; + } -# shouldn't get here -exit 1; + if( $set_low_priority eq 'Yes' ) + { + $hdr_edits->append_header('X-Priority', '5 (Lowest)'); + $hdr_edits->append_header('X-MSMail-Priority','Low'); + $hdr_edits->append_header('Importance','Low'); + } + } + if ($first && $do_tag) { + $hdr_edits->append_header('X-Barracuda-Spam-Flag', 'YES'); + } + push(@recip_cluster, $r); $first = 0; -# we read text from DATA sections to avoid any interpretations -# of special characters (e.g. \ or ') by Perl -# -__DATA__ + } # next $recip -# -package Amavis::Lookup::SQLfield; -use strict; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - @ISA = qw(Exporter); + # Store the new subject for logging purposes, otherwise + # just use the old one + if( $subj ne '' ) + { + $subj =~ s/\s*\n\s+/ /g; + chomp($subj); + $SUBJECT = $subj; + } + else + { + $SUBJECT = $msginfo->mime_entity->head->get('Subject'); + chomp( $SUBJECT ); } -BEGIN { import Amavis::Util qw(do_log) } -sub new($$$;$$) { - my($class, $sql_query,$fieldname, $fieldtype,$implied_args) = @_; - # fieldtype: B=boolean, N=numeric, S=string, - # N-: numeric, nonexistent field returns undef without complaint - # S-: string, nonexistent field returns undef without complaint - # B-: boolean, nonexistent field returns undef without complaint - # B0: boolean, nonexistent field treated as false - # B1: boolean, nonexistent field treated as true - return undef if !defined($sql_query); - my($self) = bless {}, $class; - $self->{sql_query} = $sql_query; - $self->{fieldname} = lc($fieldname); - $self->{fieldtype} = uc($fieldtype); - $self->{args} = ref($implied_args) eq 'ARRAY' ? [@$implied_args] # copy - : [$implied_args] if defined $implied_args; - $self; + my($done_all); + if (@recip_cluster >= $per_recip_data_len) { + do_log(3, "headers CLUSTERING: ". + "done all $per_recip_data_len recips in one go"); + $done_all = 1; + } else { + do_log(3, sprintf("headers CLUSTERING: got %d recips out of %d: %s", + scalar(@recip_cluster), $per_recip_data_len, + join(", ", map {"<".$_->recip_addr.">"} @recip_cluster) )); + } + if (defined($cluster_full_spam_status) && @recip_cluster) { + my($s) = $cluster_full_spam_status; $s =~ s/\n / /g; + do_log(2, sprintf("SPAM-TAG, <%s> -> %s, %s", $msginfo->sender_source, + join(", ", map {"<".$_->recip_addr.">"} @recip_cluster), $s)); } -sub lookup_sql_field($$) { - my($self,$addr) = @_; - my($match); - if (!defined($self)) { - do_log(5, "lookup_sql_field - undefined, \"$addr\" no match"); - } else { - my($field) = $self->{fieldname}; - if (!defined($self->{sql_query})) { - do_log(5, "lookup_sql_field($field) - null query, \"$addr\" no match"); - } else { - my($h_ref) = !exists($self->{args}) ? - $self->{sql_query}->lookup_sql($addr) - : $self->{sql_query}->lookup_sql($addr,$self->{args}); - if (!defined($h_ref)) { - do_log(5, "lookup_sql_field($field), \"$addr\" no match"); - } elsif (!exists($h_ref->{$field})) { - # record found, but no field with that name in the table - # fieldtype: B0: boolean, nonexistent field treated as false, - # B1: boolean, nonexistent field treated as true - if ($self->{fieldtype} eq 'B0') { # boolean, defaults to false - $match = 0; # nonexistent field treated as 0 - do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=$match"); - } elsif ($self->{fieldtype} eq 'B1') { # defaults to true - $match = 1; # nonexistent field treated as 1 - do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=$match"); - } elsif ($self->{fieldtype}=~/^.-$/) { # expected to not exist - do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=undef"); - } else { # treated as 'no match', issue a warning - do_log(1, "lookup_sql_field($field) ". - "(WARNING: no such field in the SQL table), ". - "\"$addr\" matches, result=undef"); + ($hdr_edits, \@recip_cluster, $done_all); } - } else { - # fieldtype: B=boolean, N=numeric, S=string, - $match = $h_ref->{$field}; my($found) = defined $match; - if (!defined($match)) { # keep undef for NULL field values - } elsif ($self->{fieldtype} =~ /^B/) { # boolean - # convert values 'N', 'F', '0', ' ' and "\000" to 0 - # to allow value to be used directly as a Perl boolean - $match = 0 if $match =~ /^[NnFf0 \000][ ]*$(?!\n)/; - } elsif ($self->{fieldtype} =~ /^N/) { # numeric - $match = $match + 0; # unify different numeric forms - } elsif ($self->{fieldtype} =~ /^S/) { # string - $match =~ s/ +$(?!\n)//; # trim trailing spaces + +sub do_quarantine($$$$$) { + my($conn,$msginfo,$hdr_edits,$recips_ref,$quarantine_method) = @_; + + # NOTE: RFC2821 mentions possible headers X-SMTP-MAIL and X-SMTP-RCPT + # Exim uses: Envelope-To, Sendmail uses X-Envelope-To + $hdr_edits->prepend_header('X-Envelope-To', # or: X-Quarantined-To + join(",\n ",qquote_rfc2821_local(@{$msginfo->recips})), 1); + + # Return path will be in Return-Path, no need for extra header +# $hdr_edits->prepend_header('X-SMTP-MAIL', # or: X-Quarantined-From +# qquote_rfc2821_local($msginfo->sender)); + + # ignore status, possible problems were already logged or exception thrown + my($quar_msg) = Amavis::In::Message->new; + $quar_msg->sender($mailfrom_to_quarantine ne '' ? + $mailfrom_to_quarantine : $msginfo->sender); + do_log(5, "DO_QUARANTINE, sender: ".$quar_msg->sender); + $quar_msg->recips($quarantine_method =~ /^bsmtp:/i + ? $msginfo->recips # original message recipients, bsmtp: + : $recips_ref); # e.g. per-recip domain quarantine + $quar_msg->header_edits($hdr_edits); + + $quar_msg->mail_text($msginfo->mail_text); + + # fudge to get to the body_digest of $msginfo, not of $quar_msg + $quarantine_method =~ s/%b/$msginfo->body_digest/eg; + mail_dispatch($quarantine_method,$quar_msg,1); + + my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = + one_response_for_all($quar_msg,0); # check status + if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) { + # abort if quarantining not successful + die "Can not quarantine: '$n_smtp_resp'"; } - do_log(5, "lookup_sql_field($field) \"$addr\"" . - (!$found ? ", no match" : " matches, result=$match") ); + my(@qa); # list of quarantine mailboxes or addresses + for my $r (@{$quar_msg->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } + my($addr) = $r->recip_final_addr; + push(@qa, $addr=~/\@/ ? $addr : $r->recip_mbxname); } + $msginfo->quarantined_to(\@qa); + do_log(5, "DO_QUARANTINE done"); } + +# If virus found - quarantine it and send notifications +sub do_virus($$) { + my($conn,$msginfo) = @_; + my $virus_name = ''; + if(@virusname) { + $REASON_ID = 1; + $ACTION_ID = 2; + $virus_name = join(",",@virusname); + $REASON_EXTRA = $virus_name; + } + elsif(@banned_filename) { + $REASON_ID = 2; + $ACTION_ID = 2; + $virus_name = join(",",@banned_filename); + $REASON_EXTRA = $virus_name; } - $match; + elsif(@quarantined_filename) { + # We do the quarantine stuff later on in the per-user/no-per-user quarantine section } -1; + # suggest a name to be used as 'X-Quarantine-id:' or file name + my($taint) = substr($virus_quarantine_method,0,0); + $VIRUSFILE = $virus_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si + ? $1.$taint : "virus-%i-%n"; + $VIRUSFILE =~ s/%b/$msginfo->body_digest/eg; + $VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; + $VIRUSFILE =~ s/%n/am_id()/eg; + my($hdr_edits) = Amavis::Out::EditHeader->new; + $hdr_edits->prepend_header('X-Barracuda-Quarantine-id', "<$VIRUSFILE>"); + $hdr_edits->append_header('X-Barracuda-Virus-Alert', + "INFECTED, message contains virus:\n " . + join(",\n ",@virusname), 1) if @virusname; + my(@q_addr); # obtain per-recipient quarantine address(es) + do_log(5, "do_virus: looking for per-recipient quarantine") + if ref($virus_quarantine_to) ne ''; + for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } + my($a) = lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $virus_quarantine_to); + push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr; + } + #do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr, + # $virus_quarantine_method) if @q_addr; -# -package Amavis::Lookup::SQL; -use strict; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - $VERSION = '1.15'; - @ISA = qw(Exporter); + # joe 5-4-06 BRTS b6503 skip bounce if desired + if ($msginfo->dsn_sent) { + do_log(2,"BRTS: skipping sender/recip notify of virus"); + return; } -use DBI; + do_log(5, "DO_VIRUS - NOTIFICATIONS, sender: ".$msginfo->sender); + $hdr_edits = Amavis::Out::EditHeader->new; -BEGIN { - import Amavis::Util qw(do_log); - import Amavis::Conf qw(:platform :confvars); - import Amavis::Timing qw(section_time); - import Amavis::rfc2821_2822_Tools qw(split_address split_localpart); -} +# my($notify_virus_admin_only_if_sender_is_local) = 0; -use vars qw($sql_connected); + # try to find a per-sender administrator + my($admin) = lookup($msginfo->sender, \%virus_admin,$virus_admin,$mailto); + #ZL if (!$warnvirussender || $admin eq '') { + if ($admin eq '') { + do_log(4, "Skip virus_admin notification for <".$msginfo->sender. + ">, no admin specified"); +# } elsif ($notify_virus_admin_only_if_sender_is_local && +# lookup($msginfo->sender, $local_domains_sql, $local_domains_ldap, +# \%local_domains, \@local_domains_acl, $local_domains_re)) { +# do_log(2, "Skip virus_admin notification for <".$msginfo->sender. +# ">, non-local sender"); + } elsif( @virusname ) { # notify virus admin -# 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); - do_log(3,"Connecting to SQL database server"); - for my $tmpdsn (@dsns) { - my($dsn, $username, $password) = @$tmpdsn; - do_log(4, "connect_to_sql: trying '$dsn'"); - $dbh = DBI->connect($dsn, $username, $password, - {PrintError => 0, RaiseError => 0, Taint => 1} ); - if ($dbh) { do_log(3,"connect_to_sql: '$dsn' succeeded"); last } - do_log(0, "connect_to_sql: unable to connect to DSN '$dsn': " . - $DBI::errstr); - } - do_log(0, "connect_to_sql: unable to connect to any DSN at all!" - ) if !$dbh && @dsns>1; - $sql_connected = 1 if $dbh; - $dbh; -} + my @admin_list = (split (',\s*', $virus_admin) ); -# return a new Lookup::SQL object to contain DBI handle and prepared selects -sub new { - my($class) = @_; bless {}, $class; + my($notification) = Amavis::In::Message->new; + $notification->sender($mailfrom_notify_admin); + $notification->recips([@admin_list]); + my(%mybuiltins) = %builtins; # make a local copy + $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; # used in 'To:' + $mybuiltins{'f'} = $hdrfrom_notify_admin; + $notification->mail_text(string_to_mime_entity( + expand(\$notify_virus_admin_templ,\%mybuiltins) )); + $notification->header_edits($hdr_edits); + mail_dispatch($notify_method,$notification,1); + my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = + one_response_for_all($notification,0); # check status + if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) + { do_log(0, "FAILED to notify virus admin: $n_smtp_resp") } + # $notification->purge; } -# store DBI handle and prepared selects into existing Lookup::SQL obj -sub store_dbh($$$) { - my($self, $dbh, $select_clause) = @_; - $self->{dbh} = $dbh; # save DBI handle - for my $n (1..6) { # prepare select statements with different no. of args - my($sel) = $select_clause; $sel =~ s/%k/join(',',('?')x$n)/ge; - do_log(5,"SQL prepare: ".$sel); - $self->{"sth$n"} = $dbh->prepare($sel); + if (! ($warnvirusrecip && @virusname || + $warnbannedrecip && @banned_filename) ) { + # warn_recip() normally disabled - it is usually counterproductive + # Enable only if you know what you are doing! +# } elsif (! defined($msginfo->sender_contact) ) { +# do_log(5,"do_virus: skip recipient notifications for unknown senders"); + } else { + my(@locals) = grep { $warn_offsite || + lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, $local_domains_sql, + $local_domains_ldap, \%local_domains, + \@local_domains_acl, $local_domains_re) + } @{$msginfo->recips}; + if (@locals) { + my($notification) = Amavis::In::Message->new; + $notification->sender($mailfrom_notify_recip); + $notification->recips(\@locals); + my(%mybuiltins) = %builtins; # make a local copy + $mybuiltins{'f'} = $hdrfrom_notify_admin; + if (@banned_filename){ + $notification->mail_text(string_to_mime_entity( + expand(\$notify_banned_recips_templ,\%mybuiltins) )); } - $self->clear_cache; # let's start afresh just in case - $self; + elsif (@virusname){ + $notification->mail_text(string_to_mime_entity( + expand(\$notify_virus_recips_templ,\%mybuiltins) )); } - -sub clear_cache { - my($self) = @_; - delete $self->{cache}; + $notification->header_edits($hdr_edits); + mail_dispatch($notify_method,$notification,1); + my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = + one_response_for_all($notification,0); # check status + if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) + { do_log(0, "FAILED to notify virus recipients: $n_smtp_resp")} + # $notification->purge; + } + } + do_log(5, "DO_VIRUS - DONE"); } -# 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 -# the order is unspecified, which is only useful if just specific entries -# exist in a database (full address, not domain part or mailbox part only). -# -# The following order is recommended, going from specific to more general: -# - lookup for user+foo@example.com -# - lookup for user@example.com (only if $recipient_delimiter nonempty) -# - lookup for user+foo ('naked lookup': only if local) -# - lookup for user ('naked lookup': local and $recipient_delimiter nonempty) -# - lookup for @example.com -# - lookup for @. (catchall) -# NOTE: -# this is different from hash and ACL lookups in three important aspects: -# - subdomains are not looked at, only full domain names are matched; -# - naked key (without '@') implies mailbox (=user) name, not domain name; -# - the naked mailbox name lookups are only performed when the e-mail -# address (usually its domain part) matches the local_domains* lookups. -# -# The domain part is always lowercased when constructing a key, -# the localpart is not lowercased when $localpart_is_case_sensitive is true. + # +# If Spam found - quarantine it and log report +sub do_spam($$) { + my($conn,$msginfo) = @_; -sub lookup_sql($$;$) { - my($self,$addr,$extra_args) = @_; - if (!defined $extra_args && - 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, sprintf("lookup_sql (cached): \"%s\" matches, result=(%s)", $addr, - join(", ", map {sprintf("%s=>%s", $_, - !defined($match->{$_})?'-':'"'.$match->{$_}.'"') - } sort keys(%$match) ) )); + # suggest a name to be used as 'X-Quarantine-id:' or file name + my($taint) = substr($spam_quarantine_method,0,0); + $VIRUSFILE = $spam_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si + ? $1.$taint : "spam-%b-%i-%n"; + $VIRUSFILE =~ s/%b/$msginfo->body_digest/eg; + $VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg; + $VIRUSFILE =~ s/%n/am_id()/eg; + + do_log(5, "do_spam: looking for a quarantine address"); + my(@q_addr); # quarantine address(es) + if ($spam_quarantine_bysender_to) { # by-sender quarantine + my($a) = lookup($msginfo->sender, $spam_quarantine_bysender_to); + push(@q_addr, $a) if $a ne ''; } - return $match; + for my $r (@{$msginfo->per_recip_data}) { # per-recipient quarantine + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } + my($a) = lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip, $spam_quarantine_to_sql, + $spam_quarantine_to_ldap, $spam_quarantine_to); + push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr; } - if (!$sql_connected) { - my($sql_dbh) = connect_to_sql(@lookup_sql_dsn); - section_time('sql-connect'); - defined($sql_dbh) or die "SQL server(s) not reachable"; - $sql_dbh->{'RaiseError'} = 1; - $Amavis::sql_policy->store_dbh($sql_dbh, $sql_select_policy) - if defined $sql_select_policy; - $Amavis::sql_wblist->store_dbh($sql_dbh, $sql_select_white_black_list) - if defined $sql_select_white_black_list; + if (@q_addr) { # try to quarantine it + my($hdr_edits) = Amavis::Out::EditHeader->new; + $hdr_edits->prepend_header('X-Barracuda-Quarantine-id', "<$VIRUSFILE>"); + do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr, + $spam_quarantine_method); } - my($taint) = substr($addr,0,0); - 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.$taint if $domain =~ /^\@?(.*?)\.*$(?!\n)/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_acl,$local_domains_re)) { - # NOTE: $local_domains_sql is not looked up to avoid recursion, - # only static local_domain* lookup tables are used ! - push(@keys, $localpart.$recipient_delimiter.$extension) - if $extension ne ''; # user+foo - push(@keys, $localpart); # user - } - push(@keys, '@'.$domain); # @example.com - push(@keys, '@.'); # @. (catchall) - my($n) = sprintf("%d",scalar(@keys)); - my($sth) = $self->{"sth$n"}; - unshift(@keys,@$extra_args) if ref $extra_args; # prepend extra arguments - local($1); - for (@keys) { $_=$1 if /^(.*)$(?!\n)/s } # untaint keys - do_log(5, "lookup_sql \"$addr\", query keys: " . - join(', ', map{"\"$_\""}@keys) ); - my($a_ref,$found,$match); $match = {}; - eval { - $sth->execute(@keys); - while ( defined($a_ref=$sth->fetchrow_arrayref) ) { # fetch query results - my(@names) = @{$sth->{NAME_lc}}; - $found = 1; $match = {}; @$match{@names} = @$a_ref; - if (!exists $match->{'local'} && $match->{'email'} eq '@.') { - # UGLY HACK to let a catchall (@.) imply that field 'local' has - # a value undef (NULL) when that field is not present in the - # database. This overrides B1 fieldtype default by an explicit - # undef for '@.', causing a fallback to static lookup tables. - # The purpose is to provide a useful defaults for local_domains - # SQL lookup if the field 'local' is not present in the table. - # NOTE: field names 'local' and 'email' are hardwired here! - push(@names,'local'); $match->{'local'} = undef; - do_log(5, "lookup_sql: \"$addr\" matches catchall, local=>undef"); - } - do_log(5, sprintf("lookup_sql: \"%s\" matches, result=(%s)", $addr, - join(", ", map {sprintf("%s=>%s", $_, - !defined($match->{$_})?'-':'"'.$match->{$_}.'"') - } @names) )); - last if $found; # first match wins, loop is for possible future use - } - $sth->finish(); - }; # eval - if ($@ ne '') { - my($err) = $@; - do_log(0, "lookup_sql: $DBI::err, $DBI::errstr"); - if ($sth && ($sth->err eq '2006' || # MySQL server has gone away - $sth->errstr =~ /\bserver has gone away\b/ || - $sth->err eq '2013' || - $sth->errstr =~ /\bLost connection to\b/)) { - do_log(0,"NOTICE: Disconnected from SQL server"); - $sql_connected = 0; $self->{dbh}->disconnect; - } - die $err; - } - if (!$found) { - $match = undef; - do_log(5, "lookup_sql, \"$addr\" no match"); + do_log(1, sprintf("DO_SPAM, <%s> -> %s, %s", $msginfo->sender_source, + join(',', map{"<$_>"} @{$msginfo->recips}), + !@q_addr ? '' : sprintf(", quarantine %s (%s)", + $VIRUSFILE, join(',',@q_addr)))); + # try to find a per-sender administrator + my($admin) = lookup($msginfo->sender, \%spam_admin,$spam_admin,$mailto); + if ($admin eq '') { + do_log(4, "Skip spam_admin notification for <".$msginfo->sender. + ">, no admin specified"); + } else { # Notify admin + do_log(5, "DO_SPAM - NOTIFICATIONS, sender: ".$msginfo->sender); + my($notification) = Amavis::In::Message->new; + $notification->sender($mailfrom_notify_spamadmin); + $notification->recips([$admin]); + my(%mybuiltins) = %builtins; # make a local copy + $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; # used in 'To:' + $mybuiltins{'f'} = $hdrfrom_notify_spamadmin; + $notification->mail_text(string_to_mime_entity( + expand(\$notify_spam_admin_templ,\%mybuiltins) )); + my($hdr_edits) = Amavis::Out::EditHeader->new; + $notification->header_edits($hdr_edits); + mail_dispatch($notify_method,$notification,1); + my($n_smtp_resp, $n_exit_code, $n_dsn_needed) = + one_response_for_all($notification,0); # check status + if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) + { do_log(0, "FAILED to notify spam admin: $n_smtp_resp") } + # $notification->purge; } - # save for future use, but only within processing of this message - $self->{cache}->{$addr} = $match; - section_time('lookup_sql'); - $match; + do_log(5, "DO_SPAM DONE"); } -1; - -__DATA__ -#^L -package Amavis::Lookup::LDAP; -# by Jacques Supcik, PhD -# IP-Plus Internet Services - Swisscom Enterprise Solutions Ltd -# Genfergasse 14, 3050 Bern, Switzerland (http://www.ip-plus.net/) -# March 2003 +# Calculate message digest; +# While at it, also get the message size and store original header, +# since we need it for the %H macro, and MIME::Tools may modify it. -use strict; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION - $ldap_sys_default %ldap_cache); - @ISA = qw(Exporter); - $VERSION = '1.15'; +sub get_body_digest($$) { + my($fh,$msginfo) = @_; + $fh->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; + local($_); - import Amavis::Util qw(do_log); - import Amavis::Conf qw(:platform :confvars); - import Amavis::Timing qw(section_time); - import Amavis::rfc2821_2822_Tools qw(split_address split_localpart); + my(@orig_header); my($header_size) = 0; my($body_size) = 0; + while (<$fh>) { # skip mail header + last if $_ eq $eol; + $header_size += length($_); push(@orig_header,$_); # with trailing EOL + } + my($signature) = int(rand(2147483648)); - $ldap_sys_default = { - hostname => 'localhost', port => 389, timeout => 120, tls => 0, - base => undef, scope => 'sub', - query_filter => '(&(objectClass=amavisAccount)(mail=%m))', - res_attr => undef, res_filter => '%r', - bind_dn => undef, bind_password => undef - }; - %ldap_cache = (); + if ($signature =~ /^( [0-9a-fA-F]{32} (?: [0-9a-fA-F]{8} )? ) $(?!\n)/x) { + $signature = $1; # checked (either 32 or 40 char), untaint } + # store information obtained + $msginfo->orig_header(\@orig_header); + $msginfo->orig_header_size($header_size); + $msginfo->orig_body_size($body_size); + $msginfo->body_digest($signature); -sub trim { - my $str = shift; - $str =~ s/\s+$(?!\n)//; $str =~ s/^\s+//; - $str; + section_time('body hash'); + do_log(3, "body hash: $signature"); + $signature; } -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my ($default, $query) = @_; - my ($self) = bless {}, $class; - my $llog = sub { - my $level = shift; - my $template = shift; - my $prefix = __PACKAGE__."::new (res_attr->".$query->{res_attr}.")"; - do_log($level, sprintf("$prefix - $template", @_)); - }; - # Replace undefined attributes by defaults - foreach (qw(hostname port timeout tls base scope query_filter - res_attr res_filter bind_dn bind_password)) { - $query->{$_} = $default->{$_} unless (defined $query->{$_}); - $query->{$_} = $ldap_sys_default->{$_} unless (defined $query->{$_}); +sub find_program_path($$$) { + my($fv_list, $path_list_ref, $may_log) = @_; + $fv_list = [$fv_list] if !ref $fv_list; + my($found) = undef; + for my $fv (@$fv_list) { + my(@fv_cmd) = split(' ',$fv); + if (!@fv_cmd) { # empty, not available + } elsif ($fv_cmd[0] =~ /^\//) { # absolute path + my($errn) = stat($fv_cmd[0]) ? 0 : 0+$!; + if ($errn == ENOENT) {} + elsif ($errn) { do_log(0, "find_program_path: ". + "$fv_cmd[0] inaccessible: $!") if $may_log } + elsif (-x _ && !-d _) { $found = join(' ',@fv_cmd) } + } elsif ($fv_cmd[0] =~ /\//) { # relative path + die "find_program_path: relative paths not implemented: @fv_cmd\n"; + } else { # walk through the specified PATH + for my $p (@$path_list_ref) { + my($errn) = stat("$p/$fv_cmd[0]") ? 0 : 0+$!; + if ($errn == ENOENT) {} + elsif ($errn) { do_log(0, "find_program_path: ". + "$p/$fv_cmd[0] inaccessible: $!") if $may_log } + elsif (-x _ && !-d _) { + $found = $p . '/' . join(' ',@fv_cmd); + last; } - my $ldap; - my $hostList = (ref $query->{hostname} eq 'ARRAY') ? - join ", ", @{$query->{hostname}} : $query->{hostname}; - my $cache_key = join "\036", ($hostList, $query->{port}, - $query->{timeout}, $query->{tls}, - $query->{bind_dn}, $query->{bind_password}); - if (exists $ldap_cache{$cache_key}) { - $llog->(5, "Fetching ldap connection from cache"); - $ldap = $ldap_cache{$cache_key}; - } else { - $llog->(5, "trying to connect to '%s'", $hostList); - $ldap = Net::LDAP->new($query->{hostname}, port=>$query->{port}, - timeout=>$query->{timeout}, onerror=>'undef'); - if ($ldap) { - $llog->(5, "connection to '%s' succeeded", $hostList); - } else { - $llog->(0, "unable to connect to host '%s'. LDAP lookups disabled.", - $hostList); - return undef; } - if ($query->{tls}) { # TLS required - my $tlsVer = $ldap->start_tls(verify=>'none'); - $llog->(5, "TLS version %s enabled", $tlsVer); } - if ($query->{bind_dn}) { # Binding required - if ($ldap->bind ($query->{bind_dn}, password => $query->{bind_password})) { - $llog->(5, "bind '%s' succeeded", $query->{bind_dn}); - } else { - $llog->(1, "unable to bind '%s'",$query->{bind_dn}); - return undef; + last if defined $found; } + $found; } - $ldap_cache{$cache_key} = $ldap; + +sub find_external_programs($) { + my($path_list_ref) = @_; + for my $f (qw($file $arc $gzip $bzip2 $lha $unarj $uncompress $unrar $zoo)) { + my($g) = $f; $g =~ s/\$/Amavis::Conf::/; + my($fv_list) = eval('$'.$g); + my($found) = find_program_path($fv_list,$path_list_ref,1); + { no strict 'refs'; $$g = $found } # NOTE: a symbolic reference + if (!defined $found) { + do_log(0, sprintf("No %-14s not using it", "$f,")); + } else { + do_log(0, sprintf("Found %-11s at %s%s", $f, + $daemon_chroot_dir ne '' ?"(chroot: $daemon_chroot_dir/) " :'', + $found)); } - $self->{ldap} = $ldap; - foreach (qw(base scope query_filter res_attr res_filter)) { - $self->{$_} = $query->{$_}; } - if ($query->{res_attr} eq "dn") { - $self->{type} = "S" # String + # map program name hints to full paths + my($tier) = 'primary'; # primary, secondary, ... av scanners + for my $f (@av_scanners, "\000", @av_scanners_backup) { + if ($f eq "\000") { + $tier = 'secondary'; + } elsif (!defined $f || !ref $f) { # empty, skip + } elsif (ref($f->[1]) eq 'CODE') { + do_log(0, "Using internal av scanner code for ($tier) ".$f->[0]); } else { - my $schema = $ldap->schema(); # Lookup schema - if ($schema) { - my $sa = $schema->attribute($query->{res_attr}); - if ($sa and $sa->{equality} eq 'booleanMatch' and $sa->{'single-value'}) { - $self->{type} = "B" # Boolean - } elsif ($sa and $sa->{equality} eq 'integerMatch' and - $sa->{'single-value'}) { - $self->{type} = "N" # Number - } elsif ($sa and not $sa->{'single-value'}) { - $self->{type} = "L" # List - } elsif ($sa) { - $self->{type} = "S" # String + my($found) = $f->[1] = find_program_path($f->[1],$path_list_ref,1); + if (!defined $found) { + do_log(3, "No $tier av scanner: ".$f->[0]); + $f = undef; # release its storage } else { - $llog->(1, "attribute not defined in schema"); - $self->{type} = "S" # attribute not defined, default String + do_log(0, sprintf("Found $tier av scanner %-11s at %s%s", + $f->[0], + $daemon_chroot_dir ne '' ? "(chroot: $daemon_chroot_dir/) " + : '', + $found)); } - } else { - $llog->(1, "unable to read LDAP schema"); - $self->{type} = "S" # If no schema is defined, default String } } - $llog->(5, "type='%s'",$self->{type}); - return $self; } -sub lookup_ldap_exact { - my $self = shift; - my ($addr) = @_; - my $llog = sub { - my $level = shift; - my $template = shift; - my $prefix = __PACKAGE__."::lookup_ldap_exact ($addr)"; - do_log($level, sprintf("$prefix - $template", @_)); - }; - unless (defined $self) { - $llog->(5, "object undefined, no match"); - return undef; - } - unless (defined $self->{ldap}) { - $llog->(5, "null ldap object, no match"); - return undef; - } +# Fetch all remaining modules. +sub fetch_modules_extra() { + my(@modules); + push(@modules, 'DBI') if $extra_code_sql; + push(@modules, 'Net::LDAP') if $extra_code_ldap; + push(@modules, qw(Compress::Zlib Convert::TNEF Convert::UUlib + Archive::Zip Archive::Tar)) unless $bypass_decode_parts; + if ($extra_code_antispam) { + push(@modules, qw(Mail::SpamAssassin Mail::SpamAssassin::NoMailAudit)); + push(@modules, qw(Mail::SpamAssassin::DBBasedAddrList) + ) if $sa_auto_whitelist; + } + Amavis::Boot::fetch_modules('REQUIRED ADDITIONAL MODULES', @modules); + if ($extra_code_antispam) { eval { + # seems like the following one did not exist before SA 2.50 : + require Mail::SpamAssassin::UnixLocker; + require Mail::SpamAssassin::PerMsgLearner; + } } + # load optional module SAVI if available and desired + if ($extra_code_antivirus) { + my($savi_module_ok,$savi); my($first) = 1; + for (grep {ref($_) eq 'ARRAY' && $_->[0] eq 'Sophos SAVI'} + (@av_scanners, @av_scanners_backup) + ) { + if ($first) { + $savi_module_ok = eval {require SAVI}; + +# comment out the following line in order to make SAVI-Perl initialize +# every time a child processs is born (instead of only once at startup time): + $savi = Amavis::AV::sophos_savi_init(@$_) if $savi_module_ok; + + } + $_->[1] = undef if !$savi_module_ok; + $_->[2] = $savi if defined $savi; + $first = 0; + } + } +} + +# +# Main program starts here +# + +# Read dynamic source code, and logging and notification message templates +# at the end of the Amavis package +# +if ($unicode_aware) { + # binmode(\*Amavis::DATA, ":utf8") or die "Can't set \*DATA to utf8: $!"; + # or use: ":encoding(iso-8859-1)" +} +do{ local($/) = "__DATA__$eol"; # set line terminator to this string + map { chomp($_ = ) } + ($extra_code_sql, $extra_code_ldap, + $extra_code_in_amcl, $extra_code_in_smtp, + $extra_code_antivirus, $extra_code_antispam, + $log_templ, + $notify_sender_templ, + $notify_virus_sender_templ, + $notify_virus_admin_templ, + $notify_virus_recips_templ, + $notify_spam_sender_templ, + $notify_spam_admin_templ); +}; # restore line terminator +close(\*Amavis::DATA) or "Can't close *Amavis::DATA: $!"; + +# discarding leading NL inserted by 'configure' +map { s/^\r?\n// } ($log_templ, $notify_sender_templ, + $notify_virus_sender_templ, $notify_spam_sender_templ, + $notify_virus_admin_templ, $notify_spam_admin_templ, + $notify_virus_recips_templ, $notify_spam_recips_templ); +$log_templ = $1 if $log_templ =~ /^(.*?)[\r\n]+$(?!\n)/s; # discard trailing NL + +# Be paranoid +umask(0027); + +# try to find absolute path name of oneself +my($amavisd_path) = find_program_path($0, [split(/:/, $path, -1)], 0); +$amavisd_path = $1 if $amavisd_path=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)}; # untaint + +my($config_file) = '/etc/amavisd.conf'; # default location of config file +if (@ARGV >= 2 && $ARGV[0] eq '-c') { # override by command line option -c + shift @ARGV; $config_file = shift @ARGV; + $config_file = $1 if $config_file=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)};# untaint +} +# Read config file, which may override default settings +Amavis::Conf::read_config($config_file); + +# Master configuration +my(@modules_basic) = keys %INC; + +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 (!$enable_ldap) { $extra_code_ldap = undef } +else { + eval $extra_code_ldap or die "Problem in the Lookup::LDAP code: $@"; + $extra_code_ldap = 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: $@"; + $extra_code_in_amcl = 1; # release memory occupied by the source code +} +if ($inet_socket_port eq '' || ref $inet_socket_port && !@$inet_socket_port) { + $extra_code_in_smtp = undef; +} else { + eval $extra_code_in_smtp or die "Problem in the In::SMTP code: $@"; + $extra_code_in_smtp = 1; # release memory occupied by the source code +} + +if (!@av_scanners && !@av_scanners_backup) { + $extra_code_antivirus = undef; +} 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 (!%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: $@"; + $extra_code_antispam = 1; # release memory occupied by the source code +} + +my($cmd) = lc($ARGV[0]); +if ($cmd =~ /^(start|debug|debug-sa|foreground)?$/) { + $DEBUG=1 if $cmd eq 'debug'; + $daemonize=0 if $cmd eq 'foreground'; + $daemonize=0, $sa_debug=1 if $cmd eq 'debug-sa'; +} elsif ($cmd !~ /^reload|stop$/) { + die "Unknown argument. Usage:\n $0 [ -c config-file ] ( [ start ] | stop | reload | debug | debug-sa | foreground )\n"; +} else { + if ($pid_file eq '') + { die "pid_file config parameter not defined, can't $cmd\n" } + my($errn) = stat($pid_file) ? 0 : 0+$!; + if ($errn == ENOENT) + { die "No pid_file $pid_file, can't $cmd the process\n" } + elsif ($errn) + { die "pid_file $pid_file inaccessible: $!, can't $cmd the process\n" } + my($amavisd_pid); + open(PID_FILE, "< $pid_file\0") or die "Can't read file $pid_file: $!\n"; + while () { chomp; $amavisd_pid = $1 if /^(\d+)$/ } + close(PID_FILE) or die "Can't close file $pid_file: $!"; + defined($amavisd_pid) or die "Invalid PID in the $pid_file, can't $cmd\n"; + my($sig) = $cmd eq 'reload' ? 'HUP' : 'TERM'; + kill($sig,$amavisd_pid) or die "Can't $sig amavisd[$amavisd_pid]: $!\n"; + exit 0; +} +$daemonize = 0 if $DEBUG; + +# Set path, home and term explictly. Don't trust environment +$ENV{PATH} = $path if $path ne ''; +$ENV{HOME} = $helpers_home if $helpers_home ne ''; +$ENV{TERM} = 'dumb'; + +Amavis::Log::init("scan", !$daemonize, + $DO_SYSLOG, $SYSLOG_LEVEL, $DO_SYSLOG_STATS, $SYSLOG_STATS_LEVEL, $DO_SYSLOG_DEBUG, $SYSLOG_DEBUG_LEVEL, $LOGFILE, $log_level); + +# $SIG{USR2} = sub { +# my($msg) = Carp::longmess("SIG$_[0] received, backtrace:"); +# print STDERR "\n",$msg,"\n"; do_log(0,$msg); +# }; + +fetch_modules_extra(); # bring additional modules into memory and compile them + +# my(@modules_extra); +# for my $m (keys %INC) +# { push(@modules_extra, $m) if !grep {$_ eq $m} @modules_basic } +# do_log(0, "modules loaded: " .join(", ", sort @modules_basic)); +# do_log(0, "extra modules loaded: ".join(", ", sort @modules_extra)); + +for my $m ('Amavis::Conf', + sort map { s/\.pm$//; s[/][::]g; $_ } grep { /\.pm$/ } keys %INC) { + next if !grep { $_ eq $m } qw( Amavis::Conf + Archive::Tar Archive::Zip Compress::Zlib Convert::TNEF Convert::UUlib + MIME::Entity MIME::Parser MIME::Tools Mail::Header Mail::Internet + Mail::SpamAssassin Net::DNS Net::Server SAVI Unix::Syslog ); + do_log(0, sprintf("Module %-19s %s", $m, $m->VERSION || '?')); +} + +if ($forward_method eq '' && $extra_code_in_smtp) { + do_log(1, "forward_method is null (probably milter setup), ". + "DISABLING SMTP-in AS A PRECAUTION"); + $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, "Lookup::LDAP code ".($extra_code_ldap ?'':" 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"); +do_log(1, "ANTI-SPAM code ".($extra_code_antispam?'':" NOT")." loaded"); + +# release storage +if (!$extra_code_antivirus) { @av_scanners = @av_scanners_backup = () } + +# Prepare a hash of macros to be used in notification message expansion. +# A key (macro name) must be a single character. Most characters are +# allowed, but to be on the safe side and for clarity it is suggested +# that only letters are used. Upper case letters may (as a mnemonic) +# suggest the value is an array, lower case may suggest the value is +# a scalar string - but this is only a convention and not enforced. +# +# A value may be a reference to a subroutine which will be called later at +# the time of macro expansion. This way we can provide a method for obtaining +# information which is not yet available, such as AV scanner results, +# or provide a lazy evaluation for more expensive calculations. +# Subroutine will be called in scalar context with no arguments. +# It may return a scalar string (or undef), or an array reference. + +# joe 5-24-06 b5663 builtins{'r'} and builtins{'e'} are used for NDR reason + +%builtins = ( + d => sub {rfc2822_timestamp()}, # provide RFC 2822 date-time (current time) + h => $myhostname, # dns name of this host, or configurable name + l => sub {lookup($MSGINFO->sender, $local_domains_sql, + $local_domains_ldap, \%local_domains, + \@local_domains_acl, $local_domains_re) + ? 1 : undef}, # sender is local + s => sub {qquote_rfc2821_local($MSGINFO->sender)}, # original envelope sender in <> + S => sub {$MSGINFO->sender_contact}, # unmangled sender / sender address to be notified + o => sub {$MSGINFO->sender_source}, # best attempt at determining + # true sender (origin) of the virus + # - normally the same as %s + R => sub {$MSGINFO->recips},# original message recipients list + 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 { 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; eval{$_=Encode::decode('MIME-Header', $_);}; $_} }, + b => sub {$MSGINFO->body_digest}, # original message body digest + n => \&am_id, # amavis internal message id (for log entries) + i => sub {$VIRUSFILE}, # some quarantine id, e.g. quarantine filename + 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 + X => sub {\@bad_headers}, # list of header syntax violations + W => sub {\@detecting_scanners}, # list of av scanners detecting a virus + H => sub {[map {my $h=$_; $h= '' if ($h=~/X-Barracuda/); $h} @{$MSGINFO->orig_header}]},# orig hdr + A => sub {[split(/\r?\n/, $spam_report)]}, # SpamAssassin report lines + c => sub {!defined $spam_level?'-':$spam_level}, # SpamAssassin hits/score + # macros f, T, C, B will be defined by each warn_* as appropriate + # (representing From:, To:, Cc:, and Bcc: respectively) +); + +# Map local virtual username to a mailbox (e.g. to a quarantine filename +# or a directory). Used by mail_to_local_mailbox(), e.g. for direct +# local quarantining. The hash value may be a ref to a pair of fixed +# strings, or a subroutine ref (which must return a pair of strings +# (a list, not a list ref)) which makes possible lazy evaluation +# when some part of the pair is not known before the final delivery time. +# +# The first string in a pair must be either: +# - empty or undef, which will disable saving the message, +# - a filename, indicating a Unix-style mailbox, +# - a directory name, indicating a maildir-style mailbox, +# in which case the second string may provide a suggested file name. +# +%local_delivery_aliases = ( + 'barracuda' => sub { ("/mail/mstore", undef) }, + 'virus-quarantine' => sub { ($QUARANTINEDIR, $VIRUSFILE) }, + 'spam-quarantine' => sub { ($QUARANTINEDIR, "$VIRUSFILE.gz") }, + 'user-quarantine' => # just an example + sub { my($s) = $MSGINFO->sender; + $s =~ s/[^a-zA-Z0-9._=@]/-/; $s =~ s/\@/=/; + ( $QUARANTINEDIR, + sprintf("user-%s-%s-%05d.gz", # suggested file name + $s, strftime("%Y%m%d-%H%M%S",localtime), $$) ) + }, + 'ham-quarantine' => # another example + sub { ("$QUARANTINEDIR/ham.mbox", undef) }, + 'outgoing-quarantine' => # another example + sub { ("$QUARANTINEDIR/outgoing.mbox", undef) }, + 'incoming-quarantine' => # another example + sub { ("$QUARANTINEDIR/incoming.mbox", undef) }, + 'recips-quarantine' => + sub { my($r) = join("-",@{$MSGINFO->recips}); + $r =~ s/\W//g; +do_log(0, "params: ".join(',', @_)); +$VIRUSFILE = "$VIRUSFILE$r"; +if ($VIRUSFILE =~ /^([-\w.]+)$/) { + $VIRUSFILE = $1; +} +# ( $QUARANTINEDIR, +# sprintf("recip-%s-%s-%05d", +# $r, strftime("%Y%m%d-%H%M%S",localtime), $$) ) +($QUARANTINEDIR, $VIRUSFILE) + }, +); + +# set up Net::Server configuration +my $server = bless { + server => { + # command line arguments to be used after HUP must be untainted + commandline => [$amavisd_path, '-c', $config_file], # deflt: [$0,@ARGV] + + # listen on the following sockets (one or more): + port => [ ($unix_socketname eq '' ? () : + "$unix_socketname|unix"), # traditional amavis client + map { "$_/tcp" } # accept SMTP on this port(s) + (ref $inet_socket_port ? @$inet_socket_port : + $inet_socket_port ne '' ? $inet_socket_port : () ), + ], + # limit socket bind (e.g. to the loopback interface) + host => ($inet_socket_bind eq '' ? '*' : $inet_socket_bind), + + max_servers => $max_servers, # number of pre-forked children + max_requests => $max_requests, # restart child after that many accept's + + user => $daemon_user, + group => $daemon_group, + pid_file => $pid_file, + lock_file => $lock_file, # serialization lockfile + # serialize => 'flock', # flock, semaphore, pipe + background => $daemonize ? 1 : undef, + setsid => $daemonize ? 1 : undef, + chroot => $daemon_chroot_dir ne '' ? $daemon_chroot_dir : undef, + no_close_by_child => 1, + + # controls log level for Net::Server internal log messages: + # 0=err, 1=warning, 2=notice, 3=info, 4=debug + log_level => ($DEBUG ? 4 : 2), + log_file => undef, # will be overridden to call do_log() + }, +}, 'Amavis'; + +$0 = 'amavisd (master)'; +$server->run; # transfer control to Net::Server + +# shouldn't get here +exit 1; + +# we read text from DATA sections to avoid any interpretations +# 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 set_debug_id do_debug_log) } + +sub new($$$;$$) { + my($class, $sql_query,$fieldname, $fieldtype,$implied_args) = @_; + # fieldtype: B=boolean, N=numeric, S=string, + # N-: numeric, nonexistent field returns undef without complaint + # S-: string, nonexistent field returns undef without complaint + # B-: boolean, nonexistent field returns undef without complaint + # B0: boolean, nonexistent field treated as false + # B1: boolean, nonexistent field treated as true + return undef if !defined($sql_query); + my($self) = bless {}, $class; + $self->{sql_query} = $sql_query; + $self->{fieldname} = lc($fieldname); + $self->{fieldtype} = uc($fieldtype); + $self->{args} = ref($implied_args) eq 'ARRAY' ? [@$implied_args] # copy + : [$implied_args] if defined $implied_args; + $self; +} + +sub lookup_sql_field($$) { + my($self,$addr) = @_; + my($match); + if (!defined($self)) { + do_log(5, "lookup_sql_field - undefined, \"$addr\" no match"); + } else { + my($field) = $self->{fieldname}; + if (!defined($self->{sql_query})) { + do_log(5, "lookup_sql_field($field) - null query, \"$addr\" no match"); + } else { + my($h_ref) = !exists($self->{args}) ? + $self->{sql_query}->lookup_sql($addr) + : $self->{sql_query}->lookup_sql($addr,$self->{args}); + if (!defined($h_ref)) { + do_log(5, "lookup_sql_field($field), \"$addr\" no match"); + } elsif (!exists($h_ref->{$field})) { + # record found, but no field with that name in the table + if ($self->{fieldtype} eq 'B0') { # boolean, defaults to false + $match = 0; # nonexistent field treated as 0 + do_log(5, "lookup_sql_field($field), NO FIELD, \"$addr\" result=$match"); + } elsif ($self->{fieldtype} eq 'B1') { # defaults to true + $match = 1; # nonexistent field treated as 1 + do_log(5, "lookup_sql_field($field), NO FIELD, \"$addr\" result=$match"); + } elsif ($self->{fieldtype}=~/^.-$/) { # expected to not exist + do_log(5, "lookup_sql_field($field), NO FIELD, \"$addr\" result=undef"); + } else { # treated as 'no match', issue a warning + do_log(1, "lookup_sql_field($field) ". + "(WARNING: no such field in the SQL table), ". + "\"$addr\" matches, result=undef"); + } + } else { + # fieldtype: B=boolean, N=numeric, S=string, + # B0: boolean, nonexistent field treated as false, + # B1: boolean, nonexistent field treated as true + $match = $h_ref->{$field}; my($found) = defined $match; + if (!defined($match)) { # keep undef for NULL field values + } elsif ($self->{fieldtype} =~ /^B/) { # boolean + # convert values 'N', 'F', '0', ' ' and "\000" to 0 + # to allow value to be used directly as a Perl boolean + $match = 0 if $match =~ /^[NnFf0 \000][ ]*$(?!\n)/; + } elsif ($self->{fieldtype} =~ /^N/) { # numeric + $match = $match + 0; # unify different numeric forms + } elsif ($self->{fieldtype} =~ /^S/) { # string + $match =~ s/ +$(?!\n)//; # trim trailing spaces + } + do_log(5, "lookup_sql_field($field) \"$addr\"" . + (!$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.15'; + @ISA = qw(Exporter); + @EXPORT_OK = qw(&connect_to_sql); +} +use subs @EXPORT_OK; + +BEGIN { + import Amavis::Util qw(do_log set_debug_id do_debug_log); + import Amavis::Conf qw(:platform :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; +} + +# return a Lookup::SQL object containing a DBI handle and prepared selects +sub new($$$$$$) { + my($class, $dbh, $select_clause) = @_; + my($self) = bless {}, $class; + $self->{dbh} = $dbh; # save DBI handle + for my $n (1..20) { # prepare select statements with different no. of args + my($sel) = $select_clause; $sel =~ s/%k/join(',',('?')x$n)/ge; + do_log(5,"SQL prepare: ".$sel); + $self->{"sth$n"} = $dbh->prepare($sel); + } + $self; +} + +sub clear_cache { + my($self) = @_; + delete $self->{cache}; +} + +# 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 +# the order is unspecified, which is only useful if just specific entries +# exist in a database (full address, not domain part or mailbox part only). +# +# The following order is recommended, going from specific to more general: +# - lookup for user+foo@example.com +# - lookup for user@example.com (only if $recipient_delimiter nonempty) +# - lookup for user+foo ('naked lookup': only if local) +# - lookup for user ('naked lookup': local and $recipient_delimiter nonempty) +# - lookup for @example.com +# - lookup for @. (catchall) +# NOTE: +# this is different from hash and ACL lookups in three important aspects: +# - subdomains are not looked at, only full domain names are matched; +# - naked key (without '@') implies mailbox (=user) name, not domain name; +# - the naked mailbox name lookups are only performed when the e-mail +# address (usually its domain part) matches the local_domains* lookups. +# +# 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,$extra_args) = @_; + + # + # No longer perform caching of the sql results. When a message is sent to + # multiple recipients the white/black list lookups end up returning erroneous + # results due to this caching mechanism. + # + # - chobbs + # + #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($taint) = substr($addr,0,0); + 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.$taint if $domain =~ /^\@?(.*?)\.*$(?!\n)/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 + #do_log(1,"lookup_sql calls lookup $addr"); + if (Amavis::Lookup::lookup($addr, \%local_domains, + \@local_domains_acl,$local_domains_re)) { + # NOTE: $local_domains_sql is not looked up to avoid recursion, + # only static local_domain* lookup tables are used ! + push(@keys, $localpart.$recipient_delimiter.$extension) + if $extension ne ''; # user+foo + push(@keys, $localpart); # user + } + push(@keys, '@'.$domain) if($domain); # @example.com + # new code to include subdomains + my $subdomain = $domain; + # loop - stripping off 1 subdomain at a time + while ($subdomain =~ s/^[^\.]+\.//) + { + # add subdomain to @keys + push(@keys, '@'.$subdomain) if($subdomain); + } + push(@keys, '@.'); # @. (catchall) + + #### ZL - if any of the email addresses matches an LDAP uid, add it + # as well + # FIXME: what happens if we aren't looking at the recipient list, but + # at the sender... + my @new_keys = (); + foreach my $key (@keys) { + # try using their real email address for rules + if ($Amavis::PU_REAL_EMAIL_MAP{$key}) { + push(@new_keys, $Amavis::PU_REAL_EMAIL_MAP{$key}); + } + elsif ($Amavis::PU_UID_MAP{$key}) { + # otherwise, go by the uid - just realize that the uid may be + # non-unique + push(@new_keys, $Amavis::PU_UID_MAP{$key}); + } + } + push(@keys, @new_keys); + my($n) = sprintf("%d",scalar(@keys)); + my($sth) = $self->{"sth$n"}; + unshift(@keys,@$extra_args) if ref $extra_args; # prepend extra arguments + for (@keys) { $_=$1 if /^(.*)$(?!\n)/s } # untaint keys + do_log(3, "lookup_sql \"$addr\", query keys: " . + join(', ', map{"\"$_\""}@keys) ); + + # enable auto-reconnect + my $block_on_db = 1; + while (1) { + $self->{dbh}->{mysql_auto_reconnect} = 1; + my $previous_failure_count = $self->{dbh}->{mysql_dbd_stats}->{auto_reconnects_failed}; + eval { + $sth->execute(@keys); # do the query + }; + if (!$block_on_db || + $previous_failure_count == $self->{dbh}->{mysql_dbd_stats}->{auto_reconnects_failed}) { + last; + } + do_log(0, "DB Failure - sleeping"); + sleep 1; + } + my($a_ref,$found,$match); $match = {}; + while ( defined($a_ref=$sth->fetchrow_arrayref) ) { # fetch query results + my(@names) = @{$sth->{NAME_lc}}; + $found = 1; $match = {}; @$match{@names} = @$a_ref; + do_log(5, "lookup_sql: \"$addr\" 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, \"$addr\" no match"); + } + + # No longer do sql caching ... + # + # - chobbs + # + # save for future use, but only within processing of this message + # $self->{cache}->{$addr} = $match; + + section_time('lookup_sql'); + $match; +} + +1; + +__DATA__ +#^L +package Amavis::Lookup::LDAP; +# by Jacques Supcik, PhD +# IP-Plus Internet Services - Swisscom Enterprise Solutions Ltd +# Genfergasse 14, 3050 Bern, Switzerland (http://www.ip-plus.net/) +# March 2003 + +use strict; +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION + $ldap_sys_default %ldap_cache); + @ISA = qw(Exporter); + $VERSION = '1.15'; + + import Amavis::Util qw(do_log set_debug_id do_debug_log); + import Amavis::Conf qw(:platform :confvars); + import Amavis::Timing qw(section_time); + import Amavis::rfc2821_2822_Tools qw(split_address split_localpart); + + $ldap_sys_default = { + hostname => 'localhost', port => 389, timeout => 120, tls => 0, + base => undef, scope => 'sub', + query_filter => '(&(objectClass=amavisAccount)(mail=%m))', + res_attr => undef, res_filter => '%r', + bind_dn => undef, bind_password => undef + }; + %ldap_cache = (); +} + +sub trim { + my $str = shift; + $str =~ s/\s+$(?!\n)//; $str =~ s/^\s+//; + $str; +} + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my ($default, $query) = @_; + my ($self) = bless {}, $class; + my $llog = sub { + my $level = shift; + my $template = shift; + my $prefix = __PACKAGE__."::new (res_attr->".$query->{res_attr}.")"; + do_log($level, sprintf("$prefix - $template", @_)); + }; + # Replace undefined attributes by defaults + foreach (qw(hostname port timeout tls base scope query_filter + res_attr res_filter bind_dn bind_password)) { + $query->{$_} = $default->{$_} unless (defined $query->{$_}); + $query->{$_} = $ldap_sys_default->{$_} unless (defined $query->{$_}); + } + my $ldap; + my $hostList = (ref $query->{hostname} eq 'ARRAY') ? + join ", ", @{$query->{hostname}} : $query->{hostname}; + my $cache_key = join "\036", ($hostList, $query->{port}, + $query->{timeout}, $query->{tls}, + $query->{bind_dn}, $query->{bind_password}); + if (exists $ldap_cache{$cache_key}) { + $llog->(5, "Fetching ldap connection from cache"); + $ldap = $ldap_cache{$cache_key}; + } else { + $llog->(5, "trying to connect to '%s'", $hostList); + $ldap = Net::LDAP->new($query->{hostname}, port=>$query->{port}, + timeout=>$query->{timeout}, onerror=>'undef'); + if ($ldap) { + $llog->(5, "connection to '%s' succeeded", $hostList); + } else { + $llog->(0, "unable to connect to host '%s'. LDAP lookups disabled.", + $hostList); + return undef; + } + if ($query->{tls}) { # TLS required + my $tlsVer = $ldap->start_tls(verify=>'none'); + $llog->(5, "TLS version %s enabled", $tlsVer); + } + if ($query->{bind_dn}) { # Binding required + if ($ldap->bind ($query->{bind_dn}, password => $query->{bind_password})) { + $llog->(5, "bind '%s' succeeded", $query->{bind_dn}); + } else { + $llog->(1, "unable to bind '%s'",$query->{bind_dn}); + return undef; + } + } + $ldap_cache{$cache_key} = $ldap; + } + $self->{ldap} = $ldap; + foreach (qw(base scope query_filter res_attr res_filter)) { + $self->{$_} = $query->{$_}; + } + if ($query->{res_attr} eq "dn") { + $self->{type} = "S" # String + } else { + my $schema = $ldap->schema(); # Lookup schema + if ($schema) { + my $sa = $schema->attribute($query->{res_attr}); + if ($sa and $sa->{equality} eq 'booleanMatch' and $sa->{'single-value'}) { + $self->{type} = "B" # Boolean + } elsif ($sa and $sa->{equality} eq 'integerMatch' and + $sa->{'single-value'}) { + $self->{type} = "N" # Number + } elsif ($sa and not $sa->{'single-value'}) { + $self->{type} = "L" # List + } elsif ($sa) { + $self->{type} = "S" # String + } else { + $llog->(1, "attribute not defined in schema"); + $self->{type} = "S" # attribute not defined, default String + } + } else { + $llog->(1, "unable to read LDAP schema"); + $self->{type} = "S" # If no schema is defined, default String + } + } + $llog->(5, "type='%s'",$self->{type}); + return $self; +} + +sub lookup_ldap_exact { + my $self = shift; + my ($addr) = @_; + my $llog = sub { + my $level = shift; + my $template = shift; + my $prefix = __PACKAGE__."::lookup_ldap_exact ($addr)"; + do_log($level, sprintf("$prefix - $template", @_)); + }; + unless (defined $self) { + $llog->(5, "object undefined, no match"); + return undef; + } + unless (defined $self->{ldap}) { + $llog->(5, "null ldap object, no match"); + return undef; + } my $filter = $self->{query_filter}; $filter =~ s/%m/$addr/g; my $attribute = $self->{res_attr}; @@ -7198,98 +8827,1192 @@ my $res = $self->{ldap}->search ( base => $self->{base}, scope => $self->{scope}, filter => $filter ); - unless (defined $res) { - $llog->(5, "result undefined, no match"); - return undef; + unless (defined $res) { + $llog->(5, "result undefined, no match"); + return undef; + } + $llog->(5, "result:%s", $res->code); + if (my $entry = $res->pop_entry) { + if ($self->{res_attr} eq "dn") { + my $x = trim($entry->dn); + my $f = $self->{res_filter}; $f =~ s/%r/$x/g; + $llog->(5, "dn match: %s (%s)", $x, $f); + return $f; + } elsif ($entry->exists($self->{res_attr})) { + if ($self->{type} eq "B") { + my $x = (uc($entry->get_value($self->{res_attr})) eq "TRUE") ? 1 : 0; + my $f = $self->{res_filter}; $f =~ s/%r/$x/g; + $llog->(5, "boolean match: %s (%s)", $x, $f); + return $f; + } elsif ($self->{type} eq "N") { + my $x = 0 + scalar $entry->get_value($self->{res_attr}); + my $f = $self->{res_filter}; $f =~ s/%r/$x/g; + $llog->(5, "numeric match: %s (%s)", $x, $f); + return $f; + } elsif ($self->{type} eq "S") { + my $x = trim(scalar $entry->get_value($self->{res_attr})); + my $f = $self->{res_filter}; $f =~ s/%r/$x/g; + $llog->(5, "string match: %s (%s)", $x, $f); + return $f; + } else { + my @x = map { trim($_) } $entry->get_value($self->{res_attr}); + my @f = map { my $f = $self->{res_filter}; $f =~ s/%r/$_/g; $f } @x; + $llog->(5, "list match: %s (%s)", join (", ", @x), join (", ", @f)); + return wantarray ? @f : \@f; + } + } else { + $llog->(5, "attribute does not exists, no match"); + } + } else { + $llog->(5, "address not found, no match"); + } + return undef +} + +sub lookup_ldap { + my $self = shift; + my ($addr) = @_; + my $llog = sub { + my $level = shift; + my $template = shift; + my $prefix = __PACKAGE__."::lookup_ldap ($addr)"; + do_log($level, sprintf("$prefix - $template", @_)); + }; + my $log_prefix = __PACKAGE__ . "::lookup_ldap($addr) -"; + my ($taint) = substr($addr,0,0); + my ($localpart, $domain) = split_address($addr); + my $res; + $domain = lc($domain); + $localpart = lc($localpart) unless $localpart_is_case_sensitive; + # chop off leading @, and trailing dots + if ($domain =~ /^\@?(.*?)\.*$(?!\n)/s) { $domain = $1.$taint } + my $extension; + if ($recipient_delimiter ne '') { + ($localpart, $extension) = + split_localpart($localpart, $recipient_delimiter); + } + if ($extension ne '') { # user+foo@example.com + $res = $self->lookup_ldap_exact ($localpart.$recipient_delimiter. + $extension.'@'.$domain); + if (defined $res) { return $res } + } + $res = $self->lookup_ldap_exact($localpart.'@'.$domain); # user@example.com + if (defined $res) { return $res } + if (Amavis::Lookup::lookup($addr, \%local_domains, + \@local_domains_acl, $local_domains_re)) { + if ($extension ne '') { # user+foo + $res = $self->lookup_ldap_exact($localpart.$recipient_delimiter. + $extension); + if (defined $res) { return $res } + } + $res = $self->lookup_ldap_exact ($localpart); # user + if (defined $res) { return $res } + } + $res = $self->lookup_ldap_exact ('@'.$domain); # @example.com + if (defined $res) { return $res } + $res = $self->lookup_ldap_exact ('@.'); # @. (catchall) + return $res +} + +1; + +__DATA__ +# +package Amavis::In::AMCL; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + $VERSION = '1.15'; + @ISA = qw(Exporter); +} + +use subs @EXPORT; +use Errno qw(ENOENT); +use IO::File; + +BEGIN { + import Amavis::Conf qw(:platform :confvars); + import Amavis::Util qw(do_log set_debug_id do_debug_log am_id debug_oneshot rmdir_recursively); + import Amavis::Lookup qw(lookup); + import Amavis::Timing qw(section_time); + import Amavis::rfc2821_2822_Tools; + import Amavis::In::Message; + import Amavis::In::Connection; + import Amavis::rfc2821_2822_Tools qw(/^EX_/); +} + +sub new($) { my($class) = @_; bless {}, $class } + +# Accept a single request for virus checking via UNIX socket from amavis client +# (used with sendmail milter and traditional (non-SMTP) MTA interface) +# +sub process_amavis_client_request($$$) { + my($self, $sock, $conn, $check_mail) = @_; + # $sock: connected socket from Net::Server + # $conn: information about client connection + # $check_mail: subroutine ref to be called with file handle + + my($msginfo) = Amavis::In::Message->new; + + my($fh,$tempdir); + my($protocol_succeeded) = 0; # got all data from amavis client + my($which_section) = "initialization"; + eval { + my($inbuff); + # + # Receive TEMPDIR/SENDER/RCPTS/LDA/LDAARGS from client + # + my $yval = "\1"; # value to return to the client if AOK + + $which_section = "RX_tempdir"; + defined(recv($sock, $inbuff, 8192, 0)) or die "recv (1) failed: $!"; + $inbuff =~ /^( (?: \Q$TEMPBASE\E | \Q$MYHOME\E ) + \/ (?! .* \.{2,} .*) [A-Za-z0-9_.-]+ ) $(?!\n)/xso + or die "Invalid temporary directory '$inbuff'"; + $tempdir = $1; # untaint the directory name + # set new amavis message id + am_id( ($tempdir =~ /amavis-(milter-)?(.+?)$(?!\n)/s ? $2 : undef) ); + defined(send($sock, $yval, 0)) or die "send ack (1) failed: $!"; + + $which_section = "RX_sender"; + defined(recv($sock, $inbuff, 8192, 0)) or die "recv (2) failed: $!"; + defined(send($sock, $yval, 0)) or die "send ack (2) failed: $!"; + $inbuff = unquote_rfc2821_local($inbuff) if $gets_addr_in_quoted_form; + $msginfo->sender($inbuff); + debug_oneshot(1) if lookup($msginfo->sender,\@debug_sender_acl); + + # Simple "protocol" + # \2 means LDA; \3 means EOT (end of transmission) + + $which_section = "RX_recipients"; + my(@recips); my(@ldaargs); + my($outvar) = \@recips; + for (;;) { + defined(recv($sock,$inbuff,8192,0)) or die "recv (3) failed: $!"; + last if ($inbuff eq "\3"); + if ($inbuff eq "\2") { + $outvar = \@ldaargs; + $which_section = "RX_LDA"; + } else { + $inbuff = unquote_rfc2821_local($inbuff) + if $gets_addr_in_quoted_form && $outvar==\@recips; + push(@$outvar, $inbuff); + } + defined(send($sock, $yval, 0)) or die "send ack (3) failed: $!"; + } + $msginfo->recips(\@recips); $msginfo->rx_time(time); + $protocol_succeeded = 1; # protocol obtained all required data + # amavis client is now expecting final status code + + $which_section = "opening_mail_file"; + # created by amavis client, just open it + $fh = IO::File->new("$tempdir/email.txt", 'r') + or die "Can't open file $tempdir/email.txt: $!"; + binmode($fh,":bytes") + or die "Can't cancel :utf8 mode: $!" if $unicode_aware; + $msginfo->mail_text($fh); + section_time('got data'); + do_log(1, sprintf("AM.CL %s: <%s> -> %s", $tempdir, $msginfo->sender, + join(',', map{"<$_>"}@recips) )); + }; # end of eval + my($smtp_resp, $exit_code, $preserve_evidence); + if ($@ ne '') { + chomp($@); + do_log(0,"$which_section FAILED, retry: " . $@); + $fh->close if $fh; + $fh = undef; $msginfo->mail_text(undef); + $exit_code = EX_TEMPFAIL; + # keep directory for inspection + } else { + # check_mail() expects open file on $fh, need not be rewound + ($smtp_resp, $exit_code, $preserve_evidence) = + &$check_mail($conn,$msginfo,0,$tempdir); + $fh->close or Amavis::Util::cleanup_and_die "Can't close temp file: $!" if $fh; + $fh = undef; $msginfo->mail_text(undef); + my($errn) = $tempdir eq '' ? ENOENT : (stat($tempdir) ? 0 : 0+$!); + if ($tempdir eq '' || $errn == ENOENT) { + # do nothing + } elsif ($preserve_evidence) { + do_log(0, "tempdir is to be PRESERVED: $tempdir"); + } else { + do_log(4, "tempdir being removed: $tempdir"); + rmdir_recursively($tempdir); + } + if ($forward_method eq '' && $exit_code == EX_OK) { # e.g. milter + # when forwarding is left for MTA on the input side to do, + # warn if there is anything that should be done, but MTA is not + # capable of doing (or a helper program can not pass the request) + my($any_deletes); + for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } + my($addr,$newaddr) = ($r->recip_addr, $r->recip_final_addr); + if ($r->recip_done) { + do_log(0, "WARN: recip addr <$addr> should be removed, but MTA can't do it"); + $any_deletes++; + } elsif ($newaddr ne $addr) { + do_log(0, "WARN: recip addr <$addr> should be replaced with <$newaddr>, but MTA can't do it"); + } + } + if ($any_deletes) { + do_log(0, "WARN: REJECT THE WHOLE MESSAGE, MTA-in can't do the recips deletion"); + $exit_code = EX_UNAVAILABLE; + } + } + } + if ($mta_in_type eq 'qmail' && $exit_code == EX_TEMPFAIL) { + $exit_code = 81; # qmail is different?! + } + do_log(3, "mail checking ended: exit_code=$exit_code ($smtp_resp)"); + send($sock, $exit_code, 0) if $protocol_succeeded; +} + +1; + +__DATA__ +# +package Amavis::In::SMTP; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + $VERSION = '1.15'; + @ISA = qw(Exporter); +} +use POSIX qw(strftime); +use Errno qw(ENOENT); +use Time::HiRes qw(time); + +BEGIN { + import Amavis::Conf qw(:platform :confvars); + import Amavis::Util qw(do_log set_debug_id do_debug_log am_id prolong_timer debug_oneshot + sanitize_str strip_tempdir rmdir_recursively); + import Amavis::Lookup qw(lookup); + import Amavis::Timing qw(section_time); + import Amavis::rfc2821_2822_Tools; + import Amavis::In::Message; + import Amavis::In::Connection; +} + +sub new($) { + my($class) = @_; + my($self) = bless {}, $class; + $self->{proto} = undef; # currently doing SMTP / ESMTP / LMTP + $self->{pipelining} = undef; # may we buffer responses? + $self->{smtp_outbuf} = undef; # SMTP responses buffer for PIPELINING + $self->{fh_pers} = undef; # persistent file handle for email.txt + $self->{tempdir_pers} = undef;# temporary directory for check_mail + + # variables used to switch between ramdisk and harddisk + $self->{tempdir_pers_small} = undef; # temporary directory for check_mail + $self->{tempdir_pers_large} = undef; # temporary directory for check_mail + $self->{fh_pers_small_msg} = undef; # persistent file handle for email.txt + $self->{fh_pers_large_msg} = undef; # persistent file handle for email.txt + + $self->{preserve} = undef; # don't delete tempdir on exit + $self->{tempdir_empty} = 1; # anything of interest in tempdir? + $self->{session_closed_normally} = undef; # closed properly with QUIT + $self; +} + +sub preserve_evidence # try to preserve temporary files etc in case of trouble + { my($self)=shift; !@_ ? $self->{preserve} : ($self->{preserve}=shift) } + +sub DESTROY { + my($self) = shift; + do_log(1, "DESTROY called"); + $self->{fh_pers}->close or do_log(1,"Can't close temp file: ".$!); + my($errn) = $self->{tempdir_pers} eq '' ? ENOENT + : (stat($self->{tempdir_pers}) ? 0 : 0+$!); + if (defined $self->{tempdir_pers} && $errn != ENOENT) { + # + # Always remove evidence ... + # + # this will not be included in the TIMING report, + # but it only occurs infrequently and doesn't take that long + #if ($self->preserve_evidence && !$self->{tempdir_empty}) { + # do_log(0, "tempdir is to be PRESERVED: ".$self->{tempdir_pers}); + #} else { + do_log(1, "tempdir being removed: ".$self->{tempdir_pers}); + rmdir_recursively($self->{tempdir_pers}); + #} + } + if (! $self->{session_closed_normally}) { + $self->smtp_resp(1,"421 4.3.2 Service shutting down, closing channel"); + } + do_log(1, "DESTROY returning"); +} + +sub prepare_tempdir($$$) { + my($self, $dirname, $fh_pers) = @_; + my($errn) = stat($dirname) ? 0 : 0+$!; + if ($errn == ENOENT || ! -d _) { + mkdir($dirname, 0750) + or die "Can't create directory $dirname}: $!"; + $self->{tempdir_empty} = 1; + section_time('mkdir tempdir'); + } else { + # Be sure we can't scan parts from old mails... + Amavis::Util::strip_tempdir($dirname); + } + # prepare temporary file for writing (and reading later) + my($fname) = $dirname . "/email.txt"; + my($errn) = stat($fname) ? 0 : 0+$!; + + if ($fh_pers && !$errn && -f $_) { + $fh_pers->seek(0,0) or die "Can't rewind mail file: $!"; + $fh_pers->truncate(0) or die "Can't truncate mail file: $!"; + } else { + $fh_pers = IO::File->new($fname, 'w+', 0640) + or die "Can't create file $fname: $!"; + section_time('create email.txt'); + } + return $fh_pers; +} +sub prepare_all_tempdirs($) { + my($self) = @_; + if (! defined $self->{tempdir_pers_small} ) { + # invent a name for a temporary directory for this child, and create it + my($now_iso8601) = strftime("%Y%m%dT%H%M%S", localtime); + $self->{tempdir_pers_small} = sprintf("%s/amavis-%s-%05d", + $TEMPBASE, $now_iso8601, $$); + # create name for tempdir actually on harddrive + $self->{tempdir_pers_large} = sprintf("%s/amavis-%s-%05d", + $LARGE_MSG_HOME, $now_iso8601, $$); + } + $self->{fh_pers_small_msg} = prepare_tempdir($self, + $self->{tempdir_pers_small}, + $self->{fh_pers_small_msg}); + #to create a parallel scanning directory on harddrive, uncomment out the next line + if (0) + { + $self->{fh_pers_large_msg} = prepare_tempdir($self, + $self->{tempdir_pers_large}, + $self->{fh_pers_large_msg}); + } + # default to use ramdisk file + $self->{fh_pers} = $self->{fh_pers_small_msg}; + $self->{tempdir_pers} = $self->{tempdir_pers_small}; +} +# Accept a SMTP or LMTP connect (which can do any number of SMTP transactions, +# but usually does one) and call content checking for each message received +# +sub process_smtp_request($$$$) { + my($self, $sock, $lmtp, $conn, $check_mail) = @_; + # $sock: connected socket from Net::Server + # $lmtp: use LMTP protocil instead of (E)SMTP + # $conn: information about client connection + # $check_mail: subroutine ref to be called with file handle + + my($msginfo); + $self->{pipelining} = 0; # may we buffer responses? + $self->{smtp_outbuf} = []; # SMTP responses buffer for PIPELINING + + my($myheloname); +# $myheloname = $myhostname; +# $myheloname = 'localhost'; +# $myheloname = '[127.0.0.1]'; + $myheloname = '[' . $conn->socket_ip . ']'; + + my($sender,@recips); my($got_rcpt); + $conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'SMTP'); + $self->smtp_resp(1, "220 $myheloname " . ($lmtp ? 'LMTP' : 'ESMTP') . + " amavisd-new service ready"); + my($terminating,$aborting,$eof,$voluntary_exit); my($seq) = 0; + while(<$sock>) { + prolong_timer('reading SMTP command'); + { # a block is used as a 'switch' statement - 'last' will exit from it + my($cmd) = $_; my($taint) = substr($cmd,0,0); #tainted empty string + do_log(4, $self->{proto} . "< $cmd"); + !/^ \s* ([A-Za-z]+) (?: \s+ (.*?) )? \s* \015\012 $(?!\n)/xs && do { + $self->smtp_resp(1,"500 5.5.2 Error: bad syntax", 1, $cmd); last; + }; + ($_ = $1) =~ tr/a-z/A-Z/; my($args) = $2.$taint; + /^RSET|DATA|QUIT$/ && $args ne '' && do { + $self->smtp_resp(1,"501 5.5.4 Error: $_ does not accept arguments", 1,$cmd); + last; + }; + /^RSET$/ && do { $sender = undef; @recips = (); $got_rcpt = 0; + $msginfo = undef; # forget previous + $self->smtp_resp(0,"250 2.0.0 Ok $_"); last }; + /^NOOP$/ && do { $self->smtp_resp(1,"250 2.0.0 Ok $_"); last }; + /^QUIT$/ && do { + $self->smtp_resp(1,"221 2.0.0 $myheloname (amavisd) closing transmission channel"); + $terminating=1; last; + }; +### !$lmtp && /^HELO$/ && do { # strict + /^HELO$/ && do { + $sender = undef; @recips = (); $got_rcpt = 0; # implies RSET + $msginfo = undef; # forget previous + $self->{pipelining} = 0; $self->smtp_resp(0,"250 $myheloname"); + $lmtp = 0; $conn->smtp_proto($self->{proto} = 'SMTP'); + $conn->smtp_helo($args); section_time('SMTP HELO'); last; + }; +### (!$lmtp && /^EHLO$/ || $lmtp && /^LHLO$/) && do { # strict + (/^EHLO$/ || /^LHLO$/) && do { + $sender = undef; @recips = (); $got_rcpt = 0; # implies RSET + $msginfo = undef; # forget previous + $lmtp = /^EHLO$/ ? 0 : 1; + $conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'ESMTP'); + $self->{pipelining} = 1; + $self->smtp_resp(0,"250 $myheloname\n" . join("\n", + qw(PIPELINING SIZE 8BITMIME ENHANCEDSTATUSCODES))); + $conn->smtp_helo($args); section_time("SMTP $_"); + last; + }; + /^VRFY$/ && do { + $self->smtp_resp(1,"502 5.5.1 Command $_ not implemented", 1, $cmd); + # if ($args eq '') { + # $self->smtp_resp(1,"501 5.5.2 Syntax: VRFY address", 1, $cmd); + # } else { + # $self->smtp_resp(1,"252 2.0.0 Cannot VRFY user, but will accept ". + # "message and attempt delivery", 1, $cmd); + # } + last; + }; + /^HELP$/ && do { + $self->smtp_resp(1,"214 2.0.0 See amavisd-new home page at:\n". + "http://www.ijs.si/software/amavisd/"); + last; + }; + /^MAIL$/ && do { # begin new transaction + if (defined($sender)) { + $self->smtp_resp(0,"503 5.5.1 Error: nested MAIL command", 1, $cmd); + last; + } + # begin SMTP transaction + if (!$seq) {# the first connect + section_time('SMTP pre-MAIL'); + } else { # establish new time reference for each transaction + Amavis::Timing::init(); + } + $seq++; + am_id(sprintf("%05d-%02d%s", $$, + $Amavis::child_invocation_count, ($seq>1 ? "-$seq" : ""))); + $self->prepare_all_tempdirs; + $msginfo = Amavis::In::Message->new; + $msginfo->rx_time(time); + + # permit some sloppy syntax without angle brackets + if ($args !~ /^FROM: \s* + ( < (?: " (?: \\. | [^\\"] )* " | [^"@]* ) + (?: @ (?: \[ (?: \\. | [^\]] )* \] | + [^\[\]\\>] )* )? + > | + [^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )* + ) (?: \s+ ([^<>]+) )? $(?!\n)/isx ) { + $self->smtp_resp(0,"501 5.5.2 Syntax: MAIL FROM:
", 1, $cmd); + last; + } + my($addr,$opt) = ($1.$taint, $2.$taint); my($bad); + for (split(' ',$opt)) { + if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* ) = + ( [\041-\074\076-\176]+ ) $(?!\n)/x) {#printable, no =,SP + $self->smtp_resp(0,"501 5.5.4 Syntax error in MAIL FROM parameters", + 1, $cmd); + $bad = 1; last; + } else { + my($name,$val) = (uc($1).$taint, $2.$taint); + if ($name eq 'SIZE' && $val=~/^\d{1,20}$/) { + $msginfo->msg_size($val+0); + } elsif ($name eq 'BODY' && $val=~/^7BIT|8BITMIME$/i) { + $msginfo->body_type(uc($val)); + } else { + $self->smtp_resp(0,"504 5.5.4 MAIL command parameter error: ". + "$name=$val", 1, $cmd); + $bad = 1; last; + } + } + } + if (!$bad) { + $addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr; + $self->smtp_resp(0,"250 2.1.0 Sender $addr OK"); + $sender = unquote_rfc2821_local($addr); + debug_oneshot(lookup($sender,\@debug_sender_acl)?1:0, + $self->{proto} . "< $cmd"); + }; + last; + }; + /^RCPT$/ && do { + if (!defined($sender)) { + $self->smtp_resp(0,"503 5.5.1 Need MAIL command before RCPT", 1, $cmd); + $sender = undef; @recips = (); $got_rcpt = 0; + last; + } + $got_rcpt++; + # permit some sloppy syntax without angle brackets + if ($args !~ /^TO: \s* + ( < (?: " (?: \\. | [^\\"] )* " | [^"@]* ) + (?: @ (?: \[ (?: \\. | [^\]] )* \] | + [^\[\]\\>] )* )? + > | + [^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )* + ) (?: \s+ ([^<>]+) )? $(?!\n)/isx ) { + $self->smtp_resp(0,"501 5.5.2 Syntax: RCPT TO:
", 1, $cmd); + last; + } + if ($2 ne '') { + $self->smtp_resp(0,"504 5.5.4 RCPT command parameter not implemented: $2", 1, $cmd); + ### $self->smtp_resp(0,"555 5.5.4 RCPT command parameter unrecognized: $2", 1, $cmd); + } elsif ($got_rcpt > $smtpd_recipient_limit) { + $self->smtp_resp(0,"452 4.5.3 Too many recipients"); + } else { + my($addr,$opt) = ($1.$taint, $2.$taint); + $addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr; + $self->smtp_resp(0,"250 2.1.5 Recipient $addr OK"); + push(@recips, unquote_rfc2821_local($addr)); + }; + last; + }; + /^DATA$/ && !@recips && do { + if (!defined($sender)) { + $self->smtp_resp(1,"503 5.5.1 Need MAIL command before DATA", 1, $cmd); + } elsif (!$got_rcpt) { + $self->smtp_resp(1,"503 5.5.1 Need RCPT command before DATA", 1, $cmd); + } elsif ($lmtp) { # rfc2033 requires 503 code! + $self->smtp_resp(1,"503 5.1.1 Error (DATA): no valid recipients", 1, $cmd); + } else { + $self->smtp_resp(1,"554 5.1.1 Error (DATA): no valid recipients", 1, $cmd); + } + last; + }; + /^DATA$/ && do { + # set timer to the initial value, MTA timer starts here + prolong_timer('DATA received - timer reset', $child_timeout); + my($within_data_transfer,$complete); + eval { + # dk: reset msg size + $msginfo->msg_xsize( 0 ); + $msginfo->sender($sender); $msginfo->recips(\@recips); + do_log(1, sprintf("%s:%s:%s %s: <%s> -> %s Received: %s", + $conn->smtp_proto, + $conn->socket_ip eq $inet_socket_bind ? '' + : '['.$conn->socket_ip.']', + $conn->socket_port, $self->{tempdir_pers}, + $sender, join(',', map{"<$_>"}@recips), + join(' ', + ($msginfo->msg_size eq '' ? () + : 'SIZE='.$msginfo->msg_size), + ($msginfo->body_type eq '' ? () + : 'BODY='.$msginfo->body_type), + received_line($conn,$msginfo,am_id(),0) ) + ) ); + $self->smtp_resp(1,"354 End data with ."); + $within_data_transfer = 1; + section_time('SMTP pre-DATA-flush') if $self->{pipelining}; + $self->{tempdir_empty} = 0; + + # following are unused unless disk scanning for large msgs enabled + my $email_txt_size = 0; + my $sizeofeol = length($eol); + #my $MAX_RAM_FILESIZE = 20*1024*1024; # 100mbyte max file size + my $MAX_RAM_FILESIZE = 10; # 100mbyte max file size + + do{ local($/) = "\015\012"; #set in.line terminator to CRLF + while(<$sock>) { # use native I/O for speed + # do_log(5, $self->{proto} . "< $_"); + if (/^\./) { + if ($_ eq ".\015\012") { + $complete = 1; $within_data_transfer = 0; + last; + } + # rfc 2821 by the letter + s/^\.(.+\015\012)$(?!\n)/$1/s; + } + chomp; # remove \015\012 (=$/), faster than s/// + if (0) # support for large msg scanning done on harddrive + { + $email_txt_size += length($_)+$sizeofeol; + if ($email_txt_size > $MAX_RAM_FILESIZE) + { + # We want to switch over the harddrive scan directory + # rewind the ramdisk file back to beginning + $self->{fh_pers}->seek(0,0); + # copy this file to harddrive scan partition + my($len); + my $buff; + while ( ($len=read($self->{fh_pers},$buff,16384)) > 0 ) { + syswrite($self->{fh_pers_large_msg},$buff,$len); } + #switch filehandle over to harddrive, and continue there + $self->{fh_pers} = $self->{fh_pers_large_msg}; + $self->{tempdir_pers} = $self->{tempdir_pers_large}; + $MAX_RAM_FILESIZE = 100*1024*1024; + } + } + print {$self->{fh_pers}} $_,$eol + or Amavis::Util::cleanup_and_die "Can't write to mail file: $!"; + } + $eof = 1 if !$complete; + }; # restores line terminator + # normal data termination, or eof on socket, or fatal error + do_log(4, $self->{proto} . "< .\015\012") if $complete; + $self->{fh_pers}->flush or Amavis::Util::cleanup_and_die "Can't flush mail file: $!"; + # On some systems you have to do a seek whenever you + # switch between reading and writing. Amongst other things, + # this may have the effect of calling stdio's clearerr(3). + $self->{fh_pers}->seek(0,1) or Amavis::Util::cleanup_and_die "Can't seek on file: $!"; + section_time('SMTP DATA'); + }; + if ($@ ne '' || !$complete) { # error or connection broken + chomp($@); + # either send: '421 Shutting down', or alternatively: + # '451 Aborted, error in processing' and NOT shut down! + if (!$within_data_transfer) { + my($msg) = "Error in processing: " . + !$complete && $@ eq '' ? 'incomplete' : $@; + do_log(0, $self->{proto}." TROUBLE: 451 4.5.0 $msg"); + $self->smtp_resp(1, "451 4.5.0 $msg"); + ### $aborting = $msg; + } else { + $aborting = "client broke the connection ". + "during data transfer" if $eof; + $aborting .= ', ' if $aborting ne '' && $@ ne ''; + $aborting .= $@; + $aborting = '???' if $aborting eq ''; + do_log($@ ne '' ? 0 : 3, + $self->{proto}." TROUBLE, ABORTING: $aborting"); + } + } else { # all OK + # + # Is it acceptable to do all this processing here, + # before returning response??? According to rfc1047 + # it is not a good idea! But at the moment we do not have + # much choice, amavis has no queueing mechanism and can not + # accept responsibility for delivery. + # + # check contents before responding + # check_mail() expects open file on $self->{fh_pers}, + # need not be rewound + $msginfo->mail_text($self->{fh_pers}); + my($smtp_resp, $exit_code, $preserve_evidence) = + &$check_mail($conn,$msginfo, + $lmtp,$self->{tempdir_pers}); + if ($preserve_evidence) { $self->preserve_evidence(1) } + if ($smtp_resp !~ /^4/ && + grep { !$_->recip_done } @{$msginfo->per_recip_data}) { + die "TROUBLE/MISCONFIG: not all recipients done, ". + "\$forward_method is \"$forward_method\""; + } + if (!$lmtp) { + do_log(4, "sending SMTP response: \"$smtp_resp\""); + $self->smtp_resp(0, $smtp_resp); + } else { + my($bounced) = $msginfo->dsn_sent; + for my $r (@{$msginfo->per_recip_data}) { + my($recip) = lc($r->recip_addr); + if( $Amavis::default_domain && $Amavis::default_domain ne '') { $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } + my($resp) = $r->recip_smtp_response; + if ($bounced && $smtp_resp=~/^2/ && $resp!~/^2/) { + # as the message was already bounced by us, + # MTA must not bounce it again; failure status + # needs to be converted into success! + $resp = sprintf("250 2.5.0 Ok, DSN %s (%s)", + $bounced==1?'sent':'muted', $resp); + } + do_log(4, sprintf( + "sending LMTP response for <%s>: \"%s\"", + $r->recip_addr, $resp)); + $self->smtp_resp(0, $resp); + } + } + }; + if ($self->preserve_evidence && !$self->{tempdir_empty}) { + # keep evidence in case of trouble + do_log(0,"PRESERVING EVIDENCE in ".$self->{tempdir_pers}); + $self->{fh_pers}->close or die "Can't close mail file: $!"; + $self->{fh_pers} = undef; $self->{tempdir_pers} = undef; + $self->{tempdir_pers_small} = undef; + $self->{tempdir_pers_large} = undef; + $self->{tempdir_empty} = 1; + } + # cleanup, but leave directory (and file handle + # if possible) for reuse + if ($self->{fh_pers} && !$can_truncate) { + # truncate is not standard across all Unix variants, + # it is not Posix, but is XPG4-UNIX. + # So if we can't truncate a file and leave it open, + # we have to create it anew later, at some cost. + # + $self->{fh_pers}->close or die "Can't close mail file: $!"; + $self->{fh_pers} = undef; + unlink($self->{tempdir_pers}."/email.txt") + or die "Can't delete file ". + $self->{tempdir_pers}."/email.txt: $!"; + section_time('delete email.txt'); + } + if (defined $self->{tempdir_pers}) { # prepare for the next one + strip_tempdir($self->{tempdir_pers}); + $self->{tempdir_empty} = 1; + } + $sender = undef; @recips = (); $got_rcpt = 0; # implicit RSET + $msginfo = undef; # forget previous + + $self->preserve_evidence(0); # reset + # report elapsed times by section for each transaction + # (the time for the QUIT remains unaccounted for) + do_log(2, Amavis::Timing::report()); Amavis::Timing::init(); + last; + }; # DATA + # catchall (EXPN, TURN, unknown): + $self->smtp_resp(1,"502 5.5.1 Error: command ($_) not implemented", 1, $cmd); + # $self->smtp_resp(1,"500 5.5.2 Error: command ($_) not recognized", 1, $cmd); + }; + $voluntary_exit = 1; + last if $terminating || defined $aborting; # exit SMTP-session loop + + # rfc2920 requires a flush whenever the local TCP input buffer is + # emptied. Since we can't check it (unless we use sysread & select), + # we should do a flush here to be in compliance. We could only break + # the requirement if we knew we talk with a local MTA client which + # uses client-side pipelining. + $self->smtp_resp_flush; + } + $eof = 1 if !$voluntary_exit; + # we come here when: QUIT is received, eof on socket, or we need to abort + $self->smtp_resp_flush; # just in case, the session might have been disconnected + my($msg) = + defined $aborting && !$eof? "ABORTING the session: $aborting" : + defined $aborting ? $aborting : + !$terminating ? "client broke the connection without a QUIT" : ''; + do_log(0, $self->{proto}.': NOTICE: '.$msg) if $msg ne ''; + if (defined $aborting && !$eof) + { $self->smtp_resp(1,"421 4.3.2 Service shutting down, ".$aborting) } + $self->{session_closed_normally} = 1; + # closes connection after child_finish_hook +} + +# sends a SMTP response consisting of 3-digit code and an optional message; +# slow down evil clients by delaying response on permanent errors +sub smtp_resp($$$;$$) { + my($self, $flush,$resp, $penalize,$line) = @_; + if ($penalize) { + do_log(0, $self->{proto} . ": $resp; PENALIZE: $line"); + section_time('SMTP penalty wait'); + } + my($taint) = substr($resp,0,0); + $resp = sanitize_str($resp,1); + if ($resp !~ /^ ([1-5]\d\d) (\ |-|$(?!\n)) + ([245] \. \d{1,3} \. \d{1,3} (?: \ |$(?!\n)) )? + (.*) $(?!\n)/xs) + { die "Internal error(2): bad SMTP response code: '$resp'" } + my($resp_code,$continuation,$enhanced,$tail) = ($1,$2,$3, $4.$taint); + my($lead_len) = length($resp_code) + 1 + length($enhanced); + while (length($tail) > 512-2-$lead_len || $tail =~ /\n/) { + # rfc2821: The maximum total length of a reply line including the + # reply code and the is 512 characters. More information + # may be conveyed through multiple-line replies. + my($head) = substr($tail,0,512-2-$lead_len); + if ($head =~ /^([^\n]*\n)/) { $head = $1.$taint } + $tail = substr($tail,length($head)); chomp($head); + push(@{$self->{smtp_outbuf}}, $resp_code.'-'.$enhanced.$head); + } + push(@{$self->{smtp_outbuf}},$resp_code.$continuation.$enhanced.$tail); + $self->smtp_resp_flush if $flush || !$self->{pipelining} || + @{$self->{smtp_outbuf}} > 200; +} + +sub smtp_resp_flush($) { + my($self) = shift; + if (@{$self->{smtp_outbuf}}) { + for my $resp (@{$self->{smtp_outbuf}}) { + do_log(4, $self->{proto} . "> $resp"); + }; + print map($_."\015\012", @{$self->{smtp_outbuf}}); + @{$self->{smtp_outbuf}} = (); + } +} + +1; + +__DATA__ +# +package Amavis::AV; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + $VERSION = '1.15'; + @ISA = qw(Exporter); + @EXPORT_OK = qw(&sophos_savi_init); +} + +use Errno qw(EPIPE ENOTCONN ENOENT); +use Socket; +use IO::Socket; +use IO::Socket::UNIX; + +use subs @EXPORT_OK; +use vars @EXPORT; + +BEGIN { + import Amavis::Conf qw(:platform :confvars); + import Amavis::Util qw(do_log set_debug_id do_debug_log am_id retcode min max run_command); + import Amavis::Timing qw(section_time); +} + +use vars qw(%st_socket_created %st_sock); # keep persistent state (per-socket) +use vars qw($savi); + +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 + !DeleteAllMacros Vbe !ExecFileDisinfection VisioFileHandling + Mime ActiveMimeHandling !DelVBA5Project + ScrapObjectHandling SrpStreamHandling Office2001Handling + Upx PalmPilotHandling HqxDecompression + Pdf Rtf Html Elf WordB OutlookExpress + ); + # starting with SAVI V3: Mac and SafeMacDfHandling options were removed; + # new option GrpArchiveUnpack makes individual settings unnecessary; + # option 'Mime' may cause a CPU loop when checking broken mail with older + # versions of Sophos library + my($savi) = SAVI->new; + ref $savi or Amavis::Util::cleanup_and_die "$av_name: Can't create a SAVI object, err=$savi"; + my($version) = $savi->version; + ref $version or Amavis::Util::cleanup_and_die "$av_name: Can't get SAVI version, err=$version"; + do_log(2, sprintf("$av_name init: Version %s (engine %d.%d) recognizing %d viruses\n", + $version->string, $version->major, $version->minor, $version->count)); +# for ($version->ide_list) +# { do_log(2, sprintf("$av_name: IDE %s released %s", $_->name, $_->date)) } + my($error) = $savi->set('MaxRecursionDepth', 16, 1); + !defined $error or Amavis::Util::cleanup_and_die "$av_name: error setting MaxRecursionDepth: err=$error"; + my($error) = $savi->set('NamespaceSupport', 3); # new with Sophos 3.67 + !defined $error or do_log(0,"$av_name: error setting NamespaceSupport: err=$error"); + for (@savi_bool_options) { + my($value) = /^!/ ? 0 : 1; s/^!+//; + $error = $savi->set($_, $value); + !defined $error or Amavis::Util::cleanup_and_die "$av_name: Error setting $_: err=$error"; } - $llog->(5, "result:%s", $res->code); - if (my $entry = $res->pop_entry) { - if ($self->{res_attr} eq "dn") { - my $x = trim($entry->dn); - my $f = $self->{res_filter}; $f =~ s/%r/$x/g; - $llog->(5, "dn match: %s (%s)", $x, $f); - return $f; - } elsif ($entry->exists($self->{res_attr})) { - if ($self->{type} eq "B") { - my $x = (uc($entry->get_value($self->{res_attr})) eq "TRUE") ? 1 : 0; - my $f = $self->{res_filter}; $f =~ s/%r/$x/g; - $llog->(5, "boolean match: %s (%s)", $x, $f); - return $f; - } elsif ($self->{type} eq "N") { - my $x = 0 + scalar $entry->get_value($self->{res_attr}); - my $f = $self->{res_filter}; $f =~ s/%r/$x/g; - $llog->(5, "numeric match: %s (%s)", $x, $f); - return $f; - } elsif ($self->{type} eq "S") { - my $x = trim(scalar $entry->get_value($self->{res_attr})); - my $f = $self->{res_filter}; $f =~ s/%r/$x/g; - $llog->(5, "string match: %s (%s)", $x, $f); - return $f; + section_time('sophos_savi_init'); + $savi; +} + +# same args and returns as run_av() below +# +sub sophos_savi { + my($tempdir, $av_name, $command, $savi_of_parent) = @_; + if (defined $savi_of_parent) { $savi = $savi_of_parent } + else { $savi = sophos_savi_init($av_name,$command) if !defined $savi } + my($scan_status,@virusname); my($output) = ''; + local(*DIR); my($f); my($cnt) = 0; + opendir(DIR, "$tempdir/parts") + or Amavis::Util::cleanup_and_die "Can't open directory $tempdir/parts: $!"; + while (defined($f = readdir(DIR))) { + my($fname) = "$tempdir/parts/$f"; + my($errn) = stat($fname) ? 0 : 0+$!; + next if $errn == ENOENT; + if ($errn) { die "sophos_savi: $fname inaccessible: $!" } + if (!-r _) { die "sophos_savi: $fname not readable" } + next if -d _ && ($f eq '.' || $f eq '..'); # this or parent directory + next if -z _; # empty file + $cnt++; 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) $!"; + if (! grep {$result == $_} (514,527,530,538,549) ) { + die $msg; + } else { # don't panic on non-fatal (encrypted, corrupted, partial) + do_log(0,$msg); + $scan_status = 0 if !$scan_status; # no viruses, no errors + } + } elsif ($result->infected) { + $scan_status = 1; # virus(es) found, no errors + my($msg) = "INFECTED $fname: " . join(", ",$result->viruses); + $output .= $msg.$eol; do_log(2,"$av_name result: $msg"); + push(@virusname, $result->viruses); + } else { + $scan_status = 0 if !$scan_status; # no viruses, no errors + } + } + closedir(DIR) or Amavis::Util::cleanup_and_die "Can't close directory: $!"; + if (!$cnt) { $scan_status = 0 } # no errors, no viruses + do_log(3,"$av_name result: clean") if !$scan_status; + ($scan_status,$output,\@virusname); +} + +# same args and returns as run_av() below, +# but prepended by a $query, which is the string to be sent to the daemon. +# Handles both UNIX and INET 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, $tempdir, + $av_name, $command, $args, + $sts_clean, $sts_infected, $how_to_get_names, # regexps + ) = @_; + my($query_template,$sockets) = @$args; + my($scan_status,$output,@virusname); my($socketname,$is_inet); + if (!ref($sockets)) { $sockets = [ $sockets ] } + my($max_retries) = 3 * @$sockets; my($retries) = 0; + $SIG{PIPE} = 'IGNORE'; # 'send' to broken pipe throws a signal + for (;;) { # gracefully handle cases when av child times out or restarts + @$sockets >= 1 or die "no sockets specified!?"; # sanity + $socketname = $sockets->[0]; # try the first one in the current list + $is_inet = $socketname =~ m{^/} ? 0 : 1; + eval { + if (!$st_socket_created{$socketname}) { + do_log(3, "$av_name: Connecting to socket " . + join(' ',$daemon_chroot_dir,$socketname) . + (!$retries ? '' : ", retry #$retries") ); + if ($is_inet) { # inet socket + $st_sock{$socketname} = IO::Socket::INET->new($socketname) + or die "Can't connect to INET socket $socketname: $!\n"; + $st_socket_created{$socketname} = 1; + } else { # unix socket + $st_sock{$socketname} = IO::Socket::UNIX->new( + Type => SOCK_STREAM) + or die "Can't create UNIX socket: $!\n"; + $st_socket_created{$socketname} = 1; + $st_sock{$socketname}->connect( + pack_sockaddr_un($socketname) ) + or die "Can't connect to UNIX socket $socketname: $!\n"; + } + } + do_log(3, sprintf("$av_name: Sending %s to %s socket $socketname", + $query, $is_inet ? "INET" : "UNIX")); + # UGLY: bypass send method in IO::Socket to be able to retrieve + # status/errno directly from 'send', not from 'getpeername': + defined send($st_sock{$socketname}, $query, 0) + or die "Can't send to socket $socketname: $!\n"; + if ($av_name =~ /^(Sophie|Trophie)/i) { + # Sophie and Trophie can accept multiple requests per session + # and return a single line response each time + defined $st_sock{$socketname}->recv($output, 1024) + or die "Can't receive from socket $socketname: $!\n"; + } else { + $output = join('', $st_sock{$socketname}->getlines); + $st_sock{$socketname}->close + or die "Can't close socket $socketname: $!\n"; + $st_sock{$socketname}=undef; $st_socket_created{$socketname}=0; + } + $! = undef; + $output ne '' or die "Empty result from $socketname\n"; + }; + last if $@ eq ''; + # error handling (most interesting error codes are EPIPE and ENOTCONN) + chomp($@); my($err) = "$!"; my($errn) = 0+$!; + ++$retries <= $max_retries + or die "Too many retries to talk to $socketname ($@)"; + # is ECONNREFUSED for INET sockets common enough too? + if ($retries <= 1 && $errn == EPIPE) { # common, don't cause concern + do_log(2,"$av_name broken pipe (don't worry), retrying ($retries)"); + } else { + do_log( ($retries>1?0:1), "$av_name: $@, retrying ($retries)"); + if ($retries % @$sockets == 0) { # every time the list is exhausted + my($dly) = min(20, 1 + 5 * ($retries/@$sockets - 1)); + do_log(3,"$av_name: sleeping for $dly s"); + sleep($dly); # slow down a possible runaway + } + } + if ($st_socket_created{$socketname}) { + # prepare for a retry, ignore 'close' status + $st_sock{$socketname}->close; + $st_sock{$socketname} = undef; $st_socket_created{$socketname} = 0; + } + # leave working socket as the first entry in the list + # so that it will be tried first when needed again + push(@$sockets, shift @$sockets) if @$sockets>1; # circular shift left + } + do_log(3,"$av_name result: $output"); + if ($output =~ /$sts_infected/m) { + @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/m) { + $scan_status = 0; # no errors, no viruses + } else { + do_log(0,"$av_name FAILED - unknown status: $output"); + } + ($scan_status,$output,\@virusname); +} + +# same args and returns as run_av() below +sub ask_daemon { + my($tempdir,$av_name,$command,$args) = @_; + ref $args eq 'ARRAY' + or die "The field#3 in the \@av_scanners entry is not an array ref"; + my($query_template) = $args->[0]; + $query_template =~ s[{}][$tempdir/parts]g; # replace {} with dir name + if ($query_template !~ /\*/) { # scanner can be given a directory name + return ask_daemon_internal($query_template, @_); + } else { # must check each file individually + my($scan_status,@virusname); my($output) = ''; + local(*DIR); my($f); my($cnt) = 0; + opendir(DIR, "$tempdir/parts") + or die "Can't open directory $tempdir/parts: $!"; + while (defined($f = readdir(DIR))) { + my($fname) = "$tempdir/parts/$f"; + my($errn) = stat($fname) ? 0 : 0+$!; + next if $errn == ENOENT; + if ($errn) { die "ask_daemon: $fname inaccessible: $!" } + if (!-r _) { die "ask_daemon: $fname not readable" } + next if -d _ && ($f eq '.' || $f eq '..'); # this or parent dir + next if -z _; # empty file + $cnt++; do_log(5, "$av_name: checking $fname"); + my($query_template_exp) = $query_template; + $query_template_exp =~ s[\*][$f]g; # replace * with bare file name + my($t_scan_status,$t_output,$t_virusnames) = + ask_daemon_internal($query_template_exp, @_); + if ($t_scan_status) { # virus(es) found in one part + $scan_status = $t_scan_status; # virus(es) found, no errors + do_log(3,"$av_name result: $t_output"); + $output .= $t_output . $eol; + push(@virusname, @$t_virusnames); + } elsif (!defined $t_scan_status) { + last; # error, bail out + } else { + $scan_status = 0 if !$scan_status; # no viruses, no errors + } + } + closedir(DIR) or die "$av_name: Can't close directory: $!"; + if (!$cnt) { $scan_status = 0 } # no errors, no viruses + do_log(3,"$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: +# - true if virus found, +# - 0 if no viruses found, +# - undef if it did not complete its jobs; +# the second element is a string, the text as output 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) +# +sub run_av { + my( $tempdir, # this arg is extra, not part of n-tuple + $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); my($output) = ''; + &$pre_code(@_) if defined $pre_code; + if (ref($command) eq 'CODE') { + do_log(3,"Using $av_name: (built-in interface)"); + ($scan_status,$output,$virusnames) = &$command(@_); } else { - my @x = map { trim($_) } $entry->get_value($self->{res_attr}); - my @f = map { my $f = $self->{res_filter}; $f =~ s/%r/$_/g; $f } @x; - $llog->(5, "list match: %s (%s)", join (", ", @x), join (", ", @f)); - return wantarray ? @f : \@f; + my(@args) = split(' ',$args); + if (grep { m{^({}/)?\*$(?!\n)} } @args) { # list each file individually + local(*DIR); my($f); my(@bare_fnames); + opendir(DIR, "$tempdir/parts") + or die "Can't open directory $tempdir/parts: $!"; + while (defined($f = readdir(DIR))) { + my($fname) = "$tempdir/parts/$f"; + my($errn) = stat($fname) ? 0 : 0+$!; + next if $errn == ENOENT; + if ($errn) { die "run_av: $fname inaccessible: $!" } + if (!-r _) { die "run_av: $fname not readable" } + next if -d _ && ($f eq '.' || $f eq '..'); #this or parent dir + next if -z _; # empty file + if ($f =~ /^([A-Za-z0-9_.-]+)$(?!\n)/s) { push(@bare_fnames,$1) } + else { do_log(0, "run_av: WARN: refused to untaint: $f") } + } + closedir(DIR) or die "$av_name: Can't close directory: $!"; + # replace * with bare file name + for my $a (@args) { + $a =~ s[^({}/)?\*$(?!\n)][join(' ',map {$1.$_} @bare_fnames)]e; } - } else { - $llog->(5, "attribute does not exists, no match"); } + for (@args) { s[{}][$tempdir/parts]g } # replace {} with directory name + # NOTE: RAV does not like 'getline) ) { $output .= $_ } + my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?); + chomp($output); my($output_trimmed) = $output; + $output_trimmed =~ s/([ \t\n\r])[ \t\n\r]{4,}/$1.../gs; + $output_trimmed = "..." . substr($output_trimmed,-900) + if length($output_trimmed) > 900; + do_log(3, "run_av: $command status=$retval ($? $err),$output_trimmed"); + # test for infected first, in case both expressions match + if (ref($sts_infected) eq 'ARRAY' ? (grep {$_==$retval} @$sts_infected) + : $output =~ /$sts_infected/m) { # is infected + $virusnames = []; # get a list of virus names by parsing output + @$virusnames = ref($how_to_get_names) eq 'CODE' + ? &$how_to_get_names($output) + : $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/m) { # is clean + $scan_status = 0; # 'false' (but defined) indicates no viruses + do_log(5,"run_av: clean"); } else { - $llog->(5, "address not found, no match"); + do_log(0,"Virus scanner failure: $command (exit status: $retval)"); } - return undef + $output = $output_trimmed if length($output) > 900; } - -sub lookup_ldap { - my $self = shift; - my ($addr) = @_; - my $llog = sub { - my $level = shift; - my $template = shift; - my $prefix = __PACKAGE__."::lookup_ldap ($addr)"; - do_log($level, sprintf("$prefix - $template", @_)); - }; - my $log_prefix = __PACKAGE__ . "::lookup_ldap($addr) -"; - my ($taint) = substr($addr,0,0); - my ($localpart, $domain) = split_address($addr); - my $res; - $domain = lc($domain); - $localpart = lc($localpart) unless $localpart_is_case_sensitive; - # chop off leading @, and trailing dots - if ($domain =~ /^\@?(.*?)\.*$(?!\n)/s) { $domain = $1.$taint } - my $extension; - if ($recipient_delimiter ne '') { - ($localpart, $extension) = - split_localpart($localpart, $recipient_delimiter); + &$post_code(@_) if defined $post_code; + $virusnames = [] if !defined $virusnames; + @$virusnames = (undef) if $scan_status && !@$virusnames; # nonnil + ($scan_status, $output, $virusnames); } - if ($extension ne '') { # user+foo@example.com - $res = $self->lookup_ldap_exact ($localpart.$recipient_delimiter. - $extension.'@'.$domain); - if (defined $res) { return $res } + +sub virus_scan($$) { + my($tempdir,$firsttime) = @_; + my($scan_status,$output,@virusname,@detecting_scanners); + my($anyone_done); my($anyone_tried); + my(@errors); my($j); my($tier) = 'primary'; + for my $av (@av_scanners, "\000", @av_scanners_backup) { + if ($av eq "\000") { # 'magic' separator between lists + last if $anyone_done; + do_log(0,"WARN: all $tier virus scanners failed, trying backups"); + $tier = 'secondary'; next; } - $res = $self->lookup_ldap_exact($localpart.'@'.$domain); # user@example.com - if (defined $res) { return $res } - if (Amavis::Lookup::lookup($addr, \%local_domains, - \@local_domains_acl, $local_domains_re)) { - if ($extension ne '') { # user+foo - $res = $self->lookup_ldap_exact($localpart.$recipient_delimiter. - $extension); - if (defined $res) { return $res } + next if !defined $av || !ref $av || !defined $av->[1]; + $anyone_tried++; + my($this_status,$this_output,$this_vn); + eval { ($this_status,$this_output,$this_vn) = run_av($tempdir,@$av) }; + if ($@ ne '') { + # joe 3-1-06 b6149 - don't display the AV scanner errors + # if it failed, just say it failed (but log the error detail) + my($err) = $@; chomp($err); + my $displayerr = "$av->[0] av-scanner FAILED"; + $err = $displayerr . ": $err"; + do_log(0,$err); push(@errors,$displayerr); + $this_status = undef; + }; + $anyone_done++ if defined $this_status; + $scan_status = $this_status if !defined $scan_status || $this_status; + $output = $this_output if !defined $output; + $j++; section_time("AV-scan-$j"); + if ($this_status) { # virus detected + push(@detecting_scanners, $av->[0]); + if (!@virusname) # store results of the first scanner detecting + { @virusname = @$this_vn; $output = $this_output } + ### last; # Want to stop if we found a virus? Naah! } - $res = $self->lookup_ldap_exact ($localpart); # user - if (defined $res) { return $res } } - $res = $self->lookup_ldap_exact ('@'.$domain); # @example.com - if (defined $res) { return $res } - $res = $self->lookup_ldap_exact ('@.'); # @. (catchall) - return $res + if (!$anyone_tried) { die "NO VIRUS SCANNERS AVAILABLE\n" } + elsif (!$anyone_done) + { die ("ALL VIRUS SCANNERS FAILED: ".join("; ",@errors)."\n") } + ($scan_status, $output, \@virusname, \@detecting_scanners); # return a quad } 1; __DATA__ -# -package Amavis::In::AMCL; +package Amavis::SpamControl; use strict; BEGIN { @@ -7298,1257 +10021,1827 @@ $VERSION = '1.15'; @ISA = qw(Exporter); } - -use subs @EXPORT; -use Errno qw(ENOENT); -use IO::File; +use lib '/home/emailswitch/code/firmware/current/lib/perl5'; +use lib '/home/emailswitch/code/firmware/current/lib/perl5/site_perl'; +use lib '/home/emailswitch/spamdef/current/lib/perl5/site_perl'; +use FileHandle; +use Mail::SpamAssassin; +use Mail::SpamAssassin::NoMailAudit; +use Fcntl qw(:flock); BEGIN { - import Amavis::Conf qw(:platform :confvars); - import Amavis::Util qw(do_log am_id debug_oneshot rmdir_recursively); - import Amavis::Lookup qw(lookup); - import Amavis::Timing qw(section_time); + import Amavis::Conf qw(:platform :sa $log_level + %whitelist_sender @whitelist_sender_acl $whitelist_sender_re + %blacklist_sender @blacklist_sender_acl $blacklist_sender_re + $banned_filename_re $quarantined_filename_re + @local_domains_acl %local_domains + $per_recip_whitelist_sender_lookup_tables + $per_recip_blacklist_sender_lookup_tables + $default_encoding); + import Amavis::Util qw(do_log set_debug_id do_debug_log prolong_timer cleanup_and_die); import Amavis::rfc2821_2822_Tools; - import Amavis::In::Message; - import Amavis::In::Connection; - import Amavis::rfc2821_2822_Tools qw(/^EX_/); + import Amavis::Timing qw(section_time); + import Amavis::Lookup qw(lookup); + import Amavis::Unpackers qw(check_for_banned_filenames); } -sub new($) { my($class) = @_; bless {}, $class } - -# Accept a single request for virus checking via UNIX socket from amavis client -# (used with sendmail milter and traditional (non-SMTP) MTA interface) -# -sub process_amavis_client_request($$$) { - my($self, $sock, $conn, $check_mail) = @_; - # $sock: connected socket from Net::Server - # $conn: information about client connection - # $check_mail: subroutine ref to be called with file handle +use subs @EXPORT_OK; - my($msginfo) = Amavis::In::Message->new; +use vars qw($spamassasin_obj); - my($fh,$tempdir); - my($protocol_succeeded) = 0; # got all data from amavis client - my($which_section) = "initialization"; - eval { - my($inbuff); +############ # - # Receive TEMPDIR/SENDER/RCPTS/LDA/LDAARGS from client +# Theory of operation for the $HIT_CLASS, $HIT_TYPE, $HIT_REGEXP # - my $yval = "\1"; # value to return to the client if AOK +# $HIT_TYPE contains 0, whitelist, block, tag, or quarantine depending on the type of hit independent +# of the module that defense layer that caused the hit +# $HIT_CLASS tells us what layer (module) caused the hit +# $HIT_REGEXP contains a text_streing for those layers that need to return a pattern +# +# This allows us to easily support block, quarantine, or tag on any of the layers for example +# bfs can not quarantine, spf can now quarantine. - $which_section = "RX_tempdir"; - defined(recv($sock, $inbuff, 8192, 0)) or die "recv (1) failed: $!"; - local($1,$2); - $inbuff =~ /^( (?: \Q$TEMPBASE\E | \Q$MYHOME\E ) - \/ (?! .* \.{2,} .*) [A-Za-z0-9_.-]+ ) $(?!\n)/xso - or die "Invalid temporary directory '$inbuff'"; - $tempdir = $1; # untaint the directory name - # set new amavis message id - am_id( ($tempdir =~ /amavis-(milter-)?(.+?)$(?!\n)/s ? $2 : undef) ); - defined(send($sock, $yval, 0)) or die "send ack (1) failed: $!"; +# this will also make it easier to short circuit later modules that have no hope of obtaining a more +# lethal hit on the email. +# - $which_section = "RX_sender"; - defined(recv($sock, $inbuff, 8192, 0)) or die "recv (2) failed: $!"; - defined(send($sock, $yval, 0)) or die "send ack (2) failed: $!"; - $inbuff = unquote_rfc2821_local($inbuff) if $gets_addr_in_quoted_form; - $msginfo->sender($inbuff); - debug_oneshot(1) if lookup($msginfo->sender,\@debug_sender_acl); +# constant used by $HIT_CLASS +use constant CLASS_SUBJECT => 1; +use constant CLASS_HEADER => 2; +use constant CLASS_BODY => 3; +use constant CLASS_BFS => 4; +use constant CLASS_SPF => 5; +use constant CLASS_RBL => 6; +use constant CLASS_FP => 7; +use constant CLASS_BRL => 9; +use constant CLASS_DKIM => 10; - # Simple "protocol" - # \2 means LDA; \3 means EOT (end of transmission) +# constants used by $HIT_TYPE +use constant TYPE_WHITELIST => 1; +use constant TYPE_TAG => -1; +use constant TYPE_QUARANTINE => -2; +use constant TYPE_BLOCK => -3; - $which_section = "RX_recipients"; - my(@recips); my(@ldaargs); - my($outvar) = \@recips; - for (;;) { - defined(recv($sock,$inbuff,8192,0)) or die "recv (3) failed: $!"; - last if ($inbuff eq "\3"); - if ($inbuff eq "\2") { - $outvar = \@ldaargs; - $which_section = "RX_LDA"; - } else { - $inbuff = unquote_rfc2821_local($inbuff) - if $gets_addr_in_quoted_form && $outvar==\@recips; - push(@$outvar, $inbuff); - } - defined(send($sock, $yval, 0)) or die "send ack (3) failed: $!"; - } - $msginfo->recips(\@recips); $msginfo->rx_time(time); - $protocol_succeeded = 1; # protocol obtained all required data - # amavis client is now expecting final status code +# Upper limit on URLS for intent checks. +use constant MAX_INTENT_URLS => 1000; - $which_section = "opening_mail_file"; - # created by amavis client, just open it - $fh = IO::File->new("$tempdir/email.txt",'<') - or die "Can't open file $tempdir/email.txt: $!"; - binmode($fh,":bytes") - or die "Can't cancel :utf8 mode: $!" if $unicode_aware; - $msginfo->mail_text($fh); - section_time('got data'); - do_log(1, sprintf("AM.CL %s: <%s> -> %s", $tempdir, $msginfo->sender, - join(',', map{"<$_>"}@recips) )); - }; - my($smtp_resp, $exit_code, $preserve_evidence); - if ($@ ne '') { - chomp($@); - do_log(0,"$which_section FAILED, retry: " . $@); - $fh->close if $fh; - $fh = undef; $msginfo->mail_text(undef); - $exit_code = EX_TEMPFAIL; - # keep directory for inspection - } else { - # check_mail() expects open file on $fh, need not be rewound - ($smtp_resp, $exit_code, $preserve_evidence) = - &$check_mail($conn,$msginfo,0,$tempdir); - $fh->close or die "Can't close temp file: $!" if $fh; - $fh = undef; $msginfo->mail_text(undef); - my($errn) = $tempdir eq '' ? ENOENT : (stat($tempdir) ? 0 : 0+$!); - if ($tempdir eq '' || $errn == ENOENT) { - # do nothing - } elsif ($preserve_evidence) { - do_log(0, "tempdir is to be PRESERVED: $tempdir"); - } else { - do_log(4, "tempdir being removed: $tempdir"); - rmdir_recursively($tempdir); +my $record_intent_match_info = 0; + +# called at startup, before the main fork +sub init() { + do_log(1, "SpamControl: initializing Mail::SpamAssassin"); + my($saved_umask) = umask; + $spamassasin_obj = Mail::SpamAssassin->new({ + debug => $sa_debug, + save_pattern_hits => $sa_debug, + dont_copy_prefs => 1, + local_tests_only => $sa_local_tests_only, + home_dir_for_helpers => $helpers_home, + stop_at_threshold => 0, +# DEF_RULES_DIR => '/usr/local/share/spamassassin', +# LOCAL_RULES_DIR => '/etc/mail/spamassassin', + }); + if ($sa_auto_whitelist) { # setup SpamAssassin auto-whitelisting + do_log(1, "SpamControl: turning on SA auto-whitelisting (AWL)"); + # create a factory for the persistent address list + my($addrlstfactory) = Mail::SpamAssassin::DBBasedAddrList->new; + $spamassasin_obj->set_persistent_address_list_factory($addrlstfactory); } - if ($forward_method eq '' && $exit_code == EX_OK) { # e.g. milter - # when forwarding is left for MTA on the input side to do, - # warn if there is anything that should be done, but MTA is not - # capable of doing (or a helper program can not pass the request) - my($any_deletes); - for my $r (@{$msginfo->per_recip_data}) { - my($addr,$newaddr) = ($r->recip_addr, $r->recip_final_addr); - if ($r->recip_done) { - do_log(0, "WARN: recip addr <$addr> should be removed, but MTA can't do it"); - $any_deletes++; - } elsif ($newaddr ne $addr) { - do_log(0, "WARN: recip addr <$addr> should be replaced with <$newaddr>, but MTA can't do it"); + $spamassasin_obj->compile_now; # ensure all modules etc. are preloaded + alarm(0); # seems like SA forgets to clear alarm in some cases + umask($saved_umask); # restore our umask + + # dk: initialize intent database + if ( $Amavis::Conf::scana_use_bfs < 0 ) + { + require Barracuda::Intent; + our $intent_obj; + undef $intent_obj; + $intent_obj = Barracuda::Intent ->new; + if ($intent_obj) { + my @errs = $intent_obj->clear_errors; + foreach my $err (@errs) { + do_log(0, $err); } + } else { + # Couldn't instantiate Barracuda::Intent object. + do_log(0, "Couldn't instantiate Barraucda::Intent; is " + . "intent-cache-server running? Do the expected files " + . "exist in /mail/intent?"); } - if ($any_deletes) { - do_log(0, "WARN: REJECT THE WHOLE MESSAGE, MTA-in can't do the recips deletion"); - $exit_code = EX_UNAVAILABLE; } + + do_log(1, "SpamControl: done"); } + +# check envelope sender if white or blacklisted by each recipient, +# as well as the sender in the from header +# Saves the result in recip_blacklisted_sender and recip_whitelisted_sender +# properties of each recipient object. +# +sub white_black_list($$$$) { + my($conn,$msginfo,$sql_wblist,$user_id_sql) = @_; + my($any_w)=0; my($any_b)=0; my($all)=1; my($wr,$br); + my($msg) = ''; + + # If we don't have an envelope sender then just leave + return if(!$msginfo->sender); + + # Build the list of possible senders ... this should + # be the envelope as well as the from header if we could + # get it + my (@possible_senders) = ($msginfo->sender); + + # Get the envelope sender address and try to get a from address + # out of it + my ($from_sender) = $msginfo->mime_entity->head->get('From'); + if( $from_sender ) + { + my ($user, $domain); + $from_sender =~ s/^\s(\S*)\s$/$1/g; + + if($from_sender =~ /^([^\s\@]+)\@([\d\w\-\.]+)$/) { + $user = $1; + $domain = $2; + } elsif ($from_sender =~ /^[^<>]*<([^\s\@<>]+)\@([\d\w\-\.]+)>$/) { + $user = $1; + $domain = $2; + } elsif($from_sender =~ /^"([^"]+)"\@([\d\w\-\.]+)$/) { + $user = $1; + $domain = $2; + } elsif ($from_sender =~ /^[^<>]*<"([^"]+)"\@([\d\w\-\.]+)>$/) { + $user = $1; + $domain = $2; + } + + do_log(4, "adding '$user'\@'$domain' to list to check"); + + # If we have a user and domain, then use it ... but only + # if it doesn't match the envelope address + if( $user && $domain ) + { + if( "$user\@$domain" ne $msginfo->sender ) + { + push(@possible_senders, "$user\@$domain"); } - if ($mta_in_type eq 'qmail' && $exit_code == EX_TEMPFAIL) { - $exit_code = 81; # qmail is different?! } - do_log(3, "mail checking ended: exit_code=$exit_code ($smtp_resp)"); - send($sock, $exit_code, 0) if $protocol_succeeded; } -1; - -__DATA__ -# -package Amavis::In::SMTP; -use strict; + my $sender; + foreach $sender (@possible_senders) + { + do_log(4, "white_black_list: checking sender <$sender>"); + next if !$sender; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - $VERSION = '1.15'; - @ISA = qw(Exporter); -} -use POSIX qw(strftime); -use Errno qw(ENOENT); -use Time::HiRes qw(time); + for my $r (@{$msginfo->per_recip_data}) + { + next if $r->recip_done; # already dealt with + my($recip) = lc($r->recip_addr); -BEGIN { - import Amavis::Conf qw(:platform :confvars); - import Amavis::Util qw(do_log am_id prolong_timer debug_oneshot - sanitize_str strip_tempdir rmdir_recursively); - import Amavis::Lookup qw(lookup); - import Amavis::Timing qw(section_time); - import Amavis::rfc2821_2822_Tools; - import Amavis::In::Message; - import Amavis::In::Connection; + my($wb,$user_id); + if( $Amavis::default_domain && $Amavis::default_domain ne '') + { + $recip =~ s/(?:\@.*|$)/\@$Amavis::default_domain/; } -sub new($) { - my($class) = @_; - my($self) = bless {}, $class; - $self->{proto} = undef; # currently doing SMTP / ESMTP / LMTP - $self->{pipelining} = undef; # may we buffer responses? - $self->{smtp_outbuf} = undef; # SMTP responses buffer for PIPELINING - $self->{fh_pers} = undef; # persistent file handle for email.txt - $self->{tempdir_persistent} = undef;# temporary directory for check_mail - $self->{preserve} = undef; # don't delete tempdir on exit - $self->{tempdir_empty} = 1; # anything of interest in tempdir? - $self->{session_closed_normally} = undef; # closed properly with QUIT - $self; + if( defined($sql_wblist) && defined($user_id=lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip,$user_id_sql)) ) + { + $wb = lookup($sender, Amavis::Lookup::SQLfield->new( + $sql_wblist,'wb','S',$user_id) ); + if (!defined($wb) || $wb =~ /^[ \000]*$(?!\n)/) + { + # not specified (space) + $wb = undef; } - -sub preserve_evidence # try to preserve temporary files etc in case of trouble - { my($self)=shift; !@_ ? $self->{preserve} : ($self->{preserve}=shift) } - -sub DESTROY { - my($self) = shift; -# do_log(0, "Amavis::In::SMTP::DESTROY called"); - $self->{fh_pers}->close - or die "Can't close temp file: $!" if $self->{fh_pers}; - my($errn) = $self->{tempdir_pers} eq '' ? ENOENT - : (stat($self->{tempdir_pers}) ? 0 : 0+$!); - if (defined $self->{tempdir_pers} && $errn != ENOENT) { - # this will not be included in the TIMING report, - # but it only occurs infrequently and doesn't take that long - if ($self->preserve_evidence && !$self->{tempdir_empty}) { - do_log(0, "tempdir is to be PRESERVED: ".$self->{tempdir_pers}); - } else { - do_log(2, "tempdir being removed: ".$self->{tempdir_pers}); - rmdir_recursively($self->{tempdir_pers}); + elsif( $wb =~ /^[BbNnFf0][ ]*$(?!\n)/ ) + { + # blacklisted (B or N) + $wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1); + do_log(5,"white_black_list: (SQL) recip <$recip> blacklisted sender <$sender>"); } + else + { + # whitelisted (W or Y) + $wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1); + do_log(5,"white_black_list: (SQL) recip <$recip> whitelisted sender <$sender>"); } - if (! $self->{session_closed_normally}) { - $self->smtp_resp(1,"421 4.3.2 Service shutting down, closing channel"); } + + if (!defined($wb)) + { + # sender can be both white- and blacklisted at the same time + if (lookup($sender, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip,$per_recip_blacklist_sender_lookup_tables), + \%blacklist_sender, \@blacklist_sender_acl, + $blacklist_sender_re)) + { + $wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1); + do_log(5,"white_black_list: recip <$recip> blacklisted sender <$sender>"); } -sub prepare_tempdir($) { - my($self) = @_; - if (! defined $self->{tempdir_pers} ) { - # invent a name for a temporary directory for this child, and create it - my($now_iso8601) = strftime("%Y%m%dT%H%M%S", localtime); - $self->{tempdir_pers} = sprintf("%s/amavis-%s-%05d", - $TEMPBASE, $now_iso8601, $$); + if (lookup($sender, + lookup($Amavis::PU_REAL_EMAIL_MAP{$recip} || $recip,$per_recip_whitelist_sender_lookup_tables), + \%whitelist_sender, \@whitelist_sender_acl, + $whitelist_sender_re)) + { + $wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1); + do_log(5,"white_black_list: recip <$recip> whitelisted sender <$sender>"); } - my($errn) = stat($self->{tempdir_pers}) ? 0 : 0+$!; - if ($errn == ENOENT || ! -d _) { - do_log(4,"prepare_tempdir: creating directory ".$self->{tempdir_pers}); - mkdir($self->{tempdir_pers}, 0750) - or die "Can't create directory $self->{tempdir_pers}: $!"; - $self->{tempdir_empty} = 1; - section_time('mkdir tempdir'); } - # prepare temporary file for writing (and reading later) - my($fname) = $self->{tempdir_pers} . "/email.txt"; - my($errn) = stat($fname) ? 0 : 0+$!; - if ($self->{fh_pers} && !$errn && -f _) { - $self->{fh_pers}->seek(0,0) or die "Can't rewind mail file: $!"; - $self->{fh_pers}->truncate(0) or die "Can't truncate mail file: $!"; - } else { - do_log(4,"prepare_tempdir: creating file $fname"); - # use '+>' instead of 'w+' to avoid Perl taint bug ($mode gets tainted, - # still in 5.8.2) triggered by expr in IO::Handle::_open_mode_string() - $self->{fh_pers} = IO::File->new($fname, '+>', 0640) - or die "Can't create file $fname: $!"; - section_time('create email.txt'); } } - -# Accept a SMTP or LMTP connect (which can do any number of SMTP transactions, -# but usually does one) and call content checking for each message received -# -sub process_smtp_request($$$$) { - my($self, $sock, $lmtp, $conn, $check_mail) = @_; - # $sock: connected socket from Net::Server - # $lmtp: use LMTP protocil instead of (E)SMTP - # $conn: information about client connection - # $check_mail: subroutine ref to be called with file handle - - my($msginfo); - $self->{pipelining} = 0; # may we buffer responses? - $self->{smtp_outbuf} = []; # SMTP responses buffer for PIPELINING - - my($myheloname); -# $myheloname = $myhostname; -# $myheloname = 'localhost'; -# $myheloname = '[127.0.0.1]'; - $myheloname = '[' . $conn->socket_ip . ']'; - - my($sender,@recips); my($got_rcpt); - $conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'SMTP'); - $self->smtp_resp(1, "220 $myheloname " . ($lmtp ? 'LMTP' : 'ESMTP') . - " amavisd-new service ready"); - my($terminating,$aborting,$eof,$voluntary_exit); my($seq) = 0; undef $!; - while(<$sock>) { - prolong_timer('reading SMTP command'); - { # a block is used as a 'switch' statement - 'last' will exit from it - local($1,$2); my($cmd) = $_; my($taint) = substr($cmd,0,0); - do_log(4, $self->{proto} . "< $cmd"); - !/^ \s* ([A-Za-z]+) (?: \s+ (.*?) )? \s* \015\012 $(?!\n)/xs && do { - $self->smtp_resp(1,"500 5.5.2 Error: bad syntax", 1, $cmd); last; - }; - $_ = uc($1).$taint; my($args) = $2.$taint; - /^RSET|DATA|QUIT$/ && $args ne '' && do { - $self->smtp_resp(1,"501 5.5.4 Error: $_ does not accept arguments", 1,$cmd); - last; - }; - /^RSET$/ && do { $sender = undef; @recips = (); $got_rcpt = 0; - $msginfo = undef; # forget previous - $self->smtp_resp(0,"250 2.0.0 Ok $_"); last }; - /^NOOP$/ && do { $self->smtp_resp(1,"250 2.0.0 Ok $_"); last }; - /^QUIT$/ && do { - $self->smtp_resp(1,"221 2.0.0 $myheloname (amavisd) closing transmission channel"); - $terminating=1; last; - }; -### !$lmtp && /^HELO$/ && do { # strict - /^HELO$/ && do { - $sender = undef; @recips = (); $got_rcpt = 0; # implies RSET - $msginfo = undef; # forget previous - $self->{pipelining} = 0; $self->smtp_resp(0,"250 $myheloname"); - $lmtp = 0; $conn->smtp_proto($self->{proto} = 'SMTP'); - $conn->smtp_helo($args); section_time('SMTP HELO'); last; - }; -### (!$lmtp && /^EHLO$/ || $lmtp && /^LHLO$/) && do { # strict - (/^EHLO$/ || /^LHLO$/) && do { - $sender = undef; @recips = (); $got_rcpt = 0; # implies RSET - $msginfo = undef; # forget previous - $lmtp = /^EHLO$/ ? 0 : 1; - $conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'ESMTP'); - $self->{pipelining} = 1; - $self->smtp_resp(0,"250 $myheloname\n" . join("\n", - qw(PIPELINING SIZE 8BITMIME ENHANCEDSTATUSCODES))); - $conn->smtp_helo($args); section_time("SMTP $_"); - last; - }; - /^VRFY$/ && do { - $self->smtp_resp(1,"502 5.5.1 Command $_ not implemented", 1, $cmd); - # if ($args eq '') { - # $self->smtp_resp(1,"501 5.5.2 Syntax: VRFY address", 1, $cmd); - # } else { - # $self->smtp_resp(1,"252 2.0.0 Cannot VRFY user, but will accept ". - # "message and attempt delivery", 1, $cmd); - # } - last; - }; - /^HELP$/ && do { - $self->smtp_resp(1,"214 2.0.0 See amavisd-new home page at:\n". - "http://www.ijs.si/software/amavisd/"); - last; - }; - /^MAIL$/ && do { # begin new transaction - if (defined($sender)) { - $self->smtp_resp(0,"503 5.5.1 Error: nested MAIL command", 1, $cmd); + # did all recips mark it someway? + # this wouldn't be needed if we reversed the loop order and made @recip the outer loop + # this would also reduce the number of sql queries from num_senders*num_recips to num_recips + for my $r (@{$msginfo->per_recip_data}) + { + next if $r->recip_done; # already dealt with + next if $r->recip_whitelisted_sender; + next if $r->recip_blacklisted_sender; + $all = 0; # someone still needs it scanned last; } - # begin SMTP transaction - prolong_timer('MAIL FROM received - timer reset', $child_timeout); - if (!$seq) {# the first connect - section_time('SMTP pre-MAIL'); - } else { # establish new time reference for each transaction - Amavis::Timing::init(); - } - $seq++; - am_id(sprintf("%05d-%02d%s", $$, - $Amavis::child_invocation_count, ($seq>1 ? "-$seq" : ""))); - $self->prepare_tempdir; - $msginfo = Amavis::In::Message->new; - $msginfo->rx_time(time); - # permit some sloppy syntax without angle brackets - if ($args !~ /^FROM: \s* - ( < (?: " (?: \\. | [^\\"] )* " | [^"@] )* - (?: @ (?: \[ (?: \\. | [^\]\\] )* \] | - [^\[\]\\>] )* )? - > | - [^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )* - ) (?: \s+ ([\040-\176]+) )? $(?!\n)/isx ) { - $self->smtp_resp(0,"501 5.5.2 Syntax: MAIL FROM:
", 1, $cmd); - last; + if ($all) + { + if($any_w) + { + if ($any_b) { $msg = "whitelisted or blacklisted by all recips"; } + else { $msg = "whitelisted by all recips";} } - local($1,$2); my($addr,$opt) = ($1.$taint,$2.$taint); my($bad); - for (split(' ',$opt)) { - if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* ) = - ( [\041-\074\076-\176]+ ) $(?!\n)/x) {#printable, no =,SP - $self->smtp_resp(0,"501 5.5.4 Syntax error in MAIL FROM parameters", - 1, $cmd); - $bad = 1; last; - } else { - my($name,$val) = (uc($1).$taint, $2.$taint); - if ($name eq 'SIZE' && $val=~/^\d{1,20}$/) { - $msginfo->msg_size($val+0); - } elsif ($name eq 'BODY' && $val=~/^7BIT|8BITMIME$/i) { - $msginfo->body_type(uc($val)); - } else { - $self->smtp_resp(0,"504 5.5.4 MAIL command parameter error: ". - "$name=$val", 1, $cmd); - $bad = 1; last; + elsif($any_b) + { + $msg = "blacklisted by all recips"; + } + } + elsif ($any_b || $any_w) + { + $msg.="whitelisted by ".($any_w>1?"$any_w recips, ":"$wr, ") if $any_w; + $msg.="blacklisted by ".($any_b>1?"$any_b recips, ":"$br, ") if $any_b; + $msg.="but not by all,"; } + + do_log(2,"white_black_list: $msg sender <$sender>") if $msg ne ''; + ($any_w+$any_b, $all); } + + +# Finds the first \r\n\r\n combo and returns everything below it. +sub get_body_minus_headers($){ + my $full_body = shift; + my $body_minus_headers; + my $after_flag = 0; + + $body_minus_headers = [map { $_=~/.*?\r{0,1}\n\s*\r?\n(.*)/s; my $tmp = $1; $tmp ? $tmp : $_ } @$full_body] ; + + return $body_minus_headers; } - if (!$bad) { - $addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr; - $self->smtp_resp(0,"250 2.1.0 Sender $addr OK"); - $sender = unquote_rfc2821_local($addr); - debug_oneshot(lookup($sender,\@debug_sender_acl)?1:0, - $self->{proto} . "< $cmd"); - }; - last; - }; - /^RCPT$/ && do { - if (!defined($sender)) { - $self->smtp_resp(0,"503 5.5.1 Need MAIL command before RCPT", 1, $cmd); - $sender = undef; @recips = (); $got_rcpt = 0; - last; + +sub eat_msg_headers{ + my $fh = shift; + my $lines = shift; + my $SA_bayes_scan_msg = shift; + + + GET_HEADERS: + while( my $line = <$fh> ){ + # Read the headers out of the file handle + + if ($SA_bayes_scan_msg){ + push(@$lines, $line); # this is needed for SpamAssassin } - $got_rcpt++; - # permit some sloppy syntax without angle brackets - local($1,$2); - if ($args !~ /^TO: \s* - ( < (?: " (?: \\. | [^\\"] )* " | [^"@] )* - (?: @ (?: \[ (?: \\. | [^\]\\] )* \] | - [^\[\]\\>] )* )? - > | - [^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )* - ) (?: \s+ ([\040-\176]+) )? $(?!\n)/isx ) { - $self->smtp_resp(0,"501 5.5.2 Syntax: RCPT TO:
", 1, $cmd); - last; + + last GET_HEADERS if ( $line =~ /^\r?\n$/ ); } - if ($2 ne '') { - $self->smtp_resp(0,"504 5.5.4 RCPT command parameter not implemented: $2", 1, $cmd); - ### $self->smtp_resp(0,"555 5.5.4 RCPT command parameter unrecognized: $2", 1, $cmd); - } elsif ($got_rcpt > $smtpd_recipient_limit) { - $self->smtp_resp(0,"452 4.5.3 Too many recipients"); - } else { - my($addr,$opt) = ($1.$taint, $2.$taint); - $addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr; - $self->smtp_resp(0,"250 2.1.5 Recipient $addr OK"); - push(@recips, unquote_rfc2821_local($addr)); - }; - last; - }; - /^DATA$/ && !@recips && do { - if (!defined($sender)) { - $self->smtp_resp(1,"503 5.5.1 Need MAIL command before DATA", 1, $cmd); - } elsif (!$got_rcpt) { - $self->smtp_resp(1,"503 5.5.1 Need RCPT command before DATA", 1, $cmd); - } elsif ($lmtp) { # rfc2033 requires 503 code! - $self->smtp_resp(1,"503 5.1.1 Error (DATA): no valid recipients", 1, $cmd); - } else { - $self->smtp_resp(1,"554 5.1.1 Error (DATA): no valid recipients", 1, $cmd); + } + + +# do spf check +sub do_spf($$) +{ + my ($msginfo, $original_headers) = @_; + my $which_section="SPFcheck"; + prolong_timer($which_section); + require Mail::SPF::Query; + my $ip; + my $helo = ''; + my $return_val = 0; + my $got_cached = 0; + + my $caller_id = {"*." =>{check => 0}}; + if ($Amavis::Conf::perform_spf_check eq 'both'){ + $caller_id = {"*.*" =>{check => 1}}; + } + + # If this is a multi-recip mail, check for a cached SPF result. + if ($multi_recip && $mta_id && $Amavis::saresults_cache && $Amavis::saresults_cache->exists("$mta_id:spf")) { + $return_val = $Amavis::saresults_cache->read("$mta_id:spf")-1; + $got_cached = 1; + do_log(1, "Got cached result for spf-hit: $return_val"); + if ($return_val) { + $Amavis::HIT_CLASS = CLASS_SPF(); + } + } elsif (grep(/^X-SPF-Fake-Fail:/i, @$original_headers)) { + do_log(1, "spf-hit-fake"); + $Amavis::HIT_CLASS = CLASS_SPF(); + $return_val = 1; + } else { + foreach my $header (@$original_headers){ + if ($header =~ /^Received:.*?from\s+(\S+).*?\[(.+?)\]/){ + my ($tmp_helo, $tmp) = ($1, $2); + next if (grep { $_ eq $tmp } @Amavis::Conf::spf_trusted_forwarders); + $ip=$tmp; + $helo = $tmp_helo; last; - }; - /^DATA$/ && do { - # set timer to the initial value, MTA timer starts here - prolong_timer('DATA received - timer reset', $child_timeout); - my($within_data_transfer,$complete); - eval { - $msginfo->sender($sender); $msginfo->recips(\@recips); - do_log(1, sprintf("%s:%s:%s %s: <%s> -> %s Received: %s", - $conn->smtp_proto, - $conn->socket_ip eq $inet_socket_bind ? '' - : '['.$conn->socket_ip.']', - $conn->socket_port, $self->{tempdir_pers}, - $sender, join(',', map{"<$_>"}@recips), - join(' ', - ($msginfo->msg_size eq '' ? () - : 'SIZE='.$msginfo->msg_size), - ($msginfo->body_type eq '' ? () - : 'BODY='.$msginfo->body_type), - received_line($conn,$msginfo,am_id(),0) ) - ) ); - $self->smtp_resp(1,"354 End data with ."); - $within_data_transfer = 1; - section_time('SMTP pre-DATA-flush') if $self->{pipelining}; - $self->{tempdir_empty} = 0; - do{ local($/) = "\015\012"; #set in.line terminator to CRLF - while(<$sock>) { # use native I/O for speed - # do_log(5, $self->{proto} . "< $_"); - if (/^\./) { - if ($_ eq ".\015\012") { - $complete = 1; $within_data_transfer = 0; + } + if ($header =~ /^Received:.*?\[(.+?)\]/){ + my $tmp = $1; + next if (grep { $_ eq $tmp } @Amavis::Conf::spf_trusted_forwarders); + $ip=$tmp; last; } - # rfc 2821 by the letter - s/^\.(.+\015\012)$(?!\n)/$1/s; } - chomp; # remove \015\012 (=$/), faster than s/// - print {$self->{fh_pers}} $_,$eol - or die "Can't write to mail file: $!"; + + if ($ip && $ip =~ /(\d+\.){3}\d+/ ){ + my $spf_query; + eval { $spf_query = new Mail::SPF::Query(ip => $ip, + sender => qquote_rfc2821_local($msginfo->sender), + trusted => 1, + helo => $helo, + callerid => $caller_id); }; + my ($result) = $spf_query ? $spf_query->result():''; + $which_section="SPFcheckend"; + prolong_timer($which_section); + + if ($result eq 'fail'){ + do_log(1, "spf-hit"); + $Amavis::HIT_CLASS = CLASS_SPF(); + $return_val = 1; } - $eof = 1 if !$complete; - }; # restores line terminator - # normal data termination, or eof on socket, or fatal error - do_log(4, $self->{proto} . "< .\015\012") if $complete; - $self->{fh_pers}->flush or die "Can't flush mail file: $!"; - # On some systems you have to do a seek whenever you - # switch between reading and writing. Amongst other things, - # this may have the effect of calling stdio's clearerr(3). - $self->{fh_pers}->seek(0,1) or die "Can't seek on file: $!"; - section_time('SMTP DATA'); - }; - if ($@ ne '' || !$complete) { # error or connection broken - chomp($@); - # either send: '421 Shutting down', or alternatively: - # '451 Aborted, error in processing' and NOT shut down! - if (!$within_data_transfer) { - my($msg) = "Error in processing: " . - !$complete && $@ eq '' ? 'incomplete' : $@; - do_log(0, $self->{proto}." TROUBLE: 451 4.5.0 $msg"); - $self->smtp_resp(1, "451 4.5.0 $msg"); - ### $aborting = $msg; - } else { - $aborting = "client broke the connection ". - "during data transfer" if $eof; - $aborting .= ', ' if $aborting ne '' && $@ ne ''; - $aborting .= $@; - $aborting = '???' if $aborting eq ''; - do_log($@ ne '' ? 0 : 3, - $self->{proto}." TROUBLE, ABORTING: $aborting"); } - } else { # all OK + } + + # If we're doing backscatter prevention with SPF, + # and the message is multi-recip, then cache the result. + if ($multi_recip && $mta_id && $Amavis::saresults_cache && !$got_cached + && $Amavis::Conf::perform_spf_check_for_dsn) { + do_log(2,"Caching SPF result: $return_val"); + $Amavis::saresults_cache->update("$mta_id:spf", $return_val+1); + } + + section_time("SPFcheck"); + return $return_val; +} + +# - returns true if spam detected, +# - returns 0 if no spam found, +# - throws exception (die) in case of errors, +# or just returns undef if it did not complete its jobs # - # Is it acceptable to do all this processing here, - # before returning response??? According to rfc1047 - # it is not a good idea! But at the moment we do not have - # much choice, amavis has no queueing mechanism and can not - # accept responsibility for delivery. + +sub spam_scan($$$$@) { + my($conn,$msginfo,$tempdir,$file_generator_object,@recips) = @_; + + # check results of multiple recipient cache + # incoming global variables + # $multi_recip + # $mta_id # - # check contents before responding - # check_mail() expects open file on $self->{fh_pers}, - # need not be rewound - $msginfo->mail_text($self->{fh_pers}); - my($smtp_resp, $exit_code, $preserve_evidence) = - &$check_mail($conn,$msginfo, - $lmtp,$self->{tempdir_pers}); - if ($preserve_evidence) { $self->preserve_evidence(1) } - if ($smtp_resp !~ /^4/ && - grep { !$_->recip_done } @{$msginfo->per_recip_data}) { - die "TROUBLE/MISCONFIG: not all recipients done, ". - "\$forward_method is \"$forward_method\""; + # We cache the three return values and these AMAVIS return globals + #return ($spam_level, $spam_status, $spam_report); + #$Amavis::HIT_REGEXP + #$Amavis::HIT_CLASS + #$Amavis::HIT_TYPE + # + do_log(1, "spam_scan start: $mta_id"); + + # use the av lock if already created; + my $mutex = $Amavis::MUTEX; + + my $prev_results = undef; + my $prev_sa_results = undef; + + # initialize return values so we can fall through + + my($spam_level, $spam_status, $spam_report) = (undef, '', ''); + + my %bayes_score; + + $Amavis::BAYES_HEADER = ''; + + my $need_bayes = 1; # 0 = no bayes, 1 = global, -1 = user + my $need_fnames = 0; # 0 = none, 1 = banned, 2 = quarantined + + #section_time("spam_cach"); # spam_scan start + if ($multi_recip && $Amavis::saresults_cache) { + if ($mta_id) { + # no lock needed for reading + $prev_results = $Amavis::saresults_cache->read("$mta_id:scan_pri"); + + # any results available in the cache? + if (!$prev_results) + { + # obtain a temporary write semaphore using this msgid, we won't need it after we are done + # so make sure it is destroyed + # We should be just using Semaphores, no need for anything else. + if ($debug_cache) + { + if (!$mutex) + { + do_log(2,"cache:no results for SA $mta_id get new write lock"); } - if (!$lmtp) { - do_log(4, "sending SMTP response: \"$smtp_resp\""); - $self->smtp_resp(0, $smtp_resp); - } else { - my($bounced) = $msginfo->dsn_sent; - for my $r (@{$msginfo->per_recip_data}) { - my($resp) = $r->recip_smtp_response; - if ($bounced && $smtp_resp=~/^2/ && $resp!~/^2/) { - # as the message was already bounced by us, - # MTA must not bounce it again; failure status - # needs to be converted into success! - $resp = sprintf("250 2.5.0 Ok, DSN %s (%s)", - $bounced==1?'sent':'muted', $resp); + else + { + do_log(2,"cache:no results for SA $mta_id reuse write lock"); } - do_log(4, sprintf( - "sending LMTP response for <%s>: \"%s\"", - $r->recip_addr, $resp)); - $self->smtp_resp(0, $resp); } + if (!$mutex) + { + $mutex = new IPC::ShareLite( + -key => unpack("L", Digest::MD5::md5($mta_id)), + -create => 'yes', + -destroy => 'yes', + -size => 0, + ) } - }; - alarm(0); do_log(5,"timer stopped after DATA end"); - if ($self->preserve_evidence && !$self->{tempdir_empty}) { - # keep evidence in case of trouble - do_log(0,"PRESERVING EVIDENCE in ".$self->{tempdir_pers}); - $self->{fh_pers}->close or die "Can't close mail file: $!"; - $self->{fh_pers} = undef; $self->{tempdir_pers} = undef; - $self->{tempdir_empty} = 1; + if (!$mutex) + { + do_log(2,"cache:FAILED to GET MUTEX!!!!!!!!! $mta_id"); + goto compute_new_results; } - # cleanup, but leave directory (and file handle - # if possible) for reuse - if ($self->{fh_pers} && !$can_truncate) { - # truncate is not standard across all Unix variants, - # it is not Posix, but is XPG4-UNIX. - # So if we can't truncate a file and leave it open, - # we have to create it anew later, at some cost. - # - $self->{fh_pers}->close or die "Can't close mail file: $!"; - $self->{fh_pers} = undef; - unlink($self->{tempdir_pers}."/email.txt") - or die "Can't delete file ". - $self->{tempdir_pers}."/email.txt: $!"; - section_time('delete email.txt'); + else + { + $mutex->lock( LOCK_EX); + # check to see if results magically appeared + $prev_results = $Amavis::saresults_cache->read("$mta_id:scan_pri"); + if (!$prev_results) + { + $debug_cache && do_log(2,"cache:got lock, but no results, must compute for $mta_id"); + goto compute_new_results; # i hate gotos + } + $mutex->unlock(); + $debug_cache && do_log(2,"now have SA cache results after write lock for $mta_id"); } - if (defined $self->{tempdir_pers}) { # prepare for the next one - strip_tempdir($self->{tempdir_pers}); - $self->{tempdir_empty} = 1; } - $sender = undef; @recips = (); $got_rcpt = 0; # implicit RSET - $msginfo = undef; # forget previous - $self->preserve_evidence(0); # reset - # report elapsed times by section for each transaction - # (the time for the QUIT remains unaccounted for) - do_log(2, Amavis::Timing::report()); Amavis::Timing::init(); - last; - }; # DATA - # catchall (EXPN, TURN, unknown): - $self->smtp_resp(1,"502 5.5.1 Error: command ($_) not implemented", 1, $cmd); - # $self->smtp_resp(1,"500 5.5.2 Error: command ($_) not recognized", 1, $cmd); + do_log(2, "scan results cached for $mta_id"); + my $hit_regexp; + my $hit_class; + my $hit_type; + ($spam_level, $spam_status, $spam_report, + $hit_regexp, $hit_class,$hit_type, + $need_bayes, $need_fnames) = @$prev_results; + + $debug_cache && do_log(2,"cache(sl=$spam_level,ss=$spam_status,fns=$need_fnames,hr=$hit_regexp,hc=$hit_class,ht=$hit_type,nb=$need_bayes"); + + # extract banned/quarantined filenames from cache if needed + if ($need_fnames > 0) + { + my $fname_results = $Amavis::saresults_cache->read("$mta_id:fns"); + if ($need_fnames == 1) # banned + { + @Amavis::banned_filename = @$fname_results; + } + else # quarantined + { + @Amavis::quarantined_filename = @$fname_results; + } + } + + $Amavis::HIT_REGEXP = $hit_regexp; + $Amavis::HIT_CLASS = $hit_class; + $Amavis::HIT_TYPE = $hit_type; + + if ((defined $spam_level) and ($spam_level < -1000)) + { # create tsk tsk side affects + if ($spam_level == -1001) + { + $Amavis::REASON_ID = 38; + $Amavis::ACTION_ID = 0; + } + if ($spam_level == -1002) + { + $Amavis::REASON_ID = 0; + $Amavis::ACTION_ID = 0; + } + } + + # first scan of this message determined we never need bayes + if ($need_bayes == 1) + { + $debug_cache && do_log(2,"cache1 return:$mta_id"); + return ($spam_level, $spam_status, $spam_report); + } + + # do we need to extract bayes? + my $bayes_results = undef; + if ( ($need_bayes == 2) && ($bayes_results = $Amavis::saresults_cache->read("$mta_id:scan_bayes"))) { + my $database; + # extract global bayes results + my ($bayes_header, $isspam, $probability, $confidence, $dictionary, $weight) + = @$bayes_results; + require Barracuda::Environment; + require Barracuda::Bayes; + require Barracuda::AliasLink; + my $bayes = new Barracuda::Bayes; + + # we have global result, need to check if the user will override + # there should only be one recip + foreach my $r (@{$msginfo->per_recip_data}) + { + # sigh, adding my own cut and paste + my $recip = $Amavis::PU_REAL_EMAIL_MAP{$r->recip_addr} + || $Amavis::PU_UID_MAP{$r->recip_addr} + || $r->recip_addr; + + # + # Choose per-user or global + # + foreach my $user ($recip, 'admin') { + next if ($user ne 'admin' && !$Amavis::enable_user_bayes); + + if ($bayes->exists($user)) { + my $stats = $bayes->getStats($user) or do { + do_log(1,"Barracuda::Bayes::getStats failed for user $recip: $!"); + next; }; - if ($terminating || defined $aborting) { # exit SMTP-session loop - $voluntary_exit = 1; last; + + if ($stats->{ham_classified} >= 200 && $stats->{spam_classified} >= 200) { + $database = $user; + last; } - # rfc2920 requires a flush whenever the local TCP input buffer is - # emptied. Since we can't check it (unless we use sysread & select), - # we should do a flush here to be in compliance. We could only break - # the requirement if we knew we talk with a local MTA client which - # uses client-side pipelining. - $self->smtp_resp_flush; - undef $!; - } # end of while - my($errn,$errs); - if (!$voluntary_exit) { - $eof = 1; - if (!defined($_)) { $errn = 0+$!; $errs = "$!" } } - # we come here when: QUIT is received, eof on socket, or we need to abort - $self->smtp_resp_flush; # just in case, the session might have been disconnected - my($msg) = - defined $aborting && !$eof ? "ABORTING the session: $aborting" : - defined $aborting ? $aborting : - !$terminating ?"client broke the connection without a QUIT ($errs)":''; - do_log($aborting?0:2, $self->{proto}.': NOTICE: '.$msg) if $msg ne ''; - if (defined $aborting && !$eof) - { $self->smtp_resp(1,"421 4.3.2 Service shutting down, ".$aborting) } - $self->{session_closed_normally} = 1; - # closes connection after child_finish_hook } -# sends a SMTP response consisting of 3-digit code and an optional message; -# slow down evil clients by delaying response on permanent errors -sub smtp_resp($$$;$$) { - my($self, $flush,$resp, $penalize,$line) = @_; - if ($penalize) { - do_log(0, $self->{proto} . ": $resp; PENALIZE: $line"); - sleep 5; - section_time('SMTP penalty wait'); + # this user wants global and we already have the results, stash them and return now + if ($database eq 'admin') + { + $Amavis::BAYES_HEADER = $bayes_header; + %bayes_score = ( + isspam => $isspam, + probability => $probability, + confidence => $confidence, + dictionary => $dictionary, + weight => $weight + ); + $r->recip_bayes_score(\%bayes_score); + $debug_cache && do_log(2,"cache2 return:$mta_id\n"); + return ($spam_level, $spam_status, $spam_report); } - local($1,$2,$3,$4); my($taint) = substr($resp,0,0); - $resp = sanitize_str($resp,1); - if ($resp !~ /^ ([1-5]\d\d) (\ |-|$(?!\n)) - ([245] \. \d{1,3} \. \d{1,3} (?: \ |$(?!\n)) )? - (.*) $(?!\n)/xs) - { die "Internal error(2): bad SMTP response code: '$resp'" } - my($resp_code,$continuation,$enhanced,$tail) = ($1,$2,$3, $4.$taint); - my($lead_len) = length($resp_code) + 1 + length($enhanced); - while (length($tail) > 512-2-$lead_len || $tail =~ /\n/) { - # rfc2821: The maximum total length of a reply line including the - # reply code and the is 512 characters. More information - # may be conveyed through multiple-line replies. - my($head) = substr($tail,0,512-2-$lead_len); - if ($head =~ /^([^\n]*\n)/) { $head = $1.$taint } - $tail = substr($tail,length($head)); chomp($head); - push(@{$self->{smtp_outbuf}}, $resp_code.'-'.$enhanced.$head); + # this email wants per_user, need to get the results } - push(@{$self->{smtp_outbuf}},$resp_code.$continuation.$enhanced.$tail); - $self->smtp_resp_flush if $flush || !$self->{pipelining} || - @{$self->{smtp_outbuf}} > 200; } - -sub smtp_resp_flush($) { - my($self) = shift; - if (@{$self->{smtp_outbuf}}) { - for my $resp (@{$self->{smtp_outbuf}}) { - do_log(4, $self->{proto} . "> $resp"); - }; - print map($_."\015\012", @{$self->{smtp_outbuf}}); - @{$self->{smtp_outbuf}} = (); + # we have results for everything except per user bayes + $debug_cache && do_log(2,"cache: compute user bayes:$mta_id\n"); + goto enter_to_get_user_bayes; + } else { + do_log(1,"spam_scan:bad mta_Id = NULL"); } } -1; + compute_new_results: -__DATA__ # -package Amavis::AV; -use strict; +# In order of certainty and override, efficiency, and probability of successful determination +# We should process in the following order +# All whitelists first (subject, header, body) +# SPF +# BFS +# SpamAssassin and RBL blocks +# blacklists of subject, header, body +# quarantine of subject, header, body +# tag of subject, header, body + require Barracuda::HeaderUtils; -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - $VERSION = '1.15'; - @ISA = qw(Exporter); - @EXPORT_OK = qw(&sophos_savi_init); -} + section_time("spsc_strt"); # spam_scan start -use POSIX qw(WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED); -use Errno qw(EPIPE ENOTCONN ENOENT); -use Socket; -use IO::Socket; -use IO::Socket::UNIX; + my @original_headers = @{$msginfo->orig_header()}; -use subs @EXPORT_OK; -use vars @EXPORT; -BEGIN { - import Amavis::Conf qw(:platform :confvars); - import Amavis::Util qw(do_log am_id retcode min max run_command); - import Amavis::Timing qw(section_time); -} +# # skip spam check if @spam_lovers_acl = ("@.") +# As far as I can tell, there is code that will ever set +# spam_lovers_acl such that this will match +# if (grep /^\@\.$/, @Amavis::spam_lovers_acl) { +# return (0, '', ''); +# } -use vars qw(%st_socket_created %st_sock); # keep persistent state (per-socket) -use vars qw($savi); + my($result, $regexp); +## +# Do Whitelist testing here +## + + # we should not keep the tag "Subject: " here -- Bug#6735 + my $subject_header; + my $toggle = 0; + foreach my $l (@original_headers){ + $toggle = 0 if ($l !~ /^\s/); # check the end of concatenation + if ($l =~ s/^Subject:\s?//i) { # "subject: " is not part of the subject + $toggle++; + $subject_header = $l; + } + # concatenate to subject if next line starts with whitespace + elsif ($toggle && ($l =~ /^\s/)) { + $l =~ s/^\s//; + $subject_header .= $l; + } + } -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 - !DeleteAllMacros Vbe !ExecFileDisinfection VisioFileHandling - ActiveMimeHandling !DelVBA5Project - ScrapObjectHandling SrpStreamHandling Office2001Handling - Upx PalmPilotHandling HqxDecompression - Pdf Rtf Html Elf WordB OutlookExpress - ); -# Mime - # starting with SAVI V3: Mac and SafeMacDfHandling options were removed; - # new option GrpArchiveUnpack makes individual settings unnecessary; - # option 'Mime' may cause a CPU loop when checking broken mail with some - # versions of Sophos library - 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(2, sprintf("$av_name init: Version %s (engine %d.%d) recognizing %d viruses\n", - $version->string, $version->major, $version->minor, $version->count)); -# for ($version->ide_list) -# { do_log(2, sprintf("$av_name: IDE %s released %s", $_->name, $_->date)) } - my($error) = $savi->set('MaxRecursionDepth', 16, 1); - !defined $error or die "$av_name: error setting MaxRecursionDepth: err=$error"; - my($error) = $savi->set('NamespaceSupport', 3); # new with Sophos 3.67 - !defined $error or do_log(0,"$av_name: error setting NamespaceSupport: 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"; + # Change subject header to utf-8 for comparison. + if ($subject_header =~ /\=\?.*\?\=/){ + eval { + $subject_header =~ tr/\r\n//; + $subject_header = Encode::decode('MIME-Header',$subject_header); + }; } - section_time('sophos_savi_init'); - $savi; + else { + eval { + $subject_header = Encode::decode($default_encoding, $subject_header, Encode::FB_DEFAULT); + }; } + utf8::decode($subject_header); + do_log(3, " subject: $subject_header"); + -# same args and returns as run_av() below # -sub sophos_savi { - my($tempdir, $av_name, $command, $savi_of_parent) = @_; - if (defined $savi_of_parent) { $savi = $savi_of_parent } - else { $savi = sophos_savi_init($av_name,$command) if !defined $savi } - my($scan_status,@virusname); my($output) = ''; - local(*DIR); my($f); my($cnt) = 0; - opendir(DIR, "$tempdir/parts") - or die "Can't open directory $tempdir/parts: $!"; - while (defined($f = readdir(DIR))) { - my($fname) = "$tempdir/parts/$f"; - my($errn) = stat($fname) ? 0 : 0+$!; - next if $errn == ENOENT; - if ($errn) { die "sophos_savi: $fname inaccessible: $!" } - if (!-r _) { die "sophos_savi: $fname not readable" } - next if -d _ && ($f eq '.' || $f eq '..'); # this or parent directory - next if -z _; # empty file - $cnt++; 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) $!"; - if (! grep {$result == $_} (514,527,530,538,549) ) { - die $msg; - } else { # don't panic on non-fatal (encrypted, corrupted, partial) - do_log(0,$msg); - $scan_status = 0 if !$scan_status; # no viruses, no errors + # Check whitelist keywords + # + + # subject + ($result, $regexp) = &$Amavis::Conf::whitelisted_subject_re($subject_header); + section_time('subj_whit'); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_CLASS = CLASS_SUBJECT(); # using global to pass back + $Amavis::HIT_TYPE = TYPE_WHITELIST(); # using global to pass back + do_log(1, "subject_whitelist"); + # if whitelisted, check out now + goto done_and_cache; + } + + # convert entire header string + my $all_headers; + foreach my $line (@original_headers){ + + # Change header to utf-8 for comparison. + eval {$line = Encode::decode('MIME-Header', $line);}; + $all_headers .= $line; + } + + # header keyword whitelist testing + ($result, $regexp) = &$Amavis::Conf::whitelisted_header_re($all_headers); + section_time('hedr_whit'); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_WHITELIST(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_HEADER(); # using global to pass back + do_log(1, "header_whitelist"); + # if whitelisted, check out now + goto done_and_cache; } - } elsif ($result->infected) { - $scan_status = 1; # virus(es) found, no errors - my($msg) = "INFECTED $fname: " . join(", ",$result->viruses); - $output .= $msg.$eol; do_log(2,"$av_name result: $msg"); - push(@virusname, $result->viruses); - } else { - $scan_status = 0 if !$scan_status; # no viruses, no errors + + if ($Amavis::HIT_TYPE == TYPE_BLOCK()) { + goto done_and_cache; } + + # Subject + ($result, $regexp) = &$Amavis::Conf::blocked_subject_re($subject_header); + section_time('subj_blok'); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_CLASS = CLASS_SUBJECT(); # using global to pass back + $Amavis::HIT_TYPE = TYPE_BLOCK(); # using global to pass back + utf8::upgrade($Amavis::HIT_REGEXP); + + do_log(1, "subject_block -- $regexp"); + goto done_and_cache; } - closedir(DIR) or die "Can't close directory: $!"; - if (!$cnt) { $scan_status = 0 } # no errors, no viruses - do_log(3,"$av_name result: clean") if defined($scan_status) && !$scan_status; - ($scan_status,$output,\@virusname); + + # Header + ($result, $regexp) = &$Amavis::Conf::blocked_header_re($all_headers); + section_time('hedr_blok'); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_BLOCK(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_HEADER(); # using global to pass back + do_log(1, "header_block"); + goto done_and_cache; } -# same args and returns as run_av() below, -# but prepended by a $query, which is the string to be sent to the daemon. -# Handles both UNIX and INET 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, $tempdir, - $av_name, $command, $args, - $sts_clean, $sts_infected, $how_to_get_names, # regexps - ) = @_; - my($query_template,$sockets) = @$args; - my($scan_status,$output,@virusname); my($socketname,$is_inet); - if (!ref($sockets)) { $sockets = [ $sockets ] } - my($max_retries) = 2 * @$sockets; my($retries) = 0; - $SIG{PIPE} = 'IGNORE'; # 'send' to broken pipe throws a signal - for (;;) { # gracefully handle cases when av child times out or restarts - @$sockets >= 1 or die "no sockets specified!?"; # sanity - $socketname = $sockets->[0]; # try the first one in the current list - $is_inet = $socketname =~ m{^/} ? 0 : 1; - eval { - if (!$st_socket_created{$socketname}) { - do_log(3, "$av_name: Connecting to socket " . - join(' ',$daemon_chroot_dir,$socketname) . - (!$retries ? '' : ", retry #$retries") ); - if ($is_inet) { # inet socket - $st_sock{$socketname} = IO::Socket::INET->new($socketname) - or die "Can't connect to INET socket $socketname: $!\n"; - $st_socket_created{$socketname} = 1; - } else { # unix socket - $st_sock{$socketname} = IO::Socket::UNIX->new( - Type => SOCK_STREAM) - or die "Can't create UNIX socket: $!\n"; - $st_socket_created{$socketname} = 1; - $st_sock{$socketname}->connect( - pack_sockaddr_un($socketname) ) - or die "Can't connect to UNIX socket $socketname: $!\n"; +enter_to_get_user_bayes: + + ## Start preparing the message body for additional scanning + ## The mime attachments have already been decoded into a temp directory + ## and pointers to them stored in @$msginfo->mime_entity->parts() + my $charset; # declaring this here means that character sets are inherited from + # previous messages unless specifically overridden NOTE this is + # NOT what the RFC says to do. + + # Variable to hold the lines for SA + my @lines; + + my $msg_body = ''; + + # msg_body will stay '' if the msg is huge, this will allow all the other body tests + # to just complete without scoring a hit, and we don't need to keep checking + + my $huge_msg = 0; + if (defined $sa_mail_body_size_limit && + $msginfo->orig_body_size > $sa_mail_body_size_limit) + { + $huge_msg = 1; + do_log(1, "Huge msg size:" . $msginfo->orig_body_size . ">" . $sa_mail_body_size_limit); } + else { do_log(1, "msg size:" . $msginfo->orig_body_size); } + + my $SA_bayes_scan_msg = 1; + # joe b3451 2-14-06 check if we should skip the spam scan + my $recip = ${$msginfo->per_recip_data}[0]->recip_addr; + if ( $huge_msg == 1 || $Amavis::Conf::outbound_bypass_sa || + ($Amavis::Conf::inbound_relay_bypass_sa && !lookup($recip, \%local_domains) ) + ) + { + $SA_bayes_scan_msg = 0; } - do_log(3, sprintf("$av_name: Sending %s to %s socket $socketname", - $query, $is_inet ? "INET" : "UNIX")); - # UGLY: bypass send method in IO::Socket to be able to retrieve - # status/errno directly from 'send', not from 'getpeername': - defined send($st_sock{$socketname}, $query, 0) - or die "Can't send to socket $socketname: $!\n"; - if ($av_name =~ /^(Sophie|Trophie)/i) { - # Sophie and Trophie can accept multiple requests per session - # and return a single line response each time - defined $st_sock{$socketname}->recv($output, 1024) - or die "Can't receive from socket $socketname: $!\n"; - } else { - $output = join('', $st_sock{$socketname}->getlines); - $st_sock{$socketname}->close - or die "Can't close socket $socketname: $!\n"; - $st_sock{$socketname}=undef; $st_socket_created{$socketname}=0; + + my($fh) = $msginfo->mail_text; + $fh->seek(0,0) or Amavis::Util::cleanup_and_die "Can't rewind mail file: $!"; + my($body_lines) = 0; + push(@lines, sprintf('X-Envelope-From: %s'.$eol, + qquote_rfc2821_local($msginfo->sender))); + push(@lines, sprintf('X-Envelope-To: %s'.$eol, + join(",\n ",qquote_rfc2821_local(@{$msginfo->recips})))); + + # flatten the parts + my @partlist; + my @pathlist; # used for mime only + push @partlist, $msginfo->mime_entity->parts(); + foreach my $part (@partlist) + { + push @partlist, $part->parts(); } - $! = undef; - $output ne '' or die "Empty result from $socketname\n"; - }; - last if $@ eq ''; - # error handling (most interesting error codes are EPIPE and ENOTCONN) - chomp($@); my($err) = "$!"; my($errn) = 0+$!; - ++$retries <= $max_retries - or die "Too many retries to talk to $socketname ($@)"; - # is ECONNREFUSED for INET sockets common enough too? - if ($retries <= 1 && $errn == EPIPE) { # common, don't cause concern - do_log(2,"$av_name broken pipe (don't worry), retrying ($retries)"); - } else { - do_log( ($retries>1?0:1), "$av_name: $@, retrying ($retries)"); - if ($retries % @$sockets == 0) { # every time the list is exhausted - my($dly) = min(20, 1 + 5 * ($retries/@$sockets - 1)); - do_log(3,"$av_name: sleeping for $dly s"); - sleep($dly); # slow down a possible runaway + + # create a different variable to hold the complete text body + my $bfs_msg_body = ''; + my $bfs_msg_body_log = ''; + my $separator = ('-' x 40) . "\n"; + + # Do we have any mime parts that we will need to process? + if( scalar(@partlist) ) + { + # If we do not want to apply body filters to the headers as well, + # otherwise skip this section and read everything into bfs_msg_body. + if ( $Amavis::Conf::scan_headers_as_body ne 'Yes' ){ # NOTE != YES + eat_msg_headers($fh, \@lines, $SA_bayes_scan_msg); } + + local $/ = undef; + $bfs_msg_body = <$fh>; + if ($SA_bayes_scan_msg) + { + # dk: fix bug 7482 - split lines, do not remove \n + push(@lines, split(/^/m, $bfs_msg_body)); # this is needed for SpamAssassin } - if ($st_socket_created{$socketname}) { - # prepare for a retry, ignore 'close' status - $st_sock{$socketname}->close; - $st_sock{$socketname} = undef; $st_socket_created{$socketname} = 0; + + # Do all of the conversion for the mime parts that we need to convert + # and build a list of the ones we need to scan + foreach my $part (reverse @partlist) + { + # joe 2-24-06 added i to regex looking for 'text' below + if ($part->{mail_inet_head}->{mail_hdr_hash}->{'Content-Type'} && + ${$part->{mail_inet_head}->{mail_hdr_hash}->{'Content-Type'}->[0]} =~ /text\//i) + { + my $path = $part->{ME_Bodyhandle}->{MB_Path}; + do_log(1, "*** Begining MIME scan -- $path"); + $charset = $1 if(${$part->{mail_inet_head}->{mail_hdr_hash}->{'Content-Type'}->[0]} =~ /charset\s*=\s*\"?\'?([\w-]+)/); + + if ($charset && (lc($charset) ne 'utf-8') + && (lc($charset) ne 'iso-8559-1') && + (lc($charset) ne 'us-ascii')) + { + use Barracuda::Environment; + require MS_utf8_conv; + do_log(1,"Converting $path - $charset"); + #alarm 3; + MS_utf8_conv::file_conv($path, {charset => $charset}); + + #`/home/emailswitch/code/firmware/current/bin/x2utf8.pl -e $charset $path`; + #alarm 0; } - # leave working socket as the first entry in the list - # so that it will be tried first when needed again - push(@$sockets, shift @$sockets) if @$sockets>1; # circular shift left + + # Add to the list of things we need to scan + push(@pathlist, $path); } - do_log(3,"$av_name result: $output"); - if ($output =~ /$sts_infected/m) { - @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/m) { - $scan_status = 0; # no errors, no viruses - } else { - do_log(0,"$av_name FAILED - unknown status: $output"); } - ($scan_status,$output,\@virusname); + # create complete bfs_msg_body from individual parts + $bfs_msg_body = ''; # zero out bfs_msg_body + my $part_info = "\n" . $separator; + my $part_opened = ''; + foreach my $part (@pathlist) + { + if (open MIME,"<:utf8", "$part.utf") { + $part_opened = "$part.utf"; + my $parttime = &get_cmtime($part); + $part_info .= " ... Non-UTF8 part $parttime\n"; + } + elsif (open MIME, "$part") { + $part_opened = $part; } -# same args and returns as run_av() below -sub ask_daemon { - my($tempdir,$av_name,$command,$args) = @_; - ref $args eq 'ARRAY' - or die "The field#3 in the \@av_scanners entry is not an array ref"; - my($query_template) = $args->[0]; - $query_template =~ s[{}][$tempdir/parts]g; # replace {} with dir name - if ($query_template !~ /\*/) { # scanner can be given a directory name - return ask_daemon_internal($query_template, @_); - } else { # must check each file individually - my($scan_status,@virusname); my($output) = ''; - local(*DIR); my($f); my($cnt) = 0; - opendir(DIR, "$tempdir/parts") - or die "Can't open directory $tempdir/parts: $!"; - while (defined($f = readdir(DIR))) { - my($fname) = "$tempdir/parts/$f"; - my($errn) = stat($fname) ? 0 : 0+$!; - next if $errn == ENOENT; - if ($errn) { die "ask_daemon: $fname inaccessible: $!" } - if (!-r _) { die "ask_daemon: $fname not readable" } - next if -d _ && ($f eq '.' || $f eq '..'); # this or parent dir - next if -z _; # empty file - $cnt++; do_log(5, "$av_name: checking $fname"); - my($query_template_exp) = $query_template; - $query_template_exp =~ s[\*][$f]g; # replace * with bare file name - my($t_scan_status,$t_output,$t_virusnames) = - ask_daemon_internal($query_template_exp, @_); - if ($t_scan_status) { # virus(es) found in one part - $scan_status = $t_scan_status; # virus(es) found, no errors - do_log(3,"$av_name result: $t_output"); - $output .= $t_output . $eol; - push(@virusname, @$t_virusnames); - } elsif (!defined $t_scan_status) { - last; # error, bail out - } else { - $scan_status = 0 if !$scan_status; # no viruses, no errors + if ($part_opened) + { + local $/ = undef; + my $temp = ; + $temp .= "\n\n"; + my $slen = length $bfs_msg_body; + my $elen = $slen + length $temp; + my $temptime = &get_cmtime(\*MIME); + $bfs_msg_body .= $temp; + close MIME; + + $part_info .= "Decoded MIME part: \"\Q$part_opened\E\": $slen - $elen $temptime\n"; + } else { + do_log(0, "*** Couldn't open MIME part at \"$part\"\n"); + } + } + utf8::decode($bfs_msg_body); + $part_info .= $separator; + $bfs_msg_body_log = $bfs_msg_body . $part_info; + section_time('prep_mime'); + } + else + { + # We do not have any mime parts ... so, we will go ahead and + # scan the entire mail file + + # Is this an html file that we should strip tags out of when + # doing the match for keyword processing? + my($entity) = $msginfo->mime_entity; + my $t = $msginfo->mime_entity->head->get('Content-Type'); + + # Determine the character set that we are working with + if ($t !~ /charset/ && $bfs_msg_body =~ /(charset=)['"]?((?:\w|\-)+)/){ + $t=$1.$2; + } + # The default should be whatever the user has set. + # This table should be updated along with Barracuda::HeaderUtils + # and MS_locale + my %locale_charset_map = (zh_TW => "big-5", + zh_CN => "gb2312", + de_DE => "iso-8859-1", + nl_NL => "iso-8859-1", + en_US => "iso-8859-1", + es_ES => "iso-8859-1", + fr_FR => "iso-8859-1", + ja_JP => "iso-2022-JP",); + + $charset = ""; + if ( $t =~ /charset/) + { + if ($t=~/charset\s*=\s*"(.*?)"/) + { + $charset = $1; } + elsif( $t=~/charset\s*=\s*(.*?)["\s;]/) + { + $charset = $1; } - closedir(DIR) or die "$av_name: Can't close directory: $!"; - if (!$cnt) { $scan_status = 0 } # no errors, no viruses - do_log(3,"$av_name result: clean") if defined($scan_status) && !$scan_status; - ($scan_status,$output,\@virusname); + elsif ($t=~/charset\s*=\s*(.*?)/) + { + $charset = $1; } + $charset =~ tr/\"\'//; } + do_log(1, "BODY charset = $charset "); -# 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: -# - true if virus found, -# - 0 if no viruses found, -# - undef if it did not complete its jobs; -# the second element is a string, the text as output 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) -# -sub run_av { - my( $tempdir, # this arg is extra, not part of n-tuple - $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); my($output) = ''; - &$pre_code(@_) if defined $pre_code; - if (ref($command) eq 'CODE') { - do_log(3,"Using $av_name: (built-in interface)"); - ($scan_status,$output,$virusnames) = &$command(@_); - } else { - my($any_files_to_check) = 1; - my(@args) = split(' ',$args); - if (grep { m{^({}/)?\*$(?!\n)} } @args) { # list each file individually - local($1); local(*DIR); my($f); my(@bare_fnames); - opendir(DIR, "$tempdir/parts") - or die "Can't open directory $tempdir/parts: $!"; - while (defined($f = readdir(DIR))) { - my($fname) = "$tempdir/parts/$f"; - my($errn) = stat($fname) ? 0 : 0+$!; - next if $errn == ENOENT; - if ($errn) { die "run_av: $fname inaccessible: $!" } - if (!-r _) { die "run_av: $fname not readable" } - next if -d _ && ($f eq '.' || $f eq '..'); #this or parent dir - next if -z _; # empty file - if ($f =~ /^([A-Za-z0-9_.-]+)$(?!\n)/s) { push(@bare_fnames,$1) } - else { do_log(0, "run_av: WARN: refused to untaint: $f") } + # If we do not want to apply body filters to the headers as well, + # otherwise skip this section and read everything into bfs_msg_body. + if ( $Amavis::Conf::scan_headers_as_body ne 'Yes' ){ # NOTE != YES + eat_msg_headers($fh, \@lines, $SA_bayes_scan_msg); } - closedir(DIR) or die "$av_name: Can't close directory: $!"; - $any_files_to_check = scalar(@bare_fnames); - # replace * with bare file name - @args = map {!m{^({}/)?\*\z} ? $_ : map{$1.$_}@bare_fnames} @args; + + + local $/ = undef; + $bfs_msg_body = <$fh>; + + if ($SA_bayes_scan_msg) + { + push(@lines, split(/^/m, $bfs_msg_body)); # Needed for SpamAssassin } - for (@args) { s[{}][$tempdir/parts]g } # replace {} with directory name - if (!$any_files_to_check) { - do_log(3, "Not calling $av_name, no files to scan"); - $scan_status = 0; # 'false' (but defined) indicates no viruses - } else { - # NOTE: RAV does not like 'getline) ) { $output .= $_ } - my($err); $proc_fh->close or $err=$!; my($child_stat) = $?; - my($retval) = retcode($child_stat); - local($1); chomp($output); my($output_trimmed) = $output; - $output_trimmed =~ s/([ \t\n\r])[ \t\n\r]{4,}/$1.../gs; - $output_trimmed = "..." . substr($output_trimmed,-900) - if length($output_trimmed) > 900; - do_log(3, "run_av: $command status=$retval ($child_stat $err),$output_trimmed"); - if (!WIFEXITED($child_stat)) { - do_log(0,sprintf("Virus scanner failure: %s DIED on signal %d %s", - $command, WTERMSIG($child_stat), $err)); - } elsif (ref($sts_infected) eq 'ARRAY' - ? (grep {$_==$retval} @$sts_infected) - : $output =~ /$sts_infected/m) { # is infected - # test for infected first, in case both expressions match - $virusnames = []; # get a list of virus names by parsing output - @$virusnames = ref($how_to_get_names) eq 'CODE' - ? &$how_to_get_names($output) - : $output =~ /$how_to_get_names/gm; - @$virusnames = map {defined $_ ? $_ : ()} @$virusnames; - $scan_status = 1; # 'true' indicates virus found - do_log(3,"run_av: INFECTED: ".join(", ",@$virusnames)); - } elsif (ref($sts_clean) eq 'ARRAY' ? (grep {$_==$retval} @$sts_clean) - : $output =~ /$sts_clean/m) { # 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 (exit status: $retval)"); + + # This will allow attachment names in the body to be blocked + eval {1 while ($bfs_msg_body =~ s/\G(=\?\S+?\?[BQbq]\?.*?\?=)/Encode::decode('MIME-Header', $1)/e ) ;}; + + + # BR: Check for Base64 encoded messages, and convert them to real message content we + # # BR: Check for Base64 encoded messages, and convert them to real message content we + # can scan. This will only decode text/XXX messages. + # SS: Moved this in front of charset decoding. + my $transfer_enc = grep /^Content-Transfer-Encoding:.*?(base64|quoted-printable)/i, @original_headers; # true or false + if( $transfer_enc ) + { + my $enc = $1; + + # Note ... if we are set to scan the headers as the body then we need to + # grab the body independent of the headers for the decode. + my $tmp_hdrs = ''; + my $tmp_body = ''; + if( $Amavis::Conf::scan_headers_as_body eq 'Yes' ) + { + # Iterate over all of the lines in our array and get the headers + # as well as the body (so that we can decode) + my $in_headers = 1; + foreach( @lines ) + { + if( $in_headers ) + { + # Note - our split will have already removed any newline + # characters but I am including the \r\n here as both + # optional just in case. + if( $_ =~ /^\r?\n?$/ ) + { + $in_headers = 0; } - $output = $output_trimmed if length($output) > 900; + $tmp_hdrs .= "\n$_"; } + else + { + $tmp_body .= "\n$_"; } - &$post_code(@_) if defined $post_code; - $virusnames = [] if !defined $virusnames; - @$virusnames = (undef) if $scan_status && !@$virusnames; # nonnil - ($scan_status, $output, $virusnames); } - -sub virus_scan($$) { - my($tempdir,$firsttime) = @_; - my($scan_status,$output,@virusname,@detecting_scanners); - my($anyone_done); my($anyone_tried); - my(@errors); my($j); my($tier) = 'primary'; - for my $av (@av_scanners, "\000", @av_scanners_backup) { - if ($av eq "\000") { # 'magic' separator between lists - last if $anyone_done; - do_log(0,"WARN: all $tier virus scanners failed, considering backups"); - $tier = 'secondary'; next; } - next if !defined $av || !ref $av || !defined $av->[1]; - $anyone_tried++; - my($this_status,$this_output,$this_vn); - eval { ($this_status,$this_output,$this_vn) = run_av($tempdir,@$av) }; - if ($@ ne '') { - my($err) = $@; chomp($err); - $err = "$av->[0] av-scanner FAILED: $err"; - do_log(0,$err); push(@errors,$err); - $this_status = undef; - }; - $anyone_done++ if defined $this_status; - $scan_status = $this_status if !defined $scan_status || $this_status; - $output = $this_output if !defined $output; - $j++; section_time("AV-scan-$j"); - if ($this_status) { # virus detected - push(@detecting_scanners, $av->[0]); - if (!@virusname) # store results of the first scanner detecting - { @virusname = @$this_vn; $output = $this_output } - last if $first_infected_stops_scan; # stop if we found a virus? + else + { + # The bfs_msg_body is already without headers since it was + # slurped in that way. + $tmp_body = $bfs_msg_body; + } + # Perform the decode and prepend the headers (if we set them) + if( $enc = grep /^Content-Transfer-Encoding:.*?base64/i, @original_headers ) + { + do_log(1, "base64 decode root body."); + $bfs_msg_body = "$tmp_hdrs".MIME::Base64::decode_base64($tmp_body); } + else + { + do_log(1, "QP decode root body."); + $bfs_msg_body = "$tmp_hdrs".MIME::QuotedPrint::decode_qp($tmp_body); } - if (!$anyone_tried) { die "NO VIRUS SCANNERS AVAILABLE\n" } - elsif (!$anyone_done) - { die ("ALL VIRUS SCANNERS FAILED: ".join("; ",@errors)."\n") } - ($scan_status, $output, \@virusname, \@detecting_scanners); # return a quad } -1; + if( $charset ) + { + if((lc($charset) ne 'utf-8') + && (lc($charset) ne 'iso-8559-1') && + (lc($charset) ne 'us-ascii')) + { + eval { Encode::from_to($bfs_msg_body, $charset, 'utf-8'); }; + # tell perl that it's really utf8 text + utf8::decode($bfs_msg_body); + } elsif(lc($charset) eq 'utf-8') { + # tell perl that it's really utf8 text + utf8::decode($bfs_msg_body); + } + } else { + eval { $bfs_msg_body = Encode::decode($default_encoding, $bfs_msg_body); }; + } + section_time('prep_body'); -__DATA__ -package Amavis::SpamControl; -use strict; + } -BEGIN { - use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - $VERSION = '1.15'; - @ISA = qw(Exporter); + # At this point $bfs_msg_body contains the complete text (mime of not) that we need to run + # keyword tests on + + # We shall turn it into an array-ref + { + my $SPLIT_THESHOLD = 2000; + my @msg_body; + if (length($bfs_msg_body) > $SPLIT_THESHOLD){ + # Using the OR to take care of the worst case of NO word breaks in 1000 characters. + @msg_body = ( $bfs_msg_body =~ /(?:.{1,1000}\b|.{1,1000})/gs ); } -use FileHandle; -use Mail::SpamAssassin; + else { # create array with one element + push @msg_body, $bfs_msg_body; + } + $msg_body = \@msg_body; + } + # $msg_body contains a reference to an array + # $bfs_msg_body is a scalar with the original complete text +## +# Do keyword whitelist checks in the body +# # -BEGIN { - import Amavis::Conf qw(:platform :sa $log_level - %whitelist_sender @whitelist_sender_acl $whitelist_sender_re - %blacklist_sender @blacklist_sender_acl $blacklist_sender_re - $per_recip_whitelist_sender_lookup_tables - $per_recip_blacklist_sender_lookup_tables); - import Amavis::Util qw(do_log prolong_timer); - import Amavis::rfc2821_2822_Tools; - import Amavis::Timing qw(section_time); - import Amavis::Lookup qw(lookup); +#my $msg_body_minus_headers = get_body_minus_headers($msg_body); + + # check for short_circuiting with scan cache + + if (!$prev_results) + { + + ($result, $regexp) = &$Amavis::Conf::whitelisted_body_re($msg_body); + section_time('body_white'); + + if ($result) + { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_WHITELIST(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_BODY(); # using global to pass back + do_log(1, "body_whitelist"); + # if whitelisted, check out now + goto done_and_cache; } -use subs @EXPORT_OK; -use vars qw($spamassassin_obj); +#### All the whitelisting keywords are done #### -# called at startup, before the main fork -sub init() { - do_log(1, "SpamControl: initializing Mail::SpamAssassin"); - my($saved_umask) = umask; - $spamassassin_obj = Mail::SpamAssassin->new({ - debug => $sa_debug, - save_pattern_hits => $sa_debug, - dont_copy_prefs => 1, - local_tests_only => $sa_local_tests_only, - home_dir_for_helpers => $helpers_home, - stop_at_threshold => 0, -# DEF_RULES_DIR => '/usr/local/share/spamassassin', -# LOCAL_RULES_DIR => '/etc/mail/spamassassin', - }); - if ($sa_auto_whitelist) { # setup SpamAssassin auto-whitelisting - do_log(1, "SpamControl: turning on SA auto-whitelisting (AWL)"); - # create a factory for the persistent address list - my($addrlstfactory) = Mail::SpamAssassin::DBBasedAddrList->new; - $spamassassin_obj->set_persistent_address_list_factory($addrlstfactory); +#### Now do all the various Block tests (eventually spamassassin will need to move to here +#### or right after the BFS stage + +## +# Do Keyword block tests +## + + # Body + #do_log(1,"bodyblock:$msg_body"); + ($result, $regexp) = &$Amavis::Conf::blocked_body_re($msg_body); + section_time('body_blk'); + if ($result) + { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_BLOCK(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_BODY(); # using global to pass back + do_log(1, "body_block"); + goto done_and_cache; + } + + if (!$banned_filename_re) { + do_log(5, "banned_filename_presence skipped, no tests"); + } elsif (!grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, + $Amavis::bypass_banned_checks_sql,$Amavis::bypass_banned_checks_ldap, + \%Amavis::bypass_banned_checks, \@Amavis::bypass_banned_checks_acl, + $Amavis::bypass_banned_checks_re)} @recips) { + do_log(5, "bypassing of banned_filename_presence requested"); + } else { + my $banned_filenames_ref; + # check for banned mime file name or banned mime-type + ($banned_filenames_ref) = + check_for_banned_filenames($banned_filename_re, + $msginfo->mime_entity, undef, undef); + push(@Amavis::banned_filename, @$banned_filenames_ref); + + ($banned_filenames_ref) = + check_for_banned_filenames($banned_filename_re, + undef, \@Amavis::msgparts, $file_generator_object); + push(@Amavis::banned_filename, @$banned_filenames_ref); + + if (scalar(@Amavis::banned_filename) > 0) + { + # no reason to go any further + $need_fnames = 1; # we may need to cache the banned filenames + goto done_and_cache; } - $spamassassin_obj->compile_now; # ensure all modules etc. are preloaded - alarm(0); # seems like SA forgets to clear alarm in some cases - umask($saved_umask); # restore our umask - do_log(1, "SpamControl: done"); } -# check envelope sender if white or blacklisted by each recipient; -# Saves the result in recip_blacklisted_sender and recip_whitelisted_sender -# properties of each recipient object. -# -sub white_black_list($$$$) { - my($conn,$msginfo,$sql_wblist,$user_id_sql) = @_; - my($any_w)=0; my($any_b)=0; my($all)=1; my($wr,$br); - my($sender) = $msginfo->sender; - do_log(4, "white_black_list: checking sender <$sender>"); - for my $r (@{$msginfo->per_recip_data}) { - next if $r->recip_done; # already dealt with - my($wb,$user_id); my($recip) = $r->recip_addr; +## +# Do BFS block tests (Intention Analysis) +## - if (!defined($wb) && defined($sql_wblist) && - defined($user_id=lookup($recip,$user_id_sql)) ) + # Gather the URL's and perform BFS blocks + if( $Amavis::Conf::scana_use_bfs < 0 ) { - $wb = lookup($sender, Amavis::Lookup::SQLfield->new( - $sql_wblist,'wb','S',$user_id) ); - if (!defined($wb)) { # NULL field or no match: remains undefined - } elsif ($wb =~ /^[ \000]*$(?!\n)/) { # neutral, stops the search - $wb=0; - do_log(5,"white_black_list: (SQL) recip <$recip> is neutral to sender <$sender>"); - } elsif ($wb =~ /^[BbNnFf0][ ]*$(?!\n)/) { # blacklisted (B or N) - $wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1); - do_log(5,"white_black_list: (SQL) recip <$recip> blacklisted sender <$sender>"); - } else { # whitelisted (W or Y) - $wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1); - do_log(5,"white_black_list: (SQL) recip <$recip> whitelisted sender <$sender>"); + my $url_matching_regex = qr'(?:[Hh][Tt][Tt][Pp][Ss]?://|[Ww]{3}\.)[^[:space:]\",;]+'; + # Remember the exact location where we've seen each URL. + my @urls = (); + while ($bfs_msg_body =~ m#$url_matching_regex#ogs + && @urls < MAX_INTENT_URLS) + { + my $url = $&; + $bfs_msg_body_log .= "URL \"\Q$url\E\" found at position " . pos($bfs_msg_body) . "\n"; + push @urls, $url; } + + # search for sub-urls, and split off URLS with `>'s in 'em. + if (@urls) + { + # Prevent >-splitting from feeding back together with suburls. + my @split_urls = @urls; + foreach my $url (@split_urls) { + if ($url =~ /(.*)>/) { + push @split_urls, $1; + $bfs_msg_body_log .= "SPLITURL \Q$1\E found in URL $url\n"; } - if (!defined($wb)) { # fall back to static lookups if no match - # sender can be both white- and blacklisted at the same time - if (lookup($sender, - lookup($recip,$per_recip_blacklist_sender_lookup_tables), - \%blacklist_sender, \@blacklist_sender_acl, - $blacklist_sender_re)) { - $wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1); - do_log(5,"white_black_list: recip <$recip> blacklisted sender <$sender>"); } - if (lookup($sender, - lookup($recip,$per_recip_whitelist_sender_lookup_tables), - \%whitelist_sender, \@whitelist_sender_acl, - $whitelist_sender_re)) { - $wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1); - do_log(5,"white_black_list: recip <$recip> whitelisted sender <$sender>"); + + # Prevent >-splitting from feeding back together with suburls. + my @suburls = @urls; + foreach my $url (@suburls) { + # 9 characters will keep https://www.xxx.com from matching both http://www.xxx.com and www.xxx.com + last if @urls >= MAX_INTENT_URLS; + if (length($url) > 9) { + # start at position 9 + pos($url) = 9; + if (my @new_urls = ($url =~ m#$url_matching_regex#ogs)) { + do_log(3, "SUBURL_$url (".join(",",@new_urls).")"); + push(@suburls, @new_urls); + foreach my $new_url (@new_urls) { + $bfs_msg_body_log .= "SUBURL \Q$new_url\E found in URL $url\n"; } } - $all = 0 if !$wb; } - my($msg) = ''; - if ($all && $any_w && !$any_b) { $msg = "whitelisted" } - elsif ($all && $any_b && !$any_w) { $msg = "blacklisted" } - elsif ($all) { $msg = "black or whitelisted by all recips" } - elsif ($any_b || $any_w) { - $msg.="whitelisted by ".($any_w>1?"$any_w recips, ":"$wr, ") if $any_w; - $msg.="blacklisted by ".($any_b>1?"$any_b recips, ":"$br, ") if $any_b; - $msg.="but not by all,"; } - do_log(2,"white_black_list: $msg sender <$sender>") if $msg ne ''; - ($any_w+$any_b, $all); + + # Combine the two, minus the common initial subset (@urls). + splice(@split_urls, 0, scalar @urls); + splice(@suburls, 0, scalar @urls); + @urls = (@urls, @split_urls, @suburls); + + # use intent module and check urls + require Barracuda::Intent; + our $intent_obj; + if (defined $intent_obj) { + if (my $intent_match = $intent_obj->do_check(\@urls)) { + $Amavis::HIT_REGEXP = $intent_match; + $Amavis::HIT_CLASS = CLASS_BFS(); + + # using global to pass back + $Amavis::HIT_TYPE = $Amavis::Conf::scana_use_bfs; + do_log(1, "bfs_($Amavis::HIT_TYPE): $intent_match"); + + # record stats for domain hit + $Amavis::stats_collector->record('intent',$intent_match); + + # Record troubleshooting log. + if ($record_intent_match_info) { + my $bfs_log; + open($bfs_log, ">", "/mail/intent-log/$debug_id") or do_log(0, "Couldn't log msg body: $!"); + print $bfs_log $bfs_msg_body_log; + close($bfs_log); + } + } + my @errs = $intent_obj->clear_errors; + foreach my $err (@errs) { + do_log(1, $err); } -# - returns true if spam detected, -# - returns 0 if no spam found, -# - throws exception (die) in case of errors, -# or just returns undef if it did not complete its jobs -# -sub spam_scan($$) { - my($conn,$msginfo) = @_; - my($spam_level, $spam_status, $spam_report); - if (defined $sa_mail_body_size_limit && - ($msginfo->orig_body_size > $sa_mail_body_size_limit || - $msginfo->orig_header_size + 1 + $msginfo->orig_body_size - > 5*1024 + $sa_mail_body_size_limit) ) { - do_log(1, "spam_scan: not wasting time on SA, message ". - "longer than $sa_mail_body_size_limit bytes: ". - $msginfo->orig_header_size .'+'. $msginfo->orig_body_size); - } else { - my($fh) = $msginfo->mail_text; - $fh->seek(0,0) or die "Can't rewind mail file: $!"; - my(@lines); my($body_lines) = 0; - push(@lines, sprintf('X-Envelope-From: %s'.$eol, - qquote_rfc2821_local($msginfo->sender))); - push(@lines, sprintf('X-Envelope-To: %s'.$eol, - join(",\n ",qquote_rfc2821_local(@{$msginfo->recips})))); - # read mail into memory in preparation for SpamAssasin - while (<$fh>) { push(@lines,$_); last if $_ eq $eol } # header - while (<$fh>) { push(@lines,$_); $body_lines++ } # body - section_time('SA msg read'); + # If we matched a BFS block, then + # we drop out + + # enable the next test if you want bfs to return quickly after a tag/quarantine + if ( 0 ) # return even if only quarantining or tagging + { + section_time('body_bfs'); + goto done_and_cache; + } - my($sa_required, $sa_tests); + if ($Amavis::HIT_TYPE == TYPE_BLOCK()) + { + section_time('body_bfs'); + goto done_and_cache; + } + } + } + section_time('body_bfs'); + } + # Run SpamAssassin now, unless told not to. + } # prev_results + if ($SA_bayes_scan_msg) + { + section_time('SA_pre'); my($saved_umask) = umask; + if (!$prev_sa_results) { + + my $sa_tests; + my($remaining_time) = alarm(0); # check how much time is left eval { # NOTE ON TIMEOUTS: SpamAssassin may use timer for its own purpose, # disabling it before returning. It seems it only uses timer when # external tests are enabled, so in order for our timeout to be # useful, $sa_local_tests_only needs to be true (e.g. 1). - local $SIG{ALRM} = sub { - my($s) = Carp::longmess("SA TIMED OUT, backtrace:"); - # crop at some arbitrary limit - if (length($s) > 900) { $s = substr($s,0,900-3) . "..." } - do_log(0,$s); - }; - # prepared to wait no more than n seconds - alarm($sa_timeout) if $sa_timeout > 0; - my($mail_obj); my($sa_version) = Mail::SpamAssassin::Version(); - do_log(5, "calling SA parse, SA version $sa_version"); - if ($sa_version >= 3) { - $mail_obj = $spamassassin_obj->parse(\@lines); - } elsif ($sa_version >= 2.70) { - $mail_obj = Mail::SpamAssassin::MsgParser->parse(\@lines); - } else { - $mail_obj = Mail::SpamAssassin::NoMailAudit->new(data => \@lines, - add_From_line => 0); - } - section_time('SA parse'); - do_log(5, "CALLING SA check"); + + local $SIG{ALRM} = + sub { do_log(0, Carp::longmess("SA TIMED OUT, backtrace:")) }; + # set timeout for slowest box under harshest conditions + alarm(40); # prepared to wait no more than n seconds + my($mail_obj) = Mail::SpamAssassin::NoMailAudit->new( + data => \@lines, add_From_line => 0); + do_log(5, "CALLING NoMailAudit::check"); my($per_msg_status); { local($1,$2,$3,$4); # avoid Perl 5.8.0 bug, $1 gets tainted - $per_msg_status = $spamassassin_obj->check($mail_obj); + $per_msg_status = $spamassasin_obj->check($mail_obj, $msginfo); } my($rem_t) = alarm(0); do_log(5, "RETURNED FROM NoMailAudit::check, time left: $rem_t s"); - { local($1,$2,$3,$4); # avoid Perl 5.8.0 & 5.8.2 taint bug $spam_level = $per_msg_status->get_hits; - $sa_required = $per_msg_status->get_required_hits; # not used + #$sa_required = $per_msg_status->get_required_hits; # not used $sa_tests = $per_msg_status->get_names_of_tests_hit; - $spam_report = $per_msg_status->get_report; # taints $1 and $2 ! + $spam_report = $per_msg_status->get_report; #Experimental, unfinished: # $per_msg_status->rewrite_mail; # my($entity) = nomailaudit_to_mime_entity($mail_obj); $per_msg_status->finish(); - } + $mail_obj->finish(); # free up the rest of SA allocation }; - section_time('SA check'); + section_time('SA_scan'); umask($saved_umask); # SA changes umask to 0077 prolong_timer('spam_scan_SA', $remaining_time); # restart the timer if ($@ ne '') { # SA timed out? chomp($@); die "$@\n" if $@ ne "timed out"; } - $sa_tests = join(",\n ", split(/,\s*/,$sa_tests)); + $sa_tests = join(", ", split(/,\s*/,$sa_tests)); $spam_status = "tests=" . $sa_tests; - } my($msg) = "spam_scan: hits=$spam_level $spam_status"; $msg =~ s/,\n /,/g; do_log(2, $msg); + + # Check to see if the full header scan rbls hit and convert to block/quarantine/tag + if ($spam_status =~ /BARRACUDA_HEADER_FP/) + { + my $fp_regex; + my $fp_score = 0; + my $fp_score_total = 0; + # any blocks? + # need to pull description + # for now we just look at the first one that hits + # this is hokey, but I believe this is good enough until we get full header + # scan in the mta + #do_log(1, "spam_report: $spam_report"); + while($spam_report =~ /(7\.50|10|3\.50) BARRACUDA_HEADER_FP[^\[]*(\[\<.{10,70}\>\])?/g) { + $fp_score_total += $1; + if($fp_score < $1) { + $fp_score = $1; + $fp_regex = $2; + } + } + #do_log(1, "full_header: score= $fp_score regex: $fp_regex"); + $spam_level -= $fp_score_total; # substract rbl score from spam_level + $spam_status = ''; # this is actually unused + if ($fp_score == 10) + { + $spam_level = undef; + $spam_report = ''; + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which rbl + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_RBL(); + $Amavis::HIT_TYPE = TYPE_BLOCK(); + do_log(1, "rbl_block -- $fp_regex"); + section_time('SA_RBL'); + goto done_and_cache; + } + elsif ($fp_score == 7.50) + { + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which rbl + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_RBL(); + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); + do_log(1, "rbl_quar -- $fp_regex"); + } + elsif ($fp_score == 3.50) + { + # if we are already quarantining, skip tagging + if ($Amavis::HIT_TYPE != TYPE_QUARANTINE()) + { + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which rbl + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_RBL(); + $Amavis::HIT_TYPE = TYPE_TAG(); + do_log(1, "rbl_tag -- $fp_regex"); + } + } + section_time('SA_RBL'); + #$spam_report = ''; # leave spam_report in the headers + } + + # Check to see if the DKIM rule hit and convert to block/quarantine/tag + if ($sa_tests =~ /BARRACUDA_DKIM/) { + my $fp_regex; + my $fp_score = 0; + my $fp_score_total = 0; + # any blocks? + # need to pull description + if ($spam_report =~ /(7\.50|10|3\.50) BARRACUDA_DKIM.+?\:\s(.*\))?/s) { + $fp_score_total += $1; + #if($fp_score < $1) { + $fp_score = $1; + $fp_regex = $2; + $fp_regex =~ s/\n\s*/ /; + $fp_regex = substr($fp_regex, 0, 70); + #} + } + $spam_level -= $fp_score_total; # substract dkim score from spam_level + if ($fp_score == 10) + { + $spam_level = undef; + $spam_report = ''; + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which domain + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_DKIM(); + $Amavis::HIT_TYPE = TYPE_BLOCK(); + do_log(1, "dkim_block -- $fp_regex"); + goto done_and_cache; + } + elsif ($fp_score == 7.50) + { + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which domain + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_DKIM(); + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); + do_log(1, "dkim_quar -- $fp_regex"); + } + elsif ($fp_score == 3.50) + { + # if we are already quarantining, skip tagging + if ($Amavis::HIT_TYPE != TYPE_QUARANTINE()) + { + $Amavis::HIT_REGEXP = $fp_regex; # want to capture which domain + utf8::upgrade($Amavis::HIT_REGEXP); + $Amavis::HIT_CLASS = CLASS_DKIM(); + $Amavis::HIT_TYPE = TYPE_TAG(); + do_log(1, "dkim_tag -- $fp_regex"); + } + } + } # end DKIM check + + # We can skip the rest of the spam scannning process if we know we are going to block + # We really want to be able to use per user block tests (or have threshold passed in) + if ($Amavis::HIT_TYPE == TYPE_BLOCK()) + { + goto done_and_cache; + } + # assume bayes is off + } #prev_results + $need_bayes = 1; # darn magic constants - NO_BAYES_NEEDED + if ($Amavis::use_barracuda_bayes) { + # + # Barracuda::Bayes + # + require Barracuda::Environment; + require Barracuda::Bayes; + require Barracuda::AliasLink; + + + my $bayes = new Barracuda::Bayes; + + # + # XXX: Hack! We check to see if the token 3189419349, or + # "Barracuda Spam Firewall", exists. This is a chained token. + # If it does *not* exist, disable chaining when tokenizing the + # message. Since this is a hack, we're only checking the admin + # database. It's possible that on upgrade to 3.2 we might be + # sabotaging per-user scoring, but the risk is worth it since we + # don't want to be re-parsing a message for every user. + # + # 2005-08-17 (William): + # This shouldn't be needed anymore. We blow away + # databases on upgrade to 3.3. + # + #my $chained = $bayes->dump('admin',3189419349); + # + #if ($chained && $chained->{ham_hits} == 0 && $chained->{spam_hits} == 0) { + # undef $bayes; + # $bayes = new Barracuda::Bayes {chain_max => 1}; + #} + + if (defined $bayes) { + my $recip; + my $user; + my $database; + my $score; + my $stats; + my $scanned_the_part = 0; + # XXX: Override the default die() signal handler. We don't + # want Perl to longjmp() out of any code which manipulates a + # database, otherwise we could end up w/ a deadlock. + # + # NOTE: This should eventually be done in the Perl XS code. + # + my $remaining_time = alarm(0); + local $SIG{ALRM} = sub { return }; + + alarm($remaining_time); + + section_time("io_cuda_bayes"); + + foreach my $r (@{$msginfo->per_recip_data}) { + #$recip = Barracuda::AliasLink::resolve($r->recip_addr); + $recip = $Amavis::PU_REAL_EMAIL_MAP{$r->recip_addr} + || $Amavis::PU_UID_MAP{$r->recip_addr} + || $r->recip_addr; + + # + # Choose per-user or global + # + foreach $user ($recip, 'admin') { + next if ($user ne 'admin' && !$Amavis::enable_user_bayes); + + if ($bayes->exists($user)) { + $stats = $bayes->getStats($user) or do { + do_log(1,"Barracuda::Bayes::getStats failed for user $recip: $!"); + next; + }; + + if ($stats->{ham_classified} >= 200 && $stats->{spam_classified} >= 200) { + $database = $user; + last; + } + } + } + + next unless defined $database; + + # We do this here so we don't bother scanning for Bayes + # until we know that we at least have a database to check + # against. + unless ($scanned_the_part) { + $scanned_the_part = 1; + unless ($bayes->addMIME("$tempdir/email.txt")) { + goto BAYES_INIT_FAILED; + } + } + + $score = $bayes->score($database); + + if ($score) { + my $spam = ($score->{isspam})? 'SPAM' : 'INNOCENT'; + my $dict = ($database eq $recip)? 'USER' : 'GLOBAL'; + my $scaled = ($score->{isspam} && $score->{probability} < 0.9) + ? 10 * 0.9 + : 10 * $score->{probability}; + # If it is classified as SPAM but the probability isn't + # greater than 0.9 then it was classified using Chi-Robinson + + my $weight = ($scaled > 5) ? $scaled - 5 : 0 - (5 - $scaled); + + # Moderate the weight using the sample confidence. + # Confidence should be 0 - 1, though it seems it can be + # more than 1 sometimes, so cap it. + $weight *= ($score->{confidence} > 1.0) + ? 1.0 + : $score->{confidence}; + + # + # Apply logarithmic scale to the weight. Using log base 6 + # seems to work best for our weight in the range {-5,5}. + # + # Any weight less than 1.8 crosses the X axis, changing + # signs. Therefore, zero is effectively the product of + # anything {1.8,-1.8} log base 6. + # + # The resulting weights after log base 6 look like: + # + # -5 => -5.13 + # -4 => -3.21 + # -3 => -1.55 + # -2 => -0.22 + # -1 => 0 + # 0 => 0 + # +1 => 0 + # +2 => +0.22 + # +3 => +1.55 + # +4 => +3.21 + # +5 => +5.13 + # + # slight scale and offset adjustments to bring scores + # back closer to original spamassassin 3.1 scores + if ($weight > 0) { + $weight = 0.8 * $weight * (log(abs($weight)) / log 6); + $weight = 0 if $weight < 0; + $weight += 0.75; + } elsif ($weight < 0) { + $weight = 0.45 * $weight * (log(abs($weight)) / log 6); + $weight = 0 if $weight > 0; + } + else { # $weight of 0 converts .01 + $weight = 0.01; + } + + %bayes_score = ( + isspam => $score->{isspam}, + probability => $score->{probability}, + confidence => $score->{confidence}, + + dictionary => ($database eq $recip) + ? Amavis::In::Message::PerRecip::USER_DICTIONARY + : Amavis::In::Message::PerRecip::GLOBAL_DICTIONARY, + + weight => $weight + ); + + # we have a bayes score, compute what we need to put in the cache + + # Is this a global result? + if ($database eq 'admin') + { + $need_bayes = 2; # store the result + } + else + { + $need_bayes = 3; # this was a per user result, do not update cache + } + + $r->recip_bayes_score(\%bayes_score); + + #$Amavis::BAYES_HEADER .= sprintf("%s %s %s %.4f %.4f;",$recip,$spam,$dict,$score->{probability},$score->{confidence}); + $Amavis::BAYES_HEADER .= sprintf("%s %s %.4f %.4f %2.4f;",$spam,$dict,$score->{probability},$score->{confidence},$weight); + + do_log(1,"Barracuda::Bayes score for user $recip: ISSPAM: $score->{isspam} Probability: $score->{probability} Confidence: $score->{confidence} Weight: $weight"); + } else { + do_log(1,"Barracuda::Bayes::score failed for user $recip: $!"); + } + } # foreach(@{$msginfo->per_recip_data}) + + chop $Amavis::BAYES_HEADER; + + # Restore remaining alarm time (reset at beginning of Bayes + # section) + alarm($remaining_time); + } else { + BAYES_INIT_FAILED: + if ($@) { + do_log(1,"Barracuda::Bayes failed: $@"); + } elsif ($!) { + do_log(1,"Barracuda::Bayes failed: $!"); + } else { + do_log(1,"Barracuda::Bayes failed to parse message."); + } + } # if (defined $bayes && $bayes->addFile()) + + undef $bayes; + + section_time("dn_cuda_bayes"); + + } # if($use_barracuda_bayes) + } # $SA_bayes_scan_msg + + if (!$prev_results) + { + + if ($Amavis::HIT_TYPE == TYPE_QUARANTINE()) + { + # We can return now, further tests will do no better + goto no_more_tests; + } +## +# Do Keyword Quarantine tests +## + + # These tests are shortcircuiting: early hits abort any additional keyword testing + # + # + + # RBL quarantine + my $brlreason = $msginfo->mime_entity->head->get('X-Barracuda-BRL-Quarantine', 0); + my $rblreason = $msginfo->mime_entity->head->get('X-ASG-Quarantine-RBL', 0); + if($brlreason || $rblreason) + { + if($brlreason) { + $Amavis::HIT_CLASS = CLASS_BRL(); + } else { + $Amavis::HIT_REGEXP = $rblreason; + $Amavis::HIT_CLASS = CLASS_RBL(); + } + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); + if($brlreason) { + do_log(1, "brl_tag -- $brlreason"); + } else { + do_log(1, "rbl_tag -- $rblreason"); + } + goto no_more_tests; + } + + # subject + ($result, $regexp) = &$Amavis::Conf::quarantined_subject_re($subject_header); + section_time("subj_quar"); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_CLASS = CLASS_SUBJECT(); # using global to pass back + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); # using global to pass back + do_log(1, "subject_quar"); + goto no_more_tests; + } + + # header + ($result, $regexp) = &$Amavis::Conf::quarantined_header_re($all_headers); + section_time("hedr_quar"); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_HEADER(); # using global to pass back + do_log(1, "header_quar"); + goto no_more_tests; + } + + # body + ($result, $regexp) = &$Amavis::Conf::quarantined_body_re($msg_body); + section_time('body_qua'); + + if ($result) + { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_QUARANTINE(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_BODY(); # using global to pass back + do_log(1, "body_quar"); + goto no_more_tests; + } + + + if (!$quarantined_filename_re) { + do_log(5, "quarantined_filename_presence skipped, no tests"); + } elsif (!grep {!lookup($Amavis::PU_REAL_EMAIL_MAP{$_} || $_, + $Amavis::bypass_banned_checks_sql,$Amavis::bypass_banned_checks_ldap, + \%Amavis::bypass_banned_checks, \@Amavis::bypass_banned_checks_acl, + $Amavis::bypass_banned_checks_re)} @recips) { + do_log(5, "bypassing of quarantined_filename_presence requested"); + } else { + my $quarantined_filenames_ref; + # check for banned mime file name or banned mime-type + ($quarantined_filenames_ref) = + check_for_banned_filenames($quarantined_filename_re, + $msginfo->mime_entity, undef, undef); + push(@Amavis::quarantined_filename, @$quarantined_filenames_ref); + + ($quarantined_filenames_ref) = + check_for_banned_filenames($quarantined_filename_re, + undef, \@Amavis::msgparts, $file_generator_object); + push(@Amavis::quarantined_filename, @$quarantined_filenames_ref); + if (scalar(@Amavis::quarantined_filename) > 0) + { + # no reason to go any further + $need_fnames = 2; # we may need to cache the quarantined filenames + goto done_and_cache; + } + } + + if ($Amavis::HIT_TYPE == TYPE_TAG()) + { + # We can return now, further tests will do no better + goto no_more_tests; + } +## +# Did the MTA say we should tag this for SPF? +## + { + my $spftag = $msginfo->mime_entity->head->get('X-ASG-Tag'); + if ($spftag eq "SPF\n") { + $Amavis::HIT_CLASS = CLASS_SPF(); + $Amavis::HIT_TYPE = TYPE_TAG(); + goto no_more_tests; + } else { + do_log(0,"\$spftag = \"$spftag\""); + } + } + +## +# Do Keyword Tag tests +## + if( $Barracuda::Environment::mode ne 'outbound' ) { + + # RBL tagging + if(my $brlreason = $msginfo->mime_entity->head->get('X-Barracuda-BRL-Tag', 0)) + { + $Amavis::HIT_CLASS = CLASS_BRL(); + $Amavis::HIT_TYPE = TYPE_TAG(); + do_log(1, "brl_tag -- $rblreason"); + goto no_more_tests; + } + elsif(my $rblreason = $msginfo->mime_entity->head->get('X-ASG-RBL-Restriction', 0)) + { + $Amavis::HIT_REGEXP = $rblreason; + $Amavis::HIT_CLASS = CLASS_RBL(); + $Amavis::HIT_TYPE = TYPE_TAG(); + do_log(1, "rbl_tag -- $rblreason"); + goto no_more_tests; + } + + # subject + ($result, $regexp) = &$Amavis::Conf::tagged_subject_re($subject_header); + section_time("subj_tag"); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_CLASS = CLASS_SUBJECT(); # using global to pass back + $Amavis::HIT_TYPE = TYPE_TAG(); # using global to pass back + do_log(1, "subject_tag - $subject_header "); + goto no_more_tests; + } + + # keyword header + ($result, $regexp) = &$Amavis::Conf::tagged_header_re($all_headers); + section_time("hedr_tag"); + + if ($result) { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_TAG(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_HEADER(); # using global to pass back + do_log(1, "header_tag"); + goto no_more_tests; + } + + # keyword body + ($result, $regexp) = &$Amavis::Conf::tagged_body_re($msg_body); + section_time('body_tag'); + + if ($result) + { + $Amavis::HIT_REGEXP = $regexp; + $Amavis::HIT_TYPE = TYPE_TAG(); # using global to pass back + $Amavis::HIT_CLASS = CLASS_BODY(); # using global to pass back + do_log(1, "body_tag"); + } + } + +no_more_tests: + + # Set the message scan skip because of message size if needed + if ($huge_msg) { + $Amavis::REASON_ID = 38; #tsk tsk, side affects + $Amavis::ACTION_ID = 0; + $spam_level = -1001; + goto done_and_cache; + } + + # Set the message scan skip because of outbound bypass + # CH: This may need its own special reason ID. + if ( $Amavis::Conf::outbound_bypass_sa) { + $Amavis::REASON_ID = 0; # tsk tsk again, side affects + $Amavis::ACTION_ID = 0; + $spam_level = -1002; + goto done_and_cache; + } + } # prev_results + + # return result of spamassassin run + # if we knew the tag, quarantine, and kill levels, we could have possibly returned earlier + # + # cache results +done_and_cache: + if ($multi_recip && $Amavis::saresults_cache && $mta_id) { + do_log(2, "caching scan results for $mta_id nb=$need_bayes sl=$spam_level, ss=$spam_status, fns=$need_fnames hr=$Amavis::HIT_REGEXP, hc=$Amavis::HIT_CLASS, ht=$Amavis::HIT_TYPE"); + + # + # store bayes if global and computed + if ($need_bayes == 2) + { + $Amavis::saresults_cache->update("$mta_id:scan_bayes", + [ $Amavis::BAYES_HEADER, + $bayes_score{isspam}, + $bayes_score{probability}, + $bayes_score{confidence}, + $bayes_score{dictionary}, + $bayes_score{weight} + ] ); + # force writing of primary results to change need_bayes + $prev_results = undef; + } + + # store primary results last to avoid race condition + if (!$prev_results) + { + if ($need_fnames == 1) + { + $Amavis::saresults_cache->update("$mta_id:fns", \@Amavis::banned_filename); + } + elsif ($need_fnames == 2) + { + $Amavis::saresults_cache->update("$mta_id:fns", \@Amavis::quarantined_filename); + } + + $Amavis::saresults_cache->update("$mta_id:scan_pri", + [$spam_level, $spam_status, $spam_report, + $Amavis::HIT_REGEXP, $Amavis::HIT_CLASS, $Amavis::HIT_TYPE, + $need_bayes, $need_fnames]); + } + + $mutex && $mutex->unlock(); + } ($spam_level, $spam_status, $spam_report); } +# Returns ctime and mtime for the filename/handle parameter given. +sub get_cmtime { + require POSIX; + POSIX->import qw(strftime); + my $fh = shift; + my ($mtime, $ctime) = (stat $fh)[9,10]; + my $ts = ''; + foreach my $time ($ctime, $mtime) { + $ts .= " : " . strftime("%FT%T", gmtime($time)); + } + return $ts; +} + #sub nomailaudit_to_mime_entity($) { -# my($mail_obj) = @_; # expect a Mail::SpamAssassin::MsgContainer object +# my($mail_obj) = @_; # expect a Mail::SpamAssassin::NoMailAudit object # my(@m_hdr) = $mail_obj->header; # in array context returns array of lines # my($m_body) = $mail_obj->body; # returns array ref # my($entity); @@ -8577,7 +11870,7 @@ # # log both infected and noninfected messages (default): [? %#V |[? %#F |[?%#D|Not-Delivered|Passed]|BANNED name/type (%F)]|INFECTED (%V)], # -<%o> -> [<%R>|,][? %i ||, quarantine %i], Message-ID: %m, Hits: %c +<%o> -> [<%R>|,][? %i ||, quarantine %i], Message-ID: %m __DATA__ # # ============================================================================= @@ -8587,9 +11880,10 @@ # field heads must begin with "X-" . # Subject: Undeliverable mail[?%#X|#|, invalid characters in header] + Message-ID: -[? %#X |#|INVALID HEADER (INVALID CHARACTERS OR SPACE GAP) +[? %#X |#|INVALID CHARACTERS IN HEADER [%X\n] ]\ @@ -8623,7 +11917,6 @@ to _your_ postmaster or system manager. ] -Return-Path: %s Your message[?%m|| %m] could not be delivered to:[ %N] __DATA__ @@ -8638,61 +11931,24 @@ [? %m |#|In-Reply-To: %m] Message-ID: -[? %#V |[? %#F |[? %#X ||INVALID HEADER]|BANNED CONTENTS ALERT]|VIRUS ALERT] +[? %#V |[? %#F |[? %#X ||INVALID CHARACTERS IN HEADER]|BANNED FILENAME ALERT]|VIRUS ALERT] -Our content checker found +The Spam Firewall found [? %#V |#| [? %#V |viruses|virus|viruses]: %V] [? %#F |#| banned [? %#F |names|name|names]: %F] [? %#X |#|\n[%X\n]] -in email presumably from you (%s), to the following [? %#R |recipients|recipient|recipients]:[ +in your email to the following [? %#R |recipients|recipient|recipients]:[ -> %R] -[? %#V ||Please check your system for viruses, +Please check your system [?%#V||for viruses], or ask your system administrator to do so. -]# -[? %#D |Delivery of the email was stopped! +[? %#D |Delivery of the email was stopped. ]# -[? %#V |[? %#F ||# -The message has been blocked because it contains a component -(as a MIME part or nested within) with declared name -or MIME type or contents type violating our access policy. - -To transfer contents that may be considered risky or unwanted -by site policies, or simply too large for mailing, please consider -publishing your content on the web, and only sending an URL of the -document to the recipient. - -Depending on the recipient and sender site policies, with a little -effort it might still be possible to send any contents (including -viruses) using one of the following methods: - -- encrypted using pgp, gpg or other encryption methods; - -- wrapped in a password-protected or scrambled container or archive - (e.g.: zip -e, arj -g, arc g, rar -p, or other methods) - -Note that if the contents is not intended to be secret, the -encryption key or password may be included in the same message -for recipient's convenience. - -We are sorry for inconvenience if the contents was not malicious. - -The purpose of these restrictions is to cut the most common propagation -methods used by viruses and other malware. These often exploit automatic -mechanisms and security holes in certain mail readers (Microsoft mail -readers and browsers are a common and easy target). By requiring an -explicit and decisive action from the recipient to decode mail, -the dangers of automatic malware propagation is largely reduced. -# -# Details of our mail restrictions policy are available at ... - -]]# For your reference, here are headers from your email: ------------------------- BEGIN HEADERS ----------------------------- -Return-Path: %s [%H ]\ -------------------------- END HEADERS ------------------------------ @@ -8705,7 +11961,7 @@ # field heads must begin with "X-" . # Date: %d -From: %f +From: [] Subject: [? %#V |[? %#F |[? %#X ||INVALID HEADER]|BANNED NAME (%F)]|VIRUS (%V)]# FROM[?%l|| LOCAL] [?%o|(?)|<%o>] To: [? %#T |undisclosed-recipients: ;|[<%T>|, ]] @@ -8748,14 +12004,13 @@ %q ] ------------------------- BEGIN HEADERS ----------------------------- -Return-Path: %s [%H ]\ -------------------------- END HEADERS ------------------------------ __DATA__ # # ============================================================================= -# This is a template for VIRUS/BANNED RECIPIENTS NOTIFICATIONS. +# This is a template for VIRUS RECIPIENTS NOTIFICATIONS. # For syntax and customization instructions see README.customize. # Note that only valid header fields are allowed; non-standard header # field heads must begin with "X-" . @@ -8770,18 +12025,16 @@ [? %#V |[? %#F ||BANNED NAME ALERT]|VIRUS ALERT] -Our content checker found -[? %#V |#| [? %#V |viruses|virus|viruses]: %V] -[? %#F |#| banned [? %#F |names|name|names]: %F] -[? %#X |#|\n[%X\n]] -in an email to you [? %S |from unknown sender:|from:] +The Spam Firewall found +[? %#V |#| %V\n[? %#V |viruses|virus|viruses] #] +[? %#F |#| %F\nbanned [? %#F |names|name|names] #] +in an email to you [? %o |from unknown sender.|from: - %o + %o] -[? %q |Not quarantined.|The message has been quarantined as: +[? %q |The message has been blocked.|The message has been quarantined as: %q] -Please contact your system administrator for details. __DATA__ # # ============================================================================= @@ -8799,7 +12052,6 @@ was considered unsolicited bulk e-mail (UBE). Subject: %j -Return-Path: %s [? %#D |Delivery of the email was stopped! ]# @@ -8847,7 +12099,6 @@ ]\ ------------------------- BEGIN HEADERS ----------------------------- -Return-Path: %s [%H ]\ -------------------------- END HEADERS ------------------------------ Property changes on: amavisd ___________________________________________________________________ Name: svn:keywords + author date id Name: svn:eol-style + native