xemacsweb / cgi-bin / wilma_reindex

#!/usr/bin/perl -w

# Web Interface to List Mail Archives
# Copyright 1997, 1998 by Jason L. Tibbitts III <> and
# David Wolfe <>. 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 (but see
# CFG_SUFFIX below), e.g. ".wilma/". The other supporting
# programs are assumed to be in the same directory as this one.
# $Revision$

use AppCfg 1.2;
use strict;
use vars qw/

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

# Try to figure out where the list configuration file are: if the
# $CFG_ROOT directory isn't visible from the current directory and isn't
# an absolute path, then we were probably run with a path, so extract
# that from $0 and append $CFG_ROOT.

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

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

unless (@ARGV) {
    opendir(DIR, $root) || die "Can't open '$root' directory: $!\n";
    @ARGV = sort grep /$CFG_SUFFIX$/, readdir(DIR);

# Set umask

umask(defined $CFG::umask ? oct($CFG::umask) : $DEFAULT_UMASK);

# Main loop to process mail lists.

my $list;
foreach $list (@ARGV) {

    # Grab the configuration parameters for the mail list.
    undef $CFG::;	# Wipe the namespace first
    my $cfg_file = ($list =~ /$CFG_SUFFIX$/)
		    ? "$root/$list"
		    : "$root/$list$CFG_SUFFIX";
    eval {
	my $cfg = new AppCfg $cfg_file;
    if ($@) {
	warn "Configuration File Error: $@";

    # Default the optional parameters.
    $CFG::arc_mbox   ||= $CFG::arc_dir;
    $CFG::mbox_regex ||= $CFG::arc_regex;

    # 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/$_"}

    # 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 @links  = sort grep {/$CFG::mbox_regex/ && -l "$CFG::arc_dir/$_"}
    my @archives = sort grep {/$CFG::arc_regex/ && -d "$CFG::arc_dir/$_"}

    unless (chdir $CFG::arc_dir) {
	warn "Can't chdir to $CFG::arc_dir: $!\n";
    unless (open(FLAG, ">$CFG::flag_file") && close(FLAG)) {
	warn "Can't lock the archives ($CFG::flag_file) $!\n";

    # 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) {
	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, '-f', '-n', '-o', '-H', 'index', '-M', '50',
	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";
	my @indexfiles = grep(/^\.glimpse/, readdir(INDEX));
	chmod((defined $CFG::index_mode ? $CFG::index_mode : $DEFAULT_MODE),
	    map("index/$_", @indexfiles)) if @indexfiles;


exit 0;

# Appease -w
$CFG::mhonarc        ||= $CFG::mhonarc;
$CFG::mhonarc_rcfile ||= $CFG::mhonarc_rcfile;
$CFG::glimpseindex   ||= $CFG::glimpseindex;