#!/usr/bin/perl -w
#===============================================================================
# logarch
# =======
# (c) Thomas Lohmller <logar@lohmueller.ch>
#
# Script to archive old log-files
#===============================================================================

# global configuration, change if needed
my $globalConfig = '/etc/logarch.conf';





#===============================================================================
# don't change anything after this line
#===============================================================================





#===============================================================================
# Logarch::Config
# ###############
# (c) Thomas Lohmller <logar@lohmueller.ch>
#
# Module to hold configuration informations
#===============================================================================
package Logarch::Config;

use strict;



#===============================================================================
# Initialisierer
#
# Erstellt ntige Funktionen
sub BEGIN( )
{ 
  no strict 'refs';
  
  # erstelle Funktionen zum Lesen und Setzen folgender Felder
  foreach my $attr ( qw(period mode count mail mailTo size create postrotate
  			prerotate dir mailFrom mailServer compresscmd
			compressext ) )
  {
    *{__PACKAGE__ ."::$attr"}=
    sub( ;$ )
    { my $self = shift;

      # Teste, ob Argument bergeben wurde
      if (defined($_[0])) # Argument wurde bergeben, Wert setzen
      { return $self->_setval($attr, $_[0]); }
      else # Wert abfragen
      {
        # Wert lokal vorhanden?
        if ( defined $self->{$attr} )
        {
          # Lokalen Wert zurckgeben
          return $self->{$attr};
        }
        else # lokaler Wert nicht vorhanden
        {
          # parent vorhanden
          if ( defined $self->{parent} )
          { # parent nach Wert fragen
            return eval("\$self->{parent}->$attr()");
          }
          else # parent nicht vorhanden
          {
            # Standardwert vorhanden?
            if ( defined $self->{'defaults'}->{$attr} )
            {
              # Standardwert zurckgeben
              return $self->{'defaults'}->{$attr};
            }
            else # kein Standardwert
            {
              # leere Zeichenfolge zurckgeben
              return "";
            }
          }
        }
      }
    }
  }
}



#===============================================================================
# lesen und setzen der Dateiliste
#
# Argumente:    1. Dateiliste
# Rckgabewert: Dateiliste, falls kein Argument bergeben wurde
sub files ( ;$ )
{
  my $self = shift;

  # Argument bergeben?
  if ( defined($_[0]) )
  { # Wert setzen
    $self->{files} = $_[0];
  }
  else # kein Argument bergeben
  { # Wert lesen, falls nicht vorhanden "" zurckgeben
    if ( defined($self->{files}) ) { return $self->{files}; }
    else { return ""; }
  }
}



#===============================================================================
# setze einen Wert
#
# Argumente:    1. Schlssel
#               2. Wert
# Rckgabewert: 0: Fehler aufgetreten
#		1: Wert erfolgreich gesetzt
sub _setval ( $$ )
{
  my $self = shift;

  my ($key, $val) = @_;

  if ( ( $key eq "mode"       && $val =~ /^(copytruncate|movecreate)$/ )
    || ( $key eq "period"     && $val =~ /^(day|week|month|year)$/ )
    || ( $key eq "mail"       && $val =~ /^(yes|attach|no)$/ )
    || ( $key eq "mailTo"     && $val =~ /^\w+.*$/ )
    || ( $key eq "mailFrom"   && $val =~ /^\w+.*$/ )
    || ( $key eq "mailServer" && $val =~ /^\w+.*$/ )
    || ( $key eq "count"      && $val =~ /^\d+$/ )
    || ( $key eq "size"       && $val =~ /^\d+[mk]{0,1}$/i )
    || ( $key eq "dir"        && -d $val )
    || ( $key eq "compresscmd" )
    || ( $key eq "compressext" )
    || ( $key eq "create"     && $val =~ /^(\d{3,4})\s+(\w+)\s+(\w+)$/ &&
 	         defined((getgrnam($1))[2]) && defined((getpwnam($2))[2]) )
    || ( $key eq "prerotate" || $key eq "postrotate" )
     )
  {
    if ( $key eq "size" )
    {
      if ( $val =~ /^(\d+)k$/i )	{ $val = $1 * 1024; }
      elsif ( $val =~ /^(\d+)m$/i )	{ $val = $1 * 1024*1024; }
    }

    $self->{$key}=$val;
    return 1;
  }
  else { return 0; }
}





