#!/usr/bin/perl
##########################################################################
#
#  modapp : Perl script to post articles in moderated newsgroups
#           Created for the fr.* hierarchy but can be used
#           for the mainstream or for local groups.
#
# version : $Id: modapp,v 0.8 1997/12/11 21:00:00 sn Exp $
#
# Copyright (c) 1997, Sylvain Niervze (sn@penelope.frmug.org)
#
# The initial script was written by Christophe Wolfhugel (wolf@schnok.fr.net)
#
# Permission to use, copy, and modify this software is allowed only for
# any noncommercial purpose.
# You are encouraged to send modifications to the author for futur
# integration.
#
# ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS.
#
# Report : please report bugs directly to the author (sn@penelope.frmug.org).
#          Do not forget to mention your versions of modapp, Perl and
#          operating sytem.
#          Be sure your are using the latest version of this script.
#          (Check <URL:http://www.frmug.org/usenet/mod/>)
#
##########################################################################
#
# Pre-requisites:
# - Perl 5.003 or greater
# - Net::NNTP OR News::NNTPClient CPAN module OR Un*x rnews
# - Net::SMTP CPAN module OR Un*x sendmail
# - PGP::Pipe CPAN module (optionnal)
#
# Installation:
#  - check the perl location (first line of this file)
#  - copy the script to a directory in your path
#  - change the location of the configuration file in the $modapprc
#    variable if you do not want it in your home directory
#  - create a .modapprc configuration file
#  - create an archive directory as specified by the configuration file
#
# Usage:   
#  "| modapp [options]" within your favorite mailer.
#
#   Use "modapp -h" at the shell prompt to get the list of options
#
##########################################################################
# Changes :
#
# Revision 0.1 Old days wolf
# first release
#
# See ChangeLog file for details.
#
##########################################################################
# Special thanks to :
# Christophe Wolfhugel (wolf@schnok.fr.net) for the initial script, 
# and useful comments on certain functions
# Guy Decoux (decoux@moulon.inra.fr) : big improvements :
# post_news, wait_answer, send_mail, PGP support, and so on...
# Ollivier Robert (roberto@keltia.freenix.fr) for his precious help 
# on Perl language
##########################################################################

use strict;
require 5.003;

## Configuration file
my $modapprc = $ENV{'HOME'} . "/etc/modapp.rc";

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

my $version= sprintf ("%d.%d", q$Revision: 0.10 $ =~ /(\d+)\.(\d+)/);

my $tmp;

use Getopt::Long;
use File::Copy;
use Sys::Hostname;
use Term::ReadLine;

##########################################################################
# Main procedure
##########################################################################
#
# Default values
#
my %Options = ('f' => $modapprc);
my %groups = ();

# default values for options if there is no configuration file
my %mopt = (
  'editor' => '/usr/bin/vi',    'moderators' => 'uunet.uu.net',
  'organization' => 'Usenet',   'tmpdir' => '/tmp',
  'mailhost' => 'localhost',    'nntpserver' => 'localhost',
);

# Declarations of day in the week names - See sub date
my @sday = qw (Sun Mon Tue Wed Thu Fri Sat);
# Declarations of month names - See sub date
my @month = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

# Valid main key declarations in the configuration file
my @validmkeys = qw (
  sender organization post active moderators sendmail mopts 
  checkgroups expire archdir editor simplepath printxnp archive tmpdir
  mailhost pgpuser pgpkeyring pgppassfile pgpsign pgpheader nntpserver
);

# Valid group key declarations in the configuration file
my @validgkeys = qw (
  expire followup approved signature
  pgpsign pgpuser pgppassfile pgpkeyring pgpheader
);

# Valid headers in articles
my @validheader = qw (
  from reply-to organization subject newsgroups summary keywords 
  followup-to expires supersedes references approved control
  mime-version content-type content-transfer-encoding
  x-modapp-comment mail-copies-to x-no-archive
  x-newsreader
);

# Valid headers for pgpverify (case sensitive)
my @pgpheader = qw(Subject Control Message-ID Date From Sender);

# Accents conversion - See sub strip_accents_latin1
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', 
);

do { usage(); exit(1) } if !GetOptions(
  'archive' => \$Options{'a'}, 'cancel' => \$Options{'c'},
  'expiration=i' => &valid_number(\$Options{'e'}, 0),   
  'file=s' => \$Options{'f'}, 'kcheck' => \$Options{'k'},
  'group=s' => \$Options{'g'}, 'help' => \&usage, 
  'mail=s' => \$Options{'m'}, 'not' => \$Options{'n'},
  'path' => \$Options{'p'},  'quiet' => \$Options{'q'},
  'reference:s' => \$Options{'r'}, 'supersedes:s' => \$Options{'s'},
  'test' => \$Options{'t'}, 'version' => \&version,
  'id=s' => \$Options{'i'},
);

my $returncode=parserc();
exit(1) if ($returncode);

if ($Options{'t'}) {
  my $returncode=modtest();
  exit(1) if ($returncode);
} elsif ($Options{'c'} || $0 =~ /cancel$/) {
  cancel();
} else {
  modapp();
}

##########################################################################
# decode_qp
# 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
# stolen from MIME::QuotedPrint
##########################################################################
sub decode_qp {
  local $_ = shift;
  s/=\?iso-8859-1\?q\?(.*?)\?=/rm_under($1)/gei;
  s/=\r?\n//g;
  s/=([\da-fA-F]{2})/chr(hex($1))/ge;
  $_;
}

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

##########################################################################
# strip_accents_latin1
# Input : a string containing latin1 accents
# Output: a string without latin1 accents
# Action: strip latin1 accents from input
##########################################################################
sub strip_accents_latin1 {
  local $_= shift;
  s/[]/$accents{$&}/ge;
  $_;
}

