#!/usr/local/bin/perl -w
##--------------------------------------------------------------------------##
##  File:
##	$Id: mk-procmailrc,v 1.22 2003/01/10 21:58:00 ehood Exp $
##  Description:
##	Program to create a procmail recipe file from lists.def.
##	Run script with '-man' option to view manpage for this program.
##--------------------------------------------------------------------------##
##  Copyright (C) 2001-2002	Earl Hood <earl@earlhood.com>
##
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##  
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##  
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##  02111-1307, USA
##--------------------------------------------------------------------------##

package MHArc::mk_procmailrc;

##--------------------------------------------------------------------------##
# <x-boot-strap>
BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; }
use lib "$Dir/../lib";  # Add relative lib to search path
# </x-boot-strap>
##--------------------------------------------------------------------------##
# <x-config>
use MHArc::Config;
my $config = MHArc::Config->load("$Dir/../lib/config.sh");
# </x-config>
##--------------------------------------------------------------------------##


use Getopt::Long;
use MHArc::ListDef;
use MHArc::Util qw( usage );

MAIN: {
  my @htaccess = ();
  my %opt = ( );
  my $clstatus = GetOptions(\%opt,
    'catch-address=s',
    'catch-archive=s',
    'disable-catch-archive!',
    'final-dest=s',
    'home=s',
    'mbox-dir=s',
    'msgid-cache-size=i',
    'out=s',
    'procmail-path=s',

    'verbose!',
    'help',
    'man'
  );
  usage(0) unless $clstatus;
  usage(1) if $opt{'help'};
  usage(2) if $opt{'man'};

  my $basedir       = $opt{'home'} ||
		      $config->{'SW_ROOT'} ||
		      "$Dir/..";
  my $mbox_dir	    = $opt{'mbox-dir'} ||
		      $config->{'MBOX_DIR'} ||
		      join('/',$basedir,'mbox');
  my $out_file      = $opt{'out'} ||
		      $config->{'PROCMAILRC'} ||
		      join('/', $basedir, 'procmailrc.mharc');
  my $procmail_path = $opt{'procmail-path'} ||
		      $config->{'PROCMAIL_PATH'};
  my $cache_size    = $opt{'msgid-cache-size'} ||
		      $config->{'MSGID_CACHE_SIZE'} ||
		      16384;
  my $catch_addr    = $opt{'catch-address'} ||
		      $config->{'CATCH_ADDRESS'} ||
		      "";
  my $catch_arc     = $opt{'catch-archive'} ||
		      $config->{'CATCH_ARCHIVE'} ||
		      '.catch';
  my $nocatch       = defined($opt{'disable-catch-archive'}) ?
			  $opt{'disable-catch-archive'} :
			  ($config->{'DISABLE_CATCH_ARCHIVE'} || 0);
  my $final_dest    = $opt{'final-dest'} ||
		      $config->{'FINAL_MSG_DESTINATION'} ||
		      '/dev/null';

  ## Read lists definition file
  my $file = shift(@ARGV) ||
	     $config->{'LISTS_DEF_FILE'} ||
	     "$basedir/lib/lists.def";
  my $listdef = MHArc::ListDef->new($file);

  my $extract_date_prg = join('/', $basedir, 'bin', 'extract-mesg-date');

  local(*OUTFILE);
  my $outfh;
  if (!defined($out_file) || ($out_file eq "") || ($out_file eq '-')) {
    $outfh = \*STDOUT;
  } else {
    open(OUTFILE, ">$out_file") ||
	die qq/ERROR: Unable to create "$out_file": $!\n/;
    $outfh = \*OUTFILE;
  }

  ## Print procmailrc header
  print $outfh <<EOT;
##======================================================================
##!!!!!!!!!!!!!!!!!!!!!! AUTO-CREATED, DO NOT EDIT !!!!!!!!!!!!!!!!!!!!!
##======================================================================
##  Procmail resource file for mharc archives generated from
##    $file
##  by $0
##======================================================================

SHELL=/bin/sh
LINEBUF=4096
UMASK=133
PATH=$procmail_path
BASEDIR=$basedir

LOGFILE=\$BASEDIR/log/procmail.log

## Do alot of logging?
#VERBOSE=yes

## Should deliveries be logged?
LOGABSTRACT=yes

## Root path to mail folders
MBOXROOT=$mbox_dir

## Flag if a list was matched
HAVEMATCH=no

## Date of message
MESGDATE=

##======================================================================
##  Start Rules
##======================================================================

## Avoid duplicate messages
:0 Wh: \$BASEDIR/msgid.lock
| formail -D $cache_size \$BASEDIR/msgid.cache

EOT

  ## Print recipies
  my ($name,
      $cvs_prefix,
      $check_cvs,
      $addr,
      $period,
      $noarchive,
      $pm_conditions,
      $pm_copy,
      $time_fmt);
  my (@addr);
  my (@from_addr);
  my ($str);

  foreach $name (sort keys %$listdef) {
    if (defined($listdef->{$name}{'address'})) {
      @addr = @{$listdef->{$name}{'address'}};
    } else {
      @addr = ( );
    }
    if (defined($listdef->{$name}{'from-address'})) {
      @from_addr = @{$listdef->{$name}{'from-address'}};
    } else {
      @from_addr = ( )
    }
    if (!scalar(@addr) && !scalar(@from_addr)) {
      # no addresses defined
      warn qq/Warning: No addresses defined for '$name'\n/;
      next;
    }

    # create procmail regex for list
    $pm_conditions  = '* (';
    if (scalar(@addr)) {
      $pm_conditions .= '^TO_';
      $pm_conditions .= '('  if (scalar(@addr) > 1);
      $pm_conditions .= join('|', @addr);
      $pm_conditions .= ')'  if (scalar(@addr) > 1);
      $pm_conditions .= '|(^(Delivered-To:|List-Post:).*';
      $pm_conditions .= '('  if (scalar(@addr) > 1);
      $pm_conditions .= join('|', @addr);
      $pm_conditions .= ')'  if (scalar(@addr) > 1);
      $pm_conditions .= ')';
    }
    if (scalar(@from_addr)) {
      $pm_conditions .= '|('  if (scalar(@addr));
      $pm_conditions .= '^From:(.*[^-a-zA-Z0-9_.])?';
      $pm_conditions .= '('  if (scalar(@from_addr) > 1);
      $pm_conditions .= join('|', @from_addr);
      $pm_conditions .= ')'  if (scalar(@from_addr) > 1);
      $pm_conditions .= ')'  if (scalar(@addr));
    }
    $pm_conditions .= ')';

    if (defined($listdef->{$name}{'procmail-condition'})) {
      foreach $str (@{$listdef->{$name}{'procmail-condition'}}) {
	$pm_conditions .= "\n$str";
      }
    }

    # check if doing monthly or yearly archives
    $period = lc($listdef->{$name}{'period'}[0]) || 'month';
    $period = 'month'  if ($name eq $catch_arc);
    if ($period eq 'year') {
      $time_fmt = '%Y';
    } else {
      $time_fmt = '%Y-%m';
    }

    # check if rule should not be final if matched
    if ($listdef->{$name}{'final'}) {
      $pm_copy = '';
    } else {
      $pm_copy = ' c';
    }

    # check if sender specified no archiving should be honored
    if ($listdef->{$name}{'check-no-archive'}) {
      $noarchive =<<'EOT';

  :0
  * ^(X-no-archive: yes|Restrict: no-external-archive)
  /dev/null
EOT
    } else {
      $noarchive = "";
    }

    # check if separating out cvs commits
    if ($check_cvs = $listdef->{$name}{'cvs-commits'}[0]) {
      $cvs_prefix = $listdef->{$name}{'cvs-subject-prefix'}[0] || 'CVS commit';
      foreach $addr (@addr) {
	print $outfh <<EOT;
## $name (CVS)
:0
$pm_conditions
* ^Subject: $cvs_prefix
{$noarchive
  :0
  { CMDEXEC_=`mkdir -m 755 -p \$MBOXROOT/$name.CVS` }

  :0 Wih
  * MESGDATE ?? ^^^^
  MESGDATE=| $extract_date_prg -fmt '$time_fmt'

  :0:
  \$MBOXROOT/$name.CVS/\$MESGDATE
}

EOT
      }
    } # End: $check_cvs

    # address receipe
    print $outfh <<EOT;
## $name
:0
$pm_conditions
{$noarchive
  HAVEMATCH=yes

  :0
  { CMDEXC_=`mkdir -m 755 -p \$MBOXROOT/$name` }

  :0 Wih
  * MESGDATE ?? ^^^^
  MESGDATE=| $extract_date_prg -fmt '$time_fmt'

  :0$pm_copy:
  \$MBOXROOT/$name/\$MESGDATE
}

EOT
  }

  if ($catch_addr) {
    print $outfh <<EOT;
##======================================================================
##	Send unmatched message to $catch_addr
##======================================================================
:0
* HAVEMATCH ?? no
{
  :0
  ! $catch_addr
}
EOT

  } elsif (!$nocatch) {
    print $outfh <<EOT;
##======================================================================
##	No Matches
##======================================================================
:0
* HAVEMATCH ?? no
{
  :0
  { CMDEXC_=`mkdir -m 755 -p \$MBOXROOT/$catch_arc` }

  :0 Wih
  * MESGDATE ?? ^^^^
  MESGDATE=| $extract_date_prg -fmt '%Y-%m'

  :0
  \$MBOXROOT/$catch_arc/\$MESGDATE
}

EOT
  }

  print $outfh <<EOT;
##======================================================================
## Final destination, generally discard since at least one of the
## above rules will have matched.  But if paranoid, or for debugging
## you can have all message copied to a real mailbox by the -final-dest
## option.
##======================================================================
:0
$final_dest
EOT

  if ($outfh != \*STDOUT) {
    close($outfh);
  }

} # End: MAIN

