#!/usr/bin/perl -w

# Web Interface to List Mail Archives
#
# Copyright 1997, 1998 by Jason L. Tibbitts III <tibbs@hpc.uh.edu> and
# David Wolfe <dave_wolfe@computer.org>. May be freely used, modified,
# and redistributed under the same terms as Perl. Absolutely no warranty
# of any kind. Authors are not responsible for any damage or loss caused
# by use of this program.
#
# Invokes MHonArc to HTMLize mail list archives and glimpseindex to
# index them for searching.
#
# This program is run periodically to update the HTML version of the
# mail list archives and the associated glimpse index files. Mail lists
# to be updated are specified on the command line, otherwise all mail
# lists for which configuration files are found are updated.
#
# List configuration files are in the ".wilma" subdirectory of the
# directory where the wilma CGI programs are installed (but see CFG_ROOT
# below). They reside in files named in the form listname.cf (but see
# CFG_SUFFIX below), e.g. ".wilma/testlist.cf".
#
# $Revision: 1.14 $

use Cwd;
use AppCfg;
use strict;
use vars qw/
    $CFG_ROOT
    $CFG_SUFFIX
    $DEFAULT_MODE
    $DEFAULT_TABLE
    $DEFAULT_UMASK
/;

*CFG_ROOT      = \'.wilma';	# Configuration file root directory
*CFG_SUFFIX    = \'.cf';	# Configuration file name suffix
*DEFAULT_MODE  = \'0644';
*DEFAULT_TABLE = \50;
*DEFAULT_UMASK = \'022';


# Try to figure out an absolute path for the list configuration file
# since we might chdir between accesses. Using the run path (in $0)
# isn't foolproof, but should work for well-behaved uses.

my $root = $CFG_ROOT;
if ($root !~ m{^/}) {
    unless (-d $root) {
	($root) = ($0 =~ m{^(.*)/});	# Extract base directory
	$root = (defined $root && $root ne "")
		? "$root/$CFG_ROOT"
		: "$CFG_ROOT";
    }
    $root = cwd() . "/$root" if $root !~ m{^/};
}
die "Can't find the mail list configuration files ($root)\n" unless -d $root;

# If no mail lists were specified on the command line, assume all the
# lists with configuration files.

unless (grep !/^[-+]f$/, @ARGV) {
    opendir(DIR, $root) || die "Can't open '$root' directory: $!\n";
    push @ARGV, sort grep /$CFG_SUFFIX$/, readdir(DIR);
    closedir(DIR);
}

# Main loop to process mail lists.

my $list;
my $force = 0;
foreach $list (@ARGV) {

    # Check for a force reindex flag. "-f" forces reindexing and "+f"
    # resets forced reindexing.
    if ($list =~ /^[-+]f$/) {
	$force = ($list eq "-f") ? 1 : 0;
	next;
    }

    # Grab the configuration parameters for the mail list.
    my $cfg_file = ($list =~ /$CFG_SUFFIX$/)
		    ? "$root/$list"
		    : "$root/$list$CFG_SUFFIX";
    my $cfg;
    eval {
	$cfg = AppCfg->new($cfg_file);
    };
    if ($@) {
	warn "Configuration File Error: $@";
	next;
    }
    my $cfg_arc_dir        = $cfg->get_scalar('arc_dir');
    my $cfg_arc_mbox       = $cfg->get_scalar('arc_mbox') || $cfg_arc_dir;
    my $cfg_arc_regex      = $cfg->get_scalar('arc_regex');
    my $cfg_flag_file      = $cfg->get_scalar('flag_file');
    my $cfg_glimpseindex   = $cfg->get_scalar('glimpseindex');
    my $cfg_glimpse_table  = int($cfg->get_scalar('glimpse_table') || $DEFAULT_TABLE);
    my $cfg_index_mode     = oct($cfg->get_scalar('index_mode') || $DEFAULT_MODE);
    my $cfg_mbox_regex     = $cfg->get_scalar('mbox_regex') || $cfg_arc_regex;
    my $cfg_mhonarc        = $cfg->get_scalar('mhonarc');
    my $cfg_mhonarc_rcfile = $cfg->get_scalar('mhonarc_rcfile');
    my $cfg_umask          = oct($cfg->get_scalar('umask') || $DEFAULT_UMASK);

    # Build a list of archive mailbox files.
    opendir(MBOXES, $cfg_arc_mbox) ||
	die "Can't find raw archives ($cfg_arc_mbox) $!\n";
    my @mboxes = sort grep {/$cfg_mbox_regex/ && -f "$cfg_arc_mbox/$_"}
			    readdir(MBOXES);
    closedir(MBOXES);

    # Build lists of established links to archive mailboxes and existing
    # HTML archives.
    opendir(ARCHIVES, $cfg_arc_dir) ||
	die "Can't find archives ($cfg_arc_dir) $!\n";
    my @archives = readdir(ARCHIVES);
    closedir(ARCHIVES);
    my @links = sort grep {/$cfg_mbox_regex/ && -l "$cfg_arc_dir/$_"} @archives;
    @archives = sort grep {/$cfg_arc_regex/  && -d "$cfg_arc_dir/$_"} @archives;

    unless (chdir $cfg_arc_dir) {
	warn "Can't chdir to $cfg_arc_dir: $!\n";
	next;
    }
    umask($cfg_umask);
    unless (open(FLAG, ">$cfg_flag_file") && close(FLAG)) {
	warn "Can't lock the archives ($cfg_flag_file) $!\n";
	next;
    }

    # Establish links to archive mail boxes.
    # (These links might not work for chrooted web servers.)
    my %mark = map {$_, 1} @links;
    foreach (grep(!$mark{$_}, @mboxes)) {
	symlink "$cfg_arc_mbox/$_", $_;
    }

    # Create archive directories for new mailbox archives
    my (@reinc, @reindex);
    %mark = map {$_, 1} @archives;
    foreach (@mboxes) {
	my $arc = join("", /$cfg_mbox_regex/);	# Already matched once
	if ($mark{$arc}) {
	    push(@reinc, $_) if -M "$cfg_arc_mbox/$_" < -M $arc;
	}
	else {
	    print "mkdir $arc, 0755\n";
	    mkdir $arc, 0755;
	    push @archives, $arc;	# Add the new archive to the list
	    push @reinc, $_;		# We must reinc this archive
	}
    }

    # Reinc all the mailboxes that have changed.
    if (@reinc || $force) {
	my @command = ($cfg_mhonarc, '-add', '-rcfile',
			"$root/$cfg_mhonarc_rcfile", '-outdir');
	print "Re-incing @reinc\n";
	foreach (@reinc) {
	    my $arc = join("", /$cfg_mbox_regex/);	# Already matched once
	    print "@command $arc $_\n";
	    system @command, $arc, $_;
	    push @reindex, $arc;	# We must re-index this archive
	}

	# Reindex all of the updated archives.
	mkdir "index", 0755 unless -d "index";
	@command = ($cfg_glimpseindex);
	push @command, '-f' unless $force;
	push @command, '-o', '-H', 'index', '-M', $cfg_glimpse_table, '-z';
	@reindex = @archives if $force;
	print "@command @reindex\n";
	system @command, @reindex;

	# Make all the permissions world readable.
	unless (opendir(INDEX, "index")) {
	    warn "Can't find the index directory ($cfg_arc_dir/index) $!\n";
	    next;
	}
	my @indexfiles = grep(/^\.glimpse/, readdir(INDEX));
	closedir(INDEX);
	chmod($cfg_index_mode, map("index/$_", @indexfiles)) if @indexfiles;
    }

    unlink($cfg_flag_file);
}

exit 0;
