#!/usr/bin/perl -w
###
### $Id: newsyslog.pl,v 1.11 2006/01/08 23:27:35 aaronsca Exp $
###
###  Maintain log files to manageable sizes.  This is a Perl rewrite of the 
###  MIT newsyslog utility, with a number of features and ideas taken from 
###  the FreeBSD and NetBSD versions.
###
###  Copyright (s) 2001-2006 Aaron Scarisbrick <aaronsca@cpan.org>
###  All rights reserved.
###
###  Copyright (c) 1999, 2000 Andrew Doran <ad@NetBSD.org>
###  All rights reserved.
###
###  Redistribution and use in source and binary forms, with or without
###  modification, are permitted provided that the following conditions
###  are met:
###  1. Redistributions of source code must retain the above copyright
###     notice, this list of conditions and the following disclaimer.
###  2. Redistributions in binary form must reproduce the above copyright
###     notice, this list of conditions and the following disclaimer in the
###     documentation and/or other materials provided with the distribution.
###
###  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
###  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
###  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
###  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
###  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
###  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
###  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
###  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
###  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
###  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
###  SUCH DAMAGE.
###
###  This file contains changes from the Open Software Foundation.
###
###  Copyright 1988, 1989 Massachusetts Institute of Technology
###
###  Permission to use, copy, modify, and distribute this software
###  and its documentation for any purpose and without fee is
###  hereby granted, provided that the above copyright notice
###  appear in all copies and that both that copyright notice and
###  this permission notice appear in supporting documentation,
###  and that the names of M.I.T. and the M.I.T. S.I.P.B. not be
###  used in advertising or publicity pertaining to distribution
###  of the software without specific, written prior permission.
###  M.I.T. and the M.I.T. S.I.P.B. make no representations about
###  the suitability of this software for any purpose.  It is
###  provided "as is" without express or implied warranty.
###

require 5.00503;				## - Minimum version of perl

use strict;					## - Enforce strict syntax
use Config;					## - Get usable signals
use FileHandle;					## - Filehandle object methods 
use File::Basename;				## - Pathname parsing 
use File::Copy;					## - Perl equiv of "cp" and "mv"
use Time::Local;				## - Opposite of localtime()

my($DEBUG)	= 0;				## - Debug mode (-d)
my($VERBOSE)	= 0;				## - Verbose mode (-v)
my($NOOP)	= 0;				## - No op mode (-n)
my($NOSIG)	= 0;				## - No signal daemon mode (-s)
my($ROOT)	= 0;				## - Run as non-root flag (-r)
my($FORCE)	= 0;				## - Forced log trim flag (-F)
my($min_pid)	= 5;				## - Minimum PID to signal
my(@conf)	= ();				## - Array of config entries
my(%pidm)	= ();				## - PID map
my(%sigs)	= ();				## - Array of supported signals
my(%elist)	= ();				## - Explicit hash of logfiles
my($arch_d)	= "";				## - Archive directory (-a)
my($conf_f)	= "/etc/newsyslog.conf";	## - Configuration file
my($pid_f)	= "/var/run/syslog.pid";	## - Syslog PID file
my($gzip_b)	= "gzip";			## - gzip binary
my($gzip_a)	= "-f";				## - gzip argument
my($bzip2_b)	= "bzip2";			## - bzip2 binary
my($bzip2_a)	= "-f";				## - bzip2 argument
my($pid)	= "";				## - PID iterator for wait()
my($sig_wait)	= 10;				## - Wait time in sec after kill
my($hour_s)	= 3600;				## - Hour in seconds
my($day_s)	= 86400;			## - Day in seconds
my($week_s)	= 604800;			## - Week in seconds
my($time)	= time;				## - Get current time
my($ltime)	= scalar(localtime($time));	## - Current readable time
my(@ltm)	= localtime($time);		## - Parse epoch time into array
$ltm[9]		= $ltm[5] + 1900;		## - Set long year
$ltm[10]	= substr($ltm[9], 0, 2);	## - Set century
$ltm[11]	= substr($ltm[9], 2, 2);	## - Set year

grep($sigs{$_}=1, split(/ /,$Config{sig_num}));	## - Get supported signals
STDERR->autoflush(1); STDOUT->autoflush(1);	## - Set STDOUT/ERR to autoflush
$0 =~ s/^.*\///;				## - Strip dirname from $0

sub usage {
###
### -- Display usage

  if ($_ = shift) {
    print STDERR "${0}: $_\n";
  }
  print STDERR "Usage: ${0} [-Fdnrsv] [-f config-file] [-a directory] ",
               "[-z path_to_gzip] [ -j path_to_bzip2] [-p path_to_pid]\n",
	       "\nFor more help: perldoc $0\n\n";
  exit(1);
}

sub error {
###
### -- Display error message, and optionally exit

  my($mesg)	= shift || $!;			## - Error message
  my($exit)	= shift || 0;			## - Exit level

  print STDERR "${0}: ${mesg}\n";
  exit($exit) if $exit > 0;
}

sub debug {
###
### -- Display debug messages if $DEBUG is true

  my($msg)	= shift || $!;			## - Debug message
  my($trc)	= '';				## - Stack backtrace

  return unless $DEBUG;

  my(@c, @s)	= ();				## - Caller stacks
  my($f, $l)	= '';				## - File and line num
  my($i)	= 0;

  while (@c = caller($i)) {			## - Backtrace stack
    unshift(@s, $c[3]) if $i > 0;
    $f = $c[1]; $l= $c[2]; $i++;
  }
  $trc	= join(' ', $$, $f, 'line', $l, '>',	## - pretty print backtrace
    scalar(@s) ? join(' > ', @s) : (),
  );
  print STDERR "${trc}: ${msg}\n";
}

