#!/usr/bin/perl

#-------------------------------------------------------------------------
# -- rotate-logs.pl --
# 
# reads a config file (default: /etc/rotate-logs.conf) and rotates all
# files found.  The config-file contains one file to be rotated per line.
# Lines have the format:
#
#	/path/to/file	<keep#>	<options>
#
# <options> can be "compress" or "touch", in any order.
#
# OPTION: touch
# -------------
# "touch" can have sub-options "group=<group>", "user=<user>", "mode=<mode>"
# <group> can be name or GID, <user> can be name or UID. <mode> is interpreted
# as octal.
# "touch" and sub-options are delimited by comma, with no white-space.
# The values for any sub-options not specified are taken from the original
# file.
#
# OPTION: compress
# ----------------
# causes "gzip -9 /path/to/logfileN.0" to be executed *after* "after-rotate"
# jobs have been run (i.e. signals have been sent to syslogd, etc).  The gzip
# command is "fired and forgotten", that is, a subprocess is started
# which is independent of the rotate-logs.pl script, which may continue to
# run after the rotate-logs.pl script has finished.
#
# Examples:
#
#	/var/log/mail.log	7 touch,group=bin,user=daemon,mode=0600
#	/var/log/messages	10	compress touch,mode=0660
#
# AFTER ROTATION
# --------------
# In order to send a signal to a process (such as syslogd) to cause
# logfiles to be closed and re-opened, a line of form:
#
#	after-rotate: cmd=send-signal signal=<sig-name> pid-file=/path/to/pid-file
#
# must be added to the config-file.  Currently, the only command available
# is "send-signal".  The signal must be specified with "signa=<sig-name>",
# and a file containing the PID of the process to signal must be specified
# using "pid-file=<path>". There may be several such lines.
#
# ARCHIVE-DIRECTORIES
# -------------------
# To specify a target directory to keep rotated files, a line of the form:
#
#	archive-dir: source=/path/to/logfile/dir dest=/path/to/archive/dir
#
# must be added to the config-file.  All files in /path/to/logfile/dir
# will be rotated into /path/to/archive/dir. There may be several such lines.
# CAUTION: the script assumes that the archive-dir is in the same
# filesystem as the log-dir.  If you want to have your archive-dir on a
# different filesystem, you will need to do some additional work.
#
# blank lines and lines beginning with "#" are ignored in the config-file.
#
# Author: Robert Urban, 2009 <urban@unix-beratung.de>
#-------------------------------------------------------------------------

use FileHandle;
use Getopt::Long;
use File::Copy;
use File::Path;
use File::Basename;

my $GZIP		= '/usr/bin/gzip';

my $CONFIG_FILE	= '/etc/rotate-logs.conf';
my $LOG_FILE	= '/var/log/rotate-logs.log';
my %ARCHIVE_DIRS;
my $DEBUG		= 0;
my $VERBOSE		= 0;

open_log();

$SIG{__DIE__} = \&cleanup;

my $res = GetOptions(
	'verbose|v+'	=> \$VERBOSE,
	'debug|d+'		=> \$DEBUG,
	'config|c=s'	=> \$CONFIG_FILE,
);

my $conf = read_config_file($CONFIG_FILE);

my @compress;

log_msg("rotating logfiles");
foreach my $logfile (@{ $conf->{list} }) {
	get_perms($logfile);
	rotate($logfile->{path}, $logfile->{keep});
	if (exists($logfile->{rest}->{touch})) {
		post_rotate($logfile);
	}
	if (exists($logfile->{rest}->{compress})) {
		push(@compress, $logfile);
	}
}

log_msg("\nafter-rotate jobs");
if (@{ $conf->{at_end} }) {
	foreach my $job (@{ $conf->{at_end} }) {
		run_job($job);
	}
}

log_msg("\ncompress jobs");
foreach my $logfile (@compress) {
	compress("$logfile->{path}.0");
}

#======================================================================
# subroutines
#======================================================================

sub get_perms
{
	my $conf_entry = shift;

	my ($mode, $uid, $gid) = (stat($conf_entry->{path}))[2,4,5];
	$mode &= 07777;

	$conf_entry->{perms} = {
		mode	=> $mode,
		uid		=> $uid,
		gid		=> $gid,
	};
}

sub compress
{
	my $path = shift;

	$path = check_dir($path);
	log_msg("compressing [$path]");

	my @cmd = ($GZIP, '-9', $path);

	my $rfh = FileHandle->new;
	my $wfh = FileHandle->new;
	pipe($rfh, $wfh) || die "pipe failed: $!";
	$wfh->autoflush(1);

	my $pid = fork();
	defined($pid) || die "fork failed: $!";

	if ($pid == 0) {
		# child
		$rfh->close;
		if (!$DEBUG) {
			my $pid2 = fork();
			unless ($pid2) {
				# child
				exec(@cmd);
				die "exec failed: $!";
			} else {
				# parent
				print $wfh "$pid2\n";
				$wfh->close;
			}
			exit 0;
		}
	} else {
		# parent
		$wfh->close;
		my $job_pid = <$rfh>;
		$rfh->close;
		chomp($job_pid);
		log_msg("starting job (pid=$job_pid) to compress [$path]");
	}
	waitpid($pid, 0);
}

sub post_rotate
{
	my ($conf_entry) = @_;

	if (exists($conf_entry->{rest}->{touch})) {
		touch($conf_entry);
	}
}

