#!/usr/bin/perl -w
#
##########################################################################
#
#  modappbot : Robot-moderator by e-mail
#
# version : 0.4.6, 16 Sep 1998
#
# Copyright (c) 1997-1998, Sylvain Nierveze (sn@penelope.frmug.org)
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
# You are encouraged to send modifications to the author for future
# integration.
#
# ABSOLUTELY NO WARRANTY WITH THIS SOFTWARE. USE IT AT YOUR OWN RISKS.
#
# Report : Please report bugs directly to the author (sn@penelope.frmug.org).
#          Do not forget to mention your version of modappbot,
#          Perl and operating sytem.
#          Be sure that you are using the latest version of this script.
#          (Check <URL:http://www.frmug.org/usenet/mod/>)
#
#          You should also subscribe to the modapp/modappbot mailing-list.
#          To do so :
#  $ echo 'subscribe modappbot Firstname Lastname' | mail listserv@efrei.fr
#
##########################################################################
#
# Pre-requisites:
# - Perl 5.004 or greater
# - Un*x sendmail (Net::SMTP cannot be used anymore)
# - Un*x rnews (Net::NNTP or News::NNTPClient cannot be used anymore)
# - MailTools (Mail::Internet, Mail::Address, Mail::Head)
#   implying libnet and Data::Dumper
# - Mail::Folder
# - Date::Manip
# Please read LISEZMOI for installation instruction of the Perl modules.
#
# Installation:
#  - check the perl location (first line of this file) and read LISEZMOI.
#
##########################################################################
# Changes :
#
# See CHANGEMENTS file for details.
#
##########################################################################
#
# Credits :
# * Laurent Sintes (sintes@dial.oleane.com) for help in the program design
# * Guy Decoux (decoux@moulon.inra.fr) for many subroutines
# * Russ Allbery (rra@stanford.edu) for cleanarticle borrowed from News::Gateway
# * the moderators of fr.comp.os.linux.moderated and fr.comp.applications.libres
#   and the readers for their support during the development
#
##########################################################################

# Location of the configuration file
my $configfile="/etc/modappbot/modappbot.conf";

#######################################################
###### THERE'S NOTHING TO CHANGE BELOW THIS LINE ######
#######################################################

my $version= "0.4.6";

require 5.004;

# Modules from the standard library
use strict;
use sigtrap;
#use diagnostics -verbose;
use Carp;
use File::Basename;
use File::Copy;
use File::Path;
use FileHandle;
use Getopt::Std;
use Sys::Hostname;

# Additional modules
use Mail::Header;
use Mail::Address;
use Mail::Folder::Mbox;
use Date::Manip;

# Default global values
# All these variables can be defined in the configuration file
# except the variables beginning with a 'f' at the end of the hash table
my %defmopt = ('confdir' => '/home/modapp/etc',
            'spooldir' => '/home/modapp/spool',
            'archivedir' => '/home/modapp/archive',
            'mailboxdir' => '/home/modapp/spool/mailboxes',
            'admin'=> 'root', 
            'warnadmin' => 'yes', 
            'logfile' => '/home/modapp/etc/logfile',
            'loglevel' => 2, 
            'mailcmd'=> '/usr/sbin/sendmail',
            'mailopts' => '-oem -t -f nobody',
            'newscmd' => '/usr/local/bin/rnews',
# before INN 2.2            'newsopts' => '-h localhost -v -S NNTPSERVER',
            'newsopts' => '-h localhost -v',
            'from' => 'modappbot (Modappbot)',
            'nntpserver' => 'localhost',
            'moderators' => 'moderators.isc.org',
            'nosubject' => 'no subject',
            'maxgroups' => 4,
            'maxfollowups' => 1,
            'maxarchive' => '10000',
            'maxspool' => '10000',
            'lockretries' => '10',
            'locksleep' => '3',
            'lockext' => '.lock',
            'mailbox' => 'modappbot',
            'sender' => 'modappbot@penelope.frmug.org',
            'articledbexpire' => 20,
            'subjectdbexpire' => 20,
            'fmodappbotlock' => '/tmp/modappbot.lock',
            'fackmsg' => 'ackmsg',
            'ferrormsg' => 'errormsg',
            'fmoderators' => 'moderators',
            'fhelpfile' => 'helpfile',
            'fadminhelpfile' => 'adminhelpfile',
            'farticlesdb' => 'articles',
            'fblacklist' => 'blacklist',
            'fwhitelist' => 'whitelist',
            'fsubjectdb' => 'subjectdb',
            'fconfigfile' => 'modappbot.conf',
            'fsignature' => 'signature',
            'fackdb' => 'ackdb',
            );

# Some global variables
my %groups=();
my %moderators=();
my %administrators=();
my %db;
my $err;

use vars qw($opt_c $opt_h $opt_t $opt_v);

# Valid definition group variables in configuration file
my @gconfigkeys=qw (password from includearticle
                    sendarticles refuse archive whitelist blacklist 
                    blacksubject whitesubject ack autopost refusecc
                    subjectdb subjectdbexpire mailbox followup 
                    organization checkrefs articledbexpire nntpserver
                   );

# Valid definition main variables in configuration file
my @mconfigkeys=qw (mailcmd admin warnadmin loglevel logfile 
                    adminpw maxgroups maxfollowups activefile from 
                    lockretries noreply locksleep spooldir confdir archivedir 
                    maxarchive maxspool mailboxdir mailbox sender
                    nntpserver moderators newscmd articledbexpire
                    mailopts newsopts nosubject organization
                   );

my %months= (Jan=>1, Feb=>2, Mar=>3, Apr=>4,  May=>5,  Jun=>6, 
             Jul=>7, Aug=>8, Sep=>9, Oct=>10, Nov=>11, Dec=>12);

# Headers to delete
my @delheaders=qw (Received To Lines Mail-From Old-To X-Trace X-Complaints-To);
# Headers to keep. All other headers are renamed with an 'X-' except
# those which already begin with an 'X-'
my @keepheaders=qw (Newsgroups From Reply-To Organization Message-ID
                    Subject Expires Supersedes References
                    Summary Keywords Followup-To Control Mime-Version
                    Content-Type Content-Transfer-Encoding Mail-Copies-To
                   );

# Accents conversion - See cleanarticle
my %accents = (
'' => 'A', '' => 'A', '' => 'A', '' => 'A', '' => 'A', '' => 'A', 
'' => 'AE', '' => 'C', '' => 'E', '' => 'E', '' => 'E', '' => 'E', 
'' => 'I', '' => 'I', '' => 'I', '' => 'I', '' => 'D', '' => 'N', 
'' => 'O', '' => 'O', '' => 'O', '' => 'O', '' => 'O', '' => 'O', 
'' => 'U', '' => 'U', '' => 'U', '' => 'U', '' => 'Y', '' => 'P', 
'' => 'ss', '' => 'a', '' => 'a', '' => 'a', '' => 'a', '' => 'a', 
'' => 'a', '' => 'ae', '' => 'c', '' => 'e', '' => 'e', '' => 'e', 
'' => 'e', '' => 'i', '' => 'i', '' => 'i', '' => 'i', '' => 'd', 
'' => 'n', '' => 'o', '' => 'o', '' => 'o', '' => 'o', '' => 'o', 
'' => 'o', '' => 'u', '' => 'u', '' => 'u', '' => 'u', '' => 'y', 
'' => 'p', '' => 'y', 
);

######################################################################
# Main
######################################################################

$SIG{'HUP'}= \&modend;
$SIG{'INT'}= \&modend;
$SIG{'QUIT'}= \&modend;
$SIG{'ILL'}= \&modend;
$SIG{'TRAP'}= \&modend;
$SIG{'ABRT'}= \&modend;
$SIG{'KILL'}= \&modend;
$SIG{'BUS'}= \&modend;
$SIG{'SEGV'}= \&modend;
$SIG{'SYS'}= \&modend; #if (not ($^O eq "linux"));
$SIG{'PIPE'}= \&plumber;
$SIG{'ALRM'}= \&modend;
$SIG{'TERM'}= \&modend;
$SIG{'STOP'}= \&modend;

# Get line options
getopts('c:htv') or die "Cannot parse command line\n";
# get the name of the config file
$configfile=$opt_c if ($opt_c);

# Read config file
open (RC,$configfile) or 
  die "Cannot open $configfile configuration file for reading: $!\n";
my $configtext=join('',<RC>);
close (RC);

# check the configuration file syntax and populate the %mopt and %groups hashes
my ($refmopt,$refgroups);
my %mopt=%defmopt;
eval { ($refmopt,$refgroups)=&parserc(\%mopt,\%groups,$configtext) };
die $@ if $@;

%mopt=%{$refmopt};
%groups=%{$refgroups};

# Begin logging
open (TRACE, ">>$mopt{'logfile'}") or 
  die "Cannot open $mopt{'logfile'} for writing: $!\n";
autoflush TRACE 1;

mlog (2,"(main) Modappbot $version starting...");

# Lock the bot : only one instance can run at a time
# Unlocking is automatically done at the end of the program (see END sub)
&modlock();

# Open the article database and associate the DBM with the %db hash
dbmopen %db, "$mopt{'confdir'}/$mopt{'farticlesdb'}", 0666 or 
  die "Cannot open $mopt{'confdir'}/$mopt{'farticlesdb'} article database: $!\n";

# Read the moderators files : fills the %moderators hash
eval { &parsemoderators() };
warn $@ if $@;

# Read the admin config variable : fills the %administrators hash
foreach (split(/\s+|,/,lc($mopt{'admin'}))) {
  $administrators{$_}=1;
  $mopt{'admin'}=~ s/\s+/,/g;
}

# Parse line options
if ($opt_v) {
  print "This is Modappbot version $version\n";
} elsif ($opt_h) {
  &help();
} elsif ($opt_t) {
  # Auto-test mode
  my ($output,$return)=&bottest(\%mopt,\%groups);
  if ($return) {
    print "## WARNING : some elements are not properly configured ##\n";
  } else {
    print "Modappbot configuration is correct.\n";
  }
  print $output;
} else {
  &checkmail();
  eval { &purgedb() }; warn $@ if $@;
}

exit 0;

### END OF MAIN

######################################################################
# checkmail
# Input : none
# Output : none
# Action : parse modappbot and group mailboxes
######################################################################
sub checkmail {
  mlog (2,"(checkmail)");

  for my $op (keys %{$groups{'password'}},'modappbot') {
    my $filename;
    if ($op eq 'modappbot' and 
        defined $mopt{'mailboxdir'} and
        defined $mopt{'mailbox'}) {
      $filename="$mopt{'mailboxdir'}/$mopt{'mailbox'}";
    } elsif (defined $mopt{'mailboxdir'} and
             defined $groups{'mailbox'}{$op}) {
      $filename="$mopt{'mailboxdir'}/$groups{'mailbox'}{$op}";
    } else {
      print STDERR "$0: Mailbox variable is not defined for $op\n";
      next;
    }

    if (-s $filename) {
      mlog (2,"(checkmail) $filename mailbox"); 
      my $folder;
      eval { $folder=new Mail::Folder('mbox',$filename, Timeout => 30) };
      if ($@) {
        warn $@;
        next;
      }
      for my $msgnum (sort {$a <=> $b} $folder->message_list) {
        my $mail;
        eval { $mail=$folder->get_message($msgnum) };
        if ($@) {
          mlog (1,"(checkmail) $op : $@");
          warn $@;
          next;
        } else {
          my $err='';
          if ($op eq 'modappbot') {
            eval { $err=&modappmail($mail) };
            $err=$@ if (! $err and $@);
          } else {
            eval { $err=&modappspool($mail,$op); };
            $err=$@ if (! $err and $@);
          }
          if ($err) {
            print STDERR "$err\n";
            mlog (1,$err);
          } else {
            eval { $folder->delete_message($msgnum) }; warn $@ if $@;
          }
        }   
      }
      eval { $folder->sync }; warn $@ if $@;
      eval { $folder->close }; warn $@ if $@;
    }
  }
}

######################################################################
# purgedb
# Input : none
# Output :
# Action : 
# delete articledb entries older than the articledbexpire value
# delete subjectdb entries older that the subjectdbexpire value
######################################################################
sub purgedb {
  my $now=time;

  # compute expire value in seconds. articledbexpire is expressed in days
  my $articledbexpire=$mopt{'articledbexpire'}*24*3600;
  mlog (2,"(purgedb)");

  foreach (keys %db) {
    my ($moderator,$newsgroup,$id,$status,$date)= split (/\s+/,$db{$_});
    last if (!$articledbexpire);
    next if $status eq '-';
    if ($now - $date > $articledbexpire) {
      delete $db{$_};
      mlog (2,"(purgedb) articlesdb : $_ expired");
    }

    my $garticledbexpire=0;
    if (defined $groups{'checkrefs'}{$newsgroup} and
        $groups{'checkrefs'}{$newsgroup} =~ /^n/io) {
      $garticledbexpire=-1;
    } elsif (defined $groups{'articledbexpire'}{$newsgroup}) {
      $garticledbexpire=$groups{'articledbexpire'}{$newsgroup} * 24 * 3600;
    }

    if ($garticledbexpire and ($now - $date > $garticledbexpire)) {
      delete $db{$_};
      mlog (2,"(purgedb) articlesdb : $_ expired ($garticledbexpire)");
    }
  }

  foreach my $declared_ng (keys %{$groups{'password'}}) {
    my $subjectdbexpire;
    if (! defined $groups{'subjectdbexpire'}{$declared_ng}) {
      $subjectdbexpire=$mopt{'subjectdbexpire'} * 24 * 3600;
    } else {
      $subjectdbexpire=$groups{'subjectdbexpire'}{$declared_ng} * 24 * 3600;
    }

    dbmopen my %subjectdb, 
      "$mopt{'confdir'}/$declared_ng/$mopt{'fsubjectdb'}", 0666 or
      die "Cannot open $mopt{'confdir'}/$declared_ng/$mopt{'fsubjectdb'} subjectdb database : $!\n";
    foreach (keys %subjectdb) {
      last if (!$subjectdbexpire);
      if ($now - $subjectdb{$_} > $subjectdbexpire) {
        delete $subjectdb{$_};
        mlog (2,"(purgedb) subjectdb $declared_ng : $_ expired");
      }
    }
    dbmclose %subjectdb;
  }
}