##--------------------------------------------------------------------------##
__END__

=head1 NAME

mk-procmailrc - Generate procmailrc from lists.def

=head1 SYNOPSIS

  mk-procmailrc
  mk-procmailrc [options]

=head1 DESCRIPTION

This program generates the main procmailrc used by the
L<filter-spool|filter-spool> program.  The procmailrc is generated
from C<E<lt>mharc-rootE<gt>/lib/lists.def>.

This program is typically invoked by calling C<make> from
the mharc root directory with configuration options specified
in C<E<lt>mharc-rootE<gt>/lib/config.sh>.

=head1 LIST DEFINITION FILE

The list definition file, C<E<lt>mharc-rootE<gt>/lib/lists.def>,
controls how the procmailrc used by L<filter-spool|filter-spool>
is generated.  The format of the file is simple and more convenient
than writing the procmailrc file yourself.

The basic format of the file is as follows:

=over

=item *

Any blank links or lines starting with a C<#> are ignored.

=item *

Lines with the following format:

  Option-Name: Option-Value

is an option.

=back

=head2 lists.def Supported Options

=over

=item Name

Starts, and defines, the name of an archive.  This name serves as
the directory name containing archive data and the short-title for
archive pages.  A common practice is to use the list address, but this
is not required, especially if the archive is a combination of multiple
lists, or it is prefered to use a more abstract name for simplicity.

