# NUEXPIRE.PL by Roy M. Silvernail
# A Waffle BBS maintainence utility (designed for MS-DOS systems)
# This program is released into the public domain
#
# Please refer to the file NUREAD.ME for installing and using NUEXPIRE
#
# Presented without warranty.  Bug reports, thank-you notes, bequests,
# etc. to roy%cybrspc@cs.umn.edu
#
# 10/26/91
#
# Version 1.1 10/27/91
# Fixed bug in graded expire that would never expire groups graded with
# a value that included a 0.
#
# Version 1.2 11/24/91
# Added option to append a logfile with names of all expired articles.
# This option has no effect in debug mode, although the logfile name
# will be printed with other option information.
#
# Version 1.3 12/10/91
# Added -x option to protect certain groups from expiry.
# Use '-x group.name group.name'.  List may be followed by other args.
# NUEXPIRE now skips comment lines and blank lines in the usenet file.
#
# Version 1.4 2/2/92
# Logfile used to leave 0-byte files laying about.  Fixed.
#
# Version 1.5  2/26/92
# Added -nuke option to remove all news in the spool except local groups...
# but you must prove that you _really_ want to!
#
# Version 1.6  4/19/92
# Added support for multiple forum description files.
#
# Version 1.7  4/26/92
# Tewaked some areas.  NUEXPIRE now requires Perl 4.0 to run.
# Added default /expire flags in DEFAULT lines.
# Added a little documentation of the debug flags.  Try 'nuexpire -d99'.
# The logfile works properly now, instead of logging every article
# considered.
#
# Version 1.8  5/10/92
# Added "-s" to just display statistics of how long each group is kept.
# The static file parsing now allows lines of the form 'flag:option' (with
# no whitespace).
# The 'local' forum file is not processed.
# (changes courtesy of Bill Fenner, to whom I tip my hat!)
#
# Version 2.0   11/15/92
# The 'ignore newsgroups' option now works more intuitively.  To protect
# only alt.bbs, use '-x alt.bbs.'.  To protect alt.bbs and everything
# underneath of it, use '-x alt.bbs' with no trailing period.
# More of Bill Fenner's suggestions incorporated.  NUEXPIRE now does a
# chdir() to each directory to improve stat performance.  NUEXPIRE now
# handles filenames with leading -, since it stats each file instead of
# relying on a filename.  But the leading dash will still play havoc with
# expiry by join file.  The only real solution is to upgrade to 1.65
# Waffle or trim your newsgroups before they exceed 32,767.
# Added -autonuke to do a full nuke unconditionally from the command line.
# This is potentially dangerous, so apply with care.
#

