qpsmtpd/plugins/queue/qmail-queue

#!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, "WARNING: 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();

    ! defined $child and die "Could not fork";

    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");
    }
    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(LOGERROR, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument");
# This exit is ok as we're exiting a forked child process.
            exit 3;
        }

# 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
    }
}