##########################################################################
# valid_number
# Input : 
# Output: 
# Action:
##########################################################################
sub valid_number {
  my ($opt, $binf, $bsup) = @_;
  return sub {
    my ($nom, $valeur) = @_;
    if (!defined $opt) {
    return 0 if $nom !~ /^-?(?:\d+(?:\.\d*)?|\.\d+)$/;
    $valeur = $nom;
  }
  if (ref($binf) eq "ARRAY") {
    if (! grep { $_ == $valeur } @$binf) {
      clean("modapp: Possible values for $nom are @$binf\n")
        if defined $opt;
      return 0;
      }
    } else {
      if (defined($binf) and $valeur < $binf) {
        clean("modapp: Value $nom must be >= $binf\n") if defined $opt;
        return 0;
      }
      if (defined($bsup) and $valeur > $bsup) {
        clean("modapp: Value $nom must be <= $bsup\n") if defined $opt;
        return 0;
      }
    }
    $$opt = $valeur if defined $opt;
    1;
  }
}

##########################################################################
# version
# Input : nothing
# Output: to screen
# Action: print modapp version and quit
##########################################################################
sub version {
  print "modapp: version $version\n";
  exit 0;
}

##########################################################################
# clean
# Input : string to print 
# Output: to screen
# Action: remove temporary file, print and error message, and die
##########################################################################
sub clean {
  my $message=shift;

  unlink ($tmp) if (defined $tmp and -f $tmp);
  unlink ("$tmp.pgp") if (defined $tmp and -f "$tmp.pgp");
#  print "$message";
  die "$message";
} 

##########################################################################
# usage
# Input : nothing
# Output: options on the command line of the script
# Action: print the detail of every Modapp's option
#         called by main, with the option -h
##########################################################################
sub usage {
  print <<EOF;
Usage: modapp [-a] [-c] [-e number] [-f file] [-g newsgroup] [-k]
              [-m] [-n] [-p] [-q] [-r] [-r] [-t] [-v]

-a : archive the article in the archdir directory
-c : cancel the article given in stdin - -c is implicit if modapp
   is called as "cancel"
-e number : number of days for the expiration date of the article
          if number = 0, no Expires: field is provided in the article
-f file : filename of the .modapprc file 
        (default to "$modapprc")
-g newsgroup : name of the newsgroup to use if none is provided in the article
-i msgid : use msgid parameter as Message-ID: header in posted article
-k : check the Newsgroups: line for unknown or moderated newsgroups
   If a moderated newsgroup is found, can forward the article to
   the next moderator
-h : this help message
-m : in quiet mode, forward to next moderator instead of posting in all
   moderated newsgroups. It is possible to give after this option the
   name of the newsgroup to which the article will be forwarded
-n : do not send the article to the news posting command
-p : provide a simple Path: not-for-mail header
-q : quiet mode : modapp does not launch the editor, and asks no question
-r : provide a References: header in the article. The msgid of the referenced
   article is read from the archdir/archname.msgid file
-s : provide a Supersedes: header in the article. The msgid of the superseded
   article is read from the archdir/archname.msgid file
-t : test the modapp configuration
-v : print modapp version
EOF
  exit;
}

##########################################################################
# modtest
# Input : most configuration values
# Output: the contents of each value
# Action: print to STDOUT the content of each configuration value
#         specified in the configuration file
##########################################################################
sub modtest {
  my $error=0;
  print <<EOF;
Global options: 
--------------
sender: $mopt{'sender'}
organization: $mopt{'organization'}
moderators mail hub: $mopt{'moderators'}
active file: $mopt{'active'}
default expiration: $mopt{'expirecf'}
verify Newsgroups header : $mopt{'checkgroups'}
Article Archive dir : $mopt{'archdir'}
Temporary directory : $mopt{'tmpdir'}
Archive policy : $mopt{'archive'}
Editor : $mopt{'editor'}
EOF

  print "News post program : ";
  $mopt{'post'}?print "$mopt{'post'}\n":eval {
    require News::NNTPClient;
    print "via News::NNTPClient\n";
  } || eval {
    require Net::NNTP;
    print "via Net::NNTP\n";
  } || do {
    print "none\n";
    print "** WARNING : No posting method is available !! ** \n";
    print "** Please install rnews, News::NNTPClient, or Net::NNTP Perl modules **\n";
    $error=1;
  };
  print "Mail program : ";
  $mopt{'sendmail'}?print "$mopt{'sendmail'}\n":eval {
    require Net::SMTP;
    print "via Net::SMTP\n";
  } || do {
    print "none\n";
    print "** WARNING : No mail method is available !! ** \n";
    print "** Please install sendmail or Net::SMTP Perl module ** \n";
    $error=1;
  };
  print "Mail options : $mopt{'mopts'}\n" if ($mopt{'mopts'});
  print "Print X-Newsposter header : ",
    ($mopt{'printxnp'} =~ /n(o)?/i)?"no\n":"yes\n";
  print "Generate a simple Path header : ",
    ($mopt{'simplepath'} =~ /y(es)?/i or $Options{'p'})?"yes\n":"no\n";

  my $key = '';
  foreach $key (keys %{$groups{'approved'}}) {
    print <<EOF;

Newsgroup: $key
---------
EOF
    foreach ('approved', 'followup', 'expire') {
      print "$_: $groups{$_}{$key}\n" if defined $groups{$_}{$key};
    }
    if ($groups{pgpsign}{$key} =~ /\bmail\b|\bpost\b/i) {
      foreach (qw(pgpsign pgpuser pgppassfile pgpkeyring pgpheader)) {
        print "$_: $groups{$_}{$key}\n" if defined $groups{$_}{$key};
      }
    }
    print "signature:\n$groups{'signature'}{$key}\n" 
      if defined $groups{'signature'}{$key};
    print "PGP user:$groups{'pgpuser'}{$key}\n";
  }
  return ($error);
}

##########################################################################
# wait_answer
# Input : $mess (message to print), $sub (subroutine to execute to
#         terminate the test), $quiet (boolean variable used to determine
#         if wait_answer prints something on default output or not
# Output: return the key pressed by the user. The valable keys are
#         defined by the $sub subroutine parameter
# Action: uses Perl module Term::ReadLine to print the $mess message,
#         wait for a pressed key, and compares the key to the valable
#         keys defined in the $sub subroutine. If the key is OK,
#         return it to the calling sub
# Is OS-independent
##########################################################################
sub wait_answer {
  my ($mess, $sub, $quiet) = @_;
  return &$quiet($mess) if defined $quiet;
  my $key = '';
  my $term = new Term::ReadLine 'Answer me';
  do {
      chomp($key = $term->readline($mess));
  } until &$sub($key);
  $key;
}