#===============================================================================
# konstruiere neues Objekt
#
# Argumente:    keine
# Rckgabewert: neues Logrotate::Config-Objekt
sub new( ;$ )
{
  my $type = shift;
  my $self = {};
  bless $self, $type;

  if ( defined($_[0]) ) # parent wurde bergeben
  { $self->{parent} = $_[0]; }
  else # kein Parent bergeben
  { # erstelle Standardwerte
    $self->{'defaults'} = { period      => 'week',
                            mail        => 'no',
                            compresscmd => 'bzip2',
                            compressext => 'bz2',
                            mode        => 'copytrunc',
                            create      => '0644 root root',
                            mailTo	=> 'root@localhost',
                            mailFrom	=> 'root',
                            mailServer	=> 'localhost',
                            dir         => '.',
                            size        => '0' };
  }

  return $self;
}



#===============================================================================
# gebe alle Daten der Konfiguration zurck
#
# Argumente:    keine
# Rckgabewert: keine
sub dump()
{
  my $self = shift;

  # Alle Daten dieser Konfiguration ausgeben
  print "\nDumping $self\n";
  foreach my $key ( keys %{$self} ) { print "  $key => ".$self->{$key}."\n"; }
}





#===============================================================================
# logarch
# =======
# (c) Thomas Lohmller <logar@lohmueller.ch>
#
# Main Script
#===============================================================================
package MAIN;



#===============================================================================
# Bibliotheken laden
use strict;		# strikte berprfung
use integer;		# alle Rechnungen in Ganzzahlen
use POSIX qw(strftime);	# wird zum Formatieren von Zeiten verwendet



#===============================================================================
# Globale Variablen
my @configs;		# alle gelesenen Konfigurationen
my $handle = 1;		# Counter fr Dateihandles



#===============================================================================
# oft bentigte Werte
my $yearNow = strftime("%Y", localtime);	#aktuelles Jahr
my $monthNow= strftime("%m",localtime);		#aktueller Monat
my $weekNow = strftime("%W", localtime);	#aktuelle Woche
my $dayNow  = strftime("%j", localtime);	#aktueller Tag



#===============================================================================
# suche alte Archive
#
# Argumente:    1. Logarch::Config
#               2. Namen der Archivierten Datei im Zielverzeichnis
# Rckgabewert: 0: senden Fehlgeschlagen
#		1: senden erfolgreich
sub sendMail ( $$ )
{
  my ( $config, $file ) = @_;

  # Versuche ein Mail zu senden
  eval
  { use Mail::Sender;
    my $sender;

    $sender = new Mail::Sender({from => $config->mailFrom,
  			      smtp => $config->mailServer});

    $sender->MailFile( {to =>$config->mailTo(),
		        subject => "Archived $file",
  		        msg => "Archived log-file is attached.",
		        file => $file});
  };
  # gebe Fehler aus, falls ein Fehler generiert wurde
  print STDERR "Unable to send mail to ".$config->mailTo().".\n",
  	       "Error: $@\n" if $@;
}


#===============================================================================
# suche alte Archive
#
# Argumente:    1. Logarch::Config
#               2. Namen der Original-Datei (im Zielverzeichnis)
# Rckgabewert: Array mit allen Archiven der Datei
sub getOldLogs($$)
{
  use File::Basename;	# Zum Trennen von Pfadangaben
  
  my ( $config, $file )  = @_;

  # suche Archiv-Verzeichnis
  my $dir = $config->dir();
  if ( $dir !~ /\/$/ ) { $dir .='/'; }

  # Schneide Pfad vom Dateinamen ab
  $file = basename($file);

  # gebe alles ausser leeren Wert zurck
  return grep { $_ ne "" } glob("$dir$file-*");
}



#===============================================================================
# lsche lteste Datei
#
# Argumente:    Array mit allen Dateien
# Rckgabewert: neues Array ohne gelschter Datei
sub removeOldest( @ )
{
  my @files = @_;

  # Liste sortieren
  @files = sort @files;

  # erstes Element entfernen
  my $del = shift (@files);

  # Text ausgeben, Datei lschen
  print "remove old log $del\n";
  unlink($del) or print STDERR "unable to remove $del!\n";
  
  # neues Array zurckgeben
  return @files;
}



