邮件自动回复.txt

邮件自动回复系统 可广泛用于重要通知回复的确认等等需要自动回复的情况

#!/usr/bin/perl -w
use strict;
use Net::SMTP;
#use Authen::SASL;
use MIME::Base64 ();
use MIME::QuotedPrint ();
use constant HOST => '*.*.*.*';

# 
#
# usage: 
# autoreply.pl %S %R "%T"
# %S is Sender's Email
# %R is Receiver's Email
# %T is Sender's Subject
#
# usage:
# autoreply.pl "%F"
# %F is full path to mail file name



my (%receiver, %password, @lines, @mails, %account, %homepage, @homepages,
%returnad);
chomp (@lines = <DATA>);
!/^#/ and /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)/
    and $account{$1}  = $2
    and $password{$1} = $3
    and $returnad{$1} = $4
    and $homepage{$1} = $5
    and $receiver{$1} = $6
    foreach (@lines);
#print join "\t", keys %receiver, "\n";
#print join "\t", values %receiver, "\n";

#dirct parse mail file now, see below
#my ($remoteacc, $localacc, @oldsubject) = map $_ || '', @ARGV;
# I find special char in address which must be removed.
#$remoteacc =~ s/[|<>\s]//g;
# I find MIME encoded strings in subject, must be decoded
#my $oldsubject = decodeMIME(join ' ', @oldsubject);

# parsing mail file
my ($mailfile) = map $_ || '', @ARGV;
open MAIL ,"$mailfile" or die "Can't open $mailfile for read.\n";
chomp (@lines = reverse <MAIL>);
my ($remoteacc, $localacc, $oldsubject);
foreach (@lines) {
    $remoteacc = $1  if /^From: (.*)/;
    $localacc = $1   if /^To: (.*)/;
    $oldsubject = $1 if /^Subject: (.*)/
}

foreach ($remoteacc, $localacc) {
    s/.*<//;
    s/>.*//;
    s/ //g;
}
$oldsubject = decodeMIME($oldsubject);

#
foreach (keys %receiver) {
    next unless $localacc =~ /$_/i;
    push @mails,
        $localacc,
        $returnad{$_} eq '-' ? $localacc : $returnad{$_},
        $account{$_},
        $password{$_},
        $remoteacc,
        makeNewSubject($receiver{$_}, $oldsubject)
        unless $remoteacc =~ /\.homeftp\.org/i
            or $remoteacc =~ /\.almostmy\.com/i; # avoid self-bouncing
    push @homepages,
        $homepage{$_},
        $localacc,
        $remoteacc,
        $oldsubject,
        time
        unless $homepage{$_} eq '-';
}

# Lock or Sleep
use Fcntl;
my $lockfile = "$0.lockfile";

# The lockfile needn't be unlinked. It's always closed when
# autoreply.pl terminated, either normally or by exception.
while (1) {
    unlink $lockfile;
    last if sysopen(LOCKFILE, $lockfile, O_WRONLY | O_EXCL | O_CREAT);
    warn "Another instance already running! Wait a while.\n";
    sleep 3 + int rand 5;
}

# Update webpages
my ($homepage, $time);
while (($homepage, $localacc, $remoteacc, $oldsubject, $time)
    = splice @homepages, 0, 5) {
    createEmptyHomepageFile($homepage, $localacc) unless -e $homepage;
    updateHomepageFile($homepage, $remoteacc, $oldsubject, $time);
}
# Send auto-reply mails
exit 0 unless @mails;

my $smtp = Net::SMTP->new(HOST) or die "Can't connect to " . HOST;
my ($account, $password, $subject, $sender);
while (($localacc, $sender, $account, $password, $remoteacc, $subject)
    = splice @mails, 0, 6) {
    $smtp->auth($account, $password) unless $password eq '-';
    $smtp->mail($sender);
    $smtp->recipient($remoteacc);
    $smtp->data();
    $smtp->datasend(
        "From:$sender\n",
        "To:$remoteacc\n",
        "Subject:$subject\n",
        );
    $smtp->datasend("Your email send to $localacc was received.\n");
    $smtp->datasend("      <<<Important Notice>>>\n",
            "We're shifting to $sender\n",
            "       instead of $localacc\n",
            "       to avoid some DNS problem.\n",
            "Please update your address book.\n  \n")
        if uc $sender ne uc $localacc;
    $smtp->datasend("Send by autoreply.pl, don't reply this mail.\n");
    $smtp->dataend;
}
$smtp->quit;

print join "\t", @mails;
1;

sub decodeMIME {
    my $s = shift;
    # e.g. =?ISO-8859-1?q?....?=
    $s =~ s/=\?([-A-Z0-9_]+)\?q\?(.*)\?=/MIME::QuotedPrint::decode($2)/ige;
    # e.g. =?gb2312?b?....?=
    $s =~ s/=\?([-A-Z0-9_]+)\?b\?(.*)\?=/MIME::Base64::decode($2)/ige;
    # return
    $s
}

sub updateHomepageFile {
    my ($file, $account, $subject, $time, $line) = @_;
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time);
    open F, "$file" or return 0;
    my @lines = <F>;
    close F;
    $year += 1900;
    $mon += 1;
    $subject =~ s/ /&nbsp/g;
    $line = sprintf "<tr><td>$account</td><td>$year-$mon-$mday
%02d:%02d:%02d</td>\
        <td>$subject</td></tr>\n", $hour, $min, $sec;
    splice @lines, 6, 0, $line;
#   print "insert $line";
    open F, ">$file" or return 0;
    print F @lines;
    close F;
}

sub createEmptyHomepageFile {
    my ($file, $account) = @_;
    #print "create $file\n";
    open F, ">$file" or return 0;
    print "created\n";
    print F << "HERE";
<html><head><title>Autoreply Records for "$account"</title>
<meta http-equiv="Content-Type" content="text/html;
charset=gb2312"></head><body bgcolor=#E0E0FF>
<h3>$account 的邮件自动答复记录表</h3>
<table border=1>
<tr><td>发件人</td><td>时间戳</td><td>主题</td></tr>
<!--Insert new records after this line, line 6-->
</table>
</body>

HERE
    close F;
}

sub makeNewSubject {
    my($subject, $olds) = @_;
    $subject =~ s/%T/$olds/g;
    $subject;
}

__END__
#RE_pattern_for_receiver     account  password(opt) return_sender
web_page_to_update(not allow space)     Subject_of_reply_mail
^homework\@xfzhou\.homeftp\.org$ homework   -   -
/webhome/courses/home/perl07/homework.htm Got mail : %T
^homework\@xfzhou\.almostmy\.com$ homework  -   -
/webhome/courses/home/perl07/homework.htm Got mail : %T