#!/usr/bin/perl
#
# shrotate - wrapper around 'shtool rotate'
# for rotating logfiles in a portable way.
#
# Copyright (c) 2002 - Thomas Linden <tom@daemon.de>
#

use strict;
use Getopt::Long;
use FileHandle;
### use Data::Dumper;

my $VERSION = "1.0.0";

my (
    # commandline options
    $quiet, $o_v, $o_h, $debug, $config, $novars, $path, $try,

    # global hashes
    %vars, %global,

    # location of shtool
    $shtool
    );

$config = "/etc/shrotate.conf";

if (! GetOptions (
		  "config|c=s" => \$config,
		  "path|p=s"   => \$path,
		  "debug|d"    => \$debug,
		  "novars|n"   => \$novars,
		  "quiet|q"    => \$quiet,
		  "try|t"      => \$try,
		  "version|v"  => \$o_v,
                  "help|h"     => \$o_h,
                 )    ) {
  &usage;
}
if ($o_h) {
  &usage;
}
if ($o_v) {
  print STDERR "shrotate version $VERSION\n";
  exit;
}

if ($path) {
  $shtool = "$path/shtool";
}
else {
  $shtool = "shtool";
}

#
# check for correct shtool version
my $tools = `$shtool -h`;
if ($tools !~ /rotate/s) {
  print STDERR "'$shtool' too old or not found! At least version 1.5.4 or higher\n"
              ."is required. Get it at: http://www.gnu.org/software/shtool/\n";
  exit 1;
}

foreach my $command (&build_commands(&parse($config))) {
  if ($debug || $try) {
    print STDERR "$command\n";
  }
  if (! $try) {
    system($command) and &failure("Failed command was:\n   $command\n");
  }
}


exit;






sub usage {
print qq(Usage: shrotate [-c <configfile>] [-qdvhpnt]
Rotate logfiles.

 -c, --config=<configfile>  use alternate config than the default one.
 -p, --path=<path>          path to the 'shtool' program.
 -d, --debug                turn debugging on, which prints every shell
                            command being executed.
 -n, --novars               turn off variable support.
 -q, --quiet                be quiet, even if failures are occuring.
 -t, --try                  just print out what would be executed.
 -h, --help                 display this help and exit.
 -v, --version              print version information and exit.

Report bugs to <tom\@daemon.de>.
);

  exit 1;
}


sub failure {
  my $msg = shift;
  if (! $quiet) {
    print STDERR $msg;
    exit 1;
  }
}

sub build_commands {
  #
  # build commandline for given entry
  #
  my @entries = @_;
  my(@commands);

  foreach my $entry (@entries) {
    my $command = "$shtool rotate";
    my @files = @{$entry->{files}};
    delete $entry->{files};

    if ($entry->{pwd}) {
      @files = map { (/^\// ? $_ : "$entry->{pwd}/$_" ) } @files;
      delete $entry->{pwd};
    }

    foreach my $global (keys %global) {
      if (! exists $entry->{$global}) {
	$entry->{$global} = $global{$global};
      }
    }

    foreach my $option (keys %{$entry}) {
      $command .= " --$option " . $entry->{$option};
    }
    $command .= " @files";
    push @commands, $command;
  }

  @commands;
}









sub parse {
  #
  # parse a logrotate-alike config file
  #
  my (@entries, $content, $inside);
  my @valid = map { s/\n//; $_; } <DATA>;

  my $config = shift;

  $content = &read($config);

  local $_;
  my %conf;
  foreach (split /\n/, $content) {
    if (/^\s*([^\{]*)\s*\{/) {
      my $files = &interpolate($1);
      my @files = split /\s\s*/, $files;
      $conf{files} = \@files;
      $inside = 1;
      next;
    }
    if (/^\s*\}/) {
      $inside = 0;
      my %tmp = %conf;
      push @entries, \%tmp;
      %conf = ();
      next;
    }

    s/^\s*//;
    s/\s*$//;

    my ($key, $value) = split /\s*=\s*|\s+/, $_, 2;

    $value = &interpolate($value);

    if (grep { /^$key$/ } @valid) {
      # valid option
      if ($value =~ /\s/ && $value !~ /^["'].*["']$/) {
	$value = "\"$value\"";
      }
      if ($inside) {
	$conf{$key} = $value || "";
      }
      else {
	$global{$key} = $value || "";
      }
    }
    else {
      # put on var stack
      $vars{$key} = $value;
    }
  }

  return @entries;
}


sub interpolate {
  #
  # interpolate the given string
  # using the current variable stack
  #
  my $string = shift;

  if ($novars) {
    return $string;
  }
  else {
    $string =~ s/\$([\w]*)/$vars{$1}/eg;
    return $string;
  }
}


sub read {
  #
  # read a config file and return its contents as string
  #
  my $file = shift;
  my $fd = new FileHandle;

  if ($debug) {
    print STDERR "Reading $file\n";
  }

  open $fd, "<$file" || die "Could not open config $config: $!\n";
  my $content;

  while (<$fd>) {
    next if (/^\s*#/ || /^\s*$/);
    if (/^\s*include\s\s*([^#]*)$/) {
      my $file = $1;
      if (-d $file) {
	# recurse for every file in this directory
	my $dir = $file;
	foreach my $file (<$dir/*>) {
	  $content .= &read("$file");
	}
      }
      # recurse with new file
      $content .= &read($file);
    }
    else {
      $content .= $_;
    }
  }
  close $fd;

  return "$content\n";
}


1;




#
# valid options, keep this
#

__DATA__
verbose
trace
force
num-files
size
copy
remove
archive-dir
compress
background
delay
pad
owner
group
mode
migrate
prolog
epilog
pwd
