#!/usr/bin/perl
#
# savelog
#
# usage: savelog [-m mode] [-u user] [-g group] [-t] [-p] [-c cycle] [-l] [--date date]
#                file...
#	-m mode	  - chmod log files to mode
#	-u user	  - chown log files to user
#	-g group  - chgrp log files to group
#	-c cycle  - save cycle versions of the logfile	(default: 7)
#	-t	  - touch file
#	-l	  - don't compress any log files	(default: compress)
#       -p        - preserve mode/user/group of original file
#	file 	  - log file names
#
# Bugs: If a process is still writing to the file.0 and savelog
#	moved it to file.1 and compresses it, data could be lost.
#	Smail does not have this problem in general because it
#	restats files often.

use strict;

my $compress = 'gzip -9f';
my $mode;
my $user;
my $group;
my $touch;
my $preserve; # = 1;
my $count = 7;
my $date;

my $usage = "savelog [-m mode] [-u user] [-g group] [-c cycle] [-l] [-p] [--date date] file ...";

# parse args
my @files;
while (@ARGV) {
	$_ = shift @ARGV;
	if (/^-/) {
		if ($_ eq '-t') {
			$touch = 1;
		}
		elsif ($_ eq '-m') {
			$mode = shift @ARGV;
		}
		elsif ($_ eq '-u') {
			$user = shift @ARGV;
		}
		elsif ($_ eq '-g') {
			$group = shift @ARGV;
		}
		elsif ($_ eq '-c') {
			$count = shift @ARGV;
		}
		elsif ($_ eq '-l') {
			$compress = undef;
		}
		elsif ($_ eq '-p') {
			$preserve = 1;
		}
		elsif ($_ eq '--date') {
			$date = shift @ARGV;
		}
		else {
			die $usage;
		}
	} else {
		push( @files, $_ );
	}
}


sub filefixer {
	my $fn = shift;
	my @c;
	push( @c, "chown $user $fn" ) if $user;
	push( @c, "chgrp $group $fn" ) if $group;
	push( @c, "chmod $mode $fn" ) if $mode;
	join(';',@c) || 'true';
}

die "$0: count must be at least 2\n" if ($count < 2);

my $errors;
for my $filename (@files) {

	# catch bogus files
	if (-e $filename && !(-f $filename || -d $filename)) {
		$errors++;
		warn "$0: $filename is not a regular file or directory\n";
		next;
	}

	# touch into existence first?
	if ($touch && !(-f $filename)) {
		if (system( "touch $filename && " . &filefixer($filename) )) {
			$errors++;
			warn "$0: couldn't touch $filename\n";
			next;
		}
		
	}

	# preserve?
	if ($preserve) {
		($mode,$user,$group) = (stat($filename))[2,4,5];
		$mode = sprintf("%o", $mode & 03777);
#		print "mode = $mode, user = $user, grup = $group\n";
	}

 	# be sure that the savedir exists and is writable
	my @f = split(/\//,$filename);
	my $file = pop @f;
	my $savedir = join('/',@f);
	$savedir = '.' if $savedir eq '';

 	unless (-w $savedir) {
		$errors++;
		warn "$0: directory $savedir not writeable\n";
		next;
	}

	# figure new filename, make sure it dne
	my $newname;
	if ($date) {
		$newname = $file . '.' . $date;
	} else {
		$newname = $file . '.0';
	}
	if ($date && -e "$savedir/$newname") {
		die "$0: can't rename $file, $savedir/$newname already exists!\n";
	}


	# look for old copies of this file
	my @old;
	opendir(D,$savedir);
	for my $f (readdir(D)) {
		if (substr($f,0,length($file)+1) eq ($file . '.')) {
#			print "old: $f\n";
			push( @old, $f );
		}
	}
	closedir D;

	# cycle and expire
	if ($date) {
		## date (fancy way)
		# separate out dated ones
		my @weird;
		my @ok;
		for my $f (reverse sort @old) {
			if ($f =~ /$file\.\d\d\d\d-\d\d-\d\d(\.gz|\.bz2)?$/) {
#				print "ok old: $f\n";
				push( @ok, $f );
			} else {
				print "weird: $f\n";
				push( @weird, $f );
			}
		}
		
		my @expire = splice(@ok, $count-1);  # keep newest $count
		for my $f (@expire) {
			print "removing $f\n";
			unlink "$savedir/$f";
		}
#		for my $f (@ok) {
#			print "keeping $f\n";
#		}

	} else {
		# remove excess
		my %saw;
		for my $f (@old) {
			unless ($f =~ /$file\.(\d+)(\.gz|\.bz2)?$/) {
				print "wierd: $f\n";
				next;
			}
			my $c = $1;
			if ($c >= $count) {
				print "removing $f\n";
				unlink "$savedir/$f";
			}
			if ($saw{$c}) {
				# which do we want?
				if (($compress && $f =~ /\.gz|\.bz2$/) ||
					(!$compress && $f !~ /\.gz|\.bz2$/)) {
					print "removing $savedir/$saw{$c}\n";
					unlink "$savedir/$saw{$c}";
				} else {
					print "removing $savedir/$f\n";
					unlink "$savedir/$f";
				}
			}
			$saw{$c} = $f;
		}
		
		## number (traditional way)
		for (my $n = $count; $n > 0; $n--) {
			my $s = $n - 1;
			rename "$savedir/$file.$s", "$savedir/$file.$n" if -e "$savedir/$file.$s";
			rename "$savedir/$file.$s.gz", "$savedir/$file.$n.gz" if -e "$savedir/$file.$s.gz";
			rename "$savedir/$file.$s.bz2", "$savedir/$file.$n.bz2" if -e "$savedir/$file.$s.bz2";
		}
	}
	
	# rotate!
	if (!($date) && -e "$savedir/$newname") {
		die "$0: can't rename $file, $savedir/$newname already exists!\n";
	}
	rename "$savedir/$file", "$savedir/$newname";

	# touch?
	if ($touch) {
		system("touch $filename &&" . &filefixer($filename));
	}
	
	# compress?
	if ($compress) {
		if ($date) {
			warn " ** compression not implemented\n";
		} else {
			my $oneback = $file . '.1';
			system "$compress $savedir/$oneback"
				if -e "$savedir/$oneback";
		}
	}

	# report successful rotation
	print "Rotated $filename.\n";
}

exit $errors;