#===============================================================================
# Rotiere Log-Datei
#
# Argumente:    1: Logrotate::Config
#		2: Datei
#		3: wieso Datei archiviert werden muss
# Rckgabewert: 0: erfolgreich archiviert
#	        1: kann Datei nicht kopieren
#       	2: kann Datei nicht komprimieren
#      		3: Archivierte Datei existert bereits
sub rotate( $$;$ )
{
  use File::Basename;	# Zum Trennen von Pfadangaben
  use File::Copy;		# Zum kopieren und verschieben von Dateien

  my $config = $_[0];
  my $file = $_[1];
  my $why = (defined($_[2])?$_[2]:""); 

  my $dirname  = dirname($file);
  my $filename = basename($file);

  my $newDir = $config->dir();
  if ( $newDir !~ /\/$/ ) { $newDir .='/'; }

  my $newFile = $filename . "-" .strftime('%Y_%m_%d', localtime);

  printf "rotate $filename in $dirname to $newFile\n";
  chdir $dirname || return 1;
  if ( -e "$newDir/$newFile.bz2" )
  {
    print STDERR "File $newDir$newFile.bz2 already exists. ".
    		 "rotate canceled for file $file!\n";
    return 3;
  }
  if ( $config->mode() eq "copytruncate" )
  {
    copy($file, "$newDir$newFile") || return 1;
    copy("/dev/null", $file) || return 1;
  }
  elsif ( $config->mode() eq "movecreate" )
  {
    move($file, "$newDir$newFile") || return 1;
    my @create = split(" ", $config->create());
    if ( ! ( open(OUT, ">$file") &&
             close(OUT) &&
	     chmod($create[0], $file) &&
	     chown((getpwnam("root"))[2], (getgrnam("daemon"))[2], $file)
       )   )
    { return 1; }
  }
  if ( $config->mail() eq "yes" ) { sendMail($config, $newDir.$newFile); }
  system ("bzip2 -9 \"$newDir$newFile\"") || return 2;
  if ( $config->mail() eq "attach" ) { sendMail($config, $newDir.$newFile); }
  
}



#===============================================================================
# Teste, ob Datei archviert werden muss
#
# Argumente:    1: Logrotate::Config
#		2: Datei
# Rckgabewert: Grund wieso Datei archiviert werden muss. Sonst ""
sub checkIfNeeded( $$ )
{
  my $config = $_[0];
  my $file = $_[1];

  return "" if  ( ! -e $file ); # abbruch, falls Datei nicht existiert
  return "" if  ( ! -R $file ); #    "   , falls Datei nicht gelesen werden kann
  return "" if  ( ! -f $file ); #    "   , falls es keine normale Datei ist

  my $rotate="";
  
  # teste, ob max. grsse exisitert
  if ( $config->size() )
  { # Teste ob grsse berschritten wurde.

    if ( $config->size() >= 0 && -s $file >= $config->size() )
    { $rotate = "size"; }
  }
  if ( $config->period() ne "" && $rotate eq "")
  {
    my $imod = (stat $file)[10];
    my $period = $config->period();

    if ( $period eq "year" )
    {
      if ( $yearNow > strftime("%Y",localtime($imod)) )
      { $rotate = "period"; }
    }
    elsif ( $period eq "month" )
    {
      if ( $monthNow > strftime("%m",localtime($imod)) ||
           $yearNow > strftime("%Y",localtime($imod)) )
      { $rotate = "period"; }
    }
    elsif ( $period eq "week" )
    {
      if ( $weekNow > strftime("%W",localtime($imod)) ||
           $yearNow > strftime("%Y",localtime($imod)) )
      { $rotate = "period"; }
    }
    elsif ( $period eq "day" )
    {
      if ( $dayNow > strftime("%j",localtime($imod)) ||
           $yearNow > strftime("%Y",localtime($imod)) )
      { $rotate = "period"; }
    }
  }
  
  return $rotate;
}



#===============================================================================
# Lese und analysiere Zeile
#
# Argumente:    Logarch::Config
# Rckgabewert: 0:ungltige Zeile
#        	1:Zeile eingelesen
#        	2:neuer Block beginnt
#        	3:Block fertig
#        	4:include gefunden
#        	5:Beginn postrotate
#        	6:Beginn prerotate
sub readLine ( $ )
{
  my $config = shift;

  if ( /^\s*(\w+)\s*:\s*(.+)\s*$/ )
  {
    my $key=$1; my $val=$2;
    if ( $key eq "include" )
    {
      foreach my $file ( glob($2) )
      {
        if ( -r $file && -f $file ) { &readFile($file, $config); }
	else { print STDERR "Unable to open $file for reading.\n"; }
      }
      return 4;
    }
    else
    { # teste ob funktion existiert
      if ( $config->can($key) )
      { $config->$1($2);
        return 1;
      }
      else
      { return 0; }
    }
  }
  elsif ( /^\s*{\s*$/ )
  { return 2; }
  elsif ( /^\s*}\s*$/ )
  { return 3; }
  elsif ( /^\s*postrotate\s*$/ )
  { return 5; }
  elsif ( /^\s*prerotate\s*$/ )
  { return 6; }
  else
  { return 0; }
}



