File: //usr/share/perl5/vendor_perl/Amavis/Out/SMTP.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::Out::SMTP;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_via_smtp);
}
use Time::HiRes qw(time);
use Encode ();
# use Authen::SASL;
use Amavis::Conf qw(:platform c cr ca $smtp_connection_cache_enable);
use Amavis::Lookup qw(lookup lookup2);
use Amavis::Out::EditHeader;
use Amavis::rfc2821_2822_Tools;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(untaint min max minmax ll do_log snmp_count
xtext_encode xtext_decode orcpt_encode orcpt_decode
idn_to_ascii mail_addr_idn_to_ascii
prolong_timer get_deadline
collect_equal_delivery_recips);
# simple OO wrapper around Mail::DKIM::Signer to provide a method 'print'
# and to convert \n to CRLF
#
sub new_dkim_wrapper {
my($class, $handle,$strip_cr) = @_;
bless { handle => $handle, strip_cr => $strip_cr }, $class;
}
sub close { 1 }
sub print {
my $self = shift;
my $buff = @_ == 1 ? $_[0] : join('',@_);
do_log(-1,"WARN: Unicode string passed to Amavis::Out::SMTP::print : %s",
$buff) if utf8::is_utf8($buff); # false on tainted, Perl 5.8 bug #32687
$buff =~ tr/\015//d if $self->{strip_cr}; # sanitize bare CR
$buff =~ s{\n}{\015\012}gs;
$self->{handle}->PRINT($buff);
}
# Add a log_id to the SMTP status text, insert a fabricated RFC 3463 enhanced
# status code if missing in an MTA response, see also RFC 5248
#
sub enhance_smtp_response($$$$$) {
my($smtp_resp,$am_id,$mta_id,$dflt_enhcode,$cmd_name) = @_;
local($1,$2,$3,$4); my $resp_msg;
my($resp_code,$resp_more,$resp_enhcode) = ('451', ' ', '4.5.0');
if (!defined($smtp_resp) || $smtp_resp eq '') {
$smtp_resp = sprintf('No resp. to %s', $cmd_name);
} elsif ($smtp_resp !~ /^[245]\d{2}/) {
$smtp_resp = sprintf('Bad resp. to %s: %s', $cmd_name,$smtp_resp);
} elsif ($smtp_resp =~ /^ (\d{3}) (\ |-|\z) [ \t]*
([245] \. \d{1,3} \. \d{1,3})?
\s* (.*) \z/xs) {
($resp_code, $resp_more, $resp_enhcode, $resp_msg) = ($1, $2, $3, $4);
if (!defined $resp_enhcode && $resp_code =~ /^[245]/) {
my $c = substr($resp_code,0,1);
$resp_enhcode = $dflt_enhcode; $resp_enhcode =~ s/^\d*/$c/;
}
}
sprintf("%s%s%s from MTA(%s): %s",
$resp_code, $resp_more, $resp_enhcode, $mta_id, $smtp_resp);
}
# Send mail using SMTP - single transaction
# (e.g. forwarding original mail or sending notification)
# May throw exception (die) if temporary failure (4xx) or other problem
#
# Multiple transactions may be necessary, either due to different delivery
# methods (IP address, port, SMTP vs. LMTP) or due to '452 Too many recipients'
#
sub mail_via_smtp(@) {
my($msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;
#
# RFC 2033: LMTP protocol MUST NOT be used on the TCP port 25
#
# $initial_submission can be treated as a boolean, but for more detailed
# needs it can be any of: false: 0
# or true: 'Quar', 'Dsn', 'Notif', 'AV', 'Arf'
my $which_section = 'fwd_init';
my $id = $msginfo->parent_mail_id;
$id = $msginfo->mail_id . (defined $id ? "($id)" : "");
my $sender_smtp = $msginfo->sender_smtp;
my $logmsg = sprintf("%s %s", $id, $initial_submission?'SEND':'FWD');
my($per_recip_data_ref, $proto_sockname) =
collect_equal_delivery_recips($msginfo, $filter, qr/^(?:smtp|lmtp):/i);
if (!$per_recip_data_ref || !@$per_recip_data_ref) {
do_log(5, "%s from %s, nothing to do", $logmsg, $sender_smtp);
return 1;
}
my $proto_sockname_displ = !ref $proto_sockname ? $proto_sockname
: '(' . join(', ',@$proto_sockname) . ')';
my(@per_recip_data) = @$per_recip_data_ref; undef $per_recip_data_ref;
ll(4) && do_log(4, "about to connect to %s, %s from %s -> %s",
$proto_sockname_displ, $logmsg, $sender_smtp,
join(',', qquote_rfc2821_local(
map($_->recip_final_addr, @per_recip_data)) ));
my $am_id = $msginfo->log_id;
my $dsn_envid = $msginfo->dsn_envid;
my $dsn_ret = $msginfo->dsn_ret;
my $smtputf8 = $msginfo->smtputf8; # SMTPUTF8 requested
my $smtputf8_capable; # SMTPUTF8 offered by MTA, RFC 6531
my($relayhost, $protocol, $lmtp, $mta_id, @snmp_vars);
my($smtp_session, $smtp_handle, $smtp_resp, $smtp_response);
my($any_valid_recips, $any_tempfail_recips, $pipelining,
$any_valid_recips_and_data_sent, $recips_done_by_early_fail,
$in_datasend_mode, $dsn_capable, $auth_capable) = (0) x 8;
my $mimetransport8bit_capable = 0; # RFC 6152
my(%from_options);
# RFC 5321 (ex RFC 2821), section 4.5.3.2. Timeouts
my $smtp_connect_timeout = 35;
my $smtp_helo_timeout = 300;
my $smtp_starttls_timeout = 300;
my $smtp_xforward_timeout = 300;
my $smtp_mail_timeout = 300;
my $smtp_rcpt_timeout = 300;
my $smtp_data_init_timeout = 120;
my $smtp_data_xfer_timeout = 180;
my $smtp_data_done_timeout = 600;
my $smtp_quit_timeout = 10; # 300
my $smtp_rset_timeout = 20;
# can appear anywhere in a pipelined command group:
# RSET, MAIL FROM, SEND FROM, SOML FROM, SAML FROM, RCPT TO, data
# can only appear as the last command in a pipelined group: --> flush
# EHLO, DATA, VRFY, EXPN, TURN, QUIT, NOOP,
# AUTH(RFC 4954), STARTTLS(RFC 3207), and all unknown commands
# needed to implement dynamic_destination: a '*' in place of a host or port
my($wildcard_implied_host, $wildcard_implied_port);
my $conn = $msginfo->conn_obj;
if ($conn) {
my $host = $conn->client_ip;
$wildcard_implied_host = $host if defined($host) && $host ne '';
my $port = $conn->socket_port;
$wildcard_implied_port = $port+1 if defined($port) && $port =~ /^\d+\z/;
}
my($remaining_time, $deadline) = get_deadline($which_section, 1, 0);
alarm(0); # stop the timer
my $err;
eval {
$which_section = 'fwd-connect';
require Amavis::Out::SMTP::Session;
$smtp_session = Amavis::Out::SMTP::Session->new($proto_sockname, $deadline,
$wildcard_implied_host, $wildcard_implied_port)
or die "Can't establish an SMTP/LMTP session with $proto_sockname_displ";
$smtp_handle = $smtp_session->smtp_handle;
if ($smtp_handle) {
$relayhost = $smtp_handle->socketname;
$protocol = $smtp_handle->protocol;
$lmtp = lc($protocol) eq 'lmtp' ? 1 : 0; # RFC 2033
$mta_id = sprintf("%s:%s", $protocol, $relayhost);
@snmp_vars = !$initial_submission ?
('', 'Relay', 'Proto'.uc($protocol), 'Proto'.uc($protocol).'Relay')
: ('', 'Submit', 'Proto'.uc($protocol), 'Proto'.uc($protocol).'Submit',
'Submit'.$initial_submission);
snmp_count('OutMsgs'.$_) for @snmp_vars;
}
$dsn_capable = c('propagate_dsn_if_possible') &&
defined($smtp_session->supports('DSN')); # RFC 3461
$mimetransport8bit_capable = # 8bit-MIMEtransport service extension
defined($smtp_session->supports('8BITMIME')); # RFC 6152
$smtputf8_capable = # "Internationalized Email" service extension
$mimetransport8bit_capable &&
defined($smtp_session->supports('SMTPUTF8')); # RFC 6531
$pipelining = defined($smtp_session->supports('PIPELINING')); # RFC 2920
do_log(3,"No announced PIPELINING support by MTA?") if !$pipelining;
ll(5) && do_log(5,"Remote host presents itself as: %s, handles %s",
$smtp_handle->domain,
join(', ', $dsn_capable ? 'DSN' : (),
$pipelining ? 'PIPELINING' : (),
$mimetransport8bit_capable ? '8BITMIME' : (),
$smtputf8_capable ? 'SMTPUTF8' : () ) );
if ($lmtp && !$pipelining) { # RFC 2033 requirements
die "An LMTP server implementation MUST implement PIPELINING";
}
if ($lmtp && !defined($smtp_session->supports('ENHANCEDSTATUSCODES'))) {
die "An LMTP server implementation MUST implement ENHANCEDSTATUSCODES";
}
if (!$smtputf8_capable || !$smtputf8) {
# if SMTPUTF8 is not requested or if MTA is unable to handle
# IDN with U-labels, and local part is all-ASCII, then we may
# still get this delivered by converting a domain name
# to ASCII-compatible encoding (ACE)
if ($sender_smtp =~ /^ [\x00-\x7F]* \@ [^\@]* [^\x00-\x7F] [^\@]*\z/xs) {
# localpart all-ASCII, domain is non-ASCII
my $idn_ascii = mail_addr_idn_to_ascii($sender_smtp);
do_log(2,'sender IDN encoded to ACE: %s -> %s',
$sender_smtp, $idn_ascii);
$sender_smtp = $idn_ascii;
}
for my $r (@per_recip_data) {
next if $r->recip_done;
my $rcpt_addr = $r->recip_final_addr;
if ($rcpt_addr =~ /^ [\x00-\x7F]* \@ [^\@]* [^\x00-\x7F] [^\@]*\z/xs) {
my $idn_ascii = mail_addr_idn_to_ascii($rcpt_addr);
do_log(2,'recipient IDN encoded to ACE: %s -> %s',
$rcpt_addr, $idn_ascii);
$rcpt_addr = $idn_ascii;
$r->dsn_orcpt(join(';', orcpt_decode(';'.$r->recip_addr_smtp)))
if !defined $r->dsn_orcpt;
# N.B.: change recip_addr_modified(), not recip_final_addr() !
$r->recip_addr_modified($rcpt_addr);
}
}
}
if ($smtputf8) { # SMTPUTF8 handling was requested, RFC 6531
#
# RFC 6531 section 3.4: If the SMTPUTF8-aware SMTP client is aware
# that neither the envelope nor the message being sent requires any
# of the SMTPUTF8 extension capabilities, it SHOULD NOT supply the
# SMTPUTF8 parameter with the MAIL command.
#
my($sender_8bit, $recips_8bit);
$sender_8bit = 1 if $msginfo->sender_smtp =~ tr/\x00-\x7F//c;
for my $r (@per_recip_data) {
next if $r->recip_done;
$recips_8bit = 1 if $r->recip_final_addr =~ tr/\x00-\x7F//c;
}
if (!ll(5)) {
# don't bother, just logging
} elsif ($sender_8bit || $recips_8bit || $msginfo->header_8bit) {
do_log(5,'SMTPUTF8 option requested and is needed, %s is non-ASCII',
join(' & ', $sender_8bit ? 'sender' : (),
$recips_8bit ? 'recip' : (),
$msginfo->header_8bit ? 'header' : () ));
} else {
do_log(5,'SMTPUTF8 option requested but not needed');
}
if (!$smtputf8_capable) {
# RFC 6531 sect 3.5: An SMTPUTF8-aware SMTP client MUST NOT send
# an internationalized message to an SMTP server that does not
# support SMTPUTF8.
# 550 5.6.7 Non-ASCII addresses not permitted for that sender
# 553 5.6.7 Non-ASCII addresses not permitted for that recipient
# after DATA-dot:
# 554 5.6.9 UTF-8 header message cannot be transmitted to one or more
# recipients, so the message must be rejected
#
if (!$sender_8bit && !$recips_8bit) {
# mail addresses are all-ASCII, don't care for an 8bit header
do_log(3,'SMTPUTF8 option requested but not offered, turning it off');
$smtputf8 = 0; # turn off if not needed
}
}
}
section_time($which_section);
$which_section = 'fwd-xforward';
my $cl_ip = $msginfo->client_addr;
if (defined $cl_ip && $cl_ip ne '' &&
defined($smtp_session->supports('XFORWARD'))) {
$cl_ip = 'IPv6:'.$cl_ip if $cl_ip =~ /:[0-9a-f]*:/i &&
$cl_ip !~ /^IPv6:/i;
my(%xfwd_supp_opt) = map((uc($_),1),
split(' ',$smtp_session->supports('XFORWARD')));
my(@params) = map
{ my($n,$v) = @$_;
# Postfix since version 20060610 uses xtext-encoded (RFC 3461)
# strings in XCLIENT and XFORWARD attribute values, previous
# versions expected plain text with neutered special characters;
# see README_FILES/XFORWARD_README
if (defined $v && $v ne '') {
$v =~ s/[^\041-\176]/?/gs; # isprint
$v =~ s/[<>()\\";\@]/?/gs; # other chars that are special in hdrs
# postfix/src/smtpd/smtpd.c NEUTER_CHARACTERS
$v = xtext_encode($v);
substr($v,255) = '' if length($v) > 255; # chop xtext, not nice
}
!defined $v || $v eq '' || !$xfwd_supp_opt{$n} ? () : ("$n=$v") }
( ['ADDR',$cl_ip], ['NAME',$msginfo->client_name],
['PORT',$msginfo->client_port], ['PROTO',$msginfo->client_proto],
['HELO',$msginfo->client_helo], ['SOURCE',$msginfo->client_source],
['IDENT',$msginfo->queue_id] );
$smtp_session->timeout(
max(60,min($smtp_xforward_timeout,$deadline-time())));
$smtp_handle->command('XFORWARD',@params); #flush!
$smtp_resp = $smtp_session->smtp_response; # fetch response to XFORWARD
if (!defined $smtp_resp || $smtp_resp eq '') {
do_log(-1,"%s SMTP resp. to XFORWARD, dt: %.3f s",
!defined $smtp_resp ? 'No' : 'Empty',
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp !~ /^2/) {
do_log(0,"Negative SMTP resp. to XFORWARD: %s", $smtp_resp);
} else { # success, $smtp_resp =~ /^2/
do_log(3,"smtp resp to XFORWARD: %s", $smtp_resp);
}
section_time($which_section);
}
$which_section = 'fwd-auth';
my $auth_user = $msginfo->auth_user;
my $mechanisms = $smtp_session->supports('AUTH');
if (!c('auth_required_out')) {
do_log(3,"AUTH not needed, user='%s', MTA offers '%s'",
$auth_user,$mechanisms);
} elsif ($mechanisms eq '') {
do_log(3,"INFO: MTA does not offer AUTH capability, user='%s'",
$auth_user);
} elsif (!defined $auth_user) {
do_log(0,"INFO: AUTH needed for submission but AUTH data not available");
} else {
do_log(3,"INFO: authenticating %s, server supports AUTH %s",
$auth_user,$mechanisms);
$auth_capable = 1;
# my $sasl = Authen::SASL->new(
# 'callback' => { 'user' => $auth_user, 'authname' => $auth_user,
# 'pass' => $msginfo->auth_pass });
# $smtp_handle->auth($sasl) or die "sending AUTH, user=$auth_user\n";#flush
do_log(0,"Sorry, AUTH not supported in this version of amavisd!");
section_time($which_section);
}
$which_section = 'fwd-pre-mail-from';
$smtp_session->timeout(max(60,min($smtp_mail_timeout,$deadline-time())));
my $fetched_mail_resp = 0; my $fetched_rcpt_resp = 0;
my $data_command_accepted = 0;
if ($initial_submission && $dsn_capable && !defined($dsn_envid)) {
# ENVID identifies transaction, not a message
$dsn_envid = xtext_encode(sprintf("AM.%s.%s\@%s",
$msginfo->mail_id || $msginfo->log_id,
iso8601_utc_timestamp(time),
idn_to_ascii(c('myhostname')) ));
}
$from_options{'RET'} = $dsn_ret if $dsn_capable && defined $dsn_ret;
if ($dsn_capable && defined $dsn_envid) {
# check for proper encoding (RFC 3461), just in case
if ($dsn_envid =~ tr/ =\x00-\x1F//) {
do_log(-1, "Prohibited character in ENVID: %s", $dsn_envid);
} else {
$from_options{'ENVID'} = $dsn_envid;
}
}
my $submitter = $msginfo->auth_submitter;
$from_options{'AUTH'} = xtext_encode($submitter) # RFC 4954 (ex RFC 2554)
if $auth_capable &&
defined($submitter) && $submitter ne '' && $submitter ne '<>';
if ($smtputf8 && $smtputf8_capable) {
$from_options{'SMTPUTF8'} = undef; # turn option *on*, no value
}
my $btype = $msginfo->body_type;
if (defined $btype && $btype ne '') {
$btype = uc $btype;
if ($btype ne '7BIT' && $btype ne '8BITMIME') {
do_log(-1,'requested BODY type %s is unknown/unsupported', $btype);
} elsif ($mimetransport8bit_capable) {
$from_options{'BODY'} = $btype;
}
}
if (!$mimetransport8bit_capable &&
defined $btype && $btype ne '' && uc $btype ne '7BIT') {
do_log(-1,'requested BODY type is %s, but MTA does not announce '.
'8bit-MIMEtransport capability', $btype); # RFC 6152
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_smtp_response('550 5.6.3 Conversion to 7BIT required '.
'but not supported');
$r->recip_remote_mta($relayhost); $r->recip_done(2);
}
$recips_done_by_early_fail = 1;
} elsif ($smtputf8 &&
!$smtputf8_capable && $sender_smtp =~ tr/\x00-\x7F//c) {
do_log(1,'SMTPUTF8 option requested, not offered by MTA, '.
'sender is non-ASCII: %s', $sender_smtp);
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_smtp_response('550 5.6.7 Non-ASCII addresses not permitted '.
'for sender');
$r->recip_remote_mta($relayhost); $r->recip_done(2);
}
$recips_done_by_early_fail = 1;
} else {
$which_section = 'fwd-mail-from';
$smtp_handle->mail($sender_smtp, %from_options); # MAIL FROM
# consider the transaction state unknown until we see a response
$smtp_session->transaction_begins_unconfirmed; # also counts transactions
if (!$pipelining) {
$smtp_resp = $smtp_session->smtp_response; $fetched_mail_resp = 1;
if (!defined $smtp_resp || $smtp_resp eq '') {
die sprintf("%s response to MAIL, dt: %.3f s\n",
!defined $smtp_resp ? 'No' : 'Empty',
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp =~ /^2/) {
do_log(3, "smtp resp to MAIL: %s", $smtp_resp);
$smtp_session->transaction_begins; # transaction is active
} else { # failure
do_log(1, "smtp resp to MAIL: %s", $smtp_resp);
# transaction state unchanged, consider it unknown
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
'.1.0','MAIL FROM');
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
$r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
}
$recips_done_by_early_fail = 1;
}
section_time($which_section);
}
}
$which_section = 'fwd-rcpt-to';
$smtp_session->timeout(max(60,min($smtp_rcpt_timeout,$deadline-time())));
my($skipping_resp, @per_recip_data_rcpt_sent);
for my $r (@per_recip_data) { # send recipient addresses
next if $r->recip_done;
if (defined $skipping_resp) {
$r->recip_smtp_response($skipping_resp); $r->recip_done(2);
next;
}
# prepare to send a RCPT TO command
my $raddr = qquote_rfc2821_local($r->recip_final_addr);
if ($smtputf8 && !$smtputf8_capable && $raddr =~ tr/\x00-\x7F//c) {
do_log(1,'SMTPUTF8 option requested, not offered by MTA, '.
'recipient is non-ASCII: %s', $raddr);
$r->recip_smtp_response('553 5.6.7 Non-ASCII addresses '.
'not permitted for recipient');
$r->recip_remote_mta($relayhost); $r->recip_done(2);
} elsif (!$dsn_capable) {
$smtp_handle->recipient($raddr); # a barebones RCPT TO command
push(@per_recip_data_rcpt_sent, $r); # remember which recips were sent
} else { # include dsn options with a RCPT TO command
my(@dsn_notify); # implies a default when the list is empty
my $dn = $r->dsn_notify;
@dsn_notify = @$dn if $dn && $msginfo->sender ne ''; # if nondefault
if (c('terminate_dsn_on_notify_success')) {
# we want to handle option SUCCESS locally
if (grep($_ eq 'SUCCESS', @dsn_notify)) { # strip out SUCCESS
@dsn_notify = grep($_ ne 'SUCCESS', @dsn_notify);
@dsn_notify = ('NEVER') if !@dsn_notify;
do_log(3,"stripped out SUCCESS, result: NOTIFY=%s",
join(',',@dsn_notify));
}
}
my(%rcpt_options);
$rcpt_options{'NOTIFY'} =
join(',', map(uc($_),@dsn_notify)) if @dsn_notify;
my($addr_type, $addr) =
orcpt_encode($r->dsn_orcpt, $smtputf8 && $smtputf8_capable, 1);
$rcpt_options{'ORCPT'} = $addr_type.';'.$addr if defined $addr;
$smtp_handle->recipient($raddr, %rcpt_options); # RCPT TO
push(@per_recip_data_rcpt_sent, $r); # remember which recips were sent
}
if (!$pipelining) { # must fetch responses to RCPT TO right away
$smtp_resp = $smtp_session->smtp_response; $fetched_rcpt_resp = 1;
if (defined $smtp_resp && $smtp_resp ne '') {
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
'.1.0','RCPT TO');
$r->recip_smtp_response($smtp_resp_ext); # preliminary response
}
if (!defined $smtp_resp || $smtp_resp eq '') {
die sprintf("%s response to RCPT (%s), dt: %.3f s\n",
!defined $smtp_resp ? 'No' : 'Empty', $raddr,
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp =~ /^2/) {
do_log(3, "smtp resp to RCPT (%s): %s", $raddr,$smtp_resp);
$any_valid_recips++;
} else { # failure
do_log(1, "smtp resp to RCPT (%s): %s", $raddr,$smtp_resp);
if ($smtp_resp =~ /^452/) { # too many recipients - see RFC 5321
do_log(-1, 'Only %d recips sent in one go: "%s"',
$any_valid_recips, $smtp_resp)
if !defined $skipping_resp;
$skipping_resp = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
'.5.3','RCPT TO');
} elsif ($smtp_resp =~ /^4/) {
$any_tempfail_recips++;
}
$r->recip_done(2); # got a negative response to RCPT TO
}
}
}
section_time($which_section) if !$pipelining; # otherwise it just shows 0
my $what_cmd;
if (!@per_recip_data_rcpt_sent || # no recipients were sent
$fetched_rcpt_resp && !$any_valid_recips) { # no recipients accepted
# it is known there are no valid recipients, don't go into DATA section
do_log(0,"no valid recipients, skip data transfer");
$smtp_session->timeout($smtp_rset_timeout);
$what_cmd = 'RSET'; $smtp_handle->rset; # send a RSET
$smtp_session->transaction_ends_unconfirmed;
} elsif ($fetched_rcpt_resp && # no pipelining
$any_tempfail_recips && !$dsn_per_recip_capable) {
# we must not proceed if mail did not came in as LMTP,
# or we would generate mail duplicates on each delivery attempt
do_log(-1,"mail_via_smtp: DATA skipped, tempfailed recips: %s",
$any_tempfail_recips);
$smtp_session->timeout($smtp_rset_timeout);
$what_cmd = 'RSET'; $smtp_handle->rset; # send a RSET
$smtp_session->transaction_ends_unconfirmed;
} else { # pipelining, or we know we got a clearance to proceed
$which_section = 'fwd-data-cmd';
# pipelining in effect, or we have at least one valid recipient, go DATA
$smtp_session->timeout(
max(60,min($smtp_data_init_timeout,$deadline-time())));
$smtp_handle->data; #flush! DATA
$in_datasend_mode = 1; # DATA command was sent (but not yet confirmed)
if (!$fetched_mail_resp) { # pipelining in effect, late response to MAIL
$which_section = 'fwd-mail-pip';
$smtp_session->timeout(
max(60,min($smtp_mail_timeout,$deadline-time())));
$smtp_resp = $smtp_session->smtp_response; $fetched_mail_resp = 1;
if (!defined $smtp_resp || $smtp_resp eq '') {
die sprintf("%s response to MAIL (pip), dt: %.3f s\n",
!defined $smtp_resp ? 'No' : 'Empty',
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp =~ /^2/) {
do_log(3, "smtp resp to MAIL (pip): %s", $smtp_resp);
$smtp_session->transaction_begins; # transaction is active
} else { # failure
do_log(1, "smtp resp to MAIL (pip): %s", $smtp_resp);
# transaction state unchanged, consider it unknown
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
$am_id, $mta_id, '.1.0', 'MAIL FROM');
for my $r (@per_recip_data) {
next if $r->recip_done;
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
$r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
}
$recips_done_by_early_fail = 1;
}
section_time($which_section);
}
if (!$fetched_rcpt_resp) { # pipelining in effect, late response to RCPT
$which_section = 'fwd-rcpt-pip';
$smtp_session->timeout(
max(60,min($smtp_rcpt_timeout,$deadline-time())));
for my $r (@per_recip_data_rcpt_sent) { # only for those actually sent
my $raddr = qquote_rfc2821_local($r->recip_final_addr);
$smtp_resp = $smtp_session->smtp_response; $fetched_rcpt_resp = 1;
if (defined $smtp_resp && $smtp_resp ne '') {
if ($r->recip_done) { # shouldn't happen, unless MAIL FROM failed
do_log(-1,"panic: recipient done, but got an ".
"smtp resp to RCPT (pip) (%s): %s",
$raddr,$smtp_resp) if !$recips_done_by_early_fail;
next; # do not overwrite previous diagnostics
}
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
$am_id, $mta_id, '.1.0', 'RCPT TO');
$r->recip_smtp_response($smtp_resp_ext); # preliminary response
}
if (!defined $smtp_resp || $smtp_resp eq '') {
die sprintf("%s response to RCPT (pip) (%s), dt: %.3f s\n",
!defined $smtp_resp ? 'No' : 'Empty', $raddr,
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp =~ /^2/) {
do_log(3, "smtp resp to RCPT (pip) (%s): %s", $raddr,$smtp_resp);
$any_valid_recips++;
} else { # failure
do_log(1, "smtp resp to RCPT (pip) (%s): %s", $raddr,$smtp_resp);
if ($smtp_resp =~ /^452/) { # too many recipients - see RFC 5321
do_log(-1, 'Only %d recips sent in one go: "%s"',
$any_valid_recips, $smtp_resp)
if !defined $skipping_resp;
$skipping_resp = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
'.5.3','RCPT TO');
} elsif ($smtp_resp =~ /^4/) {
$any_tempfail_recips++;
}
$r->recip_done(2); # got a negative response to RCPT TO
}
}
section_time($which_section);
}
$which_section = 'fwd-data-chkpnt' if $pipelining;
$smtp_session->timeout(
max(60,min($smtp_data_init_timeout,$deadline-time())));
$smtp_resp = $smtp_session->smtp_response; # fetch response to DATA
section_time($which_section);
$data_command_accepted = 0;
if (!defined $smtp_resp || $smtp_resp eq '') {
do_log(-1,"%s SMTP resp. to DATA, dt: %.3f s",
!defined $smtp_resp ? 'No' : 'Empty',
time - $smtp_handle->last_io_event_tx_timestamp);
$smtp_resp = sprintf("450 4.5.0 %s response to DATA",
!defined $smtp_resp ? 'No' : 'Empty');
} elsif ($smtp_resp !~ /^3/) {
do_log(0,"Negative SMTP resp. to DATA: %s", $smtp_resp);
} else { # success, $smtp_resp =~ /^3/
$data_command_accepted = 1;
do_log(3,"smtp resp to DATA: %s", $smtp_resp);
}
if (!$data_command_accepted) {
$in_datasend_mode = 0;
$smtp_session->timeout($smtp_rset_timeout);
$what_cmd = 'RSET'; $smtp_handle->rset; # send a RSET
$smtp_session->transaction_ends_unconfirmed;
# replace success responses to RCPT TO commands with a response to DATA
for my $r (@per_recip_data_rcpt_sent) { # only for those actually sent
next if $r->recip_done; # skip those that failed at earlier stages
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,
$am_id, $mta_id, '.5.0', 'DATA');
$smtp_response = $smtp_resp_ext if !defined $smtp_response;
$r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
}
} elsif (!$any_valid_recips) { # pipelining and no recipients, in DATA
do_log(2,"Too late, DATA accepted but no valid recips, send dummy");
$which_section = 'fwd-dummydata-end';
$smtp_session->timeout(
max(60,min($smtp_data_done_timeout,$deadline-time())));
$what_cmd = 'data-dot';
$smtp_handle->dataend; # .<CR><LF> as required by RFC 2920: if a DATA
# command was accepted the SMTP client should send a single dot
$in_datasend_mode = 0; $smtp_session->transaction_ends_unconfirmed;
} elsif ($any_tempfail_recips && !$dsn_per_recip_capable) { # pipelining
# we must not proceed if mail did not came in as LMTP,
# or we would generate mail duplicates on each delivery attempt
do_log(2,"Too late, DATA accepted but tempfailed recips, bail out");
die "Bail out, DATA accepted but tempfailed recips, not an LMTP input";
} else { # all ok so far, we are in a DATA state and must send contents
$which_section = 'fwd-data-hdr';
my $hdr_edits = $msginfo->header_edits;
$hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits;
$smtp_session->timeout(
max(60,min($smtp_data_xfer_timeout,$deadline-time())));
my($received_cnt,$file_position) =
$hdr_edits->write_header($msginfo,$smtp_handle,!$initial_submission);
if ($received_cnt > 100) {
# loop detection required by RFC 5321 (ex RFC 2821) section 6.3
# Do not modify the signal text, it gets matched elsewhere!
die "Too many hops: $received_cnt 'Received:' header fields\n";
}
$which_section = 'fwd-data-contents';
# a file handle or a string ref or MIME::Entity object
my $msg = $msginfo->mail_text;
my $msg_str_ref = $msginfo->mail_text_str; # have an in-memory copy?
$msg = $msg_str_ref if ref $msg_str_ref;
if (!defined $msg) {
# empty mail
} elsif (ref $msg eq 'SCALAR') {
# do it in chunks, saves memory, cache friendly
while ($file_position < length($$msg)) {
$smtp_handle->datasend(substr($$msg,$file_position,16384));
$file_position += 16384; # may overshoot, no problem
}
} elsif ($msg->isa('MIME::Entity')) {
$msg->print_body($smtp_handle);
} else {
my($nbytes,$buff);
while (($nbytes = $msg->read($buff,3*16384)) > 0) {
$smtp_handle->datasend($buff);
}
defined $nbytes or die "Error reading: $!";
}
section_time($which_section);
$which_section = 'fwd-data-end';
$smtp_session->timeout(
max(60,min($smtp_data_done_timeout,$deadline-time())));
$what_cmd = 'data-dot';
$smtp_handle->dataend; # .<CR><LF>
$in_datasend_mode = 0; $smtp_session->transaction_ends_unconfirmed;
$any_valid_recips_and_data_sent = 1;
section_time($which_section) if !$pipelining; # otherwise it shows 0
}
}
if ($pipelining && !$smtp_connection_cache_enable) {
do_log(5,"smtp connection_cache disabled, sending QUIT");
$smtp_session->quit; #flush! QUIT
# can't be sure until we see a response, consider uncertain just in case
$smtp_session->transaction_ends_unconfirmed;
}
$which_section = 'fwd-rundown-1';
$smtp_resp = undef;
if (!defined $what_cmd) {
# not expecting a response?
} elsif ($what_cmd ne 'data-dot') { # must be a response to a RSET
$smtp_resp = $smtp_session->smtp_response; # fetch a response
if (!defined $smtp_resp || $smtp_resp eq '') {
die sprintf("%s SMTP response to %s, dt: %.3f s",
!defined $smtp_resp ? 'No' : 'Empty', $what_cmd,
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp !~ /^2/) {
die "Negative SMTP response to $what_cmd: $smtp_resp";
} else { # success, $smtp_resp =~ /^2/
do_log(3,"smtp resp to %s: %s", $what_cmd,$smtp_resp);
$smtp_session->transaction_ends if $what_cmd eq 'RSET';
}
} else { # get response(s) to data-dot
# replace success responses to RCPT TO commands with a final response
my $first = 1; my $anyfail = 0; my $anysucc = 0;
for my $r (@per_recip_data_rcpt_sent) { # only for those actually sent
if ($lmtp || $first) {
$first = 0; my $raddr = qquote_rfc2821_local($r->recip_final_addr);
$raddr .= ', etc.' if !$lmtp && @per_recip_data > 1;
$smtp_resp = $smtp_session->smtp_response; # resp to data-dot
if (!defined $smtp_resp || $smtp_resp eq '') {
$anyfail = 1;
do_log(0,"%s SMTP response to %s (%s), dt: %.3f s",
!defined $smtp_resp ? 'No' : 'Empty', $what_cmd, $raddr,
time - $smtp_handle->last_io_event_tx_timestamp);
} elsif ($smtp_resp !~ /^2/) {
$anyfail = 1;
do_log(0,"Negative SMTP response to %s (%s): %s, dt: %.1f ms",
$what_cmd, $raddr, $smtp_resp,
1000*(time-$smtp_handle->last_io_event_tx_timestamp));
} else { # success, $smtp_resp =~ /^2/
$anysucc = 1;
ll(3) && do_log(3,"smtp resp to %s (%s): %s, dt: %.1f ms",
$what_cmd, $raddr, $smtp_resp,
1000*(time-$smtp_handle->last_io_event_tx_timestamp));
}
}
next if $r->recip_done; # skip those that failed at earlier stages
$r->recip_remote_mta($relayhost);
$r->recip_remote_mta_smtp_response($smtp_resp);
my $smtp_resp_ext = enhance_smtp_response($smtp_resp,$am_id,$mta_id,
'.6.0','data-dot');
$smtp_response = $smtp_resp_ext if !defined $smtp_response;
$r->recip_smtp_response($smtp_resp_ext); $r->recip_done(2);
$r->recip_mbxname($r->recip_final_addr) if $smtp_resp =~ /^2/;
}
if ($first) { # fetch an uncollected response
# fetch unprocessed response if all recipients were rejected
# but we nevertheless somehow entered a data transfer mode
# (i.e. if an SMTP server failed to reject a DATA command).
# RFC 2033: when there have been no successful RCPT commands in the
# mail transaction, the DATA command MUST fail with a 503 reply code
$smtp_resp = $smtp_session->smtp_response; # resp to data-dot
$smtp_resp = '' if !defined $smtp_resp;
if ($smtp_resp =~ /^2/) { $anysucc = 1 } else { $anyfail = 1 }
do_log(3,"smtp resp to _dummy_ data %s: %s", $what_cmd,$smtp_resp);
}
if ($anysucc && !$anyfail) {
# we are certain all went fine and a transaction is definitely over
$smtp_session->transaction_ends;
}
}
# if ($pipelining) {} # QUIT was already sent
# elsif (!$smtp_connection_cache_enable) {
# $smtp_session->quit; #flush! QUIT
# # can't be sure until we see a response, consider uncertain just in case
# $smtp_session->transaction_ends_unconfirmed;
# }
# if ($smtp_session->session_state eq 'quitsent') {
# $smtp_session->timeout($smtp_quit_timeout);
# $smtp_resp = $smtp_session->smtp_response;
# $smtp_resp = '' if !defined $smtp_resp;
# do_log(3,"smtp resp to QUIT: %s", $smtp_resp);
# if ($smtp_resp =~ /^2/) {
# $smtp_session->transaction_ends;
# } else {
# $smtp_session->transaction_ends_unconfirmed;
# do_log(0,"Negative SMTP resp. to QUIT: %s", $smtp_resp);
# }
# }
my $keep_session = $smtp_session->session_state ne 'quitsent';
if ($keep_session && !defined($smtp_session->in_smtp_transaction)) {
do_log(2,"SMTP transaction state uncertain, closing just in case");
$keep_session = 0;
}
$smtp_session->close($keep_session)
or die "Error closing Amavis::Out::SMTP::Session";
undef $smtp_handle; undef $smtp_session;
1;
# some unusual error conditions _are_ captured by eval, but fail to set $@
} or do { $err = $@ ne '' ? $@ : "errno=$!"; chomp $err };
my $saved_section_name = $which_section;
$which_section = 'fwd-end-chkpnt';
do_log(2,"mail_via_smtp: session failed: %s", $err) if defined $err;
prolong_timer($which_section); # restart timer
# terminate the SMTP session if still alive
if (!defined($smtp_session)) {
# already closed normally
} elsif ($in_datasend_mode) {
# We are aborting SMTP session. Data transfer mode must NOT be terminated
# with a dataend (dot), otherwise recipient will receive a chopped-off mail
# (and possibly be receiving it over and over again during each MTA retry.
do_log(-1, "mail_via_smtp: NOTICE: aborting SMTP session, %s", $err);
$smtp_session->close(0); # abruptly terminate SMTP session, ignore status
} else {
do_log(5,"smtp session done, sending QUIT");
eval {
$smtp_session->timeout(1); # don't wait for too long
$smtp_session->quit; #flush! # send a QUIT regardless of success so far
$smtp_session->transaction_ends_unconfirmed;
for (my $cnt=0; ; $cnt++) { # curious if there are any pending responses
my $smtp_resp = $smtp_session->smtp_response;
last if !defined $smtp_resp;
do_log(0,"discarding unprocessed reply: %s", $smtp_resp);
if ($cnt > 20) { do_log(-1,"aborting, discarding many replies"); last }
}
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log(-1, "mail_via_smtp: error during QUIT: %s", $eval_stat);
};
$smtp_session->close(0); # terminate SMTP session, ignore status
}
undef $smtp_handle; undef $smtp_session;
# prepare final smtp response and log abnormal events
for my $r (@per_recip_data) {
my $resp = $r->recip_smtp_response;
$smtp_response = $resp if !defined($smtp_response) ||
$resp =~ /^4/ && $smtp_response !~ /^4/ ||
$resp !~ /^2/ && $smtp_response !~ /^[45]/;
}
if (!defined $err) {
# no errors
} elsif ($err =~ /^timed out\b/ || $err =~ /: Timeout\z/) {
$smtp_response = sprintf("450 4.4.2 Timed out during %s, MTA(%s), id=%s",
$saved_section_name, $mta_id, $am_id);
} elsif ($err =~ /^Can't connect\b/) {
$smtp_response = sprintf("450 4.4.1 %s, MTA(%s), id=%s",
$err, $mta_id, $am_id);
} elsif ($err =~ /^Too many hops\b/) {
$smtp_response = sprintf("554 5.4.6 Reject: %s, id=%s", $err, $am_id);
} else {
$smtp_response = sprintf("451 4.5.0 From MTA(%s) during %s (%s): id=%s",
$mta_id, $saved_section_name, $err, $am_id);
}
# NOTE: $initial_submission argument is typically treated as a boolean
# but a value of 'AV' is supplied by av_smtp_client to allow a forwarding
# method to distinguish it from ordinary submissions
my $ll = ($smtp_response =~ /^2/ || $initial_submission eq 'AV') ? 1 : -1;
ll($ll) && do_log($ll, "%s from %s -> %s, %s %s",
$logmsg, $sender_smtp,
join(',', qquote_rfc2821_local(
map($_->recip_final_addr, @per_recip_data))),
join(' ', map { my $v=$from_options{$_}; defined($v)?"$_=$v":"$_" }
(keys %from_options)),
$smtp_response);
if (defined $smtp_response) {
$msginfo->dsn_passed_on($dsn_capable && $smtp_response=~/^2/ &&
!c('terminate_dsn_on_notify_success') ? 1 : 0);
for my $r (@per_recip_data) {
# attach an SMTP response to each recip that was not already processed
if (!$r->recip_done) { # mark it as done
$r->recip_smtp_response($smtp_response); $r->recip_done(2);
$r->recip_mbxname($r->recip_final_addr) if $smtp_response =~ /^2/;
} elsif ($any_valid_recips_and_data_sent &&
$r->recip_smtp_response =~ /^452/) {
# 'undo' the RCPT TO '452 Too many recipients' situation,
# mail needs to be transferred in more than one transaction
$r->recip_smtp_response(undef); $r->recip_done(undef);
}
}
if ($smtp_response =~ /^2/) {
snmp_count('OutMsgsDelivers');
my $size = $msginfo->msg_size;
snmp_count( ['OutMsgsSize'.$_, $size, 'C64'] ) for @snmp_vars;
} elsif ($smtp_response =~ /^4/) {
snmp_count('OutMsgsAttemptFails');
} elsif ($smtp_response =~ /^5/) {
snmp_count('OutMsgsRejects');
}
}
section_time($which_section);
die $err if defined($err) && $err =~ /^timed out\b/; # resignal timeout
1;
}
1;