#!/usr/bin/perl
#
# Minimalist - Minimalistic Mailing List Manager.
# Copyright (c) 1999, 2000 Vladimir Litovka <doka@kiev.sovam.com>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
# THE POSSIBILITY OF SUCH DAMAGE.

use Fcntl ':flock';	# LOCK_* constants

$version = '2.2';
#$config = "/usr/local/etc/minimalist.conf";
$config = "/etc/minimalist.conf";

# Lists' status bits
$OPEN = 0;
$RO = 1;
$CLOSED = 2;
$MANDATORY = 4;

#####################################################
# Default values
#
$auth_scheme = 'password';
$adminpwd = $listpwd = '_'.$$.time.'_';		# Some pseudo-random value
$userpwd = '';
$verify = 0;		# By default eval($verify) returns false
$suffix = '';

$sendmail = '/usr/sbin/sendmail';
$delivery = 'internal';
$domain = `/bin/hostname --fqdn`; chomp $domain;
$directory = '/var/spool/minimalist';
$admin = "postmaster\@$domain";
$security = 'careful';
$archive = 'no';
$archpgm = 'BUILTIN';
$status = $OPEN;
$copy_sender = 'yes';
$reply_to_list = 'no';
$errors_to = 'drop';
$modify_subject = 'yes';
$maxusers = 0;
$maxrcpts = 20;
$maxsize = 0;		# Maximum allowed size for message (incl. headers)
$auth_valid = 24;
$logfile = 'none';

#####################################################
# Various regular expressions
#
# for matching rounding spaces

$spaces = '^\s*(.*?)\s*$';

# for parsing two forms of mailing addresses:
#
# 1st form: Vladimir Litovka <doka@kiev.sovam.com>
# 2nd form: doka@kiev.sovam.com (Vladimir Litovka)

$first = '^(.*?)\s*<(.*?)>.*';		# $1 - gecos, $2 - address
$second = '^(.*?)\s*\((.*?)\).*';	# $1 - address, $2 - gecos

# Help
$helpmsg = <<_EOF_ ;
This is the Minimalist Mailing List Manager.

All commands MUST APPEAR IN THE SUBJECT of mail messages.

Supported commands are:

subscribe <list> [<email>] :
    subscribe user to <list>. If <list> contains suffix '-writers', user
    will be able to write to this <list>, but will not receive messages
    from it.

unsubscribe <list> [<email>] :
    unsubscribe user from <list>. Can be used with suffix '-writers' (see
    above description for subscribe)

auth <code> :
    confirm command, which need to be confirmed. This command isn't
    standalone, it must be used only by Minimalist's request.

which [<email>] :
    get list of lists, to which user subscribed

info [<list>] :
    gives you information about existing lists or about <list>

who <list> :
    gives you the list of users subscribed to <list>

help :
    This message

Note, that <email> in all commands and 'who' command can be used only by
administrators (users, who mentioned in 'mailfrom' authentication scheme or
who used correct password - either global or local). Otherwise command will
be ignored. Password must be supplied in the first line of the message body
in form of:

*password: list_password

followed by any number of empty rows. This line, of course, will be
removed from the message before sending message to subscribers.
_EOF_

########################################################
# >>>>>>>>>>>>>>> SELF - CONFIGURING <<<<<<<<<<<<<<<<< #
########################################################

if ($ARGV[0] eq '-d') {
  $ARGV[1] =~ s|(.*)/$|$1|g;
  $config = $ARGV[1]."/minimalist.conf";
  shift; shift;
 }

read_config($config, "global");
$mesender = "minimalist\@$domain";	# For substitute in X-Sender header

####################################################################
# >>>>>>>>>>>>>>>>>>>>>>>> CHECK CONFIGURATION <<<<<<<<<<<<<<<<<<< #
####################################################################

