=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;
  }
}