force bounce perl script (was: force bounce on a message from queue)

[jp-po...@blacktron.com]

Okay, so it looks like the feature isn't available and probably won't be
anytime soon. The whole transport thing doesn't appeal to me just because
I don't want to have a bunch of these entries crufting things up.

So I whipped up the following perl script. If you name it bouncemsg then
the usage should just be:

> bouncemsg queueid

It will generate a pretty crude bounce message and send it back to whoever
postfix lists as the errors_to address for the message. It will try to
pull the reason from the defer directory. Since I'm using this as part of
a system where a machine reads the bounce message, the crude one suffices.
You might want to fancy it up if these bounces are going to real users.

After sending the bounce message, it calls postsuper -d to remove the
message from the queue.

Let me state that I'm not a perl expert, so don't be surprised if you'd
write this code differently. Feel free to hack it to bits.

The only problem I forsee is the unavoidable timing issue. Postfix might
move the files around while the script is running. The chances of this
should be pretty slim, though.

Note that you might need to change the locations of the various programs.
They're all defined at the top to make this easier.

Hope this is useful. I also hope that the formatting will survive any
intermediate mail mangling. If it gets mangled, just post and I'll mail
it as an attachment (unless there's a rule against that for the mailing
list).

#!/usr/bin/perl -w

# Author: Jason Eric Pierce
# Date: 2002-12-23

my $postfixspool = '/var/spool/postfix';
my $sendmail = '/usr/sbin/sendmail';
my $postcat = '/usr/sbin/postcat';
my $postsuper = '/usr/sbin/postsuper';
my $cat = '/bin/cat';

my $queueid = shift || die "usage: bouncemsg queueid\n";
my $msg = '';
my $recipient = '';
my $body = '';
my $error = '';

my $errorfile = "$postfixspool/defer/" . substr($queueid, 0, 1) . '/' .
substr($queueid, 1, 1) . "/$queueid";
my $messagefile = "$postfixspool/deferred/" . substr($queueid, 0, 1) . '/'
. substr($queueid, 1, 1) . "/$queueid";

if (-e $messagefile) {
$msg = `$postcat $messagefile`;
}

$msg || die "Problem opening file $messagefile for queueid
$queueid.\nStopped";

if (-e $errorfile) {
$error = `$cat $errorfile`;
}

if ($msg =~ /\n\*\*\* MESSAGE CONTENTS.+\n((?:.*\n)+)\*\*\* HEADER
EXTRACTED.+\nreturn_receipt.+\nerrors_to: (.+)/) {

print "Sending bounce message...\n";
$body = $1;
$recipient = $2;

$body =~ s/\n\.\n/\n\.\.\n/g;
$error =~ s/\n\.\n/\n\.\.\n/g;

open(SENDMAIL, "|$sendmail -f \\<\\> $recipient");

print SENDMAIL << "MESSAGETEXT_BOUNCEMSG_END";
From: MAILER-DAEMON (Mail Delivery System)
Subject: Undelivered Mail Returned to Sender
To: $recipient

Message undeliverable.

Reason:

$error

Original message follows:

$body
MESSAGETEXT_BOUNCEMSG_END

print(SENDMAIL ".\n");
close(SENDMAIL);
print "Sent bounce message.\nDeleting message from queue...\n";

$delmsg = `$postsuper -d $queueid 2>&1`;
print "Output of postsuper -d $queueid:\n$delmsg\n";
if ($delmsg =~ /postsuper: $queueid: removed\npostsuper: Deleted: 1
message/) {
print "Deleted message from queue.\nAll done.\n\n";
}
else {
print "Problem deleting from the queue.\n";
}
}
else {
print "Could not parse contents of message for $queueid";
}