From: jepeway@cs.utk.edu (Chris Jepeway)
Newsgroups: news.software.b
Subject: expire.pl: A Perl expire for INN
Date: 15 Sep 92 18:16:53 GMT
Organization: /silver/homes/jepeway/.organization
Distribution: world
NNTP-Posting-Host: galoob.cs.utk.edu

And, in the "what-the-hell/why-not" department, here's a Perl
version of expire that'll handle INN's expire.ctl format.
Typically, you use it like this from a Bourne shell script:

	perl -reason "Expiring" expire.pl > history.n
	if makehistory -r -f history.n; then
		mv history.n history
		mv history.n.dir history.dir
		mv history.n.pag history.pag
		ctlinnd go "Expiring"
	else
		echo "Could not rebuild history database; inn still paused" |
			mail ${NEWSMASTER}
		exit 1
	fi

I've found it useful as a starting place to easily goof
around with different expiration schemes.

When you turn on its strip-chart code, it averages
about 6 milliseconds per line of history when running
on our news server, a Sun-3/470 feeding 9 sites and
umpteen newsreaders.

Oh yeah, if you stick this in with the INN source,
make a directory called "contrib" and put it in there.
Rich promises not to clobber anything in that dir
with future releases of INN.

Comments, enhancements, patches, etc are welcome.

Chris Jepeway <jepeway@cs.utk.edu>
---------
#! /usr/local/bin/perl
# A Perl version of INN expire.  Usage:
#    perl expire.pl -reason Expiring >history.n
#    if makehistory -r -f history.n; then
#	mv history.n history
#	mv history.n.dir history.dir
#	mv history.n.pag history.pag
#	ctlinnd go Expiring
#    else
#	echo "Could not rebuild history database; inn mastill paused" |
#		mail ${NEWSMASTER}
#	exit 1
#    fi
# 
# Note that expire.pl must leave INN paused to give you a chance
# to move the new history file into place.  Like most expires,
# it doesn't need to pause INN for very long, just long enough
# to rescan the history file one last time and keep any new
# articles from coming in while it finishes building the
# new history file.
#
# expire.pl typically averages about 6 milliseconds to process a
# single line of the history file on our news server, a Sun-3/470
#
# Chris Jepeway <jepeway@cs.utk.edu>
#

# =()<$HISTORY = '@<_PATH_HISTORY>@';>()=
$HISTORY = '/usr/local/news/history';
# =()<$NEWSSPOOL = '@<_PATH_SPOOL>@';>()=
$NEWSSPOOL = '/var/spool/news';
# =()<$EXPCTL = '@<_PATH_EXPIRECTL>@';>()=
$EXPCTL = '/usr/local/news/expire.ctl';
# =()<$ACTIVE = '@<_PATH_ACTIVE>@';>()=
$ACTIVE = '/usr/local/news/active';

$REASON = 'Expiring';
$DONTPAUSE = 0;

$DAYS = 60 * 60 * 24;
$DEFREMEMBER = 20;