##########################################################################
# editor
# Input : $editor (default program to run as a text editor)
#         $file (file to edit)
# Output: nothing
# Action: runs the $editor on $file, using the default input device
# try to be OS-independent
##########################################################################
sub editor {
  my ($editor, $file) = @_;
  if (!$Options{'q'}) {
    my $console = (Term::ReadLine::Stub::findConsole())[0];
    clean("modapp: I can't find console\n") if !$console;
# just for fun (and VMS)
#    require IPC::Open3;
#    open(FOO, $console);
#    my $pid = IPC::Open3::open3('<&FOO', '>&STDOUT', '>&STDERR', $editor, $file);
#    waitpid($pid, 0);
#    close(FOO);
# end of private joke...
    system "$editor $file < $console";
  }
}

##########################################################################
# ckgroups
# Input : $newsgroups
# Output: $nextgroup $newsgroups
# Action: verifies if $newsgroups contains the name of unknown
#         or moderated newsgroups. The verification is done 
#         accordingly to the news active file
##########################################################################
sub ckgroups {
  my $newsgroups = shift;
  my ($active_nntp,$othergroups);
#  return ('',$newsgroups) if ($Options{'q'});

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

  # removes the name of the newsgroups defined in the conf file
  $othergroups = $newsgroups;
  foreach (keys %{$groups{'approved'}}) {
    next if (($Options{'m'}) and ($_ eq $Options{'m'}));
    $othergroups =~ s/(^|,)\Q$_\E(?:,|$)/$1/g;
  }
  $othergroups =~ s/,$//;

  # no need to parse active if there is only one newsgroup
  return ('', $newsgroups) 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;

  # look for moderated of unknown newsgroups
  if ($mopt{'active'} !~ /^\s*$/) {
    open (ACTIVE, $mopt{'active'}) or 
      clean("modapp: cannot open $mopt{'active'} active file\n");
    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);
  } else {
    eval {
      require News::NNTPClient;
      if (!defined($active_nntp)) {
        my $nntp = new News::NNTPClient($mopt{'nntpserver'});
        my @list = $nntp->list();
        $nntp->quit;
        foreach (@list) {
          chomp;
          my @temp = split / /;
          $active_nntp->{$temp[0]} = [@temp[1 .. 3]];
        }
      }
    } || eval {
      require Net::NNTP;
      if (!defined($active_nntp)) {
        my $nntp = new Net::NNTP($mopt{'nntpserver'});
        $active_nntp = $nntp->list();
        $nntp->quit;
      }
    };
    clean("modapp: I can't read active\n") if !defined($active_nntp);
    foreach (@errgroups) {
      # mark the found newsgroups as "m" for moderated, or "y" for
      # 'normal' groups
      # the ngs with a "z" mark are still unknown..
      $errgroups{$_} = $active_nntp->{$_}[2]
        if $active_nntp->{$_};
    }
  }

  # print the newsgroups which are unknown
  @errgroups = grep { $errgroups{$_} eq 'z' } keys %errgroups;
  if (@errgroups) {
    my $rep;
    if (!$Options{'q'}) {
      print "## Unknown newsgroups were found\n",join("\n",@errgroups),"\n";
      $rep = wait_answer("(c)ontinue, (d)elete the newsgroups from headers, (a)bort ? ", sub { $_[0] =~ /^[cda]$/; });
    } else {
      $rep='c';
    }
    exit 2 if $rep eq 'a';
    if ($rep eq 'd') {
      my $key;
      foreach $key (@errgroups) {
        $newsgroups =~ s/(^|,)\Q$key\E(?:,|$)/$1/g;
      }
      $newsgroups =~ s/,$//;
    }
  }

  # print the newsgroups which are moderated
  @errgroups = grep { $errgroups{$_} eq 'm' } keys %errgroups;
  my $nextgroup = '';
  if (@errgroups) {
    my $rep;
    if (!$Options{'q'} and !$Options{'m'}) {
      print "## Moderated newsgroups were found\n",join("\n",@errgroups),"\n";
      $rep = wait_answer("(c)ontinue, (d)elete the newsgroups from headers,\n(f)orward to next moderator, (a)bort ? ", sub { $_[0] =~ /^[cfda]$/; });
    } elsif (defined $Options{'m'}) {
      $rep='f';
    } else {
      $rep='c';
    }
    exit 2 if $rep eq 'a';
    if ($rep eq 'd') {
      my $key;
      foreach $key (@errgroups) {
        $newsgroups =~ s/(^|,)\Q$key\E(?:,|$)/$1/g;
      }
      $newsgroups =~ s/,$//;
    }
    if ($Options{'m'}) {
      $nextgroup=$Options{'m'};
    } else {
      $nextgroup = (sort @errgroups)[-1] if $rep eq 'f'; 
    }
  }
  ($nextgroup, $newsgroups);
}

##########################################################################
# plumber
# Input : PIPE signal to modapp
# Output: error message 
# Action: stop modapp if $post or $sendmail failed to run
##########################################################################
sub plumber { 
  clean("modapp: died prematurely! ($mopt{'post'} or $mopt{'sendmail'} problem ?)\n"); 
}