sub parse_argv {
###
### -- Parse command line arguments

  while($_ = shift(@ARGV)){
    last if $_ eq "--";				## - Explicit last arg "--"
    &usage() if $_ eq "--help";			## - Standard usage arg
    unless($_ =~ s/^\-//o) {			## - All others start with "-"
      unshift(@ARGV, $_);
      last;
    }
    if (length > 1) {				## - Ugly multi-arg kludge
      foreach(reverse(split(//))){
	unshift(@ARGV, "-${_}");
      }
      next;
    }
    $DEBUG	= 1, next if $_ eq "d";		## - Debug mode
    $FORCE	= 1, next if $_ eq "F";		## - Forced archive mode
    $NOOP	= 1, next if $_ eq "n";		## - No op mode
    $NOSIG	= 1, next if $_ eq "s";		## - No signal daemon mode
    $ROOT	= 1, next if $_ eq "r";		## - Non-root mode
    $VERBOSE	= 1, next if $_ eq "v";		## - Verbose mode

    if ($_ eq "f") {				## - Explicit configuration file
      $conf_f	= shift(@ARGV) || &usage("option requires an argument -- ${_}");
      next;
    }
    if ($_ eq "a") {				## - Exclicit archive directory
      $arch_d	= shift(@ARGV) || &usage("option requires an argument -- ${_}");
      next;
    }
    if ($_ eq "z") {				## - Explicit gzip path
      $gzip_b	= shift(@ARGV) || &usage("option requires an argument -- ${_}");
      next if -x ${gzip_b};
      &error("${gzip_b}: not executable or missing path", 1)
    }
    if ($_ eq "j") {				## - Explicit bzip2 path
      $bzip2_b	= shift(@ARGV) || &usage("option requires an argument -- ${_}");
      next if -x ${bzip2_b};
      &error("${bzip2_b}: not executable or missing path", 1)
    }
    if ($_ eq "p") {				## - Explicit syslog.pid path
      $pid_f	= shift(@ARGV) || &usage("option requires an argument -- ${_}");
      unless(-r $pid_f && -s $pid_f){
	&error("${pid_f}: no such file or zero size", 1);
      }
      next;
    }
    &usage("illegal option -- ${_}");
  }
  while($_ = shift(@ARGV)){			## - Explicit logs to archive
    $elist{$_}	= 1;
    &debug("explicit: $_");
  }
  unless($> == 0 || $ROOT) {			## - Must be root unless "-r"
    &error("must have root privs", 1);
  }
  unless($conf_f eq "-" || -r $conf_f){		## - Conf file sanity check
    &error("${conf_f}: unreadable", 1);
  }
}

sub parse_conf {
###
### -- Parse configuration file

  my($fh)	= new FileHandle $conf_f;	## - Config filehandle

  unless(defined($fh)){				## - Open configuration file
    &error("open: ${conf_f}: $!", 1);
  }
  while(<$fh>){					## - Get fields
    next if /^\s*(#.*)?$/o;			## - Skip comments
    chomp;					## - Strip trailing garbage
    my($ent)	= &parse_ent($_);		## - Parse entry
    next unless defined($ent->{log});		## - Skip blank entries

    push(@conf, $ent);				## - Add entry to global array
    if ($DEBUG) {				## - Dump record in debug mode
      foreach(sort {$a cmp $b} (keys %$ent)) {
	if ($_ eq "mod") {
	  my($mod) = sprintf("%o", $ent->{$_});
	  &debug("[$.]: mod -> $mod");
	}
	else {
	  &debug("[$.]: ${_} -> $ent->{$_}");
	}
      }
      &debug("----");				## - Debug record seperator
    }
  }
  $fh->close;
}

sub parse_ent {
###
### -- Parse a configuration entry

  my(@l)	= split;			## - Tokenize line
  my($ent)	= {};				## - Configuration entry

  if ($#l < 4) {				## - Token sanity check
    &error("missing fields on line $.",1);
  }
  if ($l[0] !~ /^\//o) {			## - Sanity check logfile
    &error("illegal filename field on line $.",1);
  }
  if (%elist && !defined($elist{$l[0]})) {	## - Explicit logfile check 
    &debug("skipping: $l[0]");
    return $ent;
  }
  $ent->{log} = $l[0];				## - Get logfile NAME
  $ent->{own} = $ent->{grp} = -1;		## - Default own/grp for chown()

  if ($l[1] =~ /^[0-7]{3}$/o) {			## - Get MODE
    $ent->{mod} = oct($l[1]);
  }
  elsif ($l[1] =~ /^(\w+)?:(\w+)?$/o) {		## - Get OWNER/GROUP
    if (defined($1)) {
      $ent->{own} = getpwnam($1);
      unless(defined($ent->{own})){
	&error("unknown user on line $. -- $1",1);
      }
    }
    if (defined($2)) {
      $ent->{grp} = getgrnam($2);
      unless(defined($ent->{grp})){
	&error("unknown group on line $. -- $2",1);
      }
    }
    if ($l[2] =~ /^[0-7]{3}$/o) {
      $ent->{mod} = oct($l[2]);
      shift(@l);
    }
    else {
      &error("illegal mode on line $. -- $l[2]",1)
    }
  }
  else {
    &error("illegal owner/mode on line $. -- $l[1]",1);
  }
  if ($l[2] =~ /^\d+$/o && $l[2] >= 0) {	## - Get COUNT
    $ent->{ct}	= $l[2];
  }
  else {
    &error("illegal count on line $. -- $l[2]",1);
  }
  if ($l[3] eq "*") {				## - Get SIZE
    $ent->{sz}	= 0;
  }
  elsif ($l[3] =~ /^\d+$/o && $l[3] > 0 && $l[3] < $time) {
    $ent->{sz} = $l[3];
  }
  else {
    &error("illegal size on line $. -- $l[3]",1);
  }
  unless(defined($l[4])){			## - Get WHEN
    &error("missing when field on line $.",1);
  }
  if ($l[4] eq "*") {
    $ent->{when}	= 0;
  }
  elsif ($l[4] =~ /^(\d+)?@(.*)$/o) {		## - Interval/ISO-8601
    $ent->{when} = &parse_8601($2);
    if ($ent->{when} == -1) {
      &error("illegal ISO-8601 date format on line $. -- $l[4]",1);
    }
    $ent->{intr} = $1 if defined($1);
  }
  elsif ($l[4] =~ /^(\d+)?\$(.+)$/o) {		## - Interval/DWMT
    $ent->{when} = &parse_dwmt($2);
    if ($ent->{when} == -1) {
      &error("illegal DWM date format on line $. -- $l[4]",1);
    }
    $ent->{intr} = $1 if defined($1);
  }
  elsif ($l[4] =~ /^\d+$/o) {			## - Interval only
    $ent->{intr}	= $l[4];
  }
  else {
    &error("illegal when field on line $. -- $l[4]",1);
  }
  if (defined($ent->{intr})) {			## - Sanity check interval
    if ($ent->{intr} <= 0) {
      &error("illegal interval on line $. -- $ent->{intr}",1);
    }
  }
  else {
    $ent->{intr}	= 0;
  }
  return $ent unless defined($l[5]);		## - Get FLAGS
  &parse_flags($ent, $l[5]);

  return $ent unless defined($l[6]);		## - Get PID_F/EXT
  unless($l[6] =~ /^\//o){
    &error("bad pid/exe field on line $. -- $l[6]",1);
  }
  if (defined($ent->{exe})) {
    unless(-x $l[6]){
      &error("ext not executable on line $. -- $l[6]",1);
    }
    $ent->{exe}	= $l[6];
    if (defined($l[7])) {
      &error("sig_num not allowed with ext on line $.",1);
    }
  }
  else {
    $ent->{pid}	= $l[6];
  }
  return $ent unless defined($l[7]);		## - Get SIG_NUM
  unless(defined($sigs{$l[7]})){
    &error("bad sig_num on line $. -- $l[7]",1);
  }
  unless(defined($ent->{sig})){
    $ent->{sig}	= $l[7];
  }
  $ent;						## - Return parsed entry
}

sub parse_flags {
###
### -- Parse configuration entry flags

  my($ent, $f)	= @_;				## - Config entry and flags
  my(@flag)	= split(//, $f);

  foreach(@flag){
    last if $_ eq "-";				## - Flag placeholder
    $_		= uc($_);			## - Force uppercase
    $ent->{flag} .= $_;				## - Save flags

    $ent->{bin} = 1,	  next if $_ eq "B";	## - Binary file
    $ent->{zip} = ".gz",  next if $_ eq "Z";	## - Compress logfile with gzip
    $ent->{bz2} = ".bz2", next if $_ eq "J";	## - Compress logfile with bzip2
    $ent->{exe} = 1,	  next if $_ eq "X";	## - Execute external program
    $ent->{hst} = 1,	  next if $_ eq "P";	## - Preserve first hist logfile
    $ent->{mak} = 1,	  next if $_ eq "C";	## - Create logfile if missing
    $ent->{sig} = 0,	  next if $_ eq "S";	## - Don't send daemon signal
    $ent->{trn} = 1,	  next if $_ eq "T";	## - Truncate instead of rename

    &error("illegal flag on line $. -- $_",1);
  }
  if (defined($ent->{zip}) && defined($ent->{bz2})) {
    &error("J and Z flags mutually exclusive on line $.",1);
  }
}

sub parse_8601 {
###
### -- Parse ISO 8601 time format into epoch time format

  my($date)	= shift;			## - ISO 8601 Date in
  my($yy)	= $ltm[11];			## - Year
  my($cc)	= $ltm[10];			## - Century
  my($year)	= $ltm[9];			## - Long year
  my($mm)	= $ltm[4];			## - Month
  my($dd)	= $ltm[3];			## - Day
  my($epoch)	= 0;				## - Return value
  my($h)	= 0;				## - Hour
  my($m)	= 0;				## - Minutes
  my($s)	= 0;				## - Seconds
  my(@tmp)	= ();				## - Temp array holder
  my($str)	= ();				## - Temp string holder

  if ($date =~ /^(\d{2,8})?(T(\d{2,6})?)?$/o) {
    if (defined($1)) {				## - Left side of "T"
      @tmp	= ();
      $str	= $1;
      while($_	= substr($str, 0, 2, "")){
	unshift(@tmp, $_);
      }
      if (defined($tmp[0])) {$dd = $tmp[0]}
      if (defined($tmp[1])) {$mm = $tmp[1] - 1}
      if (defined($tmp[2])) {$yy = $tmp[2]}
      if (defined($tmp[3])) {$cc = $tmp[3]}
    }
    if (defined($3)) {				## - Right side of "T"
      @tmp	= ();
      $str	= $3;
      while($_	= substr($str, 0, 2, "")){
	push(@tmp, $_);
      }
      if (defined($tmp[0])) {$h = $tmp[0]}
      if (defined($tmp[1])) {$m = $tmp[1]}
      if (defined($tmp[2])) {$s = $tmp[2]}
    }
  }
  else {					## - Bad 8601 date format
    return -1;
  }
  if (&tm_verify($s, $m, $h, $dd, $mm, $cc . $yy)) {
    $epoch	= timelocal($s, $m, $h, $dd, $mm, ($cc . $yy) - 1900);
  }
  else {					## - Invalid date
    return -1;
  }
  if ($DEBUG) {					## - Show date if debug mode
    &debug("[$.]: $date -> ". scalar(localtime($epoch)));
  }
  $epoch;					## - Return date in epoch format
}

sub parse_dwmt {
###
### -- Parse day, week and month time format

  my($date)	= shift;			## - DWM Date in
  my($year)	= $ltm[9];			## - Long year
  my($yr)	= $ltm[5];			## - Year
  my($mm)	= $ltm[4];			## - Month
  my($dd)	= $ltm[3];			## - Day of month
  my($wk)	= $ltm[6];			## - Day of week 
  my($epoch)	= 0;				## - Return value
  my($w_off)	= 0;				## - Day of week offset
  my($h)	= 0;				## - Hour of day
  my($m)	= 0;				## - Minutes
  my($s)	= 0;				## - Seconds
  my($o1, $v1)	= 0;				## - DayofWeek/DayofMonth Opt

  if ($date =~ /^(([MW])([0-9Ll]{1,2}))?((D)(\d{1,2}))?$/o) {

    $o1		= defined($2) ? $2 : undef;	## - DOW/DOM Option
    $v1		= defined($3) ? $3 : undef;	## - DOW/DOM Value
    $h		= $6 if defined($6);		## - HOD Value
  }
  else {					## - Bad DWMT date format
    return -1;
  }
  if (defined($o1) && $o1 eq "M") {
    if ($v1 =~ /^[Ll]$/o) {			## - Last day of month
      $dd	= &tm_ldm($mm, $year);
    }
    else {					## - Specific day of month
      return -1 unless $v1 =~ /^\d{1,2}$/o;
      $dd	= $v1;
    }
  }
  elsif (defined($o1) && $o1 eq "W") {		## - Specific day of week
    return -1 unless $v1 =~ /^[0-6]$/o;
    if ($v1 != $wk) {				## - Calculate DOW offset
      $w_off	=  ($v1 - $wk) * $day_s;
      if ($w_off < 0) {
	$w_off += $week_s;
      }
    }
  }
  if (&tm_verify($s, $m, $h, $dd, $mm, $year)) {
    $epoch	= timelocal($s, $m, $h, $dd, $mm, $yr) + $w_off;
  }
  else {					## - Invalid date
    return -1;
  }
  if ($DEBUG) {
    &debug("[$.]: $date -> ". scalar(localtime($epoch)));
  }
  $epoch;					## - Return date in epoch format
}

sub tm_agelog {
###
### -- Get age of last historical logfile archive in hours

  my($ent)	= shift || return -1;		## - Config entry to process
  my($log,$dir)	= fileparse($ent->{log});	## - Parse logfile path
  my($name)	= $dir;				## - Logfile full pathname

  if ($arch_d) {
    if ($arch_d =~ /^\//o) {			## - Absolute path
      $name	= $arch_d;
    }
    else {					## - Relative path
      $name	.= "${arch_d}";
    }
    unless($name =~ /\/$/o){			## - Fix trailing "/"
      $name	.= "/";
    }
  }
  $name		.= "${log}.0";
  $name		.= "$ent->{zip}" if defined($ent->{zip});
  $name		.= "$ent->{bz2}" if defined($ent->{bz2});

  unless(stat($name)) {
    return -1;
  }
  int(($time - (stat(_))[9]) / $hour_s);
}

sub tm_ldm {
###
### -- Return the last day of the month.  If the month is February and the year 
###    is evenly divisable by 4, but not evenly divisable by 100 unless it is 
###    also evenly divisable by 400, the last day of the month is 29.

  my($mm, $yr)	= @_;				## - Month and year to check
  my(@ldm)	= (31, 28, 31, 30, 31, 30, 	## - Last day of the month array
		   31, 31, 30, 31, 30, 31);

  if ($mm == 1 && $yr % 4 == 0 && ($yr % 100 != 0 || $yr % 400 == 0)) {
    return 29;
  }
  $ldm[$mm];
}

sub tm_verify {
###
### -- Verify date/time contraints 

  my(@tm)	= @_;				## - Date/time to verify
  my($ld)	= &tm_ldm($tm[4], $tm[5]);	## - Get last day of month

  return 0 if $tm[4] < 0 || $tm[0] > 11;	## - Check month
  return 0 if $tm[3] < 1 || $tm[2] > $ld;	## - Check day
  return 0 if $tm[2] < 0 || $tm[2] > 23;	## - Check hour
  return 0 if $tm[1] < 0 || $tm[1] > 59;	## - Check minutes
  return 0 if $tm[0] < 0 || $tm[0] > 59;	## - Check seconds
  1;
}

sub do_entry {
###
### -- Test whether to trim logfile

  my($ent)	= shift || return 0;		## - Config entry to process
  my($t_when)	= 0;				## - "when" test flag
  my($t_intr)	= 0;				## - "interval" test flag
  my($t_size)	= 0;				## - "size" test flag
  my($mtime)	= 0;				## - Age of logfile in hrs
  my($ret)	= 0;				## - Return value
  my($sz)	= 0;				## - Logfile size
  my($str)	= "";				## - Report string

  if ($VERBOSE || $NOOP){			## - Build string if needed
    $str = sprintf("%s <%s%s>:",
      $ent->{log},
      $ent->{ct},
      defined($ent->{flag}) ? $ent->{flag} : ""
    );
  }
  if ($VERBOSE) {
    print STDOUT "$str ";
  }
  unless(stat($ent->{log})){			## - Check that logfile exists
    if ($VERBOSE) {
      print STDOUT "does not exist.\n";
    }
    if (defined($ent->{mak})) {			## - Create if "C" flag
      &mk_log($ent);
    }
    return $ret;
  }
  $sz		= ((-s _) + 1023) >> 10;	## - Logfile size in kilobytes
  $mtime	= &tm_agelog($ent);		## - Age of first hist logfile 

  &debug("sz/${sz} KB mtime/${mtime} HRS");

  if ($ent->{when}) {				## - Test "when"
    if (
      ($time >= $ent->{when}) && (($time - $ent->{when}) <= $hour_s) && $mtime
    ) {
      if ($VERBOSE && $ent->{intr} <= 0) {
	print STDOUT "--> time is up\n";
      }
      $t_when	= 1;
    }
    elsif ($VERBOSE && $ent->{intr} == 0) {
      print STDOUT "will trim at ", scalar(localtime($ent->{when})), "\n";
      unless($ent->{sz} || $FORCE){
	return $ret;
      }
    }
  }
  if ($ent->{sz}) {				## - Test "size"
    if ($sz >= $ent->{sz}) {
      $t_size	= 1;
    }
    if ($VERBOSE) {
      printf(STDOUT "size (Kb): %d [%d] ", $sz, $ent->{sz});
    }
  }
  if ($ent->{intr}) {				## - Test "interval"
    if ($mtime >= $ent->{intr} || $mtime < 0) {
      $t_intr	= 1;
    }
    elsif ($t_when) {				## - No trim unless when && intr
      $t_when	= 0;
    }
    if ($VERBOSE) {
      printf(STDOUT " age (hr): %d [%d] ", $mtime, $ent->{intr});
    }
  }
  if ($FORCE || $t_when || $t_intr || $t_size) {
    &debug("FORCE/${FORCE} t_when/${t_when} t_intr/${t_intr} t_size/${t_size}");
    if ($VERBOSE) {
      print STDOUT "--> trimming log....\n";
    }
    elsif ($NOOP) {
      print STDOUT "$str trimming\n";
    }
    $ret	= 1;
  }
  elsif ($VERBOSE) {
    print STDOUT "--> skipping\n";
  }
  $ret;
}

sub do_trim {
###
### -- Trim a logfile

  my($ent)	= shift;			## - Config entry to process
  my($i)	= 0;				## - Increment counter
  my($suf)	= "";				## - Logfile pathname suffix
  my($log,$src)	= fileparse($ent->{log});	## - Parse logfile path
  my($dst)	= $src;				## - Destination dir

  $suf	= $ent->{zip} if defined($ent->{zip});
  $suf	= $ent->{bz2} if defined($ent->{bz2});

  if ($arch_d) {				## - Build destination dir
    if ($arch_d =~ /^\//o) {			## - Absolute path
      $dst	= $arch_d;
    }
    else {					## - Relative path
      $dst	.= "${arch_d}";
    }
    unless($dst	=~ /\/$/o){			## - Fix trailing "/"
      $dst	.= "/";
    }
  }
  unless(stat($dst) && -d _){			## - Make archive dir if needed
    &mk_dir($dst);
  }
  for($i = $ent->{ct}; $i >= 0; $i--){
    my($n)	= $i + 1;
    
    if ($i == 0 && stat("${dst}${log}.${i}")) {	## - First historical logfile
      &do_move("${dst}${log}.${i}", "${dst}${log}.${n}");
      &do_perm($ent, "${dst}${log}.${n}");
      &do_zip($ent, "${dst}${log}.${n}");
      next;
    }
    next unless stat("${dst}${log}.${i}${suf}");

    if ($i == $ent->{ct}) {			## - Last historical logfile 
      if ($NOOP) {
	print STDOUT "rm ${dst}${log}.${i}${suf}\n";
      }
      else {
	unless(unlink("${dst}${log}.${i}${suf}")){
	  &error("${dst}${log}.${i}${suf}: unlink failed",1);
	}
      }
      next;
    }						## - Other historical logfiles

    &do_move("${dst}${log}.${i}${suf}", "${dst}${log}.${n}${suf}");
    &do_perm($ent, "${dst}${log}.${n}${suf}");

  }
  if (defined($ent->{trn})) {			## - Truncate base logfile, or
    &do_trunc("${src}${log}", "${dst}${log}.0"); 
    &do_perm($ent, "${dst}${log}.0");
  }
  else {					## - Move base logfile
    &do_move("${src}${log}", "${dst}${log}.0");
    &do_perm($ent, "${dst}${log}.0");
    &mk_log($ent);
  }
  if (defined($ent->{exe})) {			## - Notify daemon
    return unless &do_exe($ent, "${dst}${log}.0");
  }
  else {
    &do_sig($ent);
  }
  unless(defined($ent->{hst})){			## - Compress logfile
    &do_zip($ent, "${dst}${log}.0");
  }
}

sub mk_dir {
###
### -- Make archive directory paths as needed

  my($path)	= shift;			## - Path to process
  my(@tmp)	= split(/\//, $path);		## - Split path into dirs
  my($perm)	= 0777;				## - Let umask do its thing
  my(@dir)	= ();				## - Built array of dirs
  my($d)	= "";				## - Increment string

  if ($path =~ /^\//o) {			## - Remove leading null
    shift(@tmp);
  }
  foreach(@tmp){				## - Build directory path array
    $d		.= "/$_";
    push(@dir, $d);
  }
  foreach(@dir){				## - Iterate through path
    next if stat($_) && -d _;			## - Skip if directory exists
    if ($NOOP) {				## - Don't make if $NOOP
      print STDOUT "mkdir: $_\n";
    }
    else {
      if (mkdir($_, $perm) && $VERBOSE) {	## - Make direcotry otherwise
	print STDOUT "mkdir: $_\n";
      }
      else {
	&error("mkdir: ${_}: $!",1);
      }
    }
  }
}

sub mk_hdr {
###
### -- format turnover message

  sprintf("%s %s[%d]: %s\n", $ltime, $0, $$, "logfile turned over");
}

sub mk_log {
###
### -- Start a new log file with the O_EXCL flag, so we don't stomp on 
###    daemons that dynamically create missing log files.  If the open
###    fails, but the log file exists, this case is assumed.

  my($ent)	= shift;			## - Config entry to process

  if ($NOOP) {
    print STDOUT "Start new log... $ent->{log}\n";
  }
  else {
    my($fh)	= new FileHandle $ent->{log}, 	## - Create log
		    O_WRONLY|O_CREAT|O_EXCL;
    unless(defined($fh)) {			## - Check failed open
      if (stat($ent->{log})) {
	&debug("$ent->{log}: already exists");
	return;
      }
      &error("$ent->{log}: create failed",1);
    }
    unless(defined($ent->{bin})) {
      print $fh &mk_hdr();			## - Write turnover message
    }
    $fh->close;					## - Close log file
  }
  &do_perm($ent, $ent->{log});			## - Set ownership and perms
}

sub do_perm {
###
### -- Set mode, owner and group of a log file

  my($ent,$log)	= @_;				## - Entry/logfile to process
  my($perm)	= "";
  my($user)	= "";

  if ($NOOP || $DEBUG) {			## - Make printable strings
    $perm	= sprintf("%o", $ent->{mod});
    $user	.= $ent->{own} >= 0 ? getpwuid($ent->{own}) : "";
    $user	.= ":";
    $user	.= $ent->{grp} >= 0 ? getgrgid($ent->{grp}) : "";
  }
  if ($NOOP) {					## - No actions if $NOOP
    print STDOUT "chmod $perm $log\n";
    if ($user ne ":") {
      print STDOUT "chown $user $log\n"
    }
  }
  else {					## - Otherwise set mod/own/grp
    unless(chmod $ent->{mod}, $log){
      &error("$log: chmod failed",1);
    }
    &debug("chmod $perm $log");

    if ($ent->{own} >= 0 || $ent->{grp} >= 0) {
      unless(chown $ent->{own}, $ent->{grp}, $log){
	&error("$log: chown failed",1);
      }


&debug("chown $user $log");
    }
  }
}

sub do_move {
###
### -- Move a file, using copy if necessary

  my($old,$new)	= @_;				## - Old and new file paths

  if ($NOOP) {
    print STDOUT "mv $old $new\n";
    return 1;
  }
  if (move($old, $new)) {
    return 1;
  }
  &error("move: $!",1);
}

sub do_trunc {
###
### -- Copy a file and truncate original

  my($old,$new)	= @_;				## - Old and new file paths
  my($fh)	= '';				## - Old file handle
  my($hdr)	= &mk_hdr();			## - Turnover message header

  if ($NOOP) {
    print STDOUT "cp $old $new\n";
    print STDOUT "truncate $old\n";
    return 1;
  }
  $fh		= new FileHandle $old, O_RDWR;	## - Filehandle to old file

  unless(defined($fh)){				## - Open old file
    &error("open: ${old}: $!", 1);
  }
  unless(copy($fh, $new)) {			## - Copy old file to new
    $fh->close; &error("cp: $!",1);
  }
  unless(seek($fh, 0, 0)) {			## - Seek to start of old file
    $fh->close; &error("seek: $!",1);
  }
  unless(print $fh $hdr) {			## - Write turnover message
    $fh->close; &error("print_hdr: $!",1);
  }
  unless(truncate($fh, length($hdr))) {		## - Truncate file
    $fh->close; &error("truncate: $!",1);
  }
  $fh->close;
}

sub do_zip {
###
### -- Compress an archive
  
  my($ent,$log)	= @_;				## - Entry/logfile to process
  my($exe_b)	= "";				## - Compress executable binary
  my($exe_a)	= "";				## - Compress executable args
  my($pid)	= "";				## - PID of spawned compress

  if (defined($ent->{zip})) {			## - Set exe/arg for gzip(1)
    $exe_b	= $gzip_b;
    $exe_a	= $gzip_a;
  }
  elsif (defined($ent->{bz2})) {		## - Set exe/arg for bzip2(1)
    $exe_b	= $bzip2_b;
    $exe_a	= $bzip2_a;
  }
  else {					## - Don't compress logfile
    return 0;					##   unless "Z" or "J" flag
  }
  if ($exe_b !~ /^\//o) {			## - Find path if not set
    foreach(split(/:/, $ENV{PATH})){
      my($name)	= "${_}/${exe_b}";
      &debug("trying: $name");
      if (stat($name) && -x _) {
	$exe_b	= $name;
	&debug("found: $name");
	last;
      }
    }
    if ($exe_b !~ /^\//o) {
      &error("${exe_b}: path not found");
      return 0;
    }
    if (-d _) {
      &error("${exe_b}: illegal path");
      return 0;
    }
  }
  if ($NOOP || $VERBOSE) {
    print STDOUT "$exe_b $exe_a $log\n";
    return 1 if $NOOP;				## - Don't compress if $NOOP
  }
  if ($pid = fork) {				## - Parent here
    &debug("spawned $pid");
    $pidm{$pid}	= $log;				## - Save log name for errors
  }
  elsif ($pid == 0) {				## - Child here
    close(STDIN);
    unless(exec($exe_b, $exe_a, $log)){
      &error("exec: $exe_b failed",1);
    }
    exit(1);					## - Just in case
  }
  else {					## - Fatal fork error
    &error("fork failed",1);
  }
}

sub do_exe {
###
### -- Run an external program instead of sending daemon a signal

  my($ent)	= shift;			## - Config entry to process
  my($log)	= shift;			## - First historical log file

  if ($NOOP || $VERBOSE) {
    print STDOUT "executing $ent->{exe}\n";
    return 1 if $NOOP;
  }
  system($ent->{exe}, $log);
  ($? >> 8) ? 0 : 1;				## - Return 1 for 0 exit status
}


sub do_sig {
###
### -- Send a signal to a process.  If $ent->{exe} is defined, an external
###    program is run instead of sending a signal to a daemon.

  my($ent)	= shift;			## - Config entry to process
  my($ret)	= 0;				## - Return value

  if ($NOSIG || (defined($ent->{sig}) && $ent->{sig} == 0)){
    if ($VERBOSE) {
      print STDOUT "WARNING: not notifying daemon by user request\n";
    }
    return 1;
  }
  elsif ($ROOT && !defined($ent->{pid}) && $> != 0) {
    if ($VERBOSE) {
      print STDOUT "WARNING: not notifying syslogd because user not root\n";
    }
    return 1;
  }

  my($sig)	= defined($ent->{sig}) ?	## - Signal number to send
		    $ent->{sig} : 1;
  my($file)	= defined($ent->{pid}) ?	## - PID file path
		    $ent->{pid} : $pid_f;
  my($fh)	= new FileHandle $file;		## - Filehandle to PID file
  my($pid)	= 0;				## - PID to signal

  unless(defined($fh)){
    &error("${file}: open failed");
    return 0;
  }
  $pid		= $fh->getline;			## - Get PID
  $fh->close;					## - Close PID file
  chomp($pid);					## - Strip trailing whitespace

  unless($pid =~ /^\d+$/o) {
    &error("Illegal PID in $file");
    return 0;
  }
  if ($pid <= $min_pid) {
    &error("PID $pid <= $min_pid minimum");
    return 0;
  }
  if ($NOOP || $VERBOSE) {
    print STDOUT "kill -${sig} ${pid}\n";
    return 1;
  }
  $ret		= kill $sig, $pid;

  if ($ret) {
    if ($VERBOSE) {
      print STDOUT "small pause to allow daemon to close log\n";
    }
    sleep($sig_wait);
  }
  $ret;
}

### Just do it
###--------------------------------------------------------------------------###

&parse_argv();					## - Parse command line args
&parse_conf();					## - Parse configurartion file
foreach(@conf){					## - Iterate config entries
  do_entry($_) && do_trim($_);			## - Test and trim if necessary
}
while($pid = wait()) {				## - Wait for spawned processes
  last if $pid == -1;
  if ($? >> 8) {
    &error("$pidm{$pid}: compress failed");
  }
}
exit(0);

### POD
###--------------------------------------------------------------------------###
no strict qw(subs);
my($pod) = ___END___;


=head1 NAME

B<newsyslog> - maintain system log files to manageable sizes

=head1 README

B<newsyslog> is a highly configurable script for maintaining and archiving 
sets of log files.  It archives log files based on size, date or interval, 
and can optionally compress log files with gzip or bzip2.

=head1 SYNOPSIS

B<newsyslog> [B<-Fdnrsv>] [B<-f> I<config_file>] [B<-a> I<directory>] 
[B<-z> I<path_to_gzip>] [B<-j> I<path_to_bzip2>] [B<-p> I<path_to_pid>] 
[I<file ...>]

=head1 DESCRIPTION

B<newsyslog> is a script that should be scheduled to run periodically by
I<cron>(8).  When it is executed it archives log files if necessary.  If a
log file is determined to require archiving, B<newsyslog> rearranges the
files so that ``I<logfile>'' is empty, ``I<logfile>.0'' has the last period's
logs in it, ``I<logfile>.1'' has the next to last period's logs in it, and
so on, up to a user-specified number of archived logs.  Optionally, the
archived logs can be compressed to save space.

A log can be archived for three reasons: 

=over 4

=item 1.

It is larger than the configured size (in kilobytes).

=item 2.

A configured number of hours have elapsed since the log was last archived

=item 3.

This is the specific configured hour for rotation of the log.

=back

The granularity of B<newsyslog> is dependent on how often it is scheduled to
run by I<cron>(8), but should be run once an hour.  In fact, mode three 
(above) assumes that this is so.

When starting up, B<newsyslog> reads in a configuration file to determine
which logs may potentially be archived.  By default, this configuration
file is F</etc/newsyslog.conf>.  Each line of the file contains information
about a particular log file that should be handled by B<newsyslog>.  Each
line has five mandatory fields and four optional fields, with a whitespace
separating each field.  Blank lines or lines beginning with ``#'' are ignored.  
The fields of the configuration file are as follows:

=over 8

=item I<logfile_name>

Name of the system log file to be archived.

=item I<owner:group>

This optional field specifies the owner and group for the archive 
file.  The ":" is essential, even if the I<owner> or I<group> field is
left blank.  The field may be numeric, or a name which is present in
F</etc/passwd> or F</etc/group>.

=item I<mode>

Specify the mode of the log file and archives.

=item I<count>

Specify the number of archive files to be kept besides the log file itself.
Be aware that this number is base zero.  This means that to keep ten sets
of archive files (0..9), the number "9" should be specified.

=item I<size>

When the size of the log file reaches I<size> in kilobytes, the log
file will be trimmed as described above.  If this field is replaced by an
asterisk (`*'), then the size of the log file is not taken into account when 
determining when to trim the log file.

=item I<when>

The I<when> field can consist of an interval or a specific time.  
If the I<when> field is an asterisk (`*') log rotation will depend only on 
the contents of the I<size> field.  Otherwise, the I<when> field consists of 
an optional interval in hours or a specific time preceded by an `@'-sign and 
a time in restricted ISO 8601 format or by an `$'-sign and a time in DWM 
format (see time formats below).

If a time is specified, the log file will only be trimmed if 
B<newsyslog>  is run within one hour of the specified time.  If an
interval is specified, the log file will be trimmed if that many hours 
have passed since the last rotation.  When both a time and an interval 
are specified, both conditions must be satisfied for the rotation to 
take place.               

There is no provision for specification of a timezone.  All times are local 
system time.  

I<ISO 8601 restricted time format>

The lead-in character for a restricted ISO 8601 time is an
`@'-sign. The particular format of the time in restricted ISO 8601 is:
[[[[[I<cc>]I<yy>]I<mm>]I<dd>][T[I<hh>[I<mm>[I<ss>]]]]].  There is little point 
in specifying an explicit minutes or seconds component unless this script is 
run more than once an hour.  Optional date fields default to the appropriate 
component of the current date; optional time fields default to midnight; 
hence if today is January 22, 1999, the following examples are all equivalent: 

       @19990122T000000
       @990122T000000
       @0122T000000
       @22T000000
       @T000000
       @T0000
       @T00
       @22T
       @T
       @                                               

I<Day, week and month time format>

The lead-in character for day, week and month specification is a
`$'-sign. The particular format of day, week and month specification
is: [I<Dhh>], [I<Ww>[I<Dhh>]] and [I<Mdd>[I<Dhh>]] respectively.  Optional
time fields default to midnight.  The ranges for day and hour specifications
are:

 hh     hours, range 0 ... 23
 w      day of week, range 0 ... 6, 0 = Sunday 
 dd     day of month, range 1 ... 31, or the letter ``L''
	or ``l'' to specify the last day of the month.

 Some examples:

 $D0    every night at midnight
 $D23   every day at 23:00 hr
 $W0D23 every week on Sunday at 23:00 hr
 $W5D16 every week on Friday at 16:00 hr
 $MLD0  the last day of every month at midnight
 $M5D6  the 5th day of every month at 06:00 hr

=item I<flags>

This field specifies any special processing that is required.  Individual 
flags and their meanings:

 -      This flag means nothing - it is used as a 
        spacer when no flags are set.

 B      The file is a binary file or is not in 
        syslogd(1) format: the ASCII message which 
        newsyslog inserts to indicate that the logs 
        have been trimmed should not be included.

 C      Create an empty log file if none exists.

 J      Archived log files should be compressed with 
        bzip2(1) to save space.  See "-j" in the 
        OPTIONS section to specify a path for bzip2.

 P      The first historical log file (i.e. the 
        historical log file with the suffix ``.0'') 
        should not be compressed.

 S      No signal should be sent when the log file 
        is archived.  See "-s" in the OPTIONS section 
        below to not send signals for any log files.

 T      Truncate log file instead of renamimg or 
        moving.  This is necessary for daemons that
	can't be sent a signal and/or don't deal well 
	with log files changing out from under them.

 X      Execute an external program after the log file 
        is archived instead of sending a signal.  Be
	aware that executing external programs will be
	"blocking".  That is, no other operations will
	happen until the external program exits.  Also,
	external programs may pose a security risk, as
	newsyslog is typically run as the superuser.

 Z      Archived log files should be compressed with 
        gzip(1) to save space.  See "-z" in the
        OPTIONS section to specify a path for gzip.

=item I<path_to_pid_file> or I<path_to_external_program>

This optional field specifies the file name to read to find the daemon
process id.  This field must start with "/" in order to be recognized properly.
If no pid_file is specified, syslogd is assumed, which is 
F</var/run/syslog.pid> by default.  To specify a different syslog pid_file,
see B<-p> in the OPTIONS section below.

This field is the path to an external program if the I<X> flag is used. 
This field must start with "/" in order to be recognized properly.  If 
command line arguments are required for the external program, a wrapper 
script should be used.

=item I<signal_number>

This optional field specifies the signal number will be sent to the
daemon process.  By default a SIGHUP will be sent.

=back

=head1 OPTIONS

The following options can be used with B<newsyslog>:

=over 8

=item B<-F>

Force B<newsyslog> to trim the logs, even if the trim conditions 
have not been met.  This option is useful for diagnosing system
problems by providing you with fresh logs that contain only the problems.

=item B<-a> I<directory>

Specify a I<directory> into which archived log files will be written.  
If a relative path is given, it is appended to the path of 
each log file and the resulting path is used as the directory into
which the archived log for that log file will be written.  If
an absolute path is given, all archived logs are written into the
given I<directory>.  If any component of the path I<directory> does not
exist, it will be created when B<newsyslog> is run.

=item B<-d>

Place B<newsyslog> in debug mode.  In this mode it will print out 
information (hopefully) useful for debugging programtic or configuration 
issues.

=item B<-f> I<config_file>

Instruct B<newsyslog> to use I<config_file> instead of 
F</etc/newsyslog.conf> for its configuration file.

=item B<-j> I<path_to_bzip2>

Specify path for the bzip2(1) utility.  By default, each directory in 
the PATH environment variable will be searched for "bzip2".

=item B<-n>

Cause B<newsyslog> not to trim the logs, but to print out what it
would do if this option were not specified.

=item B<-p> I<path_to_pid>

Specifies the file name to read to find the I<syslogd>(8) process id.  The
default is F</var/run/syslog.pid>.

=item B<-r>

Remove the restriction that B<newsyslog> must be running as root.
Of course, B<newsyslog> will not be able to send a HUP signal to 
syslogd(8) so this option should only be used in debugging.

=item B<-s>

Do not signal daemon processes.

=item B<-v>

Place B<newsyslog> in verbose mode.  In this mode it will print out
each log and its reasons for either trimming that log or skipping it.

=item B<-z> I<path_to_gzip>

Specify path for the gzip(1) utility.  By default, each directory in 
the PATH environment variable will be searched for "gzip".

=back

If additional command line arguments are given, B<newsyslog> will only
examine log files that match those arguments; otherwise, it will examine all
files listed in the configuration file.

=head1 PREREQUISITES

This script requires the I<Config>, I<File::Basename>, I<File::Copy>, 
I<FileHandle>, I<strict> and I<Time::Local> modules.  All of these 
modules should be present in a full perl installation.  That is, it
shouldn't be necessary to track down and install a bunch of extra
modules to make this script work.

=head1 FILES

/etc/newsyslog.confE<9>E<9>B<newsyslog> configuration file

=head1 EXAMPLE CONFIGURATION

 #
 # filename   [owner:group] mode count size when [FLAGS] [/pidfile] [sig]
 #
 # Archive cron log when it excedes 1000KB, compress it with gzip,
 # keep 3 sets of archive logs, or create a new log if none exists.
 # New log and archive log permissions are set to "-rw-------".
 
 /var/log/cron               600  3     1000  *       ZC
 
 # Archive messages log every Sunday at midnight, or when it exceeds 
 # 1000KB, compress it with bzip2 and keep 5 sets of archive logs.
 # New log and archive log permissions are set to "-rw-r--r--".
 
 /var/log/messages           644  5     1000  $W0D0   J
 
 # Archive wtmp log at 05:00 on the 1st of every month, keep 3 sets of,
 # archive logs and do not write a turnover message in the new log.
 # New log and archive log permissions are set to "-rw-r--r--".
 
 /var/log/wtmp               644  3     *     @01T05  B
 
 # Archive daily log every night at midnight, compress it with gzip and 
 # keep 7 sets of archive logs.  New log and archive log permissions are 
 # set to "-rw-r-----".
 
 /var/log/daily.log          640  7     *     @T00    Z
 
 # Archive httpd log every day at 19:00, or when it exceeds 1000KB, 
 # send a signal to the PID in /tmp/httpd.pid and compress it with bzip2
 # when it is archived, or create a new log if one none exists.  New log 
 # and archive log permissions are set  to "-rw-r--r--" with group and 
 # ownership set to "www".
 
 /var/log/httpd.log  www:www 640  10    1000  $D19    JPC /tmp/httpd.pid

=head1 BUGS

Due to the implicit nature of the [[cc]yy] ISO 8601 date format, a year 
greater than 37 without an explicit century may hit an integer limit
on some systems.

The COPYRIGHT section is way too long.

=head1 AUTHORS

Aaron Scarisbrick <aaronsca@cpan.org>

Original newsyslog written by Theodore Ts'o, MIT Project Athena

=head1 COPYRIGHT

Copyright (s) 2001-2006 Aaron Scarisbrick <aaronsca@cpan.org>
All rights reserved.

Notices below applicable.

Copyright (c) 1999, 2000 Andrew Doran <ad@NetBSD.org>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

  1. Redistributions of source code must retain the above 
     copyright notice, this list of conditions and the 
     following disclaimer.

  2. Redistributions in binary form must reproduce the above 
     copyright notice, this list of conditions and the 
     following disclaimer in the documentation and/or other 
     materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.

This file contains changes from the Open Software Foundation.

Copyright 1988, 1989 Massachusetts Institute of Technology

Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is
hereby granted, provided that the above copyright notice
appear in all copies and that both that copyright notice and
this permission notice appear in supporting documentation,
and that the names of M.I.T. and the M.I.T. S.I.P.B. not be
used in advertising or publicity pertaining to distribution
of the software without specific, written prior permission.
M.I.T. and the M.I.T. S.I.P.B. make no representations about
the suitability of this software for any purpose.  It is
provided "as is" without express or implied warranty.

=head1 SCRIPT CATEGORIES

Unix/System_administration

=cut
