58 lines
1.8 KiB
Plaintext
58 lines
1.8 KiB
Plaintext
|
|
||
|
sub register {
|
||
|
my ($self, $qp) = @_;
|
||
|
$self->register_hook("queue", "queue_handler");
|
||
|
}
|
||
|
|
||
|
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 die "could not close message writer in parent";
|
||
|
close ENVELOPE_WRITER or die "could not close envelope writer in parent";
|
||
|
|
||
|
open(STDIN, "<&MESSAGE_READER") or die "b1";
|
||
|
open(STDOUT, "<&ENVELOPE_READER") or die "b2";
|
||
|
|
||
|
unless (exec '/var/qmail/bin/qmail-queue') {
|
||
|
return (DECLINED, "fatal error spawning qmail-queue");
|
||
|
}
|
||
|
}
|
||
|
}
|