##########################################################################
# parserc
# Input : modapp configuration file
# Output:
# Action: parse the configuration file and fill in the configuration
#         variables
##########################################################################
sub parserc {
  my %validmkeys = map { $_ => 1 } @validmkeys;
  my %validgkeys = map { $_ => 1 } @validgkeys;

  # modapprc is defined at the beginning of the script
  my ($where, $grp_found, $key) = (0, 0, '');
  my $error=0;
  open (RC, $Options{'f'}) or 
    clean("modapp: cannot open $Options{'f'} configuration file for reading\n");
  while (<RC>) {
    next if /^#/;
    $where = /^\s*\[\s*(\S+)\s*\]/o .. /^\s*\[\s*end\s*\]/io;
    if ($where) {
      $grp_found = $1 if $where == 1;
      if ($where =~ /E0/) {
        my $mo = '';
        $mopt{pgpuser} = $mopt{sender} if !$mopt{pgpuser};
        foreach $mo (grep(/^pgp/, keys %mopt)) {
          $groups{$mo}{$grp_found} = $mopt{$mo}
            if !defined $groups{$mo}{$grp_found};
        }
        next;
      }
      if (/^\s*([^=\s]+)\s*=\s*(.+)/) {
        $key = lc($1);
        if ($validgkeys{$key}) {
          if ($key eq 'signature' and defined($groups{$key})
          and defined($groups{$key}{$grp_found})) {
            $groups{$key}{$grp_found} .= "\n" . $2;
          } else {
            $groups{$key}{$grp_found} = $2;
          }
        } else {
          print "modapp: $key : unknown group option (modapprc line $.)\n";
          $error=1;
        }
      }
    } else  {
      if (/^\s*([^=\s]+)\s*=\s*(.+)/) {
        $key = lc($1);
        if ($validmkeys{$key}) {
          $mopt{$key} = $2;
        } else {
          print "modapp: $key : unknown global option (modapprc line $.)\n";
          $error=1;
        }
      }
    }
  }
  close(RC);
  
  # if the option -k is defined, we want to verify the Newsgroups: line
  $mopt{'checkgroups'} = 'yes' if defined $Options{'k'};

  # if archdir is defined, transform the "~" shell hack (from Perl FAQ)
  $mopt{archdir} =~ 
    s#^~([^/]*)#$1?(getpwnam($1))[7]:($ENV{'HOME'} || $ENV{'LOGDIR'})#e
      if $mopt{archdir};
  # same with pgpkeyring and pgppassfile
  my ($mo, $gr);
  foreach $mo ('pgpkeyring', 'pgppassfile') {
    foreach $gr (keys %{$groups{$mo}}) {
      $groups{$mo}{$gr} =~
        s#^~([^/]*)#$1?(getpwnam($1))[7]:($ENV{'HOME'} || $ENV{'LOGDIR'})#e
          if $groups{$mo}{$gr};
    }
  }
  # same with tmpdir
  $mopt{'tmpdir'} =~ 
    s#^~([^/]*)#$1?(getpwnam($1))[7]:($ENV{'HOME'} || $ENV{'LOGDIR'})#e
      if $mopt{'tmpdir'};
  # basic declarations for cancel
  $groups{'approved'}{'cancel'} = $mopt{'sender'} 
    if !$groups{'approved'}{'cancel'};
  $groups{'signature'}{'cancel'} = 'Article cancelled by moderator'
    if !$groups{'signature'}{'cancel'};
  return($error);
}

##########################################################################
# date
# Input : time value
# Output: date in RFC822 format
# Action: returns the date in RFC822 format, at GMT Timezone
##########################################################################
sub date {
  my(@now)=gmtime(shift);

  # Year 2000 compliant
  $now[5] +=1900; #if ($now[5]<100);

  return sprintf("%s, %d %s %d %02d:%02d:%02d GMT", $sday[$now[6]],
    $now[3], $month[$now[4]], @now[5,2,1,0]);
}

##########################################################################
# path
# Input : name of moderated newsgroup used to post the article
# Output: string containing the Path: header
# Action: prints the simple path "not-for-mail" or prints the local part 
#         of the Approved: header as the path
#         e.g. Approved: foo@bar.com -> Path: foo
##########################################################################
sub path {
  ($Options{'p'} || $mopt{'simplepath'} =~ /y(es)?/i )?"not-for-mail":
    ($_[0] eq 'cancel')?"modcancel":
      ($groups{'approved'}{$_[0]} =~ /(.*)@/)[0];
}

##########################################################################
# msgid
# Input : name of the newsgroup name used to post the article
# Output: Message-Id header (without the <>)
# Action: returns the Message-Id constituted by the local part
#         of the Approved: header e-mail address, followed
#         by the time value (numbers of seconds since 1970)
#         and followed by the hostname of the news posting host
#         e.g. foo-4562334@foo.bar.com
##########################################################################
sub msgid {
  sleep 1;
  my $random= $$;
  ($groups{'approved'}{$_[0]} =~ /(.*)@/)[0] . "-" . time . ".$random" .
    "@" . (gethostbyname(hostname))[0];
}

##########################################################################
# getarchives
# Input : $archdir directory of the archive files
# Output: list of available Archive-Name files
# Action: archive-name files contain message-id of previous
#         approved articles. They are saved by the modapp subroutine.
#         One can choose the archive-name to supersede/reference
#         with this function.
##########################################################################
sub getarchives {
  return () if $Options{'q'};
  opendir(DIR, $mopt{'archdir'}) or return ();
  my @msgid = grep { /\.msgid$/ && -f "$mopt{'archdir'}/$_" } readdir(DIR);
  closedir(DIR);
  if (@msgid) {
    print "Here are the available Archive-Name files :\n";
    print "0) NONE\n";
    for (1 .. $#msgid+1) {
      print $_,") $msgid[$_-1]\n";
    }
  }
  @msgid;
}

##########################################################################
# getoldmsgid
# Input : $type : string containing "reference" or "supersede"
#         $max : number of archive-name files in the archdir directory
# Output: message-id of the article to reference/supersede
# Action: get the message-id contained in the choosen archive-name
#         file
##########################################################################
sub getoldmsgid {
  my ($type, @max) = @_;
  my $file;

  # do { 
	  #warn "modapp: [Quiet mode] Modapp called with -r or -s with no msgid file provided\n";
	  #return '' ;
  #} if $Options{'q'};
 
  # return if there is no archdir directory
  return '' if !@max;

  # decide which archive-name file to use
  if(!$Options{substr($type,0,1)}) {
    my $rep = 
      wait_answer("Choose the Archive-Name to $type (0-".scalar(@max)."): ",
        valid_number(undef, 0, scalar(@max)),undef);

    return '' if $rep eq "0";
    $file=$max[--$rep];
  } else {
    # substr of $type is 'r' or 's'
    $file=$Options{substr($type,0,1)};
    $file .= '.msgid' if ($file !~ /\.msgid$/);
  }

  # get the old Archive-Name field
  my $oldmsgid = '';
  open (SUP,"$mopt{'archdir'}/$file")
    or clean("modapp: Cannot open $mopt{'archdir'}/$file archive-name file for reading\n");
  chomp($oldmsgid = <SUP>);
  close (SUP);
  $oldmsgid;
}

