#!/usr/local/bin/perl
# $Id: AR,v 1.33 2015/03/12 15:56:44 alan Exp $
# 
# AR
# pair Autoresponder
#
# Usage:
#   AR (ignored) username address domain filename
#
# The script requires 5 parameters, but the first parameter is
# currently not used for any purpose.  It is best to send a "0" as the
# value for this parameter.


use strict;
use Date::Format;
use Date::Range;
use Date::Simple;
use Mail::Address;

use Fcntl;   # For O_RDWR, O_CREAT, etc.
use NDBM_File;
use Getopt::Long;
use Pod::Usage;

my @LOOP_HEADERS = qw(X-Loop    Mailing-List   X-Mailing-List 
                      List-Help List-Subscribe Auto-Submitted);
my @IGNORE_PRECEDENCE = qw(junk bulk list);
my $SECONDS_IN_DAY = 86400;
my $START_TIME = time();
our $DB = undef;

my %O = (
    limit => 0,
    limit_db => '.autoresponder',
    limit_rate => 1,
);

my $result = GetOptions(\%O, "limit!", "limit_db|limit-db=s",
    "limit_rate|limit-rate=f", 'start_date|start-date=s',
    'end_date|end-date=s')
    or pod2usage();

if (@ARGV < 5) { 
    warn "bad call to AR [@ARGV]"; 
    exit(111);
}
my ($junk, $uname, $addr, $dom, $fn) = @ARGV;
$dom =~ s/:/./g;
$addr ||= 'autoresponder'; 

$fn = "/usr/home/$uname/$fn" unless $fn =~ m#^/#;
my $use_stock = 0;
if (-d $fn || (! -r $fn)) { 
    warn "file $fn nonexistent or unreadable. Using stock reply"; 
    $use_stock = 1;
}

# Read the message we're responding to from STDIN. We ignore everything
# other than header lines, and we're currently not supporting multi-line
# headers.
my (%hdr);
while (<STDIN>) {
    chomp;
    last if $_ eq "";
    if (/^([A-Z][A-Za-z0-9\-]+):?\s+(.*)$/) { 
        $hdr{lc($1)} = $2; 
    }
}
while (<STDIN>) {}

# check for loops
for my $header (@LOOP_HEADERS) { exit(0) if defined($hdr{lc($header)}) }

# Check precedence
for my $p (@IGNORE_PRECEDENCE) {
    exit(0) if $hdr{precedence} =~ /$p/i;
}

# Find reply-to address. (return-path will be env sender if preline was
# invoked)
my $rep = $hdr{'mail-reply-to'} || $hdr{'reply-to'} ||
          $hdr{'from'}          || $hdr{'return-path'}; 

# Match an e-mail address spec out of the reply-to result we got, or
# exit.  Reply to all addresses, since some customers expect this.
# Note Mail::Address doesn't know mail address group format.

my @addresses = Mail::Address->parse($rep) or exit 0;
for my $ad (@addresses) { exit(0) if $ad->address eq "$addr\@$dom" }
$rep = join ", ", map {$_->address} @addresses;

exit 0 unless $rep; # exit, but pretend the message was sent 

# stripped down version of Alan's stripped-down version
# of procmail's FROM_MAILER :) - 2/7/01 MPR
exit 0 if $rep =~ /(postmaster|
                    (sendmail|mailer-daemon)|
                    (root|daemon)|
                    m(ajordomo|ailman)|
                    list(serv|proc)|
                    b(ounce|bs\.smtp)|
                    s(erv(ices?|er)|mtp(error)?|ystem)|
                    a(dmin(istrator)?|utoanswer))
                    .*\@ # match must be before @
                    /ix; # exit, but pretend message sent 

verify_date_range();
# Verify and update the response rate limit only when we plan to respond.
# Thanks, David!
verify_limit($rep);

my $from = "Autoresponder <$addr\@$dom>";
my $subj = 'Re: ' . ($hdr{subject} || "your mail");
my $reply;

if ( $use_stock ) {
    *F2 = *DATA;
} else {
    open(F2, "<$fn");
}

# The first three lines of the message may contain header information.
# If so, extract this info and skip those lines; otherwise call them
# responder body info and print them later.