=item Address

Mail address of the list.
Multiple C<Address> options can be specified
for an archive if a list has more than one known address (e.g. due
to migration) or the archive is a collection of multiple lists.

=item Check-No-Archive

Boolean option (C<0> or C<1>) if author specified archiving permission
is honored.  The author can request no archiving should be done
by defining one of the the following header fields:

  Restrict: no-external-archive
  X-no-archive: yes

If C<Check-No-Archive> is enabled, a message to the list with either
field defined will not be archived.

=item CVS-Commits

Boolean option (C<0> or C<1>) if CVS commit messages should be
archived separately.

Use this option for development lists that have CVS project commits
mailed to the list, and you want to avoid cluttering regular discussion
mail.

=item CVS-Subject-Prefix

Specifies the C<Subject:> prefix denoting CVS commits to the list.
This option is only used if C<CVS-Commits> is specified.

=item Description

Brief description of archive and serves as the main title of archive
index pages.

=item Final

Boolean option (C<0> or C<1>) if generated rule should be final.
I.e. If a message matches, further rules will not be examined.

Use this option to short-circuit messages from being stored in multiple
archives.  For example, you may want to catch messages cross-posted
to a special address to only be archived in a special archive and
not any of the regular archives.

Another example is if you use the special C<Name> "C<.catch>"
(or the C<-catch-archive> setting described in L<"OPTIONS">).
Using "C<.catch>" is handy for C<Final> definitions to pre-catch
messages that should not be placed in any list archive.

=item From-Address

Mail address of the list.  This option is an alternative to C<Address>
where a list can only be donoted by the C<From: > field of messages.
This is fairly common for one-way lists, like newsletters, where
subscribers receive list messages but cannot post to the list.

Multiple C<From-Address> options can be specified if a list has more
than one known address (e.g. due to migration) or the archive is a
collection of multiple lists.

=item MHonArc-Options

Additional MHonArc command-line options.

=item No-Raw-Link

Boolean option (C<0> or C<1>) if links to raw archives should exist.
If set to C<1>, links will not be created or disabled.  The
default value for this option is C<0>.

Use this option if your HTML archives have been customized to obscure
address to prevent address harvesting.

=item No-Search

Boolean option (C<0> or C<1>) if searching should be disabled.
If set to C<1>, no search index is created and the C<$SEARCH-FORM$>
custom MHonArc resource variable will be set to the empty string.

=item Period

If archive is a yearly or monthly archive.  Legal values are C<year>
or C<month>.  If Period is not defined, C<month> is the default.

=item Procmail-Condition

