#!/usr/local/bin/perl

# vacation
#   An e-mail auto-responder
#     Loosely based on the original by Larry Wall and Tom Christiansen
#     Designed to emulate most vacation clones and specifically, the Sun version
#
#   09/28/2007 Version 1.1.9b2
#   Use and distribute this script as per the Artistic License
#   Copyright (C) 2007 Igor S. Livshits <mailto:vacation@ayradyss.org>
#     (with permission from Larry Wall and Tom Christiansen)


# Define some global variables
#
my $me= $0 or "vacation";       # this program's path or name
my $true= (1==1);
my $false= (1==0);
my $forwardFile= ".forward";    # name of the mail forward file
my $dataFilePrefix= ".vacation"; # prefix for my data files
my $messageFileSuffix= ".msg";  # suffix for the reply message file
my $logFileSuffix= ".log";      # suffix for the log file
my $oldSuffix= ".old";          # suffix for copies
my $editor= $ENV{'VISUAL'} || $ENV{'EDITOR'} || 'vi';
my $pager= $ENV{'PAGER'} || 'more';
my $directoryDelimiter= "/";    # Unix directory delimiter
my $myTag= "# automatically created by the Vacation program";
my $versionString= "vacation 1.1.9\n"
  . "<http://www.ayradyss.org/programs/current.html#vacation>";

# Define libraries and modules
#
use strict;
use Getopt::Long;               # command line options processor
use Sys::Syslog qw(:DEFAULT setlogsock); # interface to syslogd


# Parse options and initialize
#
my $interactive= $false;        # mode flag
my $quiet= $false;              # how chatty should I be?
my $ignoreRecipient= $false;    # should I match the recipient?
my $ignoreFile= undef;          # should I read exclusions from a file?
my $only= $false;               # treat exclusions as inclusions
my @aliases= ();                # a list of aliases for the recipient
my $silenceInterval= undef;     # how long to ignore the same sender
my $senderAlias= undef;         # alternate sender address
my $fromName= undef;            # customized From: line name
my $senderMailer= undef;        # my mail gateway
my $spamTag= undef;             # optional spam tag to find in the Subject: line
my $log= $false;                # should I log my decisions?
my $debug= $false;              # should I provide debugging information
my $pretend= $false;            # should I actually send the response?
my $syslogSocketUnix= $false;   # should I force a Unix Syslog socket?
my $version= $false;            # should I trigger version mode?
my $help= $false;               # should I trigger help mode?

if (@ARGV)
{                               # we have command-line options
  GetOptions("i|I|interactive" => \$interactive,
             "q|quiet" => \$quiet,
             "j" => \$ignoreRecipient,
             "f|file|ignore=s" => \$ignoreFile,
             "a|alias=s" => \@aliases,
             "o|only" => \$only,
             "t|time=s" =>\$silenceInterval,
             "s|sender=s" => \$senderAlias,
             "n|name=s" => \$fromName,
             "m|mailer=s" => \$senderMailer,
             "spam=s" => \$spamTag,
             "l|log" => \$log,
             "d|debug" => \$debug,
             "p|pretend" => \$pretend,
             "u|unix" => \$syslogSocketUnix,
             "v|V|version" => \$version,
             "h|help" => \$help
             );
  $interactive= $true           # quiet mode implies interactive mode
    if $quiet;
}
else
{                               # no options, trigger interactive mode
  $interactive= $true;
  $quiet= $false;
}

unless ($interactive)           # use the syslog daemon to echo messages
{                               #  in auto mode
  setlogsock('unix') if $syslogSocketUnix;
  openlog('vacation', 'pid', 'mail');
}

if ($debug)
{                               # dump some debugging info
  if ($interactive)
  {
    print "Initialized: ready for interactive mode\n";
  }
  elsif ($help)
  {
    print "Initialized: ready for help mode.\n";
  }
  elsif ($version)
  {
    print "Initialized: ready for version mode.\n";
  }
  else
  {
    syslog('debug', "Initialized: entering automatic mode.");
    syslog('debug', "Will not send the message due to set pretend flag.")
      if $pretend;
  }

  if (@ARGV and ($interactive or $help or $version))
  {                             # extraneous arguments
    die "\nI do not know what to do with the extraneous arguments:\n",
    "\t", join(" ", @ARGV), "\n\n",
    "Usage: vacation [interactive mode]\n",
    "Usage: vacation -h [terse help mode]\n",
    "Usage: vacation -t 3d -a alias1 -a alias2 user [automatic mode]\n";
  }
}


# Switch modes as appropriate
#
if ($interactive)
{                               # interactive mode overrides all else
  Interact();
}
elsif ($help)
{                               # help mode takes next precedence
  Help();
}
elsif ($version)
{                               # version mode takes next precedence
  Version();
}
else
{                               # automatic mode
  Log(AutoReply());
}

closelog unless $interactive;   # close the syslog daemon socket
exit;


#
# Subroutines
#

