#!/local/bin/perl
eval "exec /local/bin/perl -S $0 $*"
    if $running_under_some_shell;

# autoreply version 1.0

# Automatically reply postings in USENET test groups.

# Copyright Silvano Maffeis, University of Zurich, Switzerland 1993.
# You are free to use, modify, and redistribute this software free of charge.
# Redistribution for direct profit is expressly prohibited.
# This copyright note must always be included.

# First of all, you must adapt the variables below and then run
# autoreply -init to initialize the autoreplier's datafile.

# Test the functioning of your installation with
# autoreply -mailto "your_email_address"
# This mails the replies to "your_email_address" instead of to the originators
# of the test postings.

# This script can be started by cron (testmode):
# 0 * * * *   /usr/local/autorep/autoreply -mailto "your_email_address"

# After some time you can replace "-mailto .." by "-start". Only then
# replies will be mailed to the posters.

############ Variables you MUST customize: ##################################


# directory where news is spooled to:
$spool_dir = "/var/spool/news";

# Directory where autoreply stuff resides:
$top = "/home/josef/mail/pp/priv/usenet";

# groups to monitor: BE VERY CAREFUL ABOUT WHAT YOU SET HERE!
@newsgroups = ('alt.test', 'misc.test');

# Amount of posting to quote into reply (num lines):
$lines = 20;			# 20 lines are largely enough.

# The first line of the generated reply:
$intro       = "Greetings from Switzerland!";

# Problems/questions should be addressed to: (add YOUR address here:)
$problems_to = "autoreply@somewhere.ch";

# Trailer of the reply:
$trailer     = "Good bye!\nMay the force be with you!!";
 
# Mailer to use. It must behave like Berkeley bin-mail.
# (-s is used to set the subject.)
$mailer = "/usr/ucb/mail -i";

# some unix tools:
$ls = "/bin/ls";
$dt = "/bin/date";

############# End of variables to customize #################################

 
############# You don't need to change below this line ######################

# our file containing the numbers of the last processed postings:
# This file is initially created by running the script with -init
$rep = "$top/replied";

# File for logging events:
$log = "$top/log";
 
# autoreply detects an already running instance by checking for the
# existence of the ``running'' file:
$run = "$top/.running";
 

############# Subroutines: ##################################################
sub usage{
    print STDERR "usage: $0 [-init | -mailto \"address\" | -start]\n"; 
    print STDERR " -init             : initialize replied-file\n";
    print STDERR " -mailto \"address\" : send the replies to \"address\"\n";
    print STDERR "                     instead of posters. (Test mode)\n";
    print STDERR " -start            : send replies to posters.";
    print STDERR " (Production mode)\n\n";
    exit 1;
}

sub panic{
    print STDERR "PANIC: @_[0]\n"; 
    if($running == 1){
        unlink($run); 
    }
    exit 1;
}
 
# Create ``replied'' file
sub write_replied {
    # Update $rep file using memorized largest posting numbers:
    open(REPF, ">$rep") || die;
    
    # sort alphabetically on newsgroup:
    @key = keys(%mtimes);
    @key = sort(@key);
    @key = reverse(@key);
    
    # set format for ``replied'' file:
    format REPF =
@<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @>>>>>> 
$ent, $mtimes{$ent}, $total{$ent}
.
    
    # construct ``replied'' file:    
    while($ent = pop(@key)){ write REPF; };
close REPF;
}
 
# Started when a SIGTERM is received (system shutdown):
sub do_kill {
    &write_replied();
    if($running == 1){ unlink($run); };
    print STDERR "$0: killed\n";
    &panic("$0: killed\n");
}

# Brings <user@foo.dom> to user@foo.dom format.
# Also filters out junk which has special meaning to sh:
sub filter_addr {
    $_ = @_[0];
    
    s/<//g; s/>//g; s/!//g; s/&//g; s/\*//g; s/\?//g; 
    s/\"//g; s/\'//g; s/`//g; s/~//g; s/\$//g; s/\^//g; 

    return $_;
}
############# Command line arguments:  ######################################
if(@ARGV > 2 || @ARGV == 0){
    &usage();
}
 
if(@ARGV > 0){
    if((@ARGV[0] ne "-init") && (@ARGV[0] ne "-mailto") && 
       (@ARGV[0] ne "-start")){ 
        &usage();
    };
}

 
 
# Parse command line arguments:

if(@ARGV[0] eq "-init"){
    if(@ARGV > 1){ &usage(); };
    
    print STDERR "\nBuilding $rep\nwithout sending out replies. ";
    print STDERR "Please be patient.\n\n";
    
    # construct a new replied file:
    unlink($rep);
    print STDERR "creating $rep\n";
    open(TMP, ">$rep") || die "cannot create $rep for writing";
    @tmp_newsgroups = @newsgroups;
    while($ng=pop(@tmp_newsgroups)){ print TMP $ng, " 0 0\n"; };
    close TMP; 
    $init = 1;
    
}else{
    # open log file for append:
    open(OUTF, ">>$log") || die "cannot open $log for append";
    select(OUTF); $| = 1;
    $init = 0;
    
    # Write date into logfile:
    print "\n\n----------------------------------------------------\n";
    $date = `date`; chop($date);
    print "autoreplier started on $date:\n\n";
}

if(@ARGV[0] eq "-start"){
    if(@ARGV != 1){ &usage();};
}

if(@ARGV[0] eq "-mailto"){
    if(@ARGV[1] eq ""){ &usage(); };
    
    print ">> redirecting e-mails to @ARGV[1] <<\n";
    $mailto = 1;
    
}else{
    $mailto = 0;
}

# enforce "-mailto" (test):
# $mailto = 1;
# @ARGV[1] = "maffeis";
 
############# main body: ####################################################
# parse file containing last replied posting numbers,
# perform simple sanity checks:
if(!open(REPF, "$rep")){
    &panic("cannot open $rep.\nRun autoreply -init\n");
}
 
# Load ``replied'' file:  
$num_ent = 0;
while(<REPF>){
    $num_ent++;
    @line = split;
    if(@line != 3){
	&panic("Num fields in $rep != 3");
    };
    if(@line[1] < 0 || @line[2] < 0){
	&panic("Value in $rep is < 0");
    }
    $mtimes{"@line[0]"} = @line[1];
    $total{"@line[0]"} = @line[2];
}

if($num_ent != @newsgroups){
    &panic("error in $rep.\nNum newsgroups != num entries in $rep\n");
};
close(REPF);
 
if( -e "$run"){ 
    &panic("an instance of the autoreplier is already running.\n(If this is not the case then remove the file\n $run.)");
};
 
`/bin/cp $rep $rep.old`;

# create the ``running'' file. It serves as semaphore to prevent
# multiple instances of the script running at the same time.
open(RUN, ">$run") || die "cannot open $run for writing.";
close RUN;
$running = 1;
 
# signal handlers:
$SIG{ 'INT' }  = 'IGNORE';  
$SIG{ 'QUIT' } = 'IGNORE';
$SIG{ 'TERM' } = 'do_kill';
 

