#!/usr/bin/perl
#
# autoresponder.pl v1.2 (1999 10 21)
#
# This is a usenet autoresponder, answering each article
# it's given by mail, provided it's not filtered out ;-)
#
# This one has been developed for inn2.x and storage-api,
# but should just as well work with inn1.x, provided you
# set the flag correct and have it fed with Wf, not Wn ;-)
#
# History
#
# 1999 02 19 elmi@newsbone.org (Elmar K. Bins)
# started hacking away...
#
# 1999 02 20 elmi@newsbone.org (Elmar K. Bins)
# includes innshellvars.pl, writes date to log
#
# 1999 10 21 elmi@newsbone.org (Elmar K. Bins)
# Call sendmail with "-f" flag to correctly direct
# bounces.
#
# Notes
#
# A newsfeeds line for inn2.x would be
# autoresponder!:!*,*.test:Tp:<path to>/autoresponder.pl %s
#
# Resources
#
# The current version can be found at http://detebe.org/~news/software/
#

#====================================================================
# Definitions coming up next
#====================================================================

# Do you use the storage api for groups being fed here?
$STORAGEAPI = 1;


# Version and copyright stuff
$version	= "1.2";
$date		= "1999 10 21";
$authors	= "elmi\@newsbone.org (Elmar K. Bins)";
$copyright	= "-- \nautoresponder.pl v$version $date $authors\n";


# System dependent stuff
$sendmail	= "/usr/sbin/sendmail";
$date		= "/bin/date";

# $now will be like "Sat Feb 20 1999 14:30:14 +0100 (CET)"
# if you like, a simple `$date` will do. It's only used for user response.
$now		= `$date \"+%a %b %d %Y %T %z (%Z)\"`; chomp($now);


# Installation dependent stuff (pathnames)
require "/usr/local/inn/lib/innshellvars.pl";

$sm		= join("/",$inn::pathbin,"sm") if ($STORAGEAPI);
$logfile	= join("/",$inn::most_logs,"autoresponder.log");
$mymessage	= join("/",$inn::pathnews,"contrib/elmi/autoresponder.msg");


# Localizable stuff

$mymail		= "reflector\@detebe.org";
$systemname	= $inn::pathhost;
$myname		= "$systemname autoreflector";
$location	= "Germany";
$maintainermail	= $inn::complaints;
$myxheaders	= "X-Reflector: $systemname\nX-URL: http://www.detebe.org/";


# Configuration

# This many lines of the body are included in the user response
# _and_ being searched for "ignore" keywords
$lines		= 20;

# Fill in Perl regexp's here. Any Reply-Address matching one of
# these will be considered blacklisted and not receive any responses.
# case insensitive
@addressblacklist = (
		"\@.*nospam",
		"root\@",
		"middle.earth",
		"\@gsm\..*\.schule.de",
		"test\@test.de",
		"test\@test.com",
		"\@.*removethis",
		"\.nospam",
		"nospam\.",
		"\.n0spam",
		"n0spam\.",
		);

# Fill in Perl regexp's here. If one of these magic phrases is
# found in "Subject:", "Keywords:", "Summary:" or the first
# $lines lines of the body, no response will be generated.
# case insensitive
@ignorewords = (
		"ignore",
		"dont reply",
		"don\'t reply",
		"no reply",
		"no replies",
		"fuck off",
		"keine antwort",
		"keine reply",
		"ignoriere",
		"norep"
		);


#====================================================================
# The main working routine
#====================================================================

# open the article, depending on $STORAGEAPI
if ($STORAGEAPI)
  { open (ARTICLE, "$sm -R $ARGV[0]|") || exit 1; }
else
  { open (ARTICLE, "<$ARGV[0]") || exit 1; }


$body = "";

#-------------------------------------------------------------
# 1. Read header into %header{<lowercase header field name>}
#    The entire line is also added to $body for later citation
#    Removes CRs from the lines in the process.

while (<ARTICLE>)
  {
  s/
//g;
  $body .= "| " . $_;
  chomp;
  last if ($_ eq "");
  ($key,@value) = split(":",$_); $value = join(":",@value);
  $key =~ s/\s//g;
  $value =~ s/^\s//;
  $header{lc($key)} = $value;
  }


#--------------------------------------------------------------
# 2. Read first $lines lines from body and append them to $body
#    Removes CRs from the lines in the process.

