home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / NEXP20.ZIP / NUEXPIRE.PL next >
Encoding:
Text File  |  1992-11-17  |  11.6 KB  |  356 lines
  1. # NUEXPIRE.PL by Roy M. Silvernail
  2. # A Waffle BBS maintainence utility (designed for MS-DOS systems)
  3. # This program is released into the public domain
  4. #
  5. # Please refer to the file NUREAD.ME for installing and using NUEXPIRE
  6. #
  7. # Presented without warranty.  Bug reports, thank-you notes, bequests,
  8. # etc. to roy%cybrspc@cs.umn.edu
  9. #
  10. # 10/26/91
  11. #
  12. # Version 1.1 10/27/91
  13. # Fixed bug in graded expire that would never expire groups graded with
  14. # a value that included a 0.
  15. #
  16. # Version 1.2 11/24/91
  17. # Added option to append a logfile with names of all expired articles.
  18. # This option has no effect in debug mode, although the logfile name
  19. # will be printed with other option information.
  20. #
  21. # Version 1.3 12/10/91
  22. # Added -x option to protect certain groups from expiry.
  23. # Use '-x group.name group.name'.  List may be followed by other args.
  24. # NUEXPIRE now skips comment lines and blank lines in the usenet file.
  25. #
  26. # Version 1.4 2/2/92
  27. # Logfile used to leave 0-byte files laying about.  Fixed.
  28. #
  29. # Version 1.5  2/26/92
  30. # Added -nuke option to remove all news in the spool except local groups...
  31. # but you must prove that you _really_ want to!
  32. #
  33. # Version 1.6  4/19/92
  34. # Added support for multiple forum description files.
  35. #
  36. # Version 1.7  4/26/92
  37. # Tewaked some areas.  NUEXPIRE now requires Perl 4.0 to run.
  38. # Added default /expire flags in DEFAULT lines.
  39. # Added a little documentation of the debug flags.  Try 'nuexpire -d99'.
  40. # The logfile works properly now, instead of logging every article
  41. # considered.
  42. #
  43. # Version 1.8  5/10/92
  44. # Added "-s" to just display statistics of how long each group is kept.
  45. # The static file parsing now allows lines of the form 'flag:option' (with
  46. # no whitespace).
  47. # The 'local' forum file is not processed.
  48. # (changes courtesy of Bill Fenner, to whom I tip my hat!)
  49. #
  50. # Version 2.0   11/15/92
  51. # The 'ignore newsgroups' option now works more intuitively.  To protect
  52. # only alt.bbs, use '-x alt.bbs.'.  To protect alt.bbs and everything
  53. # underneath of it, use '-x alt.bbs' with no trailing period.
  54. # More of Bill Fenner's suggestions incorporated.  NUEXPIRE now does a
  55. # chdir() to each directory to improve stat performance.  NUEXPIRE now
  56. # handles filenames with leading -, since it stats each file instead of
  57. # relying on a filename.  But the leading dash will still play havoc with
  58. # expiry by join file.  The only real solution is to upgrade to 1.65
  59. # Waffle or trim your newsgroups before they exceed 32,767.
  60. # Added -autonuke to do a full nuke unconditionally from the command line.
  61. # This is potentially dangerous, so apply with care.
  62. #
  63.  
  64. $version = "V2.0";
  65. select (STDOUT); $| = 1;
  66. select((select (STDERR), $| = 1)[$[]);
  67.  
  68. sub max { local ($v) = (shift @_); grep(($_ > $v) && ($v = $_),@_); $v; }
  69. sub min { local ($v) = (shift @_); grep(($_ < $v) && ($v = $_),@_); $v; }
  70.  
  71.  
  72.  
  73. # if you _must_ run perl 3.0.41, use this fixpath
  74. # sub fixpath {
  75. # join('/',grep((y/A-Z/a-z/,s/(.*)/substr($1,0,8)/e),split(/[\/\\\.]/,shift(@_))));
  76. # }
  77.  
  78.  
  79. sub fixpath {
  80. join('/',grep(s/(.*)/substr("\L$1",0,8)/e,split(/[\/\\\.]/,shift(@_))));
  81. }
  82.  
  83.  
  84. sub usage {
  85.     print STDERR <<END_OF_PRINT;
  86.  
  87. NUEXPIRE.PL $version by Roy M. Silvernail
  88. usage: nuexpire <-t n|-u name|-s> [-g n][-d][-l filename][-x group [group...]]
  89.                 [-nuke][-autonuke]
  90.        -t: expire older than n days
  91.        -u: expire read articles from user/join
  92.        -s: STATS mode -- print age in days of oldest art,
  93.            don't do any expiration
  94.        -g: expire only articles graded n and below
  95.        -d: debug mode; print commands to STDOUT
  96.        -l: append log of deleted articles to filename
  97.        -x: exclude this group from expiry
  98.        -nuke: removes ALL news!
  99.        -autonuke: removes ALL news and doesn't ask first!
  100.        one of -s, -t or -u must be specified, but only one
  101.  
  102. END_OF_PRINT
  103.  
  104.     exit 1;
  105. }
  106.  
  107.  
  108. # parse some args, eh?
  109.  
  110. $args = join(' ',@ARGV);
  111. $nuke = ($args =~ /-nuke/) ? 1 : 0;
  112. $nuke = ($args =~ /-autonuke/) ? 2 : 0;
  113. $expire_time = ($args =~ /-t\s*(\S+)/) ? $1 : 1;     # default to 1
  114. $expire_grade = ($args =~ /-g\s*(\S+)/) ? $1 : 1;    # default to 1
  115. $join_file = $1 if $args =~ /-u\s*(\S+)/;
  116. $debug = ($args =~ /-d/) ? 1 : 0;        # explicitly set 0 if no debug
  117. $debug = $1 if ($args =~ /-d\s*(\d+)/);
  118. $log_file = ($args =~ /-l\s*(\S+)/) ? $1 : 0;
  119. $log_file = &fixpath($log_file) if $log_file;
  120. @exclude = split(' ',$1) if $args =~ /-x\s*(.*)\s-/ || $args =~ /-x\s*(.*)/;
  121. $stats++ if $args =~ /-s/;
  122. &usage() if $args =~ /-h/ || $args =~ /-\?/;
  123. &usage() if scalar(grep(/-t/||/-u/||/-s/,@ARGV)) != 1 && !$nuke;
  124. &usage() unless $args =~ /-t/ || $args =~ /-u/ || $args =~ /-s/ ||
  125.     $nuke || $debug;
  126.  
  127.  
  128.  
  129. # first, let's find out some things...
  130.  
  131. open(INFILE,$ENV{"WAFFLE"}) || die("Can't find static file");
  132.  
  133. @forums=("usenet");
  134.  
  135. while (<INFILE>) {
  136.     $waffle_dir = &fixpath($1) if /^waffle\s*:\s*(\S+)$/;
  137.     $user_dir = &fixpath($1) if /^user\s*:\s*(\S+)$/;
  138.     @forums = grep($_ ne "local",split(/[ \t]+/,$1)) if /^forums\s*:\s*(.+)$/;
  139. }
  140. close(INFILE);
  141.  
  142. # Qualify forum file paths:
  143. grep(s|^|$waffle_dir/system/|,@forums);
  144.  
  145. if ($debug==5) {
  146.     print "$waffle_dir\n$user_dir\n";
  147.     print join("\n",@forums)."\n";
  148. }
  149.  
  150. # now we know where things are....
  151.  
  152. if ($join_file) {
  153.     print "$user_dir/$join_file/join\n" if $debug;
  154.     open(JOINFILE,"$user_dir/$join_file/join") || die("no join");
  155.     while (<JOINFILE>) {
  156.         /^(\S+)\s+(\S+)$/;
  157.         $high{$1} = $2;
  158.     }
  159.     close(JOINFILE);
  160. }
  161.  
  162. # brag time
  163.  
  164. print STDERR "NUEXPIRE.PL $version by Roy M. Silvernail\n";
  165. print STDERR "referencing $user_dir/$join_file/join to delete read articles\n"
  166.     if ($join_file);
  167. print STDERR "default expiry age is $expire_time day(s)\n" unless
  168.     $join_file || $stats;
  169. print STDERR "compiling newsgroup statistics\n" if $stats;
  170. print STDERR "expiring articles graded $expire_grade and below\n"
  171.     if $expire_grade > 1;
  172. printf STDERR "debug mode %d - no files will be deleted\n",$debug if $debug;
  173. print STDERR "logging deleted articles to $log_file\n" if $log_file;
  174. printf STDERR "ignoring %s\n",join(', ',@exclude) if @exclude;
  175. print STDERR "nuke option selected\n" if $nuke;
  176. print STDERR "statistics mode\n" if $stats;
  177.  
  178. # massage the exclusions... (after we've shown them to the user)
  179. # they get used as regexps later on.
  180.  
  181. if (defined(@exclude)) {
  182.     for $t (@exclude) {
  183.         next if ($t =~ s/\.$/\$/);
  184.         $t =~ s/$/.*/;
  185.     }
  186. }
  187.  
  188. if ($log_file) {
  189.     eval "open(LOGFILE, \">>$log_file\") || die" unless $debug;
  190.     undef $log_file if $@ || $debug;
  191. }
  192.  
  193. &confirm() if $nuke == 1;
  194.  
  195. exit 0 if $debug == 5;
  196.  
  197. if($debug == 99) {
  198.     while(<DATA>) {
  199.         print;
  200.     }
  201.     exit 0;
  202. }
  203.  
  204. select(STDOUT);
  205.  
  206. for $forum (@forums) {
  207.     undef $def_exp;
  208.     open(USENET,"$forum") || die("can't find $forum file");
  209.     if ($debug == 4) {
  210.         while (<USENET>) {
  211.             next if /^#/ || /^$/ || /^DEF/;
  212.             print if /grade/;
  213.         }
  214.         next;
  215.     }
  216.     while (<USENET>) {
  217.         next if /^#/ || /^$/;
  218.         if (/^DEFAULT/) {
  219.             if (/\/dir=(\S+)/) {
  220.                 $news_root = &fixpath($1);
  221.                 $news_root =~ s/\"//g;
  222.             }
  223.             $def_exp = $1 if (/\/expire=(\S+)/);
  224.         } else {
  225.             next if /^#/ || /^$/;
  226.             print if $debug;
  227.             next if /\/junk/;
  228.             /\s*(\S+)/;
  229.             $thisgroup = $1;
  230.             print "skipping $thisgroup\n", next if
  231.                 ($debug && grep($thisgroup =~ /$_/,@exclude));
  232.             next if (!$nuke && grep($thisgroup =~ /$_/,@exclude));
  233.             $thisdir = &fixpath($news_root ."/".$thisgroup);
  234.             $thisdir = &fixpath($1) if (/\/dir=(\S+)/);
  235.             print "$thisdir\n" if $debug == 2;
  236.             next if $@;
  237.             next if /\/junk/;
  238.             $exp = /\/expire=(\S+)/ ? $1 : ($def_exp ? $def_exp : $expire_time);
  239.             next if ($exp =~ /no|never|^0/i && !$nuke);
  240.             next if ($exp =~ /grade\s*(\S+)/i && $1 > $expire_grade && !$nuke);
  241.  
  242. # This is faster if we chdir.  (thanks, Bill!)
  243.  
  244.             print "chdir($thisdir);\n" if $debug;
  245.             eval "chdir(\$thisdir) || die(\"can't chdir $thisdir\")";
  246.             eval "opendir(DIR,\".\") || die(\"can't open dir $thisdir\")";
  247.             (print STDERR $@, next) if $@;
  248.             @dtemp = grep(-f "$thisdir/$_", readdir(DIR));
  249.             closedir(DIR);
  250.             $dhigh = &max(@dtemp);
  251.  
  252.             $dlow = &min(@dtemp);
  253.  
  254.             if ($stats) {
  255.                 $count=scalar(@dtemp);
  256.                 $days= -M "$dlow";
  257.                 $size=0; grep($size+= -s "$_",@dtemp);
  258.                 $size=int($size/1024);
  259.                 $kperday=$days ? $size/$days : 0;
  260.                 $artperday=$days ? $count/$days : 0;
  261.                 printf("%6d %4d %7.2f %4dK %7.2fK/d %7.2fa/d %s\n",
  262.                 $dhigh,$count,$days,$size,$kperday,$artperday,$thisgroup);
  263.                 next;
  264.             }
  265.  
  266.             foreach $f (@dtemp) {
  267.                 $tf = "$thisdir/$f";
  268.                 if ($f == $dhigh) {
  269.                     if ($nuke) {
  270.                         if ($debug) {
  271.                             print "T: $tf\n";
  272.                         } else {
  273.                             open(I,">$f");
  274.                             close(I);
  275.                         }
  276.                     } else {
  277.                         next;
  278.                     }
  279.                 } elsif ($nuke) {
  280.                     $debug ? (print "D: $tf\n") : unlink($f);
  281.                     print LOGFILE "$tf\n" if $log_file;
  282.                 } elsif ($join_file) {
  283.                     if ($debug) {
  284.                         print "unlink: $tf\n" unless $f > $high{$thisgroup};
  285.                     } else {
  286.                         if ($f <= $high{$thisgroup}) {
  287.                             unlink($f);
  288.                             print LOGFILE "$tf\n" if $log_file;
  289.                         }
  290.                     }
  291.                 } else {
  292.                     if ($debug) {
  293.                         print "unlink: $tf\n" unless (-M $f) < $exp;
  294.                     } else {
  295.                         if ((-M $f) >= $exp) {
  296.                             unlink($f);
  297.                             print LOGFILE "$tf\n" if $log_file;
  298.                         }
  299.                     }
  300.                 }
  301.             }
  302.         }
  303.     }
  304.     close(USENET);
  305. }
  306. close(LOGFILE) if $log_file;
  307.  
  308. exit 0;
  309.  
  310.  
  311. sub confirm {
  312.     local($warning) = "\033".'[0;1;5;31mWARNING!'."\033".'[0;1;37m';
  313.     print STDERR <<END_OF_PRINT;
  314.  
  315. $warning  You have selected the nuke option.  This option will remove
  316. ALL news on your spool, and replace the largest-numbered articles with
  317. 0-byte files.  Nothing is sacred!  This command overrides everything
  318. else on the command line.  This will free up the maximum amount of disk
  319. space.
  320.  
  321. Are you really sure you want to do this?
  322.  
  323. If so, type "YES", without the quotation marks.  ANYthing else aborts.
  324.  
  325. END_OF_PRINT
  326.  
  327.     $response = <STDIN>;
  328.     chop($response);
  329.  
  330.     if ($response ne 'YES') {
  331.         print STDERR "Aborting!\n";
  332.         exit 1;
  333.     }
  334.     print STDERR "Accepted... now expiring all news.\n";
  335. }
  336. __END__
  337.  
  338. Debug values:
  339.  
  340. These are largely undocumented.  The -d flag takes a numeric argument.
  341. The values implemented are shown below --
  342.  
  343. 2   After forum file descriptor line, print the actual directory name,
  344.     as passed back by &fixpath().
  345.  
  346. 4   list only newsgroup lines from the USENET file that have an expire
  347.     group level assigned.
  348.  
  349. 5   exit program after sign-on banner.  this will exit after the -nuke
  350.     option warning.  also shows the contents of some stuff read from the
  351.     static file.
  352.  
  353. 99  print this summary.
  354.  
  355.  
  356.