my @body;
for (1..3) {
    $_ = <F2>;
    if (/^From:\s*(.*)/) {
        $from = $1;
    } elsif (/^Subject:\s*(.*)/) {
        $subj = $1;
    } elsif (/^Reply-To:\s*(.*)/i) {
        $reply = $1;
    } else {
        push @body, $_;
    }
}

# Default here to catch any customer changes.
$reply = $from if !$reply;

## Add the datestamp, now RFC2822 compliant
my $datestring = time2str( "%e %b %Y %T %z", $START_TIME );

# Tell qmail to use correct envelope headers
# If we have a sane looking reply-to, use that; otherwise, use the recipe address.
if (my ($user, $host) = $reply =~ /([a-z0-9\_\.]{1,128})@([a-z0-9\.\-]+\.[a-z0-9\-]+)/i) {
    $ENV{QMAILSHOST} = $host;
    $ENV{QMAILSUSER} = $user;
} else {  
    $ENV{QMAILSHOST} = $dom;
    $ENV{QMAILSUSER} = $addr;
}

open F1, "|/usr/sbin/sendmail -oi -t" or exit(111); # soft error
print F1 <<END;
From: $from
To: $rep
Date: $datestring
Precedence: junk
Subject: $subj
Reply-To: $reply
X-Loop: $addr\@$dom
Auto-Submitted: auto-replied
MIME-Version: 1.0
Content-type: text/plain; charset=UTF-8

END

print F1 @body;

while (<F2>) { 
    print F1 $_; 
}

close(F1);
close(F2);

exit(0);

# Check to see if we've already responded to them within the configured
# window. If we haven't, record that we're about to respond.
sub verify_limit {
    my $from = shift;

    return unless $O{limit};

    $O{limit_db} = "$ENV{HOME}/$O{limit_db}"
        unless $O{limit_db} =~ /^\//;
    db_init();
    my $last_time = db_get($from) || 0;
    if (($START_TIME - $last_time) < ($SECONDS_IN_DAY * $O{limit_rate})) {
        # silently do nothing
        exit 0;
    }
    # otherwise, update the db timestamp to now, adduming we will send the reply.
    db_set($from, $START_TIME);
    db_close();
}

# If a date range is specified, check to see if we are in the proper
# range to respond. If not, exit.
#
# If either date is invalid, we skip the date range check. This ensures
# mail delivery continues in the face of error, and that the customer
# will notice the autoresponder if it is applied inappropriately.

sub verify_date_range {
    if ($O{start_date} xor $O{end_date}) {
        pod2usage("Need to give both --start-date and --end-date");
    }

    return unless ($O{start_date} && $O{end_date});

    my $start = get_date($O{start_date}) or return;
    my $end = get_date($O{end_date}) or return;
    my $range = Date::Range->new($start, $end);

    my $today = Date::Simple::today();

    unless ($range->includes($today)) {
        # silently do nothing
        exit 0;
    }
}

sub get_date {
    my $date = shift;
    my ($y, $m, $d) = split /-/, $date or return;
    return Date::Simple::ymd($y, $m, $d);
}

# initialize the database object. stores it in the $DB global.
sub db_init {
    $DB = {};
    tie %$DB, 'NDBM_File', $O{limit_db}, O_RDWR|O_CREAT, 0600
        or die "Couldn't open autoresponder_db: $!";
}

# retrieve value for the given key from the DB.
sub db_get {
    my ($k) = @_;
    $DB->{$k};
}

# store the given key and value in the db.
sub db_set {
    my ($k, $v) = @_;
    $DB->{$k} = $v;
}

# close the db object associated with the $DB global
sub db_close {
    untie %$DB;
}

=head1 NAME

AR - pair email autoresponder

=head1 SYNOPSIS

  AR [options] <unused> <username> <address> <domain> <filename>
  
  Options:
    --limit             Enable rate limiting.
    --limit_db FILE     Rate limiting database file. Defaults to
                        ~/.autoresponder (.db extension is automatically
                        added)
    --limit_rate N      Number of days to wait between sending auto
                        responses to the same address.

    --start_date DATE
    --end_date DATE     Gives a date range between which this
                        autoresponder should respond. Outside of that
                        date range, AR just exists with 0 (success),
                        similar to when it is rate limited.

=cut

__DATA__
Hello,

This response is being generated automatically to acknowledge delivery of your
message.