#!/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"); } } }