Viewing file:  autoreply.pl (3.2 KB) -rwxr-xr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl
# autoreply.pl
# Simple autoreply script
# read qmail module config
$p = -l $0 ? readlink($0) : $0;
$p =~ /^(.*)\/[^\/]+$/;
open(CONF, "$1/config") || die "Failed to open $1/config";
while(<CONF>) {
if (/^(\S+)=(.*)/) {
$config{$1} = $2;
}
}
close(CONF);
# read headers and body
while(<STDIN>) {
s/\r|\n//g;
if (/^(\S+):\s+(.*)/) {
$header{lc($1)} = $2;
}
elsif (!$_) { last; }
}
while(<STDIN>) {
$body .= $_;
}
if ($header{'x-webmin-autoreply'}) {
print STDERR "Cancelling autoreply to an autoreply\n";
exit 1;
}
if ($header{'x-mailing-list'} ||
$header{'list-id'} ||
$header{'precedence'} =~ /junk|bulk|list/i ||
$header{'to'} =~ /Multiple recipients of/i) {
# Do nothing if post is from a mailing list
exit 0;
}
if ($header{'from'} =~ /postmaster|mailer-daemon/i) {
# Do nothing if post is a bounce
exit 0;
}
# work out the correct to address
@to = ( &split_addresses($header{'to'}),
&split_addresses($header{'cc'}),
&split_addresses($header{'bcc'}) );
$to = $to[0]->[0];
foreach $t (@to) {
if ($t->[0] =~ /^([^\@\s]+)/ && $1 eq $ARGV[1]) {
$to = $t->[0];
}
}
# build list of default reply headers
$rheader{'From'} = $to;
$rheader{'To'} = $header{'reply-to'} ? $header{'reply-to'}
: $header{'from'};
$rheader{'Subject'} = "Autoreply to $header{'subject'}";
$rheader{'X-Webmin-Autoreply'} = 1;
$rheader{'X-Originally-To'} = $header{'to'};
# read the autoreply file
if (open(AUTO, $ARGV[0])) {
while(<AUTO>) {
s/\$SUBJECT/$header{'subject'}/g;
s/\$FROM/$header{'from'}/g;
s/\$TO/$to/g;
s/\$DATE/$header{'date'}/g;
s/\$BODY/$body/g;
if (/^(\S+):\s*(.*)/ && !$doneheaders) {
$rheader{$1} = $2;
}
else {
$rbody .= $_;
$doneheaders = 1;
}
}
close(AUTO);
}
else {
$rbody = "Failed to open autoreply file $ARGV[0] : $!";
}
# Open the replies tracking DBM, if one was set
if ($rheader{'Reply-Tracking'}) {
$track_replies = dbmopen(%replies, $rheader{'Reply-Tracking'}, 0700);
}
if ($track_replies) {
# See if we have replied to this address before
$period = $rheader{'Reply-Period'} || 60*60;
($from) = &split_addresses($header{'from'});
if ($from) {
$lasttime = $replies{$from->[0]};
$now = time();
if ($now < $lasttime+$period) {
# Autoreplied already in this period .. just halt
exit(0);
}
$replies{$from->[0]} = $now;
}
}
delete($rheader{'Reply-Tracking'});
delete($rheader{'Reply-Period'});
# run qmail and feed it the reply
open(MAIL, "|$config{'qmail_dir'}/bin/qmail-inject");
foreach $h (keys %rheader) {
print MAIL "$h: $rheader{$h}\n";
}
print MAIL "\n";
print MAIL $rbody;
close(MAIL);
# split_addresses(string)
# Splits a comma-separated list of addresses into [ email, real-name ] pairs
sub split_addresses
{
local (@rv, $str = $_[0]);
while(1) {
if ($str =~ /^[\s,]*(([^<>\(\)\s]+)\s+\(([^\(\)]+)\))(.*)$/) {
push(@rv, [ $2, $3, $1 ]);
$str = $4;
}
elsif ($str =~ /^[\s,]*("([^"]+)"\s+<([^\s<>]+)>)(.*)$/ ||
$str =~ /^[\s,]*(([^<>]+)\s+<([^\s<>]+)>)(.*)$/ ||
$str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||
$str =~ /^[\s,]*(()<([^\s<>]+)>)(.*)/ ||
$str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {
push(@rv, [ $3, $2, $1 ]);
$str = $4;
}
else {
last;
}
}
return @rv;
}
|