File: //usr/share/perl5/vendor_perl/Amavis/Out/Pipe.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::Out::Pipe;
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_pipe);
}
use Errno qw(ENOENT EACCES ESRCH);
use POSIX qw(WIFEXITED WIFSIGNALED WIFSTOPPED
WEXITSTATUS WTERMSIG WSTOPSIG);
use Amavis::Conf qw(:platform c cr ca);
use Amavis::Out::EditHeader;
use Amavis::ProcControl qw(exit_status_str proc_status_ok kill_proc
run_command_consumer);
use Amavis::rfc2821_2822_Tools;
use Amavis::Timing qw(section_time);
use Amavis::Util qw(untaint min max minmax ll do_log snmp_count
collect_equal_delivery_recips);
# Send mail using external mail submission program 'sendmail' or its lookalike
# (also available with Postfix and Exim) - used for forwarding original mail
# or sending notifications or quarantining. May throw exception (die) on
# temporary failure (4xx) or other problem.
#
sub mail_via_pipe(@) {
my($msginfo, $initial_submission, $dsn_per_recip_capable, $filter) = @_;
my(@snmp_vars) = !$initial_submission ?
('', 'Relay', 'ProtoPipe', 'ProtoPipeRelay')
: ('', 'Submit', 'ProtoPipe', 'ProtoPipeSubmit',
'Submit'.$initial_submission);
snmp_count('OutMsgs'.$_) for @snmp_vars;
my $id = $msginfo->parent_mail_id;
$id = $msginfo->mail_id . (defined $id ? "($id)" : "");
my $logmsg = sprintf("%s %s via PIPE from %s", $id,
($initial_submission ? 'SEND' : 'FWD'),
$msginfo->sender_smtp);
my($per_recip_data_ref, $proto_sockname) =
collect_equal_delivery_recips($msginfo, $filter, qr/^pipe:/i);
if (!$per_recip_data_ref || !@$per_recip_data_ref) {
do_log(5, "%s, nothing to do", $logmsg); return 1;
}
$proto_sockname = $proto_sockname->[0] if ref $proto_sockname;
ll(1) && do_log(1, "delivering to %s, %s -> %s",
$proto_sockname, $logmsg,
join(',', qquote_rfc2821_local(
map($_->recip_final_addr, @$per_recip_data_ref)) ));
# just use the first one, ignoring failover alternatives
local($1);
$proto_sockname =~ /^pipe:(.*)\z/si
or die "Bad fwd method syntax: ".$proto_sockname;
my $pipe_args = $1;
$pipe_args =~ s/^flags=\S*\s*//i; # flags are currently ignored, q implied
$pipe_args =~ s/^argv=//i;
my(@pipe_args) = split(' ',$pipe_args); my(@command) = shift(@pipe_args);
my $dsn_capable = c('propagate_dsn_if_possible'); # assume, unless disabled
$dsn_capable = 0 if $command[0] !~ /sendmail/; # a hack, don't use -N or -V
if ($dsn_capable) { # DSN is supported since Postfix 2.3
# notify options are per-recipient, yet a command option -N applies to all
my $common_list; my $not_all_the_same = 0;
for my $r (@{$msginfo->per_recip_data}) {
my $dsn_notify = $r->dsn_notify;
my $d;
if ($msginfo->sender eq '') {
$d = 'NEVER';
} elsif (!$dsn_notify) {
$d = 'DELAY,FAILURE'; # sorted
} else {
$d = uc(join(',', sort @$dsn_notify)); # normalize order
}
if (!defined($common_list)) { $common_list = $d }
elsif ($d ne $common_list) { $not_all_the_same = 1 }
}
if ($common_list=~/\bSUCCESS\b/ && c('terminate_dsn_on_notify_success')) {
# strip out option SUCCESS, we want to handle it locally
my(@dsn_notify) = grep($_ ne 'SUCCESS', split(/,/,$common_list));
@dsn_notify = ('NEVER') if !@dsn_notify;
$common_list = join(',',@dsn_notify);
do_log(3,"stripped out SUCCESS, result: NOTIFY=%s", $common_list);
}
if ($not_all_the_same || $msginfo->sender eq '') {} # leave at default
elsif ($common_list eq 'DELAY,FAILURE') {} # leave at default
else { unshift(@pipe_args, '-N', $common_list) }
unshift(@pipe_args,
'-V', $msginfo->dsn_envid) if defined $msginfo->dsn_envid;
# but there is no mechanism to specify ORCPT or RET
}
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 header section:
# Funny Dude <"funny user"@some.domain>
# Although addresses passed as args to sendmail submission program
# should not be <...> bracketed, for some reason original sendmail
# issues a warning on null reverse-path, but gladly accepts <>.
# As this is not strictly wrong, we comply to make it happy.
# NOTE: the -fsender is not allowed, -f and sender must be separate args!
my $null_ret_path = '<>'; # some sendmail lookalikes want '<>', others ''
# Courier sendmail accepts '' but not '<>' for null reverse path
if (/^\$\{sender\}\z/i) {
push(@command, $msginfo->sender eq '' ? $null_ret_path
: do { my $s = $msginfo->sender_smtp;
$s =~ s/^<//; $s =~ s/>\z//; untaint($s) });
} elsif (/^\$\{recipient\}\z/i) {
push(@command,
map { $_ eq '' ? $null_ret_path : untaint(quote_rfc2821_local($_)) }
map($_->recip_final_addr, @$per_recip_data_ref));
} else {
push(@command, $_);
}
}
ll(5) && do_log(5, "mail_via_pipe running command: %s", join(' ',@command));
local $SIG{CHLD} = 'DEFAULT';
local $SIG{PIPE} = 'IGNORE'; # don't signal on a write to a widowed pipe
my($proc_fh,$pid) = run_command_consumer(undef,undef,@command);
my $hdr_edits = $msginfo->header_edits;
$hdr_edits = Amavis::Out::EditHeader->new if !$hdr_edits;
my($received_cnt,$file_position) =
$hdr_edits->write_header($msginfo,$proc_fh,!$initial_submission);
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 ($received_cnt > 100) { # loop detection required by RFC 5321 section 6.3
# deal with it later, for now just skip the body
} elsif (!defined $msg) {
# empty mail
} elsif (ref $msg eq 'SCALAR') {
# do it in chunks, saves memory, cache friendly
while ($file_position < length($$msg)) {
$proc_fh->print(substr($$msg,$file_position,16384))
or die "writing mail text to a pipe failed: $!";
$file_position += 16384; # may overshoot, no problem
}
} elsif ($msg->isa('MIME::Entity')) {
$msg->print_body($proc_fh);
} else {
my($nbytes,$buff);
while (($nbytes = $msg->read($buff,32768)) > 0) {
$proc_fh->print($buff)
or die "writing mail text to a pipe failed: $!";
}
defined $nbytes or die "Error reading: $!";
}
$proc_fh->flush or die "Can't flush pipe to a mail submission program: $!";
my $smtp_response;
if ($received_cnt > 100) { # loop detection required by RFC 5321 section 6.3
do_log(-2, "Too many hops: %d 'Received:' header fields", $received_cnt);
kill_proc($pid,$command[0],10,$proc_fh,'too many hops') if defined $pid;
$proc_fh->close; undef $proc_fh; undef $pid; # and ignore status
$smtp_response = "554 5.4.6 Reject: " .
"Too many hops: $received_cnt 'Received:' header fields";
} else {
my $err = 0; $proc_fh->close or $err=$!;
my $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
undef $proc_fh; undef $pid;
# sendmail program (Postfix variant) can return the following exit codes:
# EX_OK(0), EX_DATAERR, EX_SOFTWARE, EX_TEMPFAIL, EX_NOUSER, EX_UNAVAILABLE
if (proc_status_ok($child_stat,$err, EX_OK)) {
$smtp_response = "250 2.6.0 Ok"; # submitted to MTA
snmp_count('OutMsgsDelivers');
my $size = $msginfo->msg_size;
snmp_count( ['OutMsgsSize'.$_, $size, 'C64'] ) for @snmp_vars;
} elsif (proc_status_ok($child_stat,$err, EX_TEMPFAIL)) {
$smtp_response = "450 4.5.0 Temporary failure submitting message";
snmp_count('OutMsgsAttemptFails');
} elsif (proc_status_ok($child_stat,$err, EX_NOUSER)) {
$smtp_response = "554 5.1.1 Recipient unknown";
snmp_count('OutMsgsRejects');
} elsif (proc_status_ok($child_stat,$err, EX_UNAVAILABLE)) {
$smtp_response = "554 5.5.0 Mail submission service unavailable";
snmp_count('OutMsgsRejects');
} else {
$smtp_response = "451 4.5.0 Failed to submit a message: ".
exit_status_str($child_stat,$err);
snmp_count('OutMsgsAttemptFails');
}
ll(3) && do_log(3,"mail_via_pipe %s, %s, %s", $command[0],
exit_status_str($child_stat,$err), $smtp_response);
}
$smtp_response .= ", id=" . $msginfo->log_id;
for my $r (@$per_recip_data_ref) {
next if $r->recip_done;
$r->recip_smtp_response($smtp_response); $r->recip_done(2);
$r->recip_mbxname($r->recip_final_addr) if $smtp_response =~ /^2/;
}
$msginfo->dsn_passed_on($dsn_capable && $smtp_response=~/^2/ &&
!c('terminate_dsn_on_notify_success') ? 1 : 0);
section_time('fwd-pipe');
1;
}
1;