#!/usr/local/bin/perl5 -w
#
# Copyright (C) JohnPC 1997. All rights reserved.
# You are free to use, modify or distribute this program as you see fit,
# as long as you leave this notice here.

require 5.002; # this requires at least perl5.002 or better.

# location of overview hierachy.
# !!!! You will have to adapt this for your local system !!!!!
my $overhier = "/usr/local/news/over.view";

use File::Find;
use POSIX ':fcntl_h';
use Getopt::Std;
use strict;

# call with -v to get verbose report of which groups have out-of-order
# overview files
use vars qw($opt_v);
getopts('v');

# created files have an explicit mode set, don't let umask spoil it.
umask 0;

# locking constants for flock
sub LOCK_SH () { 1 }
sub LOCK_EX () { 2 }
sub LOCK_NB () { 4 }
sub LOCK_UN () { 8 }

# generate output at least every:
my $reporttime = 60;

# some globals
my(@later, $sort, $file, $lastout);

# with all this forking going around, we need hot pipes
$| = 1;

# find "sort"
foreach $file ( split(/:/, $ENV{PATH}) ) {
    if ( -x "$file/sort" && -f _ ) {
	$sort = "$file/sort";
	last;
    }
}
die("can't find sort\n") unless $sort;

# set sorting TMPDIR to be the same as the overview root dir, because the
# default /var/tmp might be too small for some groups
$ENV{TMPDIR} = $overhier;

$lastout = time;
# traverse over.view hierarchy
find(\&wanted, $overhier);

sub file2group ($) {
    my($group) = @_;
    $group =~ s-^$overhier/--o;
    $group =~ s-/\.overview$--;
    $group =~ s-/-.-g;
    $group;
}

# try desparately to fork
sub dofork () {
    my($pid, $count);

    $count = 0;
    while ( !defined($pid = fork) ) {
	if ( ++$count > 25 ) {
	    die "fork failed too many times: $!\n";
	}
	warn "fork failed: $!\n";
	sleep 1;
    }
    $pid;
}

# sort the .overview file
sub sortit ($) {
    my($file) = @_;
    my($lckfile, $mode, $uid, $gid, $fd, $pid, $r);

    # obtain lock on .overview file (overchan lock)
    open(OVERVIEW, "+<$file") or die("cannot open $file: $!\n");
    if ( ! flock(OVERVIEW, LOCK_EX | LOCK_NB) ) {
	# lock failed, return failure (will try again later)
	close(OVERVIEW);
	return 0;
    }
    # get file mode and ownership of .overview
    ($mode, $uid, $gid) = (stat OVERVIEW)[2,4,5];
    # create .LCK.overview file, exclusively (expireover lock)
    ($lckfile = $file) =~ s/\.overview$/.LCK.overview/;
    # sanity check
    die("not an .overview file $file?\n") if $lckfile eq $file;
    if ( ($fd = POSIX::open($lckfile, O_WRONLY | O_CREAT | O_EXCL, $mode))
	    == -1 )
    {
	# lock failed, release overchan lock and return failure
	flock(OVERVIEW, LOCK_UN);
	close(OVERVIEW);
	return 0;
    }
    # report start of sort
    print file2group($file), ": sorting\n" if $opt_v;
    $lastout = time;
    if ( ($pid = dofork) == 0 ) {
	# child. sort .overview into .LCK.overview
	open(STDOUT, ">&=$fd") or die("cannot fdopen $fd to STDOUT: $!\n");
	open(STDIN, "<&OVERVIEW") or die("cannot dup OVERVIEW to STDIN: $!\n");
	exec($sort, "-n");
	die("cannot exec $sort: $!\n");
    }
    # parent. opened .LCK.overview can be closed, but .overview must be
    # kept open because of the flock on it.
    POSIX::close($fd);
    waitpid($pid, 0);
    $r = $?;
    if ( $r ) {
	# sort failed, report failure, remove locks, but return success
	warn("sort returned: " . ($r >> 8) .
	    " trying to sort overview file of " . file2group($file) . "\n");
	unlink($lckfile);
	flock(OVERVIEW, LOCK_UN);
	close(OVERVIEW);
	return 1;
    }
    # set ownership of .LCK.overview same as .overview
    chown($uid, $gid, $lckfile);
    # rename .LCK.overview into .overview. This removes both locks at once
    rename($lckfile, $file);
    # OVERVIEW is no longer present, can be closed now
    close(OVERVIEW);
    return 1;
}

# process all files that couldn't be processed in the first pass
my(%attempts);
while ( $file = shift @later ) {
    if ( ! sortit($file) ) {
	if ( ++$attempts{$file} > 25 ) {
	    warn file2group($file), ": too many attempts to sort\n";
	}
	else {
	    push(@later, $file);
	    print file2group($file), ": still locked...\n" if $opt_v;
	}
    }
}

# this gets called for every file under /news/over.view. See File::Find.
sub wanted () {
    my $pid;

    if ( -f && /^\.overview$/ ) {
	# it's an overview file. Check sort order by forking "sort -n -c";
	if ( $opt_v && $lastout + $reporttime < time ) {
	    print "... checking ", file2group($File::Find::name), "\n";
	    $lastout = time;
	}
	if ( ($pid = dofork) == 0 ) {
	    # child. check sort order, redirect stderr to null
	    open(STDERR, ">/dev/null") or
		die("cannot redir STDERR to null: $!\n");
	    exec($sort, "-n", "-c", $_);
	    die("cannot exec $sort: $!\n");
	}
	waitpid($pid, 0);
	if ( $? >> 8 == 1 ) {
	    print file2group($File::Find::name), ": out of order\n" if $opt_v;
	    $lastout = time;
	    if ( ! sortit($File::Find::name) ) {
		push(@later, $File::Find::name);
	    }
	}
	elsif ( $? >> 8 ) {
	    die("sort returned: " . ($? >> 8) . "\n");
	}
    }
}