@PROG = split(/\//, $0);
$PROG = pop @PROG;

while ($ARGV[0] =~ "^-.*") {
    $_ = $ARGV[0]; shift;

    switch: {
	/^-spool$/ && do {
	    $NEWSSPOOL = $ARGV[0];
	    shift;
	    last switch;
	};

	/^-hist$/ && do {
	    $HISTORY = $ARGV[0];
	    shift;
	    last switch;
	};

	/^-remember$/ && do {
	    $remember = $ARGV[0] * $DAYS;
	    shift;
	    last switch;
	};

	/^-active$/ && do {
	    $ACTIVE = $ARGV[0];
	    shift;
	    last switch;
	};

	/^-reason$/ && do {
	    $REASON = $ARGV[0];
	    shift;
	    last switch;
	};

	/^-dontpause$/ && do {
	    $DONTPAUSE = 1;
	    last switch;
	};

	/^-.*$/ && do {
	    die "usage: $PROG",
		" [-spool <spool directory>]",
		" [-hist <history file>]", 
		" [-active <active file>]",
		" [-remember <# days to keep history>]",
		" [-dontpause ]",
		" [-reason <reason passed to ctlinnd pause>]",
		" [<control file>]\n";
	};
    };
}

# read newsgroups from active file
%moderated = ();
@newsgroups = ();
open(ACTIVE, $ACTIVE) || die "$PROG: can't open active file $ACTIVE\n";
while (<ACTIVE>) {
    chop;
    local($ng, $x, $y, $flag) = split(/ /);
    next if $flag eq 'x';
    push(@newsgroups, $ng);
    $moderated{$ng} = ($flag eq 'm');
}
close ACTIVE;

$now = time;

$EXPCTL = $ARGV[0] if $ARGV[0];
open(EXPCTL, $EXPCTL) || die "$PROG: can't open expire control file $EXPCTL\n";

#
# parse expire control file into %keep, %default, %purge & $forget;
# $keep{newsgroup} is the date in the past beyond which it's ok to
# expire an article based on its Expires: header, $purge{newsgroup} is
# the date in the past beyond which articles in newsgroup with Expires:
# headers will be deleted no matter what, $default{newsgroup} is the
# date in the past beyond which articles in newsgroup with no Expires:
# header will be tossed, & $forget is the date before which we forget
# we've seen an expired article
#
(%keep, %default, %purge) = ();
while (<EXPCTL>) {
    next if /^\#.*$/;
    next if /^\s*$/;

    chop;
    ($ngpat, $modflag, $keep, $default, $purge) = split(/:/);

    if ($ngpat eq '/remember/') {
	$remember = $modflag * $DAYS unless defined $remember;
	next;
    }

    # make a lame attempt to xlate from wildmat(3) patterns into perl regexps
    $ngpat =~ s/\*/[-_:a-zA-Z0-9]*/g;	# turn * into [range]*, play with :
    $ngpat =~ s/\./\\./g;		# escape .'s
    $ngpat =~ s/:/./g;			# turn all the :'s from above into .'s
    $ngpat =~ s/\?/./g;			# turn ?'s into .'s

    /$ngpat/;
    foreach $ng (grep(// && ($modflag eq 'A' ||
			     $modflag eq 'M' &&  $moderated{$_} ||
			     $modflag eq 'U' && !$moderated{$_}),
		      @newsgroups)) {
	$default{$ng} = $default eq 'never' ? 0 : $now - $default * $DAYS;
	$purge{$ng} = $purge eq 'never' ? 0 : $now - $purge * $DAYS;
	$keep{$ng} =  $keep eq 'never' ? 0 : $now - $keep * $DAYS;
    }
}
close EXPCTL;

$remember = $DEFREMEMBER * $DAYS unless defined $remember;
$forget = $now - $remember;

open(HISTORY, $HISTORY) || die "$PROG: can't open history file $HISTORY\n";

chdir $NEWSSPOOL || die "$PROG: can't cd to $NEWSSPOOL\n";

sub expire {
# uncomment some of the comments at the end of the
#   following section of code if you'd like to see a
#   fru-fru strip chart of how quickly expire is running
    $n = 0;
    $prev = time;
    while (<HISTORY>) {
	chop;
	($msgid, $date, $articles) = split(/\t/);
	($arrive, $expires) = split(/~/, $date);	# ignore posted date
	@articles = split(/ /, $articles);

	@unexpired = ();
	@expired = ();

	foreach (@articles) {
	    ($ng) = split(/\//, $_);	# pick off newsgroup

	    if ($expires eq '-' ?
		$arrive < $default{$ng} :
		($arrive < $keep{$ng}) &&
		($arrive < $purge{$ng}) || ($now > $expires)) {
		s-\.-/-g;		# convert to pathname
		push(@expired, $_);
	    } else {
		push(@unexpired, $_);
	    }
	}

	unlink @expired;	# perl doesn't call unlink(2)
				# if passed a null array

	if (@unexpired) {
	    print "$msgid\t$date\t@unexpired\n";
	} elsif ($arrive > $forget) {
	    print "$msgid\t$arrive~-\n";
	}

#	print one . per 500 lines of history, one line per 10000, and the avg
#	# milliseconds to process a history line in the last 10000
#	$n++;
#	print STDERR "." if ($n % 500 == 0);
#	if ($n % 10000 == 0) {
#	    print STDERR "$n - ", (time - $prev) / 10.0, "\n";
#	    $prev = time;
#	}
    }
}

# call expire once...
&expire;
# ...then pause INN & do it again...
system "ctlinnd pause \"$REASON\"" if !$DONTPAUSE;
&expire;
# ...leaving it paused on exit
Newsgroups: news.software.b