#!/usr/bin/perl --
#
# NAME:
#	reply.pl - intelligent vacation program
#
# SYNOPSIS:
#	reply on|off|list|user
#
# DESCRIPTION:
#	This program is loosely based on the example by
#	Larry Wall published in UnixWorld magazine.
#
#	Because this script will most likely be invoked by
#	root or daemon, the "user" name must be supplied.
#	Some sites use multiple address formats such as
#	"sjg" and "S.Gerraty", to handle this, place the
#	appropriate id's in a file $home/.replyfor (one per line)
#	Keep a list of addresses you don't ever want to
#	reply to in $home/.noreply (one per line)
#	Make it do its thing by creating a file ~/.forward
#	containing:
#	\user, "/usr/local/lib/reply user"
#	This will be done for you if you run `reply.pl on`
#	reply.pl will work out for itself where it has been
#	installed and what it is called.
#
# RETURNS:
#	1 on error with a suitable diagnosic.
#
# FILES:
#	~/.lastreply
#	~/.recording
#	~/.noreply
#	~/.replyfor
#
# AUTHOR:
#	Simon J. Gerraty <sjg@zen.void.oz.au>

# RCSid:
#	@(#)reply.pl 1.7 92/01/16 11:27:53 (sjg)
#
#	$Id: reply.pl,v 1.10 1996/04/11 13:11:16 sjg Exp $

eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  if $running_under_some_shell;

# workout what we were installed as
$Myname=$0;
$Myname=~ s#^.*/([^/]*)$#$1#;

require 'ctime.pl';
$RDB=".lastreply";

$me = shift(@ARGV) || die "No user supplied\n";
if ($me eq "on" || $me eq "off" || $me eq "list") {
  &house_keep($me);
  exit 0;
}

(@pw_ent=getpwnam($me)) || die "No such user \"$me\"\n";
$home = $pw_ent[7];
$> = $pw_ent[2];		# set euid

# get a mailer to use.
# we use the first of these that we find
# we expect that this mailer handles '@' addresses
# and the -s option to specify the subject
@MAILERS = ("$ENV{'MAILER'}",
	    '/usr/bin/mailx',
	    '/usr/bin/Mail',
	    '/usr/ucb/Mail',
	    '/usr/ucb/mail',
	    'none');

foreach $m (@MAILERS) {
  exit 1 if $m eq 'none';
  $MAILER = $m;
  last if "$m" ne "" && -X $m;
}

$DAYS = 60*60*24;		# length of day in seconds

chdir $home || die "Can't find home directory: $!\n";
# go and get the headers
&parse_header;
# build the @replyfor and @noreply lists
&build_lists($me);
$replyfor = join('|', @replyfor);

$To = $hdr{"To"} || $hdr{"Apparently-To"};
$To =~ tr/A-Z/a-z/;
if ($To =~ /$replyfor/) {		# don't reply to mailing lists
  
  $replyto = $hdr{"Reply-To"} || $hdr{"From"};
  $replyto =~ s/\s*\(.*\)//;	# user@site (Name), lose the (Name)
  $replyto =~ s/.*<(.*)>.*/$1/;	# focus on <user@site> 
  
  $r = $replyto;
  $r =~ tr/A-Z/a-z/;
  $noreply = join('|', @noreply);
  if ($r !~ /$noreply/) {
    # Ok, we may want to reply to this
    if (dbmopen(LASTREPLY, $RDB, 0644)) {
      if (time - $LASTREPLY{$r} > 7 * $DAYS) {
	# store the replyto addr in lowercase always.
	
	$LASTREPLY{$r} = time;
	
	open(MAIL, "| $MAILER -s \"Re: $hdr{'Subject'}\" $replyto");
	&mailmessage($replyto);
	close MAIL;
      }
      dbmclose(LASTREPLY);
    } else {
      warn "Can't access lastreply database: $!\n";
    }
  }
}

exit 0;

sub mailmessage {
  local($to) = @_;

  $signature = `cat .signature`;
  $recording = `cat .recording`;
  print MAIL <<"EndOfMessage";
Hi $to,
[this is a recording.]

$recording

$signature
EndOfMessage
}

sub parse_header {
 LINE:
  while (<>)  {
    last LINE if /^$/;
    chop;
    if (s/^([^ :]+): *//) {
      $keyword = $1;
      $hdr{$keyword} .= "\n" if ($hdr{$keyword} ne '');
    } else {
      s/^\s+/ /;
    }
    $hdr{$keyword} .= $_;
  }
}			       

# turn reply forwarding on/off
# or list the addresses we have replied to (and when)
sub house_keep {
  local($op) = @_;
  local($key,$val,$date);

  # work out where we should be executed from (ignore ./reply)
  @Path = split(/:/, $ENV{'PATH'});
  foreach $path (@Path, 'ERROR') {
    die "$Myname not installed in \$PATH\n" if $path eq 'ERROR';
    $reply = "$path/$Myname";
    last if $path ne '.' && -x $reply;
  }
  
  (@pw_ent = getpwuid($<));
  $me = $ENV{'USER'} || $ENV{'LOGNAME'} || $pw_ent[0];
  $home = $ENV{'HOME'} || $ENV{'LOGDIR'} || $pw_ent[7];
  $fwd = "$home/.forward";
  $rec = "$home/.recording";

  chdir $home;
  &build_lists($me);
  if ($op eq "on") {
    open(FWD, ">$fwd") || die "Can't creat $fwd: $!\n";
    print FWD "\\$me, \"\|$reply $me\"\n";
    close FWD;
    print "$fwd is in place\n";
    if (!( -f "$rec")) {
      open(REC, ">$rec") || die "Can't creat $rec: $!\n";
      print REC <<"EndOfMessage";
I am not here right now.
Your mail will be dealt with when I return.
EndOfMessage
      print "I have created a simple .recording file for you\n";
    } else {
      print "You may wish to edit \"$rec\" now\n";
    }
    $"=',';
    print "Replies will be handled for: \"@replyfor\"\n";
    print "Replies will not be sent to any of: \"@noreply\"\n";
  } elsif ($op eq "off") {
    unlink($fwd) || warn "Can't remove $fwd: $!\n";
    print ".forward has been removed\n";
  } elsif ($op eq "list") {
    if (dbmopen(LASTREPLY, $RDB, 0644)) {
      while (($key,$val) = each %LASTREPLY) {
	chop($date = &ctime($val));
	print "$date  $key\n";
      }
      dbmclose(LASTREPLY);
    } else {
      warn "Can't access lastreply database: $!\n";
    }
  } else {
    die "Unknown function '$op'\n";
  }
}

# build @replyfor and @noreply
sub build_lists {
  local($me) = @_;
  
  # this is a list of folk we _never_ reply to
  if ( -f '.noreply' ) {
    chop(@noreply = (`cat .noreply`));
  }
  push(@noreply, $me, 'daemon', 'postmaster');
  # this is a list of addresses that we answer for
  if ( -f '.replyfor' ) {
    chop(@replyfor = (`cat .replyfor`));
  }
  push(@replyfor, $me);
}