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