qpsmtpd/plugins/queue/qmail-queue

# -*- perl -*-
=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 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);
  }
  else {
    $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();

  not 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 qp $$ 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
  }
}