sub touch
{
	my $conf_entry = shift;

	my ($mode, $uid, $gid) = @{ $conf_entry->{perms} }{'mode', 'uid', 'gid'};

	my (@params) = split(',', $conf_entry->{rest}->{touch});
	foreach my $param (@params) {
		if ($param =~ /^user=(.*)$/) {
			my $user = $1;
			if ($user =~ /^\d+$/) {
				$uid = $user;
			} else {
				$uid = getpwnam($user);
				defined($uid) || die "unable to lookup user [$user]";
			}
		} elsif ($param =~ /^group=(.*)$/) {
			my $group = $1;
			if ($group =~ /^\d+$/) {
				$gid = $group;
			} else {
				$gid = getgrnam($group);
				defined($gid) || die "unable to lookup group [$group]";
			}
		} elsif ($param =~ /^mode=(.*)$/) {
			$mode = oct($1);
		}
	}

	my $file = $conf_entry->{path};
	my $o_mode = sprintf('0%o', $mode);
	log_msg("touching [$file] with mode=$o_mode, uid=$uid, gid=$gid");
	$DEBUG && return;

	my $fh = FileHandle->new($file, O_WRONLY|O_CREAT);
	defined($fh) || die "open (for touch) of file [$file] failed: $!";
	$fh->close;

	chmod($mode, $file) || die "chmod on [$file] failed: $!";
	chown($uid, $gid, $file) || die "chown on [$file] failed: $!";
}

sub run_job
{
	my $job = shift;

	my @atoms = split(' ', $job);
	my %comps;
	foreach my $atom (@atoms) {
		if ($atom =~ /^([^=]+)=(.*)$/) {
			$comps{$1} = $2;
		} else {
			log_msg("error: unable to parse atom [$atom] in job [$job]");
		}
	}

	if (!exists($comps{cmd})) {
		log_msg("error: no 'cmd' label found for job [$job]");
		return;
	}

	if ($comps{cmd} eq 'send-signal') {
		if (!exists($comps{signal})) {
			log_msg("error: no signal specified for job [$job]");
			return;
		}
		if (!exists($comps{'pid-file'})) {
			log_msg("error: no pid-file specified for job [$job]");
			return;
		}
		if (! -f $comps{'pid-file'}) {
			log_msg("error: pid-file $comps{'pid-file'} not found for job [$job]");
			return;
		}
		my $pid = get_pid_from_file($comps{'pid-file'});
		log_msg("sending signal [$comps{signal}] to pid [$pid]");
		$DEBUG || kill($comps{signal}, $pid) || die "kill: $!";
	}
}

sub get_pid_from_file
{
	my $pid_file = shift;

	my $fh = FileHandle->new($pid_file);
	defined($fh) || die "open of pid-file [$pid_file] failed: $!";
	my $pid = <$fh>;
	$fh->close;

	chomp($pid);

	return $pid;
}

sub read_config_file
{
	my $config_file = shift;

	my @list;
	my @at_end;

	my $fh = FileHandle->new($config_file);
	defined($fh) || die "can't open conf-file [$config_file]: $!";

	while(<$fh>) {
		next if (/^\s*$/ || /^\s*#/);
		if (/^\s*after-rotate:\s+(.*)\s*$/) {
			push(@at_end, $1);
			next;
		} elsif (/\s*archive-dir:\s*source=(\S+)\s+dest=(\S+)\s*$/) {
			my ($src, $targ) = ($1, $2);
			if (! -d $src) {
				die "archive-dir source [$src] does not exist\n";
			}
			if (! -d $targ) {
				mkpath($targ, { mode => 0755 });
			}
			$ARCHIVE_DIRS{$src} = $targ;
		}
		my ($path, $keep, @rest) = split;
		my $rest;
		foreach my $elem (@rest) {
			my ($key, $content) = ($elem =~ /^([^,]+)(?:,(.*))?$/);
			$rest->{$key} = $content;
		}
		push(@list, { path => $path, keep => $keep, rest => $rest });
	}
	$fh->close;

	return { list => \@list, at_end => \@at_end };
}

sub rotate
{
	my ($basename, $keep) = @_;

	log_msg(" rotating [$basename]");

	my $i = $keep - 2;

	my $last = check_dir("$basename." . ($i + 1));
	if (-f $last) {
		unlink($last);
	} elsif (-f "$last.gz") {
		unlink("$last.gz");
	}

	while($i >= 0) {
		my $old = check_dir("$basename.$i");
		my $new = check_dir("$basename." . ($i + 1));
		if (-e $old) {
			my_move($old, $new);
		} elsif (-e "$old.gz") {
			my_move("$old.gz", "$new.gz");
		}
		$i--;
	}

	my $new = check_dir("$basename.0");
	if (-e $basename) {
		my_move($basename, $new);
	}
}

sub check_dir
{
	my $file = shift;

	my $dir = dirname($file);
	if (exists($ARCHIVE_DIRS{$dir})) {
		return $ARCHIVE_DIRS{$dir} . '/' . basename($file);
	}

	return $file;
}

sub my_move
{
	my ($old, $new) = @_;

	log_msg("\tmove [$old] -> [$new]");
	#$DEBUG || rename($old, $new) || die "rename [$old] -> [$new]: $!";
	$DEBUG || move($old, $new) || die "move [$old] -> [$new]: $!";
}

sub open_log
{
	open($LOGFH, '>>', $LOG_FILE) || die "could not open logfile [$LOG_FILE]: $!";
	print $LOGFH "\n--------------------------------------------\n";
	print $LOGFH 'starting at '.localtime()."\n";
}

sub log_msg
{
	my $msg = shift;
	chomp($msg);
	$VERBOSE && print "$msg\n";
	print $LOGFH "$msg\n";
}

sub cleanup
{
	my $msg = shift;

	log_msg('caught fatal exception:');
	log_msg("error: $msg");
}