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, "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
}