# Interact
#
# Interactively set up forwarding information
#
sub Interact
{
  my $home= $ENV{'HOME'};       # home directory
  my $user= $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];

  print "\nWithin Interact...\n" if $debug;

  print "\tInvoker's name= $user\n",
  "\tEditor= $editor\n",
  "\tPager= $pager\n",
  "\tHome= $home\n",
  "\tDefault message:\n",
  DefaultMessage(),
  "\n\n"
    if $debug;

  system("clear") unless $debug;
  print "\tWelcome to Vacation Interactive Setup\n",
  "\n",
  "Please answer the questions and follow the prompts to configure\n",
  "automatic mail responses to your correspondents.\n" unless $quiet;

  unless ($home)
  {                             # try another way
    chdir or die "Could not cd to $user\'s home directory: $!\n";
    chop($home= `pwd`);
    print "Changed to $user\'s home directory <$home>\n" if $debug;
  }

  $home.= $directoryDelimiter unless $home=~ /$directoryDelimiter$/;
  unless ((-T $home.$forwardFile) and Disable($home))
  {
    SetMessage($home);
    SetForwarding($home, $user);
  }
}


# Help
#
# Display terse help information
#
sub Help
{
  print "\nWithin Help...\n" if $debug;

  system("perldoc $me")
    and die "Problems accessing perldoc... Try the following line at the prompt:\n",
    "perldoc $me";
}


# Version
#
# Display terse version information
#
sub Version
{
  print "\nWithin Version...\n" if $debug;

  print "\n$versionString\n\n";
}