# iterate through newsgroups in @newsgroups:
while($group=pop(@newsgroups)){
    print  "Processing newsgroup $group\n";
    
    # Bring 'xx.xx.xx' group names into
    # 'xx/xx/xx' form:
    $_ = $dot_group = $group; s/\./\//g; $group = $_;
    
    if(!opendir($dir, "$spool_dir/$group/")){
	&panic("cannot open directory $spool_dir/$group/");
    };
    
    # $ltime is used to compute the last replied posting number:
    $ltime = $mtimes{"$dot_group"};
    
    # iterate through postings in news group:
    while($next = readdir($dir)){
	# discard '.','..' and already replied postings:
	if($next ne '.' && $next ne '..' && $mtimes{"$dot_group"} < $next){
	    
            # print fancy dots when in -init mode: 
	    if($init == 1){ print ".";};
	    
	    # Adjust largest posting number seen so far:
	    if($next > $ltime) { $ltime = $next; };
	    
	    # Construct reply:
	    if($init == 0){
		open(TMP, "$spool_dir/$group/$next");
		
		$from = ""; $subject = ""; $reply_to = ""; $originator = "";
		# find 'From:', 'Subject', 'ignore':
		while(<TMP>){ 
		    $l = $_;
		    @line = split;
		    if(@line[0] eq 'From:'){ 
			@line_tmp = @line;
			
			# Some From headers have the format <rfc822> Joe Smith,
			# others have Joe Smith <rfc822> ...
			# Search for string containing an '@':
			while($line_elem = pop(@line_tmp)){
			    if(index($line_elem,"@") != $[-1){
				$from = &filter_addr($line_elem);
			    }	
			}	
		    }
		    if(@line[0] eq 'Originator:'){ 
			@line_tmp = @line;
			
			# Some Originator headers have the format <rfc822> Joe Smith,
			# others have Joe Smith <rfc822> ...
			# Search for string containing an '@':
			while($line_elem = pop(@line_tmp)){
			    if(index($line_elem,"@") != $[-1){
				$originator = &filter_addr($line_elem); 
			    }	
			}	
		    }
		    if(@line[0] eq 'Reply-To:'){ 
			@line_tmp = @line;
			
			# Some Reply-To headers have the format <rfc822> Joe Smith,
			# others have Joe Smith <rfc822> ...
			# Search for string containing an '@':
			while($line_elem = pop(@line_tmp)){
			    if(index($line_elem,"@") != $[-1){
				$reply_to = &filter_addr($line_elem); 
			    }	
			}	
		    }

		    if(@line[0] eq 'Subject:'){ 
			$subject = substr($_, 8); chop($subject); };
		    
                    $ignore = 0; 
		    # transliterate to lower case:
		    $_ = $l; tr/A-Z/a-z/; $l = $_;
		    if(
		       index($l,"ignore") != $[-1 
		       || index($l,"no reply") != $[-1 
		       || index($l,"no replies") != $[-1 
		       || index($l,"don't reply") != $[-1 
		       || index($l,"not reply") != $[-1 
		       || index($l,"dont reply") != $[-1 
		       || index($l,"don't respond") != $[-1 
		       || index($l,"dont respond") != $[-1 
		       || index($l,"not respond") != $[-1 
		       || index($l,"no reflect") != $[-1 
		       || index($l,"keine antwort") != $[-1 
		       || index($l,"keine replies") != $[-1 
		       || index($l,"keine replys") != $[-1 
		       ){ 
			print  "   $next: ignored\n";
			$ignore = 1; last;
		    };
		};

		if($ignore == 1){ next; }
		
		# empty 'From:'? 
		if(length($from) == 0 && length($reply_to) == 0){ 
		    print "   $next: empty \"From:\" field\n";

                    # empty 'From:'. Maybe there is an 'Originator:' address: 
		    if(length($originator) == 0 && length($reply_to) == 0){ 
			print "   $next: empty \"Originator:\" field\n";
			next; 
		    }
		    else{
			$from = $originator;
		    }
                };
		
		# Reply-To: address is preferred to From: and Originator: address
		$rto = 0;
		if(length($reply_to) > 0) { 
		    # Use Reply-To only if it is an "@" address:
		    # (People sometime write junk into the Reply-To field)
		    $from = $reply_to; $rto = 1;
		};
                
		if($mailto == 1){ 
                    # redirect reply. Don't mail to poster.
		    if($rto == 1){
			print  "   $next: redirecting reply for $from (Reply-To) ";
                        print  "to @ARGV[1]\n";
		    }
		    else{
			print  "   $next: redirecting reply for $from to @ARGV[1]\n";
		    }

                    $from = @ARGV[1];
		}else{
		    if($rto == 1){
			print  "   $next: mailing to $from (Reply-To)\n";
		    }
		    else{
			print  "   $next: mailing to $from\n";
		    }
		};
		
                # increment mail counter:
		$total{"$dot_group"}++;
		
		# Prepare mail:
		open(MAIL, 
		     "|$mailer -s \"Automatic reply to your test post\" $from") 
		    || next;
		
		print MAIL "$intro\n\n";
		print MAIL "Your fascinating posting with subject\n\n";
		# override first blank, if exists
		if(index($subject, " ") == 0){
		    $subject = substr($subject, 1, length($subject) -1);
		};
		print MAIL "\"$subject\"\n\n";
		print MAIL "showed up over here in newsgroup $dot_group on\n\n";
		
		
		# print date by looking at creation time of posting file:
		$_ = `$ls -l $spool_dir/$group/$next`; @recv_date = split;
		$_ = `$dt`; @year = split;
		
		print MAIL "@recv_date[4] @recv_date[5] @recv_date[6] @year[4]";
		if(index(@recv_date, ':') == $[-1){ print MAIL " @year[5]";};
		print MAIL ".\n\n";
		print MAIL "(Replies to this automatically generated e-mail ";
		print MAIL "will be discarded.\n";
		print MAIL " Direct problems/comments to ";
		print MAIL "$problems_to)\n\n";
		print MAIL "If you would rather not see these automatic ";
		print MAIL "responses, please include the\ntext \"ignore\"";
		print MAIL " or \"no reply\" anywhere in future ";
                print MAIL "test postings.\n\n";
		print MAIL "Here the first $lines lines of your posting:\n";
		print MAIL "==============================================\n\n";
		
		# Include first $lines lines of posting:
		seek(TMP,0,0);
		$actLine = 0;
		while(<TMP>){ 
		    if($actLine < $lines){ s/~//g; print MAIL; $actLine++;}
		    else { last;};
		};
		
		print MAIL 
		    "\n==============================================\n\n";
		print MAIL "$trailer\n";
		close MAIL;
		
		# If your MTA gets in trouble when e-mails are fired quickly,
		# then uncomment following line.
		sleep(1);
		
		close TMP;
	    }
	}
	# Memorize largest posting number:
	$mtimes{"$dot_group"} = $ltime; 
    }
    # Memorize largest posting number:
    # (Needed in the case where only one posting is in the directory
    #  and it is to be ignored)
    $mtimes{"$dot_group"} = $ltime; 
    if($init == 1){ print "\n";};
    closedir($dir);
}

&write_replied();
close OUTF;

# remove ``running'' file:
unlink($run);
 