if ($ARGV[0] eq '-') {
  print "\nMinimalist v$version, pleased to meet you.\n".
        "Using \"$config\" as main configuration file\n\n";
  print "NOTE: $config doesn't exist. It is allowed, but you are warned!\n\n" if (! -f $config);
  print	"================= Global configuration ================\n".
	"Directory: $directory\n".
	"Administrative password: ".($adminpwd =~ /^_.*_$/ ? "not defined\n" : "ok\n").
	"Logging: $logfile\n".
	"Authentication request valid at least $auth_valid hours\n";

  if ( @blacklist ) {
    print "Blacklist:\n";
    foreach (@blacklist) { print "\t . ".$_."\n"; }
   };

  print "\n";
  while ( $ARGV[0] ) {
    @trusted = (); read_config($config, "global");

    $list = $ARGV[0];
    if ($list ne '-') {
      if (!chdir("$directory/$list")) {
        print " * There isn't such list \U$list\E\n\n";
        shift; next;
       }
      read_config("config");
      print "================= \U$list\E ================\n".
	    "Authentication scheme: $auth_scheme\n";
      if ($auth_scheme eq 'mailfrom') {
        print "Administrators: ";
        if ( @trusted ) {
	  print "\n";
          foreach (@trusted) { print "\t . ".$_."\n"; }
         }
	else { print "not defined\n"; }
       }
      else {
        print "Administrative password: ".(! $listpwd ? "empty" :
			$listpwd =~ /^_.*_$/ ? "not defined" : "Ok")."\n"; }
     }

    print "Sendmail: $sendmail\n".
        "Delivery method: $delivery".($delivery eq 'alias' ? " (destination: $delivery_alias)\n" : "\n").
	"Domain: $domain\n".
	"Security: $security\n".
	"Archiving: $archive\n".
	  ($archive ne 'no' ? " * Archiver: $archpgm\n" : "").
	"Status:";
    if ($status) {
      print " read-only" if ($status & $RO);
      print " closed" if ($status & $CLOSED);
      print " mandatory" if ($status & $MANDATORY);
     }
    else { print " open"; }
    print "\nCopy to sender: $copy_sender\n".
	"Reply-To list: $reply_to_list\n".
	"Admin: $admin\n".
	"Errors from MTA: ".($errors_to eq 'drop' ? "drop" : "return to ".
				($errors_to eq 'admin' ? "admin" : "sender"))."\n".
	"Modify subject: $modify_subject\n".
	"Maximal users per list: ".($maxusers ? $maxusers : "unlimited")."\n".
	"Maximal recipients per message: ".($maxrcpts ? $maxrcpts : "unlimited")."\n".
	"Maximal size of message: ".($maxsize ? "$maxsize bytes" : "unlimited")."\n\n";
    
    # Various checks
    $msg .= " * $directory doesn't exist!\n" if (! -d $directory);
    $msg .= " * $sendmail doesn't exist!\n" if (! -x $sendmail);
    $msg .= " * Invalid delivery method: $delivery\n" if ($delivery !~ /^internal|^alias/i);
    $msg .= " * Invalid domain '$domain'\n" if ($domain !~ /^(\w[-\w]*\.)+[a-z]{2,4}$/i);
    $msg .= " * Invalid security level '$security'\n" if ($security !~ /^none$|^careful$|^paranoid$/i);
    $msg .= " * Invalid 'copy to sender' value '$copy_sender'\n" if ($copy_sender !~ /^yes$|^no$/i);
    $msg .= " * Invalid 'modify subject' value '$modify_subject'\n" if ($modify_subject !~ /^yes$|^no$|^more$/i);
    $msg .= " * Invalid 'reply-to list' value '$reply_to_list'\n" if ($reply_to_list !~ /^yes$|^no$|\@/i);
    $msg .= " * Invalid 'errors to' value '$errors_to'\n" if ($errors_to !~ /^drop$|^admin$|^sender$/i);
    $msg .= " * Invalid authentication request validity time: $auth_valid\n" if ($auth_valid !~ /^[0-9]+$/);
    $msg .= " * Invalid authentication scheme: $auth_scheme\n" if ($auth_scheme !~ /^mailfrom|^password/i);
    $msg .= " * Invalid archiving strategy '$archive'\n" if ($archive !~ /^no$|^daily$|^monthly$|^yearly$|^pipe$/i);
    if ($archive eq 'pipe') {
      ($arpg, ) = split(/\s+/, $archpgm, 2);
      $msg .= " * $arpg doesn't exists!\n" if (! -x $arpg);
     }

    die "\t=== CONFIGURATION FAILURE===\nErrors are:\n".$msg."\n" if ($msg);
    shift;
   }

  exit 0;
 }

####################################################################
# >>>>>>>>>>>>>>>>>>>>>>>>> START HERE <<<<<<<<<<<<<<<<<<<<<<<<<<< #
####################################################################

$list = $ARGV[0];
$auth_seconds = $auth_valid * 3600;	# Convert hours to seconds

while (<STDIN>) {
  s/\r//g;		# Remove Windooze's \r, it is safe to do this
  $message .= $_;
 }
($header, $body) = split(/\n\n/, $message, 2); $header .= "\n";

undef $message;		# Clear memory, it doesn't used anymore

#####-------------------------------------#####
# Note: mail FROM, but in most cases REPLY-TO #
#####-------------------------------------#####

$from = $reply = $sender = $xsender = $subject = '';

# Check SysV-style "From ". Stupid workaround for messages from robots, but
# with human-like From: header. In most cases "From " is the only way to
# find out envelope sender of message.
if ($header =~ /^From (.*)\n/i) {
  exit 0 if ($1 =~ /MAILER-DAEMON/i); }