#
# Reply to the incoming message
#
sub AutoReply
{
  my $header= undef;            # the message header
  my $from= undef;              # individual header line values
  my $subject= undef;           # the subject line
  my $replyTo= undef;           # the reply-to header
  my $to= undef;                # the to address
  my $cc= undef;                # the carbon copy recipients
  my $sender= undef;            # temporary storage
  my $when= undef;              # the time of the last message from the current sender
  my $username= pop(@ARGV);     # last remaining argument must be the username
  my $replyResult= undef;       # outcome of our reply attempt
  my $value= undef;             # temporary values
  my $interval= 0;              # current silence interval
  my @ignoreSenders= ();        # a list of senders to ignore (or explicitly include)

  die "I cannot proceed in automatic mode without a user's name!"
    unless $username;

  my %scale= (                  # set up time scale for silence period calculations
                's', 1,
                'm', 60,
                'h', 60 * 60,
                'd', 24 * 60 * 60,
                'w', 7 * 24 * 60 * 60,
             );
  $silenceInterval= "1w"        # default to one week
    unless $silenceInterval;
  while ($silenceInterval=~ s/^(\d+)([smhdw])?//)
  {                             # convert the aging period to seconds
    $value= $1;
    $value*= $scale{$2} if $2;  # use an appropriate multiplier, if any
    $interval+= $value;
  }
  $silenceInterval= $interval;
  
  @ignoreSenders= (             # set up senders to ignore (likely non-human)
                        'daemon', 
                        'postmaster', 
                        'mailer-daemon', 
                        'mailer',
                        'root',
                        '-request@',
                     )
    unless $only;               # but only if we respond to everyone by default
  push(@ignoreSenders, $username."\@".$senderMailer) if ($senderMailer and !$only);
  push(@ignoreSenders, $username."\@localhost") unless $only;
  push(@ignoreSenders, ReadIgnoredSenders())
    if ($ignoreFile);           # read additional senders to ignore (or include)

  push(@aliases, $username);    # identity

  $fromName=                    # set the default custom from: line name
    "via the Vacation auto-responder" unless $fromName;

  if ($debug)
  {                             # dump current settings
    syslog('debug', "Within AutoReply");
    syslog('debug', "User's name: $username");
    syslog('debug', "Custom name: $fromName");
    syslog('debug', "Silence period: $silenceInterval seconds");
    syslog('debug', join(" ", "Ignored senders:", @ignoreSenders)) unless $only;
    syslog('debug', join(" ", "Included senders:", @ignoreSenders)) if $only;
    syslog('debug', join(" ", "Aliases:", @aliases));
    syslog('debug', "I will not check for a recipient")
      if $ignoreRecipient;
    syslog('debug', join(" ", "Ignoring extraneous options:", @ARGV))
      if @ARGV; 
  }

  # Grab and process the incoming message header
  $/= '';                       # paragraph mode
  $header= <STDIN>;             # grab the header from STDIN
  $header=~ s/\n\s+/ /g;        # fix continuation lines
  while(<STDIN>) {};            # exhaust the input buffer (so as not to make some systems upset)

  # ignore labeled mass mailings (bulk, junk, and list)
  return ("Precedence: $1", $header)
    if $header=~ /^Precedence:[ \t]*(bulk|junk|list)/im;
  return ("Suspected spam: X-Spam-Flag")
    if $header=~ /^X-Spam-Flag: YES$/im;

  # reduce to just the email address
  ($from)= ($header=~ /^From:[ \t]*(.*)/m);
  $from=~ s/".*"//;             # drop quotes and text between them
  $from= $1                     # then excise the fully-qualified e-mail address from the remainder
    if $from=~ /(\S+\@\S+)/;
  while ($from=~ /<(.+)>/)
  {                             # drop brackets, sometimes nested (why?)
    $from= $1;
  }
  syslog('debug', "From: <$from>") if $debug;
  unless ($from)
  {                             # no From: line!
    syslog('err', "Could not find a \"From:\" line");
    return ("No \"From:\" line", $header);
  }     

  ($replyTo)= ($header=~ /^Reply-To:[ \t]*(.*)/m);
  syslog('debug', "Reply-To: <$replyTo>") if $debug;

  ($to)= ($header=~ /^To:[ \t]*(.*)/m);
  syslog('debug', "To: <$to>") if $debug;
  
  ($cc)= ($header=~ /^Cc:[ \t]*(.*)/m);
  syslog('debug', "Cc: <$cc>") if $debug;
 
  ($subject)= ($header=~ /Subject:[ \t]*(.*)/m);
  syslog('debug', "Subject: <$subject>") if $debug;
  return ("Suspected spam: $subject") # check for the specified spam tag
    if ($spamTag and $subject=~ /$spamTag/i);
  $subject= "(No subject)" unless $subject;

  $to.= ", " . $cc if $cc;      # gather all the recipients together
  unless ($to)
  {                             # no To: nor Cc: line
    if ($ignoreRecipient)
    {                           # but the user does not care
      syslog('debug', "Could not find any recipients, but we don't care")
        if $debug;
    }
    else
    {                           # ignore the message without recipients
      syslog('err', "Could not find any recipients");
      return ("Could not find any recipients", $header);
    }
  }

  if ($only)
  {                             # only respond to explicitly defined senders
    my $matched= $false;        # found a match?
    foreach $sender (@ignoreSenders)
    {
      $matched= $true, last if ($from=~ /$sender/i);
    }
    return ("Did not match any of the explicitly listed senders", $header) unless $matched;
  }
  else
  {                             # ignore specific senders
    foreach $sender (@ignoreSenders)
    {                   
      if ($sender=~ s/\@$//i)
      {                         # special case: name only
        if ($from=~ /$sender\@/i)
        {
          return ("Matched ignored sender: $sender\@", $header);
        }
      }
      else
      {
        if ($from=~ /\b$sender\b/i)
        {
          return ("Matched ignored sender: $sender", $header);
        }
      }
    }
  }
 
  unless ($ignoreRecipient)
  {
    my $matched= $false;        # alias search result flag

    foreach my $alias (@aliases)
    {                           # make sure the message was specifically for the user
      if (($to=~ /$alias$/i) or ($to=~ /$alias[\s\@\"\'\+>,]/i))
      {                         # found a match
        syslog('debug', "Matched a recipient: $alias") if $debug;
        $matched= $true;
        last;
      }
    }
    return ("You are not the specific recipient", $header) unless $matched;
  }

  $replyTo= $from unless $replyTo;
  if ($when= RecentSender($replyTo))
  {                             # this is a recent sender, or 
    return ("We've already notified <$from> $when", $header);
  }
  else
  {                             # send a reply to this sender
    $replyResult= SendReply($replyTo, $subject, $username, $fromName);
  }

  return ($replyResult, $header);
}


# YesOrNo
#
# Ask the user to confirm or decline
#
sub YesOrNo
{
  my $question= shift;          # the question we are to ask
  my $answer;                   # the yes or no asnwer we are to record

  while ($true)
  {                             # wait for a proper answer
    print "\n$question ";
    $answer= <STDIN>;
    last if $answer=~ /^[yn]/i;
    print "Please answer \"yes\" or \"no\" ('y' or 'n')\n";
  }
  
  print "\n";
  return ($answer=~ /^y/i);     # confirmed?
}


# Disable
#
# Ask whether to disable currently active forwarding
#
sub Disable
{
  my $home= shift;              # home directory
  my %senders;                  # the past senders database
  my @keys;                     # keys of the past senders database
  my $key;                      # a single key of the past senders database
  my $when;                     # time stamp for each record
  my $mine;                     # guess about the ownership of the .forward
  my $readDelimiter;            # storage for the current read delimiter
  my $forward;                  # contents of the .forward file

  if ($quiet)
  {                             # just make a copy and continue
    rename($home.$forwardFile, $home.$forwardFile.$oldSuffix)
      or die "Failed to preserve <$home$forwardFile> " .
        "as <$home$forwardFile$oldSuffix>: $!\n";

    return $false;              # do not disable vacation
  }

  print "\n--\n\n",
  "You have a \"$forwardFile\" file in your home directory containing:\n\n";

  if(open(Forward, $home.$forwardFile))
  {                             # check the contents
    $readDelimiter= $/;
    undef $/;                   # read everything at once
    $forward= <Forward>;
    close(Forward);
    $/= $readDelimiter;         # restore the delimiter

    print $forward, "\n\n";     # echo it for the user
    $mine= $forward=~ /$myTag/m; # check for my tag
  }
  else
  {                             # cannot open the file
    print "Could not open <$home$forwardFile>: $!\n";
    $mine= $false;              # should be able to open my own files
  }

  if ($mine)
  {
    if (YesOrNo("Would you like to disable the vacation feature?"))
    {                           # disable forwarding
      unlink($home.$forwardFile)
        or die "Failed to remove <$home$forwardFile>: $!\n";

      use DB_File;              # senders database access
      use Fcntl;                # file access flags
      if (tie(%senders, 'DB_File', $home.$dataFilePrefix,
              O_RDONLY, 0600, $DB_HASH))
      {
        if (@keys= sort { $senders{$a} <=> $senders{$b}; } keys %senders)
        {
          require 'ctime.pl';
          open(Pager, "| $pager")
            or die "Could not open a pipe to $pager: $!\n";
          print Pager "While you were away, I responded to:\n\n";
          foreach $key (@keys)
          {
            ($when)= unpack("L", $senders{$key});
            printf Pager "%40s on %s", $key, ctime($when);
          }
          print Pager "\n\n";
          close(Pager);
          untie(%senders);
        }
      }
      else
      {
        print "Could not open the past senders database: $!\n\n" if $debug;
      }
      print "Back to normal mail reception.\n\n";
      return $true;             # leave vacation disabled
    }
    else
    {
      print "Ok, the vacation feature remains enabled.\n";
    }
  }
  else
  {                             # clobber the alien .forward file?
    print "\n",
    "If you continue, I will replace this \"$forwardFile\" file\n",
    "with my own settings. I will keep a copy of the original\n",
    "as \"$forwardFile$oldSuffix\".\n";

    unless (YesOrNo("Continue and replace the \"$forwardFile\" file?"))
    {
      print "Ok, I will leave it alone.\n\n";
      return $true;             # do not overwrite
    }
    else
    {                           # make a copy
      rename($home.$forwardFile, $home.$forwardFile.$oldSuffix)
        or die "Failed to preserve <$home$forwardFile> " .
               "as <$home$forwardFile$oldSuffix>: $!\n";
    }
  }

  return $false;                # proceed
}


# SetMessage
#
# Configure a vacation reply message
#
sub SetMessage
{
  my $home= shift;              # home directory
  my $see;              # user responses
  my $edit;

  if (-T $home.$dataFilePrefix.$messageFileSuffix)
  {                             # a message already exists
    if ($quiet)
    {                           # no questions, just edit it
      $edit= $true;
    }
    else
    {
      print "\n--\n\n",
      "You have a message file in ",
      "$home$dataFilePrefix$messageFileSuffix\n";
      $see= YesOrNo("Would you like to see it?");
      if ($see)
      {
        print "\n";
        
        print "\tInvoking pager:\n",
        "\t\t$pager $home$dataFilePrefix$messageFileSuffix\n"
          if $debug;
        if (system($pager, $home.$dataFilePrefix.$messageFileSuffix))
        {
          print
            "\tFailed to hand off <$home$dataFilePrefix$messageFileSuffix>\n",
            "\tto a pager ($pager): $!\n" if $debug;
        }
        print "\n--\n\n";
      }
      $edit= YesOrNo("Would you like to edit it?");
    }
  }
  else
  {
    MakeDefaultMessage($home.$dataFilePrefix.$messageFileSuffix);
    unless ($quiet)
    {                           # ask some questions
      print "\n--\n\n",
      "I've created a default vacation message in ",
      "$home$dataFilePrefix$messageFileSuffix\n",
      "While you are away, I will return this message to anyone who sends\n",
      "you mail.\n",
      "\n",
      "Press 'return' or 'enter' when you are ready to continue, and you\n",
      "will enter your favorite editor ($editor) to adjust the message\n",
      "to your own tastes.\n\n";
      $|= 1;                    # unbuffer input
      print "Press 'return' or 'enter' to continue... ";
      <STDIN>;
    }
    $edit= $true;
  }
  if ($edit)
  {                             # delegate to an external editor
    print "\tInvoking editor:\n",
    "\t\t$editor $home$dataFilePrefix$messageFileSuffix\n"
      if $debug;

    if (system($editor, $home.$dataFilePrefix.$messageFileSuffix))
    {
      print "\tFailed to hand off <$home$dataFilePrefix$messageFileSuffix>\n",
      "\tto an editor ($editor): $!\n" if $debug;
    }
  }
}


# MakeDefaultMessage
#
# Create a default vacation reply message
#
sub MakeDefaultMessage
{
  my $messageFile= shift;       # path to the message file

  open(Message, ">$messageFile")
    or die "Could not create <$messageFile>: $!\n";
  print Message DefaultMessage();
  close(Message);
}


# DefaultMessage
#
# Echo a default vacation reply message
#
sub DefaultMessage
{
  return "Precedence: junk\n" .
    "X-No-Archive: yes\n" .
    "Subject: Away for a while\n" .
    "\n" .
    "Hello,\n" .
    "\n" .
    "I am gone for a while and will read your message concerning\n" .
    "\"\$SUBJECT\" upon my return.\n";
}


# SetForwarding
#
# Create a .forward file to enable vacation
#
sub SetForwarding
{
  my $home= shift;              # home directory
  my $user= shift;              # current user's login name
  my $vacation= $0;             # our path name

  if ((-T $home.$forwardFile) and !$quiet)
  {                             # we're keeping previous settings
    print "\n--\n\n",
    "Keeping previous \"$forwardFile\" file.\n\n",
    "The vacation feature remains enabled.\n\n",
    "Please remember to turn it off when you return.\n",
    "You may accomplish this by running this program again.\n",
    "\n",
    "Enjoy!\n\n";

    return;                     # all done!
  }

  print "\tMy path= $vacation\n" if $debug;

  unless ($vacation=~ m/^\//)
  {
    $vacation= '/usr/local/bin/vacation';
    print "\tChanged my path to <$vacation>\n" if $debug;
  }

  print "\n--\n\n",
  "I will create a \"$forwardFile\" file in your home directory\n",
  "to enable the vacation feature.\n" unless $quiet;

  if ($quiet or YesOrNo("Would you like to enable the vacation feature now?"))
  {                             # activate vacation
        my $alias;              # possible user aliases
        my $arguments= "";      # custom arguments for automatic execution
                                # inherited from interactive invocation
        
        $arguments.= " -f $ignoreFile" if $ignoreFile;
        $arguments.= " -j $ignoreRecipient" if $ignoreRecipient;
        $arguments.= " -t $silenceInterval" if $silenceInterval;
        $arguments.= " -s $senderAlias" if $senderAlias;
        $arguments.= " -m $senderMailer" if $senderMailer;
        $arguments.= " -n '$fromName\'" if $fromName;
        $arguments.= " -o" if $only;
        $arguments.= " -l" if $log;
        $arguments.= " -d" if $debug;
        $arguments.= " -u" if $syslogSocketUnix;
        
        if ($spamTag)
        {                       # add spam tag filtering
          $spamTag=~ s/\\/\\\\/g; # armor escape slashes
          $arguments.= " --spam \\\"$spamTag\\\"";
        }
        
        foreach $alias (@aliases)
        {
          $arguments.= " -a $alias";
        }
        
  
    ClearDatabase($home.$dataFilePrefix);
    
    open(Forward, ">$home$forwardFile")
      or die "Could not create <$home$forwardFile>: $!\n";
    chmod(0644, $home.$forwardFile) # make sendmail security checks happy
      or die "Could not change permissions for <$home$forwardFile>: $!\n";
    print Forward "\\$user, \"|$vacation$arguments $user\"\n";
    print Forward "$myTag\n";
    close(Forward);

    # In honor of the original having this fail-safe, we have it too
    MakeDefaultMessage($home.$dataFilePrefix.$messageFileSuffix)
      unless -T $home.$dataFilePrefix.$messageFileSuffix;

    print "\n--\n\n",
    "Ok, I enabled the vacation feature for you.\n\n",
    "Please remember to turn it off when you return.\n",
    "You may accomplish this by running this program again.\n",
    "\n",
    "Enjoy!\n\n" unless $quiet;
  }
  else
  {                             # do not activate vacation
    print "Ok, the vacation feature remains disabled.\n\n";
  }
}


# ClearDatabase
#
# Initialize a database file
#
sub ClearDatabase
{
  my $databasePath= shift;      # our target file
  my %database;                 # just a dummy array
  use DB_File;                  # senders database access
  use Fcntl;                    # file access flags
      
  print "\nWithin ClearDatabase...\n" if $debug;

  if (tie(%database, 'DB_File', $databasePath, O_RDWR|O_CREAT, 0600, $DB_HASH))
  {
    undef(%database);           # clear it
    untie(%database);
  }
  else
  {                             # could not open the file!
    print "Could not clear the database <$databasePath>: $!\n"
      if $debug;
  }
}


# ReadIgnoredSenders
#
# Gather additional senders to ignore from a specified file
#
sub ReadIgnoredSenders
{
  my @ignoreSenders= ();        # a list of senders to ignore

  syslog('debug', "Within ReadIgnoredSenders") if $debug;
  
  if (-e $ignoreFile)
  {                             # file exists
    if ((-T $ignoreFile) and (-r $ignoreFile))
    {                           # and is readable
      if (open(Ignore, $ignoreFile))
      {                         # proceed to read sender names
        while(<Ignore>)
        {                       # read in additional senders to ignore
          push(@ignoreSenders, split());
        }
        close(Ignore);
      }
      else
      {                         # failed to open the list of senders to ignore
        syslog('err', "Failed to open <$ignoreFile>: %m");
      }
    }
    else
    {                           # specified file cannot be read
      syslog('debug', "Cannot read <$ignoreFile>") if $debug;
    }
  }
  else
  {                             # specified file does not exist
    syslog('debug', "<$ignoreFile> does not exist") if $debug;
  }

  return @ignoreSenders;
}


# RecentSender
#
# Check to see if the sender was recently notified
#
sub RecentSender
{
  my $sender= shift;            # address of our sender
  my %senders;                  # the past senders database
  my $lastTime;                # the last time we notified this sender
  my $ago;
  my $now= time;                # the time now
  my $home= $ENV{'HOME'};       # home directory
  use DB_File;                  # senders database access
  use Fcntl;                    # file access flags

  chop($home= `pwd`) unless $home;
  $home.= $directoryDelimiter unless $home=~ /$directoryDelimiter$/;

  if (tie(%senders, 'DB_File', $home.$dataFilePrefix,
          O_RDONLY, 0600, $DB_HASH))
  {                             # check the database for repetitions
    if ($lastTime= $senders{$sender})
    {
      ($lastTime)= unpack('L', $lastTime); # get the value
      if ($lastTime)
      {                         # check elapsed time
        syslog('debug', "now= $now, last= $lastTime, " .
               "timeout= $silenceInterval") if $debug;
        if (($ago= $now - $lastTime) < $silenceInterval)
        {                       # recently notified
          untie(%senders);
          syslog('debug', "ago= $ago") if $debug;
          return ("$ago seconds ago") if ($ago > 1);
          return ("a second ago");
        }
      }
    }
    untie(%senders);
    syslog('debug', "No time stamp available for $sender") if $debug;
    return $false;              # no value or too long ago
  }
  else
  {                             # failed to open the database
    syslog('debug', "Could not check the previous senders database " .
           "<$home$dataFilePrefix>: %m") if $debug;
    return $false;
  }
}


# SendReply
#
# Record the automatic decision and source header lines
#
sub SendReply
{
  use Net::SMTP;                # from libnet by Graham Barr
  my $to= shift;                # our addressee (original sender)
  my $subject= shift;           # the original subject
  my $from= shift;              # the user on whose behalf I act
  my $fromName= shift;          # custom name for the above mentioned user
  my $response;                 # the text of our response
  my $readDelimiter;            # storage for the current read delimiter
  my $mailer;                   # interface to the mail system
  my %senders;                  # the past senders database
  my $now= time;                # the time now
  my $home= $ENV{'HOME'};       # home directory

  chop($home= `pwd`) unless $home;
  $home.= $directoryDelimiter unless $home=~ /$directoryDelimiter$/;
  
  if (open(Response, $home.$dataFilePrefix.$messageFileSuffix))
  {
    $readDelimiter= $/;
    undef $/;                   # read everything at once
    $response= <Response>;
    close(Response);
    $/= $readDelimiter;         # restore the delimiter
  }
  else
  {                             # cannot read the saved response
    syslog('debug', "Could not open the preset response file " .
           "<$home$dataFilePrefix$messageFileSuffix>: %m") if $debug;
    $response= DefaultMessage(); # use a default response
  }
  $response=~ s/\$SUBJECT/$subject/g; # replace subject tokens with a real subject
  $response=~ s/\$SENDER/$to/g;       # replace sender tokens with the current sender
  $response=~ s/\$RECIPIENT/$from/g;  # replace recipient tokens with user's address

  unless ($mailer= new Net::SMTP($senderMailer))
  {                             # confirm our mailer
    my $error= $@;
    if ($senderMailer)
    {                           # error trying a custom mail host
      syslog('err', "Could not create a custom mailer through $senderMailer: $error");
      return ("Could not create a custom mailer through $senderMailer ($error)");
    }
    else
    {                           # try sending through the local host
      if ($debug)
      {
        syslog('debug', "Could not create a mailer ($error); did you configure libnet?");
        syslog('debug', "Will try \'localhost\' as a work-around...");
      }
      unless ($mailer= new Net::SMTP("localhost"))
      {                         # confirm our local mailer
        my $error= $@;
        syslog('err', "Could not create a local mailer: $error");
        return ("Could not create a local mailer ($error)");
      }
    }
  }
  if ($senderAlias)
  {                             # alternate sender address specified
    $from= $senderAlias;
    syslog('debug', "Using alternate sender address <$from>") if $debug;
  }
  unless ($from=~ /\@/)
  {                             # fully qualify sender address as necessary
    $from.= "\@" . $mailer->domain();
    syslog('debug', "Fully qualified user's email address as <$from>")
      if $debug;
  }
  if ($pretend)
  {                             # pretend mode: don't send the reply
    syslog('debug', "Dumping message to STDOUT")
      if $debug;
    print("To: $to\n" .
          "From: $from ($fromName)\n" .
          "Date: " . MailDate() . "\n" .
          $response);
  }
  else
  {                             # normal mode: send the reply
    if ($mailer->mail($from) and $mailer->to($to))
    {                           # negotiate envelope and send message
      $mailer->data();
      $mailer->datasend("To: $to\n" .
                        "From: $from ($fromName)\n" .
                        "Date: " . MailDate() . "\n" .
                        $response);
      $mailer->dataend();
      $mailer->quit();
      
      use DB_File;              # senders database access
      use Fcntl;                # file access flags
      if (tie(%senders, 'DB_File', $home.$dataFilePrefix,
              O_WRONLY|O_CREAT, 0600, $DB_HASH))
      {                         # update the database for the current sender
        $senders{$to}= pack('L', $now);
        untie(%senders);
      }
      else
      {                         # failed to open the database
        syslog('debug', "Could not update the previous senders database " .
               "<$home$dataFilePrefix>: %m") if $debug;
      }
    }
    else
    {                           # failed to negotiate the mail transaction
      my $message=  $mailer->message();
      syslog('err', "Could not send the response to $to from $from: $message");
      $mailer->quit;
      return ("Could not send response to $to ($message)");
    }
  }

  return ("Attempted to notify <$to>");
}


# MailDate
#
# Construct a valid mail header date string
#
sub MailDate
{
  use Time::Local;

  syslog('debug', "MailDate: constructing the date header") if $debug;

  my $time= time();             # remember the current epoch time
  my @months=                   # month names for the header
    qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  my @weekDays=                 # weekday names for the header
    qw(Sun Mon Tue Wed Thu Fri Sat);

  my ($second, $minute, $hour, $day, $month, $year, $weekDay)=
    localtime($time);           # set up the time tag

  my $offset=                   # compute and format the time zone offset
    (timegm(localtime($time)) - $time) / 3600;
  my $timezone= sprintf("%+03d", int($offset)) . 
    sprintf "%02d", abs($offset - int($offset)) * 60;

  return join(" ", $weekDays[$weekDay] . ",",
              $day, $months[$month], $year+1900,
              sprintf("%02d:%02d:%02d", $hour, $minute, $second), $timezone
             );
}


# Log
#
# Record the automatic decision and source header lines
#
sub Log
{
  return unless $log;           # only log if requested

  my $decision= shift;          # what I decided
  my $header= shift;            # the source messages header lines
  my $home= $ENV{'HOME'};       # home directory

  chop($home= `pwd`) unless $home;
  $home.= $directoryDelimiter unless $home=~ /$directoryDelimiter$/;

  if (open(Log, ">>$home$dataFilePrefix$logFileSuffix"))
  {
    print Log "--\n",
    $decision,
    "\n--\n",
    $header,
    "\n--\n";

    close(Log);
  }
  else
  {                             # failed to access the log
    syslog('debug', "Cannot append to " .
           "<$home$dataFilePrefix$logFileSuffix>") if $debug;
  }
}


#
# Terse help
#

__END__
=pod

=head1 NAME

vacation -- automatically respond to e-mail messages

=head1 SYNOPSIS

B<vacation>

B<vacation> B<-q>

B<vacation> B<-i> [B<-j>] S<[B<-f> I<file>]> S<[B<-a> I<alias>]...> S<[B<-t> I<time>]>
S<[B<-s> I<address>]> S<[B<-m> I<host>]> [B<-u>] [B<-l>] [B<-d>] S<[B<-n> I<string>]>
S<[B<--spam> I<pattern>]>

B<vacation> [B<-j>] S<[B<-f> I<file>]> S<[B<-a> I<alias>]...> S<[B<-t> I<time>]>
S<[B<-s> I<address>]> S<[B<-m> I<host>]> [B<-u>] [B<-l>] [B<-d>] S<[B<-n> I<string>]>
[B<--spam> I<pattern>] I<user>

B<vacation> B<-h>

B<vacation> B<-v>

(See the OPTIONS section for alternate option syntax with long option names.)

=head1 DESCRIPTION

B<vacation> provides two major modes of operation: an interactive mode
for set up and reporting and an automatic mode for unattended processing
of incoming e-mail messages.

In its interactive mode, B<vacation> will set up appropriate files to
enable automatic respones to e-mail messages. To accomplish this task,
B<vacation> will interview the user and provide an opportunity to customize
the automatic response message along with a few other options.

The automatic response message is a template which may contain tokens.
B<vacation> will replace these tokens with apporpriate values as it
composes and sends the automatic reply. Currently, B<vacation> checks
for the C<$SUBJECT> token which it will replace with the C<Subject:>
line of the original message. In addition, you may use C<$SENDER>
as a token for the original sender of the incoming message (C<To:>
line of the response) and C<$RECIPIENT> for your own C<From:> address.

B<vacation> will not prompt for all the esoteric options it supports
during the interview. Instead, it will expect those as command-line
arguments. It will learn and set automatic-mode options passed to
it on the command line while invoked in its interactive mode.

A subsequent interactive invocation of B<vacation> will prompt to turn
off automatic responses and provide a report of autmatic reponses it
sent since being activated.

Quiet mode is a variation of the interactive mode designed to emulate
a few bare-bones versions of B<vacation>. In its quiet mode, B<vacation>
will bypass all questions and safeguards of the interactive mode.
It will invoke an external editor to compose the response and will
then configure the C<.forward> file. B<vacation> attempts to learn
the editor from the environment variables C<VISUAL> and C<EDITOR>;
it will default to B<vi> if the environment variables are not set.

In its automatic mode, B<vacation> will respond to incoming e-mail
messages with a response either configured manually or through
the interactive mode. The preferred way to invoke B<vacation> in
its automatic mode is via the C<.forward> file with a line such as:

C<\user, "| /usr/local/bin/vacation user">

The initial interactive mode interview will set up such a C<.forward> file.

This version of B<vacation> is loosely based on the original by Larry Wall
and Tom Christiansen. It is designed to emulate most B<vacation> clones,
and specifically, the Sun version from the early Solaris days.

Options

=over 4

=item B<-j>

Respond to all incoming messages regardless of whether I<user> is a
listed recipient or not. 

=item B<-f> I<file>, B<--file> I<file>, B<--ignore> I<file>

A I<file> contaning a list of senders to ignore. B<vacation>
will ignore senders listed in the specified file in addition
to the default list consiting of C<root>, C<daemon>,
C<mailer>, C<postmaster>, and C<mailer-daemon>.

=item B<-o>, B<--only>

Treat the list of senders to ignore as the opposite. That is,
only respond to listed senders.

=item B<-a> I<alias>, B<--alias> I<alias>

Other names (aliases) to be treated as the recipient (I<user>).
This option may be repeated once for each alias.

=item B<-n> I<string>, B<--name> I<string>

A custom string to use as the name in the From: line.

=item B<-t> I<time>, B<--time> I<time>

The minimum time interval between automatic responses to the
same sender. The time interval may be a string consisting of numbers
and the letters C<s>, C<m>, C<h>, C<d>, and C<w> to designate seconds,
minutes, hours, days, and weeks, respectively. This string may not 
contain spaces or any other characters. The default interval is one
week.

=item B<-s> I<address>, B<--sender> I<address>

An alternate sender e-mail address for automatic replies.

=item B<-m> I<host>, B<--mailer> I<host>

An alternate mail host for automatic replies. If not supplied,
B<vacation> will inherit the mailer pre-configured for B<libnet>
or will attempt to use the local host.

=item B<--spam> I<pattern>

Support for ignoring messages with matched strings in the subject
line. The string may be a regular expression, properly quoted and
escaped.

=item B<-u>, B<-unix>

Force the C<UNIX> C<SYSLOG> socket type. Otherwise, B<vacation>
uses the system default which is usually C<INET>.

=item B<-l>, B<--log>

Keep a journal of all processed messages and decisions in a log.
By default, the log gets written to C<~user/.vacation.log>.

=item B<-d>, B<--debug>

Provide diagnostic messages during execution. During interactive
mode, B<vacation> writes to C<STDERR>; during automatic mode, B<vacation>
writes to the C<SYSLOG> C<MAIL> facility.

=item B<-p>, B<--pretend>

Do everything but send the reply while in automatic mode. Only applies
to automatic mode.

=item B<-v>, B<-V>, B<--version>

Print version information and exit.

=item B<-h>, B<-H>, B<--help>

Print this terse manual and exit.

=back

=head1 EXAMPLES

To simply get started, invoke B<vacation> as

C<vacation>

without any arguments. This will start the interactive interview.

To enable logging and debugging during automatic execution, invoke B<vacation>
interactively as:

C<vacation -i -d -l>


Please note that B<vacation> will also provide debugging information
to C<STDERR> during the interview. To only allow debugging during
automatic execution, modify the C<.forward> file manually after B<vacation>
sets it up:

C<\user, "/usr/local/bin/vacation --debug --log user">


To specify a custom time interval either add the B<--time> option when
invoking B<vacation> interactively:

C<vacation -i --time 1w2h>

or modify the F<.forward> file to include the B<--time> option:

C<\user, "/usr/local/bin/vacation --time 5d7h user">


For aliases, again either list them during interactive invocation:

C<vacation -i --alias first_alias --alias another_alias>

or subsequently modify the F<.forward> file to include them:

C<\user, "/usr/local/bin/vacation -a first_alias -a another_alias user">

To ignore messages with certain patters in the subject line:

C<vacation -i --spam pattern>

C<vacation -i --spam "^\[Spam\]">

or subsequently modify the F<.forward> file to include them:

C<\user, "/usr/local/bin/vacation --spam pattern">

C<\user, "/usr/local/bin/vacation --spam \"^\\[Spam\\]\"">


To specify a custom name string for the From: line of the automatic reply
either add the B<--name> option when invoking B<vacation> interactively:

C<vacation -i --name 'Richard Mayhew via an auto-responder'>

or modify the F<.forward> file to include the B<--name> option:

C<\user, "/usr/local/bin/vacation --name 'Richard Mayhew via an auto-responder' user">

=head1 FILES

=over 4

=item $HOME/.forward

A text file read by the MTA which contains delivery destinations for a given user.

=item $HOME/.forward.old

A backup of the previous C<.forward> file.

=item $HOME/.vacation.msg

A text file containing the auto-reply message template.

=item $HOME/.vacation.log

A text file where B<vacation> logs its activities.

=item $HOME/.vacation.db

A database file where B<vacation> tracks previous senders.

=back

=head1 REQUIRES

Perl 5.6, Getopt::Long, Net::SMTP, Sys::Syslog, Time::Local, DB_File, Fcntl

=head1 SEE ALSO

perl(1), vi(1), sendmail(1)

=head1 BUGS

Send bug reports, questions, and requests to vacation@ayradyss.org.

=head1 AUTHOR

Igor S. Livshits <mailto:vacation@ayradyss.org>

=head1 COPYRIGHT

Copyright (C) 2006 Igor S. Livshits

Use and distribute this tool as per the Artistic License

=cut