######################################################################
# modappspool
# Input : group name
# Output :
# Action : 
#  see the algorithm below. In general, this function spools
#  an article given on stdin so that it can be affected to a moderator
######################################################################
sub modappspool {
  my ($article,$group)=@_;
  mlog (2,"(modappspool) $group");

  # Clean the headers and body of article
  cleanarticle($article);

  # Load the article
  my @artbody=@{$article->body()} or do {
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (1,"(modappspool) dropped; No mail body");
    return ('');
  };
  my $arthead=$article->head() or do {
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (1,"(modappspool) dropped; No mail headers");
    return ('');
  };

  # fill-in control and supersedes variables if these headers exist
  my $control=($arthead->get('Control')) || ''; chomp ($control);
  my $supersedes=($arthead->get('Supersedes')) || ''; chomp ($supersedes);

  # drop the article if there is no From: header
  if (! $arthead->get('From')) {
    $arthead->replace("X-Modappbot-Status","dropped; no From: header");
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (2,"(modappspool) dropped; no From: header");
    return ('');
  }
  my ($mailaddress)=Mail::Address->parse($arthead->get('From')) or do {
    $arthead->replace("X-Modappbot-Status","dropped; No address in From: header");
    $arthead->delete('From');
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (2,"(modappspool) dropped; no address in From: header");
    return ('');
  };
  my $mailfrom=$mailaddress->address() or do {
    $arthead->replace("X-Modappbot-Status",
                  "dropped; No valid address in From: header");
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (2,"(modappspool) dropped; No valid address in From: header");
    return ('');
  };
  chomp ($mailfrom);

  # drop the article if there is no Newsgroups: header (it should not happen)
  if (! $arthead->get('Newsgroups')) {
    $arthead->replace("X-Modappbot-Status","dropped; no Newsgroups: header");
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog (2,"(modappspool) dropped; no Newsgroups: header");
    return ('');
  }

  # check if article is crossposted in one group moderated by modappbot
  my $flags='';
  my $newsgroups=$arthead->get('Newsgroups') or 
    return ("(modappspool) No Newsgroups: header");
  chomp ($newsgroups);
  ($flags,undef)=ckgroups($newsgroups,'');
  if ($flags =~ /N/) {
    $arthead->replace("X-Modappbot-Status",
                  "dropped; $group is not in Newsgroups: line"); 
    $err=art_archive($article,$group,'e'); return ("(modappspool) $err") if $err;
    mlog(2,"(modappspool) dropped; $group is not in Newsgroups: line");
    return ('');
  }

  # if author is in blacklist for the newsgroup, drop the article
  if (list_match($mailfrom,$group,'blacklist')) {
    $arthead->replace("X-Modappbot-Status","dropped; blacklisted");
    $err=art_archive($article,$group,'a'); return ("(modappspool) $err") if $err;
    mlog(2,"(modappspool) dropped; blacklisted");
    return ('');
  }

  # if subject header matches blacksubject regexp, drop the article
  my $subject=$arthead->get('Subject'); chomp ($subject);
  if (defined $groups{'blacksubject'}{$group} and
      $groups{'blacksubject'}{$group} ne '' and
      ($subject =~ /$groups{'blacksubject'}{$group}/i)) {
    $arthead->replace("X-Modappbot-Status","dropped; subject forbidden");
    $err=art_archive($article,$group,'a'); return ("(modappspool) $err") if $err;
    mlog(2,"(modappspool) dropped; subject forbidden");
    return ('');
  }

  my $status='';

  # Check if the author is in whitelist for the newsgroup
  # if author is in whitelist for the newsgroup, and if article
  # is not crossposted in other moderated newsgroups, post the article
  # or spool it if it is crossposted in other moderated newsgroups

  if ($control and list_match('Control:',$group,'whitelist')) {
    $status="post";
    mlog (2,"(modappspool) POST whitelist cancel $control");
  } elsif (($supersedes and list_match('Supersedes:',$group,'whitelist')) or 
            list_match($mailfrom,$group,'whitelist')) {
    if ($flags =~ /M/) {
       $status="spool";
       mlog(2,"(modappspool) SPOOL whitelist");
    } else {
       $status="post";
       mlog(2,"(modappspool) POST whitelist");
    }
  } elsif (defined $groups{'whitesubject'}{$group}) {

    # if whitesubject is defined, and if subject header does not match 
    # whitesubject regexp, send back an error message
    # if whitesubject is defined, and if article matches it, delete
    # the whitesubject from the subject: header and :
    # - if autopost is set to yes, post the article
    # - if autopost is set to no, spool the article
    # if whitesubject is not defined, spool the article

    # if sender is in subjectdb database, ignore the whitesubject directive
    $groups{'subjectdb'}{$group}='y' 
      if (!defined $groups{'subjectdb'}{$group});
    dbmopen my %subjectdb, "$mopt{'confdir'}/$group/$mopt{'fsubjectdb'}", 0666;
    if ((($groups{'subjectdb'}{$group} =~ /^y/io) and
        (defined $subjectdb{$mailfrom})) or 
        ($subject =~ /$groups{'whitesubject'}{$group}/i) ) {

      # strip whitesubject from article subject
      $subject=~ s/$groups{'whitesubject'}{$group}\s*//i;
      $arthead->replace('Subject',$subject);

      $subjectdb{$mailfrom}="".time;
      if (defined $groups{'autopost'}{$group} and
          $groups{'autopost'}{$group} =~ /^y/io) {
        $status="post";
        mlog (2,"(modappspool) POST autopost whitesubject");
      } else {
        $status="spool";
        mlog (2,"(modappspool) SPOOL whitesubject");
      }
    } else {
      $status="error";
      mlog (2,"(modappspool) ERROR");
    }
    dbmclose %subjectdb;
  } else {
    $status="spool";
    mlog (2,"(modappspool) SPOOL");
  }

  if ($status eq "error") {
    # if whitesubject is not matched, send back an error message
    $arthead->replace("X-Modappbot-Status",
                  "dropped; subject does not match white subject"); 
    $err=spool_ack($mailfrom,"$mopt{'confdir'}/$group/$mopt{'ferrormsg'}",
      $subject,$group,'err',$article); return ("(modappspool) $err") if $err;
    $err=art_archive($article,$group,'a'); return ("(modappspool) $err") if $err;
    mlog (2,"(modappspool) dropped; subject does not match white subject");
  } else {
    # otherwise, send back an ack mail
    if ($status eq "spool") {
      $arthead->replace("X-Modappbot-Status","spooled");
      $err=spool_ack($mailfrom,"$mopt{'confdir'}/$group/$mopt{'fackmsg'}",
        $subject,$group,'ack',$article); return ("(modappspool) $err") if $err;
      $err=art_spool($article,$group); return ("(modappspool) $err") if $err;
      mlog (2,"(modappspool) spooled");
    } elsif ($status eq "post") {
      $arthead->replace("X-Modappbot-Status","autoposted");
      return ("(modappspool) $err") if $err;
      $err=art_post($article,$group,''); return ("(modappspool) $err") if $err;
      $err=art_archive($article,$group,'p'); return ("(modappspool) $err") if $err;
      mlog (2,"(modappspool) autoposted");
    }
  }
  return ('');
}

##########################################################################
# decodeqp
# Input : a string containing QuotedPrintable encoded characters
# Output: string without QuotedPrintable encoding
# Action: strip =?iso-8859-1?q? and QP encoded words in article headers
# borrowed from MIME::QuotedPrint
##########################################################################
sub decodeqp {
  local $_ = shift;
  s/=\?iso-8859-1\?q\?(.*?)\?=/rmunder($1)/gei;
  s/=\r?\n//g;
  s/=([\da-fA-F]{2})/chr(hex($1))/ge;
  $_;
}

##########################################################################
# rmunder
# Input : string containing QuotedPrintable characters
# Output: string where "_" are converted in " "
# Action: converts "_" to " " in QP-encoded words
##########################################################################
sub rmunder {
    my $m = shift;
    $m =~ tr/_/ /;
    $m;
}

