bcaf58471e
Fix error handling in queue/qmail-queue. Add option to queue/qmail-queue to specify an alternate qmail-queue location. Add support for the QMAILQUEUE environment variable. PPerl compatibility (yay!) git-svn-id: https://svn.perl.org/qpsmtpd/trunk@110 958fd67b-6ff1-0310-b445-bb7760255be9
108 lines
3.0 KiB
Plaintext
108 lines
3.0 KiB
Plaintext
=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
|
|
|
|
sub register {
|
|
my ($self, $qp, @args) = @_;
|
|
$self->register_hook("queue", "queue_handler");
|
|
|
|
if (@args > 0) {
|
|
$self->{_queue_exec} = $args[0];
|
|
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
|
} else {
|
|
$self->{_queue_exec} = "/var/qmail/bin/qmail-queue";
|
|
}
|
|
|
|
$self->{_queue_exec} = $ENV{QMAILQUEUE} if $ENV{QMAILQUEUE};
|
|
|
|
}
|
|
|
|
sub queue_handler {
|
|
my ($self, $transaction) = @_;
|
|
|
|
# these bits inspired by Peter Samuels "qmail-queue wrapper"
|
|
pipe(MESSAGE_READER, MESSAGE_WRITER) or fault("Could not create message pipe"), exit;
|
|
pipe(ENVELOPE_READER, ENVELOPE_WRITER) or fault("Could not create envelope pipe"), exit;
|
|
|
|
my $child = fork();
|
|
|
|
not defined $child and fault(451, "Could not fork"), exit;
|
|
|
|
if ($child) {
|
|
# Parent
|
|
my $oldfh = select(MESSAGE_WRITER); $| = 1;
|
|
select(ENVELOPE_WRITER); $| = 1;
|
|
select($oldfh);
|
|
|
|
close MESSAGE_READER or fault("close msg reader fault"),exit;
|
|
close ENVELOPE_READER or fault("close envelope reader fault"), exit;
|
|
|
|
$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)");
|
|
return (OK, "Queued!");
|
|
}
|
|
elsif (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(1, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument");
|
|
exit 3;
|
|
}
|
|
|
|
# save the original STDIN and STDOUT
|
|
open(SAVE_STDIN, "<&STDIN");
|
|
open(SAVE_STDOUT, ">&STDOUT");
|
|
|
|
# what are those exit values for? Why don't we die with a useful error message?
|
|
open(STDIN, "<&MESSAGE_READER") or exit 4;
|
|
open(STDOUT, "<&ENVELOPE_READER") or exit 5;
|
|
|
|
$self->log(7, "Queuing to $queue_exec");
|
|
|
|
my $rc = exec $queue_exec;
|
|
|
|
# restore the original STDIN and STDOUT
|
|
open(STDIN, "<&SAVE_STDIN");
|
|
open(STDOUT, ">&SAVE_STDOUT");
|
|
|
|
exit 6 if not $rc;
|
|
}
|
|
}
|