125 lines
3.5 KiB
Perl
125 lines
3.5 KiB
Perl
#!perl -w
|
|
|
|
=head1 NAME
|
|
|
|
qmail-queue
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This is the most common plugin used to queue incoming mails. A
|
|
variation of this plugin would maybe forward the mail via smtp.
|
|
|
|
=head1 CONFIG
|
|
|
|
It takes one optional parameter, the location of qmail-queue. This
|
|
makes it easy to use a qmail-queue replacement.
|
|
|
|
queue/qmail-queue /var/qmail/bin/another-qmail-queue
|
|
|
|
If set the environment variable QMAILQUEUE overrides this setting.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
#use warnings;
|
|
|
|
use Qpsmtpd::Constants;
|
|
use POSIX ();
|
|
|
|
sub register {
|
|
my ($self, $qp, @args) = @_;
|
|
|
|
if (@args > 0) {
|
|
$self->{_queue_exec} = $args[0];
|
|
$self->log(LOGWARN, "Ignoring additional arguments.") if @args > 1;
|
|
}
|
|
|
|
$self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue";
|
|
$self->{_queue_exec} = $ENV{QMAILQUEUE} if $ENV{QMAILQUEUE};
|
|
}
|
|
|
|
sub hook_queue {
|
|
my ($self, $transaction) = @_;
|
|
|
|
# these bits inspired by Peter Samuels "qmail-queue wrapper"
|
|
pipe(MESSAGE_READER, MESSAGE_WRITER) or die "Could not create message pipe";
|
|
pipe(ENVELOPE_READER, ENVELOPE_WRITER)
|
|
or die "Could not create envelope pipe";
|
|
|
|
local $SIG{PIPE} = sub { die 'SIGPIPE' };
|
|
my $child = fork();
|
|
die "Could not fork" if !defined $child;
|
|
|
|
if ($child) {
|
|
|
|
# Parent
|
|
my $oldfh = select MESSAGE_WRITER;
|
|
$| = 1;
|
|
select ENVELOPE_WRITER;
|
|
$| = 1;
|
|
select $oldfh;
|
|
|
|
close MESSAGE_READER or die "close msg reader fault";
|
|
close ENVELOPE_READER or die "close envelope reader fault";
|
|
|
|
$transaction->header->print(\*MESSAGE_WRITER);
|
|
$transaction->body_resetpos;
|
|
while (my $line = $transaction->body_getline) {
|
|
print MESSAGE_WRITER $line;
|
|
}
|
|
close MESSAGE_WRITER;
|
|
|
|
my @rcpt = map { "T" . $_->address } $transaction->recipients;
|
|
my $from = "F" . ($transaction->sender->address || "");
|
|
print ENVELOPE_WRITER "$from\0", join("\0", @rcpt), "\0\0"
|
|
or return DECLINED, "Could not print addresses to queue";
|
|
|
|
close ENVELOPE_WRITER;
|
|
waitpid($child, 0);
|
|
my $exit_code = $? >> 8;
|
|
$exit_code
|
|
and return DECLINED, "Unable to queue message ($exit_code)";
|
|
|
|
my $msg_id = $transaction->header->get('Message-Id') || '';
|
|
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here
|
|
$msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s
|
|
return OK, "Queued! " . time . " qp $child $msg_id";
|
|
}
|
|
|
|
return if !defined $child;
|
|
|
|
# Child
|
|
close MESSAGE_WRITER or exit 1;
|
|
close ENVELOPE_WRITER or exit 2;
|
|
|
|
# Untaint $self->{_queue_exec}
|
|
my $queue_exec = $self->{_queue_exec};
|
|
if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
|
|
$queue_exec = $1;
|
|
}
|
|
else {
|
|
$self->log(LOGERROR, "FATAL: Unexpected characters in plugin argument");
|
|
exit 3; # exiting the forked child process.
|
|
}
|
|
|
|
# save the original STDIN and STDOUT in case exec() fails below
|
|
open(SAVE_STDIN, "<&STDIN");
|
|
open(SAVE_STDOUT, ">&STDOUT");
|
|
|
|
POSIX::dup2(fileno(MESSAGE_READER), 0)
|
|
or die "Unable to dup MESSAGE_READER: $!";
|
|
POSIX::dup2(fileno(ENVELOPE_READER), 1)
|
|
or die "Unable to dup ENVELOPE_READER: $!";
|
|
|
|
my $ppid = getppid();
|
|
$self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec");
|
|
|
|
my $rc = exec $queue_exec;
|
|
|
|
# close the pipe
|
|
close(MESSAGE_READER);
|
|
close(MESSAGE_WRITER);
|
|
|
|
exit 6; # we'll only get here if the exec fails
|
|
}
|