$version = "V2.0";
select (STDOUT); $| = 1;
select((select (STDERR), $| = 1)[$[]);

sub max { local ($v) = (shift @_); grep(($_ > $v) && ($v = $_),@_); $v; }
sub min { local ($v) = (shift @_); grep(($_ < $v) && ($v = $_),@_); $v; }



# if you _must_ run perl 3.0.41, use this fixpath
# sub fixpath {
# join('/',grep((y/A-Z/a-z/,s/(.*)/substr($1,0,8)/e),split(/[\/\\\.]/,shift(@_))));
# }


sub fixpath {
join('/',grep(s/(.*)/substr("\L$1",0,8)/e,split(/[\/\\\.]/,shift(@_))));
}


sub usage {
    print STDERR <<END_OF_PRINT;

NUEXPIRE.PL $version by Roy M. Silvernail
usage: nuexpire <-t n|-u name|-s> [-g n][-d][-l filename][-x group [group...]]
                [-nuke][-autonuke]
       -t: expire older than n days
       -u: expire read articles from user/join
       -s: STATS mode -- print age in days of oldest art,
           don't do any expiration
       -g: expire only articles graded n and below
       -d: debug mode; print commands to STDOUT
       -l: append log of deleted articles to filename
       -x: exclude this group from expiry
       -nuke: removes ALL news!
       -autonuke: removes ALL news and doesn't ask first!
       one of -s, -t or -u must be specified, but only one

END_OF_PRINT

    exit 1;
}


# parse some args, eh?

$args = join(' ',@ARGV);
$nuke = ($args =~ /-nuke/) ? 1 : 0;
$nuke = ($args =~ /-autonuke/) ? 2 : 0;
$expire_time = ($args =~ /-t\s*(\S+)/) ? $1 : 1;     # default to 1
$expire_grade = ($args =~ /-g\s*(\S+)/) ? $1 : 1;    # default to 1
$join_file = $1 if $args =~ /-u\s*(\S+)/;
$debug = ($args =~ /-d/) ? 1 : 0;        # explicitly set 0 if no debug
$debug = $1 if ($args =~ /-d\s*(\d+)/);
$log_file = ($args =~ /-l\s*(\S+)/) ? $1 : 0;
$log_file = &fixpath($log_file) if $log_file;
@exclude = split(' ',$1) if $args =~ /-x\s*(.*)\s-/ || $args =~ /-x\s*(.*)/;
$stats++ if $args =~ /-s/;
&usage() if $args =~ /-h/ || $args =~ /-\?/;
&usage() if scalar(grep(/-t/||/-u/||/-s/,@ARGV)) != 1 && !$nuke;
&usage() unless $args =~ /-t/ || $args =~ /-u/ || $args =~ /-s/ ||
    $nuke || $debug;



# first, let's find out some things...

open(INFILE,$ENV{"WAFFLE"}) || die("Can't find static file");

@forums=("usenet");

while (<INFILE>) {
    $waffle_dir = &fixpath($1) if /^waffle\s*:\s*(\S+)$/;
    $user_dir = &fixpath($1) if /^user\s*:\s*(\S+)$/;
    @forums = grep($_ ne "local",split(/[ \t]+/,$1)) if /^forums\s*:\s*(.+)$/;
}
close(INFILE);

# Qualify forum file paths:
grep(s|^|$waffle_dir/system/|,@forums);

if ($debug==5) {
    print "$waffle_dir\n$user_dir\n";
    print join("\n",@forums)."\n";
}

# now we know where things are....

if ($join_file) {
    print "$user_dir/$join_file/join\n" if $debug;
    open(JOINFILE,"$user_dir/$join_file/join") || die("no join");
    while (<JOINFILE>) {
        /^(\S+)\s+(\S+)$/;
        $high{$1} = $2;
    }
    close(JOINFILE);
}

# brag time

print STDERR "NUEXPIRE.PL $version by Roy M. Silvernail\n";
print STDERR "referencing $user_dir/$join_file/join to delete read articles\n"
    if ($join_file);
print STDERR "default expiry age is $expire_time day(s)\n" unless
    $join_file || $stats;
print STDERR "compiling newsgroup statistics\n" if $stats;
print STDERR "expiring articles graded $expire_grade and below\n"
    if $expire_grade > 1;
printf STDERR "debug mode %d - no files will be deleted\n",$debug if $debug;
print STDERR "logging deleted articles to $log_file\n" if $log_file;
printf STDERR "ignoring %s\n",join(', ',@exclude) if @exclude;
print STDERR "nuke option selected\n" if $nuke;
print STDERR "statistics mode\n" if $stats;

# massage the exclusions... (after we've shown them to the user)
# they get used as regexps later on.

if (defined(@exclude)) {
    for $t (@exclude) {
        next if ($t =~ s/\.$/\$/);
        $t =~ s/$/.*/;
    }
}

if ($log_file) {
    eval "open(LOGFILE, \">>$log_file\") || die" unless $debug;
    undef $log_file if $@ || $debug;
}

&confirm() if $nuke == 1;

exit 0 if $debug == 5;

if($debug == 99) {
    while(<DATA>) {
        print;
    }
    exit 0;
}

select(STDOUT);

for $forum (@forums) {
    undef $def_exp;
    open(USENET,"$forum") || die("can't find $forum file");
    if ($debug == 4) {
        while (<USENET>) {
            next if /^#/ || /^$/ || /^DEF/;
            print if /grade/;
        }
        next;
    }
    while (<USENET>) {
        next if /^#/ || /^$/;
        if (/^DEFAULT/) {
            if (/\/dir=(\S+)/) {
                $news_root = &fixpath($1);
                $news_root =~ s/\"//g;
            }
            $def_exp = $1 if (/\/expire=(\S+)/);
        } else {
            next if /^#/ || /^$/;
            print if $debug;
            next if /\/junk/;
            /\s*(\S+)/;
            $thisgroup = $1;
            print "skipping $thisgroup\n", next if
                ($debug && grep($thisgroup =~ /$_/,@exclude));
            next if (!$nuke && grep($thisgroup =~ /$_/,@exclude));
            $thisdir = &fixpath($news_root ."/".$thisgroup);
            $thisdir = &fixpath($1) if (/\/dir=(\S+)/);
            print "$thisdir\n" if $debug == 2;
            next if $@;
            next if /\/junk/;
            $exp = /\/expire=(\S+)/ ? $1 : ($def_exp ? $def_exp : $expire_time);
            next if ($exp =~ /no|never|^0/i && !$nuke);
            next if ($exp =~ /grade\s*(\S+)/i && $1 > $expire_grade && !$nuke);

# This is faster if we chdir.  (thanks, Bill!)

            print "chdir($thisdir);\n" if $debug;
            eval "chdir(\$thisdir) || die(\"can't chdir $thisdir\")";
            eval "opendir(DIR,\".\") || die(\"can't open dir $thisdir\")";
            (print STDERR $@, next) if $@;
            @dtemp = grep(-f "$thisdir/$_", readdir(DIR));
            closedir(DIR);
            $dhigh = &max(@dtemp);

            $dlow = &min(@dtemp);

            if ($stats) {
                $count=scalar(@dtemp);
                $days= -M "$dlow";
                $size=0; grep($size+= -s "$_",@dtemp);
                $size=int($size/1024);
                $kperday=$days ? $size/$days : 0;
                $artperday=$days ? $count/$days : 0;
                printf("%6d %4d %7.2f %4dK %7.2fK/d %7.2fa/d %s\n",
                $dhigh,$count,$days,$size,$kperday,$artperday,$thisgroup);
                next;
            }

            foreach $f (@dtemp) {
                $tf = "$thisdir/$f";
                if ($f == $dhigh) {
                    if ($nuke) {
                        if ($debug) {
                            print "T: $tf\n";
                        } else {
                            open(I,">$f");
                            close(I);
                        }
                    } else {
                        next;
                    }
                } elsif ($nuke) {
                    $debug ? (print "D: $tf\n") : unlink($f);
                    print LOGFILE "$tf\n" if $log_file;
                } elsif ($join_file) {
                    if ($debug) {
                        print "unlink: $tf\n" unless $f > $high{$thisgroup};
                    } else {
                        if ($f <= $high{$thisgroup}) {
                            unlink($f);
                            print LOGFILE "$tf\n" if $log_file;
                        }
                    }
                } else {
                    if ($debug) {
                        print "unlink: $tf\n" unless (-M $f) < $exp;
                    } else {
                        if ((-M $f) >= $exp) {
                            unlink($f);
                            print LOGFILE "$tf\n" if $log_file;
                        }
                    }
                }
            }
        }
    }
    close(USENET);
}
close(LOGFILE) if $log_file;

exit 0;


sub confirm {
    local($warning) = "\033".'[0;1;5;31mWARNING!'."\033".'[0;1;37m';
    print STDERR <<END_OF_PRINT;

$warning  You have selected the nuke option.  This option will remove
ALL news on your spool, and replace the largest-numbered articles with
0-byte files.  Nothing is sacred!  This command overrides everything
else on the command line.  This will free up the maximum amount of disk
space.

Are you really sure you want to do this?

If so, type "YES", without the quotation marks.  ANYthing else aborts.

END_OF_PRINT

    $response = <STDIN>;
    chop($response);

    if ($response ne 'YES') {
        print STDERR "Aborting!\n";
        exit 1;
    }
    print STDERR "Accepted... now expiring all news.\n";
}
__END__

Debug values:

These are largely undocumented.  The -d flag takes a numeric argument.
The values implemented are shown below --

2   After forum file descriptor line, print the actual directory name,
    as passed back by &fixpath().

4   list only newsgroup lines from the USENET file that have an expire
    group level assigned.

5   exit program after sign-on banner.  this will exit after the -nuke
    option warning.  also shows the contents of some stuff read from the
    static file.

99  print this summary.