# ToList: A minimal mailing list forwarder. 
# Copyright (c) 1997 by Tommy Anderberg.
 
# Usage: "$0 <list tag> <address file> [<header file>]"
 
$leadingWhiteSpace       = '^\s';
$trailingWhiteSpace      = '$\s';
$emptyLine               = '^\n';
$leadingExclamationPoint = '^!';
 
# Get list tag
 
if ($#ARGV < 1)
{
   exit(1);
}
 
$listTag = shift(@ARGV);
 
# Read message from STDIN
 
@forwardedMessage = <STDIN>;
 
# Check for list tag in Subject: line of forwarded message
 
$subjectPattern = '^Subject: ';
$toListPattern  = $subjectPattern . $listTag;
 
foreach $line (0..$#forwardedMessage)
{
   if ($forwardedMessage[$line] =~ /$emptyLine/)
   {
     # Checked all header lines
 
     last;
   }
 
   if ($forwardedMessage[$line] =~ /$subjectPattern/)
   {
      # Found Subject: line; check if it's tagged for list posting
 
      if ($forwardedMessage[$line] =~ /$toListPattern/) 
      {
         # Subject: line with list tag found! Create new subject line 
         # without list tag (loop ensures that any list tag[s] chained
         # after the first one are removed too) 
 
         $subjectLine = $forwardedMessage[$line];
 
         do
         {
            $subjectLine =~ s/$toListPattern//;
         } while ($subjectLine =~ /$toListPattern/);
 
         # Remove trailing white space
 
         $subjectLine =~ s/$trailingWhiteSpace//;
      }
  
      last; # Only the first Subject: line counts!
   }
}
 
# If Subject: line with list tag not found, this message is
# not meant for posting to the list; exit
 
unless (defined($subjectLine))
{
   exit(0);
}
 
# Get sender's address
 
$fromPattern = '^From: ';
 
foreach $line (0..$#forwardedMessage)
{
   if ($forwardedMessage[$line] =~ /$emptyLine/)
   {
     last;
   }
 
   if ($forwardedMessage[$line] =~ /$fromPattern/)
   {
     if ($forwardedMessage[$line] =~ /([\w-.]+\@[\w-.]+){1}/)
     {
        $sendersAddress = $1;
     }
 
     last;
   }
}
 
# If no valid sender address, abort
 
unless (defined($sendersAddress))
{
   exit(2);
}
 
# Get address file
 
$addressFile = shift(@ARGV);
 
# If address file opens OK, read contents; if not, abort
   
if (open(INFILE, $addressFile))
{
   @addresses = <INFILE>;
   close(INFILE);
}
else
{
   # Could not read address file
   
   exit(3);
}
 
# Verify that sender is in address file
 
foreach $line (0..$#addresses)
{  
   $address = @addresses[$line];
 
   $address =~ s/$leadingWhiteSpace//;  # Remove leading white space
   $address =~ s/$trailingWhiteSpace//; # Remove trailing white space
 
   # Special: addresses preceded by an exclamation point are
   # allowed to post, but do not receive any mail from the list. 
   # This allows the list owner to post without having to receive 
   # all messages going to the list twice (directly to the mail
   # box AND through ToList).
 
   $address =~ s/$leadingExclamationPoint//;
 
   if ((uc($address) cmp uc($sendersAddress)) == 0)
   {
      # Found sender's address in address file!
   
      $authorized = TRUE;
 
      last;
   }
}
 
# If sender is not in address file, mail back and say so
 
unless (defined($authorized))
{
   if (open(MAIL, '| /usr/lib/sendmail -t -n -oi'))
   {
      # Send it!
 
      print MAIL "To: $sendersAddress\n";
      print MAIL "Subject: Unauthorized $listTag posting\n";
      print MAIL "\n";
      print MAIL "This is an automatically generated reply.\n";
      print MAIL "\n";
      print MAIL "The address $sendersAddress could not be recognized as\n";
      print MAIL "belonging to a $listTag subscriber. Only subscribers can\n";
      print MAIL "post to the $listTag list. If you subscribe through another\n";
      print MAIL "account, use that account to post. If your account name\n";
      print MAIL "has changed, contact the list owner.\n";
      print MAIL "\n";
      print MAIL "Here is the message which you tried to post:\n";
      print MAIL "\n";
      print MAIL @forwardedMessage;
      close MAIL;
   }
 
   exit(0);
}
 
# Remove original header info
 
foreach $line (0..$#forwardedMessage)
{
   if ($forwardedMessage[$line] =~ /$emptyLine/)
   {
     last;
   }
 
   $forwardedMessage[$line] = '';
}
 
# If a header file has been specified, get it
 
unless ($#ARGV < 0)
{
   $headerFile = shift(@ARGV);
}
 
if (defined($headerFile))
{   
   # If header file opens OK, read contents; if not, abort
   
   if (open(INFILE, $headerFile))
   {
      @headerMessage = <INFILE>;
      close(INFILE);
   }
   else
   {
      # Could not read header file
   
      exit(4);
   }
}
 
# Send a copy to each address
 
foreach $address (@addresses)
{   
   $address =~ s/$leadingWhiteSpace//;  # Remove leading white space
   $address =~ s/$trailingWhiteSpace//; # Remove trailing white space
   
   # Don't forward anything to addresses preceded by exclamation points
   
   unless ($address =~ /$leadingExclamationPoint/)
   {
      if (open(MAIL, '| /usr/lib/sendmail -t -n -oi'))
	  {
         # Send it!
 
         print MAIL "To: $address\n";
         print MAIL "Subject: $subjectLine\n";
         print MAIL "Original sender: $sendersAddress\n";
 
         if (defined(@headerMessage))
         {
            print MAIL "@headerMessage";
         }
         print MAIL @forwardedMessage;
         close MAIL;
      }
   }
}
   
exit(0);