# Extract From:
if ($header =~ /(^|\n)from:\s*(.*\n([ \t]+.*\n)*)/i) {
  $from = $2; $from =~ s/$spaces/$1/ogs;
  $from =~ s/\n//g; $from =~ s/\s{2,}/ /g; }

# Extract Reply-To:
if ($header =~ /(^|\n)reply-to:\s*(.*\n([ \t]+.*\n)*)/i) {
  $reply = $2; $reply =~ s/$spaces/$1/gs; }

# Sender and X-Sender are interesting only when generated by robots
# (Minimalist, MTA, etc), which don't produce multi-row headers.

if ($header =~ /(^|\n)sender: (.*)\n/i) { $sender = $2; }
if ($header =~ /(^|\n)x-sender: (.*)\n/i) { $xsender = $2; }
 
$mailto = ( $reply eq '' ? $from : $reply );

# Preparing From:
if ($from =~ s/$first/$2/og) { ($gecos = $1) =~ s/$spaces/$1/gs;}
elsif ($from =~ s/$second/$1/og) { ($gecos = $2) =~ s/$spaces/$1/gs; }
$from =~ s/\s+//gs; $from = lc($from);

exit 0 if (($xsender eq $mesender) || ($from eq $mesender));	# LOOP detected
exit 0 if (($from =~ /MAILER-DAEMON/i) ||
	   ($sender =~ /MAILER-DAEMON/i) ||
	   ($xsender =~ /MAILER-DAEMON/i));		# ignore messages from MAILER-DAEMON

foreach (@blacklist) {					# ignore messages from Black List
  exit 0 if (($from =~ /$_$/i) ||
  	     ($sender =~ /$_$/i) ||
  	     ($xsender =~ /$_$/i));
 }

$qfrom = quotemeta($from);	# For use among with 'grep' function

# Get (multiline) subject
if ($header =~ /(^|\n)subject:\s*(.*\n([ \t]+.*\n)*)/i) {
  $subject = $2; $subject =~ s/$spaces/$1/gs; }

# Get password if it's there and strip this line from message's body
if ($body =~ s/((^|\n)\*password:[ \t]+)(.*)\n+/$2/i) {
  $userpwd = $3; }

$body =~ s/\n*$//g;

#########################################################################
###################### Message for subscribers ##########################
#
if ($list) {

 if (! -d "$directory/$list" ) {
   $msg = <<_EOF_ ;
From: Minimalist Manager <$me>
To: $admin
Subject: Possible error in system settings

ERROR:
    Minimalist was called with '$list' argument, but there isn't such
    list in '$directory'.

SOLUTION:
    Check your 'aliases' file - there is possible typo.

_EOF_
   goto SendMessage;	# Send message and exit.
  }

 chdir("$directory/$list");
 read_config("config");

 if ($modify_subject ne 'no') {
   if ($modify_subject eq 'more') {	# Remove leading "Re: "
     $subject =~ s/^.*:\s+(\[$list\])/$1/ig }
   else {				# change anything before [...] to Re:
     $subject =~ s/^(.*:\s+)+(\[$list\])/Re: $2/ig; }

   # Modify subject if it don't modified before
   if ($subject !~ /^(.*:\s+)?\[$list\] /i) {
     $subject = "[$list] ".$subject; }
  }
  
 open LIST, "list" and do {
   while (<LIST>) {
     if ( $_ !~ /^#/ ) { $users .= $_; }	# Ignore comments
    }
   close LIST;
   @members = split ("\n", $users);
  };
 
 if (($security ne 'none') && !eval($verify)) {
   @rw = @members;
   open LIST, "list-writers" and do {
     while (<LIST>) { if ( $_ !~ /^#/ ) { $others .= $_; } }; close LIST;
     push (@rw, split ("\n", $others));
    }
  }

 if (@rw && !grep(/^$qfrom$/i, @rw)) {	# @rw means ($security ne 'none' && !eval($verify))
   $msg = <<_EOF_ ;
From: Minimalist Manager <$me>
To: $mailto
Subject: $subject

ERROR:
    You ($from) are not subscribed to this list.

SOLUTION:
    Send a message to minimalist\@$domain with a subject
    of 'info' (no quotes) for information about subscribing.

===========================================================================

$body
_EOF_
  } 

 elsif (($status & $RO) && !eval($verify)) {
   $msg = <<_EOF_ ;
From: Minimalist Manager <$me>
To: $mailto
Subject: $subject

ERROR:
    You are not allowed to write to this list.

===========================================================================

$body
_EOF_
  }
 elsif ($maxsize && (length($header) + length($body) > $maxsize)) {
   $header = substr($header, 0, 4000);	# Send first 4000 bytes of header, not more
   $msg = <<_EOF_ ;
From: Minimalist Manager <$me>
To: $mailto
Subject: $subject

ERROR:
    Message size is larger than maximum allowed ($maxsize bytes).

SOLUTION:
    Either send a smaller message or split your message into multiple
    smaller ones.

===========================================================================
Header of your message follows:

$header
_EOF_
  }
 else {		# Ok, all checks done.

   if ($archive eq 'pipe') { arch_pipe(); }
   elsif ($archive ne 'no') { archive(); }

   # Extract (and remove from header) recipients of message. This
   # information will be used later, when sending message to to members
   # except those who already received this message directly.

   # Get all recipients from To: and Cc: (expect multi-line)
   if ($header =~ s/(^|\n)to:\s*(.*\n([ \t]+.*\n)*)/$1/i) {
     $rc = $2; @recip = split(/[\n,]/, $rc); }
   if ($header =~ s/(^|\n)cc:\s*(.*\n([ \t]+.*\n)*)/$1/i) {
     $rc = $2; push (@recip, split(/[\n,]/, $rc)); }

   # Remove conflicting headers
   $header =~ s/x-mailing-list.*\n([ \t]+.*\n)*//ig;
   $header =~ s/x-sender: .*\n([ \t]+.*\n)*//ig;
   $header =~ s/precedence: .*\n//ig;

   $header =~ s/\n*$//g;
   $header .= "\nTo: $list\@$domain\n";	# Mail to himself, loop handled
   $header .= "Precedence: list\n";	# For vacation and similar programs

   if ($reply_to_list ne 'no') {
     $header =~ s/(^|\n)reply-to: .*\n([ \t]+.*\n)*/$1/ig;
     if ($reply_to_list eq 'yes') { $header .= "Reply-To: $list\@$domain\n"; }
     else { $header .= "Reply-To: $reply_to_list\n"; }
    }
   if ($modify_subject ne 'no') {
     $header =~ s/(^|\n)subject: .*\n([ \t]+.*\n)*/$1/ig;
     $header .= "Subject: $subject\n";
    }

   $footer = read_info("footer");

   if ($delivery eq 'internal') {

     foreach (@recip) {
       s/$first/$2/g || s/$second/$1/g ;
       s/\s+//gs;
       push (@rcpts, lc($_));
      }

     if ($copy_sender eq 'no') { push (@rcpts, $from) }	# @rcpts will be _excluded_

     @members = sort @members; @rcpts = sort @rcpts;

     for ($r=0, $m=0; $m < @members; ) {
       if ($r >= @rcpts || $members[$m] lt $rcpts[$r]) {
	 push (@recipients, $members[$m++]); }
       elsif ($members[$m] eq $rcpts[$r]) { $r++; $m++; }
       elsif ($members[$m] gt $rcpts[$r]) { $r++ };
      }

     #########################################################
     # Send message to recipients ($maxrcpts per message)

     $maxrcpts = $#recipients + 1 if ($maxrcpts == 0);	# Unlimited?

     $rcs = 0;
     foreach $one (@recipients) {
       if ($rcs == $maxrcpts) {
	 sendPortion();
	 $bcc = ''; $rcs = 0;	# Clear counters
	}
       if ($one ne '') {
	 $bcc .= "$one,"; $rcs++; }
      }

     sendPortion() if ($bcc ne '');	# Send to rest subscribers
    }
   else {	# Alias delivery
     $msg .= $header."X-Sender: $mesender\n".
		"X-Mailing-List: $list\@$domain\n".
		"X-Mailing-List-Owner: $list-owner\@$domain\n".
		"X-Mailing-List-Server: Minimalist v$version\n\n".
	     $body."\n\n".$footer;

     open MAIL, "| $sendmail $envelope_sender $delivery_alias";
     print MAIL $msg."\n";
     close MAIL;
    }

   $msg = '';	# Clear message, don't send anything anymore
  }

} else {

#########################################################################
######################## Message to Minimalist ##########################
#
# Allowed commands:
#	subscribe <list> [<e-mail>]
#	unsubscribe <list> [<e-mail>]
#	auth <code>
#	which [<e-mail>]
#	info [<list>]
#	who <list>
#	help

 $subject =~ s/^.*: //g;	# Strip leading 'Anything: '

 $list = ''; $email = '';
 ($cmd, $list, $email) = split (/\s+/, $subject, 3);
 $cmd = lc($cmd); $list = lc($list);

 if ($email ne '') {
   $email =~ s/$first/$2/g || $email =~ s/$second/$1/g ;
   $email =~ s/\s+//gs; $email = lc($email);
  }

 $msg = "From: Minimalist Manager <$me>\n".
	"To: $mailto\n".
	"Subject: Re: $subject\n".
	"X-Sender: $mesender\n".
	"X-Mailing-List-Server: Minimalist v$version\n";
 
 if ($cmd eq 'help') {
   $msg .= "\n".$helpmsg; }

 elsif ($cmd eq 'auth' && ($authcode = $list)) {
   ($cmd, $list, $email) = getAuth($authcode);
   if ($cmd eq 'subscribe' || $cmd eq 'unsubscribe') { 
     chdir "$directory/$list";
     read_config("config");
     $owner = "$list-owner\@$domain";
     if (eval("$cmd(0)") && $logfile ne 'none') {
       &logCommand("$cmd $list$suffix".($email eq $from ? "" : " $email")); }
    }
   else {
     $msg .= "\nERROR:\n\tThere is no authentication request with such code: $authcode\n".
             "\nSOLUTION:\n\tNone.";
    }
  }

 elsif ($cmd eq 'which') {
   $email = $list;	# $list means $email here
   if ($email && ($email ne $from) && !eval($verify)) {
     $msg .= "\nERROR:\n\tYou are not allowed to get subscription of other users.\n".
             "\nSOLUTION:\n\tNone.";
    }
   else {
     &logCommand($subject) if ($logfile ne 'none');
     $email = $from if (! $email);

     $msg .= "\nCurrent subscription of user $email :\n\n";
     chdir $directory;
     opendir DIR, ".";
     while ($dir = readdir DIR) {
       if (-d $dir && $dir !~ /^\./) {	# Ignore entries starting with '.'
	 foreach $f ("", "-writers") {
           open LIST, "$dir/list".$f and do {
             while (<LIST>) {
               chomp($_);
               if ($email eq $_) { $msg .= "* \U$dir\E$f\n"; last; }
              }
             close LIST;
	    }	# open LIST
	  }	# foreach
        }
      }
     closedir DIR;
    }
  }

 else {		# Rest commands (sub/unsub/info/who) use list's name as argument
 
 if ($list =~ s/^(.*?)(-writers)$/$1/) {	# -writers ?
   $suffix = $2; }
 
 if ( ($list ne '') && (! -d "$directory/$list") ) {
   $msg .= <<_EOF_ ;

ERROR:
    There is no such list \U$list\E here.

SOLUTION:
    Send a message to minimalist\@$domain with a subject
    of 'info' (no quotes) for a list of available mailing lists.
_EOF_
  }

 elsif ( (($cmd eq 'subscribe') || ($cmd eq 'unsubscribe')) && ($list ne '') ) {
   $melist = "$list\@$domain";

   # Check for possible loop
   exit 0 if (($from eq $melist) || ($email eq $me) || ($email eq $melist));

   chdir "$directory/$list";
   read_config("config");
   $owner = "$list-owner\@$domain";

   if (eval($verify)) {
     &logCommand($subject) if (eval("$cmd(1)") && $logfile ne 'none');
    }
   elsif (($email ne '') && ($email ne $from)) {
     $msg .=  "\nERROR:\n\tYou aren't allowed to subscribe other persons.\n".
	      "\nSOLUTION:\n\tNone.";
    }
   elsif (($cmd eq 'subscribe') && ($status & $CLOSED)) {
     $msg .=  "\nERROR:\n\tSorry, this list is closed for you.\n".
	      "\nSOLUTION:\n\tAre you unsure? Please, complain to $owner";
    }
   elsif (($cmd eq 'unsubscribe') && ($status & $MANDATORY)) {
     $msg .=  "\nERROR:\n\tSorry, this list is mandatory for you.\n".
	      "\nSOLUTION:\n\tAre you unsure? Please, complain to $owner";
    }
   else {
     if ($security ne 'paranoid') {
       &logCommand($subject) if (eval("$cmd(0)") && $logfile ne 'none'); }
     else {
       $authcode = genAuth();
       $msg = <<_EOF_ ;
From: Minimalist Manager <$me>
To: $from
Subject: auth $authcode

Your request

	$subject

must be authenticated. To accomplish this, send another request
to $me (or just press 'Reply' in your mail reader)
with the following subject:

       auth $authcode

This authentication request valid for next $auth_valid hours from
now. After this term it will be discarded.
_EOF_
      }        # paranoid security
    }
  }	# subscribe/unsubscribe

 elsif ($cmd eq 'info') {
   &logCommand($subject) if ($logfile ne 'none');
   if ($list ne '') {
     $msg .= "\nHere is the available information about \U$list\E\n\n";
     $msg .= read_info("$directory/$list/info");
    }
   else {
     $msg .= "\nThese are the mailing lists available at $domain:\n\n";
     if (open(INFO, "$directory/lists.lst")) {
       while (<INFO>) {
         $msg .= $_ if (! /^#/); }
       close INFO;
      }
    }
  }

 elsif (($cmd eq 'who') && ($list ne '')) {
   chdir "$directory/$list";
   read_config("config");

   if (eval($verify)) {
     &logCommand($subject) if ($logfile ne 'none');
     $msg .= "\nUsers, subscribed to \U$list\E$suffix:\n\n";
     if (open(LIST, "list".$suffix)) {
       while (<LIST>) {
         if ($_ !~ /^#/) { $msg .= $_; }
	}
       close LIST;
      }
    }
   else {
     $msg .= "\nERROR:\n\tYou aren't allowed to get listing of subscribed users.\n".
     	     "\nSOLUTION:\n\tNone.";
    }
  }

 else {
   $msg .= "\nERROR:\n\tBad syntax or unknown instruction.\n".
   	   "\nSOLUTION:\n\n$helpmsg";
  }

  }	# Rest commands

 cleanAuth();		# Clean old authentication requests
}

SendMessage:

if ($msg ne '') {
  $msg =~ s/\n*$//g;
  open MAIL, "| $sendmail -t $envelope_sender";
  print MAIL "$msg\n\n-- \nSincerely, the Minimalist\n";
  close MAIL;
 }

exit 0;

#########################################################################
######################## Supplementary functions ########################

#................... SUBSCRIBE .....................
sub subscribe {

 my ($trustedcall) = @_;
 my ($cc);

 if ($email) { $cc = "$email," if ($email ne $from); }
 else { $email = $from; }

 if (open LIST, "list".$suffix) {
   $users .= $_ while (<LIST>);
   close LIST;
   @members = split ("\n", $users);
   $eml = quotemeta($email);
   if (grep(/^#*$eml$/i, @members)) {
     $deny = 1;
     $cause = "you already subscribed to \U$list\E$suffix";
    }
   elsif (!$trustedcall && $maxusers > 0 ) {
     if ($suffix) { open LIST, "list" }		# Count both readers/writers and writers
     else { open LIST, "list-writers" }
     $others .= $_ while (<LIST>);
     close LIST;
     push (@members, split ("\n", $others));
     if (@members >= $maxusers) {
       $deny = 1; $cc .= "$owner,";
       $cause = "there are already maximal count of subscribers ($maxusers) at \U$list\E";
      }
    }
   open LIST, ">>list".$suffix if (!$deny);
  }
 else { open LIST, ">list".$suffix; } 

 if ($cc) {
   chop $cc;
   $msg .= "Cc: $cc\n";
  }

 $msg .= "\nDear $email,\n\n";

 if (! $deny) {
   &lockf(LIST, 'lock'); print LIST "$email\n"; &lockf(LIST);
   $msg .= <<_EOF_ ;
    You have subscribed to \U$list\E$suffix successfully.

Please, note the following:
_EOF_
   $msg .= "\n".read_info("info");
  }
 else {
   $msg .= <<_EOF_ ;
You haven't subscribed to \U$list\E$suffix due to the following reason:

    * $cause.

If you have comments or questions, please, send them to the list
administrator $owner.
_EOF_
  }

 !$deny;
}

#................... UNSUBSCRIBE .....................
sub unsubscribe {

 if ($email) { $msg .= "Cc: $email\n" if ($email ne $from); }
 else { $email = $from; }

 if (open LIST, "list".$suffix) {
   $users .= $_ while (<LIST>);
   close LIST;

   if ($users =~ s/(^|\n)$email\n/$1/g) {
     open LIST, ">list".$suffix;
     &lockf(LIST, 'lock'); print LIST $users; &lockf(LIST);
     $msg .= "\nUser $email has successfully unsubscribed.\n";
     $ok = 1;
    }
   else {
     $msg .= "\nUser $email isn't registered member of this list.\n";
     $ok = 0;
    }
  }

 $ok;
}

#................... READ CONFIG .....................
sub read_config {

my ($fname, $global) = @_;

if (open(CONF, $fname)) {
  while (<CONF>) {

    s/^\s*//gs;
    if($_ =~ /^#/) {

    #............... Global variables .................#

    } elsif (($_ =~ /^directory/i) && $global) {
     ($directive, $directory) = split(/=/, $_);
     $directory =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^password/i && $global) {
     ($directive, $adminpwd) = split(/=/, $_);
     $adminpwd =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^request valid/i && $global) {
     ($directive, $auth_valid) = split(/=/, $_);
     $auth_valid =~ s/$spaces/$1/gs; $auth_valid = lc($auth_valid);

    } elsif (($_ =~ /^blacklist/i) && $global) {
     ($directive, $black) = split(/=/, $_, 2);
     $black =~ s/\s+//g;
     push (@blacklist, expand_lists(split(':', $black)));

    } elsif (($_ =~ /^logfile/i) && $global) {
     ($directive, $logfile) = split(/=/, $_);
     $logfile =~ s/$spaces/$1/gs;

    # .............. Global and local variables .............. #

    } elsif ($_ =~ /^sendmail/i) {
     ($directive, $sendmail) = split(/=/, $_);
     $sendmail =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^delivery/i) {
     ($directive, $delivery) = split(/=/, $_);
     $delivery =~ s/$spaces/$1/gs;

     if ($delivery =~ s/^alias\s+//i) {
       $delivery_alias = $delivery; $delivery = 'alias';
      }

    } elsif ($_ =~ /^domain/i) {
     ($directive, $domain) = split(/=/, $_);
     $domain =~ s/$spaces/$1/gs;

     # External program?
     if ($domain =~ /^\|/) {
       $domain = eval("`".substr($domain, 1)."`");
       chomp $domain;
      }

    } elsif ($_ =~ /^admin/i) {
     ($directive, $admin) = split(/=/, $_);
     $admin =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^errors to/i) {
     ($directive, $errors_to) = split(/=/, $_);
     $errors_to =~ s/$spaces/$1/gs; $errors_to = lc($errors_to);

    } elsif ($_ =~ /^security/i) {
     ($directive, $security) = split(/=/, $_);
     $security =~ s/$spaces/$1/gs; $security = lc($security);

    } elsif ($_ =~ /^archive/i) {
     ($directive, $archive) = split(/=/, $_);
     $archive =~ s/$spaces/$1/gs;

     if ($archive =~ s/^pipe\s+//i) {
       $archpgm = $archive;
       $archive = "pipe"; }
     else {
       $archpgm = 'BUILTIN';
       $archive =~ s/$spaces/$1/gs; $archive = lc($archive);
      }

    } elsif ($_ =~ /^status/i) {
     ($directive, $status) = split(/=/, $_);
     $status =~ s/\s+//g;	# Remove any spaces
     $status = lc($status);

     # Calculate mask for status
     %strel = ("open", $OPEN, "ro", $RO, "closed", $CLOSED, "mandatory", $MANDATORY);
     @starr = split(/,/, $status);
     $status = 0;
     foreach (@starr) { $status += $strel{$_}; }

    } elsif ($_ =~ /^copy to sender/i) {
     ($directive, $copy_sender) = split(/=/, $_);
     $copy_sender =~ s/$spaces/$1/gs; $copy_sender = lc($copy_sender);

    } elsif ($_ =~ /^reply-to list/i) {
     ($directive, $reply_to_list) = split(/=/, $_);
     $reply_to_list =~ s/$spaces/$1/gs; $reply_to_list = lc($reply_to_list);

     # In global config only 'yes' or 'no' allowed
     if ($global && ($reply_to_list ne 'yes')) { $reply_to_list = 'no'; }

    } elsif ($_ =~ /^modify subject/i) {
     ($directive, $modify_subject) = split(/=/, $_);
     $modify_subject =~ s/$spaces/$1/gs; $modify_subject = lc($modify_subject);

    } elsif ($_ =~ /^maxusers/i) {
     ($directive, $maxusers) = split(/=/, $_);
     $maxusers =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^maxrcpts/i) {
     ($directive, $maxrcpts) = split(/=/, $_);
     $maxrcpts =~ s/$spaces/$1/gs;

    } elsif ($_ =~ /^maxsize/i) {
     ($directive, $maxsize) = split(/=/, $_);
     $maxsize =~ s/$spaces/$1/gs;

    #.................... Only local variables ..................#

    } elsif ($_ =~ /^auth/i && !$global) {
     ($directive, $scheme) = split(/=/, $_, 2); $scheme =~ s/$spaces/$1/gs;
     ($auth_scheme, $auth_args) = split(/\s+/, $scheme, 2); $auth_scheme = lc($auth_scheme);

     if ($auth_scheme eq 'mailfrom') {
       $auth_args =~ s/\s+//g;
       @trusted = expand_lists(split(':', $auth_args));
      }
     else { $listpwd =  $auth_args; }
    }
  }
  close CONF;
 }

 if ( ($auth_scheme eq 'mailfrom') && @trusted ) {
   $verify = 'grep(/^$qfrom$/i, @trusted) || ($userpwd eq $adminpwd)'; }
 else {
   $verify = '($userpwd eq $listpwd) || ($userpwd eq $adminpwd)'; }

 $me = "minimalist\@$domain";

 if ($errors_to eq 'drop') { $envelope_sender = "-f $me"; }
 elsif ($errors_to eq 'admin') { $envelope_sender = "-f $admin"; }
 else { $envelope_sender = ""; }
}

#..........................................................
sub expand_lists {
 my (@junk) = @_;
 my (@result);

 foreach $s (@junk) {
   if ( $s =~ s/^\@// ) {	# Expand items, starting with '@'
     if (open(IN, $s)) {
       while (<IN>) {
         chomp $_; $result[@result] = $_; }
       close IN;
      }
    }
   elsif ($s ne '') { $result[@result] = $s; }
  }
 @result;
}

#.......... Read file and substitute all macroses .........
sub read_info {
 my ($fname) = @_;
 my ($tail);

 if (open(TAIL, $fname)) {
   $tail .= $_ while (<TAIL>);
   close TAIL;

   $tail =~ s/\\a/$admin/ig;
   $tail =~ s/\\d/$domain/ig;
   $tail =~ s/\\l/$list/ig;
   $tail =~ s/\\o/$list-owner\@$domain/ig;
  }
 if ($tail) { $tail }
 else { '' };
}

#.......... Send ready portion of message ............
sub sendPortion {

 chop $bcc;
 $temphdr = $header . "Bcc: $bcc\n";
 $temphdr .= "X-Sender: $mesender\n".
 "X-Mailing-List: $list\@$domain\n".
 "X-Mailing-List-Owner: $list-owner\@$domain\n".
 "X-Mailing-List-Server: Minimalist v$version\n\n";
 $msg = $temphdr.$body."\n\n".$footer;

 open MAIL, "| $sendmail -t $envelope_sender";
 print MAIL $msg."\n";
 close MAIL;
}

#.................... Built-in archiver ..........................
sub archive {

 @date = localtime;
 $year = 1900 + $date[5];
 $month = 1 + $date[4];
 $day = $date[3];

 $path = "archive/";
 mkdir($path, 0755) if (! -d $path);

 @types = ("yearly", "monthly", "daily");
 %rel = ($types[0], $year, $types[1], $month, $types[2], $day);

 foreach $key (@types) {
   $path .= $rel{$key}."./";
   mkdir($path, 0755) if (! -d $path);
   last if ($key eq $archive);
  }

 if (open(NUM, $path."SEQUENCE")) {
   read NUM, $msgnum, 16;
   $msgnum = int($msgnum);
   close NUM;
  }
 else { $msgnum = 0 }

 open ARCHIVE, ">$path".$msgnum;
 print ARCHIVE $header."\n".$body;
 close ARCHIVE;

 open NUM, ">$path"."SEQUENCE";
 print NUM $msgnum+1;
 close NUM;
}

#.................... External archiver ..........................
sub arch_pipe {

 open (ARCHIVE, "| $archpgm");
 print ARCHIVE $header."\n".$body;
 close (ARCHIVE);
}

#.................... Generate authentication code ...............
sub genAuth {

 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
 my ($authcode) = $mon.$mday.$hour.$min.$sec."-$$";

 mkdir ("$directory/.auth", 0750) if (! -d "$directory/.auth");

 open AUTH, ">$directory/.auth/$authcode";
 print AUTH "$cmd $list$suffix $from\n";
 close AUTH;

 $authcode;
}

#................. Check for authentication code ...............
sub getAuth {

 my ($cmd, $list, $from);
 my ($authcode) = @_;
 my ($authfile) = "$directory/.auth/$authcode";

 if ($authcode =~ /^[0-9]+\-[0-9]+$/) {
   open AUTH, $authfile and do {
     $authtask = <AUTH>; chomp $authtask;
     close AUTH; unlink $authfile;

     ($cmd, $list, $from) = split(/ /, $authtask);

     if ($list =~ s/^(.*?)(-writers)$/$1/) {	# -writers ?
       $suffix = $2; }

     ($cmd, $list, $from);
    }
  }
}

#............... Clean old authentication requests .............
sub cleanAuth {

 my $now = time;
 my $dir = "$directory/.auth";
 my $mark = "$dir/.lastclean";

 if (! -f $mark) { open LC, "> $mark"; close LC; return; }
 else {
   my @ftime = stat(_);
   return if ($now - $ftime[9] < $auth_seconds);	# Return if too early
  }

 utime $now, $now, $mark;	# Touch .lastclean
 opendir DIR, $dir;
 while ($entry = readdir DIR) {
   if ($entry !~ /^\./ && -f "$dir/$entry") {
     @ftime = stat(_);
     unlink "$dir/$entry" if ($now - $ftime[9] > $auth_seconds);
    }
  }
 closedir DIR;
}

#............................ Locking .........................
sub lockf {
 my ($FD, $lock) = @_;

 if ($lock) {		# Lock FD
   flock $FD, LOCK_EX;
   seek $FD, 0, 2;
  }
 else {			# Unlock FD and close it
   flock $FD, LOCK_UN;
   close $FD;
  }
}

#......................... Logging activity ....................
sub logCommand {

 my ($command) = @_;

 $command =~ s/\n+/ /g; $command =~ s/\s{2,}/ /g;	# Prepare for logging

 open FILE, ">>$logfile"; &lockf(FILE, 1);
 @ct = localtime(); $gecos = "($gecos)" if ($gecos);

 printf FILE "%s %02d %02d:%02d %d %s\n",
   (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$ct[4]],
   $ct[3], $ct[2], $ct[1], 1900+$ct[5], "$from $gecos: $command";
 &lockf(FILE);
}
