Source

xemacsweb / cgi-bin / wilma_reindex

#!/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". 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
    $CFG_SUFFIX
    $DEFAULT_MODE
    $DEFAULT_UMASK
/;

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


# 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);
    closedir(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;
	$cfg->import_variables();
    };
    if ($@) {
	warn "Configuration File Error: $@";
	next;
    }

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

    unless (chdir $CFG::arc_dir) {
	warn "Can't chdir to $CFG::arc_dir: $!\n";
	next;
    }
    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) {
	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',
		    '-z');
	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((defined $CFG::index_mode ? $CFG::index_mode : $DEFAULT_MODE),
	    map("index/$_", @indexfiles)) if @indexfiles;
    }

    unlink($CFG::flag_file);
}

exit 0;

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