#===============================================================================
# lese Konfigurationsdatei
#
# Argumente:    1: Dateiname
#		2: [bergeordnete Konfiguration]
# Rckgabewert: Logarch::Config oder undef falls ein Fehler aufgetreten ist
sub readFile ( $;$ )
{
  # wird wegen dynamischen filehandles gebraucht
  no strict 'refs';

  # Configfile
  my $file = $_[0];

  return undef if  ( ! -e $file ); # abbruch, falls Datei nicht existiert
  return undef if  ( ! -R $file ); #    "   , falls Datei nicht lesbar
  return undef if  ( ! -f $file ); #    "   , falls es keine normale Datei ist
  return undef if  ( ! -O $file ); #    "   , falls Datei nicht eff UID gehrt
  return undef if  ( ! -T $file ); #    "   , falls es keine Text-Datei ist

  my $filehandle = $handle++;

  my ( $parent, @stack, $config );
  if ( defined($_[1]) ) { $config = new Logarch::Config($_[1]); }
  else { $config = new Logarch::Config(); }
  push(@configs, $config);

  # versuche Konfigurationsdatei zu ffnen und fr read-only Zugriff sperren
  if ( open($filehandle, "<$file") && flock($filehandle, 1) )
  {
    while (<$filehandle>)
    {
      # leere Zeilen und Kommentare (beginnen mit #) berspringen
      if ( /^\s*(#.*|\s*)\n$/ ) { next; }
  
      # Zeile enthlt was. Newline entvernen und Inhalt analysieren.
      chomp();

      my $res = readLine($config);
      if ( $res == 0 ) # ungltige Zeile
      { print STDERR "unknown line in $file:$. -> $_\n"; }
      elsif ( $res == 2 ) # neuer Block
      {
        push(@stack, $config); # aktuelle Config auf Stack schieben
        $config = new Logarch::Config($config); # neue Config
        push(@configs, $config); # neue config an array anfgen
      }
      elsif ( $res == 3 ) # Block fertig
      { $config = pop(@stack); } # alte config vom stack holen
      elsif ( $res == 5 || $res == 6 ) # Beginn script
      { 
        my $script = "";
        while ( defined($_=<$filehandle>) && ! /^\s*endscript\s*$/ )
        { $script .= "$_"; } # ganzes Script lesen in $script
	chomp($script);
	if ( $res == 5 )
	{ $config->postrotate($script); }
	else
	{ $config->prerotate($script); }
      }
      elsif ( $res == 1 || $res == 4 )
      {} # alles ok
    }

    # Datei freigeben und wieder schliessen
    flock $filehandle, 8;
    close $filehandle;
  }
  else # Konfigurationsdatei konnte nicht geffnet werden
  {
    # Warnung ausgeben
    print STDERR "Unable to read configuration from $file\n";
    return undef;
  }
  
  return $config;
}



#===============================================================================
# Hauptprogramm
#
# Argumente:    keine
# Rckgabewert: keine
readFile ( $globalConfig );

# Gehe alle Konfigurationen durch
foreach my $config ( @configs )
{
  my $count=0;

  my @files = glob($config->files());
  foreach my $file (@files)
  {
    if ( $file !~ /^[\.]{0,2}$/ )
    { 
      my $res = checkIfNeeded($config, $file);
      if ( $res ne "" )
      {
	print "\narchiving $file...\n";

        my @oldLogs = getOldLogs($config, $file);
	while ( @oldLogs > ($config->count()-1) )
	{ @oldLogs = removeOldest(@oldLogs); }

        $count++;
	  
	if ( $count == 1 && $config->prerotate() ne "" )
	{
	  print "============== executing prerotate... =============\n";
	  system($config->prerotate());
	  print "=================== ... finished ==================\n";
	}
	
        rotate($config, $file, $res);
      }
    }
    if ( $count >= 1 && $config->potrotate() ne "" )
    {
      print "============== executing postrotate... ============\n";
      system($config->postrotate());
      print "=================== ... finished ==================\n";
    }
  }
}
