package Amavis::Boot;
use strict;
sub fetch_modules($$@) {
my($reason,$required,@modules) = @_;
my(@missing);
for my $m (@modules) {
local($_) = $m; $_ .= /^auto::/ ? '.al' : '.pm'; s[::][/]g;
eval {require $_} or push(@missing,$m);
}
die "ERROR: MISSING $reason:\n" .
join('', map {" $_\n"} @missing) if $required && @missing;
};
BEGIN {
fetch_modules('REQUIRED BASIC MODULES', 1, qw(
Exporter POSIX Fcntl Socket Errno Carp Time::HiRes
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
MIME::Head MIME::Body MIME::Entity MIME::Parser
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
) );
};
1;
package Amavis::Conf;
use strict;
sub D_REJECT(); sub D_BOUNCE(); sub D_DISCARD(); sub D_PASS();
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = ();
%EXPORT_TAGS = (
'confvars' => [qw(
$myversion $mydomain
$MYHOME $TEMPBASE $QUARANTINEDIR
$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
$max_servers $max_requests $child_timeout
$warnvirussender $warnspamsender
$warnbannedsender $warnbadhsender
$warnvirusrecip $warnbannedrecip
$log_templ
$unix_socketname $inet_socket_port $inet_socket_bind @inet_acl
$myhostname $localhost_name
$insert_received_line
$mta_in_type $gets_addr_in_quoted_form
$mta_out_type $forward_method
$relayhost_is_client
$X_HEADER_TAG $X_HEADER_LINE
$remove_existing_x_scanned_headers $remove_existing_spam_headers
%local_delivery_aliases
$hdr_encoding $bdy_encoding
$final_virus_destiny $final_spam_destiny
$final_banned_destiny $final_bad_header_destiny
$recipient_delimiter $replace_existing_extension
$localpart_is_case_sensitive
$addr_extension_banned $addr_extension_virus $addr_extension_spam
$smtpd_recipient_limit
$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_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
%bypass_header_checks @bypass_header_checks_acl $bypass_header_checks_re
%virus_lovers @virus_lovers_acl $virus_lovers_re
%spam_lovers @spam_lovers_acl $spam_lovers_re
%banned_files_lovers @banned_files_lovers_acl $banned_files_lovers_re
%bad_header_lovers @bad_header_lovers_acl $bad_header_lovers_re
%whitelist_sender @whitelist_sender_acl $whitelist_sender_re
$per_recip_whitelist_sender_lookup_tables
%blacklist_sender @blacklist_sender_acl $blacklist_sender_re
$per_recip_blacklist_sender_lookup_tables
$viruses_that_fake_sender_re
@lookup_sql_dsn $sql_key_fieldname
$sql_select_policy $sql_select_white_black_list
$enable_ldap $default_ldap $virus_lovers_ldap
$banned_files_lovers_ldap $bypass_virus_checks_ldap
$bypass_spam_checks_ldap $spam_tag_level_ldap
$spam_tag2_level_ldap $spam_kill_level_ldap
$spam_modifies_subj_ldap $local_domains_ldap
%local_domains @local_domains_acl $local_domains_re
)],
'notifyconf' => [qw(
$notify_method
$notify_xmailer_header
$virus_quarantine_method
$spam_quarantine_method
$mailfrom_notify_sender
$mailfrom_notify_admin
$mailfrom_notify_recip
$mailfrom_notify_spamadmin
$mailfrom_to_quarantine
$hdrfrom_notify_sender
$hdrfrom_notify_admin
$hdrfrom_notify_spamadmin
%virus_admin %spam_admin $virus_admin $spam_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
$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
)],
'sa' => [qw(
$helpers_home
$sa_tag_level_deflt $sa_tag2_level_deflt $sa_kill_level_deflt
$sa_spam_subject_tag $sa_spam_modifies_subj
$sa_local_tests_only $sa_debug $sa_mail_body_size_limit
$sa_auto_whitelist
)],
'platform' => [qw(
$can_truncate
$unicode_aware
$eol
&D_REJECT &D_BOUNCE &D_DISCARD &D_PASS
)],
);
Exporter::export_tags qw(confvars notifyconf unpack sa platform);
}
use POSIX qw(uname);
use Errno qw(ENOENT);
use vars @EXPORT;
$myversion = 'amavisd-new-20030616-p2';
$eol = "\n"; $unicode_aware = $]>=5.008 && length("\x{263a}")==1 && eval { require Encode };
$MYHOME = '/var/amavis';
$mydomain = '!change-mydomain-variable!.example.com';
$DEBUG = 0;
$daemonize = 0;
$max_servers = 2; $max_requests = 10;
$child_timeout = 8*60;
$can_truncate = 1;
$SYSLOG_LEVEL = "mail.info";
$sql_select_policy =
'SELECT *,users.id FROM users,policy'.
' WHERE (users.policy_id=policy.id) AND (users.email IN (%k))'.
' ORDER BY users.priority DESC';
$sql_select_white_black_list =
'SELECT wb FROM wblist,mailaddr'.
' WHERE (rid=?) AND (sid=mailaddr.id) AND (mailaddr.email IN (%k))'.
' ORDER BY mailaddr.priority DESC';
$inet_socket_bind = '127.0.0.1';
@inet_acl = qw( 127.0.0.1 );
$gets_addr_in_quoted_form = 1;
$notify_method = 'smtp:127.0.0.1:10025';
$forward_method = 'smtp:127.0.0.1:10025';
$virus_quarantine_method = 'local:virus-%i-%n';
$spam_quarantine_method = 'local:spam-%b-%i-%n';
$insert_received_line = 1; $remove_existing_x_scanned_headers = 0;
$remove_existing_spam_headers = 1;
$hdr_encoding = 'iso-8859-1'; $bdy_encoding = 'iso-8859-1';
$smtpd_recipient_limit = 1000;
$myhostname = (uname)[1];
$localhost_name = 'localhost';
$mailfrom_to_quarantine = undef;
$virus_quarantine_to = undef; $spam_quarantine_to = undef;
$spam_quarantine_bysender_to = undef;
$QUARANTINEDIR = undef;
$sa_spam_subject_tag = undef; $sa_spam_modifies_subj = 1;
$sa_local_tests_only = 0;
$sa_debug = 0;
sub D_REJECT () { -3 }
sub D_BOUNCE () { -2 }
sub D_DISCARD() { 0 }
sub D_PASS () { 1 }
$final_virus_destiny = D_BOUNCE; $final_banned_destiny = D_BOUNCE; $final_spam_destiny = D_REJECT; $final_bad_header_destiny = D_PASS;
$addr_extension_banned = undef; $addr_extension_virus = undef; $addr_extension_spam = undef;
$recipient_delimiter = '+';
$replace_existing_extension = 1;
$localpart_is_case_sensitive = 0;
use vars qw($mailfrom);
*read_text = \&Amavis::Util::read_text;
*read_l10n_templates = \&Amavis::Util::read_l10n_templates;
*read_hash = \&Amavis::Util::read_hash;
*ask_daemon = \&Amavis::AV::ask_daemon;
*sophos_savi = \&Amavis::AV::sophos_savi;
sub new_RE { Amavis::Lookup::RE->new(@_) };
use vars qw(@local_domains);
*local_domains = \@local_domains_acl;
sub read_config($) {
my($config_file) = @_;
my($msg);
my($errn) = stat($config_file) ? 0 : 0+$!;
if ($errn == ENOENT) { $msg = "does not exist" }
elsif ($errn) { $msg = "inaccessible: $!" }
elsif (! -f _) { $msg = "not a regular file" }
elsif (! -r _) { $msg = "not readable" }
if (defined $msg) { die "Config file $config_file $msg" }
do $config_file;
if ($@ ne '') { die "Error in config file $config_file: $@" }
if (!$mailfrom_notify_admin && !$mailfrom_notify_recip &&
!$mailfrom_notify_spamadmin) {
$mailfrom_notify_admin = $mailfrom_notify_recip = $mailfrom;
$mailfrom_notify_spamadmin = $mailfrom;
}
for ($DEBUG, $DO_SYSLOG, $warn_offsite, $warnvirussender, $warnvirusrecip,
$warnspamsender, $warnbannedsender, $warnbadhsender)
{ $_ = 0 if /^\s*NO\s*$/i }
$TEMPBASE = $MYHOME if !defined $TEMPBASE;
$helpers_home = $MYHOME if !defined $helpers_home;
$pid_file = "$MYHOME/amavisd.pid" if !defined $pid_file;
$lock_file = "$MYHOME/amavisd.lock" if !defined $lock_file;
$hdrfrom_notify_sender = "amavisd-new <postmaster\@$myhostname>"
if !defined $hdrfrom_notify_sender;
$hdrfrom_notify_admin = $mailfrom_notify_admin ne ''
? $mailfrom_notify_admin : $hdrfrom_notify_sender
if !defined $hdrfrom_notify_admin;
$hdrfrom_notify_spamadmin = $mailfrom_notify_spamadmin ne ''
? $mailfrom_notify_spamadmin : $hdrfrom_notify_sender
if !defined $hdrfrom_notify_spamadmin;
for ($final_virus_destiny,$final_banned_destiny,$final_spam_destiny) {
if ($_ > 0) { $_ = D_PASS }
elsif ($_ < 0 && $_ != D_BOUNCE && $_ != D_REJECT) { $_ = $forward_method eq '' ? D_REJECT : D_BOUNCE;
}
}
if ($final_virus_destiny == D_DISCARD && $warnvirussender)
{ $final_virus_destiny = D_BOUNCE }
if ($final_spam_destiny == D_DISCARD && $warnspamsender)
{ $final_spam_destiny = D_BOUNCE }
if ($final_banned_destiny == D_DISCARD && $warnbannedsender)
{ $final_banned_destiny = D_BOUNCE }
if ($final_bad_header_destiny == D_DISCARD && $warnbadhsender)
{ $final_bad_header_destiny = D_BOUNCE }
}
1;
package Amavis::Timing;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&init §ion_time &report);
}
use subs @EXPORT_OK;
use Time::HiRes qw(time);
use vars qw(@timing);
sub init() {
@timing = ();
section_time('init');
}
sub section_time($) {
push(@timing, shift, time);
}
sub report() {
section_time('rundown');
my($notneeded, $t0) = (shift(@timing), shift(@timing));
my($total) = $timing[$ if ($total < 0.0000001) { $total = 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 ) );
$t0 = $t;
}
sprintf("TIMING [total %.0f ms] - %s",
$total*1000, join(", ", @sections));
}
1;
package Amavis::Lock;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT = qw(&lock &unlock);
}
use Fcntl qw(:flock);
use subs @EXPORT;
sub lock($) {
my $file = shift;
flock($file, LOCK_EX) or die "Can't lock $file: $!";
seek($file, 0, 2) or die "Can't position $file to its tail: $!";
}
sub unlock($) {
my $file = shift;
flock($file, LOCK_UN) or die "Can't unlock $file: $!";
}
1;
package Amavis::Log;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&init &write_log);
}
use subs @EXPORT_OK;
use POSIX qw(strftime);
use Unix::Syslog qw(:macros :subs);
use IO::File;
use File::Basename;
BEGIN {
import Amavis::Conf qw(:platform $myversion $myhostname);
import Amavis::Lock;
}
use vars qw($loghandle); 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) = @_;
$myname = $1 if basename($0) =~ /^(.*)$/;
if ($syslog_level =~ /^\s*([a-z0-9]+)\.([a-z0-9]+)\s*$/i) {
$syslog_facility = eval("LOG_\U$1");
$syslog_priority = eval("LOG_\U$2");
}
$syslog_facility = LOG_DAEMON if $syslog_facility !~ /^\d+$(?!\n)/;
$syslog_priority = LOG_WARNING if $syslog_priority !~ /^\d+$(?!\n)/;
if ($do_syslog) {
openlog($ident, LOG_PID, $syslog_facility);
} else {
$loghandle = IO::File->new($logfile, 'a')
or die "Failed to open log file $logfile: $!";
$loghandle->autoflush(1);
}
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{LANG}" if $ENV{LC_TYPE} ne '';
$msg .= ", LANG=$ENV{LANG}" if $ENV{LANG} ne '';
write_log($msg, undef);
}
sub write_log($$) {
my($errmsg,$am_id) = @_;
my($really_log_to_stderr) = $log_to_stderr || (!$do_syslog && !$loghandle);
my($prefix);
if ($really_log_to_stderr || !$do_syslog) { $prefix = sprintf("%s %s %s[%s]: ",
strftime("%b %e %H:%M:%S", localtime),
$myhostname, $myname, $$);
}
$am_id = "($am_id) " if defined $am_id;
$errmsg = Amavis::Util::sanitize_str($errmsg);
if ($really_log_to_stderr) {
print STDERR $prefix,$am_id,$errmsg,$eol;
} elsif ($do_syslog) {
my($pre); my($logline_size) = 980; while (length($am_id.$pre.$errmsg) > $logline_size) {
my($avail) = $logline_size - length($am_id.$pre."...");
syslog($syslog_priority, "%s",
$am_id . $pre . substr($errmsg,0,$avail) . "...");
$pre = "..."; $errmsg = substr($errmsg,$avail);
}
syslog($syslog_priority, "%s", $am_id.$pre.$errmsg);
} else {
lock($loghandle);
print $loghandle $prefix,$am_id,$errmsg,$eol;
unlock($loghandle);
}
}
1;
package Amavis::Util;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&safe_encode &am_id &do_log &debug_oneshot
&retcode &prolong_timer &sanitize_str &min &max
&strip_tempdir &rmdir_recursively &rmdir_flat
&read_text &read_l10n_templates &read_hash &run_command);
}
use subs @EXPORT_OK;
use POSIX qw(WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED);
use Errno qw(ENOENT);
BEGIN {
import Amavis::Conf qw(:platform :notifyconf $DEBUG $log_level);
import Amavis::Log qw(write_log);
import Amavis::Timing qw(section_time);
}
sub safe_encode($$;$) {
if (!$unicode_aware) { $_[1] } else {
my($encoding, $str, $check) = @_;
$check = 0 if !defined($check);
my($taint) = substr($str,0,0); $str =~ /^(.*)$(?!\n)/s; $str = $1; $taint . Encode::encode($encoding, $str, $check); }
}
use vars qw($amavis_task_id); sub am_id(;$) {
if (@_) { $amavis_task_id = shift;
$0 = "amavisd ($amavis_task_id)";
}
$amavis_task_id; }
sub do_log($$) {
my($level,$errmsg) = @_;
$level = 0 if $DEBUG || debug_oneshot();
write_log($errmsg, am_id()) if $level <= $log_level;
}
use vars qw($debug_oneshot);
sub debug_oneshot(;$$) {
if (@_) {
my($new_debug_oneshot) = shift;
if (($new_debug_oneshot?1:0) != ($debug_oneshot?1:0)) {
do_log(0, "DEBUG_ONESHOT: TURNED ".
($new_debug_oneshot ? "ON" : "OFF"));
do_log(0, shift) if @_; }
$debug_oneshot = $new_debug_oneshot;
}
$debug_oneshot;
}
sub retcode($) {
my $code = shift;
return WEXITSTATUS($code) if WIFEXITED($code);
return 128+WTERMSIG($code) if WIFSIGNALED($code);
return 255;
}
sub prolong_timer($;$) {
my($which_section,$child_remaining_time) = @_;
if (!defined($child_remaining_time)) {
$child_remaining_time = Time::HiRes::alarm(0); }
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); }
sub sanitize_str {
my($str,$keep_eol) = @_;
my(%map) = ("\r"=>'\\r', "\n"=>'\\n', "\f"=>'\\f', "\t"=>'\\t',
"\b"=>'\\b', "\e"=>'\\e', "\\"=>'\\\\');
if ($keep_eol) {
$str =~ s/([^\012\040-\133\135-\176])/ exists($map{$1}) ? $map{$1} :
sprintf(ord($1)>255 ? '\\x{%04x}' : '\\%03o', ord($1))/eg;
} else {
$str =~ s/([^\040-\133\135-\176])/ exists($map{$1}) ? $map{$1} :
sprintf(ord($1)>255 ? '\\x{%04x}' : '\\%03o', ord($1))/eg;
}
$str;
}
sub check_tempdir($) {
my($dir) = shift;
my($f); local(*DIR);
opendir(DIR, $dir) or die "Can't open directory $dir: $!";
while (defined($f = readdir(DIR))) {
if (! -d("$dir/$f") ) {
die "Unexpected file $dir/$f" if $f ne 'email.txt';
} elsif ($f eq '.' || $f eq '..' || $f eq 'parts') {}
else { die "Unexpected subdirectory $dir/$f" }
}
closedir(DIR) or die "Can't close directory $dir: $!";
1;
}
sub strip_tempdir($) {
my($dir) = shift;
my($errn) = stat("$dir/parts") ? 0 : 0+$!;
rmdir_recursively("$dir/parts",1) if $errn != ENOENT;
check_tempdir($dir);
1;
}
sub rmdir_recursively($;$) {
my($dir, $exclude_itself) = @_;
do_log(4,"rmdir_recursively: $dir, excl=$exclude_itself");
my($f); my($cnt) = 0;
local(*DIR);
opendir(DIR, $dir) or die "Can't open directory $dir: $!";
while (defined($f = readdir(DIR))) {
next if $f !~ /^(.+)$(?!\n)/s;
$f = $1; 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: $!";
}
}
closedir(DIR) or die "Can't close directory $dir: $!";
section_time("unlink-$cnt-files");
if (!$exclude_itself) {
rmdir($dir) or die "Can't remove directory $dir: $!";
section_time('rmdir');
}
1;
}
sub rmdir_flat($) {
my $dir = shift;
do_log(4,"rmdir_flat: $dir");
my $f;
opendir(DIR, $dir) or die "Can't open directory $dir: $!";
while (defined($f = readdir(DIR))) {
next if $f !~ /^(.+)$(?!\n)/s;
$f = $1; if (-d "$dir/$f") {
die "Refused to unlink a subdirectory $dir/$f"
unless ($f eq '.' || $f eq '..');
} else {
unlink("$dir/$f") or die "Can't remove file $dir/$f: $!";
}
}
closedir(DIR) or die "Can't close directory $dir: $!";
rmdir($dir) or die "Can't remove directory $dir: $!";
1;
}
sub min(@) {
my($r) = @_==1 && ref($_[0]) ? $_[0] : \@_; my($m); for (@$r) { $m = $_ if defined $_ && (!defined $m || $_ < $m) }
$m;
}
sub max(@) {
my($r) = @_==1 && ref($_[0]) ? $_[0] : \@_; my($m); for (@$r) { $m = $_ if defined $_ && (!defined $m || $_ > $m) }
$m;
}
sub read_text($;$) {
my($filename,$encoding) = @_;
my($inp) = IO::File->new;
$inp->open($filename,'r')
or 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: $!";
}
my($str) = ''; while(<$inp>) { $str .= $_ }
$inp->close or die "Can't close file $filename: $!";
$str;
}
sub read_l10n_templates($;$) {
my($dir) = @_;
if (@_ > 1) { my($l10nlang,$l10nbase) = @_; $dir = "$l10nbase/$l10nlang" }
my($file_chset) = Amavis::Util::read_text("$dir/charset");
my($taint) = substr($file_chset,0,0);
if ($file_chset =~ m{^(?: $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_virus_sender_templ =
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);
$notify_virus_recips_templ =
Amavis::Util::read_text("$dir/template-virus-recipient.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);
}
sub read_hash(@) {
unshift(@_,{}) if !ref $_[0]; my($hashref,$filename,$keep_case) = @_;
my($inp) = IO::File->new;
$inp->open($filename,'r') or die "Can't open file $filename for reading: $!";
while(<$inp>) { chomp; my($line)='';
for my $t (/\G (" (?: \\" | [^"] )* " | [^ last if $t eq '#';
$line .= $t;
}
$line =~ s/^\s+//; $line =~ s/\s+$//; # trim leading and trailing space
next if $line eq '';
my($addr) = Amavis::rfc2821_2822_Tools::unquote_rfc2821_local($line);
$addr = lc($addr) if !$keep_case;
$hashref->{$addr} = 1;
}
$inp->close or die "Can't close file $filename: $!";
$hashref;
}
sub run_command($$@) {
my($stdin_from, $stderr_to, $cmd, @args) = @_;
my($cmd_text) = join(' ',$cmd,@args);
$stdin_from = '/dev/null' if $stdin_from eq '';
my($msg) = join(' ',$cmd,@args,"<$stdin_from");
$msg .= " 2>$stderr_to" if $stderr_to ne '';
my($pid);
my($proc_fh) = IO::File->new;
eval { $pid = $proc_fh->open('-|') }; if ($@ ne '') { chomp($@); die "run_command (open pipe): $@" }
defined($pid) or die "run_command: can't fork: $!";
if (!$pid) { eval { 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: $!";
fileno(STDIN)==0 or die "run_command: STDIN not fd0";
if ($stderr_to ne '') {
open(STDERR, ">$stderr_to")
or die "Can't open STDERR to $stderr_to: $!";
fileno(STDERR)==2 or die "run_command: STDERR not fd2";
}
exec {$cmd} ($cmd,@args)
or die "Can't exec program $cmd: $!"; };
chomp($@); do_log(0,"run_command: child process [$$] failed ".
"to exec $cmd_text: $@");
exec('/bin/false'); exit 1; }
do_log(5, "run_command: [$pid] $msg");
binmode($proc_fh,":bytes")
or die "Can't cancel :utf8 mode on pipe: $!" if $unicode_aware;
$proc_fh; }
1;
package Amavis::rfc2821_2822_Tools;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = qw(
&rfc2822_timestamp &received_line &split_address &split_localpart
"e_rfc2821_local &qquote_rfc2821_local &unquote_rfc2821_local
&one_response_for_all
&EX_OK &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM);
}
use subs @EXPORT;
use POSIX qw(locale_h strftime);
BEGIN {
eval {require 'sysexits.ph'}; 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);
}
BEGIN {
import Amavis::Conf qw(:platform
$myhostname $localhost_name $forward_method);
import Amavis::Util qw(do_log);
}
sub get_zone_offset($) {
my($t) = @_;
my($d) = 0; for (1..3) { my($r) = sprintf("%04d%02d%02d", (localtime($t))[5,4,3]) cmp
sprintf("%04d%02d%02d", (gmtime($t+$d))[5,4,3]);
if ($r == 0) { last } else { $d += $r*24*3600 };
}
my($sl,$su) = (0,0);
for ((localtime($t))[2,1,0]) { $sl = $sl*60 + $_ };
for ((gmtime($t+$d))[2,1,0]) { $su = $su*60 + $_ };
$d += $sl-$su; my($sign) = $d >= 0 ? '+' : '-'; $d = -$d if $d<0;
$d = int(($d+30)/60.0); sprintf("%s%02d%02d", $sign, int($d/60), $d%60);
}
sub rfc2822_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("%a, %e %b %Y %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($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);
$s .= "\n with $smtp_proto" if $smtp_proto =~ /^(ES|S|L)MTP$/i;
$s .= "\n id $id" if $id ne '';
$s .= "\n for " . qquote_rfc2821_local(@$recips) if @$recips==1;
$s .= ";\n " . rfc2822_timestamp($msginfo->rx_time);
$s =~ s/\n//g if !$folded;
$s;
}
sub split_address($) {
my($mailbox) = @_;
my($taint) = substr($mailbox,0,0);
$mailbox =~ /^ (.*?) ( \@ (?: \[ (?: \\. | [^\[\]\\] )* \]
| [^@"<>\[\]\\\s] )*
) $(?!\n)/xs ? ($1.$taint, $2.$taint) : ($mailbox,'');
}
# split_localpart() splits localpart of an e-mail address at the first
# occurrence of the delimiter character. (based on equivalent routine
# in Postfix)
#
# Reserved addresses are not split: postmaster, mailer-daemon,
# double-bounce. Addresses that begin with owner-, or addresses
# that end in -request are not split when the owner_request_special
# parameter is set.
sub split_localpart($$) {
my($localpart, $delimiter) = @_;
my($owner_request_special) = 0; # configurable ???
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
&& $localpart =~ /^owner-|-request$(?!\n)/i) {
# backwards compatibility: don't split owner-foo or foo-request
} elsif ($localpart =~ /^(.+?)\Q$delimiter\E(.*)$(?!\n)/s) {
($localpart,$extension) = ($1.$taint, $2.$taint);
# do not split the address if the result would have a null localpart
}
($localpart,$extension);
}
# quote_rfc2821_local() quotes the local part of a mailbox address
# (given in internal (unquoted) form), and returns external (quoted)
# mailbox address, as per rfc2821.
#
# Internal (unquoted) form is used internally by AMaViS and other mail sw,
# external (quoted) form is used in SMTP commands and message headers.
#
# The quote_rfc2821_local() conversion is necessary because addresses
# we get from certain MTAs are raw, with stripped-off quoting.
# To re-insert message back via SMTP, the local-part of the address needs
# to be quoted again if it contains reserved characters or otherwise
# does not obey the dot-atom syntax, as specified per rfc2821.
# Failing to do that gets us into trouble: amavis accepts message from MTA,
# but is unable to hand it back to MTA after checking, receiving
# '501 Bad address syntax' with every attempt.
#
sub quote_rfc2821_local($) {
my($mailbox) = @_;
# atext: any character except controls, SP, and specials (rfc2821/rfc2822)
my($atext) = "a-zA-Z0-9! my($localpart,$domain) = split_address($mailbox);
if ($localpart !~ /^[$atext]+(\.[$atext]+)*$(?!\n)/so) { $localpart =~ s/(["\\])/\\$1/g; # quoted-pair
$localpart = '"' . $localpart . '"'; # make a qcontent out of it
}
$domain = '' if $domain eq '@'; # strip off empty domain entirely
$localpart . $domain;
}
# wraps the result of quote_rfc2821_local into angle brackets <...> ;
# If given a list, it returns a list (possibly converted to
# comma-separated scalar), quoting each element;
#
sub qquote_rfc2821_local(@) {
my(@r) = map { $_ eq '' ? '<>' : ('<'.quote_rfc2821_local($_).'>') } @_;
wantarray ? @r : join(', ',@r);
}
# unquote_rfc2821_local() strips away the quoting from the local part
# of an external (quoted) mailbox address, and returns internal (unquoted)
# mailbox address, as per rfc2821.
#
# Internal (unquoted) form is used internally by AMaViS and other mail sw,
# external (quoted) form is used in SMTP commands and message headers.
#
sub unquote_rfc2821_local($) {
my($mailbox) = @_;
my($taint) = substr($mailbox,0,0);
# the angle-bracket stripping is not really a duty of this subroutine,
# as it should have been already done elsewhere, but for the time being
# we do it here:
$mailbox = $1.$taint if $mailbox =~ /^ \s* < ( .* ) > \s* $(?!\n)/xs;
my($localpart,$domain) = split_address($mailbox);
$localpart =~ s/ " | \\(.) | \\$ /$1/xsg; $localpart . $domain;
}
sub one_response_for_all($$) {
my($msginfo,$dsn_per_recip_capable) = @_;
my($smtp_resp,$exit_code,$dsn_needed);
my($sender) = $msginfo->sender;
my($per_recip_data) = $msginfo->per_recip_data;
my($any_not_done) = scalar(grep {!$_->recip_done} @$per_recip_data);
if ($forward_method ne '' && $any_not_done)
{ die "Explicit forwarding, but not all recips done" }
if (!@$per_recip_data) { $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) { if ($r->recip_smtp_response =~ /^4/) { $smtp_resp = $r->recip_smtp_response; last }
}
if (!defined $smtp_resp) {
for my $r (@$per_recip_data) { if ($r->recip_done && $r->recip_smtp_response !~ /^[245]/) {
$smtp_resp = '451 4.5.0 Bad SMTP response code??? "' .
$r->recip_smtp_response . '"';
last; }
}
}
if (defined $smtp_resp) {
$exit_code = EX_TEMPFAIL;
do_log(5, "one_response_for_all <$sender>: 4xx found, '$smtp_resp'");
}
}
if (!defined $smtp_resp) {
my($notall);
for my $r (@$per_recip_data) {
if ($r->recip_destiny == D_DISCARD) { $smtp_resp = $r->recip_smtp_response if !defined $smtp_resp;
} else { $notall++; last } }
if ($notall) { $smtp_resp = undef }
if (defined $smtp_resp) {
$exit_code = $forward_method eq '' ? 99 : EX_OK;
do_log(5, "one_response_for_all <$sender>: all DISCARD, '$smtp_resp'");
}
}
if (!defined $smtp_resp) {
my($notall,$done_level); my($bounce_cnt) = 0;
for my $r (@$per_recip_data) {
my($dest,$resp) = ($r->recip_destiny, $r->recip_smtp_response);
if ($dest == D_DISCARD) {
} elsif ($resp =~ /^5/ && $dest != D_BOUNCE) {
if (!defined $smtp_resp || $r->recip_done > $done_level) {
$smtp_resp = $resp; $done_level = $r->recip_done;
}
} else { $notall++; last } }
if ($notall) { $smtp_resp = undef }
if (defined $smtp_resp) {
$exit_code = EX_UNAVAILABLE;
do_log(5, "one_response_for_all <$sender>: REJECTs, '$smtp_resp'");
}
}
if (!defined $smtp_resp) {
my($rej_cnt) = 0; my($bounce_cnt) = 0; my($drop_cnt) = 0;
for my $r (@$per_recip_data) {
my($dest,$resp) = ($r->recip_destiny, $r->recip_smtp_response);
if ($resp=~/^2/ && $dest==D_PASS) { $smtp_resp = $resp if !defined $smtp_resp;
}
$drop_cnt++ if $dest == D_DISCARD;
if ($resp =~ /^5/)
{ if ($dest==D_BOUNCE) { $bounce_cnt++ } else { $rej_cnt++ } }
}
$exit_code = EX_OK;
if (!defined $smtp_resp) { $smtp_resp = "250 2.5.0 Ok"; if ($any_not_done) { $smtp_resp .= ", continue delivery" }
elsif ($forward_method eq '') { $exit_code = 99 } }
$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>: " .
($rej_cnt+$bounce_cnt+$drop_cnt > 0 ? 'mixed' : 'success') .
", dsn_needed=$dsn_needed, '$smtp_resp'");
}
($smtp_resp, $exit_code, $dsn_needed);
}
1;
package Amavis::Lookup::RE;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
@ISA = qw(Exporter);
}
BEGIN { import Amavis::Util qw(do_log) }
sub new($$) { my($class) = shift; bless [@_], $class }
sub lookup_re($$) {
my($self,$addr) = @_;
my($taint) = substr($addr,0,0); my($found, $fullkey, $result);
for my $e (@$self) {
my($key); if (ref($e) eq 'ARRAY') { ($key,$result) = ($e->[0], @$e<2 ? 1 : $e->[1]);
} else { ($key,$result) = ($e,1);
}
my(@m) = $addr =~ /$key/;
if (@m) {
$found++; $fullkey = $key;
my($any) =
$result =~ s[ \$ ( (\d+) | { (\d+) } | \( (\d+) \) ) ]
[ my($j)=$2+$3+$4; $j<1 ? '' : $m[$j-1] ]gxse;
$result .= $taint if $any;
last;
}
}
$fullkey = $result = undef if !$found;
do_log(5, "lookup_RE: key=\"$addr\"" . (!$found ? ", no match"
: " matches \"$fullkey\", result=$result") );
!wantarray ? $result : ($result,$fullkey);
}
1;
package Amavis::Lookup;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&lookup &lookup_ip_acl);
}
use subs @EXPORT_OK;
BEGIN {
import Amavis::Util qw(do_log);
import Amavis::Conf qw(:platform
$recipient_delimiter $localpart_is_case_sensitive
%local_domains @local_domains_acl $local_domains_re);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(split_address split_localpart);
}
sub lookup_hash($$) {
my($addr, $hash_ref) = @_;
(ref($hash_ref) eq 'HASH') or die "lookup_hash: arg2 must be a hash ref";
return undef if !%$hash_ref; my($taint) = substr($addr,0,0);
my($localpart,$domain) = split_address($addr); $domain = lc($domain);
$localpart = lc($localpart) if !$localpart_is_case_sensitive;
$domain = $1.$taint if $domain =~ /^\@?(.*?)\.*$(?!\n)/s;
my($extension);
if ($recipient_delimiter ne '') {
($localpart, $extension) =
split_localpart($localpart, $recipient_delimiter);
}
my($key, $match, $found);
if ($extension ne '') { $key = $localpart.$recipient_delimiter.$extension.'@'.$domain;
($match = $$hash_ref{$key}, $found++) if exists $$hash_ref{$key};
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
if (!$found) { $key = $localpart . '@' . $domain;
($match = $$hash_ref{$key}, $found++) if exists $$hash_ref{$key};
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
if (!$found && $extension ne '') { $key = $localpart . $recipient_delimiter . $extension . '@';
($match = $$hash_ref{$key}, $found++) if exists $$hash_ref{$key};
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
if (!$found) { $key = $localpart . '@';
($match = $$hash_ref{$key}, $found++) if exists $$hash_ref{$key};
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
if (!$found) { $key = $domain;
($match = $$hash_ref{$key}, $found++) if exists $$hash_ref{$key};
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
my($d) = $domain;
while (!$found) { $key = "." . $d;
if (exists($$hash_ref{$key})) { $match = $$hash_ref{$key}; $found++ }
do_log(5, "lookup_hash: key=\"$key\"" .
(!$found ? ", no match" : " matches, result=$match") );
last if $d eq '';
$d = ($d =~ /^([^.]*)\.(.*)$(?!\n)/s) ? $2 : '';
}
$match = 1 if $found && !defined $match;
$match;
}
sub lookup_acl($$) {
my($addr, $acl_ref) = @_;
(ref($acl_ref) eq 'ARRAY') or die "lookup_acl: arg2 must be a list ref";
my($taint) = substr($addr,0,0);
my($lcaddr) = lc($addr);
my($localpart,$domain) = split_address($addr);
$domain = lc($domain);
$domain = $1.$taint if $domain =~ /^\@?(.*?)\.*$(?!\n)/s;
my($found, $fullkey, $result);
for my $e (@$acl_ref) {
$result = 1; $fullkey = lc($e); my($key) = $fullkey;
if ($key =~ /^(!+)(.*)$(?!\n)/s) { $key = $2;
$result = 1-$result if (length($1) & 1); }
if ($key =~ /\@/) { $found++ if $lcaddr eq $key;
} elsif ($key =~ /^\.(.*)$(?!\n)/s) { $found++ if $domain =~ /^ (.*? (\.|$(?!\n)))? \Q$1\E $(?!\n)/xs;
} else { $found++ if $domain eq $key;
}
last if $found;
}
$fullkey = $result = undef if !$found;
do_log(5, "lookup_acl: key=\"$addr\"" . (!$found ? ", no match"
: " matches \"$fullkey\", result=$result") );
!wantarray ? $result : ($result,$fullkey);
}
sub lookup($@) {
my($addr, @tables) = @_;
my($match);
for my $t (@tables) {
if (!ref($t)) { $match = $t;
do_log(5, "lookup: (scalar) matches, result=\"$match\"")
if defined $match;
} elsif (ref($t) eq 'HASH' ) { $match = lookup_hash($addr,$t);
} elsif (ref($t) eq 'ARRAY') { $match = lookup_acl($addr,$t);
} elsif ($t->isa('Amavis::Lookup::RE')) {
$match = $t->lookup_re($addr);
} elsif ($t->isa('Amavis::Lookup::SQL')) {
$match = $t->lookup_sql($addr);
} elsif ($t->isa('Amavis::Lookup::LDAP')) {
$match = $t->lookup_ldap($addr);
} elsif ($t->isa('Amavis::Lookup::SQLfield')) {
$match = $t->lookup_sql_field($addr);
} else {
die "TROUBLE: lookup argument is an unknown object: ".ref($t);
}
last if defined $match;
}
$match;
}
sub lookup_ip_acl($$) {
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)));
my($found, $fullkey, $result);
for my $net (@$nets_ref) {
$fullkey = $net; my($key) = $fullkey; $result = 1;
my($taint) = substr($key,0,0);
if ($key =~ /^(!+)(.*)$(?!\n)/s) { $key = $2.$taint;
$result = 1-$result if (length($1) & 1); }
my($netip,$mask) = ($key =~ m{^([^/]*)/(.*)$(?!\n)}s) ?
($1.$taint, $2.$taint) : ($key,32);
my($netipbin) = unpack('N', pack('C4', split(/\./, $netip, -1)));
if ($mask =~ /^(\d+\.){3}\d+$(?!\n)/) { $mask = unpack('N', pack('C4',split(/\./,$mask,-1)));
} else {
$mask = 32 if $mask !~ /^\d+$(?!\n)/ || $mask>32 || $mask<0;
$mask = unpack('N', pack('B32', ('1' x $mask . '0' x (32-$mask))));
}
$found++ if ($ipbin & $mask) == ($netipbin & $mask);
last if $found;
}
$fullkey = $result = undef if !$found;
do_log(5, "lookup_ip_acl: key=\"$ip\"" . (!$found ? ", no match"
: " matches \"$fullkey\", result=$result") );
!wantarray ? $result : ($result,$fullkey);
}
1;
package Amavis::Expand;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&expand);
}
use subs @EXPORT_OK;
sub expand($$) {
my($str_ref) =shift; my($builtins_href)=shift; my($lex_lbr, $lex_lbrq, $lex_rbr, $lex_sep, $lex_h) =
\('[', '[?', ']', '|', '#'); my(%lexmap); for (keys(%$builtins_href))
{ $lexmap{"%$_"} = \"%$_"; $lexmap{"% for ($lex_lbr, $lex_lbrq, $lex_rbr, $lex_sep, $lex_h) { $lexmap{$$_} = $_ }
my(@tokens) = $$str_ref =~ /\G \ \\ [0-7]{1,3} | [^\[\]\\|%\n my(%esc) = (r=>"\r", n=>"\n", f=>"\f", b=>"\b", e=>"\e", a=>"\a", t=>"\t");
for (@tokens) {
if (exists $lexmap{$_}) { $_ = $lexmap{$_} } elsif ($_ eq "\\\n") { $_ = '' } elsif (/^%(%)$(?!\n)/) { $_ = $1 } elsif (/^(% elsif (/^\\([0-7]{1,3})$(?!\n)/) { $_ = chr(oct($1)) } elsif (/^\\(.)$(?!\n)/s) { $_ = (exists($esc{$1}) ? $esc{$1} : $1) }
}
my($level) = 0; my($quote_level) = 0;
my(@macro_type,@arg); my($output_str) = ''; my($whereto) = \$output_str;
while (@tokens > 0) {
my($t) = shift(@tokens);
if ($t eq '') { } elsif ($quote_level>0 && ref($t) && ($t==$lex_lbr || $t==$lex_lbrq)) {
$quote_level++;
ref($whereto) eq 'ARRAY' ? push(@$whereto, $t) : ($$whereto .= $t);
} elsif (ref($t) && $t == $lex_lbr) { $quote_level++; $level++;
unshift(@arg,[[]]); unshift(@macro_type,''); $whereto = $arg[0][0];
} elsif (ref($t) && $t == $lex_lbrq) { $level++;
unshift(@arg,[[]]); unshift(@macro_type,''); $whereto = $arg[0][0];
$macro_type[0] = 'select';
} elsif ($quote_level>1 && ref($t) && $t==$lex_rbr) {
$quote_level--;
ref($whereto) eq 'ARRAY' ? push(@$whereto, $t) : ($$whereto .= $t);
} elsif ($level==1 && ref($t) && $t==$lex_sep) { if ($quote_level==0 && $macro_type[0] eq 'select' && @{$arg[0]}==1)
{ $quote_level++ }
if ($quote_level==1) {
unshift(@{$arg[0]}, []); $whereto = $arg[0][0]; } else {
ref($whereto) eq 'ARRAY' ? push(@$whereto, $t) : ($$whereto .= $t);
}
} elsif ($quote_level>0 && ref($t) && $t==$lex_rbr) {
$quote_level--; $level-- if $level > 0;
my(@result);
if ($macro_type[0] eq 'select') {
my($sel,@alternatives) = reverse @{$arg[0]}; $sel = !ref($sel) ? '' : join('',@$sel); if ($sel =~ /^\s*$(?!\n)/) { $sel = 0 }
elsif ($sel =~ /^\s*(\d+)\s*$(?!\n)/) { $sel = 0+$1 } else { $sel = 1 }
push(@alternatives,[]) if @alternatives < 2 && $sel > 0;
if ($sel < 0) { $sel = 0 }
elsif ($sel > $ @result = @{$alternatives[$sel]};
} else { my($cvar_r,$sep_r,$body_r,$cvar); if (@{$arg[0]}>=3) { ($cvar_r,$body_r,$sep_r) = reverse @{$arg[0]} }
else { ($body_r,$sep_r) = reverse @{$arg[0]}; $cvar_r = $body_r }
for (@$cvar_r) {
if (ref && $$_=~/^%(.)$(?!\n)/s) { $cvar = $1; last }
}
if (exists($builtins_href->{$cvar})) {
my($values_r) = $builtins_href->{$cvar};
while (ref($values_r) eq 'CODE') { $values_r = &$values_r }
$values_r = [ $values_r ] if !ref($values_r);
my($ind); my($re) = qr/^%\Q$cvar\E$(?!\n)/;
for my $val (@$values_r) {
push(@result, @$sep_r) if ++$ind>1 && ref($sep_r);
push(@result, map {(ref && $$_=~/$re/) ? $val : $_} @$body_r);
}
}
}
shift(@macro_type); shift(@arg); $whereto = $level>0 ? $arg[0][0] : \$output_str;
unshift(@tokens, @result); } else { my($s) = '';
if ($quote_level>0 || !ref($t)) { $s = $t; } elsif ($t == $lex_h) { while (@tokens) { last if shift(@tokens) eq "\n" }
} elsif ($$t =~ /^%\ if (!exists($builtins_href->{$1})) { $s = 0; } else {
$s = $builtins_href->{$1};
while (ref($s) eq 'CODE') { $s = &$s } $s = ref($s) ? @$s : ($s !~ /^\s*$(?!\n)/);
};
} elsif ($$t =~ /^%(.)$(?!\n)/s) { if (!exists($builtins_href->{$1})) { $s = ''; } else {
$s = $builtins_href->{$1};
while (ref($s) eq 'CODE') { $s = &$s } $s = join(', ',@$s) if ref($s);
};
} else { $s = $$t } ref($whereto) eq 'ARRAY' ? push(@$whereto, $s) : ($$whereto .= $s);
}
}
return \$output_str;
}
1;
package Amavis::In::Connection;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
sub new
{ my($class) = @_; bless {}, $class }
sub client_ip { my($self)=shift; !@_ ? $self->{client_ip} : ($self->{client_ip}=shift) }
sub socket_ip { my($self)=shift; !@_ ? $self->{socket_ip} : ($self->{socket_ip}=shift) }
sub socket_port { my($self)=shift; !@_ ? $self->{socket_port}:($self->{socket_port}=shift) }
sub proto { my($self)=shift; !@_ ? $self->{proto} : ($self->{proto}=shift) }
sub smtp_proto { my($self)=shift; !@_ ? $self->{smtp_proto}: ($self->{smtp_proto}=shift) }
sub smtp_helo { my($self)=shift; !@_ ? $self->{smtp_helo} : ($self->{smtp_helo}=shift) }
1;
package Amavis::In::Message::PerRecip;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
sub new { my($class) = @_; bless [(undef) x 10], $class }
sub recip_addr { my($self)=shift; !@_ ? $$self[0] : ($$self[0]=shift) }
sub recip_addr_modified
{ my($self)=shift; !@_ ? $$self[1] : ($$self[1]=shift) }
sub recip_destiny { my($self)=shift; !@_ ? $$self[2] : ($$self[2]=shift) }
sub recip_done { my($self)=shift; !@_ ? $$self[3] : ($$self[3]=shift) }
sub recip_smtp_response { my($self)=shift; !@_ ? $$self[4] : ($$self[4]=shift) }
sub recip_remote_mta_smtp_response { my($self)=shift; !@_ ? $$self[5] : ($$self[5]=shift) }
sub recip_remote_mta { my($self)=shift; !@_ ? $$self[6] : ($$self[6]=shift) }
sub recip_mbxname { my($self)=shift; !@_ ? $$self[7] : ($$self[7]=shift) }
sub recip_whitelisted_sender { my($self)=shift; !@_ ? $$self[8] : ($$self[8]=shift) }
sub recip_blacklisted_sender { my($self)=shift; !@_ ? $$self[9] : ($$self[9]=shift) }
sub recip_final_addr { my($self)=shift;
my($newaddr) = $self->recip_addr_modified;
defined $newaddr ? $newaddr : $self->recip_addr;
}
1;
package Amavis::In::Message;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
BEGIN {
import Amavis::Conf qw( :platform );
import Amavis::rfc2821_2822_Tools qw(rfc2822_timestamp);
import Amavis::In::Message::PerRecip;
}
sub new
{ my($class) = @_; bless {}, $class }
sub rx_time { my($self)=shift; !@_ ? $self->{rx_time} : ($self->{rx_time}=shift) }
sub msg_size { my($self)=shift; !@_ ? $self->{msg_size} : ($self->{msg_size}=shift) }
sub body_type { my($self)=shift; !@_ ? $self->{body_type} : ($self->{body_type}=shift) }
sub sender { my($self)=shift; !@_ ? $self->{sender} : ($self->{sender}=shift) }
sub sender_contact { my($self)=shift; !@_ ? $self->{sender_c} : ($self->{sender_c}=shift) }
sub sender_source { my($self)=shift; !@_ ? $self->{sender_src} : ($self->{sender_src}=shift) }
sub mime_entity { my($self)=shift; !@_ ? $self->{mime_entity}: ($self->{mime_entity}=shift)}
sub mail_text { my($self)=shift; !@_ ? $self->{mail_text} : ($self->{mail_text}=shift) }
sub header_edits { my($self)=shift; !@_ ? $self->{hdr_edits} : ($self->{hdr_edits}=shift) }
sub orig_header { my($self)=shift; !@_ ? $self->{orig_header}: ($self->{orig_header}=shift) }
sub orig_header_size { my($self)=shift; !@_ ? $self->{orig_hdr_s} : ($self->{orig_hdr_s}=shift) }
sub orig_body_size { my($self)=shift; !@_ ? $self->{orig_bdy_s} : ($self->{orig_bdy_s}=shift) }
sub body_digest { my($self)=shift; !@_ ? $self->{body_digest}: ($self->{body_digest}=shift) }
sub quarantined_to { my($self)=shift; !@_ ? $self->{quarantine} : ($self->{quarantine}=shift) }
sub dsn_sent { my($self)=shift; !@_ ? $self->{dsn_sent} : ($self->{dsn_sent}=shift) }
sub per_recip_data { my($self)=shift;
if (@_) { @{$self->{recips}} = @{$_[0]} }
$self->{recips};
}
sub recips { my($self)=shift;
if (@_) { $self->per_recip_data([ map {
my($per_recip_obj) = Amavis::In::Message::PerRecip->new;
$per_recip_obj->recip_addr($_);
$per_recip_obj->recip_destiny(D_PASS); $per_recip_obj } @{$_[0]} ]);
}
return if !defined wantarray; [ map { $_->recip_addr } @{$self->per_recip_data} ];
}
1;
package Amavis::Out::EditHeader;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
BEGIN {
import Amavis::Conf qw(:platform $hdr_encoding);
import Amavis::Timing qw(section_time);
import Amavis::Util qw(do_log safe_encode);
}
use MIME::Words;
sub new {
my($class) = @_;
bless {}, $class;
}
sub prepend_header($$$;$) {
my($self, $field_name, $field_body, $structured) = @_;
unshift(@{$self->{prepend}}, hdr($field_name, $field_body, $structured));
}
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) = @_;
$self->{edit}{lc($field_name)} = undef;
}
sub edit_header($$$;$) {
my($self, $field_name, $field_edit_sub, $structured) = @_;
!defined($field_edit_sub) || ref($field_edit_sub) eq 'CODE'
or die "edit_header: arg#3 must be undef or a subroutine ref";
$self->{edit}{lc($field_name)} = $field_edit_sub;
}
sub hdr($$;$) {
my($field_name, $field_body, $structured) = @_;
if ($field_name =~ /^(X-.*|Subject|Comments)$(?!\n)/si &&
$field_body =~ /[^\011\012\040-\176]/ ) { $field_body =~ s/\n[ \t]/ /g; chomp($field_body); my($field_body_octets) = safe_encode($hdr_encoding, $field_body);
$field_body = MIME::Words::encode_mimeword($field_body_octets,
'Q', $hdr_encoding);
} else { $field_body = safe_encode('ascii', $field_body);
}
$field_name = safe_encode('ascii', $field_name);
my($str) = $field_name . ':';
$str .= ' ' if $field_body !~ /^[ \t]/;
$str .= $field_body;
$str =~ s/\n([^ \t\n])/\n $1/g; $str =~ s/\n([ \t]*\n)+/\n/g; chomp($str); if ($structured) {
my(@sublines) = split(/\n/,$str,-1);
$str = ''; my($s) = ''; my($s_l) = 0;
for (@sublines) { if ($s !~ /^\s*$/ && $s_l+length($_) > 78) {
$str .= "\n" if $str ne '';
$str .= $s; $s = ''; $s_l = 0;
}
$s .= $_; $s_l += length($_);
}
if ($s !~ /^\s*$(?!\n)/) {
$str .= "\n" if $str ne '';
$str .= $s;
}
} elsif (length($str) > 999) {
}
$str .= "\n"; do_log(5, "header: $str");
$str;
}
sub write_header($$$) {
my($self,$msg,$out_fh) = @_;
$out_fh = IO::Wrap::wraphandle($out_fh); my($is_mime) = ref($msg) && $msg->isa('MIME::Entity');
my(@header);
if ($is_mime) {
@header = map { /^[ \t]*\n?$(?!\n)/ ? () : (/\n$(?!\n)/ ? $_ : $_."\n") } @{$msg->header};
}
my($received_cnt) = 0; my($str) = '';
for (@{$self->{prepend}}) { $str .= $_ }
if ($str ne '') { $out_fh->print($str) or die "sending mail header1: $!" }
if (!defined($msg)) {
} elsif (!exists($self->{edit}) || !scalar(%{$self->{edit}})) {
if ($is_mime) {
for my $h (@header) {
$out_fh->print($h) or die "sending mail header2: $!";
}
} else { while (<$msg>) { last if $_ eq $eol; $out_fh->print($_) or die "sending mail header3: $!";
}
}
} else {
my($curr_head, $next_head);
while ( defined($next_head = $is_mime ? shift @header : <$msg>) ) {
if ($next_head =~ /^[ \t]/) { $curr_head .= $next_head } else { if (!defined($curr_head)) { } elsif ($curr_head !~ /^([!-9;-\176]+)[ \t]*:(.*)$(?!\n)/s) {
$out_fh->print($curr_head) or die "sending mail header4: $!";
} else { 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})) { $out_fh->print($curr_head) or die "sending mail header5: $!";
} else {
my($edit) = $self->{edit}{$field_name_lc};
if (defined($edit)) { chomp($field_body);
$out_fh->print(hdr($field_name,
&$edit($field_name,$field_body)))
or die "sending mail header6: $!";
}
}
}
last if $next_head eq $eol; $curr_head = $next_head;
}
}
}
$str = '';
for (@{$self->{append}}) { $str .= $_ }
$str .= $eol; $out_fh->print($str) or die "sending mail header7: $!";
section_time('write-header');
$received_cnt;
}
1;
package Amavis::Out::Local;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&mail_to_local_mailbox);
}
use Errno qw(ENOENT);
use IO::File;
use IO::Wrap;
BEGIN {
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::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools;
import Amavis::Out::EditHeader;
}
use subs @EXPORT_OK;
sub mail_to_local_mailbox(@) {
my($via,$msginfo,$initial_submission,$filter) = @_;
my($taint) = substr($via,0,0);
$via =~ /^local:(.*)$(?!\n)/si or die "Bad local method: $via";
my($via_arg) = $1.$taint;
my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data};
return 1 if !@per_recip_data;
my($msg) = $msginfo->mail_text; if (defined($msg) && !$msg->isa('MIME::Entity')) {
$msg = IO::Wrap::wraphandle($msg); }
my($sender) = $msginfo->sender;
for my $r (@per_recip_data) {
my($recip) = $r->recip_final_addr;
next if $recip eq '';
my($localpart,$domain) = split_address($recip);
my($smtp_response);
my($mbxname, $suggested_filename);
{ my($alias) = $local_delivery_aliases{$localpart};
if (ref($alias) eq 'ARRAY') {
($mbxname, $suggested_filename) = @$alias;
} elsif (ref($alias) eq 'CODE') { ($mbxname, $suggested_filename) = &$alias;
} elsif ($alias ne '') {
($mbxname, $suggested_filename) = ($alias, undef);
}
if ($mbxname eq '') {
my($why) = !exists $local_delivery_aliases{$localpart} ? 1
: $alias eq '' ? 2 : 3;
do_log(2, "skip local delivery($why): <$sender> -> <$recip>");
$smtp_response = "250 2.6.0 Ok, skip local delivery($why)";
last; }
my($ux); if (!-d $mbxname) { $ux = 1; } else { $ux = 0; if ($suggested_filename eq '') {
$suggested_filename = $via_arg ne '' ? $via_arg : 'msg-%i-%n';
$suggested_filename =~ s/%b/$msginfo->body_digest/eg;
$suggested_filename =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg;
$suggested_filename =~ s/%n/am_id()/eg;
}
$mbxname = "$mbxname/$suggested_filename";
}
do_log(1, "local delivery: <$sender> -> <$recip>, mbx=$mbxname");
my($pos,$pipe);
my($errn) = stat($mbxname) ? 0 : 0+$!;
local $SIG{CHLD} = 'DEFAULT';
local $SIG{PIPE} = 'IGNORE'; local(*MP);
eval { if (!$ux) { if ($errn == ENOENT) { } elsif (!$errn && -e _) {
die "File $mbxname already exists, refuse to overwrite";
}
if (defined($gzip) && $mbxname =~ /\.gz$(?!\n)/) {
open(MP,"|$gzip -c >$mbxname") or die "gzip failed: $!";
$pipe = 1;
} else {
open(MP,"> $mbxname\0") or die "Can't create $mbxname: $!";
}
} else { if ($errn == ENOENT) {
open(MP,"> $mbxname\0") or 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: $!";
}
binmode(MP,":bytes")
or die "Can't cancel :utf8 mode: $!" if $unicode_aware;
lock(\*MP); $pos = tell MP;
}
if (defined($msg) && !$msg->isa('MIME::Entity')) {
$msg->seek(0,0) or die "Can't rewind mail file: $!";
}
};
if ($@ ne '') {
chomp($@);
$smtp_response = $@ eq "timed out" ? "450 4.4.2" : "451 4.5.0";
$smtp_response .= " Local delivery(1) to $mbxname failed: $@";
last; }
eval { printf MP ("From %s %s$eol",
quote_rfc2821_local($sender), scalar(localtime) )
or 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));
my($received_cnt) = $hdr_edits->write_header($msg,\*MP);
if ($received_cnt > 110) {
die "Too many hops: $received_cnt 'Received:' header lines\n";
}
if (!$ux) { while ( $msg->read($_,16384) > 0 ) {
print MP $_ or die "Can't write to $mbxname: $!";
}
} else { my($blank_line) = 1;
while(<$msg>) {
print MP '>' or die "Can't write to $mbxname: $!"
if $blank_line && /^From /;
print MP $_ or die "Can't write to $mbxname: $!";
$blank_line = $_ eq "\n";
}
}
print MP $eol or die "Can't write to $mbxname: $!" if $ux;
};
my($failed) = 0;
if ($@ ne '') { chomp($@);
if ($ux && defined($pos) && $can_truncate) {
truncate(MP,$pos) or die "Can't truncate file $mbxname: $!";
}
$failed = 1;
}
unlock(\*MP) if $ux;
close(MP) or die ("Can't close $mbxname: " . ($pipe ? $? : $!) );
if (!$failed) { $smtp_response =
"250 2.6.0 Ok, delivered to $mbxname";
} elsif ($@ eq "timed out") { $smtp_response =
"450 4.4.2 Local delivery to $mbxname timed out";
} elsif ($@ =~ /too many hops/i) { $smtp_response =
"550 5.4.6 Rejected delivery to mailbox $mbxname: $@";
} else { $smtp_response =
"451 4.5.0 Local delivery to mailbox $mbxname failed: $@";
}
} 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;
section_time('save-to-local-mailbox');
}
}
1;
package Amavis::Out;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = qw(&mail_dispatch
&EX_OK &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM);
}
BEGIN {
eval {require 'sysexits.ph'}; 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;
use IO::Wrap;
use Net::Cmd;
use Net::SMTP 2.24;
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
prolong_timer);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools;
import Amavis::Out::Local qw(mail_to_local_mailbox);
import Amavis::Out::EditHeader;
}
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,$conn) = (shift,shift);
if ($via =~ /^smtp\b/i) {
mail_via_smtp(dynamic_destination($via,$conn), @_);
} elsif ($via =~ /^pipe:/i) {
mail_via_pipe($via,@_);
} elsif ($via =~ /^bsmtp:/i) {
mail_via_bsmtp($via,@_);
} elsif ($via =~ /^local:/i) {
my($msginfo,$initial_submission,$filter) = @_;
mail_to_local_mailbox($via,$msginfo,$initial_submission,
sub {shift->recip_final_addr !~ /\@/ ? 1 : 0} );
if (grep {! $_->recip_done } @{$msginfo->per_recip_data}) {
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,@_);
}
}
};
}
sub new_smtp_data
{ my($class,$sh) = @_; bless \$sh, $class }
sub print {
my($self) = shift;
$$self->datasend(\@_) or die "datasend timed out while sending header\n";
}
sub mail_via_smtp(@) {
my($via,$msginfo,$initial_submission,$filter) = @_;
my($num_recips_undone) = scalar(
grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data} );
while ($num_recips_undone > 0) {
mail_via_smtp_single(@_); my($num_recips_undone_after) = scalar(
grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data} );
if ($num_recips_undone_after >= $num_recips_undone) {
do_log(0, "Number of recipients ($num_recips_undone_after) ".
"not reduced in SMTP transaction, abandon the effort");
last;
}
if ($num_recips_undone_after > 0) {
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));
}
$num_recips_undone = $num_recips_undone_after;
}
1;
}
sub mail_via_smtp_single(@) {
my($via,$msginfo,$initial_submission,$filter) = @_;
my($which_section) = 'fwd_init';
my($taint) = substr($via,0,0);
$via =~ /^smtp:([^:]*):([^:]*)(:.*)?$(?!\n)/si
or 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>",
($initial_submission ? 'SEND' : 'FWD'),
$relayhost, $relayhost_port, $msginfo->sender);
if (!@per_recip_data) { do_log(5, "$logmsg, nothing to do"); return 1 }
do_log(1, $logmsg . " -> " .
join(",", map {"<".$_->recip_final_addr.">"} @per_recip_data));
my($msg) = $msginfo->mail_text; my($smtp_handle,$smtp_response);
my($smtp_code, $smtp_msg, $received_cnt);
my($any_valid_recips) = 0; my($any_tempfail_recips) = 0;
my($any_valid_recips_and_data_sent) = 0; my($in_datasend_mode) = 0;
if (defined($msg) && !$msg->isa('MIME::Entity')) {
$msg = IO::Wrap::wraphandle($msg); $msg->seek(0,0) or die "Can't rewind mail file: $!";
}
my($remaining_time) = alarm(0); eval {
$which_section = 'fwd-connect';
$smtp_handle = Net::SMTP->new("$relayhost:$relayhost_port",
Hello => $localhost_name, ExactAddresses => 1,
Timeout => max(60, min(5*60,$remaining_time)), );
defined($smtp_handle)
or 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); $remaining_time = undef;
$which_section = 'fwd-mail-from';
$smtp_handle->mail(qquote_rfc2821_local($msginfo->sender))
or 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) { if (defined $skipping_resp) {
$r->recip_smtp_response($skipping_resp); $r->recip_done(2);
next;
}
$smtp_handle->recipient(qquote_rfc2821_local($r->recip_final_addr));
$smtp_code = $smtp_handle->code;
$smtp_msg = $smtp_handle->message; chomp($smtp_msg);
my($smtp_resp) = "$smtp_code $smtp_msg";
if ($smtp_code =~ /^2/) {
$any_valid_recips++;
} elsif ($smtp_code =~ /^0/) {
do_log(0, "response to RCPT TO not yet available, assuming it will be ok");
} else { 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/; 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);
if ($resp_enhcode eq '' && $resp_code =~ /^([245])/ ) {
my($c) = $1;
$resp_enhcode = ($resp_code eq '452') ? "$c.5.3"
: "$c.1.0"; $smtp_resp = "$smtp_code $resp_enhcode $smtp_msg";
}
}
if ($smtp_resp =~ /^452/) { do_log(0, sprintf('Only %d recips sent in one go: "%s"',
$any_valid_recips, $smtp_resp));
$skipping_resp = $smtp_resp;
} elsif ($smtp_resp =~ /^4/) {
$any_tempfail_recips++;
}
$r->recip_smtp_response($smtp_resp); $r->recip_done(2);
}
}
section_time($which_section); prolong_timer($which_section);
$smtp_code = $smtp_msg = undef;
if ($any_valid_recips && !$any_tempfail_recips) { $which_section = 'fwd-data';
$smtp_handle->data or die "sending DATA command\n";
$in_datasend_mode = 1;
my($smtp_resp) = $smtp_handle->code . " " . $smtp_handle->message;
chomp($smtp_resp);
do_log(5, "response to DATA: \"$smtp_resp\"");
my($smtp_data_fh) = Amavis::Out->new_smtp_data($smtp_handle);
my($hdr_edits) = $msginfo->header_edits;
$hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits;
$received_cnt = $hdr_edits->write_header($msg, $smtp_data_fh);
if ($received_cnt > 100) {
die "Too many hops: $received_cnt 'Received:' header lines\n";
}
if (!defined($msg)) {
} elsif ($msg->isa('MIME::Entity')) {
$msg->print_body($smtp_data_fh);
} else {
while ( $msg->read($_,16384) > 0 ) {
$smtp_handle->datasend($_)
or die "datasend timed out while sending body\n";
}
}
section_time($which_section); prolong_timer($which_section);
$which_section = 'fwd-data-end';
$smtp_handle->dataend;
$in_datasend_mode = 0; $any_valid_recips_and_data_sent = 1;
section_time($which_section); prolong_timer($which_section);
$which_section = 'fwd-rundown-1';
$smtp_code = $smtp_handle->code;
my(@msgs) = $smtp_handle->message;
my($smtp_msg) = $msgs[$ $smtp_response = "$smtp_code $smtp_msg";
do_log(5, "response to data end: \"$smtp_response\"");
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_response);
}
if ($smtp_code =~ /^[245]/) {
my($smtp_status) = substr($smtp_code,0,1);
$smtp_response = sprintf("%s %d.6.0 %s, id=%s, from MTA: %s",
$smtp_code, $smtp_status,
($smtp_status==2 ? 'Ok' : 'Failed'),
am_id(), $smtp_response);
}
}
};
my($err) = $@; my($saved_section_name) = $which_section;
if ($err ne '') { chomp($err); $err = ' ' if $err eq '' } prolong_timer($which_section, $remaining_time); $which_section = 'fwd-rundown';
if ($err ne '') { do_log(3, "mail_via_smtp: session failed: $err");
if (!defined($smtp_handle)) { $smtp_msg = '' }
else {
$smtp_code = $smtp_handle->code;
$smtp_msg = $smtp_handle->message; chomp($smtp_msg);
}
}
if (!defined $smtp_handle) {
} elsif ($in_datasend_mode) {
do_log(0, "mail_via_smtp: NOTICE: aborting SMTP session, $err");
$smtp_handle->close; } else {
$smtp_handle->timeout(15); $smtp_handle->quit; if ($err eq '' && $smtp_handle->status != CMD_OK) {
do_log(0, "Warning: sending SMTP QUIT command failed: " .
$smtp_handle->code . " " . $smtp_handle->message);
}
}
if ($err eq '') { if ($any_valid_recips_and_data_sent && $smtp_response !~ /^[245]/) {
$smtp_response = sprintf("451 4.6.0 Bad SMTP code, id=%s, from MTA: \"%s\"",
am_id(), $smtp_response);
}
} elsif ($err eq "timed out" || $err =~ /: Timeout$/) {
my($msg) = ($in_datasend_mode && $smtp_code =~ /^354/) ? ''
: ", $smtp_code $smtp_msg";
$smtp_response = sprintf("450 4.4.2 Timed out during %s%s, id=%s",
$saved_section_name, $msg, am_id());
} elsif ($err =~ /^Can't connect/) {
$smtp_response = sprintf("450 4.4.1 %s, id=%s", $err, am_id());
} elsif ($err =~ /^Too many hops/) {
$smtp_response = sprintf("550 5.4.6 Rejected: %s, id=%s",$err,am_id());
} elsif ($smtp_code =~ /^5/) { # 5xx
$smtp_response = sprintf("%s 5.5.0 Rejected by MTA: %s %s, id=%s",
($smtp_code !~ /^5\d\d$(?!\n)/ ?"550" :$smtp_code),
$smtp_code, $smtp_msg, am_id());
} elsif ($smtp_code =~ /^0/) { # 000
$smtp_response = sprintf("450 4.4.2 No response during %s (%s): id=%s",
$saved_section_name, $err, am_id());
} else {
$smtp_response =
sprintf("%s 4.5.0 from MTA during %s (%s): %s %s, id=%s",
($smtp_code !~ /^4\d\d$(?!\n)/ ? "451" : $smtp_code),
$saved_section_name, $err, $smtp_code,$smtp_msg, am_id());
}
do_log(($smtp_response=~/^2/ ? 3 : 0), "mail_via_smtp: $smtp_response");
if (!$any_valid_recips || $any_tempfail_recips) {
do_log(3, "mail_via_smtp: DATA skipped, $any_valid_recips, ".
"$any_tempfail_recips, $any_valid_recips_and_data_sent");
}
if (defined $smtp_response) {
for my $r (@per_recip_data) {
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 &&
$r->recip_smtp_response =~ /^452/) { # 'undo' the RCPT TO
# '452 Too many recipients' situation - needs to be handled
# in more than one transaction
$r->recip_smtp_response(undef); $r->recip_done(undef);
}
}
}
section_time($which_section);
1;
}
# Send mail using external program 'sendmail' (also available with Postfix
# and Exim) - used for forwarding original mail or sending notifications.
# May throw exception (die) if temporary failure (4xx) or other problem
#
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";
my($pipe_args) = $1.$taint;
$pipe_args =~ s/^flags=\S*\s*//i; # flags are currently ignored, q implied
$pipe_args =~ s/^argv=//i;
my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data};
my($logmsg) = sprintf("%s via PIPE: <%s>",
($initial_submission ? 'SEND' : 'FWD'), $msginfo->sender);
if (!@per_recip_data) { do_log(5,"$logmsg, nothing to do"); return 1 }
do_log(1, $logmsg . " -> " .
join(",", map {"<".$_->recip_final_addr.">"} @per_recip_data));
my($msg) = $msginfo->mail_text; # a scalar reference, or a file handle
if (defined($msg) && !$msg->isa('MIME::Entity')) {
# 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: $!";
}
return 1 if !@per_recip_data;
my(@pipe_args) = split(' ',$pipe_args);
my(@command) = shift @pipe_args;
for (@pipe_args) {
# The sendmail command line expects addresses quoted as per RFC 822.
# "funny user"@some.domain
# For compatibility with Sendmail, the Postfix sendmail command line
# also accepts address formats that are legal in RFC 822 mail headers:
# Funny Dude <"funny user"@some.domain>
# Although addresses passed as args to sendmail initial submission
# should not be <...> bracketed, for some reason original sendmail
# issues a warning on null reverse-path, but gladly accepty <>.
# As this is not strictly wrong, we comply to make it happy.
if (/^\${sender}$(?!\n)/i) {
push(@command, map { /^(.*)$(?!\n)/s; $1 } # untaint
map { $_ eq '' ? '<>' : quote_rfc2821_local($_) }
$msginfo->sender);
} elsif (/^\${recipient}$(?!\n)/i) {
push(@command, map { /^(.*)$(?!\n)/s; $1 } # untaint
map { $_ eq '' ? '<>' : quote_rfc2821_local($_) }
map { $_->recip_final_addr } @per_recip_data);
} else { push(@command, $_) }
}
do_log(5,"mail_via_pipe running command: ".join(' ',@command));
local $SIG{CHLD} = 'DEFAULT';
local $SIG{PIPE} = 'IGNORE'; # write to broken pipe throws a signal
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: $!";
if (!$pid) { # child
exec {$command[0]} (@command);
exec('/bin/false'); # must not exit, we have to avoid DESTROY handlers
exit EX_TEMPFAIL; # just in case
# NOTREACHED
}
# parent
binmode(MP,":bytes") or 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);
if ($received_cnt > 100) { # loop detection required by rfc2821 6.2
# deal with it later, for now just skip the body
} elsif (!defined($msg)) {
# empty mail body
} elsif ($msg->isa('MIME::Entity')) {
$msg->print_body(\*MP);
} else {
while ( $msg->read($_,16384) > 0 ) {
print MP $_ or die "Submitting mail text failed: $!";
}
}
my($smtp_response);
if ($received_cnt > 100) { # loop detection required by rfc2821 6.2
do_log(0, "Too many hops: $received_cnt 'Received:' header lines");
kill(15,$pid); # kill the process running mail submission program
close(MP); # and ignore status
$smtp_response = "550 5.4.6 Rejected: " .
"Too many hops: $received_cnt 'Received:' header lines";
} else {
my($err); close(MP) or $err=$!; my($status) = retcode($?);
# sendmail program (Postfix variant) can return the following exit codes:
# 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_UNAVAILABLE) {
$smtp_response = "550 5.5.0 Mail submission service unavailable";
} else {
$smtp_response = "451 4.5.0 Unknown failure submitting message, ".
"status=$status ($? $err)";
}
}
$smtp_response .= ", id=" . am_id();
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_smtp_response($smtp_response);
$r->recip_done(2);
}
section_time('fwd-pipe');
1;
}
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";
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;
$bsmtp_file_final =~ s/%n/am_id()/eg;
my($bsmtp_file_tmp) = $bsmtp_file_final . ".tmp";
my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data};
my($logmsg) = sprintf("%s via BSMTP: <%s>",
($initial_submission ? 'SEND' : 'FWD'), $msginfo->sender);
if (!@per_recip_data) { do_log(5,"$logmsg, nothing to do"); return 1 }
do_log(1, $logmsg . " -> " .
join(",", map {"<".$_->recip_final_addr.">"} @per_recip_data) .
", file " . $bsmtp_file_final);
my($msg) = $msginfo->mail_text; # a scalar reference, or a file handle
if (defined($msg) && !$msg->isa('MIME::Entity')) {
# 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: $!";
}
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): $!";
printf MP ("MAIL FROM:%s BODY=8BITMIME$eol", # avoid conversion to 7bit
qquote_rfc2821_local($msginfo->sender))
or die "print failed (MAIL FROM): $!";
for my $r (@per_recip_data) {
print MP ("RCPT TO:",qquote_rfc2821_local($r->recip_final_addr),$eol)
or die "print failed (RCPT TO): $!";
}
print MP ("DATA",$eol) or 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);
if ($received_cnt > 100) { # loop detection required by rfc2821 6.2
die "Too many hops: $received_cnt 'Received:' header lines";
} elsif (!defined($msg)) { # empty mail body
} elsif ($msg->isa('MIME::Entity')) {
$msg->print_body(\*MP);
} else {
while (<$msg>) {
print MP "." or die "print failed-.data: $!" if /^\./;
print MP $_ or 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: $!";
rename($bsmtp_file_tmp, $bsmtp_file_final)
or die "Can't rename BSMTP file to $bsmtp_file_final: $!";
};
my($err) = $@; my($smtp_response);
if ($err eq '') {
$smtp_response = "250 2.6.0 Ok, queued as BSMTP $bsmtp_file_final";
} else {
chomp($err);
unlink($bsmtp_file_tmp) or do_log(0,
"Can't delete half-finished BSMTP file $bsmtp_file_tmp: $!");
close(MP); # ignore status
if ($err =~ /too many hops/i) {
$smtp_response = "550 5.4.6 Rejected: $err";
} else {
$smtp_response = "451 4.5.0 Writing $bsmtp_file_tmp failed: $err";
}
}
$smtp_response .= ", id=" . am_id();
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_smtp_response($smtp_response);
$r->recip_done(2);
}
section_time('fwd-bsmtp');
1;
}
1;
#
package Amavis::UnmangleSender;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&best_try_originator &first_received_from);
}
use subs @EXPORT_OK;
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);
}
use Mail::Address;
# Returns the envelope sender address, or reconstructs it if there is
# a good reason to believe the envelope address has been changed or forged,
# as is common for some varieties of viruses. Returns best guess of the
# sender address, or undef if it can not be determined.
#
sub unmangle_sender($$$) {
my $sender = shift; # rfc2821 envelope sender address
my $from = shift; # rfc2822 'From:' header, may include comment
my $virusname_list = shift; # list ref containing names of detected viruses
# based on ideas from Furio Ercolessi, Mike Atkinson, Mark Martinec
my($best_try_originator) = $sender;
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 bug, $1 gets tainted
$from = (Mail::Address->parse($from))[0];
}
$from = $from->address if $from ne '';
# NOTE: rfc2822 allows multiple addresses in the From field!
if (grep { /magistr/i } @$virusname_list) {
for my $j (0..2) { # assemble possible `shifted' candidates
next if $j >= length($localpart);
my($try) = $sender;
substr($try,$j,1) = chr(ord(substr($try,$j,1))-1);
if (lc($from) eq lc($try)) { $best_try_originator = $try; last }
}
}
#
# Virus names are AV-checker vendor specific, but many use same
# or similar virus names. This requires attention and adjustments
# from Amavis administrators.
#
if (grep { /badtrans/i } @$virusname_list) {
if ($from =~ /^ # these are fake built-in addresses
(joanna\@mail\.utexas\.edu | powerpuff\@videotron\.ca |
(mary\@c-com | support\@cyberramp | admin\@gte |
administrator\@border) \.net |
(monika\@telia | jessica\@aol | spiderroll\@hotmail |
lgonzal\@hotmail | andy\@hweb-media | Gravity49\@aol |
tina0828\@yahoo | JUJUB271\@AOL | aizzo\@home) \.com
) $(?!\n)/xi
) { # discard recipient's address used as a fake 'MAIL FROM:'
$best_try_originator = undef;
} else {
my($taint) = substr($from,0,0);
$best_try_originator = $1.$taint if $from =~ /^_(.+)$(?!\n)/s
&& lc($sender) ne lc($1);
}
}
for my $vn (@$virusname_list) {
my($result,$patt) = $viruses_that_fake_sender_re->lookup_re($vn);
if ($result) {
do_log(2,"Virus $vn matches pattern $patt, sender addr ignored");
$best_try_originator = undef;
last;
}
}
$best_try_originator;
}
# Given a dotted-quad IP address try reverse DNS resolve, and then
# forward DNS resolve. If they match, return domain name,
# otherwise return the IP address in brackets. (works for IPv4 only)
#
sub ip_addr_to_name($) {
my($addr) = shift; # quad-dot address string
my($binaddr) = pack('C4',split(/\./,$addr)); # to binary string
my(@addr) = gethostbyaddr($binaddr,2); # IP -> name
if (@addr) {
my($name,$aliases,$addrtype,$length,@addrs) = @addr;
if ($name =~ /\.[a-zA-Z]+$(?!\n)/) {
my(@raddr) = gethostbyname($name); # name -> IP
my($rname,$raliases,$raddrtype,$rlength,@raddrs) = @raddr;
for my $ra (@raddrs) { return $name if lc($ra) eq lc($binaddr) }
}
}
'[' . $addr . ']'; # return IP address in brackets if nothing matches
}
# Obtain and parse the first entry (chronologically) in the 'Received:' header
# path trace - to be used as the value of the macro %t in customized messages
#
sub first_received_from($) {
my($entity) = shift;
my($first_received);
if (defined($entity)) {
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;
};
# For the purpose of informing administrators try to obtain true sender
# address or at least its site, as certain viruses have a nasty habit
# of faking envelope sender address. Return a pair of addresses:
# - the first (if defined) appears valid and may be used for sender
# notifications;
# - the second should only be used in generating customizable notification
# messages (macro %o), NOT to be used as address for sending notifications,
# as it can contain nonvalid address (but can be more informative).
#
sub best_try_originator($$$) {
my($sender,$entity,$virusname_list) = @_;
return ($sender,$sender) if !defined($entity); # don't bother if no header
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);
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 defined $first_received_from_ip;
(undef, $originator);
}
1;
#
package Amavis::Unpackers::NewFilename;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
BEGIN {
import Amavis::Util qw(do_log);
}
sub new($;$) { # create a file name generator object
my($class,$maxfiles) = @_;
bless {
num_of_issued_names => 0,
first_issued_ind => 1, last_issued_ind => 0,
maxfiles => $maxfiles, # may be undef, to disable limit
type => {},
}, $class;
}
sub parts_list_reset($) { # clear a list of recently issued names
my($self) = shift;
$self->{num_of_issued_names} = 0;
$self->{first_issued_ind} = $self->{last_issued_ind} + 1;
}
sub parts_list($) { # returns a ref to a list of recently issued names
my($self) = shift;
[ map { sprintf("part-%05d",$_) }
($self->{first_issued_ind} .. $self->{last_issued_ind}) ];
}
sub generate_new_name($) { # make-up a new name and return it
my($self) = shift;
if (defined($self->{maxfiles}) &&
$self->{num_of_issued_names} >= $self->{maxfiles}) {
# do not change the text in die without adjusting decompose_part()
die "Maximum number of files ($self->{maxfiles}) exceeded";
}
$self->{num_of_issued_names}++; $self->{last_issued_ind}++;
my($name) = sprintf("part-%05d", $self->{last_issued_ind});
do_log(5, "Issued a new file name: ".$name);
$name;
}
# remember full file type as obtained by calling 'file' utility
sub file_type_long($$;$) {
my($self,$part) = (shift,shift);
$self->{ltype}->{$part} = shift if @_;
$self->{ltype}->{$part};
}
# remember short/categorized file type
sub file_type($$;$) {
my($self,$part) = (shift,shift);
$self->{stype}->{$part} = shift if @_;
$self->{stype}->{$part};
}
1;
#
package Amavis::Unpackers::OurFiler;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter MIME::Parser::Filer); # subclass of MIME::Parser::Filer
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = ();
}
# This package will be used by mime_decode().
#
# We don't want no heavy MIME::Parser machinery for file name extension
# guessing, decoding charsets in filenames (and listening to complaints
# about it), checking for evil filenames, checking for filename contention, ...
# (which can not be turned off completely by ignore_filename(1) !!!)
# Just enforce our file name! And while at it, collect generated filenames.
#
sub new($$$) {
my($class, $dir, $file_generator_object) = @_;
$dir =~ s/\/+$(?!\n)//; # chop off trailing slashes from directory name
bless {
directory => $dir, file_generator_object => $file_generator_object,
}, $class;
}
sub output_path($@) {
my($self,$head) = @_;
# invent new bare file name
my($name) = $self->{file_generator_object}->generate_new_name;
$self->{directory} . "/$name"; # return it with prepended directory
}
1;
#
package Amavis::Unpackers;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&init &mime_decode &decompose_part
&determine_file_types &check_for_banned_filenames
&check_header_validity);
}
use Errno qw(ENOENT);
use MIME::Parser;
use MIME::Words;
use Convert::TNEF;
use Convert::UUlib qw(:constants);
use Compress::Zlib;
use Archive::Tar;
use Archive::Zip qw(:CONSTANTS :ERROR_CODES);
use File::Copy;
BEGIN {
import Amavis::Util qw(do_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);
import Amavis::Lookup qw(lookup);
}
use subs @EXPORT_OK;
use vars qw($threshold); # Magic number to detect DoS attacks
use vars qw($avail_quota); # available bytes quota for unpacked mail
use vars qw($rem_quota); # remaining bytes quota for unpacked mail
use vars qw($file_generator_object);
sub init($$) {
my($mail_size); ($file_generator_object,$mail_size) = @_;
$threshold = 14;
$avail_quota = $rem_quota = # quota in bytes
max($MIN_EXPANSION_QUOTA,
$mail_size*$MIN_EXPANSION_FACTOR,
min($MAX_EXPANSION_QUOTA, $mail_size*$MAX_EXPANSION_FACTOR));
do_log(4, "Original mail size: $mail_size; quota set to: $avail_quota bytes");
}
# generate unique filename (bare names, no directory)
sub getfilename() { $file_generator_object->generate_new_name }
sub consumed_bytes($$) {
my($bytes,$bywhom) = @_;
my($perc) = !$avail_quota ? '' : sprintf(", (%.0f%%)",
100*($avail_quota-($rem_quota-$bytes))/$avail_quota);
do_log(5, "Charging $bytes bytes to remaining quota $rem_quota".
" (out of $avail_quota$perc) - by $bywhom");
if ($bytes > $rem_quota && $rem_quota >= 0) {
# Do not modify the following signal text, it gets matched elsewhere!
my($msg) = "Exceeded storage quota $avail_quota bytes by $bywhom; last chunk $bytes bytes";
do_log(0,$msg); die "$msg\n";
}
$rem_quota -= $bytes;
};
# save MIME preamble and epilogue (if nontrivial) as extra (pseudo)parts
sub mime_decode_pre_epi($$$) {
my($pe_name,$pe_lines,$tempdir) = @_;
if (defined $pe_lines && @$pe_lines) {
do_log(5, "mime_decode_$pe_name: ".scalar(@$pe_lines)." lines");
if (@$pe_lines>5 ||
"@$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: $!";
binmode(PRE,":bytes")
or 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: $!";
$len += length($_);
}
close(PRE) or die "Can't close $pe_name $newpart: $!";
consumed_bytes($len,'mime_decode_pre_epi');
}
}
}
# Break up mime parts
sub mime_decode($$) {
my($fileh,$tempdir) = @_;
# $fileh may be an open file handle, or a file name of a part
my($parser) = MIME::Parser->new;
$parser->filer(Amavis::Unpackers::OurFiler->new(
"$tempdir/parts", $file_generator_object));
$parser->ignore_errors(1); # also is the default
# $parser->extract_nested_messages(0);
$parser->extract_nested_messages("NEST"); # parse embedded message/rfc822
$parser->extract_uuencode(1);
my($entity);
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 bug, $1 gets tainted
$entity = $parser->parse($fileh);
} else { # assume $fileh is a file name
do_log(4,"Extracting mime components from $fileh");
local($1,$2,$3,$4); # avoid Perl 5.8.0 bug, $1 gets tainted
$entity = $parser->parse_open("$tempdir/parts/$fileh");
}
my($err) = $parser->last_error;
$err =~ s/\s+$(?!\n)//; $err =~ s/[ \t\r]*\n+/; /g; $err =~ s/\s+/ /g;
$err = substr($err,0,250) . '...' if length($err) > 250;
do_log(1, "warning - MIME::Parser $err") if $err ne '';
# traverse MIME::Entity object breadth-first,
# extracting preambles and epilogues as extra (pseudo)parts
my(@unvisited) = ($entity);
while (@unvisited) {
my($ent) = shift(@unvisited);
mime_decode_pre_epi('preamble', $ent->preamble, $tempdir);
my($body) = $ent->bodyhandle; my($fn);
do_log(4, "mime_decode: Content-type: " . $ent->mime_type .
(!$body ? "" : ( ", name: ".$ent->head->recommended_filename) ));
if (defined $body) {
consumed_bytes(
defined($fn=$body->path) ? -s $fn : length($body->as_string),
'mime_decode');
}
mime_decode_pre_epi('epilogue', $ent->epilogue, $tempdir);
push(@unvisited, $ent->parts);
}
section_time('mime_decode');
$entity;
}
sub check_header_validity($$) {
my($conn, $msginfo) = @_;
my(@bad); my($curr_head);
for my $next_head (@{$msginfo->orig_header},"\n") {
if ($next_head =~ /^[ \t]/) { $curr_head .= $next_head } # folded
else { # new header
if (!defined($curr_head)) { # no previous complete header
} else {
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
? ($1.$taint, $2.$taint) : (undef,$curr_head);
my($msg1,$msg2);
if ($curr_head =~ /^(.*?)([\000\015])(.*)$(?!\n)/s) {
$msg1 = "Improper use of control character";
} elsif ($curr_head =~ /^(.*?)([\200-\377])(.*)$(?!\n)/s) {
$msg1 = "Non-encoded 8-bit data";
} elsif ($curr_head =~ /^(.*?)([^\000-\377])(.*)$(?!\n)/s) {
$msg1 = "Non-encoded Unicode character";
}
if (defined $msg1) {
my($pre,$ch,$post) = ($1.$taint, $2.$taint, $3.$taint);
if (length($post) > 20) {
$post = substr($post,0,15) . "...";
}
if (length($pre)-length($field_name)-2 > 50-length($post)){
$pre = "$field_name: ..." .
substr($pre,length($pre)-(45-length($post)));
}
$msg1 .= sprintf(" (char %02X hex) in message header '%s'",
ord($ch), $field_name);
$msg2 = sanitize_str($pre);
my($msg2_pre_l) = length($msg2);
$msg2 .= sanitize_str($ch.$post);
push(@bad, "$msg1\n $msg2\n " . (' ' x $msg2_pre_l).'^');
}
}
last if $next_head eq $eol; # end-of-header reached
$curr_head = $next_head;
}
}
@bad;
}
sub check_for_banned_filenames($$$$) {
my($acl_re, $entity, $parts, $file_generator_object) = @_;
my(@banned);
if (defined $parts && @$parts && $file_generator_object) {
do_log(3, "Checking for banned (contents-based) file types, " .
scalar(@$parts) . " parts");
for my $part (@$parts) {
for my $ft ($file_generator_object->file_type($part),
$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);
if ($result) {
push(@banned, $ft);
do_log(2, "Banned file contents type: $ft (patt: $patt)");
}
}
}
}
my(@unvisited) = defined $entity ? ($entity) : ();
do_log(3, "Checking for banned MIME types and names") if @unvisited;
while (@unvisited) { # traverse MIME::Entity object breadth-first
my($ent) = shift(@unvisited);
my(@rn); # recommended file names, both raw and RFC 2047 decoded
if ($ent->bodyhandle) {
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);
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);
push(@rn,$val_decoded) if !grep {$_ eq $val_decoded} @rn;
}
}
my($mt,$et) = ($ent->mime_type, $ent->effective_type);
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
if ($result) {
push(@banned, $mt);
do_log(2, "Banned Content-Type: $mt (patt: $patt)");
}
if ($et ne $mt) {
($result,$patt) = $acl_re->lookup_re($et); # effective mime type
if ($result) {
push(@banned, $et);
do_log(2, "Banned efective Content-Type: $et (patt: $patt)");
}
}
for my $rn (@rn) {
($result,$patt) = $acl_re->lookup_re($rn); # recommended file name
if ($result) {
push(@banned, $rn);
do_log(2, "Banned declared file name: $rn (patt: $patt)");
}
}
push(@unvisited, $ent->parts);
}
for (@banned) { $_ = sanitize_str($_); $_ = '"'.$_.'"' if / / }
\@banned; # return a listref of violations, possibly empty
}
# call 'file' utility for each part,
# and associate (save) full and short types with each part
#
sub determine_file_types($$$) {
my($partslist,$tempdir,$file_generator_object) = @_;
$file ne '' or 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, '/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)";
chomp($filetype); my($taint) = substr($filetype,0,0);
# remove file name
$filetype = $1.$taint if $filetype=~/^.+?: (.*)$(?!\n)/s;
section_time('get-file-type');
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';
/^(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';
/^ISO-8859.*\btext/i and $ty = '.txt';
/^Non-ISO.*ASCII\b.*\btext/i and $ty = '.txt';
/^Unicode\b.*\btext/i and $ty = '.txt';
/HTML document text/i and $ty = '.html';
/^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';
/^TIFF image data/i and $ty = '.tif';
/^MP3\b/i and $ty = '.mp3';
/^MPEG\b.*\bstream data/i and $ty = '.mpeg';
/^RIFF.*\bAVI/ and $ty = '.avi';
/^PostScript document text/i and $ty = '.ps';
/^PDF document/i and $ty = '.pdf';
/^Rich Text Format data/i and $ty = '.rtf';
/^Microsoft Office Document/i and $ty = '.doc';
/^LaTeX\b.*\bdocument text/i and $ty = '.lat';
/^TeX DVI file/i and $ty = '.dvi';
/^XML document text/i and $ty = '.xml';
/^exported SGML document text/i and $ty = '.sgml';
/^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';
/^Zip archive/i and $ty = '.zip';
/^RAR archive/i and $ty = '.rar';
/^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';
/script text executable/i and $ty = '.txt';
/^can't stat\b/ and $ty = '.empty'; # file(1) diagnostics
/^empty$/i and $ty = '.empty';
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);
};
}
# recursively descend into a directory $dir containing potentially unsafe
# files with unpredictable names, soft links, etc., rename each regular
# nonempty file to directory $outdir giving it a generated name,
# and discard all the rest, including the directory $dir.
# Return number of bytes that 'sanitized' files now occupy.
#
sub flatten_and_tidy_dir($$) {
my($dir,$outdir) = @_;
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);
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: $!" }
elsif (!-r _) { $msg = "not readable" }
if (defined $msg) { die "flatten_and_tidy_dir: \"$dir/$f\" $msg" }
next if ($f eq '.' || $f eq '..') && -d _;
$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\": $!";
} 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\": $!";
} elsif (-z _) {
$cnt_u++; unlink("$dir/$f") or die "Can't remove \"$dir/$f\": $!";
} else {
$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: $!";
}
}
closedir(DIR) or die "Can't close directory \"$dir\": $!";
section_time("ren${cnt_r}-unl${cnt_u}-files");
rmdir($dir) or die "Can't remove directory \"$dir\": $!";
section_time('rmdir');
$consumed_bytes;
}
# Decompose the part
sub decompose_part($$$) {
my($part,$tempdir,$file_generator_object) = @_;
my($filename) = "$tempdir/parts/$part";
my($filetype) = $file_generator_object->file_type_long($part);
my($ty) = $file_generator_object->file_type($part);
my($hold);
# do_log(4, "decompose_part: $part $filetype ($ty)");
# possible return values from eval:
# 0 - truly atomic, unknown or archiver failure; consider atomic
# 1 - some archiver format, successfully unpacked, result replaces original
# 2 - probably unpacked, but keep the original (eg self-extracting archive)
my($sts) = eval {
return 0 if !defined($ty); # consider atomic if unknown
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 -c");
/^\.Z$/ && defined $uncompress
&& return do_uncompress($part,$tempdir,"$uncompress -c");
/^\.bz2$/ && defined $bzip2
&& return do_uncompress($part,$tempdir,"$bzip2 -d -c");
/^\.gz$/ && defined $gzip
&& 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 -c");
/^\.cpio$/ && defined $cpio && return do_cpio($part,$tempdir);
# /^\.tar$/ && defined $cpio && return do_cpio($part,$tempdir);
/^\.tar$/ && return do_tar($part,$tempdir); # fallback
/^\.zip$/ && return do_unzip($part,0,$tempdir);
/^\.rar$/ && return do_unrar($part,0,$tempdir);
/^\.(lha|lzh)$/ && return do_lha($part,0,$tempdir);
/^\.arc$/ && return do_arc($part,$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);
# Falling through (e.g. HTML) - no match, consider atomic
return 0;
};
if ($@ ne '') {
chomp($@);
if ($@ =~ /^Exceeded storage quota/ ||
$@ =~ /^Maximum number of files.*exceeded/) { $hold = $@ }
else {
do_log(0,"Decoding of $part ($filetype) failed, ".
"leaving it unpacked: $@");
}
$sts = 2;
}
if ($sts == 1 && lookup($filetype, $keep_decoded_original_re)) {
# don't trust this file type or unpacker,
# keep both the original and the unpacked file
do_log(5, "file type is $filetype, retain original $part");
$sts = 2;
}
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;
}
#
# Uncompression/unarchiving routines
# Possible return codes:
# 0 atomic and stop unpacking
# 1 stuff was extracted, and continue unpacking
# 2 atomic and continue unpacking ; may be sfx, ascii etc.
# if ASCII text, try multiple decoding methods as provided by UUlib
# (includes uuencoding, xxencoding, Base64 and BinHex)
sub do_ascii($$) {
my($part,$tempdir) = @_;
my($sts,$count);
# prevent uunconc.c/UUDecode() from trying to create temp file in /
$ENV{TMPDIR} = $TEMPBASE if $ENV{TMPDIR} eq '';
$sts = Convert::UUlib::Initialize();
$sts==RET_OK or die "Convert::UUlib::Initialize failed: " .
Convert::UUlib::strerror($sts);
($sts,$count) = Convert::UUlib::LoadFile("$tempdir/parts/$part");
if ($sts != RET_OK) {
my($errmsg) = Convert::UUlib::strerror($sts) . ": $!";
$errmsg .= ", (???" . Convert::UUlib::strerror(
Convert::UUlib::GetOption(OPT_ERRNO)) .
"???)" if $sts==RET_IOERR;
die "Convert::UUlib::LoadFile failed: $errmsg";
}
do_log(4,"do_ascii: Decoding part $part ($count items)");
my($uu); my($any_errors,$any_decoded);
Convert::UUlib::SetOption(OPT_IGNMODE, 1);
for (my $j=0; $uu=Convert::UUlib::GetFileListItem($j); $j++) {
do_log(4, sprintf(
"do_ascii(%d): state=0x%02x, enc=%s%s, est.size=%s, name=%s",
$j, $uu->state, Convert::UUlib::strencoding($uu->uudet),
($uu->mimetype ne '' ? ", mimetype=".$uu->mimetype : ''),
$uu->size, $uu->filename));
if (! ($uu->state & FILE_OK) ) {
$any_errors++;
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) = "$!";
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 = ", stat on decoded: $newpart $statmsg" }
consumed_bytes(0+(-s _), 'do_ascii');
if ($sts==RET_OK && !defined($statmsg)) {
$any_decoded++;
} elsif ($sts==RET_NODATA || $sts==RET_NOEND) {
$any_errors++;
do_log(0, "do_ascii: Convert::UUlib error: " .
Convert::UUlib::strerror($sts) . $statmsg);
} else {
$any_errors++;
my($errmsg) = Convert::UUlib::strerror($sts).":: $err_decode";
$errmsg .= ", " . Convert::UUlib::strerror(
Convert::UUlib::GetOption(OPT_ERRNO)) if $sts==RET_IOERR;
die ("Convert::UUlib failed: " . $errmsg . $statmsg);
}
}
}
Convert::UUlib::CleanUp();
($any_decoded && !$any_errors) ? 1 : $any_errors ? 2 : 0;
}
# use Archive-Zip
sub do_unzip($$$) {
my($part,$exec,$tempdir) = @_;
do_log(4,"Unzipping $part");
my($zip) = Archive::Zip->new;
my(@err_nm) = qw(AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR);
# Need to set up a temporary minimal error handler
# because we now test inside do_unzip whether the $part
# in question is a zip archive
Archive::Zip::setErrorHandler(sub{return 5});
my($sts) = $zip->read("$tempdir/parts/$part");
Archive::Zip::setErrorHandler(sub{die @_});
if ($sts != AZ_OK) {
do_log(4,"do_unzip: not a zip: $err_nm[$sts] ($sts)");
return 0;
}
local *OUTPART;
my($any_unsupp_compmeth, $any_encrypted);
for my $mem ($zip->members()) {
my($compmeth) = $mem->compressionMethod;
if ($compmeth!=COMPRESSION_DEFLATED && $compmeth!=COMPRESSION_STORED) {
$any_unsupp_compmeth = $compmeth;
} elsif ($mem->isEncrypted) {
$any_encrypted++;
} elsif (!$mem->isDirectory) {
my($oldc) = $mem->desiredCompressionMethod(COMPRESSION_STORED);
$sts = $mem->rewindData();
$sts == AZ_OK
or 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: $!";
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: $!";
consumed_bytes(length($$buf_ref), 'do_unzip');
}
close(OUTPART) or die "Can't close $newpart: $!";
$mem->desiredCompressionMethod($oldc);
$mem->endRead();
}
}
if ($any_unsupp_compmeth)
{ do_log(0, "do_unzip: $part, unsupported compr. method: $any_unsupp_compmeth") }
if ($any_encrypted)
{ do_log(4, "do_unzip: $part, skipped $any_encrypted encrypted member(s)") }
$exec ? 2 : 1;
}
# use external decompressor program from the gzip/bzip2/compress family
# (there *is* a perl module for bzip2, but it is not ready for prime time)
sub do_uncompress($$$) {
my($part,$tempdir,$decompressor) = @_;
return 0 if !$decompressor;
do_log(4,"do_uncompress $part by $decompressor");
my($newpart) = "$tempdir/parts/" . getfilename();
my($rv) = run_command_copy($newpart,
run_command("$tempdir/parts/$part", undef,
split(' ',$decompressor) ));
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 die "Can't unlink $newpart: $!";
die "Error running $decompressor on $part, status: $retcode";
}
1;
}
# use Zlib to inflate
sub do_gunzip($$) {
my($part,$tempdir) = @_;
do_log(4,"Inflating gzip archive $part");
local *OUTPART;
my($gz) = gzopen("$tempdir/parts/$part", "rb")
or 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: $!";
my($buffer);
while ($gz->gzread($buffer) > 0) {
print OUTPART $buffer or die "Can't write to $newpart: $!";
consumed_bytes(length($buffer),'do_gunzip');
}
close(OUTPART) or 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: $!";
$gz->gzclose();
return 0;
}
$gz->gzclose();
1;
}
# untar any tar archives with Archive-Tar, extract each file individually
sub do_tar($$) {
my($part,$tempdir) = @_;
# Work around bug in Archive-Tar
my $tar = eval { Archive::Tar->new("$tempdir/parts/$part") };
unless (defined($tar)) {
chomp($@); do_log(4, "Faulty archive $part, $@");
return 0;
}
local *OUTPART;
do_log(4,"Untarring $part");
my @list = $tar->list_files();
for (@list) {
next if /\/$(?!\n)/; # ignore directories
# this is bad (reads whole file into scalar)
# 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: $!";
consumed_bytes(length($data),'do_tar');
close(OUTPART) or die "Can't close $newpart: $!";
}
1;
}
# use external program to expand RAR archives
sub do_unrar($$$) {
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, '--',
"$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
do_log(4, sprintf("unrar 't' returned status %d (signal %d, %s), command: %s",
$retval, $rv1&255, $err, $unrar));
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($proc_fh) = run_command(undef,undef, $unrar,
'v', @common_rar_switches, '--', "$tempdir/parts/$part");
while( defined($_ = $proc_fh->getline) ) {
chomp;
if (/^unexpected end of archive/) {
last;
} elsif (/^------/) {
$hypcount++;
last if $hypcount >= 2;
} elsif ($hypcount == 1) {
$lcnt++;
if ($lcnt % 2 == 0) { # information line (every other line)
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");
if ($1 > 0) { $bytes += $1; push(@list,$member_name) }
}
$member_name = undef;
} elsif (/^\*/) {
# discard password-protected files - makes no sense extracting
$encryptedcount++; $member_name = undef;
} else {
s/^.//s; # discard first character (space or an asterisk)
$member_name = $_;
}
}
}
# consume all remaining output to avoid broken pipe
while( defined($proc_fh->getline) ) {}
$err=undef; $proc_fh->close or $err=$!; $retval = retcode($?);
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
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 && $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, '--',
# "$tempdir/parts/$part");
my($proc_fh) = run_command(undef, '/dev/null', $unrar,
qw(x -inul -ver -o- -kb), @common_rar_switches, '--',
"$tempdir/parts/$part", "$tempdir/parts/rar/");
my($output) = '';
while( defined($_ = $proc_fh->getline) ) { $output .= $_ }
my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?);
if (!grep {$_==$retval} (0,1,3)) { # not one of: SUCCESS, WARNING, CRC
do_log(0, "unrar returned status $retval ($? $err)") if $retval;
}
my($errn) = stat("$tempdir/parts/rar") ? 0 : 0+$!;
if ($errn != ENOENT) {
my($b)=flatten_and_tidy_dir("$tempdir/parts/rar","$tempdir/parts");
consumed_bytes($b,'do_unrar');
}
}
$exec ? 2 : 1;
}
# use external program to expand LHA archives
sub do_lha($$$) {
my($part,$exec,$tempdir) = @_;
return 0 if !$lha;
# Check whether we can really lha it
my($checkerr);
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;
return 0 if $? || $checkerr;
do_log(4,"Expanding LHA archive $part");
my(@list);
$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) {
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;
}
$exec ? 2 : 1;
}
# use external program to expand ARC archives;
# works with original arc, or a GPL licensed 'nomarch'
# (http://rus.members.beeb.net/nomarch.html)
sub do_arc($$) {
my($part,$tempdir) = @_;
return 0 if !$arc;
my($is_nomarch) = $arc =~ /nomarch/i;
do_log(4,"Unarcing $part, using " . ($is_nomarch ? "nomarch" : "arc") );
my($cmdargs) = ($is_nomarch ? "-l -U" : "ln") . " $tempdir/parts/$part";
my($proc_fh) = run_command(undef, '/dev/null', $arc, split(' ',$cmdargs));
my(@list) = $proc_fh->getlines;
my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?);
$retval==0 or do_log(0, "do_arc: status=$retval ($? $err)");
#*** no spaces in filenames allowed???
map { s/^([^ \t\r\n]*).*$(?!\n)/$1/s } @list; # keep only filenames
if (@list) {
my $rv = store_mgr($tempdir, \@list, $arc,
($is_nomarch ? ('-p', '-U') : 'p'),
"$tempdir/parts/$part");
do_log(0, sprintf("arc returned status %d (signal %d)",
$rv>>8, $rv&255)) if $rv;
}
1;
}
# use external program to expand ZOO archives
sub do_zoo($$) {
my($part,$tempdir) = @_;
return 0 if !$zoo;
do_log(4,"Expanding ZOO archive $part");
# Zoo needs extension of .zoo!
symlink("$tempdir/parts/$part", "$tempdir/parts/$part.zoo");
my($proc_fh) = run_command(undef, undef,
$zoo, 'lf1q', "$tempdir/parts/$part.zoo");
my(@list) = $proc_fh->getlines;
my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?);
$retval==0 or do_log(0, "do_zoo: status=$retval ($? $err)");
if (@list) {
chomp(@list);
my $rv = store_mgr($tempdir, \@list, $zoo, 'xpqqq:',
"$tempdir/parts/$part.zoo");
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: $!";
}
1;
}
# use external program to expand ARJ archives
sub do_unarj($$) {
my($part,$tempdir) = @_;
return 0 if !$unarj;
do_log(4,"Expanding ARJ archive $part");
$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: $!";
# unarj has very limited extraction options! This may not be secure!
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: $!";
# avoiding shell: don't call system("... >/dev/null")
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($?);
chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!";
my($errn) = stat("$tempdir/parts/arj") ? 0 : 0+$!;
if ($errn != ENOENT) {
my($bytes) = flatten_and_tidy_dir("$tempdir/parts/arj", "$tempdir/parts");
consumed_bytes($bytes, 'do_unarj');
}
unlink("$tempdir/parts/$part.arj")
or die "Can't unlink $tempdir/parts/$part.arj: $!";
die "unarj returned status $retval ($err)" if $retval;
1;
}
sub do_tnef($$) {
my($part,$tempdir) = @_;
do_log(4,"Extracting TNEF attachment $part");
chdir("$tempdir/parts") or 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: $!";
return 0; }
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: $!";
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: $!";
consumed_bytes(length($s),'do_tnef');
}
close(OUTPART) or die "Can't close $newpart: $!";
consumed_bytes(-s($newpart), 'do_tnef');
}
}
$tnef->purge;
chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!";
1;
}
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 -n -v --quiet) );
while( defined($_ = $proc_fh->getline) ) {
chomp;
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;
}
}
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'); $rem_quota = $rem_quota_saved;
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 --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');
1;
}
sub do_executable($$) {
my($part,$tempdir) = @_;
do_log(4,"Check whether $part is a self-extracting archive");
return 2 if eval{do_unzip($part,1,$tempdir)};
chomp($@);
do_log(0,"do_executable/do_unzip failed, ignoring: $@") if $@;
return 2 if eval{do_unrar($part,1,$tempdir)};
chomp($@);
do_log(0,"do_executable/do_unrar failed, ignoring: $@") if $@;
return 2 if eval{do_lha($part,1,$tempdir)};
chomp($@);
do_log(0,"do_executable/do_unlha failed, ignoring: $@") if $@;
return 0;
}
sub run_command_copy($$) {
my($outfile,$ifh) = @_;
my($ofh) = IO::File->new;
$ofh->open($outfile,'w') or die "Can't create file $outfile: $!";
binmode($ofh) or die "Can't set file $outfile to binmode: $!";
binmode($ifh) or die "Can't set binmode on pipe: $!";
my($len, $buf, $offset, $written);
while ($len = $ifh->sysread($buf,16384)) {
$offset = 0;
while ($len > 0) { $written = syswrite($ofh, $buf, $len, $offset);
defined($written) or die "syswrite to $outfile failed: $!";
consumed_bytes($written, "run_command_copy");
$len -= $written; $offset += $written;
}
}
$ifh->close; my($rv) = $?;
$ofh->close or die "Can't close $outfile: $!";
$rv; }
sub store_mgr($$$@) {
my($tempdir, $list, $cmd, @args) = @_;
local *FH;
my(@rv);
for my $f (@$list) {
next if $f =~ /\/$(?!\n)/; if ($f =~ m{^(\.?[A-Za-z0-9_][A-Za-z0-9/._=~-]*)$(?!\n)} ) {
$f = $1; } else { do_log(1, "store_mgr: NOTICE: untainting funny argument \"$f\"");
$f = $1 if $f =~ /^(.*)$(?!\n)/s; }
my($newpart) = "$tempdir/parts/" . getfilename();
do_log(5, sprintf('store_mgr: extracting "%s" to file %s using %s',
$f, $newpart, $cmd));
my $rv = run_command_copy($newpart,
run_command(undef, undef, $cmd, @args, $f));
do_log(5, sprintf('store_mgr: extracted by %s, status %d (signal %d)',
$cmd, $rv>>8, $rv&255));
push(@rv,$rv);
}
@rv = grep {$_ != 0} @rv;
@rv ? $rv[0] : 0; }
1;
package Amavis::Notify;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
%EXPORT_TAGS = ();
@EXPORT = ();
@EXPORT_OK = qw(&delivery_status_notification &delivery_short_report
&string_to_mime_entity);
}
BEGIN {
import Amavis::Util qw(do_log safe_encode);
import Amavis::Timing qw(section_time);
import Amavis::Conf qw(:platform :notifyconf $myhostname $forward_method
$hdr_encoding $bdy_encoding);
import Amavis::Lookup qw(lookup);
import Amavis::Expand qw(expand);
import Amavis::rfc2821_2822_Tools;
}
use MIME::Entity;
use subs @EXPORT_OK;
sub string_to_mime_entity($) {
my($mail_as_string_ref) = @_;
my($entity); my($m_hdr,$m_body);
my($taint) = substr($$mail_as_string_ref,0,0);
($m_hdr,$m_body) = ($1.$taint, $3.$taint)
if $$mail_as_string_ref =~ /^(.*?\r?\n)(\r?\n|$(?!\n))(.*)$(?!\n)/s;
$m_body = safe_encode($bdy_encoding, $m_body);
eval {$entity = MIME::Entity->build(
Type => 'text/plain', Encoding => '-SUGGEST', Charset => $bdy_encoding,
(defined $notify_xmailer_header && $notify_xmailer_header eq ''
? () : ('X-Mailer' => $notify_xmailer_header) ), Data => $m_body); 1} or do {chomp($@); die $@};
my($head) = $entity->head;
$m_hdr =~ s/\r?\n([ \t])/$1/g; for my $hdr_line (split(/\r?\n/,$m_hdr)) {
if ($hdr_line =~ /^([^:]*):\s*(.*)$(?!\n)/s) {
my($fhead,$fbody) = ($1.$taint, $2.$taint);
if ($fhead =~ /^(X-.*|Subject|Comments)$(?!\n)/si &&
$fbody =~ /[^\011\012\040-\176]/ ) { my($fbody_octets) = $fbody; if ($unicode_aware && Encode::is_utf8($fbody)) {
$fbody_octets = safe_encode($hdr_encoding, $fbody);
do_log(5,"string_to_mime_entity UTF-8 body: $fbody");
do_log(5,"string_to_mime_entity body octets: $fbody_octets");
}
$fbody = MIME::Words::encode_mimeword($fbody_octets,
'Q', $hdr_encoding);
} else { $fbody = safe_encode('ascii', $fbody);
}
$fhead = safe_encode('ascii', $fhead);
do_log(5, sprintf("string_to_mime_entity %s: %s", $fhead,$fbody));
eval {$head->replace($fhead,$fbody); 1} or do {chomp($@); die $@};
}
}
$entity; }
sub delivery_status_notification($$$$$) {
my($conn, $msginfo, $report_success_dsn_also,
$builtins_ref, $template_ref) = @_;
my($dsn_time) = time; my($notification);
if ($msginfo->sender eq '') { do_log(4, "Not sending DSN to empty return path");
} else {
my($from_mta,$client_ip) = ($conn->smtp_helo, $conn->client_ip);
my($msg)=''; $msg .= "Reporting-MTA: dns; $myhostname\n";
$msg .= "Received-From-MTA: smtp; $from_mta ([$client_ip])\n"
if $from_mta ne '';
$msg .= "Arrival-Date: " . rfc2822_timestamp($msginfo->rx_time) . "\n";
my($any); for my $r (@{$msginfo->per_recip_data}) {
my($remote_mta) = $r->recip_remote_mta;
my($smtp_resp) = $r->recip_smtp_response;
if (! $r->recip_done) {
if ($forward_method eq '') { $smtp_resp = "250 2.5.0 Ok, continue delivery";
} else {
do_log(0, "TROUBLE: recipient not done: <" .
$r->recip_addr . "> " . $smtp_resp);
}
}
my($smtp_resp_code, $smtp_resp_enhcode, $smtp_resp_msg);
if ($smtp_resp =~ /^ (\d{3}) \s+ ([245] \. \d{1,3} \. \d{1,3})?
\s* (.*) $(?!\n)/xs) {
($smtp_resp_code,$smtp_resp_enhcode,$smtp_resp_msg)=($1,$2,$3);
} else { $smtp_resp_msg = $smtp_resp }
my($smtp_resp_class) = $smtp_resp_code =~ /^(\d)/ ? $1 : '0';
if ($smtp_resp_enhcode eq '' && $smtp_resp_class =~ /^([245])$/ ) {
$smtp_resp_enhcode = "$1.0.0";
}
next unless $smtp_resp_class ne '2' || $report_success_dsn_also;
$any++;
$msg .= "\n"; if ($remote_mta ne '' && $r->recip_final_addr ne $r->recip_addr) {
$msg .= "X-NextToLast-Final-Recipient: rfc822; " .
quote_rfc2821_local($r->recip_addr) . "\n";
$msg .= "Final-Recipient: rfc822; " .
quote_rfc2821_local($r->recip_final_addr) . "\n";
} else {
$msg .= "Final-Recipient: rfc822; " .
quote_rfc2821_local($r->recip_addr) . "\n";
}
$msg .= "Action: " .
($smtp_resp_class eq '2' ? 'delivered' : 'failed') . "\n";
$msg .= "Status: $smtp_resp_enhcode\n";
my($rem_smtp_resp) = $r->recip_remote_mta_smtp_response;
if ($remote_mta eq '' || $rem_smtp_resp eq '') {
$msg .= "Diagnostic-Code: smtp; $smtp_resp\n";
} else {
$msg .= "Remote-MTA: dns; $remote_mta\n";
$msg .= "Diagnostic-Code: smtp; $rem_smtp_resp\n";
}
$msg .= "Last-Attempt-Date: " . rfc2822_timestamp($dsn_time) ."\n";
}
return $notification if !$any;
my($to_hdr) = qquote_rfc2821_local($msginfo->sender_contact);
my(%mybuiltins) = %$builtins_ref; $mybuiltins{'f'} = $hdrfrom_notify_sender; $mybuiltins{'T'} = $to_hdr;
$mybuiltins{'d'} = rfc2822_timestamp($dsn_time);
my($dsn) = expand($template_ref,\%mybuiltins);
my($dsn_entity) = string_to_mime_entity($dsn);
$dsn_entity->make_multipart;
my($head) = $dsn_entity->head;
eval {$head->replace('From',$hdrfrom_notify_sender); 1} or do {chomp($@); die $@};
eval {$head->replace('To', $to_hdr); 1} or do {chomp($@); die $@};
eval {$head->replace('Date',rfc2822_timestamp($dsn_time)); 1}
or do {chomp($@); die $@};
my($field) = Mail::Field->new('Content_type'); $field->type("multipart/report; report-type=delivery-status");
$field->boundary(MIME::Entity::make_boundary());
$head->replace('Content-type', $field->stringify);
$head = undef;
eval {$dsn_entity->attach(
Type => 'message/delivery-status', Encoding => '7bit',
Description => 'Delivery error report',
Data => $msg); 1} or do {chomp($@); die $@};
eval {$dsn_entity->attach(
Type => 'text/rfc822-headers', Encoding => '-SUGGEST',
Description => 'Undelivered-message headers',
Data => $msginfo->orig_header); 1} or do {chomp($@); die $@};
$notification = Amavis::In::Message->new;
$notification->sender($mailfrom_notify_sender); $notification->recips([$msginfo->sender_contact]);
$notification->mail_text($dsn_entity);
}
$notification;
}
sub delivery_short_report($) {
my($msginfo) = @_;
my(@succ_entries, @other_entries);
for my $r (@{$msginfo->per_recip_data}) {
my($remote_mta) = $r->recip_remote_mta;
my($smtp_resp) = $r->recip_smtp_response;
my($qrecip_addr) = scalar(qquote_rfc2821_local($r->recip_addr));
if ($r->recip_destiny == D_PASS
&& ($smtp_resp =~ /^2/ || !$r->recip_done)) {
push(@succ_entries, $qrecip_addr);
} else {
push(@other_entries, sprintf("%s:%s\n %s", $qrecip_addr,
($remote_mta eq ''?'':" $remote_mta said:"), $smtp_resp));
}
}
(\@succ_entries, \@other_entries);
}
1;
package Amavis;
require 5.005; use strict;
use POSIX qw(strftime);
use Errno qw(ENOENT);
use IO::File;
use Digest::MD5;
use Net::Server 0.83;
use Net::Server::PreForkSimple;
BEGIN {
import Amavis::Conf qw(:platform :confvars :notifyconf :sa);
import Amavis::Util qw(do_log debug_oneshot am_id prolong_timer
min max);
import Amavis::Timing qw(section_time);
import Amavis::Log;
import Amavis::Lookup qw(lookup lookup_ip_acl);
import Amavis::rfc2821_2822_Tools;
import Amavis::Out;
import Amavis::Out::EditHeader;
import Amavis::UnmangleSender qw(best_try_originator first_received_from);
import Amavis::Unpackers qw(mime_decode decompose_part
determine_file_types check_for_banned_filenames
check_header_validity);
import Amavis::Expand qw(expand);
import Amavis::Notify qw(delivery_status_notification
delivery_short_report string_to_mime_entity);
import Amavis::In::Connection;
import Amavis::In::Message;
}
use vars qw(@ISA);
@ISA = qw(Net::Server::PreForkSimple);
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
use vars qw($extra_code_sql $extra_code_ldap
$extra_code_in_amcl $extra_code_in_smtp
$extra_code_antivirus $extra_code_antispam);
use vars qw($spam_level $spam_status $spam_report);
use vars qw($user_id_sql
$virus_lovers_sql $spam_lovers_sql
$banned_files_lovers_sql $bad_header_lovers_sql
$bypass_virus_checks_sql $bypass_spam_checks_sql
$bypass_banned_checks_sql $bypass_header_checks_sql
$spam_tag_level_sql $spam_tag2_level_sql $spam_kill_level_sql
$spam_modifies_subj_sql $local_domains_sql $wb_listed_sql
$spam_quarantine_to_sql);
use vars qw($default_ldap $user_id_ldap
$virus_lovers_ldap $spam_lovers_ldap
$banned_files_lovers_ldap $bad_header_lovers_ldap
$bypass_virus_checks_ldap $bypass_spam_checks_ldap
$bypass_banned_checks_ldap $bypass_header_checks_ldap
$spam_tag_level_ldap $spam_tag2_level_ldap $spam_kill_level_ldap
$spam_modifies_subj_ldap $local_domains_ldap $wb_listed_ldap
$spam_quarantine_to_ldap);
use vars qw(%scan_cache $body_digest);
use vars qw(%builtins);
use vars qw($child_invocation_count $child_task_count);
use vars qw($VIRUSFILE $CONN $MSGINFO);
use vars qw($av_output @virusname @detecting_scanners
@banned_filename @bad_headers);
use vars qw($amcl_in_obj $smtp_in_obj); use vars qw($sql_policy $sql_wblist);
sub pre_loop_hook {
local $SIG{CHLD} = 'DEFAULT';
find_external_programs( [split(/:/, $path, -1)] );
my($name) = $TEMPBASE;
$name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne '';
my($errn) = stat($TEMPBASE) ? 0 : 0+$!;
if ($errn == ENOENT) { die "No TEMPBASE directory: $name" }
elsif ($errn) { die "TEMPBASE directory inaccessible, $!: $name" }
elsif (! -d _) { die "TEMPBASE is not a directory: $name" }
elsif (! -w _) { die "TEMPBASE is not writeable: $name" }
if ($QUARANTINEDIR ne '') {
my($name) = $QUARANTINEDIR;
$name = "$daemon_chroot_dir $name" if $daemon_chroot_dir ne '';
my($errn) = stat($QUARANTINEDIR) ? 0 : 0+$!;
if ($errn == ENOENT) { } elsif ($errn) { die "QUARANTINEDIR inaccessible, $!: $name" }
elsif (-d _ && !-w _) { die "QUARANTINEDIR directory not writeable: $name" }
}
Amavis::SpamControl::init() if $extra_code_antispam;
}
sub write_to_log_hook {
my($self,$level,$msg) = @_;
my($prop) = $self->{server};
local $SIG{CHLD} = 'DEFAULT';
chomp($msg); do_log(1, "Net::Server: ".$msg); 1;
}
sub child_init_hook {
my($self) = shift;
local $SIG{CHLD} = 'DEFAULT';
$0 = 'amavisd (virgin child)';
}
sub post_accept_hook {
my($self) = shift;
local $SIG{CHLD} = 'DEFAULT';
$child_invocation_count++;
Amavis::Timing::init(); $0 = 'amavisd (child)';
}
sub allow_deny_hook {
my($self) = shift;
my($prop) = $self->{server};
my($sock) = $prop->{client};
local $SIG{CHLD} = 'DEFAULT';
return 1 if UNIVERSAL::can($sock,'NS_proto') && $sock->NS_proto eq 'UNIX';
my($permit,$fullkey) = lookup_ip_acl($prop->{peeraddr}, \@inet_acl);
if (!$permit) {
if (!defined($fullkey)) {
do_log(0, "DENIED ACCESS from IP " . $prop->{peeraddr});
} else {
do_log(0, sprintf("DENIED ACCESS from IP %s, blocked by rule %s",
$prop->{peeraddr}, $fullkey));
}
return 0;
}
1;
}
sub process_request {
my($self) = shift;
my($prop) = $self->{server};
my($sock) = $prop->{client};
local $SIG{CHLD} = 'DEFAULT';
if ($unicode_aware) {
binmode(STDIN, ":bytes") or die "Can't cancel :utf8 mode on STDIN: $!";
binmode(STDOUT,":bytes") or die "Can't cancel :utf8 mode on STDOUT: $!";
binmode($sock, ":bytes") or die "Can't cancel :utf8 mode on socket: $!";
}
$| = 1;
local $SIG{ALRM} = sub { die "timed out\n" }; eval {
prolong_timer('new request - timer reset', $child_timeout); if ($extra_code_sql && @lookup_sql_dsn && $child_invocation_count==1) {
$sql_policy = $sql_wblist = undef;
my($sql_dbh)= Amavis::Lookup::SQL::connect_to_sql(@lookup_sql_dsn);
section_time('sql-connect');
if (!defined($sql_dbh)) {
die "SQL server(s) not reachable, ABORTING";
} else {
$sql_dbh->{'RaiseError'} = 1;
$sql_policy = Amavis::Lookup::SQL->new(
$sql_dbh, $sql_select_policy);
$sql_wblist = Amavis::Lookup::SQL->new(
$sql_dbh, $sql_select_white_black_list
) if defined $sql_select_white_black_list;
my $nf = sub {Amavis::Lookup::SQLfield->new($sql_policy,@_)}; $user_id_sql = $nf->('id', 'N');
$virus_lovers_sql = $nf->('virus_lover', 'B0');
$spam_lovers_sql = $nf->('spam_lover', 'B-');
$banned_files_lovers_sql= $nf->('banned_files_lover', 'B-');
$bad_header_lovers_sql = $nf->('bad_header_lover', 'B-');
$bypass_virus_checks_sql= $nf->('bypass_virus_checks', 'B0');
$bypass_spam_checks_sql = $nf->('bypass_spam_checks', 'B0');
$bypass_banned_checks_sql=$nf->('bypass_banned_checks','B-');
$bypass_header_checks_sql=$nf->('bypass_header_checks','B-');
$spam_tag_level_sql = $nf->('spam_tag_level', 'N' );
$spam_tag2_level_sql = $nf->('spam_tag2_level', 'N' );
$spam_kill_level_sql = $nf->('spam_kill_level', 'N' );
$spam_modifies_subj_sql = $nf->('spam_modifies_subj', 'B-');
$spam_quarantine_to_sql = $nf->('spam_quarantine_to', 'S-');
$local_domains_sql = $nf->('local', 'B1');
section_time('sql-prepare');
}
undef @lookup_sql_dsn; }
if ($extra_code_ldap && $child_invocation_count==1) {
my $lf = sub {
Amavis::Lookup::LDAP->new($default_ldap, @_) if $_[0]
}; $virus_lovers_ldap = $lf->($virus_lovers_ldap);
$spam_lovers_ldap = $lf->($spam_lovers_ldap);
$banned_files_lovers_ldap = $lf->($banned_files_lovers_ldap);
$bad_header_lovers_ldap = $lf->($bad_header_lovers_ldap);
$bypass_virus_checks_ldap = $lf->($bypass_virus_checks_ldap);
$bypass_spam_checks_ldap = $lf->($bypass_spam_checks_ldap);
$bypass_banned_checks_ldap= $lf->($bypass_banned_checks_ldap);
$bypass_header_checks_ldap= $lf->($bypass_header_checks_ldap);
$spam_tag_level_ldap = $lf->($spam_tag_level_ldap);
$spam_tag2_level_ldap = $lf->($spam_tag2_level_ldap);
$spam_kill_level_ldap = $lf->($spam_kill_level_ldap);
$spam_modifies_subj_ldap = $lf->($spam_modifies_subj_ldap);
$spam_quarantine_to_ldap = $lf->($spam_quarantine_to_ldap);
$local_domains_ldap = $lf->($local_domains_ldap);
}
my($conn) = Amavis::In::Connection->new;
$CONN = $conn; $conn->proto($sock->NS_proto);
if ($sock->NS_proto eq 'UNIX') { $amcl_in_obj = Amavis::In::AMCL->new if !$amcl_in_obj;
$amcl_in_obj->process_amavis_client_request(
$sock, $conn, \&check_mail);
do_log(2, Amavis::Timing::report()); } elsif ($sock->NS_proto eq 'TCP') { $conn->socket_ip($prop->{sockaddr});
$conn->socket_port($prop->{sockport});
$conn->client_ip($prop->{peeraddr});
if (!$extra_code_in_smtp) {
die ("incomming TCP connection, but dynamic code ".
"to handle SMTP or LMTP not loaded");
} else {
my($lmtp); $smtp_in_obj = Amavis::In::SMTP->new if !$smtp_in_obj;
$smtp_in_obj->process_smtp_request(
$sock, $lmtp, $conn, \&check_mail);
}
} else {
die ("unsupported protocol: " . $sock->NS_proto);
}
};
alarm(0); if ($@ ne '') {
chomp($@);
my($msg) = $@ eq "timed out"
? "Child task exceeded $child_timeout seconds, abort"
: "TROUBLE?: $@";
do_log(0, $msg);
$smtp_in_obj->preserve_evidence(1) if $smtp_in_obj;
die ("(" . am_id() . ") " . $msg . "\n");
}
if ($child_task_count >= $max_requests &&
$child_invocation_count < $max_requests) {
do_log(1,"Requesting a process rundown after $child_task_count tasks");
$self->done(1);
}
}
sub done(@) {
my($self) = shift;
if (@_) {
$self->{server}->{done} = shift;
} elsif (!$self->{server}->{done}) {
$self->{server}->{done} = $self->SUPER::done;
}
$self->{server}->{done};
}
sub post_process_request_hook {
local $SIG{CHLD} = 'DEFAULT';
debug_oneshot(0);
$0 = 'amavisd (child)';
}
sub child_finish_hook {
my($self) = shift;
local $SIG{CHLD} = 'DEFAULT';
$smtp_in_obj = undef; $amcl_in_obj = undef; }
sub END { $smtp_in_obj = undef; $amcl_in_obj = undef; }
sub check_mail($$$$) {
my($conn, $msginfo, $dsn_per_recip_capable, $tempdir) = @_;
my($fh) = $msginfo->mail_text;
my(@recips) = @{$msginfo->recips};
$MSGINFO = $msginfo; $child_task_count++;
$VIRUSFILE = undef; $av_output = undef;
@virusname = (); @detecting_scanners = ();
@banned_filename = (); @bad_headers = ();
$spam_level = undef; $spam_status = undef; $spam_report = undef;
$sql_policy->clear_cache if defined $sql_policy;
$sql_wblist->clear_cache if defined $sql_wblist;
$body_digest = get_body_digest($fh,$msginfo);
my($mail_size) = $msginfo->orig_header_size + 1 + $msginfo->orig_body_size;
my($file_generator_object) = Amavis::Unpackers::NewFilename->new($MAXFILES ? $MAXFILES : undef);
Amavis::Unpackers::init($file_generator_object, $mail_size);
my($smtp_resp,$exit_code,$preserve_evidence);
my($banned_filename_checked);
my($virus_presence_checked,$spam_presence_checked);
do_log(1, sprintf("Checking: <%s> -> %s",
$msginfo->sender, join(',',map{"<$_>"}@recips)) );
my($am_id) = am_id();
my($hold); my($which_section);
eval {
$which_section = "creating_partsdir";
if (-d "$tempdir/parts") {
} else {
mkdir("$tempdir/parts", 0750)
or die "Can't create directory $tempdir/parts: $!";
section_time('mkdir parts');
}
chdir($TEMPBASE) or die "Can't chdir to $TEMPBASE: $!";
if (defined($body_digest) && exists($scan_cache{$body_digest})) {
$which_section = "cached";
my($bs) = $scan_cache{$body_digest};
$banned_filename_checked = defined $bs->{'FB'} ? 1 : 0;
$virus_presence_checked = defined $bs->{'VN'} ? 1 : 0;
$spam_presence_checked = defined $bs->{'SL'} ? 1 : 0;
do_log(1, sprintf("cached %s from <%s> (%s,%s,%s)", $body_digest,
$msginfo->sender, $banned_filename_checked,
$virus_presence_checked,$spam_presence_checked));
@banned_filename = !ref($bs->{'FB'}) ? () : @{$bs->{'FB'}}; @virusname = !ref($bs->{'VN'}) ? () : @{$bs->{'VN'}}; @detecting_scanners=!ref($bs->{'VD'}) ? () : @{$bs->{'VD'}}; $av_output = $bs->{'VO'}; $spam_level = $bs->{'SL'};
$spam_status = $bs->{'SS'}; $spam_report = $bs->{'SR'};
}
if (grep {!lookup($_,
$bypass_header_checks_sql, $bypass_header_checks_ldap,
\%bypass_header_checks, \@bypass_header_checks_acl,
$bypass_header_checks_re)} @recips) {
@bad_headers = check_header_validity($conn, $msginfo);
}
if ($banned_filename_checked) {
do_log(5, "banned_filename_presence cached, skipping check");
} elsif (!$banned_filename_re) {
do_log(5, "banned_filename_presence skipped, no tests");
} elsif (!grep {!lookup($_,
$bypass_banned_checks_sql,$bypass_banned_checks_ldap,
\%bypass_banned_checks, \@bypass_banned_checks_acl,
$bypass_banned_checks_re)} @recips) {
do_log(5, "bypassing of banned_filename_presence requested");
} else {
if (!defined($msginfo->mime_entity)) {
$which_section = "mime_decode";
$msginfo->mime_entity(mime_decode($fh,$tempdir));
prolong_timer($which_section);
}
$which_section = "filename_check_mime";
my($banned_filenames_ref) =
check_for_banned_filenames($banned_filename_re,
$msginfo->mime_entity, undef, undef);
push(@banned_filename, @$banned_filenames_ref);
$scan_cache{$body_digest}{'FB'} = [@banned_filename] if defined $body_digest;
$banned_filename_checked = 1;
}
if ($virus_presence_checked) {
do_log(5, "virus_presence cached, skipping virus_scan");
} else {
my($will_do_virus_scanning) = $extra_code_antivirus &&
grep {!lookup($_, $bypass_virus_checks_sql,
$bypass_virus_checks_ldap,
\%bypass_virus_checks,
\@bypass_virus_checks_acl,
$bypass_virus_checks_re)} @recips;
if (!$bypass_decode_parts &&
($will_do_virus_scanning ||
($banned_filename_re && !@banned_filename) )
) { if (!defined($msginfo->mime_entity)) {
$which_section = "mime_decode";
$msginfo->mime_entity(mime_decode($fh,$tempdir));
prolong_timer($which_section);
}
$which_section = "decoding";
my(@parts); my($depth) = 1;
TIER: while ( @parts=@{$file_generator_object->parts_list} ) {
$which_section = "decoding1";
if ($depth > $MAXLEVELS) {
$hold = "Maximum decoding depth ($MAXLEVELS) exceeded";
last;
}
$file_generator_object->parts_list_reset; my(@chopped_parts) = @parts > 5 ? @parts[0..4] : @parts;
do_log(4, sprintf("decode_parts: level=%d, #parts=%d : %s",
$depth, scalar(@parts), join(', ', @chopped_parts,
(@chopped_parts>=@parts ? () : "...")) ));
$which_section = "decoding2-get-file-types";
determine_file_types(\@parts, $tempdir,
$file_generator_object);
if (!$banned_filename_re) {
} elsif (!grep {!lookup($_,
$bypass_banned_checks_sql,$bypass_banned_checks_ldap,
\%bypass_banned_checks, \@bypass_banned_checks_acl,
$bypass_banned_checks_re)} @recips) {
} else {
$which_section = "decoding3-check-banned";
my($banned_filenames_ref) =
check_for_banned_filenames($banned_filename_re,
undef, \@parts, $file_generator_object);
push(@banned_filename, @$banned_filenames_ref);
$scan_cache{$body_digest}{'FB'} = [@banned_filename] if defined $body_digest;
}
$which_section = "decoding4";
for my $part (@parts) {
my($errn) = stat("$tempdir/parts/$part") ? 0 : 0+$!;
if ($errn == ENOENT) {
do_log(0, "decode_parts: NOTICE: new name requested, but file not created: $part");
} else {
$which_section = "decoding-decompose-parts";
$hold = decompose_part($part, $tempdir,
$file_generator_object);
$which_section = "decoding5";
last TIER if defined $hold;
}
}
$depth++;
}
section_time('parts'); prolong_timer('decoding');
}
if ($hold ne '') { $will_do_virus_scanning = 0 }
if (!$extra_code_antivirus) {
do_log(5, "No anti-virus code loaded, skipping this section");
} elsif ($will_do_virus_scanning) {
if (!defined($msginfo->mime_entity)) {
$which_section = "mime_decode";
$msginfo->mime_entity(mime_decode($fh,$tempdir));
prolong_timer($which_section);
}
$which_section = "virus_scan";
my($remaining_time) = alarm(0); my($av_ret);
eval {
my($vn,$ds); ($av_ret,$av_output,$vn,$ds) =
Amavis::AV::virus_scan($tempdir, $child_task_count==1);
@virusname = @$vn; @detecting_scanners = @$ds; };
prolong_timer($which_section, $remaining_time); if ($@ ne '') {
chomp($@);
die "$@\n" if $@ ne "timed out";
@virusname = (); $av_ret = 0; do_log(0, "virus_scan TIMED OUT, ASSUME NOT A VIRUS !!!");
}
defined($av_ret) or die "All virus scanners failed!";
if (defined $body_digest) { $scan_cache{$body_digest}{'VO'} = $av_output;
$scan_cache{$body_digest}{'VN'} = [@virusname]; $scan_cache{$body_digest}{'VD'} = [@detecting_scanners];
}
$virus_presence_checked = 1;
}
}
my($any_wbl, $all_wbl);
($any_wbl,$all_wbl) = Amavis::SpamControl::white_black_list(
$conn,$msginfo,$sql_wblist,$user_id_sql) if $extra_code_antispam;
if ($spam_presence_checked) {
do_log(5, "spam_presence cached, skipping spam_scan");
} elsif (!$extra_code_antispam) {
do_log(5, "No anti-spam code loaded, skipping spam_scan");
} elsif (@virusname || @banned_filename) {
do_log(5, "infected or banned contents, skipping spam_scan");
} elsif ($all_wbl) {
do_log(5, "sender white/blacklisted, skipping spam_scan");
} elsif (!grep {!lookup($_,
$bypass_spam_checks_sql, $bypass_spam_checks_ldap,
\%bypass_spam_checks, \@bypass_spam_checks_acl,
$bypass_spam_checks_re)} @recips) {
do_log(5, "bypassing of spam checks requested");
} else {
$which_section = "spam_scan";
($spam_level, $spam_status, $spam_report) =
Amavis::SpamControl::spam_scan($conn,$msginfo);
prolong_timer($which_section);
if (defined $body_digest) { $scan_cache{$body_digest}{'SL'} = $spam_level;
$scan_cache{$body_digest}{'SS'} = $spam_status;
$scan_cache{$body_digest}{'SR'} = $spam_report;
}
$spam_presence_checked = 1;
}
$msginfo->sender_contact($msginfo->sender); $msginfo->sender_source($msginfo->sender);
my($considered_spam_by_some_recips);
if (@virusname || @banned_filename) { $which_section = "deal_with_virus_or_banned";
my($final_destiny) = @virusname ? $final_virus_destiny
: @banned_filename ? $final_banned_destiny : D_PASS;
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; if ($final_destiny == D_PASS) {
} elsif ((!@virusname || lookup($r->recip_addr,
$virus_lovers_sql, $virus_lovers_ldap,
\%virus_lovers, \@virus_lovers_acl,
$virus_lovers_re))
&&
(!@banned_filename || lookup($r->recip_addr,
$banned_files_lovers_sql, $banned_files_lovers_ldap,
\%banned_files_lovers, \@banned_files_lovers_acl,
$banned_files_lovers_re)) ) {
} else { $r->recip_destiny($final_destiny);
my($reason);
if (@virusname)
{ $reason = "VIRUS: " . join(", ", @virusname) }
elsif (@banned_filename)
{ $reason = "BANNED: " . join(", ", @banned_filename) }
$r->recip_smtp_response( ($final_destiny == D_DISCARD
? "250 2.7.1 Ok, discarded"
: "550 5.7.1 Message content rejected")
. ", id=$am_id - $reason");
$r->recip_done(1);
}
my($ext) = @virusname ? $addr_extension_virus
: @banned_filename ? $addr_extension_banned : '';
if ($recipient_delimiter ne '' && $ext ne '' &&
$r->recip_destiny == D_PASS &&
lookup($r->recip_addr, $local_domains_sql,
$local_domains_ldap, \%local_domains,
\@local_domains_acl, $local_domains_re)
) { my($localpart,$domain) = split_address($r->recip_addr);
if ($replace_existing_extension) {
$localpart =~
s/^(.*?)\Q$recipient_delimiter\E.*$(?!\n)/$1/s;
}
do_log(5,"adding extension $recipient_delimiter".
"$addr_extension_virus to $localpart\@$domain");
$r->recip_addr_modified(
$localpart . $recipient_delimiter . $ext . $domain);
}
}
$which_section = "virus_or_banned quar+notif";
ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname);
do_virus($conn,$msginfo);
} else { $which_section = "deal_with_spam";
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; my($should_be_killed) = $r->recip_blacklisted_sender ||
defined $spam_level && $spam_level>=lookup($r->recip_addr,
$spam_kill_level_sql, $spam_kill_level_ldap,
$sa_kill_level_deflt);
next unless $should_be_killed;
$considered_spam_by_some_recips = 1;
if ($final_spam_destiny == D_PASS ||
$r->recip_whitelisted_sender ||
lookup($r->recip_addr, $spam_lovers_sql,$spam_lovers_ldap,
\%spam_lovers,\@spam_lovers_acl,$spam_lovers_re) ) {
} else { $r->recip_destiny($final_spam_destiny);
my($reason) = $r->recip_blacklisted_sender ?
'sender blacklisted' : 'UBE';
$r->recip_smtp_response( ($final_spam_destiny == D_DISCARD
? "250 2.7.1 Ok, discarded, $reason"
: "550 5.7.1 Message content rejected, $reason")
. ", id=$am_id");
$r->recip_done(1);
}
if ($recipient_delimiter ne '' &&
$addr_extension_spam ne '' &&
$r->recip_destiny == D_PASS &&
lookup($r->recip_addr, $local_domains_sql,
$local_domains_ldap, \%local_domains,
\@local_domains_acl, $local_domains_re) )
{ my($localpart,$domain) = split_address($r->recip_addr);
if ($replace_existing_extension) {
$localpart =~
s/^(.*?)\Q$recipient_delimiter\E.*$(?!\n)/$1/s;
}
do_log(5,"adding extension $recipient_delimiter".
"$addr_extension_spam to $localpart\@$domain");
$r->recip_addr_modified($localpart.
$recipient_delimiter.$addr_extension_spam.$domain);
}
}
if ($considered_spam_by_some_recips) {
$which_section = "spam quar+notif";
ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname);
do_spam($conn,$msginfo);
}
}
if (@bad_headers) { $which_section = "deal_with_bad_headers";
ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname);
my($is_bulk) = $msginfo->mime_entity->head->get("precedence");
chomp($is_bulk);
do_log(0, sprintf("BAD HEADER from %s<%s>: %s",
$is_bulk eq '' ? '' : "($is_bulk) ",
$msginfo->sender, $bad_headers[0] ));
$is_bulk =~ /(bulk|list)/i ? $1 : undef;
if (defined $is_bulk || $msginfo->sender eq '') {
} else {
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; if ($final_bad_header_destiny == D_PASS ||
lookup($r->recip_addr,
$bad_header_lovers_sql, $bad_header_lovers_ldap,
\%bad_header_lovers, \@bad_header_lovers_acl,
$bad_header_lovers_re) ) {
} else { $r->recip_destiny($final_bad_header_destiny);
my($reason) = (split("\n",$bad_headers[0]))[0];
$r->recip_smtp_response(
($final_bad_header_destiny == D_DISCARD
? "250 2.6.0 Ok, message with invalid header discarded"
: "550 5.6.0 Message with invalid header rejected")
. ", id=$am_id - $reason");
$r->recip_done(1);
}
}
}
}
prolong_timer($which_section);
if ($forward_method ne '') { $which_section = "forwarding";
ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); for (;;) {
my($hdr_edits) = Amavis::Out::EditHeader->new;
$hdr_edits = add_forwarding_header_edits_common(
$conn,$msginfo,$hdr_edits,$hold,
$virus_presence_checked,$spam_presence_checked);
my($done_all);
my($recip_cl); ($hdr_edits,$recip_cl,$done_all) =
add_forwarding_header_edits_per_recip(
$conn,$msginfo,$hdr_edits,$hold);
last if !@$recip_cl;
$msginfo->header_edits($hdr_edits);
mail_dispatch($forward_method,$conn,$msginfo,0,
sub {my($r)=@_; grep {$_ eq $r} @$recip_cl} );
last if $done_all;
}
}
prolong_timer($which_section);
$which_section = "delivery-notification";
my($dsn_needed);
($smtp_resp, $exit_code, $dsn_needed) =
one_response_for_all($msginfo,$dsn_per_recip_capable);
my($warnsender_with_pass) = $smtp_resp =~ /^2/ && !$dsn_needed &&
( $warnvirussender && @virusname
|| $warnbannedsender && @banned_filename
|| $warnbadhsender && @bad_headers
|| $warnspamsender && $considered_spam_by_some_recips );
do_log(5, "warnsender_with_pass=$warnsender_with_pass, dsn_needed=$dsn_needed, exit=$exit_code, $smtp_resp");
if ($dsn_needed || $warnsender_with_pass) {
ensure_mime_entity($msginfo,$fh,$tempdir,\@virusname); my($notification);
if ($msginfo->sender eq '') { do_log(4, "Not sending DSN to empty return path");
} elsif ($msginfo->sender_contact eq '') {
do_log(4, "Not sending DSN to believed-to-be-faked return path");
$msginfo->dsn_sent(2); } elsif ((@virusname || @banned_filename ||
$considered_spam_by_some_recips) &&
$msginfo->mime_entity->head->get("precedence")
=~ /bulk|list|junk/i ) {
do_log(4, "Not sending DSN in response to bulk mail");
$msginfo->dsn_sent(2); } else {
$notification = delivery_status_notification(
$conn, $msginfo, $warnsender_with_pass, \%builtins,
@virusname+@banned_filename ? \$notify_virus_sender_templ
: $considered_spam_by_some_recips ? \$notify_spam_sender_templ
: \$notify_sender_templ);
}
if (defined $notification) { mail_dispatch($notify_method,$conn,$notification,1);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($notification,0); if (!$n_dsn_needed) { $msginfo->dsn_sent(1); } else {
do_log(0, "UNABLE TO SEND DSN: $n_smtp_resp");
}
}
}
prolong_timer($which_section);
$which_section = "finishing";
my($strr) = expand(\$log_templ,\%builtins);
$$strr =~ s/[\s\n\r]+$(?!\n)//;
do_log(0, $$strr) if $$strr ne '';
}; if ($@ ne '') {
chomp($@);
$preserve_evidence = 1;
my($msg) = "$which_section FAILED: $@";
do_log(0, "TROUBLE in check_mail: $msg");
$smtp_resp = "451 4.5.0 Error in processing, id=$am_id, $msg";
$exit_code = EX_TEMPFAIL;
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done;
$r->recip_smtp_response($smtp_resp);
$r->recip_done(1);
}
}
if ($hold ne '') { $preserve_evidence = 1 };
if (!$preserve_evidence && debug_oneshot()) {
do_log(0, "DEBUG_ONESHOT CAUSES EVIDENCE TO BE PRESERVED");
$preserve_evidence = 1;
};
$MSGINFO = undef; ($smtp_resp,$exit_code,$preserve_evidence);
}
sub ensure_mime_entity($$$$) {
my($msginfo,$fh,$tempdir,$virusname_list) = @_;
if (!defined($msginfo->mime_entity)) {
$msginfo->mime_entity(mime_decode($fh,$tempdir));
prolong_timer("ensure_mime_entity");
}
if (@$virusname_list) {
my($sender_contact,$sender_source) = best_try_originator(
$msginfo->sender, $msginfo->mime_entity, $virusname_list);
$msginfo->sender_contact($sender_contact); $msginfo->sender_source($sender_source); }
}
sub add_forwarding_header_edits_common($$$$) {
my($conn, $msginfo, $hdr_edits, $hold,
$virus_presence_checked, $spam_presence_checked) = @_;
$hdr_edits->prepend_header('Received',
received_line($conn,$msginfo,am_id(),1),
1) if $insert_received_line && $forward_method ne '';
$hdr_edits->delete_header('X-Amavis-Hold');
if ($hold ne '') {
$hdr_edits->append_header('X-Amavis-Hold', $hold);
do_log(0, 'Placing on HOLD: '.$hold);
}
if ($extra_code_antivirus) {
if ($X_HEADER_LINE && $X_HEADER_TAG =~ /^[!-9;-\176]+$(?!\n)/) {
if ($remove_existing_x_scanned_headers)
{ $hdr_edits->delete_header($X_HEADER_TAG) }
$hdr_edits->append_header(
$X_HEADER_TAG,$X_HEADER_LINE) if $virus_presence_checked;
}
$hdr_edits->delete_header('X-Amavis-Alert');
$hdr_edits->append_header('X-Amavis-Alert',
"INFECTED, message contains virus:\n " .
join(",\n ",@virusname), 1) if @virusname;
if (@banned_filename) {
my(@b) = @banned_filename > 3 ? @banned_filename[0..2]
: @banned_filename;
my($msg) = "BANNED FILENAME, message contains " .
(@banned_filename == 1 ? 'part' : 'parts') . " named:\n ".
join(",\n ",@b) . (@banned_filename > @b ? ", ..." : "");
$hdr_edits->append_header('X-Amavis-Alert', $msg, 1);
}
$hdr_edits->append_header('X-Amavis-Alert',
"BAD HEADER ".$bad_headers[0], 1) if @bad_headers;
}
if ($extra_code_antispam) {
if ($remove_existing_spam_headers) {
$hdr_edits->delete_header('X-Spam-Status');
$hdr_edits->delete_header('X-Spam-Level');
$hdr_edits->delete_header('X-Spam-Flag');
$hdr_edits->delete_header('X-Spam-Report');
$hdr_edits->delete_header('X-Spam-Checker-Version');
}
}
$hdr_edits;
}
sub add_forwarding_header_edits_per_recip($$$$$) {
my($conn, $msginfo, $hdr_edits, $hold, $filter) = @_;
my(@recip_cluster);
my(@per_recip_data) = grep {!$_->recip_done && (!$filter || &$filter($_))}
@{$msginfo->per_recip_data};
my($per_recip_data_len) = scalar(@per_recip_data);
if (!$extra_code_antispam)
{ @recip_cluster = @per_recip_data; @per_recip_data = () }
my($first) = 1; my($cluster_key); my($cluster_full_spam_status);
for my $r (@per_recip_data) {
my($recip) = $r->recip_addr;
my($blacklisted) = $r->recip_blacklisted_sender;
my($whitelisted) = $r->recip_whitelisted_sender;
my($is_local) =
lookup($recip, $local_domains_sql,
$local_domains_ldap, \%local_domains,
\@local_domains_acl, $local_domains_re);
my($tag_level) =
lookup($recip, $spam_tag_level_sql, $spam_tag_level_ldap,
$sa_tag_level_deflt);
my($tag2_level) = lookup($recip, $spam_tag2_level_sql, $spam_kill_level_sql,
$spam_tag2_level_ldap, $spam_kill_level_ldap,
$sa_tag2_level_deflt, $sa_kill_level_deflt);
my($do_tag) = $is_local && ($blacklisted || $spam_level>=$tag_level);
my($do_tag2) = $is_local && ($blacklisted || $spam_level>=$tag2_level);
my($do_subj) = $do_tag2 && $sa_spam_subject_tag ne '' &&
lookup($recip, $spam_modifies_subj_sql,
$spam_modifies_subj_ldap,$sa_spam_modifies_subj);
for ($do_tag,$do_tag2,$do_subj) { $_ = $_ ? 1 : 0 } my($spam_level_bar, $full_spam_status);
if ($do_tag || $do_tag2) {
$spam_level_bar = '*' x min($blacklisted?64:$spam_level+0, 64);
$full_spam_status = sprintf(
"%s,\n hits=%3.1f\n tagged_above=%3.1f\n required=%3.1f\n %s%s",
( ($blacklisted || $spam_level>=$tag2_level) ? 'Yes' : 'No'),
$spam_level, $tag_level, $tag2_level,
join('', $blacklisted ? "BLACKLISTED\n " : (),
$whitelisted ? "WHITELISTED\n " : () ), $spam_status);
}
my($key) = join("\000", $do_tag, $do_tag2, $do_subj,
$spam_level_bar, $full_spam_status);
if ($first) {
do_log(5, sprintf("headers CLUSTERING: NEW CLUSTER <%s>: ".
"hits=%3.1f, tag=%d, tag2=%d, subj=%d, local=%d, bl=%d",
$recip, $spam_level,$do_tag,$do_tag2,$do_subj,$is_local,$blacklisted) );
$cluster_key = $key; $cluster_full_spam_status = $full_spam_status;
} elsif ($key eq $cluster_key) {
do_log(5, "headers CLUSTERING: <$recip> joining cluster");
} else {
do_log(5, "headers CLUSTERING: skipping <$recip> (tag=$do_tag, tag2=$do_tag2)" );
next;
}
if ($first && $do_tag) {
$hdr_edits->append_header('X-Spam-Status',$full_spam_status,1);
$hdr_edits->append_header('X-Spam-Level',$spam_level_bar);
}
if ($first && $do_subj) {
my($entity) = $msginfo->mime_entity;
if (defined $entity && $entity->head->get('Subject')) { $hdr_edits->edit_header('Subject',
sub { $_[1]=~/^([ \t]?)(.*)$(?!\n)/s;
' '.$sa_spam_subject_tag.$2 });
} else { my($s) = $sa_spam_subject_tag; $s =~ s/[ \t]+$(?!\n)//; # trim
$hdr_edits->append_header('Subject', $s);
}
}
if ($first && $do_tag2) {
$hdr_edits->append_header('X-Spam-Flag', 'YES');
}
push(@recip_cluster, $r); $first = 0;
}
my($done_all);
if (@recip_cluster == $per_recip_data_len) {
do_log(3, "headers CLUSTERING: ".
"done all $per_recip_data_len recips in one go");
$done_all = 1;
} else {
do_log(3, sprintf("headers CLUSTERING: got %d recips out of %d: %s",
scalar(@recip_cluster), $per_recip_data_len,
join(", ", map {"<".$_->recip_addr.">"} @recip_cluster) ));
}
if (defined($cluster_full_spam_status) && @recip_cluster) {
my($s) = $cluster_full_spam_status; $s =~ s/\n / /g;
do_log(2, sprintf("SPAM-TAG, <%s> -> %s, %s", $msginfo->sender_source,
join(", ", map {"<".$_->recip_addr.">"} @recip_cluster), $s));
}
($hdr_edits, \@recip_cluster, $done_all);
}
sub do_quarantine($$$$$) {
my($conn,$msginfo,$hdr_edits,$recips_ref,$quarantine_method) = @_;
$hdr_edits->prepend_header('X-Envelope-To', join(",\n ",qquote_rfc2821_local(@{$msginfo->recips})), 1);
my($quar_msg) = Amavis::In::Message->new;
$quar_msg->sender($mailfrom_to_quarantine ne '' ?
$mailfrom_to_quarantine : $msginfo->sender);
do_log(5, "DO_QUARANTINE, sender: ".$quar_msg->sender);
$quar_msg->recips($quarantine_method =~ /^bsmtp:/i
? $msginfo->recips : $recips_ref); $quar_msg->header_edits($hdr_edits);
$quar_msg->mail_text($msginfo->mail_text);
$quarantine_method =~ s/%b/$msginfo->body_digest/eg;
mail_dispatch($quarantine_method,$conn,$quar_msg,1);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($quar_msg,0); if ($n_smtp_resp !~ /^2/ || $n_dsn_needed) {
die "Can not quarantine: '$n_smtp_resp'";
}
my(@qa); for my $r (@{$quar_msg->per_recip_data}) {
my($addr) = $r->recip_final_addr;
push(@qa, $addr=~/\@/ ? $addr : $r->recip_mbxname);
}
$msginfo->quarantined_to(\@qa);
do_log(5, "DO_QUARANTINE done");
}
sub do_virus($$) {
my($conn,$msginfo) = @_;
my($taint) = substr($virus_quarantine_method,0,0);
$VIRUSFILE = $virus_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si
? $1.$taint : "virus-%i-%n";
$VIRUSFILE =~ s/%b/$msginfo->body_digest/eg;
$VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg;
$VIRUSFILE =~ s/%n/am_id()/eg;
my($hdr_edits) = Amavis::Out::EditHeader->new;
$hdr_edits->prepend_header('X-Quarantine-id', "<$VIRUSFILE>");
$hdr_edits->append_header('X-AMaViS-Alert',
"INFECTED, message contains virus:\n " .
join(",\n ",@virusname), 1) if @virusname;
if (@banned_filename) {
my(@b) = @banned_filename>3 ?@banned_filename[0..2] :@banned_filename;
my($msg) = "BANNED FILENAME, message contains " .
(@banned_filename == 1 ? 'part' : 'parts') . " named:\n ".
join(",\n ",@b) . (@banned_filename > @b ? ", ..." : "");
$hdr_edits->append_header('X-Amavis-Alert', $msg, 1);
}
my(@q_addr); do_log(5, "do_virus: looking for per-recipient quarantine")
if ref($virus_quarantine_to) ne '';
for my $r (@{$msginfo->per_recip_data}) {
my($a) = lookup($r->recip_addr, $virus_quarantine_to);
push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr;
}
do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr,
$virus_quarantine_method) if @q_addr;
do_log(5, "DO_VIRUS - NOTIFICATIONS, sender: ".$msginfo->sender);
$hdr_edits = Amavis::Out::EditHeader->new;
my($admin) = lookup($msginfo->sender, \%virus_admin,$virus_admin,$mailto);
if ($admin eq '') {
do_log(4, "Skip virus_admin notification for <".$msginfo->sender.
">, no admin specified");
} else { my($notification) = Amavis::In::Message->new;
$notification->sender($mailfrom_notify_admin);
$notification->recips([$admin]);
my(%mybuiltins) = %builtins; $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; $mybuiltins{'f'} = $hdrfrom_notify_admin;
$notification->mail_text(string_to_mime_entity(
expand(\$notify_virus_admin_templ,\%mybuiltins) ));
$notification->header_edits($hdr_edits);
mail_dispatch($notify_method,$conn,$notification,1);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($notification,0); if ($n_smtp_resp !~ /^2/ || $n_dsn_needed)
{ do_log(0, "FAILED to notify virus admin: $n_smtp_resp") }
}
if (! ($warnvirusrecip && @virusname ||
$warnbannedrecip && @banned_filename) ) {
} else {
my(@locals) = grep { $warn_offsite ||
lookup($_, $local_domains_sql,
$local_domains_ldap, \%local_domains,
\@local_domains_acl, $local_domains_re)
} @{$msginfo->recips};
if (@locals) {
my($notification) = Amavis::In::Message->new;
$notification->sender($mailfrom_notify_recip);
$notification->recips(\@locals);
my(%mybuiltins) = %builtins; $mybuiltins{'f'} = $hdrfrom_notify_admin;
$notification->mail_text(string_to_mime_entity(
expand(\$notify_virus_recips_templ,\%mybuiltins) ));
$notification->header_edits($hdr_edits);
mail_dispatch($notify_method,$conn,$notification,1);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($notification,0); if ($n_smtp_resp !~ /^2/ || $n_dsn_needed)
{ do_log(0, "FAILED to notify virus recipients: $n_smtp_resp")}
}
}
do_log(5, "DO_VIRUS - DONE");
}
sub do_spam($$) {
my($conn,$msginfo) = @_;
my($taint) = substr($spam_quarantine_method,0,0);
$VIRUSFILE = $spam_quarantine_method =~ /^(?:local|bsmtp):(.*)$(?!\n)/si
? $1.$taint : "spam-%b-%i-%n";
$VIRUSFILE =~ s/%b/$msginfo->body_digest/eg;
$VIRUSFILE =~ s/%i/strftime("%Y%m%d-%H%M%S",localtime)/eg;
$VIRUSFILE =~ s/%n/am_id()/eg;
my($tag_level) =
min(map {lookup($_, $spam_tag_level_sql, $spam_tag_level_ldap,
$sa_tag_level_deflt)} @{$msginfo->recips});
my($tag2_level) = min(map {lookup($_, $spam_tag2_level_sql, $spam_kill_level_sql,
$spam_tag2_level_ldap, $spam_kill_level_ldap,
$sa_tag2_level_deflt, $sa_kill_level_deflt)}
@{$msginfo->recips});
my($kill_level) =
min(map {lookup($_, $spam_kill_level_sql, $spam_kill_level_ldap,
$sa_kill_level_deflt)} @{$msginfo->recips});
my($full_spam_status) = sprintf(
"%s,\n hits=%3.1f\n tag1=%3.1f\n tag2=%3.1f\n kill=%3.1f\n %s",
($spam_level >= $tag2_level ? 'Yes' : 'No'),
$spam_level, $tag_level, $tag2_level, $kill_level, $spam_status);
my($s) = $full_spam_status; $s =~ s/\n / /g;
do_log(5, "do_spam: looking for a quarantine address");
my(@q_addr); if ($spam_quarantine_bysender_to) { my($a) = lookup($msginfo->sender, $spam_quarantine_bysender_to);
push(@q_addr, $a) if $a ne '';
}
for my $r (@{$msginfo->per_recip_data}) { my($a) = lookup($r->recip_addr, $spam_quarantine_to_sql,
$spam_quarantine_to_ldap, $spam_quarantine_to);
push(@q_addr, $a) if $a ne '' && !grep {$_ eq $a} @q_addr;
}
if (@q_addr) { my($hdr_edits) = Amavis::Out::EditHeader->new;
$hdr_edits->prepend_header('X-Quarantine-id', "<$VIRUSFILE>");
$hdr_edits->append_header('X-Spam-Status', $full_spam_status, 1);
$hdr_edits->append_header('X-Spam-Level', '*' x min($spam_level+0,64));
do_quarantine($conn, $msginfo, $hdr_edits, \@q_addr,
$spam_quarantine_method);
}
do_log(1, sprintf("SPAM, <%s> -> %s, %s%s", $msginfo->sender_source,
join(',', map{"<$_>"} @{$msginfo->recips}), $s,
!@q_addr ? '' : sprintf(", quarantine %s (%s)",
$VIRUSFILE, join(',',@q_addr))));
my($admin) = lookup($msginfo->sender, \%spam_admin,$spam_admin,$mailto);
if ($admin eq '') {
do_log(4, "Skip spam_admin notification for <".$msginfo->sender.
">, no admin specified");
} else { do_log(5, "DO_SPAM - NOTIFICATIONS, sender: ".$msginfo->sender);
my($notification) = Amavis::In::Message->new;
$notification->sender($mailfrom_notify_spamadmin);
$notification->recips([$admin]);
my(%mybuiltins) = %builtins; $mybuiltins{'T'} = [ quote_rfc2821_local($admin) ]; $mybuiltins{'f'} = $hdrfrom_notify_spamadmin;
$notification->mail_text(string_to_mime_entity(
expand(\$notify_spam_admin_templ,\%mybuiltins) ));
my($hdr_edits) = Amavis::Out::EditHeader->new;
$notification->header_edits($hdr_edits);
mail_dispatch($notify_method,$conn,$notification,1);
my($n_smtp_resp, $n_exit_code, $n_dsn_needed) =
one_response_for_all($notification,0); if ($n_smtp_resp !~ /^2/ || $n_dsn_needed)
{ do_log(0, "FAILED to notify spam admin: $n_smtp_resp") }
}
do_log(5, "DO_SPAM DONE");
}
sub get_body_digest($$) {
my($fh,$msginfo) = @_;
$fh->seek(0,0) or die "Can't rewind mail file: $!";
local($_);
my($ctx) = Digest::MD5->new;
my(@orig_header); my($header_size) = 0; my($body_size) = 0;
while (<$fh>) { last if $_ eq $eol;
$header_size += length($_); push(@orig_header,$_); }
my($len);
while ( ($len=read($fh,$_,16384)) > 0 ) {
$ctx->add($_); $body_size += $len;
}
my($signature) = $ctx->hexdigest;
if ($signature =~ /^( [0-9a-fA-F]{32} (?: [0-9a-fA-F]{8} )? ) $(?!\n)/x) {
$signature = $1; }
$msginfo->orig_header(\@orig_header);
$msginfo->orig_header_size($header_size);
$msginfo->orig_body_size($body_size);
$msginfo->body_digest($signature);
section_time('body hash');
do_log(3, "body hash: $signature");
$signature;
}
sub find_program_path($$$) {
my($fv_list, $path_list_ref, $may_log) = @_;
$fv_list = [$fv_list] if !ref $fv_list;
my($found) = undef;
for my $fv (@$fv_list) {
my(@fv_cmd) = split(' ',$fv);
if (!@fv_cmd) { } elsif ($fv_cmd[0] =~ /^\//) { # absolute path
my($errn) = stat($fv_cmd[0]) ? 0 : 0+$!;
if ($errn == ENOENT) {}
elsif ($errn) { do_log(0, "find_program_path: ".
"$fv_cmd[0] inaccessible: $!") if $may_log }
elsif (-x _ && !-d _) { $found = join(' ',@fv_cmd) }
} elsif ($fv_cmd[0] =~ /\//) { # relative path
die "find_program_path: relative paths not implemented: @fv_cmd\n";
} else { for my $p (@$path_list_ref) {
my($errn) = stat("$p/$fv_cmd[0]") ? 0 : 0+$!;
if ($errn == ENOENT) {}
elsif ($errn) { do_log(0, "find_program_path: ".
"$p/$fv_cmd[0] inaccessible: $!") if $may_log }
elsif (-x _ && !-d _) {
$found = $p . '/' . join(' ',@fv_cmd);
last;
}
}
}
last if defined $found;
}
$found;
}
sub find_external_programs($) {
my($path_list_ref) = @_;
for my $f (qw($file $arc $gzip $bzip2 $lzop $lha $unarj
$uncompress $unfreeze $unrar $zoo $cpio)) {
my($g) = $f; $g =~ s/\$/Amavis::Conf::/;
my($fv_list) = eval('$'.$g);
my($found) = find_program_path($fv_list,$path_list_ref,1);
{ no strict 'refs'; $$g = $found } if (!defined $found) {
do_log(0, sprintf("No %-14s not using it", "$f,"));
} else {
do_log(0, sprintf("Found %-11s at %s%s", $f,
$daemon_chroot_dir ne '' ?"(chroot: $daemon_chroot_dir/) " :'',
$found));
}
}
my($tier) = 'primary'; for my $f (@av_scanners, "\000", @av_scanners_backup) {
if ($f eq "\000") {
$tier = 'secondary';
} elsif (!defined $f || !ref $f) { } elsif (ref($f->[1]) eq 'CODE') {
do_log(0, "Using internal av scanner code for ($tier) ".$f->[0]);
} else {
my($found) = $f->[1] = find_program_path($f->[1],$path_list_ref,1);
if (!defined $found) {
do_log(3, "No $tier av scanner: ".$f->[0]);
$f = undef; } else {
do_log(0, sprintf("Found $tier av scanner %-11s at %s%s",
$f->[0],
$daemon_chroot_dir ne '' ? "(chroot: $daemon_chroot_dir/) "
: '',
$found));
}
}
}
}
sub fetch_modules_extra() {
my(@modules);
push(@modules, 'DBI') if $extra_code_sql;
push(@modules, 'Net::LDAP') if $extra_code_ldap;
push(@modules, qw(Compress::Zlib Convert::TNEF Convert::UUlib
Archive::Zip Archive::Tar)) unless $bypass_decode_parts;
if ($extra_code_antispam) {
push(@modules, qw(Mail::SpamAssassin Mail::SpamAssassin::NoMailAudit));
push(@modules, qw(Mail::SpamAssassin::DBBasedAddrList)
) if $sa_auto_whitelist;
}
Amavis::Boot::fetch_modules('REQUIRED ADDITIONAL MODULES', 1, @modules);
if ($extra_code_antispam) { Amavis::Boot::fetch_modules('PRE-COMPILE OPTIONAL MODULES', 0, qw(
Mail::SpamAssassin::UnixLocker Mail::SpamAssassin::PerMsgLearner
Net::DNS::RR::SOA Net::DNS::RR::NS Net::DNS::RR::MX Net::DNS::RR::A
Net::DNS::RR::PTR Net::DNS::RR::CNAME Net::DNS::RR::TXT));
}
if ($extra_code_antivirus) {
my($savi_module_ok,$savi); my($first) = 1;
for (grep {ref($_) eq 'ARRAY' && $_->[0] eq 'Sophos SAVI'}
(@av_scanners, @av_scanners_backup)
) {
if ($first) {
$savi_module_ok = eval {require SAVI};
$savi = Amavis::AV::sophos_savi_init(@$_) if $savi_module_ok;
}
$_->[1] = undef if !$savi_module_ok;
$_->[2] = $savi if defined $savi;
$first = 0;
}
}
}
if ($unicode_aware) {
}
do{ local($/) = "__DATA__$eol"; map { chomp($_ = <Amavis::DATA>) }
($extra_code_sql, $extra_code_ldap,
$extra_code_in_amcl, $extra_code_in_smtp,
$extra_code_antivirus, $extra_code_antispam,
$log_templ,
$notify_sender_templ,
$notify_virus_sender_templ,
$notify_virus_admin_templ,
$notify_virus_recips_templ,
$notify_spam_sender_templ,
$notify_spam_admin_templ);
}; close(\*Amavis::DATA) or "Can't close *Amavis::DATA: $!";
map { s/^\r?\n// } ($log_templ, $notify_sender_templ,
$notify_virus_sender_templ, $notify_spam_sender_templ,
$notify_virus_admin_templ, $notify_spam_admin_templ,
$notify_virus_recips_templ, $notify_spam_recips_templ);
$log_templ = $1 if $log_templ =~ /^(.*?)[\r\n]+$(?!\n)/s;
umask(0027);
my($amavisd_path) = find_program_path($0, [split(/:/, $path, -1)], 0);
$amavisd_path = $1 if $amavisd_path=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)};
my($config_file) = '/etc/amavisd.conf'; if (@ARGV >= 2 && $ARGV[0] eq '-c') { shift @ARGV; $config_file = shift @ARGV;
$config_file = $1 if $config_file=~m{^([A-Za-z0-9/._=+-]+)$(?!\n)};}
Amavis::Conf::read_config($config_file);
my(@modules_basic) = keys %INC;
if (!@lookup_sql_dsn) { $extra_code_sql = undef }
else {
eval $extra_code_sql or die "Problem in the Lookup::SQL code: $@";
$extra_code_sql = 1; }
if (!$enable_ldap) { $extra_code_ldap = undef }
else {
eval $extra_code_ldap or die "Problem in the Lookup::LDAP code: $@";
$extra_code_ldap = 1; }
if ($unix_socketname eq '') { $extra_code_in_amcl = undef }
else {
eval $extra_code_in_amcl or die "Problem in the In::AMCL code: $@";
$extra_code_in_amcl = 1; }
if ($inet_socket_port eq '' || ref $inet_socket_port && !@$inet_socket_port) {
$extra_code_in_smtp = undef;
} else {
eval $extra_code_in_smtp or die "Problem in the In::SMTP code: $@";
$extra_code_in_smtp = 1; }
if (!@av_scanners && !@av_scanners_backup) {
$extra_code_antivirus = undef;
} elsif (!%bypass_virus_checks &&
@bypass_virus_checks_acl==1 && @bypass_virus_checks_acl[0] eq '.') {
$extra_code_antivirus = undef;
} else {
eval $extra_code_antivirus or die "Problem in the antivirus code: $@";
$extra_code_antivirus = 1; }
if (!%bypass_spam_checks &&
@bypass_spam_checks_acl==1 && @bypass_spam_checks_acl[0] eq '.') {
$extra_code_antispam = undef;
} else {
eval $extra_code_antispam or die "Problem in the antispam code: $@";
$extra_code_antispam = 1; }
my($cmd) = lc($ARGV[0]);
if ($cmd =~ /^(start|debug|debug-sa|foreground)?$/) {
$DEBUG=1 if $cmd eq 'debug';
$daemonize=0 if $cmd eq 'foreground';
$daemonize=0, $sa_debug=1 if $cmd eq 'debug-sa';
} elsif ($cmd !~ /^reload|stop$/) {
die "Unknown argument. Usage:\n $0 [ -c config-file ] ( [ start ] | stop | reload | debug | debug-sa | foreground )\n";
} else {
if ($pid_file eq '')
{ die "pid_file config parameter not defined, can't $cmd\n" }
my($errn) = stat($pid_file) ? 0 : 0+$!;
if ($errn == ENOENT)
{ die "No pid_file $pid_file, can't $cmd the process\n" }
elsif ($errn)
{ die "pid_file $pid_file inaccessible: $!, can't $cmd the process\n" }
my($amavisd_pid);
open(PID_FILE, "< $pid_file\0") or die "Can't read file $pid_file: $!\n";
while (<PID_FILE>) { chomp; $amavisd_pid = $1 if /^(\d+)$/ }
close(PID_FILE) or die "Can't close file $pid_file: $!";
defined($amavisd_pid) or die "Invalid PID in the $pid_file, can't $cmd\n";
my($sig) = $cmd eq 'reload' ? 'HUP' : 'TERM';
kill($sig,$amavisd_pid) or die "Can't $sig amavisd[$amavisd_pid]: $!\n";
exit 0;
}
$daemonize = 0 if $DEBUG;
$ENV{PATH} = $path if $path ne '';
$ENV{HOME} = $helpers_home if $helpers_home ne '';
$ENV{TERM} = 'dumb';
Amavis::Log::init("amavis", !$daemonize,
$DO_SYSLOG, $SYSLOG_LEVEL, $LOGFILE, $log_level);
fetch_modules_extra();
for my $m ('Amavis::Conf',
sort map { s/\.pm$//; s[/][::]g; $_ } grep { /\.pm$/ } keys %INC) {
next if !grep { $_ eq $m } qw( Amavis::Conf
Archive::Tar Archive::Zip Compress::Zlib Convert::TNEF Convert::UUlib
MIME::Entity MIME::Parser MIME::Tools Mail::Header Mail::Internet
Mail::SpamAssassin Net::DNS Net::Server SAVI Unix::Syslog );
do_log(0, sprintf("Module %-19s %s", $m, $m->VERSION || '?'));
}
if ($forward_method eq '' && $extra_code_in_smtp) {
do_log(1, "forward_method is null (probably milter setup), ".
"DISABLING SMTP-in AS A PRECAUTION");
$extra_code_in_smtp = undef;
}
do_log(1, "Found myself: $amavisd_path -c $config_file");
do_log(1, "Lookup::SQL code ".($extra_code_sql ?'':" NOT")." loaded");
do_log(1, "Lookup::LDAP code ".($extra_code_ldap ?'':" NOT")." loaded");
do_log(1, "AMCL-in protocol code ".($extra_code_in_amcl?'':" NOT")." loaded");
do_log(1, "SMTP-in protocol code ".($extra_code_in_smtp?'':" NOT")." loaded");
do_log(1, "ANTI-VIRUS code ".($extra_code_antivirus?'':" NOT")." loaded");
do_log(1, "ANTI-SPAM code ".($extra_code_antispam?'':" NOT")." loaded");
if (!$extra_code_antivirus) { @av_scanners = @av_scanners_backup = () }
%builtins = (
d => sub {rfc2822_timestamp()}, h => $myhostname, l => sub {lookup($MSGINFO->sender, $local_domains_sql,
$local_domains_ldap, \%local_domains,
\@local_domains_acl, $local_domains_re)
? 1 : undef}, s => sub {qquote_rfc2821_local($MSGINFO->sender)}, S => sub {$MSGINFO->sender_contact}, o => sub {$MSGINFO->sender_source}, R => sub {$MSGINFO->recips}, D => sub {my($y,$n)=delivery_short_report($MSGINFO); $y}, N => sub {my($y,$n)=delivery_short_report($MSGINFO); $n}, t => sub {first_received_from($MSGINFO->mime_entity)}, m => sub { local($_) = $MSGINFO->mime_entity; if (defined) { $_ = $_->head->get("Message-ID"); chomp; $_ } },
j => sub { local($_) = $MSGINFO->mime_entity; if (defined) { $_ = $_->head->get("Subject"); chomp; $_ } },
b => sub {$MSGINFO->body_digest}, n => \&am_id, i => sub {$VIRUSFILE}, q => sub {$MSGINFO->quarantined_to}, v => sub {[split(/[ \t]*\r?\n/,$av_output)]}, V => sub {\@virusname}, F => sub {\@banned_filename}, X => sub {\@bad_headers}, W => sub {\@detecting_scanners}, H => sub {[map {my $h=$_; chomp($h); $h} @{$MSGINFO->orig_header}]}, A => sub {[split(/\r?\n/, $spam_report)]}, c => sub {!defined $spam_level?'-':$spam_level}, );
%local_delivery_aliases = (
'virus-quarantine' => sub { ($QUARANTINEDIR, $VIRUSFILE) },
'spam-quarantine' => sub { ($QUARANTINEDIR, "$VIRUSFILE.gz") }, 'user-quarantine' => sub { my($s) = $MSGINFO->sender;
$s =~ s/[^a-zA-Z0-9._=@]/-/; $s =~ s/\@/=/;
( $QUARANTINEDIR,
sprintf("user-%s-%s-%05d.gz", $s, strftime("%Y%m%d-%H%M%S",localtime), $$) )
},
'ham-quarantine' => sub { ("$QUARANTINEDIR/ham.mbox", undef) },
'outgoing-quarantine' => sub { ("$QUARANTINEDIR/outgoing.mbox", undef) },
'incoming-quarantine' => sub { ("$QUARANTINEDIR/incoming.mbox", undef) },
);
my $server = bless {
server => {
commandline => [$amavisd_path, '-c', $config_file],
port => [ ($unix_socketname eq '' ? () :
"$unix_socketname|unix"), map { "$_/tcp" } (ref $inet_socket_port ? @$inet_socket_port :
$inet_socket_port ne '' ? $inet_socket_port : () ),
],
host => ($inet_socket_bind eq '' ? '*' : $inet_socket_bind),
max_servers => $max_servers, max_requests => $max_requests,
user => $daemon_user,
group => $daemon_group,
pid_file => $pid_file,
lock_file => $lock_file, background => $daemonize ? 1 : undef,
setsid => $daemonize ? 1 : undef,
chroot => $daemon_chroot_dir ne '' ? $daemon_chroot_dir : undef,
no_close_by_child => 1,
log_level => ($DEBUG ? 4 : 2),
log_file => undef, },
}, 'Amavis';
$0 = 'amavisd (master)';
$server->run;
exit 1;
__DATA__
package Amavis::Lookup::SQLfield;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
@ISA = qw(Exporter);
}
BEGIN { import Amavis::Util qw(do_log) }
sub new($$$;$$) {
my($class, $sql_query,$fieldname, $fieldtype,$implied_args) = @_;
return undef if !defined($sql_query);
my($self) = bless {}, $class;
$self->{sql_query} = $sql_query;
$self->{fieldname} = lc($fieldname);
$self->{fieldtype} = uc($fieldtype);
$self->{args} = ref($implied_args) eq 'ARRAY' ? [@$implied_args] : [$implied_args] if defined $implied_args;
$self;
}
sub lookup_sql_field($$) {
my($self,$addr) = @_;
my($match);
if (!defined($self)) {
do_log(5, "lookup_sql_field - undefined, \"$addr\" no match");
} else {
my($field) = $self->{fieldname};
if (!defined($self->{sql_query})) {
do_log(5, "lookup_sql_field($field) - null query, \"$addr\" no match");
} else {
my($h_ref) = !exists($self->{args}) ?
$self->{sql_query}->lookup_sql($addr)
: $self->{sql_query}->lookup_sql($addr,$self->{args});
if (!defined($h_ref)) {
do_log(5, "lookup_sql_field($field), \"$addr\" no match");
} elsif (!exists($h_ref->{$field})) {
if ($self->{fieldtype} eq 'B0') { $match = 0; do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=$match");
} elsif ($self->{fieldtype} eq 'B1') { $match = 1; do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=$match");
} elsif ($self->{fieldtype}=~/^.-$/) { do_log(5, "lookup_sql_field($field), no field, \"$addr\" result=undef");
} else { do_log(1, "lookup_sql_field($field) ".
"(WARNING: no such field in the SQL table), ".
"\"$addr\" matches, result=undef");
}
} else {
$match = $h_ref->{$field}; my($found) = defined $match;
if (!defined($match)) { } elsif ($self->{fieldtype} =~ /^B/) { $match = 0 if $match =~ /^[NnFf0 \000][ ]*$(?!\n)/;
} elsif ($self->{fieldtype} =~ /^N/) { $match = $match + 0; } elsif ($self->{fieldtype} =~ /^S/) { $match =~ s/ +$(?!\n)//; # trim trailing spaces
}
do_log(5, "lookup_sql_field($field) \"$addr\"" .
(!$found ? ", no match" : " matches, result=$match") );
}
}
}
$match;
}
1;
package Amavis::Lookup::SQL;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&connect_to_sql);
}
use subs @EXPORT_OK;
use DBI;
BEGIN {
import Amavis::Util qw(do_log);
import Amavis::Conf qw(:platform :confvars);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(split_address split_localpart);
}
sub connect_to_sql(@) {
my(@dsns) = @_; my($dbh);
for my $tmpdsn (@dsns) {
my($dsn, $username, $password) = @$tmpdsn;
do_log(5, "connect_to_sql: trying '$dsn'");
$dbh = DBI->connect($dsn, $username, $password,
{PrintError => 0, RaiseError => 0, Taint => 1} );
if ($dbh) { do_log(5,"connect_to_sql: '$dsn' succeeded"); last }
do_log(0, "connect_to_sql: unable to connect to DSN '$dsn': " .
$DBI::errstr);
}
do_log(0, "connect_to_sql: unable to connect to any DSN at all!"
) if !$dbh && @dsns>1;
$dbh;
}
sub new($$$$$$) {
my($class, $dbh, $select_clause) = @_;
my($self) = bless {}, $class;
$self->{dbh} = $dbh; for my $n (1..6) { my($sel) = $select_clause; $sel =~ s/%k/join(',',('?')x$n)/ge;
do_log(5,"SQL prepare: ".$sel);
$self->{"sth$n"} = $dbh->prepare($sel);
}
$self;
}
sub clear_cache {
my($self) = @_;
delete $self->{cache};
}
sub lookup_sql($$;$) {
my($self,$addr,$extra_args) = @_;
if (exists $self->{cache} && exists $self->{cache}->{$addr}) { my($match) = $self->{cache}->{$addr};
if (!defined($match)) {
do_log(5, "lookup_sql (cached): \"$addr\" no match");
} else {
do_log(5, "lookup_sql (cached): \"$addr\" matches, result=(".
join(", ", map {$_.'=>"'.$match->{$_}.'"'} sort keys(%$match))
.")" );
}
return $match;
}
my($taint) = substr($addr,0,0);
my($localpart,$domain) = split_address($addr);
$domain = lc($domain);
$localpart = lc($localpart) if !$localpart_is_case_sensitive;
$domain = $1.$taint if $domain =~ /^\@?(.*?)\.*$(?!\n)/s;
my(@keys); my($extension);
if ($recipient_delimiter ne '') {
($localpart, $extension) =
split_localpart($localpart, $recipient_delimiter);
}
push(@keys, $localpart.$recipient_delimiter.$extension.'@'.$domain)
if $extension ne ''; push(@keys, $localpart.'@'.$domain); if (Amavis::Lookup::lookup($addr, \%local_domains,
\@local_domains_acl,$local_domains_re)) {
push(@keys, $localpart.$recipient_delimiter.$extension)
if $extension ne ''; push(@keys, $localpart); }
push(@keys, '@'.$domain); push(@keys, '@.'); my($n) = sprintf("%d",scalar(@keys));
my($sth) = $self->{"sth$n"};
unshift(@keys,@$extra_args) if ref $extra_args; for (@keys) { $_=$1 if /^(.*)$(?!\n)/s } do_log(5, "lookup_sql \"$addr\", query keys: " .
join(', ', map{"\"$_\""}@keys) );
$sth->execute(@keys); my($a_ref,$found,$match); $match = {};
while ( defined($a_ref=$sth->fetchrow_arrayref) ) { my(@names) = @{$sth->{NAME_lc}};
$found = 1; $match = {}; @$match{@names} = @$a_ref;
do_log(5, "lookup_sql: \"$addr\" matches, result=(".
join(", ", map {$_.'=>"'.$match->{$_}.'"'} @names) .")" );
last if $found; }
$sth->finish();
if (!$found) {
$match = undef;
do_log(5, "lookup_sql, \"$addr\" no match");
}
$self->{cache}->{$addr} = $match;
section_time('lookup_sql');
$match;
}
1;
__DATA__
package Amavis::Lookup::LDAP;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
$ldap_sys_default %ldap_cache);
@ISA = qw(Exporter);
$VERSION = '1.15';
import Amavis::Util qw(do_log);
import Amavis::Conf qw(:platform :confvars);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(split_address split_localpart);
$ldap_sys_default = {
hostname => 'localhost', port => 389, timeout => 120, tls => 0,
base => undef, scope => 'sub',
query_filter => '(&(objectClass=amavisAccount)(mail=%m))',
res_attr => undef, res_filter => '%r',
bind_dn => undef, bind_password => undef
};
%ldap_cache = ();
}
sub trim {
my $str = shift;
$str =~ s/\s+$(?!\n)//; $str =~ s/^\s+//;
$str;
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($default, $query) = @_;
my ($self) = bless {}, $class;
my $llog = sub {
my $level = shift;
my $template = shift;
my $prefix = __PACKAGE__."::new (res_attr->".$query->{res_attr}.")";
do_log($level, sprintf("$prefix - $template", @_));
};
foreach (qw(hostname port timeout tls base scope query_filter
res_attr res_filter bind_dn bind_password)) {
$query->{$_} = $default->{$_} unless (defined $query->{$_});
$query->{$_} = $ldap_sys_default->{$_} unless (defined $query->{$_});
}
my $ldap;
my $hostList = (ref $query->{hostname} eq 'ARRAY') ?
join ", ", @{$query->{hostname}} : $query->{hostname};
my $cache_key = join "\036", ($hostList, $query->{port},
$query->{timeout}, $query->{tls},
$query->{bind_dn}, $query->{bind_password});
if (exists $ldap_cache{$cache_key}) {
$llog->(5, "Fetching ldap connection from cache");
$ldap = $ldap_cache{$cache_key};
} else {
$llog->(5, "trying to connect to '%s'", $hostList);
$ldap = Net::LDAP->new($query->{hostname}, port=>$query->{port},
timeout=>$query->{timeout}, onerror=>'undef');
if ($ldap) {
$llog->(5, "connection to '%s' succeeded", $hostList);
} else {
$llog->(0, "unable to connect to host '%s'. LDAP lookups disabled.",
$hostList);
return undef;
}
if ($query->{tls}) { my $tlsVer = $ldap->start_tls(verify=>'none');
$llog->(5, "TLS version %s enabled", $tlsVer);
}
if ($query->{bind_dn}) { if ($ldap->bind ($query->{bind_dn}, password => $query->{bind_password})) {
$llog->(5, "bind '%s' succeeded", $query->{bind_dn});
} else {
$llog->(1, "unable to bind '%s'",$query->{bind_dn});
return undef;
}
}
$ldap_cache{$cache_key} = $ldap;
}
$self->{ldap} = $ldap;
foreach (qw(base scope query_filter res_attr res_filter)) {
$self->{$_} = $query->{$_};
}
if ($query->{res_attr} eq "dn") {
$self->{type} = "S" } else {
my $schema = $ldap->schema(); if ($schema) {
my $sa = $schema->attribute($query->{res_attr});
if ($sa and $sa->{equality} eq 'booleanMatch' and $sa->{'single-value'}) {
$self->{type} = "B" } elsif ($sa and $sa->{equality} eq 'integerMatch' and
$sa->{'single-value'}) {
$self->{type} = "N" } elsif ($sa and not $sa->{'single-value'}) {
$self->{type} = "L" } elsif ($sa) {
$self->{type} = "S" } else {
$llog->(1, "attribute not defined in schema");
$self->{type} = "S" }
} else {
$llog->(1, "unable to read LDAP schema");
$self->{type} = "S" }
}
$llog->(5, "type='%s'",$self->{type});
return $self;
}
sub lookup_ldap_exact {
my $self = shift;
my ($addr) = @_;
my $llog = sub {
my $level = shift;
my $template = shift;
my $prefix = __PACKAGE__."::lookup_ldap_exact ($addr)";
do_log($level, sprintf("$prefix - $template", @_));
};
unless (defined $self) {
$llog->(5, "object undefined, no match");
return undef;
}
unless (defined $self->{ldap}) {
$llog->(5, "null ldap object, no match");
return undef;
}
my $filter = $self->{query_filter};
$filter =~ s/%m/$addr/g;
my $attribute = $self->{res_attr};
$llog->(5, "searching attribute=%s, filter=%s, base=\"%s\", scope=\"%s\"",
$self->{res_attr}, $filter, $self->{base}, $self->{scope});
my $res = $self->{ldap}->search (
base => $self->{base}, scope => $self->{scope}, filter => $filter
);
unless (defined $res) {
$llog->(5, "result undefined, no match");
return undef;
}
$llog->(5, "result:%s", $res->code);
if (my $entry = $res->pop_entry) {
if ($self->{res_attr} eq "dn") {
my $x = trim($entry->dn);
my $f = $self->{res_filter}; $f =~ s/%r/$x/g;
$llog->(5, "dn match: %s (%s)", $x, $f);
return $f;
} elsif ($entry->exists($self->{res_attr})) {
if ($self->{type} eq "B") {
my $x = (uc($entry->get_value($self->{res_attr})) eq "TRUE") ? 1 : 0;
my $f = $self->{res_filter}; $f =~ s/%r/$x/g;
$llog->(5, "boolean match: %s (%s)", $x, $f);
return $f;
} elsif ($self->{type} eq "N") {
my $x = 0 + scalar $entry->get_value($self->{res_attr});
my $f = $self->{res_filter}; $f =~ s/%r/$x/g;
$llog->(5, "numeric match: %s (%s)", $x, $f);
return $f;
} elsif ($self->{type} eq "S") {
my $x = trim(scalar $entry->get_value($self->{res_attr}));
my $f = $self->{res_filter}; $f =~ s/%r/$x/g;
$llog->(5, "string match: %s (%s)", $x, $f);
return $f;
} else {
my @x = map { trim($_) } $entry->get_value($self->{res_attr});
my @f = map { my $f = $self->{res_filter}; $f =~ s/%r/$_/g; $f } @x;
$llog->(5, "list match: %s (%s)", join (", ", @x), join (", ", @f));
return wantarray ? @f : \@f;
}
} else {
$llog->(5, "attribute does not exists, no match");
}
} else {
$llog->(5, "address not found, no match");
}
return undef
}
sub lookup_ldap {
my $self = shift;
my ($addr) = @_;
my $llog = sub {
my $level = shift;
my $template = shift;
my $prefix = __PACKAGE__."::lookup_ldap ($addr)";
do_log($level, sprintf("$prefix - $template", @_));
};
my $log_prefix = __PACKAGE__ . "::lookup_ldap($addr) -";
my ($taint) = substr($addr,0,0);
my ($localpart, $domain) = split_address($addr);
my $res;
$domain = lc($domain);
$localpart = lc($localpart) unless $localpart_is_case_sensitive;
if ($domain =~ /^\@?(.*?)\.*$(?!\n)/s) { $domain = $1.$taint }
my $extension;
if ($recipient_delimiter ne '') {
($localpart, $extension) =
split_localpart($localpart, $recipient_delimiter);
}
if ($extension ne '') { $res = $self->lookup_ldap_exact ($localpart.$recipient_delimiter.
$extension.'@'.$domain);
if (defined $res) { return $res }
}
$res = $self->lookup_ldap_exact($localpart.'@'.$domain); if (defined $res) { return $res }
if (Amavis::Lookup::lookup($addr, \%local_domains,
\@local_domains_acl, $local_domains_re)) {
if ($extension ne '') { $res = $self->lookup_ldap_exact($localpart.$recipient_delimiter.
$extension);
if (defined $res) { return $res }
}
$res = $self->lookup_ldap_exact ($localpart); if (defined $res) { return $res }
}
$res = $self->lookup_ldap_exact ('@'.$domain); if (defined $res) { return $res }
$res = $self->lookup_ldap_exact ('@.'); return $res
}
1;
__DATA__
package Amavis::In::AMCL;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
use subs @EXPORT;
use Errno qw(ENOENT);
use IO::File;
BEGIN {
import Amavis::Conf qw(:platform :confvars);
import Amavis::Util qw(do_log am_id debug_oneshot rmdir_recursively);
import Amavis::Lookup qw(lookup);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools;
import Amavis::In::Message;
import Amavis::In::Connection;
import Amavis::rfc2821_2822_Tools qw(/^EX_/);
}
sub new($) { my($class) = @_; bless {}, $class }
sub process_amavis_client_request($$$) {
my($self, $sock, $conn, $check_mail) = @_;
my($msginfo) = Amavis::In::Message->new;
my($fh,$tempdir);
my($protocol_succeeded) = 0; my($which_section) = "initialization";
eval {
my($inbuff);
my $yval = "\1";
$which_section = "RX_tempdir";
defined(recv($sock, $inbuff, 8192, 0)) or die "recv (1) failed: $!";
$inbuff =~ /^( (?: \Q$TEMPBASE\E | \Q$MYHOME\E )
\/ (?! .* \.{2,} .*) [A-Za-z0-9_.-]+ ) $(?!\n)/xso
or die "Invalid temporary directory '$inbuff'";
$tempdir = $1; am_id( ($tempdir =~ /amavis-(milter-)?(.+?)$(?!\n)/s ? $2 : undef) );
defined(send($sock, $yval, 0)) or die "send ack (1) failed: $!";
$which_section = "RX_sender";
defined(recv($sock, $inbuff, 8192, 0)) or die "recv (2) failed: $!";
defined(send($sock, $yval, 0)) or die "send ack (2) failed: $!";
$inbuff = unquote_rfc2821_local($inbuff) if $gets_addr_in_quoted_form;
$msginfo->sender($inbuff);
debug_oneshot(1) if lookup($msginfo->sender,\@debug_sender_acl);
$which_section = "RX_recipients";
my(@recips); my(@ldaargs);
my($outvar) = \@recips;
for (;;) {
defined(recv($sock,$inbuff,8192,0)) or die "recv (3) failed: $!";
last if ($inbuff eq "\3");
if ($inbuff eq "\2") {
$outvar = \@ldaargs;
$which_section = "RX_LDA";
} else {
$inbuff = unquote_rfc2821_local($inbuff)
if $gets_addr_in_quoted_form && $outvar==\@recips;
push(@$outvar, $inbuff);
}
defined(send($sock, $yval, 0)) or die "send ack (3) failed: $!";
}
$msginfo->recips(\@recips); $msginfo->rx_time(time);
$protocol_succeeded = 1;
$which_section = "opening_mail_file";
$fh = IO::File->new("$tempdir/email.txt", 'r')
or die "Can't open file $tempdir/email.txt: $!";
binmode($fh,":bytes")
or die "Can't cancel :utf8 mode: $!" if $unicode_aware;
$msginfo->mail_text($fh);
section_time('got data');
do_log(1, sprintf("AM.CL %s: <%s> -> %s", $tempdir, $msginfo->sender,
join(',', map{"<$_>"}@recips) ));
};
my($smtp_resp, $exit_code, $preserve_evidence);
if ($@ ne '') {
chomp($@);
do_log(0,"$which_section FAILED, retry: " . $@);
$fh->close if $fh;
$fh = undef; $msginfo->mail_text(undef);
$exit_code = EX_TEMPFAIL;
} else {
($smtp_resp, $exit_code, $preserve_evidence) =
&$check_mail($conn,$msginfo,0,$tempdir);
$fh->close or die "Can't close temp file: $!" if $fh;
$fh = undef; $msginfo->mail_text(undef);
my($errn) = $tempdir eq '' ? ENOENT : (stat($tempdir) ? 0 : 0+$!);
if ($tempdir eq '' || $errn == ENOENT) {
} elsif ($preserve_evidence) {
do_log(0, "tempdir is to be PRESERVED: $tempdir");
} else {
do_log(4, "tempdir being removed: $tempdir");
rmdir_recursively($tempdir);
}
if ($forward_method eq '' && $exit_code == EX_OK) { my($any_deletes);
for my $r (@{$msginfo->per_recip_data}) {
my($addr,$newaddr) = ($r->recip_addr, $r->recip_final_addr);
if ($r->recip_done) {
do_log(0, "WARN: recip addr <$addr> should be removed, but MTA can't do it");
$any_deletes++;
} elsif ($newaddr ne $addr) {
do_log(0, "WARN: recip addr <$addr> should be replaced with <$newaddr>, but MTA can't do it");
}
}
if ($any_deletes) {
do_log(0, "WARN: REJECT THE WHOLE MESSAGE, MTA-in can't do the recips deletion");
$exit_code = EX_UNAVAILABLE;
}
}
}
if ($mta_in_type eq 'qmail' && $exit_code == EX_TEMPFAIL) {
$exit_code = 81; }
do_log(3, "mail checking ended: exit_code=$exit_code ($smtp_resp)");
send($sock, $exit_code, 0) if $protocol_succeeded;
}
1;
__DATA__
package Amavis::In::SMTP;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
use POSIX qw(strftime);
use Errno qw(ENOENT);
use Time::HiRes qw(time);
BEGIN {
import Amavis::Conf qw(:platform :confvars);
import Amavis::Util qw(do_log am_id prolong_timer debug_oneshot
sanitize_str strip_tempdir rmdir_recursively);
import Amavis::Lookup qw(lookup);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools;
import Amavis::In::Message;
import Amavis::In::Connection;
}
sub new($) {
my($class) = @_;
my($self) = bless {}, $class;
$self->{proto} = undef; $self->{pipelining} = undef; $self->{smtp_outbuf} = undef; $self->{fh_pers} = undef; $self->{tempdir_persistent} = undef; $self->{preserve} = undef; $self->{tempdir_empty} = 1; $self->{session_closed_normally} = undef; $self;
}
sub preserve_evidence { my($self)=shift; !@_ ? $self->{preserve} : ($self->{preserve}=shift) }
sub DESTROY {
my($self) = shift;
$self->{fh_pers}->close
or die "Can't close temp file: $!" if $self->{fh_pers};
my($errn) = $self->{tempdir_pers} eq '' ? ENOENT
: (stat($self->{tempdir_pers}) ? 0 : 0+$!);
if (defined $self->{tempdir_pers} && $errn != ENOENT) {
if ($self->preserve_evidence && !$self->{tempdir_empty}) {
do_log(0, "tempdir is to be PRESERVED: ".$self->{tempdir_pers});
} else {
do_log(2, "tempdir being removed: ".$self->{tempdir_pers});
rmdir_recursively($self->{tempdir_pers});
}
}
if (! $self->{session_closed_normally}) {
$self->smtp_resp(1,"421 4.3.2 Service shutting down, closing channel");
}
}
sub prepare_tempdir($) {
my($self) = @_;
if (! defined $self->{tempdir_pers} ) {
my($now_iso8601) = strftime("%Y%m%dT%H%M%S", localtime);
$self->{tempdir_pers} = sprintf("%s/amavis-%s-%05d",
$TEMPBASE, $now_iso8601, $$);
}
my($errn) = stat($self->{tempdir_pers}) ? 0 : 0+$!;
if ($errn == ENOENT || ! -d _) {
mkdir($self->{tempdir_pers}, 0750)
or die "Can't create directory $self->{tempdir_pers}: $!";
$self->{tempdir_empty} = 1;
section_time('mkdir tempdir');
}
my($fname) = $self->{tempdir_pers} . "/email.txt";
my($errn) = stat($fname) ? 0 : 0+$!;
if ($self->{fh_pers} && !$errn && -f _) {
$self->{fh_pers}->seek(0,0) or die "Can't rewind mail file: $!";
$self->{fh_pers}->truncate(0) or die "Can't truncate mail file: $!";
} else {
$self->{fh_pers} = IO::File->new($fname, 'w+', 0640)
or die "Can't create file $fname: $!";
section_time('create email.txt');
}
}
sub process_smtp_request($$$$) {
my($self, $sock, $lmtp, $conn, $check_mail) = @_;
my($msginfo);
$self->{pipelining} = 0; $self->{smtp_outbuf} = [];
my($myheloname);
$myheloname = '[' . $conn->socket_ip . ']';
my($sender,@recips); my($got_rcpt);
$conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'SMTP');
$self->smtp_resp(1, "220 $myheloname " . ($lmtp ? 'LMTP' : 'ESMTP') .
" amavisd-new service ready");
my($terminating,$aborting,$eof,$voluntary_exit); my($seq) = 0;
while(<$sock>) {
prolong_timer('reading SMTP command');
{ my($cmd) = $_; my($taint) = substr($cmd,0,0); do_log(4, $self->{proto} . "< $cmd");
!/^ \s* ([A-Za-z]+) (?: \s+ (.*?) )? \s* \015\012 $(?!\n)/xs && do {
$self->smtp_resp(1,"500 5.5.2 Error: bad syntax", 1, $cmd); last;
};
$_ = uc($1).$taint; my($args) = $2.$taint;
/^RSET|DATA|QUIT$/ && $args ne '' && do {
$self->smtp_resp(1,"501 5.5.4 Error: $_ does not accept arguments", 1,$cmd);
last;
};
/^RSET$/ && do { $sender = undef; @recips = (); $got_rcpt = 0;
$msginfo = undef; $self->smtp_resp(0,"250 2.0.0 Ok $_"); last };
/^NOOP$/ && do { $self->smtp_resp(1,"250 2.0.0 Ok $_"); last };
/^QUIT$/ && do {
$self->smtp_resp(1,"221 2.0.0 $myheloname (amavisd) closing transmission channel");
$terminating=1; last;
};
/^HELO$/ && do {
$sender = undef; @recips = (); $got_rcpt = 0; $msginfo = undef; $self->{pipelining} = 0; $self->smtp_resp(0,"250 $myheloname");
$lmtp = 0; $conn->smtp_proto($self->{proto} = 'SMTP');
$conn->smtp_helo($args); section_time('SMTP HELO'); last;
};
(/^EHLO$/ || /^LHLO$/) && do {
$sender = undef; @recips = (); $got_rcpt = 0; $msginfo = undef; $lmtp = /^EHLO$/ ? 0 : 1;
$conn->smtp_proto($self->{proto} = $lmtp ? 'LMTP' : 'ESMTP');
$self->{pipelining} = 1;
$self->smtp_resp(0,"250 $myheloname\n" . join("\n",
qw(PIPELINING SIZE 8BITMIME ENHANCEDSTATUSCODES)));
$conn->smtp_helo($args); section_time("SMTP $_");
last;
};
/^VRFY$/ && do {
$self->smtp_resp(1,"502 5.5.1 Command $_ not implemented", 1, $cmd);
last;
};
/^HELP$/ && do {
$self->smtp_resp(1,"214 2.0.0 See amavisd-new home page at:\n".
"http://www.ijs.si/software/amavisd/");
last;
};
/^MAIL$/ && do { if (defined($sender)) {
$self->smtp_resp(0,"503 5.5.1 Error: nested MAIL command", 1, $cmd);
last;
}
if (!$seq) { section_time('SMTP pre-MAIL');
} else { Amavis::Timing::init();
}
$seq++;
am_id(sprintf("%05d-%02d%s", $$,
$Amavis::child_invocation_count, ($seq>1 ? "-$seq" : "")));
$self->prepare_tempdir;
$msginfo = Amavis::In::Message->new;
$msginfo->rx_time(time);
if ($args !~ /^FROM: \s*
( < (?: " (?: \\. | [^\\"] )* " | [^"@]* )
(?: @ (?: \[ (?: \\. | [^\]] )* \] |
[^\[\]\\>] )* )?
> |
[^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )*
) (?: \s+ ([^<>]+) )? $(?!\n)/isx ) {
$self->smtp_resp(0,"501 5.5.2 Syntax: MAIL FROM: <address>", 1, $cmd);
last;
}
my($addr,$opt) = ($1.$taint, $2.$taint); my($bad);
for (split(' ',$opt)) {
if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* ) =
( [\041-\074\076-\176]+ ) $(?!\n)/x) { $self->smtp_resp(0,"501 5.5.4 Syntax error in MAIL FROM parameters",
1, $cmd);
$bad = 1; last;
} else {
my($name,$val) = (uc($1).$taint, $2.$taint);
if ($name eq 'SIZE' && $val=~/^\d{1,20}$/) {
$msginfo->msg_size($val+0);
} elsif ($name eq 'BODY' && $val=~/^7BIT|8BITMIME$/i) {
$msginfo->body_type(uc($val));
} else {
$self->smtp_resp(0,"504 5.5.4 MAIL command parameter error: ".
"$name=$val", 1, $cmd);
$bad = 1; last;
}
}
}
if (!$bad) {
$addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr;
$self->smtp_resp(0,"250 2.1.0 Sender $addr OK");
$sender = unquote_rfc2821_local($addr);
debug_oneshot(lookup($sender,\@debug_sender_acl)?1:0,
$self->{proto} . "< $cmd");
};
last;
};
/^RCPT$/ && do {
if (!defined($sender)) {
$self->smtp_resp(0,"503 5.5.1 Need MAIL command before RCPT", 1, $cmd);
$sender = undef; @recips = (); $got_rcpt = 0;
last;
}
$got_rcpt++;
if ($args !~ /^TO: \s*
( < (?: " (?: \\. | [^\\"] )* " | [^"@]* )
(?: @ (?: \[ (?: \\. | [^\]] )* \] |
[^\[\]\\>] )* )?
> |
[^<\s] (?: " (?: \\. | [^\\"] )* " | [^"\s] )*
) (?: \s+ ([^<>]+) )? $(?!\n)/isx ) {
$self->smtp_resp(0,"501 5.5.2 Syntax: RCPT TO: <address>", 1, $cmd);
last;
}
if ($2 ne '') {
$self->smtp_resp(0,"504 5.5.4 RCPT command parameter not implemented: $2", 1, $cmd);
} elsif ($got_rcpt > $smtpd_recipient_limit) {
$self->smtp_resp(0,"452 4.5.3 Too many recipients");
} else {
my($addr,$opt) = ($1.$taint, $2.$taint);
$addr = ($addr =~ /^<(.*)>$/s) ? $1.$taint : $addr;
$self->smtp_resp(0,"250 2.1.5 Recipient $addr OK");
push(@recips, unquote_rfc2821_local($addr));
};
last;
};
/^DATA$/ && !@recips && do {
if (!defined($sender)) {
$self->smtp_resp(1,"503 5.5.1 Need MAIL command before DATA", 1, $cmd);
} elsif (!$got_rcpt) {
$self->smtp_resp(1,"503 5.5.1 Need RCPT command before DATA", 1, $cmd);
} elsif ($lmtp) { $self->smtp_resp(1,"503 5.1.1 Error (DATA): no valid recipients", 1, $cmd);
} else {
$self->smtp_resp(1,"554 5.1.1 Error (DATA): no valid recipients", 1, $cmd);
}
last;
};
/^DATA$/ && do {
prolong_timer('DATA received - timer reset', $child_timeout);
my($within_data_transfer,$complete);
eval {
$msginfo->sender($sender); $msginfo->recips(\@recips);
do_log(1, sprintf("%s:%s:%s %s: <%s> -> %s Received: %s",
$conn->smtp_proto,
$conn->socket_ip eq $inet_socket_bind ? ''
: '['.$conn->socket_ip.']',
$conn->socket_port, $self->{tempdir_pers},
$sender, join(',', map{"<$_>"}@recips),
join(' ',
($msginfo->msg_size eq '' ? ()
: 'SIZE='.$msginfo->msg_size),
($msginfo->body_type eq '' ? ()
: 'BODY='.$msginfo->body_type),
received_line($conn,$msginfo,am_id(),0) )
) );
$self->smtp_resp(1,"354 End data with <CR><LF>.<CR><LF>");
$within_data_transfer = 1;
section_time('SMTP pre-DATA-flush') if $self->{pipelining};
$self->{tempdir_empty} = 0;
do{ local($/) = "\015\012"; while(<$sock>) { if (/^\./) {
if ($_ eq ".\015\012") {
$complete = 1; $within_data_transfer = 0;
last;
}
s/^\.(.+\015\012)$(?!\n)/$1/s;
}
chomp; print {$self->{fh_pers}} $_,$eol
or die "Can't write to mail file: $!";
}
$eof = 1 if !$complete;
}; do_log(4, $self->{proto} . "< .\015\012") if $complete;
$self->{fh_pers}->flush or die "Can't flush mail file: $!";
$self->{fh_pers}->seek(0,1) or die "Can't seek on file: $!";
section_time('SMTP DATA');
};
if ($@ ne '' || !$complete) { chomp($@);
if (!$within_data_transfer) {
my($msg) = "Error in processing: " .
!$complete && $@ eq '' ? 'incomplete' : $@;
do_log(0, $self->{proto}." TROUBLE: 451 4.5.0 $msg");
$self->smtp_resp(1, "451 4.5.0 $msg");
} else {
$aborting = "client broke the connection ".
"during data transfer" if $eof;
$aborting .= ', ' if $aborting ne '' && $@ ne '';
$aborting .= $@;
$aborting = '???' if $aborting eq '';
do_log($@ ne '' ? 0 : 3,
$self->{proto}." TROUBLE, ABORTING: $aborting");
}
} else { $msginfo->mail_text($self->{fh_pers});
my($smtp_resp, $exit_code, $preserve_evidence) =
&$check_mail($conn,$msginfo,
$lmtp,$self->{tempdir_pers});
if ($preserve_evidence) { $self->preserve_evidence(1) }
if ($smtp_resp !~ /^4/ &&
grep { !$_->recip_done } @{$msginfo->per_recip_data}) {
die "TROUBLE/MISCONFIG: not all recipients done, ".
"\$forward_method is \"$forward_method\"";
}
if (!$lmtp) {
do_log(4, "sending SMTP response: \"$smtp_resp\"");
$self->smtp_resp(0, $smtp_resp);
} else {
my($bounced) = $msginfo->dsn_sent;
for my $r (@{$msginfo->per_recip_data}) {
my($resp) = $r->recip_smtp_response;
if ($bounced && $smtp_resp=~/^2/ && $resp!~/^2/) {
$resp = sprintf("250 2.5.0 Ok, DSN %s (%s)",
$bounced==1?'sent':'muted', $resp);
}
do_log(4, sprintf(
"sending LMTP response for <%s>: \"%s\"",
$r->recip_addr, $resp));
$self->smtp_resp(0, $resp);
}
}
};
if ($self->preserve_evidence && !$self->{tempdir_empty}) {
do_log(0,"PRESERVING EVIDENCE in ".$self->{tempdir_pers});
$self->{fh_pers}->close or die "Can't close mail file: $!";
$self->{fh_pers} = undef; $self->{tempdir_pers} = undef;
$self->{tempdir_empty} = 1;
}
if ($self->{fh_pers} && !$can_truncate) {
$self->{fh_pers}->close or die "Can't close mail file: $!";
$self->{fh_pers} = undef;
unlink($self->{tempdir_pers}."/email.txt")
or die "Can't delete file ".
$self->{tempdir_pers}."/email.txt: $!";
section_time('delete email.txt');
}
if (defined $self->{tempdir_pers}) { strip_tempdir($self->{tempdir_pers});
$self->{tempdir_empty} = 1;
}
$sender = undef; @recips = (); $got_rcpt = 0; $msginfo = undef;
$self->preserve_evidence(0); do_log(2, Amavis::Timing::report()); Amavis::Timing::init();
last;
}; $self->smtp_resp(1,"502 5.5.1 Error: command ($_) not implemented", 1, $cmd);
};
$voluntary_exit = 1;
last if $terminating || defined $aborting;
$self->smtp_resp_flush;
}
$eof = 1 if !$voluntary_exit;
$self->smtp_resp_flush; my($msg) =
defined $aborting && !$eof? "ABORTING the session: $aborting" :
defined $aborting ? $aborting :
!$terminating ? "client broke the connection without a QUIT" : '';
do_log(0, $self->{proto}.': NOTICE: '.$msg) if $msg ne '';
if (defined $aborting && !$eof)
{ $self->smtp_resp(1,"421 4.3.2 Service shutting down, ".$aborting) }
$self->{session_closed_normally} = 1;
}
sub smtp_resp($$$;$$) {
my($self, $flush,$resp, $penalize,$line) = @_;
if ($penalize) {
do_log(0, $self->{proto} . ": $resp; PENALIZE: $line");
sleep 5;
section_time('SMTP penalty wait');
}
my($taint) = substr($resp,0,0);
$resp = sanitize_str($resp,1);
if ($resp !~ /^ ([1-5]\d\d) (\ |-|$(?!\n))
([245] \. \d{1,3} \. \d{1,3} (?: \ |$(?!\n)) )?
(.*) $(?!\n)/xs)
{ die "Internal error(2): bad SMTP response code: '$resp'" }
my($resp_code,$continuation,$enhanced,$tail) = ($1,$2,$3, $4.$taint);
my($lead_len) = length($resp_code) + 1 + length($enhanced);
while (length($tail) > 512-2-$lead_len || $tail =~ /\n/) {
my($head) = substr($tail,0,512-2-$lead_len);
if ($head =~ /^([^\n]*\n)/) { $head = $1.$taint }
$tail = substr($tail,length($head)); chomp($head);
push(@{$self->{smtp_outbuf}}, $resp_code.'-'.$enhanced.$head);
}
push(@{$self->{smtp_outbuf}},$resp_code.$continuation.$enhanced.$tail);
$self->smtp_resp_flush if $flush || !$self->{pipelining} ||
@{$self->{smtp_outbuf}} > 200;
}
sub smtp_resp_flush($) {
my($self) = shift;
if (@{$self->{smtp_outbuf}}) {
for my $resp (@{$self->{smtp_outbuf}}) {
do_log(4, $self->{proto} . "> $resp");
};
print map($_."\015\012", @{$self->{smtp_outbuf}});
@{$self->{smtp_outbuf}} = ();
}
}
1;
__DATA__
package Amavis::AV;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&sophos_savi_init);
}
use Errno qw(EPIPE ENOTCONN ENOENT);
use Socket;
use IO::Socket;
use IO::Socket::UNIX;
use subs @EXPORT_OK;
use vars @EXPORT;
BEGIN {
import Amavis::Conf qw(:platform :confvars);
import Amavis::Util qw(do_log am_id retcode min max run_command);
import Amavis::Timing qw(section_time);
}
use vars qw(%st_socket_created %st_sock); use vars qw($savi);
sub sophos_savi_init {
my($av_name, $command) = @_;
my(@savi_bool_options) = qw(
FullSweep DynamicDecompression FullMacroSweep OLE2Handling
IgnoreTemplateBit VBA3Handling VBA5Handling OF95DecryptHandling
HelpHandling DecompressVBA5 Emulation PEHandling ExcelFormulaHandling
PowerPointMacroHandling PowerPointEmbeddedHandling ProjectHandling
ZipDecompression ArjDecompression RarDecompression UueDecompression
GZipDecompression TarDecompression CmzDecompression HqxDecompression
MbinDecompression !LoopBackEnabled
Lha SfxArchives MSCabinet TnefAttachmentHandling MSCompress
!DeleteAllMacros Vbe !ExecFileDisinfection VisioFileHandling
Mime ActiveMimeHandling !DelVBA5Project
ScrapObjectHandling SrpStreamHandling Office2001Handling
Upx PalmPilotHandling HqxDecompression
Pdf Rtf Html Elf WordB OutlookExpress
);
my($savi) = SAVI->new;
ref $savi or die "$av_name: Can't create a SAVI object, err=$savi";
my($version) = $savi->version;
ref $version or die "$av_name: Can't get SAVI version, err=$version";
do_log(2, sprintf("$av_name init: Version %s (engine %d.%d) recognizing %d viruses\n",
$version->string, $version->major, $version->minor, $version->count));
my($error) = $savi->set('MaxRecursionDepth', 16, 1);
!defined $error or die "$av_name: error setting MaxRecursionDepth: err=$error";
my($error) = $savi->set('NamespaceSupport', 3); !defined $error or do_log(0,"$av_name: error setting NamespaceSupport: err=$error");
for (@savi_bool_options) {
my($value) = /^!/ ? 0 : 1; s/^!+//;
$error = $savi->set($_, $value);
!defined $error or die "$av_name: Error setting $_: err=$error";
}
section_time('sophos_savi_init');
$savi;
}
sub sophos_savi {
my($tempdir, $av_name, $command, $savi_of_parent) = @_;
if (defined $savi_of_parent) { $savi = $savi_of_parent }
else { $savi = sophos_savi_init($av_name,$command) if !defined $savi }
my($scan_status,@virusname); my($output) = '';
local(*DIR); my($f); my($cnt) = 0;
opendir(DIR, "$tempdir/parts")
or die "Can't open directory $tempdir/parts: $!";
while (defined($f = readdir(DIR))) {
my($fname) = "$tempdir/parts/$f";
my($errn) = stat($fname) ? 0 : 0+$!;
next if $errn == ENOENT;
if ($errn) { die "sophos_savi: $fname inaccessible: $!" }
if (!-r _) { die "sophos_savi: $fname not readable" }
next if -d _ && ($f eq '.' || $f eq '..'); next if -z _; $cnt++; do_log(5, "$av_name: checking $fname");
my($result) = $savi->scan($fname);
if (!ref($result)) { my($msg) = "$av_name: error scanning file $fname, " .
$savi->error_string($result) . " ($result) $!";
if (! grep {$result == $_} (514,527,530,538,549) ) {
die $msg;
} else { do_log(0,$msg);
$scan_status = 0 if !$scan_status; }
} elsif ($result->infected) {
$scan_status = 1; my($msg) = "INFECTED $fname: " . join(", ",$result->viruses);
$output .= $msg.$eol; do_log(2,"$av_name result: $msg");
push(@virusname, $result->viruses);
} else {
$scan_status = 0 if !$scan_status; }
}
closedir(DIR) or die "Can't close directory: $!";
if (!$cnt) { $scan_status = 0 } do_log(3,"$av_name result: clean") if !$scan_status;
($scan_status,$output,\@virusname);
}
sub ask_daemon_internal {
my( $query, $tempdir,
$av_name, $command, $args,
$sts_clean, $sts_infected, $how_to_get_names, ) = @_;
my($query_template,$sockets) = @$args;
my($scan_status,$output,@virusname); my($socketname,$is_inet);
if (!ref($sockets)) { $sockets = [ $sockets ] }
my($max_retries) = 3 * @$sockets; my($retries) = 0;
$SIG{PIPE} = 'IGNORE'; for (;;) { @$sockets >= 1 or die "no sockets specified!?"; $socketname = $sockets->[0]; $is_inet = $socketname =~ m{^/} ? 0 : 1;
eval {
if (!$st_socket_created{$socketname}) {
do_log(3, "$av_name: Connecting to socket " .
join(' ',$daemon_chroot_dir,$socketname) .
(!$retries ? '' : ", retry #$retries") );
if ($is_inet) { $st_sock{$socketname} = IO::Socket::INET->new($socketname)
or die "Can't connect to INET socket $socketname: $!\n";
$st_socket_created{$socketname} = 1;
} else { $st_sock{$socketname} = IO::Socket::UNIX->new(
Type => SOCK_STREAM)
or die "Can't create UNIX socket: $!\n";
$st_socket_created{$socketname} = 1;
$st_sock{$socketname}->connect(
pack_sockaddr_un($socketname) )
or die "Can't connect to UNIX socket $socketname: $!\n";
}
}
do_log(3, sprintf("$av_name: Sending %s to %s socket $socketname",
$query, $is_inet ? "INET" : "UNIX"));
defined send($st_sock{$socketname}, $query, 0)
or die "Can't send to socket $socketname: $!\n";
if ($av_name =~ /^(Sophie|Trophie)/i) {
defined $st_sock{$socketname}->recv($output, 1024)
or die "Can't receive from socket $socketname: $!\n";
} else {
$output = join('', $st_sock{$socketname}->getlines);
$st_sock{$socketname}->close
or die "Can't close socket $socketname: $!\n";
$st_sock{$socketname}=undef; $st_socket_created{$socketname}=0;
}
$! = undef;
$output ne '' or die "Empty result from $socketname\n";
};
last if $@ eq '';
chomp($@); my($err) = "$!"; my($errn) = 0+$!;
++$retries <= $max_retries
or die "Too many retries to talk to $socketname ($@)";
if ($retries <= 1 && $errn == EPIPE) { do_log(2,"$av_name broken pipe (don't worry), retrying ($retries)");
} else {
do_log( ($retries>1?0:1), "$av_name: $@, retrying ($retries)");
if ($retries % @$sockets == 0) { my($dly) = min(20, 1 + 5 * ($retries/@$sockets - 1));
do_log(3,"$av_name: sleeping for $dly s");
sleep($dly); }
}
if ($st_socket_created{$socketname}) {
$st_sock{$socketname}->close;
$st_sock{$socketname} = undef; $st_socket_created{$socketname} = 0;
}
push(@$sockets, shift @$sockets) if @$sockets>1; }
do_log(3,"$av_name result: $output");
if ($output =~ /$sts_infected/m) {
@virusname = ref($how_to_get_names) eq 'CODE'
? &$how_to_get_names($output)
: $output =~ /$how_to_get_names/gm;
$scan_status = 1; } elsif ($output =~ /$sts_clean/m) {
$scan_status = 0; } else {
do_log(0,"$av_name FAILED - unknown status: $output");
}
($scan_status,$output,\@virusname);
}
sub ask_daemon {
my($tempdir,$av_name,$command,$args) = @_;
ref $args eq 'ARRAY'
or die "The field#3 in the \@av_scanners entry is not an array ref";
my($query_template) = $args->[0];
$query_template =~ s[{}][$tempdir/parts]g; if ($query_template !~ /\*/) { return ask_daemon_internal($query_template, @_);
} else { my($scan_status,@virusname); my($output) = '';
local(*DIR); my($f); my($cnt) = 0;
opendir(DIR, "$tempdir/parts")
or die "Can't open directory $tempdir/parts: $!";
while (defined($f = readdir(DIR))) {
my($fname) = "$tempdir/parts/$f";
my($errn) = stat($fname) ? 0 : 0+$!;
next if $errn == ENOENT;
if ($errn) { die "ask_daemon: $fname inaccessible: $!" }
if (!-r _) { die "ask_daemon: $fname not readable" }
next if -d _ && ($f eq '.' || $f eq '..'); next if -z _; $cnt++; do_log(5, "$av_name: checking $fname");
my($query_template_exp) = $query_template;
$query_template_exp =~ s[\*][$f]g; my($t_scan_status,$t_output,$t_virusnames) =
ask_daemon_internal($query_template_exp, @_);
if ($t_scan_status) { $scan_status = $t_scan_status; do_log(3,"$av_name result: $t_output");
$output .= $t_output . $eol;
push(@virusname, @$t_virusnames);
} elsif (!defined $t_scan_status) {
last; } else {
$scan_status = 0 if !$scan_status; }
}
closedir(DIR) or die "$av_name: Can't close directory: $!";
if (!$cnt) { $scan_status = 0 } do_log(3,"$av_name result: clean") if !$scan_status;
($scan_status,$output,\@virusname);
}
}
sub run_av {
my( $tempdir, $av_name, $command, $args,
$sts_clean, $sts_infected, $how_to_get_names, $pre_code, $post_code, ) = @_;
my($scan_status,$virusnames); my($output) = '';
&$pre_code(@_) if defined $pre_code;
if (ref($command) eq 'CODE') {
do_log(3,"Using $av_name: (built-in interface)");
($scan_status,$output,$virusnames) = &$command(@_);
} else {
my(@args) = split(' ',$args);
if (grep { m{^({}/)?\*$(?!\n)} } @args) { local(*DIR); my($f); my(@bare_fnames);
opendir(DIR, "$tempdir/parts")
or die "Can't open directory $tempdir/parts: $!";
while (defined($f = readdir(DIR))) {
my($fname) = "$tempdir/parts/$f";
my($errn) = stat($fname) ? 0 : 0+$!;
next if $errn == ENOENT;
if ($errn) { die "run_av: $fname inaccessible: $!" }
if (!-r _) { die "run_av: $fname not readable" }
next if -d _ && ($f eq '.' || $f eq '..'); next if -z _; if ($f =~ /^([A-Za-z0-9_.-]+)$(?!\n)/s) { push(@bare_fnames,$1) }
else { do_log(0, "run_av: WARN: refused to untaint: $f") }
}
closedir(DIR) or die "$av_name: Can't close directory: $!";
for my $a (@args) {
$a =~ s[^({}/)?\*$(?!\n)][join(' ',map {$1.$_} @bare_fnames)]e;
}
}
for (@args) { s[{}][$tempdir/parts]g } do_log(3, "Using $av_name: " . join(' ',$command,@args));
my($proc_fh) = run_command(undef, "&1", $command, @args);
while( defined($_ = $proc_fh->getline) ) { $output .= $_ }
my($err); $proc_fh->close or $err=$!; my($retval) = retcode($?);
chomp($output); my($output_trimmed) = $output;
$output_trimmed =~ s/([ \t\n\r])[ \t\n\r]{4,}/$1.../gs;
$output_trimmed = "..." . substr($output_trimmed,-900)
if length($output_trimmed) > 900;
do_log(3, "run_av: $command status=$retval ($? $err),$output_trimmed");
if (ref($sts_infected) eq 'ARRAY' ? (grep {$_==$retval} @$sts_infected)
: $output =~ /$sts_infected/m) { $virusnames = []; @$virusnames = ref($how_to_get_names) eq 'CODE'
? &$how_to_get_names($output)
: $output =~ /$how_to_get_names/gm;
@$virusnames = map {defined $_ ? $_ : ()} @$virusnames;
$scan_status = 1; do_log(5,"run_av: INFECTED: ".join(", ",@$virusnames));
} elsif (ref($sts_clean) eq 'ARRAY' ? (grep {$_==$retval} @$sts_clean)
: $output =~ /$sts_clean/m) { $scan_status = 0; do_log(5,"run_av: clean");
} else {
do_log(0,"Virus scanner failure: $command (exit status: $retval)");
}
$output = $output_trimmed if length($output) > 900;
}
&$post_code(@_) if defined $post_code;
$virusnames = [] if !defined $virusnames;
@$virusnames = (undef) if $scan_status && !@$virusnames; ($scan_status, $output, $virusnames);
}
sub virus_scan($$) {
my($tempdir,$firsttime) = @_;
my($scan_status,$output,@virusname,@detecting_scanners);
my($anyone_done); my($anyone_tried);
my(@errors); my($j); my($tier) = 'primary';
for my $av (@av_scanners, "\000", @av_scanners_backup) {
if ($av eq "\000") { last if $anyone_done;
do_log(0,"WARN: all $tier virus scanners failed, trying backups");
$tier = 'secondary'; next;
}
next if !defined $av || !ref $av || !defined $av->[1];
$anyone_tried++;
my($this_status,$this_output,$this_vn);
eval { ($this_status,$this_output,$this_vn) = run_av($tempdir,@$av) };
if ($@ ne '') {
my($err) = $@; chomp($err);
$err = "$av->[0] av-scanner FAILED: $err";
do_log(0,$err); push(@errors,$err);
$this_status = undef;
};
$anyone_done++ if defined $this_status;
$scan_status = $this_status if !defined $scan_status || $this_status;
$output = $this_output if !defined $output;
$j++; section_time("AV-scan-$j");
if ($this_status) { push(@detecting_scanners, $av->[0]);
if (!@virusname) { @virusname = @$this_vn; $output = $this_output }
}
}
if (!$anyone_tried) { die "NO VIRUS SCANNERS AVAILABLE\n" }
elsif (!$anyone_done)
{ die ("ALL VIRUS SCANNERS FAILED: ".join("; ",@errors)."\n") }
($scan_status, $output, \@virusname, \@detecting_scanners); }
1;
__DATA__
package Amavis::SpamControl;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '1.15';
@ISA = qw(Exporter);
}
use FileHandle;
use Mail::SpamAssassin;
use Mail::SpamAssassin::NoMailAudit;
BEGIN {
import Amavis::Conf qw(:platform :sa $log_level
%whitelist_sender @whitelist_sender_acl $whitelist_sender_re
%blacklist_sender @blacklist_sender_acl $blacklist_sender_re
$per_recip_whitelist_sender_lookup_tables
$per_recip_blacklist_sender_lookup_tables);
import Amavis::Util qw(do_log prolong_timer);
import Amavis::rfc2821_2822_Tools;
import Amavis::Timing qw(section_time);
import Amavis::Lookup qw(lookup);
}
use subs @EXPORT_OK;
use vars qw($spamassasin_obj);
sub init() {
do_log(1, "SpamControl: initializing Mail::SpamAssassin");
my($saved_umask) = umask;
$spamassasin_obj = Mail::SpamAssassin->new({
debug => $sa_debug,
save_pattern_hits => $sa_debug,
dont_copy_prefs => 1,
local_tests_only => $sa_local_tests_only,
home_dir_for_helpers => $helpers_home,
stop_at_threshold => 0,
});
if ($sa_auto_whitelist) { do_log(1, "SpamControl: turning on SA auto-whitelisting (AWL)");
my($addrlstfactory) = Mail::SpamAssassin::DBBasedAddrList->new;
$spamassasin_obj->set_persistent_address_list_factory($addrlstfactory);
}
$spamassasin_obj->compile_now; alarm(0); umask($saved_umask); do_log(1, "SpamControl: done");
}
sub white_black_list($$$$) {
my($conn,$msginfo,$sql_wblist,$user_id_sql) = @_;
my($any_w)=0; my($any_b)=0; my($all)=1; my($wr,$br);
my($sender) = $msginfo->sender;
do_log(4, "white_black_list: checking sender <$sender>");
for my $r (@{$msginfo->per_recip_data}) {
next if $r->recip_done; my($wb,$user_id); my($recip) = $r->recip_addr;
if (defined($sql_wblist) &&
defined($user_id=lookup($recip,$user_id_sql)) )
{
$wb = lookup($sender, Amavis::Lookup::SQLfield->new(
$sql_wblist,'wb','S',$user_id) );
if (!defined($wb) || $wb =~ /^[ \000]*$(?!\n)/) { $wb = undef;
} elsif ($wb =~ /^[BbNnFf0][ ]*$(?!\n)/) { $wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1);
do_log(5,"white_black_list: (SQL) recip <$recip> blacklisted sender <$sender>");
} else { $wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1);
do_log(5,"white_black_list: (SQL) recip <$recip> whitelisted sender <$sender>");
}
}
if (!defined($wb)) {
if (lookup($sender,
lookup($recip,$per_recip_blacklist_sender_lookup_tables),
\%blacklist_sender, \@blacklist_sender_acl,
$blacklist_sender_re)) {
$wb=-1; $any_b++; $br=$recip; $r->recip_blacklisted_sender(1);
do_log(5,"white_black_list: recip <$recip> blacklisted sender <$sender>");
}
if (lookup($sender,
lookup($recip,$per_recip_whitelist_sender_lookup_tables),
\%whitelist_sender, \@whitelist_sender_acl,
$whitelist_sender_re)) {
$wb=+1; $any_w++; $wr=$recip; $r->recip_whitelisted_sender(1);
do_log(5,"white_black_list: recip <$recip> whitelisted sender <$sender>");
}
}
$all = 0 if !$wb;
}
my($msg) = '';
if ($all && $any_w && !$any_b) { $msg = "whitelisted" }
elsif ($all && $any_b && !$any_w) { $msg = "blacklisted" }
elsif ($all) { $msg = "black or whitelisted by all recips" }
elsif ($any_b || $any_w) {
$msg.="whitelisted by ".($any_w>1?"$any_w recips, ":"$wr, ") if $any_w;
$msg.="blacklisted by ".($any_b>1?"$any_b recips, ":"$br, ") if $any_b;
$msg.="but not by all,";
}
do_log(2,"white_black_list: $msg sender <$sender>") if $msg ne '';
($any_w+$any_b, $all);
}
sub spam_scan($$) {
my($conn,$msginfo) = @_;
my($spam_level, $spam_status, $spam_report);
if (defined $sa_mail_body_size_limit &&
$msginfo->orig_body_size > $sa_mail_body_size_limit) {
do_log(1, "spam_scan: not wasting time on SA, message body ".
"longer than $sa_mail_body_size_limit bytes: ".
$msginfo->orig_body_size);
} else {
my($fh) = $msginfo->mail_text;
$fh->seek(0,0) or die "Can't rewind mail file: $!";
my(@lines); my($body_lines) = 0;
push(@lines, sprintf('X-Envelope-From: %s'.$eol,
qquote_rfc2821_local($msginfo->sender)));
push(@lines, sprintf('X-Envelope-To: %s'.$eol,
join(",\n ",qquote_rfc2821_local(@{$msginfo->recips}))));
while (<$fh>) { push(@lines,$_); last if $_ eq $eol } while (<$fh>) { push(@lines,$_); $body_lines++ } section_time('SA msg read');
my($sa_required, $sa_tests);
my($saved_umask) = umask;
my($remaining_time) = alarm(0); eval {
local $SIG{ALRM} = sub {
my($s) = Carp::longmess("SA TIMED OUT, backtrace:");
if (length($s) > 900) { $s = substr($s,0,900-3) . "..." }
do_log(0,$s);
};
alarm(20); my($mail_obj) = Mail::SpamAssassin::NoMailAudit->new(
data => \@lines, add_From_line => 0);
section_time('SA parse');
do_log(5, "CALLING NoMailAudit::check");
my($per_msg_status);
{ local($1,$2,$3,$4); $per_msg_status = $spamassasin_obj->check($mail_obj);
}
my($rem_t) = alarm(0);
do_log(5, "RETURNED FROM NoMailAudit::check, time left: $rem_t s");
$spam_level = $per_msg_status->get_hits;
$sa_required = $per_msg_status->get_required_hits; $sa_tests = $per_msg_status->get_names_of_tests_hit;
$spam_report = $per_msg_status->get_report;
$per_msg_status->finish();
};
section_time('SA check');
umask($saved_umask); prolong_timer('spam_scan_SA', $remaining_time); if ($@ ne '') { chomp($@);
die "$@\n" if $@ ne "timed out";
}
$sa_tests = join(",\n ", split(/,\s*/,$sa_tests));
$spam_status = "tests=" . $sa_tests;
}
my($msg) = "spam_scan: hits=$spam_level $spam_status";
$msg =~ s/,\n /,/g; do_log(2, $msg);
($spam_level, $spam_status, $spam_report);
}
1;
__DATA__
[? %<%o> -> [<%R>|,][? %i ||, quarantine %i], Message-ID: %m
__DATA__
Subject: Undeliverable mail[?%
Message-ID: <DSN%n@%h>
[? %
[%X\n]
]\
This nondelivery report was generated by the amavisd-new program
at host %h. Our internal reference code for your message
is %n.
[? %WHAT IS AN INVALID CHARACTER IN MAIL HEADER?
The RFC 2822 standard specifies rules for forming internet messages.
It does not allow the use of characters with codes above 127 to be used
directly (non-encoded) in mail header (it also prohibits NUL and bare CR).
If characters (e.g. with diacritics) from ISO Latin or other alphabets
need to be included in the header, these characters need to be properly
encoded according to RFC 2047. This encoding is often done transparently
by mail reader (MUA), but if automatic encoding is not available (e.g.
by some older MUA) it is the user's responsibility to avoid the use
of such characters in mail header, or to encode them manually. Typically
the offending header fields in this category are 'Subject', 'Organization',
and comment fields in e-mail addresses of the 'From', 'To' and 'Cc'.
Sometimes such invalid header fields are inserted automatically
by some MUA, MTA, content checker, or other mail handling service.
If this is the case, that service needs to be fixed or properly configured.
Typically the offending header fields in this category are 'Date',
'Received', 'X-Mailer', 'X-Priority', 'X-Scanned', etc.
If you don't know how to fix or avoid the problem, please report it
to _your_ postmaster or system manager.
]
Your message[?%m|| %m] could not be delivered to:[
%N]
__DATA__
Subject: [? %[? %m |Message-ID: <VS%n@%h>
[? %
Our content checker found
[? %[? %[? %in your email to the following [? %-> %R]
Please check your system[?%or ask your system administrator to do so.
[? %
]
For your reference, here are headers from your email:
------------------------- BEGIN HEADERS -----------------------------
[%H
]\
-------------------------- END HEADERS ------------------------------
__DATA__
Date: %d
From: %f
Subject: [? % FROM[?%l|| LOCAL] [?%o|(?)|<%o>]
To: [? %[? %Message-ID: <VA%n@%h>
[? %[? %|A virus (%V) was found.
|Two viruses (%V) were found.
|%]
[? %||Two banned names (%F) were found.
|%]
[? %|Scanner detecting a virus: %W
|Scanners detecting a virus: %W
]
The mail originated from: <%o>
[? %t | %t
]
[? %
][? %%D]
]
[? %%N]
]
[? % %v]
]]
[? %q |Not quarantined.|The message has been quarantined as:
%q
]
------------------------- BEGIN HEADERS -----------------------------
[%H
]\
-------------------------- END HEADERS ------------------------------
__DATA__
Date: %d
From: %f
Subject: [? % IN MAIL TO YOU (from [?%o|(?)|<%o>])
To: [? %[? %Message-ID: <VR%n@%h>
[? %
Our content checker found
[? %[? %in an email to you [? %o |from unknown sender.|from:
%o]
[? %q |Not quarantined.|The message has been quarantined as:
%q]
Please contact your system administrator for details.
__DATA__
Subject: Considered UNSOLICITED BULK EMAIL from you
[? %m |Message-ID: <SS%n@%h>
Your message to:[
-> %R]
was considered unsolicited bulk e-mail (UBE).
Subject: %j
[? %]__DATA__
Date: %d
From: %f
Subject: SPAM FROM[?%l|| LOCAL] [?%o|(?)|<%o>]
To: [? %[? %[? %Message-ID: <SA%n@%h>
Unsolicited bulk email \
[? %o |from unknown or forged sender.|from:
%o]
Subject: %j
[? %t | %t
]
[? %%D]
][? %%N]
][? %q |Not quarantined.|The message has been quarantined as:
%q]
SpamAssassin report:
[%A
]\
------------------------- BEGIN HEADERS -----------------------------
[%H
]\
-------------------------- END HEADERS ------------------------------