Additional condition to apply to base address check.  The condition
must be legal procmailrc syntax and should include any prefixing C<*>,
C<!>, et. al.  This option can be specified multiple times.

B<CAUTION:> Exercise caution when using this option, especially if
C<CVS-Commits> is true.  When C<CVS-commits> is true, an additionaly
rule already exists to check for the C<CVS-Subject-Prefix> setting.

=back

=head2 lists.def Example

  ##  In this definition, we define multiple addresses to check.
  Name: mhonarc-users
  Description: MHonArc Users
  Address: mhonarc-users@mhonarc.org
  Address: mhonarc@ncsa.uiuc.edu
  Address: mhonarc@rosat.mpe-garching.mpg.de

  ##  This definition defines a list that receives CVS commits and those
  ##  commits should be separated into a special archive as to not
  ##  pollute the discussion messages with cvs commit messages
  Name: mhonarc-dev
  Description: MHonArc Development
  Address: mhonarc-dev@mhonarc.org
  CVS-Commits: 1
  CVS-Subject-Prefix: CVS: 

=head1 OPTIONS

You should never have to invoke this program with any options since
C<config.sh> specifies any options used by this program.  However,
for advanced uses, or you do not care if you mess things up, the
following options are available:

=over

=item C<-catch-address> I<mail-address>

The name of the email address to forward all unmatched message to.
This is an alternative to C<-catch-archive>, and will supercede
C<-catch-archive>, if defined.
If this option is not specified, the C<CATCH_ADDRESS> variable in
C<config.sh> is used.

=item C<-catch-archive> I<name>

The name of the I<catch> archive.  The I<catch> archive collects
all messages that do not match any list rules.  If this
option is not specified, the C<CATCH_ARCHIVE> variable in
C<config.sh> is used, else the name "C<.catch>" is used.

B<Note:> If you use this option, it is recommended that the name
starts with a C<.> (a dot).  This insures that no search index is built
and it will not be listed in the all-lists page.

=item C<-disable-catch-archive>

If specified, no I<catch> archive will be defined.

B<CAUTION:> Care should be used when using this option since any
message that does not match a normal rule will be lost.

=item C<-final-dest> I<mailbox>

The destination of messages that make it to the end of the procmailrc.
It is normal for messages to make it to the end since the list matching
rules create copies of the message during filtering.  Hence, it is
normal to see "C<Folder: /dev/null>" destinations in the procmail log
and it does not indicate that a message was lost.

Message copying is done inorder to properly archive a message that has
been cross-posted to multiple lists.  Message copying is not done for
archives with the C<Final> option set to 1, for CVS commit archives,
or for messages that are captured by the catch archive.

This option is generally only used for debugging purposes.

If C<-final-dest> is not specified, the
C<FINAL_MSG_DESTINATION> variable in C<config.sh> is used, else
C</dev/null> is used.

=item C<-help>

Print out usage information.

=item C<-home> I<pathname>

B<You should not use this option>.

Root pathname of software and archives.  If not specified,
C<SW_ROOT> variable in C<config.sh> is used, else the parent directory
that containing this program is used.

=item C<-man>

Print out entire manpage.

=item C<-mbox-dir> I<pathname>

Root pathname containing raw mailbox archives.  If not specified,
C<MBOX_DIR> variable in C<config.sh> is used, else C<I<-home>/mbox>
is used.

=item C<-msgid-cache-size> I<number-of-bytes>

The maximum size, in bytes, of the message-id cache.  The message-id
cache helps avoid processing duplicate messages.

If this option is not specified, the C<MSGID_CACHE_SIZE> variable
in C<config.sh> is used, else 16384 will be used.

=item C<-out> I<pathname>

Output filename.  If this option is not specified, the C<PROCMAILRC>
variable in C<config.sh> is used, else C<I<-home>/procmailrc.mharc>
is used.

If "-" is the I<pathname>, then the procmailrc will be dumped to
standard out.

=item C<-procmail-path> I<pathname-list>

The search path for C<procmail> to use.  If this option is not
specified, the C<PROCMAIL_PATH> variable in C<config.sh> is used.

=back

=head1 FILES

=over

=item C<E<lt>mharc-rootE<gt>/lib/lists.def>

Mailing lists definition file.

=item C<E<lt>mharc-rootE<gt>/lib/config.sh>

Main configuration file for mharc.

=back

=head1 VERSION

$Id: mk-procmailrc,v 1.22 2003/01/10 21:58:00 ehood Exp $

=head1 AUTHOR

Earl Hood, earl@earlhood.com

This program is part of the mharc archiving system and comes with
ABSOLUTELY NO WARRANTY and may be copied only under the terms of
the GNU General Public License, which may be found in the mharc
distribution.

=cut