##########################################################################
# post_news
# Input : $article (message with headers and body to be sent to
#         the news server), $default (default news posting software)
#         $args (line arguments to the posting program if it's defined)
# Output: a news article posted to the news server
# Action: posts a news article to the news server using the $default
#         program if it is defined. Otherwise, try to post the article
#         with News::NNTPClient, and finally, if News::NNTPClient is not
#         installed, try to use Net::NNTP to post the article.
#         If all methods fail, print an error message and die
##########################################################################
sub post_news {
  my ($article, $default, $ng) = @_;
  my $nntpserver;
  pgp_post($article, $ng);
  foreach $nntpserver (split(/,/,$mopt{'nntpserver'})) {
    if ($default !~ /^\s*$/){
      clean("modapp: can't find $default\n") unless -x $default;
      open (PROGPOST,"| $default -h localhost -v -S $nntpserver") or do {
        print STDERR "modapp : cannot run $default -h localhost -v -S $nntpserver \n";
        next;
      };
      open (FOO, $article);
      while (<FOO>) {
        print PROGPOST $_;
      }
      close (FOO);
      close (PROGPOST);
      if ($?) {
        print STDERR "modapp : $default -h localhost -v -S $nntpserver did not run successfully\n";
        next;
      }
    } else {
      eval {
        require News::NNTPClient;
        my $nntp = new News::NNTPClient($nntpserver);
        $nntp->mode_reader;
        open(FOO, $article);
        $nntp->post(<FOO>);
        close(FOO);
        warn "News::NNTPClient Error on $nntpserver : ",$nntp->code,"\n" if !$nntp->ok;
        $nntp->quit;
      } || eval {
        require Net::NNTP;
        my $nntp = new Net::NNTP($nntpserver);
        $nntp->reader();
        open(FOO, $article);
        warn "News::NNTP Error on $nntpserver\n" if !$nntp->post(<FOO>);
        close(FOO);
        $nntp->quit;
      } || do {
        print STDERR "modapp: I don't know how to POST\n";
        next;
      }
    }
  }
}

##########################################################################
# send_mail
# Input : $from (email sender), $to (email recipient), 
#         $default (default mailer), $args (line arguments for default mailer)
#         $article (message with headers and body to be sent by mail)
# Output: an e-mail message sent to the recipient
# Action: if $default exists, try to use it to send the mail.
#         Otherwise, use Net::SMTP to send the mail
##########################################################################
sub send_mail {
  my ($from, $to, $ng, $article, $default, $args) = @_;
  pgp_mail($article, $ng);
  if ($default !~ /^\s*$/) {
    clean("modapp: can't find $default\n") unless -x $default;
    system "$default $args < $article";
  } else {
    eval {
      require Net::SMTP;
      my $smtp = new Net::SMTP($mopt{'mailhost'});
      $smtp->mail($from);
      $smtp->to($to);
      $smtp->data();
      open(FOO, $article);
      $smtp->datasend($_) while (<FOO>);
      close(FOO);
      $smtp->dataend();
      $smtp->quit;
    } || clean("modapp: I don't know how to send a MAIL\n");
  }
}

##########################################################################
# cancel
# Input : article
# Output: cancel message
# Action: cancel the article given in stdin
#         the cancel message contains the following headers :
#         - From: is the same as the original article
#         - Reply-To: is the same as the original article
#         - Newsgroups: is the same as the original article
#         - Message-ID: contains "modcancel-" followed by the
#           original message-id
#         - Control: contains : "cancel msgid", msgid being
#           the original message-id
#         - Subject: contains : "cmsg cancel msgid"
#         - Date: is the date when the cancel message is posted
#         - Organization: Usenet
#         - Approved: header is automatically inserted in the cancel
#           article, because the subroutine is designed to be used
#           by moderators who need to cancel unapproved messages posted
#           in their newsgroup. Approved: contains the value
#           of the variable approved in the cancel section of the config file
#         - Sender: contains the default sender value, as given in the
#           main section of the config file
#         - Path: contains "modcancel" or "not-for-mail", depending
#           if the moderator wants a custom Path: header or the standard
#           "not-for-mail" header (option -p)
#         the cancel message contains the body specified in the signature value
#         of the cancel section in the config file.
#         The cancel message is sent to editor so that it's possible
#         to edit it before posting.
#         The resulting article is posted to the news server
#         by rnews command (article is prepared to be posted by
#         rnews, and it will not be accepted by inews).
##########################################################################
sub cancel {
  $tmp = "$mopt{'tmpdir'}/moder.$$";

  # in case inews dumps core or something crazy
  $SIG{'PIPE'} = "plumber";

  my ($from, $replyto) = ('', '');
  open(MSG, "> $tmp") || clean("modapp: can't open $tmp\n");
  
  my $where = 0;
  while (<>) {
    $where = 1 .. /^\S/o;
    next if $where and $where !~ /E0/;
    last if /^$/;
    /^From:\s+(.+)/io && do { 
      $from = $1;
      $from =~ s/^(.*) <(.*)>/$2 ($1)/;
      print MSG "From: $from\n"; 
      next;
    };
    /^Reply-To:\s+(.+)/io && do { 
      $replyto = $1;
      $replyto =~ s/^(.*) <(.*)>/$2 ($1)/;
      print MSG "Reply-To: $replyto\n"; 
      next;
    };
    /^Newsgroups:/io && do { 
      print MSG;
      next;
    };
    /^Message-ID:\s+<(.+)>$/io && do { 
      print MSG "Control: cancel <$1>\n";
      print MSG "Message-ID: <modcancel.$1>\n"; 
      print MSG "Subject: cmsg cancel <$1>\n";
      next;
    };
  }

  print MSG "Date: " . &date(time) . "\n";
  print MSG "Organization: Usenet\n";
  print MSG "Approved: $groups{'approved'}{'cancel'}\n";
  print MSG "Sender: $mopt{'sender'}\n";
  print MSG "Path: " . &path('cancel') . "\n";
  print MSG "\n$groups{'signature'}{'cancel'}\n";

  close MSG;

  my $rep = 'e';
  while ($rep eq 'e') {
    editor($mopt{'editor'}, $tmp);
    $rep = wait_answer("(s)end, (a)bort or (e)dit? ",
      sub { $_[0] =~ /^[sae]$/; });
  }
  post_news($tmp, $mopt{'post'}, 'cancel') if $rep eq 's';
  unlink($tmp);
}

