|
#!/usr/bin/perl
|
|
|
|
require Mail::Internet;
|
|
|
|
# We'll need Mail::Address to extract the
|
|
# return address from the incoming message
|
|
|
|
require Mail::Address;
|
|
|
|
# Since we're running as a filter, the
|
|
# incoming message will be available from
|
|
# STDIN:
|
|
|
|
$mail = Mail::Internet->new( \*STDIN );
|
|
|
|
# Create an empty Mail::Internet object
|
|
# for our reply
|
|
|
|
$reply = Mail::Internet->new();
|
|
|
|
# Locate address of sender. The get()
|
|
# method returns the header line from the
|
|
# message, or undef if it doesn't exist.
|
|
|
|
$sender = $mail->get('Reply-To') ||
|
|
$mail->get('From');
|
|
|
|
# Create a Mail::Address object
|
|
|
|
# Mail::Address->parse returns a list of
|
|
|
|
# objects. We probably want the first.
|
|
|
|
|
|
$sender = (Mail::Address->parse($sender))[0];
|
|
|
|
|
|
# Create a To header on our reply message
|
|
|
|
# which contains the senders address
|
|
|
|
|
|
$reply->add(To => $sender->format);
|
|
|
|
# Extract the Subject from the original
|
|
# message
|
|
|
|
$subject = $mail->get('Subject');
|
|
|
|
if ($subject) {
|
|
|
|
# Add Re: prefix
|
|
$subject = 'Re: ' . $subject
|
|
unless $subject =~ /^\s*Re:/i;
|
|
|
|
# Set the Subject line on our new message
|
|
|
|
$reply->add(Subject => $subject);
|
|
}
|
|
|
|
# Extract the References and Message-Id from
|
|
# the original message
|
|
|
|
$ref = $mail->get('References') || '';
|
|
$mid = $mail->get('Message-Id');
|
|
|
|
# Combine them to create our new
|
|
# References line
|
|
|
|
$ref .= ' ' . $mid if $mid;
|
|
|
|
# Add our new References line to our
|
|
# reply message
|
|
|
|
$reply->add(References => $ref)
|
|
if length $ref;
|
|
|
|
|
|
# Create an array containing reply text
|
|
|
|
@reply = ("This is a recorded message",
|
|
"I am away from my machine at the moment",
|
|
"and will reply to your message",
|
|
"as soon as I return");
|
|
|
|
# Add the body to the reply message
|
|
|
|
$reply->body( \@reply );
|
|
|
|
|
|
# Open a pipe to /usr/lib/sendmail. -t tells
|
|
|
|
# sendmail to scan the input for To, Cc, and
|
|
|
|
# Bcc headers, and extract the mail addresses.
|
|
|
|
|
|
open(MAIL, "|/usr/lib/sendmail -t")
|
|
|
|
|| die "Can't send mail: $!";
|
|
|
|
|
|
# print the message down the pipe
|
|
|
|
# (i.e.: send the message to sendmail)
|
|
|
|
|
|
$reply->print( \*MAIL );
|
|
|
|
|
|
close(MAIL);
|