#!/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.
#
# 2002 06 27 cord@Wunder-nett.org (Cord Beermann)
# added sort of a rate filter, to prevent bombing
# through this autoresponder. It looks in the logfile,
# so you should rotate that file from time to time ;-)
#
# 2002 09 17 cord@Wunder-nett.org (Cord Beermann)
# added customization based on Newsgroup
#
# 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+CFB2";
$date		= "2002 09 19";
$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 "/news/lib/innshellvars.pl";

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

# Localizable stuff

$mymail		= "devnull\@news.mediaWays.net";
$systemname	= $inn::pathhost;
$myname		= "$systemname autoreflector";
$location	= "Germany";
$maintainermail	= $inn::complaints;
$myxheaders	= "X-Reflector: $systemname\nX-URL: http://feedme.news.mediaWays.net/";


# 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 = (
		"kst1966\@nate.com",
		"MAILER-DAEMON",
		"spoo1uk\@yahoo.co.uk",
		"bbs",
		"webmaster",
		"ophidia.be",
		"example",
		"nntp-monitor",
		"abuse",
		"address",
		"anon",
		"checkbot",
		"delete",
		"domain",
		"dont",
		"email",
		"fake",
		"valid",
		"nobody",
		"nosuch",
		"not",
		"none",
		"nomail",
		"nowhere",
		"null",
		"remove",
		"root\@",
		"rot13",
		"rubbish",
		"some",
		"spam",
		"test",
		"unknown",
		"what",
		"where",
		"xxx",
		"news\@mediaWays.net",
		"news\@telefonica.de",
		"med\@libero.it",
		"hypdock\@yahoo.com",
		);

# 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 = (
		"delivery-status",
		"This is a multi-part message in MIME format.",
		"anon",
		"bulk",
		"charter",
		"dele",
		"don\'t",
		"dont",
		"fuck off",
		"ignor",
		"kein",
		"no repl",
		"norep",
		"remove",
		"negeer",
		);


#====================================================================
# 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 "");

$references = $header{'message-id'};

#------------
# 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))
  }

#------------
# e/ this address already in the Logfile? Bail Out.
open(LOG, "$logfile") || die "Cannot open log $logfile.\nBailing out";
foreach $pattern (<LOG>)
  {
  $pattern = (split / /, $pattern)[8];
  &leave(5,"already replied")
	if (lc($cmail) eq lc($pattern));
  }
close(LOG);

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

$mymessage2	= join("/",$inn::pathnews,"doc/${header{newsgroups}}.autoresponder.msg");

if ( -s $mymessage2 ) {
  @msg = &filltemplate($mymessage2,1);
} else {
  @msg = &filltemplate($mymessage,1);
}
if (@msg == ())
  { &leave(6,"could not load $mymessage"); }

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

# print header

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

@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 | $cmail IN $header{newsgroups} $header{'message-id'} [";

  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;
}