##########################################################################
# modapp
# Input : article to moderate (normally received by e-mail)
# Output: article posted in the news subsystem
# Action: inserts headers required by the news server for articles
#         posted in moderated newsgroups.
#         The following headers can be generated:
#         Path, Sender, Approved, X-Newsposter, Message-ID, Date,
#         From, Reply-To, Subject, Newsgroups, Followup-To,
#         Summary, Keywords, Organization, Expires, Supersedes,
#         References.
#         All other headers present in the original article
#         are automatically removed before approval.
#         There is a special header which is also accepted if it's
#         already present in the article : X-Also-Approved.
#         This header is used if the article was forwarded by another
#         moderator. It should contain the Approved: field used
#         by the other moderator(s).
#         If you decided to forward the article to the next moderator
#         (in case the article must be crossposted to several
#         moderated newsgroups), modapp will insert a
#         X-Also-Approved: header containing your approved: header
#         for your newsgroup. Modapp will also insert a special
#         comment at the very beginning of the article before sending
#         it to the other moderator by e-mail. This comment should
#         be removed by the other moderator before posting the article
#         in the newsgroups.
#         The article is sent to the editor so that it's possible
#         to edit it before posting, or forwarded to other moderator.
#         The resulting article is posted to the news server
#         by rnews command (article is prepared to be posted by
#         rnews, and it will not be accepted by inews).
#         It's sent to sendmail if the moderator decided to forward
#         it to the next moderator.
##########################################################################
sub modapp {

  $tmp = "$mopt{'tmpdir'}/moder.$$";
  my $rep;

  my $doarchive='';

  # in case rnews dumps core or something crazy
  $SIG{'PIPE'} = \&plumber;

  # looking for headers
  my %validheader = map { $_ => 1 } @validheader;

  while (1) {
    my %header = ('organization' => $mopt{'organization'},);
    my ($where, $header, $ok) = (0, '', 0);

    while (<>) {
      $where = 1 .. /^\S/;
      next if $where and $where !~ /E0/;
      last if /^$/;
      # Strip QP and accents in headers
      $_ = strip_accents_latin1(decode_qp($_));
      $ok = 1;
      if (/^([-\w]+):\s+(.+)/) {
        $header = lc($1);
        if ($validheader{$header}) {
          $header{$header} = $2;
        } else {
          $header = '';
        }
      } elsif (/^\s+(.*)/) {
        $header{$header} .= "\n  $1" if $header ne '';
      }
    }
    last if !$ok;
    $header{'reply-to'} = "$2 ($1)" if $header{'reply-to'} =~ /^(.*)\s+<(.*)>/;
    $header{'from'} = "$2 ($1)" if $header{'from'} =~ /^(.*)\s+<(.*)>/;
    $header{'approved'}=~ s/ //g;
    my @alsoapproved = split(/,/, $header{'approved'});
  
    # which is your moderated newsgroup ?
    my ($ng, $key) = ('', '');
    foreach $key (keys %{$groups{'approved'}}) {
      if (($header{'newsgroups'} =~ /(?:^|,)\Q$key\E(?:,|$)/) and
          ($key ne $Options{'m'})) {
        $ng = $key;
        last;
      }
    }

    # if there is more than one section declared in the config file,
    # and if no Newsgroups: header is present in the article,
    # you can choose which newsgroup to use (if you moderate several
    # newsgroups, and if the several newsgroups are declared as several
    # sections in the config file)
    if (!$ng) {
      my @approved = grep { $_ ne 'cancel' } keys %{$groups{'approved'}};
      if (@approved == 1) {
        $ng = $approved[0];
        $header{'newsgroups'} = $ng;
      } elsif (@approved > 1) {
        if ($Options{'g'}) {
          $header{'newsgroups'}=$Options{'g'} if (!$header{'newsgroups'});
          $ng=$Options{'g'};
        } elsif ($Options{'q'}) {
          clean("modapp: [Quiet Mode] No valid newsgroups in headers\n");
        } else {
          print <<EOF;

The following article does not contain a valid Newsgroups: header
From: $header{'from'}
Subject: $header{'subject'}
Newsgroups: $header{'newsgroups'}
EOF
         my $max=0;
        
          foreach $key (@approved) {
            print ++$max,") $key\n";
          }
          $rep = wait_answer("Choose the newgroup to use (1-$max): ", 
            valid_number(undef, 1, $max),undef);
          $ng = $approved[$rep-1];
          $header{'newsgroups'} = $ng;
        }
      }
    }
    clean("modapp: No Newsgroups\n") if !$ng;

    # what to do with Followup-To: header
    my $keepfollowup=0;
    if (defined $header{'followup-to'} && 
      $groups{'followup'}{$ng} ne $header{'followup-to'} && 
      !$Options{'q'}) {
      my $rep = wait_answer("Keep Followup-To: $header{'followup-to'} header (y/n) ? ", sub { $_[0] =~ /^[yn]$/; });
      if ($rep eq "y") {
        $keepfollowup=1;
      }
    }

    if (defined $header{'reply-to'} && !$Options{'q'}) {
      my $rep = wait_answer("Keep Reply-To: $header{'reply-to'} header (y/n) ?", sub { $_[0] =~ /^[yn]$/io; });
      if ($rep eq "n") {
        undef $header{'reply-to'};
      }
    }

    $keepfollowup=1 if ($Options{'q'});

    $header{'followup-to'} = $groups{'followup'}{$ng} 
      if ($groups{'followup'}{$ng} && !$keepfollowup);

    my $msgid;
    if ($Options{'i'}) {
      $msgid = $Options{'i'};
    } else {
      $msgid = &msgid($ng);
    }

    # Expiration date
    my $expires;
    if (!$header{'expires'}) {
      if (defined $Options{'e'}) {
        $expires = $Options{'e'};
      } elsif (defined $groups{'expire'}{$ng}) {
        $expires = $groups{'expire'}{$ng};
      } elsif (defined $mopt{'expire'}) {
        $expires = $mopt{'expire'};
      }
      $expires = &date (time + $expires * 86400) if $expires;
    } else {
      $expires = $header{'expires'};
    }

    my @max;
    @max=($Options{'s'} eq '')?getarchives():'' 
      if (defined $Options{'s'});
    @max=($Options{'r'} eq '')?getarchives():''
      if (defined $Options{'r'} and !defined $Options{'s'});
    $header{'supersedes'} = &getoldmsgid("supersede", @max) 
      if (defined $Options{'s'});
    $header{'references'} = &getoldmsgid("reference", @max) 
      if (defined $Options{'r'});
    my $nextgroup = '';
    ($nextgroup, $header{'newsgroups'}) = ckgroups($header{'newsgroups'}) 
       if $mopt{'checkgroups'} =~ /^y(es)?$/i;

    clean("modapp: No Newsgroups\n") unless 
      (path($ng) and $header{'newsgroups'});

    # MSG contains the article to be approved
    open(MSG, "> $tmp") || clean("modapp: can't open $tmp\n");

    # standard headers
    print MSG "Path: " . &path($ng) . "\n";
    print MSG "Newsgroups: $header{'newsgroups'}\n";
    print MSG "From: $header{'from'}\n";
    print MSG "Reply-To: $header{'reply-to'}\n" if $header{'reply-to'};
    print MSG "Organization: $header{'organization'}\n";
    print MSG "Subject: $header{'subject'}\n";
    print MSG "Date: " . &date(time) . "\n";
    print MSG "Expires: $expires\n" if $expires;
    print MSG "Supersedes: $header{'supersedes'}\n" if $header{'supersedes'};
    print MSG "References: $header{'references'}\n" if $header{'references'};
    print MSG "Summary: $header{'summary'}\n" if $header{'summary'};
    print MSG "Keywords: $header{'keywords'}\n" if $header{'keywords'};
    print MSG "Followup-To: $header{'followup-to'}\n" if $header{'followup-to'};

    # print all Approved: headers
    print MSG "Approved: $groups{'approved'}{$ng}";
    foreach (@alsoapproved) {
      print MSG ",$_";
    }
    print MSG "\n";

    print MSG "Sender: $mopt{'sender'}\n";
    print MSG "Message-ID: <$msgid>\n";
    print MSG "Control: $header{'control'}\n" if $header{'control'};
    print MSG "MIME-Version: $header{'mime-version'}\n"
      if $header{'mime-version'};
    print MSG "Content-Type: $header{'content-type'}\n" 
      if $header{'content-type'};
    print MSG "Content-Transfer-Encoding: $header{'content-transfer-encoding'}\n" if $header{'content-transfer-encoding'};
    print MSG "X-Newsreader: $header{'x-newsreader'}\n" if $header{'x-newsreader'};
    print MSG "X-No-Archive: $header{'x-no-archive'}\n" if $header{'x-no-archive'};
    print MSG "Mail-Copies-To: $header{'mail-copies-to'}\n" if $header{'mail-copies-to'};
    print MSG "X-Modapp-Comment: $header{'x-modapp-comment'}\n" if $header{'x-modapp-comment'};
 
    # print the version of the modapp script in the article headers
    print MSG "X-Newsposter: Modapp v$version\n" 
      unless ($mopt{'printxnp'} =~ /n(o)?/i);
  
    # if you want to forward the article to another moderator,
    # the X-Also-Approved: header containing the value of
    # the Approved: header for your newsgroup is inserted in the
    # article to forward. The standard Approved: header is NOT
    # present in the article in this case
    #
    # The To: header is required by "sendmail -t" (and Netiquette)
    #
    # if the article is forwarded to another moderator,
    # print a big warning at the beginning of the article.
    if ($nextgroup) {
      $nextgroup =~ tr/./-/;
      print MSG <<EOF;
To: $nextgroup\@$mopt{'moderators'}
EOF

      $nextgroup =~ tr/-/./;
      print MSG <<EOF;

############# MODERATION INFO #####################################
This message has been approved by the moderator
of $ng, but it should be crossposted to 
the moderated $nextgroup newsgroup. 
It has been forwarded to you for approval. 
If there is another moderated newsgroup on the
Newsgroups line, please forward the article to the next moderator.
Please delete this information before approval.
######## END OF MODERATION INFO ###################################
EOF
      $nextgroup =~ tr/-/./;
    }
    print MSG "\n";

    my $archname = '';
    while (<>) {
      last if /^From /;
      if ($archname eq '' and /^archive-name: (.+)/i) {
      # if there is an Archive-Name: secondary header present in the
      # article, get its contents, and print it
        $archname = $1; 
        $archname =~ tr#/#.#;
      }
      print MSG $_;
      if (eof) {
        close(ARGV);
        last;
      }
    }

    # print the newgroup signature
    print MSG "-- \n$groups{'signature'}{$ng}\n" 
      if $nextgroup eq '' && defined ($groups{'signature'}{$ng}) ;
  
    close MSG;
  
    my $rep = 'e';
    while ($rep eq 'e') {
      editor($mopt{'editor'}, $tmp);
        # Quiet mode : always try to post 
      $rep = wait_answer(($nextgroup eq '')?"(p)ost, (a)bort, (e)dit ? ":
                         "(m)ail, (a)bort, (e)dit ? ", 
                         sub { $_[0] =~ /^[maep]$/; },
                         $Options{'q'}?sub { 'p' }:undef);
    }
  
    if (($rep eq "p" or $rep eq "m") and !$Options{'n'}) {
      if ($nextgroup) {
        # forward to the next moderator by mail
        my $next = $nextgroup;
        $next =~ tr/./-/;
        send_mail($mopt{'sender'}, "$next\@$mopt{'moderators'}", $ng,
                 $tmp, $mopt{'sendmail'}, $mopt{'mopts'});
      } else {
        post_news($tmp, $mopt{'post'}, $ng); 
      }

      # Do we need to archive the article ?
      if ($mopt{'archive'} eq "ask" && !$Options{'q'}) {
        my $rep = wait_answer("Do you want to archive this article (y/n) ? ", 
          sub { $_[0] =~ /^[yn]$/; });
        if ($rep eq "y") {
          $doarchive="yes";
        }
      }

      # option -a can be specified to archive the article in the
      # archdir directory. Same with archive conf option (yes/no/ask)
      if ($Options{'a'} || ($mopt{'archive'} eq "yes")  
                        || ($doarchive eq "yes") ) {
        my $i = 0;
        $i++ until (! -f "$mopt{'archdir'}/$ng.$i");
        copy($tmp, "$mopt{'archdir'}/$ng.$i") 
          || clean("modapp: Cannot create $mopt{'archdir'}/$ng.$i\n");
      }

      # if there is an archive name in the article, we can
      # save the message-id of the article in a file in the
      # archdir directory, so that reference and supersedes functions
      # are available for future articles
      if ($archname ne '') {
        do {
          open (SUP,">$mopt{'archdir'}/$archname.msgid");
          print SUP "<$msgid>\n";
          close (SUP);
        } || warn "modapp: Cannot open $mopt{'archdir'}/$archname.msgid\nSupersedes and References options will not be available!\n";
      }
    }
    unlink($tmp);
  }
}