$count = 0;
while (<ARTICLE>)
  {
  s/
//g;
  last if ($count >= $lines);
  $body .= "| " . $_ if $count < $lines;
  $count++;
  }


#--------------------------------------------------------------
# 3. Decide whether this autoresponse request is to be honoured

#------------
# Get the reply address, from reply-to: if available

$mail = $header{from};
$mail = $header{'reply-to'} if ($header{'reply-to'} ne "");


#------------
# a/ control message? Bail out.

&leave(1,"control message")
	if ($header{control} ||				# control header
	    ($header{subject} =~ m/^cmsg/i) ||		# old style by subject
	    ($header{newsgroups} =~ m/\.ctl(,|$)/i));	# old style by group


#------------
# b/ mail address invalid? Bail out.

# get only the part around the "@" into $cmail for address parsing

$mail  =~ m/([^ <>]+\@[^ <>]+)/;
$cmail = $1;

# read this twice ;-)

&leave(2,"invalid mail address $mail")
	if ($cmail !~ m/^[^\@ ]+\@([^\@ ]+\.)+[a-z][a-z]+$/i);

#	if (($cmail !~ m/^[^\@ ]+\@([^\@ ]+\.)+[a-z][a-z]+$/i) &&
#	    ($cmail !~ m/^[^\@ ]+\@\[(\d+\.){3}\d+\]$/));


#------------
# c/ mail address matches blacklist patterns? Bail out.

foreach $pattern (@addressblacklist)
  {
  &leave(3,"blacklisted mail address $mail")
  	if ($mail =~ m/$pattern/i);
  }


#------------
# d/ magic "ignore" words in message? Bail out.

foreach $pattern (@ignorewords)
  {
  &leave(4,"user wish")
  	if (($header{subject}  =~ m/$pattern/i) ||
	    ($header{keywords} =~ m/$pattern/i) ||
	    ($header{summary}  =~ m/$pattern/i) ||
	    ($body             =~ m/$pattern/i))
  }


#--------------------------------------------------------------
# 4. Send mail, log and leave.

@msg = &filltemplate($mymessage,1);
if (@msg == ())
  { &leave(5,"could not load $mymessage"); }

open (MAIL, "| $sendmail -t -f $mymail") || &leave(6,"could not start $sendmail");

# print header

print MAIL <<__EOMAIL__;
From: $mymail ($myname)
To: $mail
Subject: Answer from reflector (Re: $header{subject})
Precedence: bulk
$myxheaders

@msg
$body
$copyright
__EOMAIL__

close(MAIL);
&leave(0,"");


#====================================================================
# Helper subroutines following
#====================================================================

#--------------------------------------------------------------
# leave takes an exit code and optionally a string, logs
# according to the exit code (!=0 means error|ignore)
# and exit with an exit code of $exitcode

sub leave
{
  my ($exitcode,$string) = @_;

  open(LOG, ">>$logfile") || die "Cannot open log $logfile.\nBailing out";

  $logstr = "$now | $mail IN $header{newsgroups} [";

  if ($exitcode == 0)
    { $logstr .= "replied]"; }
  else
    { $logstr .= "ignored]"; }

  $logstr .= " ($string)" if ($string ne "");

  print LOG "$logstr\n";
  close(LOG);

  exit $exitcode;
}


#--------------------------------------------------------------
# filltemplate
# reads a file, replaces %%variable%% patterns, pushes the
# resulting line onto its result array (or doesn't, according
# to the $purge setting and whether there are still %%...%%-
# sequences in the resulting line.
# Returns the resulting array (or an empty one).

sub filltemplate
{
  my ($tmplfile,$purge) = @_;

  open(TMPL, "<$tmplfile") || return ();
  my @tmpl = <TMPL>;
  close(TMPL);

  @result = ();

  foreach $line (@tmpl)
    {
    $line =~ s/%%newsgroups%%/$header{newsgroups}/g;
    $line =~ s/%%date%%/$header{date}/g;
    $line =~ s/%%path%%/$header{path}/g;
    $line =~ s/%%mydate%%/$now/g;
    $line =~ s/%%mymail%%/$mymail/g;
    $line =~ s/%%maintainermail%%/$maintainermail/g;
    $line =~ s/%%systemname%%/$systemname/g;
    $line =~ s/%%location%%/$location/g;
    $line =~ s/%%lines%%/$lines/g;

    if (($line !~ m/%%[^%]*%%/) || (!purge))
      { push @result, $line; }
    }

  return @result;
}