######################################################################
# cleanarticle 
# Input : 
# Output :
# Action :
# headers : convert accents
# body : decode QP, convert Micro$oft quotes in ISO ones (thanks Russ Allbery)
#        in a future release : decode UUEncode, Base64
######################################################################
sub cleanarticle {
  my $article=shift;

  # Delete unwanted headers
  foreach (@delheaders) {
    $article->head->delete($_);
  }

  $article->head->fold();

  # delete empty headers
  $article->head->cleanup();

  # subject='no subject' if there is no Subject: header
  my $subject=($article->head->get('Subject')) || $mopt{'nosubject'};
  $article->head->replace('Subject',$subject);

  # if there is no Message-ID, create one
  if (! $article->head->get('Message-ID')) {
    sleep 1;
    my $random=$$;
    my $msgid="bot-".time.".$random"."@".(gethostbyname(hostname))[0];
    $article->head->replace('Message-ID',$msgid);
  }

  # if there are blanks in Newsgroups:, delete them
  my $newsgroups=$article->head->get('Newsgroups');
  if ($newsgroups =~ /\s+/) {
    $newsgroups=~ s/\s+//g;
    $article->head->replace('Newsgroups',$newsgroups);
  };
    

  # Decode accents in headers (only on Subject, From and Reply-To)
  foreach my $tag ('From','Subject','Reply-To') {
    my $content=$article->head->get($tag) or next;
    $content=decodeqp($content);
    $content=~ s/[]/$accents{$&}/ge;
    $article->head->replace($tag,$content);
  }

  $article->tidy_body();

  # This part is (C) Russ Allbery, 1998. rra@stanford.edu
  # This is cleanbody.al from News::Gateway 0.42
  #
  # We perform the following tests and munging to the body of the post:
  #
  #   * Undo quoted-printable.
  #   * Smart quote undoing: 0221 -> `  0222 -> '  0223 -> "  0224 -> "
  #                          0205 -> --
  #   * Strip out any Ctrl-Ms or literal deletes.
  #   * Reject if the body contains invalid characters.
  #   * Reject if any line is longer than 79 characters.

  my $quoted = $article->head->get ('content-transfer-encoding') || ''; 
  $quoted=lc $quoted; chomp($quoted);
  $quoted = ($quoted eq 'quoted-printable');
  local $_;

  # First pass.  We'll only need two passes if there were quoted-printable
  # continuation lines.
  my ($save, $splice);
  foreach (@{$article->body}) {
    # Fix quoted-printable, which is annoying to have to deal with.
    if ($quoted) {
      if ($save) {
        $_ = $save . $_;
        undef $save;
      }
      s/=([0-9A-F]{2})/chr (hex $1)/eg;
      s/=\n//g;
      if (s/=$//) {
        # Continuation line.  Ugh.  Replace line with a disallowed
        # character and save this line; we'll need to splice this
        # line out later on another pass.
        $save = $_;
        $_ = "\0";
        $splice = 1;
        next;
      }
    }

    # Convert Microsoft smart quotes to their real counterparts.
    tr/\x91\x92\x93\x94/\`\'\"\"/;
    s/\x85/--/g;

    # Remove CRs (DOS line endings, most likely) and delete characters.
    tr/\r\x7f//d;

  }

  # Second pass if there were continuation lines to splice out the removed
  # lines of body text.
  if ($splice) {
    my $body = $article->body;
    my $i;
    for ($i = 0; $i < @$body; $i++) {
      splice (@$body, $i, 1) if ($$body[$i] eq "\0");
    }
  }

  # Fix Content-Transfer-Encoding header if we decoded quoted-printable.
  $article->head->replace('Content-Transfer-Encoding','8bit') if $quoted;

  # end of cleanbody.al
}

######################################################################
# list_match
# Input : 
# $group : group name to use for the list
# $mailfrom : e-mail address to use for list matching
# $list : list to use (whitelist or blacklist)
# Output : returns 0 if not found, 1 if found
# Action :
# looks for $mailfrom in the $list for the group named $group
# regexps are ok for blacklist and whitelist
######################################################################
sub list_match {
  my ($mailfrom,$group,$list)=@_;
  mlog (2,"(list_match) $mailfrom $group $list");
  my $found='';
  if (defined $groups{$list}{$group} and
      $groups{$list}{$group} =~ /y/io and 
      -r "$mopt{'confdir'}/$group/$list" ) {
    open LIST, "$mopt{'confdir'}/$group/$list";
    while (<LIST>) {
      chomp;
      $_=lc($_);
      $mailfrom=lc($mailfrom);
      $found="$mailfrom $group $list $_" if ($mailfrom =~ /^$_/);
      $found="$mailfrom $group $list $_" if ($mailfrom eq $_);
    }
    close LIST;
  }
  return ($found);
}

######################################################################
# spool_ack
# Input : 
# $mailfrom : mail sender
# $file : file to send back to sender (given in global variable $mailfrom)
# $subject : subject to put in the mail
# $group : group name used to get the From: header in the mail
# $type : 'ack' or something else. If this is 'ack', and if
#  ack is set to 'no' in the config file, do not send back an ackwnoledge
# $article : Mail::Internet object containing the article
# Output :
# Action :
# send back a mail to sender containing possibly the headers/body of
# incoming article
######################################################################
sub spool_ack {
  my ($mailfrom,$file,$subject,$group,$type,$article)=@_;
  mlog (2,"(spool_ack) $mailfrom $file $group $type");

  # return if ack/error file does not exist, or if ack or from
  # group variables are not set for the newsgroup
  # also return if ack group variable is set to 'no'
  # but do not return even if ack is set to 'no' and we want
  # to send back an error message (this is known by the $type variable)
  return ('') if (! -r $file);
  return ('') if (! defined $groups{'ack'}{$group});
  return ('') if (! defined $groups{'from'}{$group});
  return ('') if ($groups{'ack'}{$group} =~ /^n/io and $type eq 'ack');
  return ('') if ($mailfrom =~ /$mopt{'noreply'}/i);

  open (MSG, $file);
  # if the file to send back includes a subject header, put it in the mail
  my $acksubject;
  if (<MSG> =~ /^Subject:\s+(.*)/) {
    $acksubject="$1 Re: $subject";
  } else {
    $acksubject="Re: $subject";
  }

  my $mailmsg =new Mail::Internet;
  $mailmsg->head->add('From',$groups{'from'}{$group});

  my $recipient=$article->head->get('Reply-To') || $mailfrom;
  $mailmsg->head->add('To',$recipient);

  $mailmsg->head->add('Subject',$acksubject);
  push @{$mailmsg->body},<MSG>;
  close (MSG);

  # send back headers of article
  push @{$mailmsg->body},"> ",join("> ",@{$article->head->header}),"> \n"
    if ($groups{'ack'}{$group} =~ /^(h|f)/io);

  # send back body of article
  push @{$mailmsg->body},"> ",join("> ",@{$article->body})
    if ($groups{'ack'}{$group} =~ /^(b|f)/io);

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# modappmail
# Input : none
# Output : none
# Action : invoqued by the '-m' command line option
#  parse a command mail given on stdin
#  interpret the given commands 
######################################################################
sub modappmail {
  mlog (2,"(modappmail)");
  my $article=shift;

  # Parse received e-mail
  my @mailbody=@{$article->body()};

  my $mailhead=$article->head() or do {
    mlog (1,"(modappmail) dropped; No mail headers");
    return ('');
  };

  $article->tidy_body();
  $mailhead->fold();

  my ($mailaddress)=Mail::Address->parse($mailhead->get('From')) or do {
    mlog  (1,"(modappmail) No From: header");
    return ('');
  };

  my $mailfrom=$mailaddress->address() or do {
    mlog  (1,"(modappmail) No From: address in header");
    return ('');
  };

  $mailfrom=lc($mailfrom);

  mlog(2,"(modappmail) Request from: $mailfrom");

  # Check if the e-mail is one of the moderators (for one of the newsgroups)
  # warning if mail is not from a moderator or an administrator
  if ((!defined $moderators{$mailfrom}) and 
      (!defined $administrators{$mailfrom})) {
    mlog (2, "(main) $mailfrom is not moderator nor administrator");
    warnadmin($mailfrom,$article) if ($mopt{'warnadmin'} =~ /y/i);
    return ('');
  }

  # parse the commands given in the mail body

  my @error=();

  # No mail commands
  if (!(@mailbody)) {
    mlog(2,"(modappmail) No mail body");
    push @error,"No commands in mail body";
  }

  my (@jobcommand,@jobgroup,@jobarticle,@joboptions)=((),(),(),());
  my $i=0;
  while ($i <= $#mailbody) {
    # parse mail body
    mlog (2,"(parsecommands) body $#mailbody $i : $mailbody[$i]");
    # get current mailbody line
    my $line=$mailbody[$i++];
    next if ($line=~ /^\s*$/);
    last if ($line=~ /^--/);
    # strip blanks at the beginning or the end of line
    $line=~ s/^\s*//g;
    $line=~ s/\s*$//g;
    my ($command,$password,$options)= split(/\s+/,$line,3);
    $command="" if (!defined $command);
    $password="" if (!defined $password);
    $options="" if (!defined $options);
    mlog (2, "(parsecommands) |$command|$password|$options|");
  
    # there are several types of commands :
    # - single command : a simple word without a password. As mails from 
    # bad guys are dropped by the modappmail subroutine, we can exec the command
    # - single admin command : an administrative command. We have to check that
    # it comes from the administrator and that the admin password is correct
    # - group command : "command password group" : we check that password
    # is ok for the given group (and that the group exist)
    # special case : newpassword command : we have to check that a new 
    # password is correctly included in the command
    # - put group command : "command password group ... file to put" : 
    # same as before, but we get the included file (delimited by the end
    # of mail or the 'endput' word) because we will have to deal with it
    # after parsing
    # - article command : as the id of the article is given in the command,
    # we have to look for it in the spool and get the corresponding
    # group and moderator. If article is not associated to the sender,
    # or if password is incorrect for the associated group, we send back
    # an error message
    # there is a special case with the refuse command : we have to check
    # that the specified refuse command is correctly defined in the config file
    # otherwise, we send back some error msg
    # - put article command : same as before, but we extract the included
    # article 

    if ($command eq "assigned") {
      # single command
      push @jobcommand,"assigned";
      push @jobgroup,"";
      push @jobarticle,"";
      push @joboptions,"";
    } elsif ($command eq "help") {
      if (defined $administrators{$mailfrom}) {
        if ($password eq $mopt{'adminpw'}) {
          # single admin command
          # password is ok, send back the administrative help file
          push @jobcommand,"adminhelp";
          push @jobgroup,"";
          push @jobarticle,"";
          push @joboptions,"";
        } elsif ($password ne '') {
          # if mail is from the administrator but password is incorrect,
          # tell it
          mlog(2,"(parsecommands) Admin password incorrect");
          push @error,"$line\nAdministrator password incorrect";
        } else {
          # single command
          # if mail is from the administrator but there is no password,
          # send back the normal help file 
          # (an administrator can also be a moderator)
          mlog(2,"(parsecommands) help");
          push @jobcommand,"help";
          push @jobgroup,"";
          push @jobarticle,"";
          push @joboptions,"";
        }
      } else {
        # single command
        # if mail is not from an administrator send back the normal help file
        # (there is no security problem because we checked 
        # that mail is from an administrator or moderator)
        mlog(2,"(parsecommands) help");
        push @jobcommand,"help";
        push @jobgroup,"";
        push @jobarticle,"";
        push @joboptions,"";
      }
    } elsif ($command eq "approve" or
             $command eq "reallyapprove" or
             $command eq "delete" or
             $command eq "refuse.noreply" or
             $command eq "release" or
             $command eq "getarticle" or
             $command eq "putarticle" or
             $command =~ /^refuse\./ ) {
      # article or put article command
      if (!$options or !$password) {
        # incorrect "article" / "put article" command syntax
        mlog (2, "(parsecommands) No password or article provided");
        push @error, "$line\nNo password or article provided\n";
      } elsif ($command eq "putarticle" and $options =~ /\s+/) {
        # Multiple article references with putarticle are not allowed
        mlog (2, "(modappmail) Putarticle does not accept multiple article references");
        push @error, "$line\nYou cannot use multiple article references with putarticle\n";
      } else {
        foreach my $article (split(/\s+/,$options)) {
          my $article_found=0;
          foreach my $declared_ng (keys %{$groups{'password'}}) {
            # if we find the article in one of the spools,
            # we can get the name of the moderator and the newsgroup
            # corresponding to the article
            if (defined $db{"$mopt{'spooldir'}/$declared_ng/$article"}) {
              my ($moderator,$newsgroup,$id,$status,$adate)= split (/\s+/,$db{"$mopt{'spooldir'}/$declared_ng/$article"});
              next if ($status ne "-"); # article has already been treated
              $article_found=1;
              if ($moderator ne $mailfrom) {
                push @error, "$command $password $article\nPermission denied (article not assigned to $mailfrom)\n";
              } elsif (!defined $moderators{"$mailfrom $newsgroup"}) {
                push @error, "$command $password $article\nPermission denied ($mailfrom is not moderator for $newsgroup)\n";
              } elsif (!checkpassword ($password,$newsgroup)) {
                push @error, "$command $password $article\nPermission denied (password incorrect)\n";
              } elsif (($command =~ /^refuse\./) and 
                       ($command ne "refuse.noreply") and
                       ((! defined $groups{$command}{$newsgroup}) or
                        (! -r "$mopt{'confdir'}/$newsgroup/$command") or
                        (! defined $groups{'from'}{$newsgroup}))) {
                  # this is in case the refuse command is not defined in config 
                  push @error, "$command $password $article\nUndefined refuse command\n";
              } else {
                push @jobcommand,$command;
                push @jobgroup,$newsgroup;
                push @jobarticle,$article;
                if ($command eq "putarticle") {
                  # this is the only one put article command. We extract
                  # the article from the command mail
                  my $attached_file='';
                  while ($i <= $#mailbody) {
                    if ($mailbody[$i] =~ /^endput/) {
                      $i++;
                      last;
                    }
                    $attached_file.=$mailbody[$i++];
                  }
                  push @joboptions,$attached_file;
                } else {
                  push @joboptions,"";
                }
              }
            }
          }
          if (!$article_found) {
            # article id does not correspond to anything in the spool
            mlog(2, "(parsecommands) no such article : $command $password $article");
            push @error, "$command $password $article\nNo such article or article not assigned to anyone\n";
          }
        }
      }
    } elsif ($command eq "available" or
             $command eq "newpassword" or
             $command eq "getfile" or
             $command eq "putfile") {
      my $newpassword;
      ($options,$newpassword)=
        split(/\s+/,$options) if ($command eq "newpassword");
      my $number;
      ($options,$number)=split(/\s+/,$options,2) if ($command eq "available");
      $number="" if (!defined $number);
      my $file;
      ($options,$file)=split(/\s+/,$options,2) 
        if ($command eq "getfile" or $command eq "putfile");
      $options="" if (!defined $options);
      $file="" if (!defined $file);
      if (!$options or !$password) {
        mlog(2,"(parsecommands) No password or group name provided");
        push @error,"$line\nNo password or group name provided\n";
      } elsif (!declaredng($options)) {
        mlog(2,"(parsecommands) Group $options not declared in configuration");
        push @error, "$line\nGroup $options not declared in configuration\n";
      } elsif (!($_=checkpassword($password,$options))) {
        mlog(2,"(parsecommands) Password incorrect");
        push @error, "$line\nPassword incorrect\n";
      } elsif (!defined $moderators{"$mailfrom $options"}) {
        mlog(2,"(parsecommands) $mailfrom is not moderator for $options");
        push @error, "$line\n$mailfrom is not moderator for $options\n";
      } else {
        # group commands
        if ($command eq "available") {
          # available command
          if ($number ne "" and ($number !~ /^\d+$/ or $number eq "0")) {
            mlog (2,"(parsecommands) available : $number : incorrect number");
            push @error, "$line\n$number : incorrect number\n";
          } else {
            mlog (2,"(parsecommands) available : group=$options, number=$number");
            push @jobcommand, $command;
            push @jobgroup,$options;
            push @jobarticle,"";
            push @joboptions,$number;
          }
        } elsif ($command eq "newpassword") {
          if (!$newpassword) {
            mlog (2, "(main) newpassword : no new password provided");
            push @error, "$line\nNo new password provided\n";
          } else {
            # group command
            mlog (2, "(main) newpassword : <$options|$password|$newpassword>");
            push @jobcommand,"newpassword";
            push @jobgroup,$options;
            push @jobarticle,"";
            push @joboptions,$newpassword;
          }
        } if ($command eq "putfile" or $command eq "getfile") {
          if (!$file) {
            mlog(2,"(parsecommands) No filename provided");
            push @error,"$line\nNo filename provided";
          } elsif ($file ne $mopt{'ferrormsg'} and 
                   $file ne $mopt{'fackmsg'} and
                   $file ne $mopt{'fmoderators'} and 
                   $file ne $mopt{'fblacklist'} and
                   $file ne $mopt{'fwhitelist'} and
                   $file ne $mopt{'fsignature'} and
                   $file !~ /^refuse\.\S+$/) {
              mlog(2,"(parsecommands) Filename incorrect");
              push @error,"$line\nFilename incorrect";
          } elsif ($file =~ /^refuse\.(\S+)$/ and 
                   $command eq "getfile" and
                   !validrefuse($options,$1)) {
              mlog(2,"(parsecommands) refuse.$1 : filename incorrect");
              push @error,"$line\nrefuse.$1 : filename incorrect";
          } elsif ($command eq "putfile") {
            # put group command
            my $attached_file='';
            while ($i <= $#mailbody) {
              if ($mailbody[$i] =~ /^endput/) {
                $i++;
                last;
              } elsif ($mailbody[$i] =~ /^--/) {
                last;
              }
              $attached_file.=$mailbody[$i] if ($mailbody[$i] !~ /^\s*$/);
              $i++;
            }
            if ($file eq $mopt{'fmoderators'} and
                $attached_file eq "") {
              mlog(2,"(parsecommands) new moderators file empty");
              push @error,"$line\nnew moderators file empty";
            } else {
              mlog(2,"(parsecommands) putfile $options $file");
              push @jobcommand,$command;
              push @jobgroup,$options;
              push @jobarticle,"";
              push @joboptions,"$file\n".$attached_file;
            }
          } elsif ($command eq "getfile") {
            # get group command
            mlog(2,"(parsecommands) getfile $options $file");
            push @jobcommand,$command;
            push @jobgroup,$options;
            push @jobarticle,"";
            push @joboptions,$file;
          }
        }
      }
    } elsif ($command eq "dbdump" or
             $command eq "admgetfile" or
             $command eq "admputfile") {
      if (defined $administrators{$mailfrom}) {
        if ($password eq $mopt{'adminpw'}) {
          if ($command eq "dbdump") {
            # admin command
            push @jobcommand,$command;
            push @jobgroup,"";
            push @jobarticle,"";
            push @joboptions,"";
          } elsif ($command eq "admgetfile") {
            if ($options ne $mopt{'fhelpfile'} and
                $options ne $mopt{'fadminhelpfile'} and
                $options ne $mopt{'fconfigfile'}) {
              mlog(2,"(parsecommands) Filename incorrect");
              push @error,"$line\nFilename incorrect";
            } else {
              push @jobcommand,$command;
              push @jobgroup,"";
              push @jobarticle,"";
              push @joboptions,$options;
            }
          } elsif ($command eq "admputfile") {
            if ($options ne $mopt{'fhelpfile'} and
                $options ne $mopt{'fadminhelpfile'} and
                $options ne $mopt{'fconfigfile'}) {
              mlog(2,"(parsecommands) Filename incorrect");
              push @error,"$line\nFilename incorrect";
            } else {
              # admin put command
              push @jobcommand,$command;
              push @jobgroup,"";
              push @jobarticle,"";
              push @jobarticle,"";
              my $attached_file='';
              while ($i <= $#mailbody) {
                if ($mailbody[$i] =~ /^endput/) {
                  $i++;
                  last;
                } elsif ($mailbody[$i] =~ /^--/) {
                  last;
                }
                $attached_file.=$mailbody[$i++];
              }
              push @joboptions,"$options\n".$attached_file;
            }
          }
        } else {
          mlog(2,"(parsecommands) Administrator password incorrect");
          push @error, "$line\nAdministrator password incorrect";
        }
      } else {
        mlog(2,"(parsecommands) admin command from a non-administrator");
        push @error, "$line\nCommand not understood";
      }
    } else {
      mlog(2,"(parsecommands) command unknown");
      push @error, "$line\nCommand not understood";
    }
  } # end for

  my $printreport; # if 1, send back a mail giving the affected articles
  for ($i=0;$i<=$#jobcommand;$i++) {
    mlog (2,"(modappmail) JOBCOMMAND=$jobcommand[$i] ");
    # parse the commands given in the mail
    if ($jobcommand[$i] eq "available") {
      # Available command
      my $refarticles;
      ($err,$refarticles)=listarticles("$mopt{'spooldir'}/$jobgroup[$i]");
      return ("(modappmail) $err") if $err;
      $err=affectarticles($mailfrom,$jobgroup[$i],$joboptions[$i],$refarticles);
      return ("(modappmail) $err") if $err;
      $printreport=1;
    } elsif ($jobcommand[$i] eq "adminhelp") {
      # adminhelp command
      $err=sendhelp($mailfrom,"$mopt{'confdir'}/$mopt{'fadminhelpfile'}");
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "help") {
      # help command
      $err=sendhelp($mailfrom,"$mopt{'confdir'}/$mopt{'fhelpfile'}");
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "newpassword") {
      $err=newpassword($mailfrom,$jobgroup[$i],$joboptions[$i]);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "assigned") {
      # assigned command
      $printreport=1;
    } elsif ($jobcommand[$i] eq "delete" or 
             $jobcommand[$i] eq "refuse.noreply") {
      $err=art_delete ($mailfrom,$jobarticle[$i],$jobgroup[$i]);
      return ("(modappmail) $err") if $err;
      $printreport=1;
    } elsif (($jobcommand[$i] eq "approve") or
             ($jobcommand[$i] eq "reallyapprove")) {
      $err=art_approve($mailfrom,$jobarticle[$i],$jobgroup[$i],$jobcommand[$i]);
      return ("(modappmail) $err") if $err;
      $printreport=1;
    } elsif ($jobcommand[$i] eq "getarticle") {
      $err=art_getarticle ($mailfrom,$jobarticle[$i],$jobgroup[$i]);
      return ("(modappmail) $err") if $err;
      $printreport=1;
    } elsif ($jobcommand[$i] eq "release") {
      art_release ($jobarticle[$i],$jobgroup[$i]);
      $printreport=1;
    } elsif ($jobcommand[$i] =~ /^refuse\./) {
      $err=art_refuse ($mailfrom,$jobarticle[$i],$jobgroup[$i],$jobcommand[$i]);
      return ("(modappmail) $err") if $err;
      $printreport=1;
    } elsif ($jobcommand[$i] eq "putarticle") {
      # putarticle command
      $err=putfile("$mopt{'spooldir'}/$jobgroup[$i]/$jobarticle[$i]",
        $joboptions[$i],0);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "getfile") {
      $err=groupgetfile($mailfrom,$jobgroup[$i],$joboptions[$i]);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "putfile") {
      $err=groupputfile($mailfrom,$jobgroup[$i],$joboptions[$i]);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "dbdump") {
      # dbdump admin command
      $err=dbdump($mailfrom);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "admgetfile") {
      $err=admgetfile($mailfrom,$joboptions[$i]);
      return ("(modappmail) $err") if $err;
    } elsif ($jobcommand[$i] eq "admputfile") {
      $err=admputfile($mailfrom,$joboptions[$i]);
      return ("(modappmail) $err") if $err;
    }
  }

  $err=printarticles($mailfrom) if ($printreport);
  return ("(modappmail) $err") if $err;

  # if the @error table is not empty, send back an error mail giving the errors
  if (@error) {
    my $mailmsg=new Mail::Internet;
    $mailmsg->head->add('From',$mopt{'from'});
    $mailmsg->head->add('To',$article->head->get('Reply-To') || $mailfrom);
    $mailmsg->head->add('Bcc',$mopt{'admin'});
    $mailmsg->head->add('Subject','Your request to Modappbot');

    # parse the @error table
    foreach (@error) {
      push @{$mailmsg->body},">>> $_\n";
    }

    # include the original e-mail in the error 
    push @{$mailmsg->body},"\nThe original message was : \n\n",
         "> ",join("> ",@{$article->header},("\n"),@{$article->body}),"\n";

    sendmail($mailmsg);
  }

  return ('');
}

######################################################################
# validrefuse
# Input : 
# $newsgroup : name of a newsgroup
# $refusefile : name of a refuse command
# Output : none
# Action : returns true if the refusefile is defined for the specified.
# returns false otherwise
######################################################################
sub validrefuse {
  my ($newsgroup,$refusefile)=@_;
  my $refusefound=0;
  foreach my $refusecommand (keys %groups) {
    if (defined $groups{$refusecommand}{$newsgroup} and
      $refusecommand=~ /^refuse\.(\S+)$/) {
      $refusefound=1 if $1 eq $refusefile;
    }
  }
  return $refusefound;
}

######################################################################
# swrite (cf perlform manpage)
######################################################################
sub swrite {
  croak "usage : swrite PICTURE ARGS" unless @_;
  mlog (2,"(swrite)");

  my $format=shift;
  $^A="";
  formline($format,@_);
  return $^A;
}

######################################################################
# mlog
# Input : 
# $level : logging level : 
#  0 do not log anything
#  1 log commands and articles
#  2 for debug only
# $message : a single line message to print to the log file
# Output : none
# Action : prints a message to the logfile
######################################################################
sub mlog {
  my ($level,$message)=@_;
  return if !defined $mopt{'loglevel'};
  return if !defined fileno TRACE;
  $message=~ s/\n$//;
  print TRACE localtime()." [$$] $message\n" if ($level <= $mopt{'loglevel'});
}

######################################################################
# warnadmin
# Input : none
# Output : none
# Action : warn the administrator if the received command mail does not come 
#          from the admin or a mod
######################################################################
sub warnadmin {
  my ($mailfrom,$article)=@_;
  mlog(2,"(warnadmin) $mailfrom");
  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mopt{'admin'});
  $mailmsg->head->add('Subject',
    'Modappbot : non moderator or administrator request');

  push @{$mailmsg->body},
"Modappbot has received a request from a non moderator or administrator.
Sender is : $mailfrom.\n";

  # include original e-mail in warning
  push @{$mailmsg->body},"The original message was : \n\n",
    "> ",join("> ",@{$article->head->header()},("\n"),@{$article->body()}),"\n";

  sendmail($mailmsg);
}

######################################################################
# plumber
# Input : none
# Output : none
# Action : 
# if the script received a signal, we can use this function
# to terminate quietly
######################################################################
sub plumber {
  mlog(2, "(plumber) modappbot died prematurely !");
  die "modappbot died prematurely ! : \n$mopt{'mailcmd'} or $mopt{'newscmd'} problem ?\n";
}

######################################################################
# sendmail
# Input : from address, to address, message to send
# Output : mail sent from 'from' address to 'to' address
# Action : send a mail by SMTP
######################################################################
sub sendmail {
  my $mail=shift;
  mlog (2, "(sendmail)");

  $mail->head->replace("X-Modappbot-Version","$version");

  # MIME headers if they are not already present
  $mail->head->replace("MIME-Version","1.0");
  $mail->head->replace("Content-Type","text/plain; charset=iso-8859-1");
  $mail->head->replace("Content-Transfer-Encoding","8bit");

  open (MAIL, "|$mopt{'mailcmd'} $mopt{'mailopts'}") 
    or die "(sendmail) cannot run $mopt{'mailcmd'} command\n";
  $mail->print (\*MAIL);
  close (MAIL);
  die "(sendmail) $mopt{'mailcmd'} did not run successfully\n" if $?;
}

##########################################################################
# ckgroups
# Input : $newsgroups
# Output: flag : M for moderated ngs, U for unknown ngs
# Action: verifies if $newsgroups contains the name of unknown
#         or moderated newsgroups. The verification is done 
#         accordingly to the news active file
# Thanks to Guy Decoux for this function
##########################################################################
sub ckgroups {
  my ($newsgroups,$email) = @_;
  mlog (2,"(ckgroups) $newsgroups $email");
  my ($nextgroup,$declared_ng);

  $newsgroups =~ s/\s+//g;
  $newsgroups =~ s/,{2,}/,/g;
  my $flags='';

  # remove the name of the newsgroups defined in the conf file
  my $othergroups = $newsgroups;
  foreach (keys %{$groups{'password'}}) {
    # if e-mail is not defined, we simply strip the group for the
    # newsgroups: header
    if ($email eq "") {
      $othergroups =~ s/(^|,)\Q$_\E(?:,|$)/$1/g;
    } elsif (defined $moderators{"$email $_"}) {
      # if $email is moderator for one of the newsgroup, delete the
      # name of the newsgroup from it. Otherwise, do nothing
      $othergroups =~ s/(^|,)\Q$_\E(?:,|$)/$1/g;
    }
  }
  if ($othergroups eq $newsgroups) {
    # we did not strip any group name from the Newsgroups: header,
    # this means that $email is not moderator for $group
    $flags.="N";
  }

  $othergroups =~ s/,$//;

  # no need to parse active if there is only one newsgroup
  return ($flags,'') if (!$othergroups);

  my @errgroups = split /,/, $othergroups;

  # by default, all newsgroups (except the ones in .modapprc) are
  # unknown
  my %errgroups = map { $_ => 'z' } @errgroups;
  my $nb = 0;

  return ($flags,'') if ((!defined $mopt{'activefile'}) 
             or (defined $mopt{'activefile'} and !-r $mopt{'activefile'}));

  # look for moderated of unknown newsgroups
  open (ACTIVE, $mopt{'activefile'});
  while (<ACTIVE>) {
    chomp;
    my ($a_name, $a_hi, $a_low, $a_flags) = split (/ /);
    next if !defined $errgroups{$a_name};
    $errgroups{$a_name} = $a_flags;
    last if ++$nb == @errgroups;
  }
  close (ACTIVE);

  # print the newsgroups which are unknown
  @errgroups = grep { $errgroups{$_} eq 'z' } keys %errgroups;
  $flags.="U" if (@errgroups);

  # print the newsgroups which are moderated
  @errgroups = grep { $errgroups{$_} eq 'm' } keys %errgroups;
  if (@errgroups) {
    $flags.="M";
    $nextgroup=(sort @errgroups)[-1];
  }
  return ($flags,$nextgroup);
}

######################################################################
# parserc
# Input : 
# $refmopt : reference to %mopt hash
# $refgroups : reference to %groups hash
# $configtext : a configuration file filled in a single string
# Output : 
# $msgtext : text giving errors found when parsing config file
# references to %mopt and %groups passed to calling subroutine
# Action :
# this is used to parse the config file before doing anything
# this can also be used to parse a config file given by the
# 'putconfig' administrative command. This is why we pass
# references to hashes and a string instead of using global variables
# Thanks to Guy Decoux for this function (from modapp script)
######################################################################
sub parserc {
  my ($refmopt,$refgroups,$configtext)=@_;
  my %mopt=%{$refmopt};
  my %groups=%{$refgroups};
  my $msgtext='';
  my %gconfigkeys = map { $_ => 1 } @gconfigkeys;
  my %mconfigkeys = map { $_ => 1 } @mconfigkeys;
  my $i=0;

  my ($where, $grp_found, $key, $value) = (0, 0, '', '');
  foreach (split(/\n/,$configtext)) {
    $i++;
    next if /^#/;
    $where = /^\s*\[\s*(\S+)\s*\]/o .. /^\s*\[\s*end\s*\]/io;
    if ($where) {
      $grp_found = $1 if $where == 1;
      if (/^\s*([^=\s]+)\s*=\s*(.+)/) {
        $key = lc($1);
        $value = $2;
        if ($gconfigkeys{$key}) {
          if ($key eq "refuse") {
            # this is a special case : the refuse variable
            # can contain a list of strings
            foreach (split(/\s+/,$value)) {
              $groups{"$key.$_"}{$grp_found} = 1;
            }
          } else {
            $groups{$key}{$grp_found} = $value;
          }
        } elsif ($key =~ /^refuse\./) {
          $groups{$key}{$grp_found} = $value;
        } else {
          $msgtext.="-> $key : unknown option (modappbot.conf line $i)\n";
        }
      }
    } else {
      if (/^\s*([^=\s]+)\s*=\s*(.+)/) {
        $key = lc($1);
        $value=$2;
        if ($mconfigkeys{$key}) {
          $mopt{$key} = $value;
        } else {
          $msgtext.="-> $key : unknown global option (modappbot.conf line $i)\n";
        }
      }
    }
  }

  my ($mo, $gr);
  foreach $mo (keys (%gconfigkeys)) {
    foreach $gr (keys %{$groups{$mo}}) {
      $groups{$mo}{$gr} =~
        s#^~([^/]*)#$1?(getpwnam($1))[7]:($ENV{'HOME'} || $ENV{'LOGDIR'})#e
          if $groups{$mo}{$gr};
    }
  }

  die "The configuration is invalid:\n$msgtext\n" if $msgtext;

  return (\%mopt,\%groups);
}

######################################################################
# parsearticle
# Input : 
# $article : full path of a spooled article
# $email : e-mail used to check if article is crossposted in 
# groups for which $email is not moderator
# Output : 
# variables given the main parts of the article, including a $mime
# tag used for MIME warnings (if article is not properly encoded)
# Action :
# parse the article and get the important informations from it
######################################################################
sub parsearticle {
  my ($article,$email)=@_;

  mlog(2,"(parsearticle) $article $email");

  open (ARTICLE,$article) or 
    return("(parsearticle) cannot open $article article for reading",'','','','','','','');
  my $objet=new Mail::Internet (\*ARTICLE);
  close (ARTICLE);

  my $objhead=$objet->head;
  my $from=(Mail::Address->parse($objhead->get('From')))[0]->address();
  my $subject=$objhead->get('Subject'); chomp ($subject);
  my $newsgroups=$objhead->get('Newsgroups'); chomp ($newsgroups);

  # We use Date::Manip here
  my $date=UnixDate($objhead->get('Date'),"%d %b") || "none";

  # Parse the References: header. If the references contains
  # an article affected to another moderator, $refnum=0
  # if the references contain an article affected to the same
  # moderator or affected to no-one, $refnum=1
  my @references=();
  if ($_=$objhead->get('References')) {
    chomp;
    @references=split(/\s+/,$_);
  }

  my $val;
  my $refnum=1; # 1 = article can be affected to moderator
  foreach $val (values %db) {
    my ($oldid,$oldmod);
    ($oldmod,undef,$oldid,undef,undef)=split(/\s+/,$val);
    # we saved the message-id of approved articles in the database,
    # this is useful here to make the relation between a posted article
    # and a followup received by the bot
    next if ($oldid eq '-');
    foreach my $ref (@references) {
      # if a previously approved article is seen in the references: header,
      # but it was not approved by the asking moderator, return 0
      if (($ref eq $oldid) and ($oldmod ne $email)) {
        $refnum=0;
        last;
      }
    }
    last if ($refnum == 0);
  }

  my @objbody=@{$objet->body()};
  my $length=$#objbody+1;

  my ($flags,$nextgroup);
  ($flags,$nextgroup)=ckgroups($newsgroups,$email);
  my @newsgroups=split(/,/,$newsgroups);
  $flags.="C" if ($#newsgroups+1 > $mopt{'maxgroups'}); # massively crossposted

  # check MIME headers
  my $mimect=$objhead->get('Content-Type') || ''; chomp ($mimect);
  my $mimecte=$objhead->get('Content-Transfer-Encoding') || ''; chomp($mimecte);
  if (($mimect and (($mimect !~ /text\/plain/i) or !$mimecte)) or 
      ($mimecte and (($mimecte !~ /^(7|8)bit$/i) or !$mimect))) {
    $flags.="T";
  }

  return ($err,$from,$date,$subject,$length,$flags,$nextgroup,$refnum);
}

######################################################################
# listarticles
# Input : 
# $spooldir : spool directory (consists normally in the spooldir variable
# and the group name)
# Output : 
# a list of articles availables in the spool
# Action :
# parse the spool directory and return a list of spooled articles
######################################################################
sub listarticles {
  my $spooldir=shift;
  mlog (2,"(listarticles) $spooldir");
  my @articles;
  opendir (SPOOL,$spooldir) 
    or return ("(listarticles) cannot open $spooldir directory",undef);
  @articles= grep !/^$spooldir\/\.\.?$/, map "$spooldir/$_" , readdir SPOOL;
  closedir (SPOOL);
  return ('',\@articles);
}

######################################################################
# affectarticles
# Input : 
# $ng : moderated group name in which articles will be posted
# $numarticles : maximum number of articles to assigned to moderator
# @articles : list of articles to affect
# Output : none
# Action :
# affect the list of articles to the moderator if he has nothing waiting
# send back affected articles if sendarticles variable is set
# this is the main procedure used for manual assignation
######################################################################
sub affectarticles {
  my ($mailfrom,$ng,$numarticles,$refarticles)=@_;
  mlog (2,"(affectarticles) $mailfrom $ng $numarticles");
  my @articles=@{$refarticles};

  # check if moderator has some affected articles
  foreach (keys %db) {
    my ($amod,$agroup,$aid,$astatus,$adate)=split(/\s+/,$db{$_});
    next if ($astatus ne "-");
    if (($amod eq $mailfrom) and ($agroup eq $ng)) {
      # if mod has some already affected articles, he has to deal
      # with them before asking more
      mlog (2,"(affectarticles) Some articles are already assigned to $mailfrom");
      return ('');
    }
  }

  if (@articles) {
    # Some articles are waiting
    my $counter=0;
    for my $index (0 .. $#articles) {
      my $article=$articles[$index];
      my ($err,$from,$date,$subject,$length,$flags,$nextgroup,$refnum)= 
        parsearticle($article,$mailfrom);
      return ("(affectarticles) $err") if $err;

      do {
        # if $refnum is 0, the article cannot be affected to the moderator
        next if (!$refnum); 
      } unless ((defined $groups{'checkrefs'}{$ng} and 
                 $groups{'checkrefs'}{$ng} =~ /^n/io) or
                (defined $groups{'articledbexpire'}{$ng} and
                 $groups{'articledbexpire'}{$ng} == 0));

      my $msgid=basename($article);

      if (! defined $db{$article}) {
        $db{$article}=$mailfrom . " " . $ng . " -" . " -" . " -";
        if ($groups{'sendarticles'}{$ng} =~ /^(h|f|b)/i ) {
          # send back the article if sendarticles variable is set
          my $mailmsg=new Mail::Internet;
          $mailmsg->head->add('From',$mopt{'from'});
          $mailmsg->head->add('To',$mailfrom);
          $mailmsg->head->add('Subject',"Modappbot : article $msgid for $ng");

          open (ARTICLE,$article) or 
            return ("(affectarticles) cannot open $article article file for reading");

          while (<ARTICLE>) {
            push @{$mailmsg->body},$_ 
              if ($groups{'sendarticles'}{$ng} =~ /^(h|f)/i);
            last if (/^$/);
          }
          while (<ARTICLE>) {
            push @{$mailmsg->body},$_ 
              if ($groups{'sendarticles'}{$ng} =~ /^(f|b)/i);
          }
          close (ARTICLE);
          sendmail ($mailmsg);
        }
        $counter++;
        last if ($numarticles ne "") and ($counter >= $numarticles);
      }
    }
  }
  return ('');
}

######################################################################
# printarticles
# Input : none
# Output : none
# Action :
# print the list of affected article in a pretty output
# this uses the swrite function
######################################################################
sub printarticles {
  my $mailfrom=shift;
  mlog (2,"(printarticles) $mailfrom");

  my $ARTICLE=<<EOF;
@<<<<<<<<<<<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<
 @<<<<<<<<< @<<<< @||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
EOF

  my @affected;
  for (reverse sort keys %db) {
    my ($moderator,$newsgroup,$id,$status,$adate)=split(/\s+/,$db{$_});
    if ($moderator eq $mailfrom and $status eq "-") {
      # get the list of articles affected to the asking moderator
      push @affected, $_;
    }
  }

  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);

  if (@affected) {
    my $nbarticles=$#affected + 1;
    if ($nbarticles==1) {
    $mailmsg->head->add('Subject',
      "Modappbot : one assigned article to $mailfrom");
    } else {
    $mailmsg->head->add('Subject',
      "Modappbot : $nbarticles assigned articles to $mailfrom");
    }

    push @{$mailmsg->body},
      ($nbarticles==1) 
        ? "The following article is assigned to $mailfrom :"
        : "The following $nbarticles articles are assigned to $mailfrom :", 
      "

Article                    Flags   From                  Newsgroup
 Date      Lines                 Subject
------------------------------------------------------------------------------
";

    my $i;
    for ($i=0;$i<=$#affected;$i++) {
      my ($from,$date,$subject,$length,$flags,$nextgroup,$refnum);
      ($err,$from,$date,$subject,$length,$flags,$nextgroup,$refnum)= 
        parsearticle($affected[$i],$mailfrom);
      return ("(printarticles) $err") if $err;
      my ($moderator,$newsgroup,$id,$status,$adate)=
        split(/\s+/,$db{$affected[$i]});

      my $msgid=basename($affected[$i]);
       push @{$mailmsg->body}, swrite($ARTICLE,
         $msgid,$flags,$from,$newsgroup,$date,$length,$subject);
    }

    push @{$mailmsg->body},"\n";

  } else {

    # No articles to moderate
    $mailmsg->head->add('Subject',
      "Modappbot : No assigned articles to $mailfrom");

    push @{$mailmsg->body},
      "There are no assigned articles to $mailfrom.\n\n";

  }

  # Compute the number of assigned articles
  foreach my $declared_ng (keys %{$groups{'password'}}) {
    if (defined $moderators{"$mailfrom $declared_ng"}) {
      my $refarticles;
      ($err,$refarticles)=listarticles("$mopt{'spooldir'}/$declared_ng");
      return ("(printarticles) $err") if $err;
      my @articles=@{$refarticles};
      my $unassigned_arts=$#articles+1;
      mlog(2,"(printarticles) number of articles in $declared_ng : $unassigned_arts");
      foreach (@{$refarticles}) {
        mlog(2,"(printarticles) article : $_ $declared_ng");
        $unassigned_arts-- if (defined $db{$_});
      }
      if ($unassigned_arts) {
        push @{$mailmsg->body},
          ($unassigned_arts==1)
          ? "** There is one unassigned article"
          : "** There are $unassigned_arts unassigned articles",
          " in $declared_ng\n";
      }
    }
  }

  if (@affected) {
    push @{$mailmsg->body},"
Description of flags :
U : article would be posted in unknown newsgroups
M : article would be posted in other _Moderated_ newsgroups 
    for which you are not moderator
C : article would be posted in more that $mopt{'maxgroups'} newsgroups
T : invalid MIME headers or encoding

";
  }

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# dbdump
# Input : none
# Output : none
# Action :
# same as printarticles but all articles saved in the database are printed
# remember that the database is purged periodically
######################################################################
sub dbdump {
  my $mailfrom=shift;
  mlog (2,"(dbdump) $mailfrom");

  my $DUMP=<<EOF;
@<<<<<<<<<<<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<
 @<<<<<<<<< @<<< @|||||||||||||||||||||||||||||||||||||| @<<<<<<<<<<<<<<<<<<<<<
EOF

  my @affected;
  for (reverse sort keys %db) {
    my $status;
    (undef,undef,undef,$status,undef)=split(/\s+/,$db{$_});
    push @affected, $_ if ($status eq "-");
  }

  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);

  if (@affected) {
    my $nbarticles=$#affected + 1;
    $mailmsg->head->add('Subject',
      "Modappbot : Database dump : $nbarticles assigned articles");

    push @{$mailmsg->body},
      "The following $nbarticles articles are currently assigned :


Article                    Flags   From                  Newsgroup
  Date     Lines                Subject                  Moderator
------------------------------------------------------------------------------
";
    my $i;
    for ($i=0;$i<=$#affected;$i++) {
      my ($moderator,$newsgroup,$id,$status,$adate)=split(/\s+/,$db{$affected[$i]});
      my ($from,$date,$subject,$length,$flags,$nextgroup,$refnum);
      ($err,$from,$date,$subject,$length,$flags,$nextgroup,$refnum)= 
        parsearticle($affected[$i],$moderator);
      return ("(dbdump) $err") if $err;
      my $msgid=basename($affected[$i]);
      push @{$mailmsg->body},swrite($DUMP,
        $msgid,$flags,$from,$newsgroup,$date,$length,$subject,$moderator);
    }

  } else {
    # No articles in database
    $mailmsg->head->add('Subject',"Modappbot : Database dump : no articles");

    push @{$mailmsg->body},"The article database is empty.\n";
  }

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# art_spool
# Input : 
# $article : incoming article to spool
# $group : group in which the article is spooled
# Output : none
# Action :
# Copies the incoming article in the spool for the specified group
# the filename in the spool is computed to avoid overwriting an
# existing file. The filename is unique among all the group spools
# and this subroutine checks that the used filename is not used 
# in the article database
######################################################################
sub art_spool {
  my ($article,$group)=@_;
  mlog (2,"(art_spool) $group");
  my $order=0;
  # calculate the filename prefix : this is the order of the group
  # name in all the group spools
  foreach (sort keys %{$groups{'password'}}) {
    $order++;
    last if ($group eq $_);
  }

  my $index=0;
  my $key;
  do {
    $index++;
    $key="$mopt{'spooldir'}/$group/$order$index";
    if ($index > $mopt{'maxspool'}) {
      # if maximum number of spooled articles is reached, return
      return ("(art_spool) spool overflow in $group (".$mopt{'maxspool'}." max)");
    }
  } until ((! -f $key) and (! defined $db{$key}));
  open (ARTICLE, "> $mopt{'spooldir'}/$group/$order$index") or 
    return ("(art_spool) Cannot spool article (index: $order$index ; newsgroup: $group)");
  print ARTICLE join("",@{$article->head->header()},("\n"),@{$article->body()});
  close (ARTICLE);

  return ('');
}

######################################################################
# art_delete
# Input : 
# $file : article filename
# $newsgroup : group in which the article is spooled
# Output : modified db hash
# Action :
# add a modapp header in the article, archive it and delete it
# modify the entry of the article in the article database to specified
# that article was deleted
######################################################################
sub art_delete {
  my ($mailfrom,$file,$newsgroup)=@_;
  mlog(2,"(art_delete) $mailfrom $file $newsgroup");

  # return if the moderator tries to delete an article that
  # is not in the article database (article just released, deleted, refused)
  return if (!defined $db{"$mopt{'spooldir'}/$newsgroup/$file"});

  # return if the moderator tries to delete an article
  # that he has just approved
  my ($amod,$agroup,$aid,$astatus,$adate)=
    split (/\s+/,$db{"$mopt{'spooldir'}/$newsgroup/$file"});
  return if ($astatus eq "approved");

  open (ARTICLE, "$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_delete) Cannot open article file for reading: $!");
  my $article=new Mail::Internet (\*ARTICLE);
  close (ARTICLE);

  $article->head->replace("X-Modappbot-Status","deleted by $mailfrom");

  $err=art_archive($article,$newsgroup,'d');
  return ("(art_delete) $err") if $err;

  unlink ("$mopt{'spooldir'}/$newsgroup/$file") or
   return ("(art_delete) Cannot delete $mopt{'spooldir'}/$newsgroup/$file");
  delete $db{"$mopt{'spooldir'}/$newsgroup/$file"};

  return ('');
}

######################################################################
# art_refuse
# Input : 
# $article : article filename
# $newsgroup : group in which article is spooled
# $reason : refusal reason
# Output : modified db hash
# Action :
# add a modapp header, archive the article, and send back to
# article author a text file specifying the reason of refusal
# delete the article from the spool and modify the article database
# to specify that article was refused (but do not store the reason in the db)
######################################################################
sub art_refuse {
  my ($mailfrom,$file,$newsgroup,$reason)=@_;

  mlog(2,"(art_refuse) $mailfrom $file $newsgroup $reason");

  # return if the moderator tries to refuse an article that
  # is not in the article database (article just released, deleted, refused)
  return if (!defined $db{"$mopt{'spooldir'}/$newsgroup/$file"});

  # return if the moderator tries to refuse an article
  # that he has just approved
  my ($amod,$agroup,$aid,$astatus,$adate)=
    split (/\s+/,$db{"$mopt{'spooldir'}/$newsgroup/$file"});
  return if ($astatus eq "approved");

  # send the reason by mail to article author
  open(ARTICLE,"$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_refuse) Cannot open $mopt{'spooldir'}/$newsgroup/$file for reading");
  my $article=new Mail::Internet (\*ARTICLE);
  close(ARTICLE);

  $article->head->replace("X-Modappbot-Status",
    "refused by $mailfrom; reason : $reason");

  $err=art_archive($article,$newsgroup,'r');
  return ("(art_refuse) $err") if $err;

  # do not send a mail to author if e-mail address contains anti-spam kludge
  if ($mailfrom !~ /$mopt{'noreply'}/) {

    my $subject=$article->head->get('Subject'); chomp ($subject);
    $subject=~ s/(Re|Rep)://g;
    my $artfrom=
      (Mail::Address->parse($article->head->get('From')))[0]->address();

    my $artreply=$article->head->get('Reply-To') || $artfrom;

    my $reply=new Mail::Internet;
    $reply->head->add('From',$groups{'from'}{$newsgroup});
    $reply->head->add('To',$artreply);
    $reply->head->add('Subject',"Re: $subject");
    $reply->head->add('Bcc',$groups{'refusecc'}{$newsgroup})
      if defined $groups{'refusecc'}{$newsgroup};

    # send back the text file giving the refusal reason
    open (REASON,"$mopt{'confdir'}/$newsgroup/$reason") or
      return ("(art_refuse) Cannot open $mopt{'confdir'}/$newsgroup/$reason for reading");
    push @{$reply->body},<REASON>;
    close (REASON);
  
    if ($groups{'includearticle'}{$newsgroup}) {
      if ($groups{'includearticle'}{$newsgroup} =~ /(h|f)/io) {
        push @{$reply->body},"> ",join('> ',@{$article->head->header}),"> \n";
      }

      if ($groups{'includearticle'}{$newsgroup} =~ /(f|b)/io) {
        push @{$reply->body},"> ",join('> ',@{$article->body});
      }
    }
  
    sendmail($reply);
  }

  unlink ("$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_refuse) Cannot delete $mopt{'spooldir'}/$newsgroup/$file");
  delete $db{"$mopt{'spooldir'}/$newsgroup/$file"};

  return ('');
}

######################################################################
# art_release
# Input : 
# $article : article filename
# $newsgroup : group in which article is spooled
# Output : modified db hash
# Action : delete the entry in the database but do not delete the
# article filename so that it can be affected to someone else
# Currently, this works only in manual assignement
######################################################################
sub art_release {
  my ($article,$newsgroup)=@_;
  mlog(2,"(art_release) $article $newsgroup");

  # return if the moderator tries to release an article that
  # is not in the article database (article just released, deleted, refused)
  return if (!defined $db{"$mopt{'spooldir'}/$newsgroup/$article"});

  # return if the moderator tries to release an article
  # that he has just approved
  my ($amod,$agroup,$aid,$astatus,$adate)=
    split (/\s+/,$db{"$mopt{'spooldir'}/$newsgroup/$article"});
  return if ($astatus eq "approved");

  mlog (2,"(art_release) ". $db{"$mopt{'spooldir'}/$newsgroup/$article"});
  delete $db{"$mopt{'spooldir'}/$newsgroup/$article"};
}

######################################################################
# art_approve
# Input : 
# $article : article filename
# $newsgroup : group in which article is spooled
# $action : 'approve' or 'reallyapprove' 
# Output : modified db hash
# Action :
# sends the article to the modapp script so that it can be posted
# (if action is 'reallyapprove ' or if it is 'approve' and article
# is not xposted in other moderated newsgroup) or mailed to next
# moderator (in action is 'approve' and article is xposted in another
# moderated ng)
# article database is modified so that the article is marked as
# approved (even if it is crossposted in other moderated ngs) and
# article is deleted from spool
######################################################################
sub art_approve {
  my ($mailfrom,$file,$newsgroup,$action)=@_;
  mlog(2,"(art_approve) $mailfrom $file $newsgroup $action");

  # return if the moderator tries to approve an article that
  # is not in the article database (article just released, deleted, refused)
  return if (!defined $db{"$mopt{'spooldir'}/$newsgroup/$file"});

  # return if the moderator tries to approve an article
  # that he has just approved
  (undef,undef,undef,my $astatus,undef)=
    split (/\s+/,$db{"$mopt{'spooldir'}/$newsgroup/$file"});
  return if ($astatus eq "approved");

  my ($err,$afrom,$adate,$asubject,$alength,$aflags,$anextgroup,$refnum)= 
    parsearticle("$mopt{'spooldir'}/$newsgroup/$file",$mailfrom);
  return ("(art_approve) $err") if $err;

  open (ARTICLE,"$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_approve) Cannot open article file for reading");
  my $article=new Mail::Internet (\*ARTICLE);
  close (ARTICLE);

  # Get article message-id
  my $msgid=$article->head->get('Message-ID'); chomp($msgid);

  if (($aflags !~ /M/) or ($action eq 'reallyapprove')) {
    # if no groups are moderated or if the moderator
    # really wants to approve the article, even if it will
    # be crossposted in other mod. groups, then, post it
    mlog(2,"(doarticles) [really]approve : $file posted");

    $article->head->replace("X-Modappbot-Status","approved by $mailfrom");
    $err=art_post($article,$newsgroup,'');
    return ("(art_approve) $err") if $err;
  } else {
    # if some groups in which the article will be posted are moderated
    # send it by mail to next moderator
    mlog(2,"(doarticles) approve : $file mailed to $anextgroup");

    $article->head->replace("X-Modappbot-Status",
                        "mailed by $mailfrom to $anextgroup");
    $err=art_post($article,$newsgroup,$anextgroup);
    return ("(art_approve) $err") if $err;
  }
  unlink ("$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_approve) Cannot delete $mopt{'spooldir'}/$newsgroup/$file");
  (my $amod,my $agroup,my $aid,$astatus,my $adate2)=
    split (/\s+/,$db{"$mopt{'spooldir'}/$newsgroup/$file"});
  $adate2=time;
  $db{"$mopt{'spooldir'}/$newsgroup/$file"}=
    join (" ",$amod,$agroup,$msgid,"approved",$adate2);

  return ('');
}

######################################################################
# art_post
# Input : 
# $article : Mail::Internet object article
# $newsgroup : group in which article is spooled
# $anextgroup : can be empty (which means that article is posted)
# if it is not empty, send the article to the moderator of the newsgroup
# Output : none
# Action : pipe the article to newscmd or mailcmd
######################################################################
sub art_post {
  my ($article,$newsgroup,$anextgroup)=@_;

  my $arthead=$article->head();

  # keep mandatory headers, rename the others
  foreach my $tag ($arthead->tags) {
    my $tagfound=0;
    foreach (@keepheaders) {
      $tagfound=1 if (lc($tag) eq lc($_));
    }
    if (!$tagfound and $tag !~ /^X-/) {
      my $taghead=$arthead->get($tag) or next;
      $arthead->delete($tag);
      $arthead->add("X-Original-$tag",$taghead);
    }
  }

  # keep only first instance of multiple headers
  foreach my $tag ($arthead->tags) {
    my $header=($arthead->get($tag))[0];
    $arthead->delete($tag); # delete all instances
    $arthead->add($tag,$header); # add only the first instance
  }

  $arthead->replace("Path","not-for-mail");
  $arthead->replace("Sender",$mopt{'sender'});

  if (defined $groups{'followup'}{$newsgroup}) {
    $arthead->replace("Followup-To",$groups{'followup'}{$newsgroup});
  } elsif (defined $arthead->get('Followup-To')) {
    # check groups in followup
    (my $flags,undef)=ckgroups($arthead->get('Followup-To'),'');
    $arthead->delete('Followup-To') if ($flags =~ /U/);
  }

  my $artorganization=$arthead->get("Organization") || ''; 
  chomp ($artorganization);
  if (!$artorganization) {
    my $organization=
      $groups{'organization'}{$newsgroup} || $mopt{'organization'} || '';
    $arthead->replace("Organization",$organization) if $organization;
  }

  my $artapproved=$arthead->get("Approved") || ''; chomp ($artapproved);
  my $approved=
    (Mail::Address->parse($groups{'from'}{$newsgroup}))[0]->address();
  chomp ($approved);
  if (!$artapproved) {
    $arthead->add("Approved",$approved);
  } else {
    $arthead->replace("Approved",join(',',$artapproved,$approved));
  }

  $arthead->replace("X-Modappbot-Version",$version);
#  $arthead->replace("Date",UnixDate("today","%g"));
  $arthead->replace("Date",
    UnixDate(scalar gmtime(),"%d %b %Y %H:%M:%S GMT"));

  if (-r "$mopt{'confdir'}/$newsgroup/$mopt{'fsignature'}") {
    open (SIGNATURE,"$mopt{'confdir'}/$newsgroup/$mopt{'fsignature'}");
    push @{$article->body},"\n-- \n",<SIGNATURE>;
    close (SIGNATURE);
  }

  mlog (2,"(art_post) $newsgroup $anextgroup");
  if ($anextgroup eq '') {
    mlog (2,"(art_post) article posted");
    my $errnews=0;
    foreach my $nntpserver (split(/\s+/,$groups{'nntpserver'}{$newsgroup} || $mopt{'nntpserver'})) {
      my $newsopts=$mopt{'newsopts'};
      $newsopts=~ s/NNTPSERVER/$nntpserver/ei if $newsopts =~ /NNTPSERVER/i;
      open (NEWS,"| $mopt{'newscmd'} $newsopts");
      $article->print(\*NEWS);
      close (NEWS);
      $errnews=1 if $?;
    }
    return ("(art_post) $mopt{'newscmd'} did not run successfully") if $errnews;
  } else {
    mlog (2,"(art_post) article mailed");
    $anextgroup=~ tr/./-/;
    $arthead->add("To",join('@',$anextgroup,$mopt{'moderators'}));
    sendmail($article);
  }

  $err=art_archive($article,$newsgroup,'p'); return ("(art_refuse) $err") if $err;
  return ('');
}

######################################################################
# art_getarticle
# Input : 
# $article : article filename to get from the spool
# $newsgroup : group in which article is spooled
# Output : none
# Action :
# transfer the specified article filename to the moderator by e-mail
######################################################################
sub art_getarticle {
  my ($mailfrom,$file,$newsgroup)=@_;
  mlog(2,"(art_getarticle) $mailfrom $file $newsgroup");

  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);
  $mailmsg->head->add('Subject',"Modappbot : Article $file for $newsgroup");

  open (ARTICLE,"$mopt{'spooldir'}/$newsgroup/$file") or
    return ("(art_getarticle) Cannot read $mopt{'spooldir'}/$newsgroup/$file");
  push @{$mailmsg->body},<ARTICLE>;
  close (ARTICLE);

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# art_archive
# Input : 
# $article : full filename of article (with full pathname)
# $newsgroup : group in which article is spooled
# Output : none
# Action :
# copy the filename in the archive directory - return if
# maxarchive global variable is reached
######################################################################
sub art_archive {
  my ($article,$newsgroup,$reason)=@_;
  mlog (2,"(art_archive) $newsgroup");

  # return if the archive group keyword does not match the reason for archiving
  return if ($groups{'archive'}{$newsgroup} !~ $reason);

  # Archive the article
  if (! -d "$mopt{'archivedir'}/$newsgroup") {
    mkpath ("$mopt{'archivedir'}/$newsgroup",0,0755) or
      return ("(art_archive) Cannot mkdir $mopt{'archivedir'}/$newsgroup");
  }
  my $index=1;
  while (-f "$mopt{'archivedir'}/$newsgroup/$index") {
    $index++;
    return ("(art_archive) Archive overflow in $newsgroup ($mopt{'maxarchive'} max)") if ($index > $mopt{'maxarchive'});
  }

  open (ARCHIVE,">$mopt{'archivedir'}/$newsgroup/$index") or 
    return ("(art_archive) Cannot copy article from spooldir to archivedir");
  print ARCHIVE join("",@{$article->head->header},("\n"),@{$article->body});
  close (ARCHIVE);
  mlog(2,"(art_archive) $index $newsgroup");

  return ('');
}

######################################################################
# newpassword
# Input : 
# $newsgroup : group for which password is changed
# $password : new password
# Output : new configuration filename
# Action :
# change the password configuration variable in the config file
######################################################################
sub newpassword {
  my ($mailfrom,$newsgroup,$password)=@_;
  mlog (2,"(newpassword) $mailfrom $newsgroup $password");
  my (@newconfig,$i);

  my ($where, $grp_found, $key) = (0, 0, '');
  open (RC, $configfile) or 
    return ("(newpassword) cannot open $configfile configuration file for reading");
  while (<RC>) {
    $newconfig[$i]=$_;
    next if /^#/;
    $where = /^\s*\[\s*(\S+)\s*\]/o .. /^\s*\[\s*end\s*\]/io;
    if ($where) {
      $grp_found = $1 if $where == 1;
      if (/^\s*([^=\s]+)\s*=\s*(.+)/) {
        if (($grp_found eq $newsgroup) and ($1 eq "password")) {
          # 'password' keyword found in the config file for
          # the specified newsgroup name
          $newconfig[$i]="password=$password\n";
        }
      }
    }
    $i++;
  }
  close(RC);

  # make a backup of the old configuration file
  rename $configfile, "$configfile.old" or
    return ("(newpassword) Cannot backup modappbot configuration file");

  # write the new configuration file
  open (RC, ">$configfile") or return ("(newpassword) Cannot open $configfile for writing");
  print RC join('',@newconfig);
  close (RC);

  # send the new password to all moderators of the specified newsgroup
  open (MODERATORS,"$mopt{'confdir'}/$newsgroup/$mopt{'fmoderators'}") or 
    return ("(newpassword) Cannot open $mopt{'confdir'}/$newsgroup/$mopt{'fmoderators'} file for reading");

  while (<MODERATORS>) {
    chomp;
    next if (/^#/);
    next if (/^\s*$/);
    my $mailmsg=new Mail::Internet;
    $mailmsg->head->add('From',$mopt{'from'});
    $mailmsg->head->add('To',$_);
    $mailmsg->head->add('Subject',"Modappbot : new password for $newsgroup");

    push @{$mailmsg->body},
"$mailfrom has set a new password for $newsgroup.

The new password is : $password

";

    sendmail ($mailmsg);
  }
  close (MODERATORS);

  return ('');
}

######################################################################
# sendhelp
# Input : 
# $helpfile : can be 'helpfile' or 'adminhelpfile' - specifies the
# help file name that is sent to the asking moderator or administrator
# Output : none
# Action :
# send a help file by e-mail
# give the configuration details of the groups for which mailfrom is 
# moderator 
######################################################################
sub sendhelp {
  my ($mailfrom,$helpfile)=@_;
  mlog (2,"(sendhelp) $mailfrom $helpfile");

  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);

  open (HELPFILE,$helpfile) or return ("(sendhelp) cannot open $helpfile for reading");
  my $firstline=<HELPFILE>; chomp($firstline);
  if ($firstline =~ /^Subject:/io) {
    $mailmsg->head->add('Subject',$firstline);
  } else {
    push @{$mailmsg->body},$firstline,"\n";
  }
  push @{$mailmsg->body},<HELPFILE>;
  close (HELPFILE);

  push @{$mailmsg->body},
"----------------------------------------------------------------------
You ($mailfrom) are moderator for the following newsgroups :

";

  # get configuration parameters for sender
  my $ismoderator=0;
  foreach my $declared_ng (keys %{$groups{'password'}}) {
    if (defined $moderators{"$mailfrom $declared_ng"}) {
      push @{$mailmsg->body},"* $declared_ng";
      $ismoderator=1;
    }
  }
  push @{$mailmsg->body},"NONE (only administrator)" if !$ismoderator;
 
  # get configuration parameters for every newsgroup 
  # for which sender is moderator
  foreach my $declared_ng (keys %{$groups{'password'}}) {
    if (defined $moderators{"$mailfrom $declared_ng"}) {
      push @{$mailmsg->body},
"\n----------------------------------------------------------------------
Configuration parameters for $declared_ng newsgroup :

";
      push @{$mailmsg->body},"Password : $groups{'password'}{$declared_ng}\n";

      if (defined $groups{'organization'}{$declared_ng} and $groups{'organization'}{$declared_ng}) {
        push @{$mailmsg->body},"Group Organization: header: $groups{'organization'}{$declared_ng}\n";
      } else {
        push @{$mailmsg->body},"Group Organization: header is not set.\n";
      }

      if (defined $groups{'followup'}{$declared_ng} and $groups{'followup'}{$declared_ng}) {
        push @{$mailmsg->body},"Group Followup-To: header: $groups{'followup'}{$declared_ng}\n";
      } else {
        push @{$mailmsg->body},"Group Followup-To: header is not set.\n";
      }

      if (defined $groups{'articledbexpire'}{$declared_ng}) {
        if ($groups{'articledbexpire'}{$declared_ng} > 0) {
          push @{$mailmsg->body},"Article database expiration : $groups{'articledbexpire'}{$declared_ng} days\n";
        } elsif ($groups{'articledbexpire'}{$declared_ng} ==0) {
          push @{$mailmsg->body},"Article database expiration is null\nwhich means that approved articles are not kept in the database\n";
        }
      } elsif (defined $groups{'checkrefs'}{$declared_ng}) {
        if ($groups{'checkrefs'}{$declared_ng} =~ /^n/io) {
          push @{$mailmsg->body},"Article database expiration is negative and checkrefs is set to 'no'\n  which means that approved articles are not kept in the database\n";
        }
      } else {
        push @{$mailmsg->body},"Article database expiration is not set for this group.\n";
      }

      if (defined $groups{'ack'}{$declared_ng}) {
        if ($groups{'ack'}{$declared_ng} =~ /f/i) {
          push @{$mailmsg->body},"Full article is sent back to author in the acknowledgment\n";
        } elsif ($groups{'ack'}{$declared_ng} =~ /b/i) {
          push @{$mailmsg->body},"Only the body is sent back to author in the acknowledgment\n";
        } elsif ($groups{'ack'}{$declared_ng} =~ /h/i) {
          push @{$mailmsg->body},"Only the headers are sent back to author in the acknowledgment\n";
        }
      }

      if (defined $groups{'whitelist'}{$declared_ng}) {
        if ($groups{'whitelist'}{$declared_ng}=~ /y/i) {
          if (-r "$mopt{'confdir'}/$declared_ng/whitelist") {
            push @{$mailmsg->body},"A whitelist file is used\n";
          }
        } elsif ($groups{'whitelist'}{$declared_ng} =~ /n/i) {
          push @{$mailmsg->body},"No whitelist file is used\n";
        }
      }

      if (defined $groups{'blacklist'}{$declared_ng}) {
        if ($groups{'blacklist'}{$declared_ng}=~ /y/i) {
          if (-r "$mopt{'confdir'}/$declared_ng/$mopt{'fblacklist'}") {
            push @{$mailmsg->body},"A blacklist file is used\n";
          }
        } elsif ($groups{'blacklist'}{$declared_ng} =~ /n/i) {
          push @{$mailmsg->body},"No blacklist file is used\n";
        }
      }

      if (defined $groups{'blacksubject'}{$declared_ng} and $groups{'blacksubject'}{$declared_ng}) {
        push @{$mailmsg->body},"Articles are dropped if their subject matches \n  the following regexp : $groups{'blacksubject'}{$declared_ng}\n";
      }

      if (defined $groups{'whitesubject'}{$declared_ng} and $groups{'whitesubject'}{$declared_ng}) {
        if (defined $groups{'autopost'}{$declared_ng}) {
          if ($groups{'autopost'}{$declared_ng} =~ /^y/io) {
            push @{$mailmsg->body},"Articles are autoposted if their subject matches \n  the following regexp : $groups{'whitesubject'}{$declared_ng}\n";
          } elsif ($groups{'autopost'}{$declared_ng} =~ /^n/io) {
            push @{$mailmsg->body},"Articles are spooled if their subject matches \n  the following regexp : $groups{'whitesubject'}{$declared_ng}\n";
          }
        } else {
          push @{$mailmsg->body},"Articles are spooled if their subject matches \n  the following regexp : $groups{'whitesubject'}{$declared_ng}\n  (because autopost is not set)\n";
        }
        if (defined $groups{'subjectdb'}{$declared_ng} and $groups{'subjectdb'}{$declared_ng} =~ /^n/io) {
          push @{$mailmsg->body},"E-mail of authors is not saved in a database.
  Therefore, they will receive an acknowledgment for every article posted
  in the group.\n";
        } else {
          push @{$mailmsg->body},"E-mail of authors is saved in a database, preventing 
  them to receive an ack for every posted article.\n";
          if ($groups{'subjectdbexpire'}{$declared_ng}) {
            if ($groups{'subjectdbexpire'}{$declared_ng} =~ /^\d+$/) {
              push @{$mailmsg->body},"E-mails are kept for $groups{'subjectdbexpire'}{$declared_ng} days. (0 means forever)\n";
            }
          } else {
            push @{$mailmsg->body},"E-mails are kept forever in the database\n";
          }
        }
      }

      if (defined $groups{'refusecc'}{$declared_ng} and $groups{'refusecc'}{$declared_ng}) {
        push @{$mailmsg->body},"A blind copy of refused articles is sent to : $groups{'refusecc'}{$declared_ng}\n";
      } else {
        push @{$mailmsg->body},"Refused articles are not bcc-ed to anybody\n";
      }

      if (-f "$mopt{'confdir'}/$declared_ng/$mopt{'fsignature'}") {
        push @{$mailmsg->body},"Signature file : \n\n";
        open (SIGN,"$mopt{'confdir'}/$declared_ng/$mopt{'fsignature'}") or
          return ("(sendhelp) can't open $mopt{'confdir'}/$declared_ng/$mopt{'fsignature'} signature file for reading\n ($!)\n");
        push @{$mailmsg->body},<SIGN>;
        close (SIGN);
        push @{$mailmsg->body},"\n";
      } else {
        push @{$mailmsg->body},"No signature file\n";
      }

      if ($groups{'sendarticles'}{$declared_ng} =~ /f/i) {
        push @{$mailmsg->body},
          "Full articles are sent to moderators during 'available' phase\n";
      } elsif ($groups{'sendarticles'}{$declared_ng} =~ /b/i) {
        push @{$mailmsg->body},
          "Only the body of articles are sent to moderators during 'available' phase\n";
      } elsif ($groups{'sendarticles'}{$declared_ng} =~ /h/i) {
        push @{$mailmsg->body},
          "Only the headers of articles are sent to moderators during 'available' phase\n";
      }

      my $refuse=0;
      foreach my $command (keys %groups) {
        if ((defined $groups{$command}{$declared_ng}) and 
            ($command =~ /^refuse\./)) {
          push @{$mailmsg->body},"Possible refuse commands :\n" if (!$refuse);
          push @{$mailmsg->body},"* $command\n";
          $refuse=1;
        }
      }

      if (defined $groups{'includearticle'}{$declared_ng} and $refuse) {
        if ($groups{'includearticle'}{$declared_ng} =~ /f/i) {
          push @{$mailmsg->body},
            "Full article is sent back to author of a refused article\n";
        } elsif ($groups{'includearticle'}{$declared_ng} =~ /b/i) {
          push @{$mailmsg->body},
            "Only the body is sent back to author of a refused article\n";
        } elsif ($groups{'includearticle'}{$declared_ng} =~ /h/i) {
          push @{$mailmsg->body},
            "Only the headers are sent back to author of a refused article\n";
        }
      }
      if (defined $groups{'from'}{$declared_ng} and $refuse) {
        push @{$mailmsg->body},"Refused articles are sent back to sender with the following From: header :\n";
        push @{$mailmsg->body},"  $groups{'from'}{$declared_ng}\n";
      }

      my $archived= "Refused or deleted articles are ";
      if (defined $groups{'archive'}{$declared_ng} and 
          $groups{'archive'}{$declared_ng} =~ /n/io) {
        $archived.="not ";
      }
      $archived.="archived\n";

      push @{$mailmsg->body},$archived;
    }
  }

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# putfile
# Input : 
# $file : filename to put
# $text : file contents to put
# $backup : if 1, do a backup of old file before replacing it if it exists
# backup filename is same as filename with a '.old' appended to filename
# Output : new file
# Action : writes a new file on the disk
######################################################################
sub putfile {
  my ($file,$text,$backup)=@_;
  mlog(2,"(putfile) $file $backup");

  if ($backup and -f $file) {
    rename "$file", "$file.old" or return ("(putfile) cannot backup old $file file");
  }
  open (NEWFILE,">$file") or return ("(putfile) cannot open $file file for writing");
  print NEWFILE $text;
  close (NEWFILE);

  return ('');
}

######################################################################
# admgetfile
# Input : 
# $file : filename to get
# Output : none
# Action : send the requested file to the administrator
######################################################################
sub admgetfile {
  my ($mailfrom,$file)=@_;
  mlog (2,"(admgetfile) $mailfrom $file");

  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);
  $mailmsg->head->add('Subject',"Modappbot : $file");

  open (MYFILE, "$mopt{'confdir'}/$file");
  push @{$mailmsg->body},<MYFILE>;
  close (MYFILE);

  sendmail ($mailmsg);

  return ('');
}

######################################################################
# admputfile
# Input : 
# $file : filename to put
# Output : none
# Action : copies the included file in the configuration and
# send an acknowledgement to the administrator or moderators
######################################################################
sub admputfile {
  my ($mailfrom,$file)=@_;
  mlog (2,"(admputfile) $mailfrom");

  my $filename="";
  ($filename,$file)=split(/\n/,$file,2);
  if ($filename eq $mopt{'fhelpfile'}) {
    $err=putfile("$mopt{'confdir'}/$filename",$file,1);
    return ("(admputfile) $err") if $err;
    my %modsent=();
    foreach my $declared_ng (keys %{$groups{'password'}}) {
      open (MODERATORS,"$mopt{'confdir'}/$declared_ng/$mopt{'fmoderators'}");
      while (<MODERATORS>) {
        chomp;
        next if (/^\s*$/);
        next if (defined $modsent{$_});
        $modsent{$_}=1;
        my $mailmsg=new Mail::Internet;
        $mailmsg->head->add('From',$mopt{'from'});
        $mailmsg->head->add('To',$_);
        $mailmsg->head->add('Cc',$mopt{'admin'});
        $mailmsg->head->add('Subject',
          "Modappbot : New helpfile set by $mailfrom");

        push @{$mailmsg->body},
"The administrator has set a new helpfile.
The new helpfile is :

$file
";
        sendmail($mailmsg);
      }
      close (MODERATORS);
    
    }
  } elsif ($filename eq $mopt{'fadminhelpfile'}) {
    $err=putfile("$mopt{'confdir'}/$filename",$file,1);
    return ("(admputfile) $err") if $err;

    my $mailmsg=new Mail::Internet;
    $mailmsg->head->add('From',$mopt{'from'});
    $mailmsg->head->add('To',$mopt{'admin'});
    $mailmsg->head->add('Subject',
      "Modappbot : New adminhelpfile set by $mailfrom");

    push @{$mailmsg->body},
"The administrator has set a new adminhelpfile.
The new file is :

$file

";
    sendmail ($mailmsg);
  } elsif ($filename eq $mopt{'fconfigfile'}) {
    my (%tmpgroups,%tmpmopt)=((),());
    %tmpmopt=%mopt;

    my ($refmopt,$refgroups);
    my $returnparserc='';
    my $returnbottest='';
    my $testoutput='';
    eval { ($refmopt,$refgroups)=&parserc(\%tmpmopt,\%tmpgroups,$file) };
    if ($@) {
      $returnparserc=$@;
    } else {
      %tmpgroups=%{$refgroups};
      my %returnmopt=%{$refmopt};
      foreach (keys %returnmopt) {
        $tmpmopt{$_}=$returnmopt{$_};
      }
      ($testoutput,$returnbottest)=bottest(\%tmpmopt,\%tmpgroups);
    }

    # send back an acknowledge if new config file syntax is ok
    if (!$returnparserc and !$returnbottest) {
      mlog(2,"(admputfile) $filename config OK");
      $err=putfile($configfile,$file,1);
      return ("(admputfile) $err") if $err;
      my $mailmsg=new Mail::Internet;
      $mailmsg->head->add('From',$mopt{'from'});
      $mailmsg->head->add('To',$mopt{'admin'});
      $mailmsg->head->add('Subject',
        "Modappbot : New configuration file set by $mailfrom");

      push @{$mailmsg->body},
"The new configuration is :

$file

";

      sendmail ($mailmsg);
    } else {
      mlog(2,"(admputfile) $filename config refused");
      my $mailmsg=new Mail::Internet;
      $mailmsg->head->add('From',$mopt{'from'});
      $mailmsg->head->add('To',$mailfrom);
      $mailmsg->head->add('Subject',
        "Modappbot : new configuration file REFUSED !");

      push @{$mailmsg->body},
"The configuration file that you have sent is not valid.
Here is the output of the test procedure :

";
      push @{$mailmsg->body},$returnparserc if $returnparserc;
      push @{$mailmsg->body},$testoutput if $returnbottest;

      sendmail ($mailmsg);
    }
  }

  return ('');
}

######################################################################
# groupgetfile
# Input : 
# $group : group in which the filename is located
# $file : file to get in the group configuration
# Output : none
# Action : send the  file to the moderator
######################################################################
sub groupgetfile {
  my ($mailfrom,$group,$file)=@_;
  mlog(2,"(groupgetfile) $mailfrom $group $file");
  mlog(2,"(groupgetfile) $file sent to $mailfrom");
  my $mailmsg=new Mail::Internet;
  $mailmsg->head->add('From',$mopt{'from'});
  $mailmsg->head->add('To',$mailfrom);
  $mailmsg->head->add('Subject',"Modappbot : $file for $group");

  open (MYFILE,"$mopt{'confdir'}/$group/$file") or
    return ("(groupgetfile) Cannot open $mopt{'confdir'}/$group/$file for reading : $!");
  push @{$mailmsg->body},<MYFILE>;
  close (MYFILE);
  sendmail($mailmsg);

  return ('');
}

######################################################################
# groupputfile
# Input : 
# $group : group in which the filename is located
# $file : file to put in the group configuration
# Output : none
# Action : put the new file in configuration and warn moderators
# that file has changed
######################################################################
sub groupputfile {
  my ($mailfrom,$group,$file)=@_;
  my $filename='';
  ($filename,$file)=split(/\n/,$file,2);
  mlog(2,"(groupputfile) $mailfrom $group $filename");
  $err=putfile("$mopt{'confdir'}/$group/$filename",$file,1);
  return ("(groupputfile) $err") if $err;

  open (MODERATORS,"$mopt{'confdir'}/$group/$mopt{'fmoderators'}");
  # warn the moderators that file has changed
  while (<MODERATORS>) {
    chomp;
    next if (/^#/);
    next if (/^\s*$/);
    my $moderator=$_;
    mlog(2,"(groupputfile) sendmail: $_");
    my $mailmsg=new Mail::Internet;
    $mailmsg->head->add('From',$mopt{'from'});
    $mailmsg->head->add('To',$moderator);
    $mailmsg->head->add('Subject',
      "Modappbot : new $filename for $group set by $mailfrom");

    push @{$mailmsg->body},
"$mailfrom has put a new file 
named $filename for $group.

The file is now :

$file

";
    sendmail ($mailmsg);
  }
  close (MODERATORS);

  return ('');
}

######################################################################
# checkpassword
# Input : 
# $password : typed password
# $newsgroup : group name
# Output : 1 if password is OK, 0 if not
# Action :
# check if password is same as the password specified in the config file
# for the $newsgroup variable
######################################################################
sub checkpassword {
  my ($password,$newsgroup)=@_;
  mlog (2,"(checkpassword) $password $newsgroup");

  if ($groups{'password'}{$newsgroup} eq $password) {
    return (1);
  } else {
    return (0);
  }
}

######################################################################
# declaredng
# Input : 
# $newsgroup : group name
# Output : 1 if $newsgroup is declared in config file, otherwise 0
# Action :
# check if $newsgroup is declared in the configuration of the bot
######################################################################
sub declaredng {
  my $newsgroup=shift;
  mlog (2,"(declaredng) $newsgroup");

  my $found=0;
  foreach (keys %{$groups{'password'}}) {
    $found=1 if ($newsgroup eq $_);
  }
  return ($found);
}

######################################################################
# parsemoderators
# Input : none
# Output : modified %moderators hash
# Action :
# parse the moderators file for every configured newsgroup and
# fill the %moderators hash
# this hash can contain two keys : mod e-mail only
# and mod e-mail + group name for which this e-mail is moderator
######################################################################
sub parsemoderators {
  mlog (2,"(parsemoderators)");
  foreach my $declared_ng (keys %{$groups{'password'}}) {
    open (MODERATORS,"$mopt{'confdir'}/$declared_ng/$mopt{'fmoderators'}") or
      die "(parsemoderators) cannot open $mopt{'confdir'}/$declared_ng/$mopt{'fmoderators'} moderators file: $!\n";
    while (<MODERATORS>) {
      chomp;
      next if (/^#/);
      next if (/^\s*$/);
      s/^\s*//g;
      s/\s*$//g;
      $_=lc($_);
      mlog(2,"(parsemoderators) $_ $declared_ng");
      # The moderators hash contains two things :
      # a key with the e-mail of each moderator and his group
      # a key with simply the e-mail of each moderator
      $moderators{"$_ $declared_ng"}=1;
      $moderators{$_}=1;
    }
    close (MODERATORS);
  }
}

######################################################################
# help
# Input : none
# Output : none
# Action :
# print the usage of the bot on standard output. Used with -h option
# or without any command line options
######################################################################
sub help {
  mlog (2,"(help)");
  print "This is Modappbot version $version.

Syntax : modappbot -c configfile -h -t -v

If modappbot is launched without command line options,
it will check the contents of the group and command mailboxes.

-c configfile : specify another configuration file instead 
                of $configfile
-h            : this help message
-t            : test the configuration of the robot
-v            : print the version of the robot

";

}

######################################################################
# bottest
# Input : 
# Output : 
# Action :
######################################################################
sub bottest {
  mlog (2,"(bottest)");
  my ($refmopt,$refgroups)=@_;
  my %mopt=%{$refmopt};
  my %groups=%{$refgroups};
  my $error=0;
  my $msgtext="
This is Modappbot version $version, running in test mode.

Fatal errors are mentionned by '->'.

Global options :
----------------
";

  if (defined $mopt{'admin'}) {
    foreach my $administrator (split(/\s+|,/,$mopt{'admin'})) {
      if ($administrator !~ /([a-z_0-9\.]+[+])?[-a-z_0-9\.]+@[-a-z0-9\.]+/io or
          $administrator =~ /[\;\<\>\*\|\`\&\$\!\#\(\)\[\]\{\}\:\'\"\/]/) {
        $msgtext.="-> Admin e-mail : $administrator : Invalid e-mail address\n";
        delete $mopt{'admin'};
        $error=1;
      } else {
        $msgtext.= "Administrator e-mail : $administrator\n";
      }
    }
  } else {
    $msgtext.= "-> No administrator e-mail defined\n";
    $error=1;
  }

  if (defined $mopt{'adminpw'}) {
    $msgtext.= "Administrator password : $mopt{'adminpw'}\n";
  } else {
    $msgtext.= "-> No administrator password defined\n";
    $error=1;
  }

  if (! -r "$mopt{'confdir'}/$mopt{'fhelpfile'}") {
    $msgtext.="-> Helpfile does not exist\n";
    $error=1;
  } 
  if (! -r "$mopt{'confdir'}/$mopt{'fadminhelpfile'}") {
    $msgtext.="-> Administrator helpfile does not exist\n";
    $error=1;
  } 

  if ($mopt{'warnadmin'} =~ /y/i) {
    $msgtext.= "Warn admin when Modappbot receives a mail from a non moderator\n";
  } elsif ($mopt{'warnadmin'} =~ /n/i) {
    $msgtext.= "Do NOT warn admin when Modappbot receives a mail from a non moderator\n";
  } elsif (defined $mopt{'warnadmin'}) {
    $msgtext.= "-> warnadmin=$mopt{'warnadmin'} : incorrect value (should be boolean)\n";
    $error=1;
  }

  if (defined $mopt{'from'}) {
    $msgtext.="Address used in mail sent to moderators : $mopt{'from'}\n";
  } else {
    $msgtext.="-> The 'from' global variable is NOT defined.\n";
    $error=1;
  }

  if (defined $mopt{'sender'}) {
    $msgtext.="Contents of Sender: header added to articles : $mopt{'sender'}\n";
  } else {
    $msgtext.="-> The 'sender' global variable is NOT defined.
  This variable must contain the value added to the Sender: header added
  by Modappbot in headers\n";
    $error=1;
  }

  if (defined $mopt{'noreply'}) {
    $msgtext.="Regexp matching anti-spam e-mail addresses in articles : $mopt{'noreply'}\n";
  } else {
    $msgtext.="The 'noreply' global variable is not defined. 
  This variable can be used to prevent Modappbot to send mail to 
  people using anti-spam e-mail addresses.\n";
  }

  if (defined $mopt{'maxgroups'}) {
    if ($mopt{'maxgroups'} =~ /^\d+$/ and $mopt{'maxgroups'} > 0) {
      $msgtext.= "Maximum newsgroups (C flag in report) : $mopt{'maxgroups'}\n";
    } else {
      $msgtext.= "-> maxgroups=$mopt{'maxgroups'} : incorrect value (should be numeric and greater than zero)\n";
      $error=1;
    }
  } else {
    $msgtext.= "No maxgroups value defined\n";
  }

  if (defined $mopt{'maxfollowups'}) {
    if ($mopt{'maxfollowups'} =~ /^\d+$/ and $mopt{'maxfollowups'} > 0) {
      $msgtext.= "Maximum followups (F flag in report) : $mopt{'maxfollowups'}\n";
    } else {
      $msgtext.= "-> maxfollowups=$mopt{'maxfollowups'} : incorrect value (should be numeric and greater than zero)\n";
      $error=1;
    }
  } else {
    $msgtext.= "No maxfollowups value defined\n";
  }

  if (defined $mopt{'activefile'}) {
    if (-r $mopt{'activefile'}) {
      $msgtext.= "Active file : $mopt{'activefile'}\n";
    } else {
      $msgtext.= "-> Active file : $mopt{'activefile'} is NOT readable\n";
      $error=1;
    }
  } else {
    $msgtext.= "No active file access method is defined\n";
    $error=1;
  }

  if (defined $mopt{'nntpserver'}) {
    if ($mopt{'nntpserver'} =~ /\s+/) {
      $msgtext.="Modappbot will post articles to multiple news servers :\n";
      foreach (split(/\s+/,$mopt{'nntpserver'})) {
        $msgtext.="  * $_\n";
      }
    } else {
      $msgtext.="Modappbot will post articles to the $mopt{'nntpserver'} news server\n";
    }
  } else {
    $msgtext.="-> The global 'nntpserver' variable is NOT defined.
  This variable must contain the name of the news server that Modappbot
  will use for posting articles. It can also contain a list of
  servers separated by blanks.\n";
    $error=1;
  }

  if (defined $mopt{'moderators'}) {
    $msgtext.="Moderators mailhost : $mopt{'moderators'}\n";
  } else {
    $msgtext.="-> The global 'moderators' variable is NOT defined.
  This variable must contain the name of the host receiving articles
  sent by Modappbot if they are crossposted to other moderated newsgroups
  (moderators.isc.org for instance).\n";
    $error=1;
  }

  if (defined $mopt{'loglevel'}) {
    if ($mopt{'loglevel'} =~ /^\d+$/) {
      $msgtext.= "Logging level : $mopt{'loglevel'}\n";
    } else {
      $msgtext.= "-> loglevel=$mopt{'loglevel'} : incorrect value (should be numeric)\n";
      $error=1;
    }
  } else {
    $msgtext.= "No loglevel value defined\n";
  }

  if (defined $mopt{'logfile'}) {
    if (-r $mopt{'logfile'}) {
      $msgtext.= "Logfile : $mopt{'logfile'}\n";
    } else {
      $msgtext.= "-> logfile $mopt{'logfile'} is not readable\n";
      $error=1;
    }
  } else {
    $msgtext.= "-> logfile pathname is not defined\n";
    $error=1;
  }

  if (defined $mopt{'lockretries'}) {
    if ($mopt{'lockretries'} =~ /^\d+$/ and $mopt{'lockretries'} > 0) {
      $msgtext.="Number of mailbox locking retries : $mopt{'lockretries'}\n";
    } else {
      $msgtext.="-> lockretries=$mopt{'lockretries'} : incorrect value (should be numeric and greater than zero\n";
      $error=1;
    }
  } else {
    $msgtext.="-> The 'lockretries' global variable is NOT defined.\n";
    $error=1;
  }

  if (defined $mopt{'locksleep'}) {
    if ($mopt{'locksleep'} =~ /^\d+$/ and $mopt{'locksleep'} > 0) {
      $msgtext.="Number of seconds to wait if mailbox is already locked : $mopt{'locksleep'}\n";
    } else {
      $msgtext.="-> locksleep=$mopt{'locksleep'} : incorrect value (should be numeric and greater than zero)\n";
      $error=1;
    } 
  } else {
    $msgtext.="-> The 'locksleep' global variable is NOT defined.\n";
    $error=1;
  }

  if (defined $mopt{'confdir'}) {
    if (-w $mopt{'confdir'}) {
      $msgtext.= "Configuration directory : $mopt{'confdir'}\n";
    } else {
      $msgtext.= "-> Configuration directory $mopt{'confdir'} is NOT writable\n";
      $error=1;
    }
  } else {
      $msgtext.= "-> No configuration directory defined\n";
      $error=1;
  }
 
  if (defined $mopt{'spooldir'}) {
    if (-w $mopt{'spooldir'}) {
      $msgtext.= "Spool directory : $mopt{'spooldir'}\n";
    } else {
      $msgtext.= "-> Spool directory $mopt{'spooldir'} is NOT writable\n";
      $error=1;
    }
  } else {
    $msgtext.= "-> No spool directory defined\n";
    $error=1;
  }

  if (defined $mopt{'archivedir'}) {
    if (-w $mopt{'archivedir'}) {
      $msgtext.= "Archive directory : $mopt{'archivedir'}\n";
    } else {
      $msgtext.= "-> Archive directory $mopt{'archivedir'} is NOT writable\n";
      $error=1;
    }
  } else {
    $msgtext.= "No archive directory defined\n";
  }

  if (defined $mopt{'mailboxdir'}) {
    if (-w $mopt{'mailboxdir'}) {
      $msgtext.= "Mailbox directory : $mopt{'mailboxdir'}\n";
    } else {
      $msgtext.= "-> Mailbox directory $mopt{'mailboxdir'} is NOT writable\n";
      $error=1;
    }
  } else {
    $msgtext.= "-> No mailbox directory defined\n";
    $error=1;
  }

  if (defined $mopt{'mailbox'}) {
    $msgtext.="Modappbot Mailbox file (relative to mailboxdir) : $mopt{'mailbox'}\n";
  } else {
    $msgtext.="-> No Modappbox mailbox file defined\n";
    $error=1;
  }

  if (defined $mopt{'maxarchive'}) {
    $msgtext.="Maximum number of articles in the archive directories : $mopt{'maxarchive'}\n";
  } else {
    $msgtext.="The 'maxarchive' global variable is not set.
  This variable can be used to fix the maximum number of articles saved
  in the group archive directories.\n";
  }

  if (defined $mopt{'maxspool'}) {
    $msgtext.="Maximum number of articles in the spool directories : $mopt{'maxspool'}\n";
  } else {
    $msgtext.="The 'maxspool' global variable is not set.
  This variable can be used to fix the maximum number of articles 
  in the group spool directories.\n";
  }

  if (defined $mopt{'articledbexpire'}) {
    if ($mopt{'articledbexpire'} !~ /^\d+$/) {
      $msgtext.= "-> articledbexpire=$mopt{'articledbexpire'} : incorrect value (should be numeric)\n";
      $error=1;
    } else {
      $msgtext.= "Global article expiration date : $mopt{'articledbexpire'} days\n";
    }
  } else {
    $msgtext.= "Global article expiration date is not set\n";
  }

  if (defined $mopt{'organization'} and $mopt{'organization'}) {
    $msgtext.= "Global Organization: header: $mopt{'organization'}\n";
  } else {
    $msgtext.= "Global Organization: header is not set.\n";
  }

  if (defined $mopt{'nosubject'} and $mopt{'nosubject'}) {
    $msgtext.="Contents of Subject: header added to articles containing no subject : $mopt{'nosubject'}\n";
  } else {
    $msgtext.="The 'nosubject' global variable is not set.\n";
  }

  # External software configuration tests
  $msgtext.="\nExternal software checks :\n";
  $msgtext.="--------------------------\n";
  # mail configuration
  $msgtext.="\n* Mail configuration\n";
  if (-x $mopt{'mailcmd'}) {
    if ($mopt{'mailcmd'} =~ /sendmail/) {
      $msgtext.="Mails are sent with $mopt{'mailcmd'} $mopt{'mailopts'}\n";
      if (defined $mopt{'admin'}) {
        foreach my $administrator (split(/\s+|,/,$mopt{'admin'})) {
          my $testmail=new Mail::Internet;
          $testmail->head->add('From',"Modappbot (Modappbot in test mode)");
          $testmail->head->add('To',$administrator);
          $testmail->head->add('Subject',"Modappbot configuration test");

          push @{$testmail->body},
"If you can read this mail, this means that mail configuration 
of Modappbot is OK.
";

          sendmail($testmail);
          $msgtext.="A test mail has been sent to $administrator\n";
        }

      } else {
        $msgtext.="-> I was unable to send a test mail because admin is not defined\nor maybe the administrator e-mail is incorrect\n";
        $error=1;
      }
    } else {
        $msgtext.="-> $mopt{'mailcmd'} should be sendmail\n";
        $error=1;
      }
  } else {
    $msgtext.="-> $mopt{'mailcmd'} is not executable\n";
    $error=1;
  }

  $msgtext.= "* News configuration\n";
  if (defined $mopt{'newscmd'}) {
    if (-x $mopt{'newscmd'}) {
      $msgtext.="Articles are posted with $mopt{'newscmd'} $mopt{'newsopts'}\n";
    } else {
      $msgtext.="-> $mopt{'newscmd'} is not executable\n";
      $error=1;
    }
  } else {
    $msgtext.="-> newscmd variable is not defined\n";
    $error=1;
  }

  # Group tests
  my @groups=keys (%{$groups{'password'}});
  if ($#groups >=0 ) {
    foreach (@groups) {
      $msgtext.= "\nGroup options for $_ :\n";
      $msgtext.= "------------------" . "-" x length($_) . "--\n";

      if (defined $groups{'password'}{$_}) {
        $msgtext.= "Group password : $groups{'password'}{$_}\n";
      } else {
        $msgtext.= "-> No group password defined\n";
        $error=1;
      }

      if (defined $groups{'nntpserver'}{$_}) {
        if ($groups{'nntpserver'}{$_} =~ /\s+/) {
          $msgtext.="Modappbot will post articles for $_ to multiple news servers :\n";
          foreach (split(/\s+/,$groups{'nntpserver'}{$_})) {
            $msgtext.="  * $_\n";
          }
        } else {
          $msgtext.="Modappbot will post articles for $_ to the $groups{'nntpserver'}{$_} news server\n";
        }
      }

      if (defined $groups{'organization'}{$_} and $groups{'organization'}{$_}) {
        $msgtext.= "Group Organization: header: $groups{'organization'}{$_}\n";
      } else {
        $msgtext.= "Group Organization: header is not set.\n";
      }

      if (defined $groups{'followup'}{$_} and $groups{'followup'}{$_}) {
        $msgtext.= "Group Followup-To: header: $groups{'followup'}{$_}\n";
      } else {
        $msgtext.= "Group Followup-To: header is not set.\n";
      }

      if (defined $groups{'mailbox'}{$_} and $groups{'mailbox'}{$_}) {
        $msgtext.= "Group mailbox (relative to mailboxdir) : $groups{'mailbox'}{$_}\n";
      } else {
        $msgtext.= "-> Group mailbox is not defined\n";
        $error=1;
      }

      if (defined $groups{'sendarticles'}{$_}) {
        if ($groups{'sendarticles'}{$_} =~ /f/i) {
          $msgtext.= "Full articles are sent to moderators during 'available' phase\n";
        } elsif ($groups{'sendarticles'}{$_} =~ /b/i) {
          $msgtext.= "Only the body of articles is sent to moderators during 'available' phase\n";
        } elsif ($groups{'sendarticles'}{$_} =~ /h/i) {
          $msgtext.= "Only the headers of articles are sent to moderators during 'available' phase\n";
        } else {
          $msgtext.= "-> sendarticles=$groups{'sendarticles'}{$_} : incorrect value (should be f/b/h tri-option)\n";
          $error=1;
        }
      } else {
        $msgtext.= "Do NOT send articles to moderators during 'available' phase\n";
      }

      if (defined $groups{'articledbexpire'}{$_}) {
        if ($groups{'articledbexpire'}{$_} !~ /^\d+$/) {
          $msgtext.= "-> articledbexpire=$groups{'articledbexpire'}{$_} : incorrect value (should be numeric)\n";
          $error=1;
        } elsif ($groups{'articledbexpire'}{$_} > 0) {
          $msgtext.= "Article database expiration : $groups{'articledbexpire'}{$_} days\n";
        } elsif ($groups{'articledbexpire'}{$_} ==0) {
          $msgtext.= "Article database expiration is null\nwhich means that approved articles are not kept in the database\n";
        }
      } elsif (defined $groups{'checkrefs'}{$_}) {
        if ($groups{'checkrefs'}{$_} =~ /^n/io) {
          $msgtext.= "Article database expiration is negative and checkrefs is set to 'no'\n  which means that approved articles are not kept in the database\n";
        } elsif ($groups{'checkrefs'}{$_} !~ /^y/io) {
          $msgtext.= "-> checkrefs=$groups{'checkrefs'}{$_} : incorrect value (should be yes or no)\n";
          $error=1;
        }
      } else {
        $msgtext.= "Article database expiration is not set.\n";
      }

      my $refuse=0;
      foreach my $command (keys %groups) {
        if ((defined $groups{$command}{$_}) and 
            ($command =~ /^refuse\./)) {
          $msgtext.="Possible refuse commands :\n" if (!$refuse);
          $refuse=1;
          if (-r "$mopt{'confdir'}/$_/$command") {
            $msgtext.="* $command\n";
          } else {
            $msgtext.="* $command\n  -> File $mopt{'confdir'}/$_/$command\n     is not readable or does not exist\n";
            $error=1;
          }
        }
      }

      if (defined $groups{'includearticle'}{$_} and $refuse) {
        if ($groups{'includearticle'}{$_} =~ /f/i) {
          $msgtext.= "Full article is sent back to author of a refused article\n";
        } elsif ($groups{'includearticle'}{$_} =~ /b/i) {
          $msgtext.= "Only the body is sent back to author of a refused article\n";
        } elsif ($groups{'includearticle'}{$_} =~ /h/i) {
          $msgtext.= "Only the headers are sent back to author of a refused article\n";
        } else {
          $msgtext.= "-> includearticle=$groups{'includearticle'}{$_} : incorrect value (should be f/b/h)\n";
          $error=1;
        }
      }

      if (defined $groups{'ack'}{$_}) {
        if ($groups{'ack'}{$_} =~ /f/i) {
          $msgtext.= "Full article is sent back to author in the acknowledgment\n";
        } elsif ($groups{'ack'}{$_} =~ /b/i) {
          $msgtext.= "Only the body is sent back to author in the acknowledgment\n";
        } elsif ($groups{'ack'}{$_} =~ /h/i) {
          $msgtext.= "Only the headers are sent back to author in the acknowledgment\n";
        } else {
          $msgtext.= "-> ack=$groups{'ack'}{$_} : incorrect value (should be f/b/h)\n";
          $error=1;
        }
      }

      if ($refuse) {
        if (defined $groups{'from'}{$_}) {
          $msgtext.="Refused articles are sent back to sender with the following From: header :\n";
          $msgtext.="  $groups{'from'}{$_}\n";
        } else {
          $msgtext.="-> No from header configured\n";
          $error=1;
        }
      }

      if (defined $groups{'archive'}{$_}) {
        if ($groups{'archive'}{$_} =~ /^(p|a|r|d|e)*$/) {
          if ($groups{'archive'}{$_} =~ /p/i) {
            $msgtext.="Posted articles are archived\n";
          }; 
          if ($groups{'archive'}{$_} =~ /a/i) {
            $msgtext.="Automatically refused articles are archived\n";
          };
          if ($groups{'archive'}{$_} =~ /r/i) {
            $msgtext.="Refused articles are archived\n";
          };
          if ($groups{'archive'}{$_} =~ /d/i) {
            $msgtext.="Deleted articles are archived\n";
          };
          if ($groups{'archive'}{$_} =~ /e/i) {
            $msgtext.="Erroneous articles are archived\n";
          } 
          if (! -d "$mopt{'archivedir'}/$_") {
            $msgtext.="Archive directory for $_ does not exist. Will be created\n";
          }
        } else {
          $msgtext.="-> archive=$groups{'archive'}{$_} : incorrect value (should be 'p', 'a', 'r', 'd' or 'e')\n";
          $error=1;
        }
      }

      if (defined $groups{'whitelist'}{$_}) {
        if ($groups{'whitelist'}{$_}=~ /y/i) {
          if (-r "$mopt{'confdir'}/$_/whitelist") {
            $msgtext.="A whitelist file is used\n";
          } else {
            $msgtext.="-> Whitelist file for $_ does not exist\n";
            $error=1;
          }
        } elsif ($groups{'whitelist'}{$_} =~ /n/i) {
          $msgtext.="No whitelist file is used\n";
        } else {
          $msgtext.="-> whitelist=$groups{'whitelist'}{$_} : incorrect value (should be boolean)\n";
          $error=1;
        }
      }

      if (defined $groups{'blacklist'}{$_}) {
        if ($groups{'blacklist'}{$_}=~ /y/i) {
          if (-r "$mopt{'confdir'}/$_/$mopt{'fblacklist'}") {
            $msgtext.="A blacklist file is used\n";
          } else {
            $msgtext.="-> Blacklist file for $_ does not exist\n";
            $error=1;
          }
        } elsif ($groups{'blacklist'}{$_} =~ /n/i) {
          $msgtext.="No blacklist file is used\n";
        } else {
          $msgtext.="-> blacklist=$groups{'blacklist'}{$_} : incorrect value (should be boolean)\n";
          $error=1;
        }
      }

      if (defined $groups{'blacksubject'}{$_} and $groups{'blacksubject'}{$_}) {
        $msgtext.="Articles are dropped if their subject matches \n  the following regexp : $groups{'blacksubject'}{$_}\n";
      } else {
        $msgtext.="The 'blacksubject' group variable is not defined\n";
      }

      if (defined $groups{'whitesubject'}{$_} and $groups{'whitesubject'}{$_}) {
        if (defined $groups{'autopost'}{$_}) {
          if ($groups{'autopost'}{$_} =~ /^y/io) {
            $msgtext.="Articles are autoposted if their subject matches \n  the following regexp : $groups{'whitesubject'}{$_}\n";
          } elsif ($groups{'autopost'}{$_} =~ /^n/io) {
            $msgtext.="Articles are spooled if their subject matches \n  the following regexp : $groups{'whitesubject'}{$_}\n";
          } else {
            $msgtext.="-> autopost=$groups{'autopost'}{$_} : incorrect value (should be y/n)\n";
            $error=1;
          }
        } else {
          $msgtext.="Articles are spooled if their subject matches \n  the following regexp : $groups{'whitesubject'}{$_}\n  (because autopost is not set)\n";
        }
        if (defined $groups{'subjectdb'}{$_} and $groups{'subjectdb'}{$_} =~ /^n/io) {
          $msgtext.="E-mail of authors is not saved in a database.
  Therefore, they will receive an acknowledgment for every article posted
  in the group.\n";
        } else {
          $msgtext.="E-mail of authors is saved in a database, preventing 
  them to receive an ack for every posted article.\n";
          if ($groups{'subjectdbexpire'}{$_}) {
            if ($groups{'subjectdbexpire'}{$_} =~ /^\d+$/) {
              $msgtext.="E-mails are kept for $groups{'subjectdbexpire'}{$_} days. (0 means forever)\n";
            } else {
              $msgtext.="-> subjectdbexpire=$groups{'subjectdbexpire'}{$_} : incorrect value (should be numeric)\n";
              $error=1;
            }
          } else {
            $msgtext.="E-mails are kept forever in the database\n";
          }
        }
      } else {
        $msgtext.="The 'whitesubject' group variable is not defined\n";
      }

      if (defined $groups{'refusecc'}{$_} and $groups{'refusecc'}{$_}) {
        $msgtext.="A blind copy of refused articles is sent to : $groups{'refusecc'}{$_}\n";
      } else {
        $msgtext.="Refused articles are not bcc-ed to anybody\n";
      }

      # Test important files and directories
      if (! -d "$mopt{'confdir'}/$_") {
        $msgtext.="-> Configuration directory for $_ does not exist\n";
        $error=1;
      } else {
        if (! -r "$mopt{'confdir'}/$_/$mopt{'fmoderators'}") {
          $msgtext.="-> Moderators file for $_ does not exist\n";
          $error=1;
        } elsif (-z "$mopt{'confdir'}/$_/$mopt{'fmoderators'}") {
          $msgtext.="-> Moderators file for $_ is empty\n";
          $error=1;
        }
      }
      if (! -d "$mopt{'spooldir'}/$_") {
        $msgtext.="-> Spool directory for $_ does not exist\n";
        $error=1;
      }
    }
  } else {
    $msgtext.= "\n-> No moderated groups are configured !!\n";
    $error=1;
  }

  return ($msgtext,$error);
}

######################################################################
# modlock
# Input : none
# Output : none
# Action :
# Verify that only one modappspool/modappmail is running at a time. 
# Write a lock file.
######################################################################
sub modlock {
  my $i=0;
  while (not sysopen(LOCK, $mopt{'fmodappbotlock'}, 
                          O_WRONLY|O_EXCL|O_CREAT,0644)) {
    sleep($mopt{'locksleep'});
    $i++;
    die "Cannot lock article database (I tried $mopt{'lockretries'} times)\n" if ($i > $mopt{'lockretries'});
  }
  print LOCK $$;
  close(LOCK);
}

######################################################################
# modunlock
# Input : none
# Output : none
# Action : Unlock modappbot (delete /tmp/modappbot.lock)
######################################################################
sub modunlock {
  # verify that the modappbot.lock contains the PID of modappbot
  # if not, do not delete it
  return if !defined $mopt{'fmodappbotlock'};
  if (-r $mopt{'fmodappbotlock'}) {
    open LOCK,$mopt{'fmodappbotlock'};
    chomp (my $locknum= <LOCK>);
    close LOCK;
    unlink $mopt{'fmodappbotlock'} if ($locknum == $$);
  }
}

######################################################################
# modend
# Input : none
# Output : none
# Action :
# close the syslog and article database and remove the lock file written
# by modstart procedure
######################################################################
sub modend {
  mlog (2,"(modend) End of Modappbot");
  dbmclose (%db);
  modunlock();
  close TRACE;
}

END {
  modend();
}

## END of modappbot