##########################################################################
# pgp_mail
# Input :
# Output:
# Action:
##########################################################################
sub pgp_mail {
  my ($article, $ng) = @_;
  return unless $ng and $groups{pgpsign}{$ng} =~ /\bmail\b/i;
  eval {
    require PGP::Pipe;
    clean("modapp: PGPUSER or PGPASSFILE is not defined !\n")
      if !$groups{pgppassfile}{$ng} or !$groups{pgpuser}{$ng};
    my @header = ();
    open(FOO, $article) or clean("modapp: cannot open $article for reading\n");
    while (<FOO>) {
      last if /^$/;
      push(@header, $_);
    }
    open(BAR, ">$article.pgp") or clean("modapp: cannot open $article for writing\n");
    print BAR <FOO>;
    close(FOO);
    close(BAR);
    my ($email) = ($groups{pgpuser}{$ng} =~ /([^\s<]+@[^\s>]+)/);
    my $signe = signe("$article.pgp", $ng, 'mail');
    open(FOO, ">$article") or clean("modapp: cannot open $article for writing\n");
    print FOO @header, "\n", $signe;
    close(FOO);
    unlink("$article.pgp");
  } || clean("I can't sign the article\n$@\n");
}

##########################################################################
# pgp_post
# Input :
# Output:
# Action:
##########################################################################
sub pgp_post {
  my ($article, $ng) = @_;
  return unless $ng and $groups{pgpsign}{$ng} =~ /\bpost\b/i;
  eval {
    require PGP::Pipe;
    clean("modapp: PGPUSER or PGPASSFILE is not defined !\n")
      if !$groups{pgppassfile}{$ng} or !$groups{pgpuser}{$ng};
    my $file = prepare_signature($article, $ng);
    my ($email) = ($groups{pgpuser}{$ng} =~ /([^\s<]+@[^\s>]+)/);
    my $signe = signe($file, $ng, 'post');
    open(TMPI, $article);
    open(TMPO, ">$file");
    while (<TMPI>) {
      last if /^$/;
      print TMPO;
    }
    print TMPO "X-Info: See ftp://ftp.uu.net/networking/news/misc/pgpcontrol/README\n";
    print TMPO "X-PGP-Sig: $signe\n\n";
    print TMPO <TMPI>;
    close(TMPI);
    close(TMPO);
    copy($file, $article);
    unlink($file);
  } || clean("I can't sign the article\n$@\n");
}

##########################################################################
# prepare_signature
# Input :
# Output:
# Action:
##########################################################################
sub prepare_signature {
  my ($file, $ng) = @_;
  open(FOO, $file) or clean("Can't read $file\n");
  my @pgphead = @pgpheader;
  if ($groups{pgpheader}{$ng}) {
    foreach ($groups{pgpheader}{$ng}) {
      s/\s+//g; s/,{2,}/,/g; s/^,//; s/,$//;
    }
    @pgphead = split(/,/, $groups{pgpheader}{$ng}) if $groups{pgpheader}{$ng};
  }
  my %pgpheader = map { $_ => 1 } @pgphead;
  my ($header, %header) = ('', ());
  while (<FOO>) {
    last if /^$/;
    if (/^(\S+):[ \t](.+)/) {
      $header = $1;
      if ($pgpheader{$header}) {
        $header{$header} = $2;
      } else {
        $header = '';
      }
    } elsif (/^\s/ and $header) {
      chomp;
      $header{$header} .= "\n$_";
    }
  }
  open(TMP, ">$file.pgp");
  print TMP "X-Signed-Headers: ",join(',', @pgphead),"\n";
  foreach (@pgphead) {
    print TMP "$_: $header{$_}\n";
  }
  print TMP "\n";
  print TMP <FOO>;
  close(FOO);
  close(TMP);
  "$file.pgp";
}

##########################################################################
# signe
# Input :
# Output:
# Action:
##########################################################################
sub signe {
  my ($file, $ng, $type) = @_;
  my $password = '';
  open(FOO, $groups{pgppassfile}{$ng}) 
    or clean("Can't read the password file for $groups{pgpuser}{$ng}\n");
  chomp($password = <FOO>);
  close(FOO);
  my ($email) = ($groups{pgpuser}{$ng} =~ /([^\s<]+@[^\s>]+)/);
  my @key=();
  my $keyring = new PGP::Keyring $groups{'pgpkeyring'}{$ng};
  if ($email) {
    @key=$keyring->Find(Email => $email);
  } else {
    @key=$keyring->Find(Owner => $groups{pgpuser}{$ng});
  }
  #my @key = $keyring->Find(Email => $email);
  clean("Invalid username\n") if !@key;
  my $pgp = new PGP::Pipe;
  my $signe = $pgp->Sign(Armor => 1, Clear => 1,  File => $file, 
    Password => $password, Key => $key[0]);
  clean("Invalid username/password\n") if !$signe;
  return $signe if $type =~ /mail/i;
  $signe =~ s/\A.*?\n-----BEGIN PGP SIGNATURE-----//s;
  my ($version) = ($signe =~ /\nVersion:\s*(.+)/);
  $signe =~ s/\A.*?\n\n//s;
  $signe =~ s/\n-----END PGP SIGNATURE-----\n//;
  $signe =~ s/^/\t/gm;
  my @pgphead = @pgpheader;
  @pgphead = split(/,/, $groups{pgpheader}{$ng}) if $groups{pgpheader}{$ng};
  $version . ' ' . join(',', @pgphead) . "\n$signe";
}

# END of modapp
