From 82ce74888f73ad09a841177c096e6987a481f9c7 Mon Sep 17 00:00:00 2001 From: Frank Brehm Date: Mon, 20 Mar 2006 18:05:23 +0000 Subject: [PATCH] Kompletten Umbau angefangen --- LogRotate.pm | 119 +++ LogRotate/Conf.pm | 1498 +++++++++++++++++++++++++++++ logrotate.pl | 2323 +-------------------------------------------- 3 files changed, 1634 insertions(+), 2306 deletions(-) create mode 100644 LogRotate.pm create mode 100644 LogRotate/Conf.pm diff --git a/LogRotate.pm b/LogRotate.pm new file mode 100644 index 0000000..b0a86ea --- /dev/null +++ b/LogRotate.pm @@ -0,0 +1,119 @@ +package LogRotate; + +# $Id$ +# $URL$ + +=head1 NAME + +B - Logrotate Object Module + +=head1 SYNOPSIS + +B [OPTIONS] config_file+ + +=cut + +#------------------------------------------------------------------------------------ + +use strict; +use 5.8.0; +use warnings; +use Cwd qw(cwd getcwd abs_path); +use File::Basename; +use Data::Dumper; +use POSIX; +use File::Copy; + +use LogRotate::Conf; + +use constant default_firstline_statusfile => "Logrotate State -- Version 2"; +use constant default_buffer_size => 4096; +use constant max_rotate => 100000; + +#------------------------------------------------------------------------------------ + +sub new { + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my $uid = $>; + my ( $gid ) = $) =~ /^(\d+)/; + my ( $res, $cmd ); + + my $self = { + verbose => 0, + test => 0, + force => 0, + statusfile => '/var/lib/logrotate.pl.status', + scripts => {}, + logfiles => {}, + rotatet_files => {}, + files_to_compress => {}, + @_ + }; + + $res = bless $self, $class; + + my $p = $self->{'verbose'} > 2 ? __PACKAGE__ . "::new: " : ""; + + my $conf = new LogRotate::Conf( + 'verbose' => $self->{'verbose'}, + ); + + $self->{'c'} = $conf; + + #return undef unless $self->check_state_file(); + + return $res; + +} + +#------------------------------------------------------------------------------------ + +=head2 read( $file ) + +Liest die uebergebene Datei in die Konfiguration ein. + +=cut + +sub read_config($$) { + + my $self = shift; + my $file = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::read: " : ""; + + return $self->{'c'}->read($file); + +} + +#------------------------------------------------------------------------------------------ + +=head2 verbose() + +Setzt bzw. gibt den Verbose-Level dieses Moduls zurueck. + +=cut + +sub verbose($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $nv = defined $nv ? ( $nv =~ /(\d+)/ ? $1 : 0 ) : 0; + $self->{'verbose'} = $nv; + } + return $self->{'verbose'}; + +} + +1; + +__END__ + +=head1 AUTHOR + +Frank Brehm + +=cut + + diff --git a/LogRotate/Conf.pm b/LogRotate/Conf.pm new file mode 100644 index 0000000..350343d --- /dev/null +++ b/LogRotate/Conf.pm @@ -0,0 +1,1498 @@ +package LogRotate::Conf; + +# $Id$ +# $URL$ + +=head1 NAME + +B - Logrotate Object Module + +=head1 SYNOPSIS + + my $lr_conf = new LogRotate::Conf(); + + $lr_conf->verbose(2); + $lr_conf->default_compress(1); + $lr_conf->default_copytruncate(0); + $lr_conf->default_create_mode(0644); + $lr_conf->default_create_owner('root'); + $lr_conf->default_create_group('bin'); + $lr_conf->default_period('weekly'); + +=cut + +use strict; +use 5.8.0; +use warnings; + +use Carp qw(:DEFAULT cluck); + +#------------------------------------------------------------------------------------ + +use Cwd qw(cwd getcwd abs_path); +use File::Basename; +use Data::Dumper; +#use POSIX; + + +our $AUTOLOAD; +our %ok_field; + +my $MainVersion = "2.0"; + +my $Revis = <<'ENDE'; + $Revision$ +ENDE +$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; +our $VERSION = $MainVersion . "." . $Revis; + +$Data::Dumper::Indent = 1; +$Data::Dumper::Sortkeys = 1; + +my @ValidFields = qw( parent compressext compressoptions ); + +for my $attr ( @ValidFields ) { + $ok_field{$attr}++; +} + +my %ValidPeriods = ( + 'daily' => 1, + 'weekly' => 1, + 'monthly' => 1, + 'yearly' => 1, +); + +my @StandardCompressPrograms = ( + 'gzip', + 'bzip2', + 'compress', +); + +my %StandardCompressPrograms = ( + 'gzip' => '.gz', + 'bzip2' => '.bz2', + 'compress' => '.Z', +); + +#use constant default_firstline_statusfile => "Logrotate State -- Version 2"; +#use constant default_buffer_size => 4096; +#use constant max_rotate => 100000; + +#------------------------------------------------------------------------------------ + +=head1 Funktionen + +=head2 sub new() - Konstruktor + +Wird aufgerufen, um ein neues LogRotate::Conf-Objekt zu erstellen. + +=cut + +sub new { + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my ( $res, $cmd ); + + my $self = { + 'configfiles' => {}, + 'verbose' => 0, + 'included_files' => {}, + 'compress_cmd' => 'Compress::Zlib', + 'COMPRESSEXT' => ".gz", + 'COMPRESSOPTIONS' => "", + 'scripts' => {}, + @_ + }; + + $res = bless $self, $class; + + my $p = $self->verbose() ? __PACKAGE__ . "::new(): " : ""; + $self->reset_defaults(); + $self->add_taboo( '\.rpmnew', 'ext' ); + $self->add_taboo( '\.rpmorig', 'ext' ); + $self->add_taboo( '\.rpmsave', 'ext' ); + $self->add_taboo( ',v', 'ext' ); + $self->add_taboo( '\.swp', 'ext' ); + $self->add_taboo( '~', 'ext' ); + $self->add_taboo( '\.', 'prefix' ); + $self->add_taboo( '\.bak', 'ext' ); + $self->add_taboo( '\.old', 'ext' ); + $self->add_taboo( '\.rej', 'ext' ); + $self->add_taboo( 'CVS', 'file' ); + + if ( $self->{'compress_cmd'} ) { + unless ( $cmd = $self->check_compress_program( $self->{'compress_cmd'}, 1 ) ) { + carp $p . "Kein gueltiges Kompressionsprogramm gefunden, Kompression wird deaktiviert.\n" if $self->{'verbose'}; + $self->{'compress_cmd'} = undef; + } + $self->{'compress_cmd'} = $cmd; + } + + return $res; + +} + +#------------------------------------------------------------------------------------------ + +=head2 AUTOLOAD() + +Autoload-Methode zum Zugriff auf alle möglichen Elemente. + +=cut + +sub AUTOLOAD { + + my $self = shift; + my $attr = $AUTOLOAD; + my ( $val ); + + $attr =~ s/.*:://; + $attr = lc($attr); + + croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr}; + + return $self->verbose(@_) if $attr eq "verbose"; + return $self->compress_cmd(@_) if $attr eq "compress_cmd"; + return $self->default_compress(@_) if $attr eq "default_compress"; + return $self->default_copytruncate(@_) if $attr eq "default_copytruncate"; + return $self->default_create_mode(@_) if $attr eq "default_create_mode"; + return $self->default_create_group(@_) if $attr eq "default_create_group"; + return $self->default_create_owner(@_) if $attr eq "default_create_owner"; + return $self->default_period(@_) if $attr eq "default_period"; + return $self->default_dateext(@_) if $attr eq "default_dateext"; + return $self->default_delaycompress(@_) if $attr eq "default_delaycompress"; + return $self->default_extension(@_) if $attr eq "default_extension"; + return $self->default_if_empty(@_) if $attr eq "default_if_empty" or $attr eq "default_ifempty"; + return $self->default_maxage(@_) if $attr eq "default_maxage"; + return $self->default_missingok(@_) if $attr eq "default_missingok"; + return $self->default_olddir_dirname(@_) if $attr eq "default_olddir_dirname"; + return $self->default_olddir_dateformat(@_) if $attr eq "default_olddir_dateformat"; + return $self->default_olddir_group(@_) if $attr eq "default_olddir_group"; + return $self->default_olddir_mode(@_) if $attr eq "default_olddir_mode"; + return $self->default_olddir_owner(@_) if $attr eq "default_olddir_owner"; + return $self->default_rotate(@_) if $attr eq "default_rotate"; + return $self->default_size(@_) if $attr eq "default_size"; + + if ( @_ ) { + $val = shift; + $self->{uc($attr)} = $val; + } + return $self->{uc($attr)}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 add_taboo( $pattern, [$type] ) + +Fuegt der $self->{'taboo'} - Liste einen weiteren Eintrag hinzu. +Dabei besagt der optionale Parameter $type, ob es sich dabei um ein Praefix-Muster handelt +(C - Suche am Anfang des Dateinamens), um einen kompletten Dateinamen (C - +der Dateiname muss komplett mit dem Suchmuster uebereinstimmen), oder eine Dateiendung +handelt (C - Suche am Ende des Dateinamens). + +Vorgabe fuer $type, wenn nicht uebergeben, ist 'file'. + +=cut + +sub add_taboo($$;$) { + + my $self = shift; + my $pattern = shift || ''; + my $p = $self->verbose() ? __PACKAGE__ . "::add_taboo(): " : ""; + my $type = lc(shift || 'file'); + + $self->{'taboo'} = [] unless $self->{'taboo'}; + + my %Pat = ( 'ext' => '%s$', + 'file' => '^%s$', + 'prefix' => '^%s' ); + + unless ( $Pat{$type} ) { + carp $p . "Ungueltiger Parameter fuer \$type uebergeben: '$type'.\n"; + return; + } + + $pattern = sprintf( $Pat{$type}, $pattern ); + print $p . "Neues Tabu-Pattern: '$pattern'.\n" if $self->verbose() > 3; + push( @{$self->{'taboo'}}, $pattern ); + +} + +#------------------------------------------------------------------------------------------ + +=head2 check_compress_program( $kommando, [$check_if_empty] ) + +Ermittelt anhand des uebergebenen Kommandos das Kompressions-Programm und gibt +es wieder zurueck. + +Wenn das zu verwendende Programm (oder Perl-Modul) nicht vorhanden ist, wird +zuruckgegeben. + +Der optionale Parameter $check_if_empty gibt an, ob trotz nicht uebergebenen oder +gefundenen Kommandos oder Moduls noch einmal die Verfuegbarkeit von +Standard-Kompressionsmodulen oder Programmen gesucht werden soll. + +=cut + +sub check_compress_program($$;$) { + + my $self = shift; + my $cmd = shift || 0; + my $p = $self->verbose() ? __PACKAGE__ . "::check_compress_program(): " : ""; + my $check_if_empty = shift || 0; + my @Dirs; + my ( $dir, $found, $prog ); + + @Dirs = split ":", $ENV{'PATH'}; + + if ( $cmd ) { + if ( $cmd =~ m#^/# ) { + if ( -f $cmd and -x $cmd ) { + print $p . "Kopressionsprogramm in '$cmd' gefunden.\n" if $self->verbose() > 1; + return $cmd; + } else { + warn $p . "Ungueltiges Kopressionsprogramm '$cmd'.\n"; + $cmd = undef; + } + } else { + if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/ ) { + eval "use Compress::Zlib;"; + if ( $@ ) { + warn "$@\n" if $self->{'verbose'}; + $cmd = undef; + } else { + print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if $self->verbose() > 1; + return 'Compress::Zlib'; + } + } elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/ ) { + eval "use Compress::Bzip2;"; + if ( $@ ) { + warn "$@\n" if $self->verbose(); + $cmd = undef; + } else { + print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if $self->verbose() > 1; + return 'Compress::Bzip2'; + } + } else { + foreach $dir ( @Dirs ) { + $prog = $dir . "/" . $cmd; + if ( -f $prog and -x $prog ) { + print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if $self->verbose() > 1; + return $prog; + } + } + warn $p . "'$cmd' nicht gefunden im Suchpfad '$ENV{'PATH'}'.\n"; + $cmd = undef; + } + } + } + + if ( $check_if_empty ) { + + eval "use Compress::Zlib;"; + if ( $@ ) { + $cmd = undef; + } else { + print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if $self->verbose() > 1; + $self->{'compressext'} = ".gz"; + return 'Compress::Zlib'; + } + + eval "use Compress::Bzip2;"; + if ( $@ ) { + $cmd = undef; + } else { + print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if $self->verbose() > 1; + $self->{'compressext'} = ".bz2"; + return 'Compress::Bzip2'; + } + + foreach $cmd ( @StandardCompressPrograms ) { + foreach $dir ( @Dirs ) { + $prog = $dir . "/" . $cmd; + if ( -f $prog and -x $prog ) { + $self->{'compressext'} = $StandardCompressPrograms{$cmd}; + print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if $self->verbose() > 1; + return $prog; + } + } + } + warn $p . "Kein gueltiges Kompressionsprogramm in '$ENV{'PATH'}' gefunden.\n"; + + } + + return undef; + + + +} + +#------------------------------------------------------------------------------------------ + +=head2 compress_cmd( $kommando ) + +Setzt bzw. gibt das zu verwendende Kompressions-Kommando zurueck. + +Wenn das Kompressions-Kommando den Wert 0 oder hat, dann wird grundsaetzlich +nicht komprimiert. + +Wenn das Kompressions-Kommando den Wert 1 oder 'Compress::Zlib' hat, dann wird zur Kompression das +Perl-Modul 'Compress::Zlib' verwendet. + +Wenn das Kompressions-Kommando den Wert 2 oder 'Compress::Bzip2' hat, dann wird zur Kompression das +Perl-Modul 'Compress::Bzip2' verwendet. + +=cut + +sub compress_cmd($;$) { + + my $self = shift; + + if ( @_ ) { + my $cmd = shift; + if ( $cmd ) { + if ( $cmd = $self->check_compress_program( $cmd ) ) { + $self->{'compress_cmd'} = $cmd; + } + } + } + + return $self->{'compress_cmd'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 compress_statement( $_, $f, $in_fd, $linenr ); + +Setzt als logischen Wert, ob die Logdateien komprimiert werden sollen oder nicht. + +=cut + +sub compress_statement($$$$$) { + + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = $self->verbose() ? __PACKAGE__ . "::compress_statement(): " : ""; + + if ( $self->{'compress_cmd'} ) { + if ( $in_fd ) { + $self->{'newfile'}{'compress'} = 1; + } else { + $self->{'default'}{'compress'} = 1; + } + } else { + warn $p . "Kompression unmoeglich, kein Kompressions-Kommando gegeben (Datei '$f', Zeile '$f')\n" if $self->{'verbose'} > 1; + if ( $in_fd ) { + $self->{'newfile'}{'compress'} = undef; + } else { + $self->{'default'}{'compress'} = undef; + } + } + +} + +#------------------------------------------------------------------------------------------ + +=head2 compresscmd_statement( $_, $f, $in_fd, $linenr ); + +Gibt ein alternatives Kompressionsprogramm fuer Logdateien an. + +=cut + +sub compresscmd_statement($$$$$) { + + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = $self->verbose() ? __PACKAGE__ . "::compresscmd_statement(): " : ""; + + my ( $cmd, $name ); + my ( @Values ); + + if ( $in_fd ) { + warn $p . "Die Direktive 'compresscmd' ist nicht innerhalb von Logdatei-Definitionen erlaubt" . + " (Datei '$f', Zeile '$f').\n" if $self->{'verbose'}; + return; + } + + $cmd = $line; + $cmd =~ s/^\S+\s*//; + @Values = $cmd ? $self->parts( $cmd ) : (); + unless ( $Values[0] ) { + warn $p . "Direktive 'compresscmd' ohne dazugehoeriges Kommando gegeben (Datei '$f', Zeile '$f').\n" if $self->{'verbose'}; + return; + } + $cmd = $Values[0]; + + if ( $name = $self->check_compress_program( $cmd ) ) { + $self->{'compress_cmd'} = $name; + return; + } + + warn $p . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte " . + "Kommando '" . $self->{'compress_cmd'} . "' (Datei '$f', Zeile '$f').\n" if $self->{'verbose'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_compress() + +Setzt bzw. gibt die Default-Compress-Einstellung dieses Moduls zurueck. + +=cut + +sub default_compress($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'compress'} = $self->to_bool($nv); + } + return $self->{'default'}{'compress'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_copytruncate() + +Setzt bzw. gibt die Default-copytruncate-Einstellung dieses Moduls zurueck. + +=cut + +sub default_copytruncate($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'copytruncate'} = $nv; + } + return $self->{'default'}{'copytruncate'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_create_group() + +Setzt bzw. gibt die Default-create_group-Einstellung dieses Moduls zurueck. + +(die Eigentuemer-Gruppe einer Logdatei) + +=cut + +sub default_create_group($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam( $nv ) ); + $self->{'default'}{'create'}{'group'} = $nv; + } + } + return $self->{'default'}{'create'}{'group'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_create_mode() + +Setzt bzw. gibt die Default-create_mode-Einstellung dieses Moduls zurueck. + +(die Datei-Permissions der Logdatei) + +=cut + +sub default_create_mode($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : 0644; + $self->{'default'}{'create'}{'mode'} = $nv; + } + return $self->{'default'}{'create'}{'mode'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_create_owner() + +Setzt bzw. gibt die Default-create_owner-Einstellung dieses Moduls zurueck. + +(der Eigentuemer einer Logdatei) + +=cut + +sub default_create_owner($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam( $nv ) ); + $self->{'default'}{'create'}{'owner'} = $nv; + } + } + return $self->{'default'}{'create'}{'owner'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_dateext() + +Setzt bzw. gibt die Default-dateext-Einstellung dieses Moduls zurueck. + +=cut + +sub default_dateext($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'dateext'} = $self->to_bool($nv); + } + return $self->{'default'}{'dateext'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_datepattern() + +Setzt bzw. gibt die Default-datepattern-Einstellung dieses Moduls zurueck. + +=cut + +sub default_datepattern($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'datepattern'} = $nv; + } + return $self->{'default'}{'datepattern'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_delaycompress() + +Setzt bzw. gibt die Default-delaycompress-Einstellung dieses Moduls zurueck. + +=cut + +sub default_delaycompress($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'delaycompress'} = $self->to_bool($nv); + } + return $self->{'default'}{'delaycompress'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_extension() + +Setzt bzw. gibt die Default-extension-Einstellung dieses Moduls zurueck. + +=cut + +sub default_extension($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'extension'} = $nv if defined $nv; + } + return $self->{'default'}{'extension'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_if_empty() + +Setzt bzw. gibt die Default-if_empty-Einstellung dieses Moduls zurueck. + +=cut + +sub default_if_empty($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'if_empty'} = $self->to_bool($nv); + } + return $self->{'default'}{'if_empty'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_max_age() + +Setzt bzw. gibt die Default-max_age-Einstellung dieses Moduls zurueck. + +=cut + +sub default_max_age($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'max_age'} = $self->to_int($nv); + } + return $self->{'default'}{'max_age'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_missingok() + +Setzt bzw. gibt die Default-missingok-Einstellung dieses Moduls zurueck. + +=cut + +sub default_missingok($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'missingok'} = $self->to_bool($nv); + } + return $self->{'default'}{'missingok'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_olddir_dirname() + +Setzt bzw. gibt die Default-olddir_dirname-Einstellung dieses Moduls zurueck. + +=cut + +sub default_olddir_dirname($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'olddir'}{'dirname'} = $nv if defined $nv; + } + return $self->{'olddir'}{'dirname'}{'extension'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_olddir_dateformat() + +Setzt bzw. gibt die Default-olddir_dateformat-Einstellung dieses Moduls zurueck. + +=cut + +sub default_olddir_dateformat($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'olddir'}{'dateformat'} = $nv; + } + return $self->{'default'}{'olddir'}{'dateformat'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_olddir_group() + +Setzt bzw. gibt die Default-olddir_group-Einstellung dieses Moduls zurueck. + +=cut + +sub default_olddir_group($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam( $nv ) ); + $self->{'default'}{'olddir'}{'group'} = $nv; + } else { + $self->{'default'}{'olddir'}{'group'} = undef; + } + } + return $self->{'default'}{'olddir'}{'group'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_olddir_mode() + +Setzt bzw. gibt die Default-olddir_group-Einstellung dieses Moduls zurueck. + +=cut + +sub default_olddir_mode($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : undef; + $self->{'default'}{'olddir'}{'mode'} = $nv; + } + return $self->{'default'}{'olddir'}{'mode'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_olddir_owner() + +Setzt bzw. gibt die Default-olddir_owner-Einstellung dieses Moduls zurueck. + +=cut + +sub default_olddir_owner($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam( $nv ) ); + $self->{'default'}{'olddir'}{'owner'} = $nv; + } else { + $self->{'default'}{'olddir'}{'owner'} = undef; + } + } + return $self->{'default'}{'olddir'}{'owner'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_period() + +Setzt bzw. gibt die Default-period-Einstellung dieses Moduls zurueck. + +(die Rotations-Periode einer Logdatei) + +=cut + +sub default_period($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $nv = lc($nv); + $self->{'default'}{'period'} = $nv if $ValidPeriods{$nv}; + } + } + return $self->{'default'}{'period'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_rotate() + +Setzt bzw. gibt die Default-rotate-Einstellung dieses Moduls zurueck. + +=cut + +sub default_rotate($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $self->{'default'}{'rotate'} = $self->to_int($nv); + } + return $self->{'default'}{'rotate'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 default_size() + +Setzt bzw. gibt die Default-size-Einstellung dieses Moduls zurueck. + +=cut + +sub default_size($;$) { + + my $self = shift; + my ( $nv, $val ); + if ( @_ ) { + $nv = shift; + if ( defined $nv ) { + $val = $self->human2byte($nv); + $self->{'default'}{'size'} = $val if defined $val; + } + } + return $self->{'default'}{'size'}; + +} + +#------------------------------------------------------------------------------------------ + +=head2 do_include( $zeile, $file, $in_fd, $linenr ) + +Fuehrt eine Include-Anweisung aus. + +In dieser wird entweder eine spezielle Datei (oder mehrere mit Shell-Muster), oder ein +komplettes Verzeichnis (unter Beachtung der Tabu-Muster) mit eingelesen. + +=cut + +sub do_include($$$$$) { + + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = $self->verbose() ? __PACKAGE__ . "::do_include(): " : ""; + + my ( $if, $dir, $basename, $name, $bname, $found, $pattern ); + + if ( $in_fd ) { + warn $p . "include-Directiven innerhalb von Logfile-Definitionen sind nicht erlaubt" . + "(Zeile $linenr in datei '$f')\n"; + return undef; + } + + # Das Wort 'include selbst wegschmeissen + $line =~ s/^\S+\s*//; + + my @Values = $self->parts($line); + + # Fehlermeldung, wenn der Dateiname fehlt + unless ( @Values ) { + warn $p . "Include-Directive ohne Datei- oder Verzzeichnisangabe in Datei '$f', Zeile $linenr gefunden.\n"; + return undef; + } + + $if = $Values[0]; + warn $p . "Nur ein Include pro Direktive ist erlaubt. Der erste Eintrag '$if' wird verwendet." . + " (Datei ''$f', Zeile $linenr).\n" if scalar @Values > 1; + + if ( $if !~ m#^/# ) { + if ( $f =~ m#/# ) { + ( $dir, $basename ) = $f =~ m#(.*)/([^/]+)$#; + } else { + $dir = "."; + $basename = $f; + } + $if = $dir . "/" . $if; + } + + if ( -f $if ) { + if ( $self->{'included_files'}{$if} ) { + warn $p . "Rekursives Includen von '$if' in Datei '$f', Zeile $linenr.\n"; + return undef; + } + print $p . "Include Datei '$if' ...\n" if $self->{'verbose'} > 1; + $self->{'included_files'}{$if} = 1; + return $self->read( $f ); + } + + if ( -d $if ) { + + print $p . "Include Verzeichnis '$if' ...\n" if $self->{'verbose'} > 1; + + foreach $name ( glob( "$if/.* $if/*") ) { + + $bname = basename( $name ); + next if $bname eq "." or $bname eq ".."; + + print $p . "Checke Include-Datei '$if/$bname' ...\n" if $self->{'verbose'} > 1; + if ( -d "$if/$bname" ) { + # Keine Verzeichnis-Rekursion !!! + print $p . "Verzeichnis '$if/$bname' wird uebergangen.\n" if $self->{'verbose'} > 1; + next; + } + + # Check auf Tabu-Dateinamen + $found = 0; + foreach $pattern ( @{$self->{'taboo'}} ) { + if ( $bname =~ /$pattern/ ) { + $found = 1; + print $p . "Datei '$if/$bname' matcht Tabu-Pattern '$pattern', wird uebergangen.\n" if $self->{'verbose'} > 1; + last; + } + } + next if $found; + + if ( $self->{'included_files'}{$name} ) { + warn $p . "Rekursives Includen von '$name' in Datei '$f', Zeile $linenr.\n"; + return undef; + } + print $p . "Include Datei '$name' ...\n" if $self->{'verbose'} > 1; + $self->{'included_files'}{$name} = 1; + + return undef unless $self->read( $name ); + + } + + return 1; + + } + + warn $p . "Ungueltige Include-Direktive '$line' in Datei '$f', Zeile $linenr gefunden.\n"; + return undef; + +} + +#------------------------------------------------------------------------------------------ + +=head2 human2byte( $wert ) + +Wandelt eine Bytzahl, die fuer den Menschen lesbar ist, in einen Integer-Wert von Bytes um. + +Z.Bsp.: + + '10 KByte' => 10240 + +=cut + +sub human2byte($$) { + + my $self = shift; + my $val = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::human2byte(): " : ""; + + return undef unless defined $val; + print $p . "aufgerufen mit '" . $val . "'.\n" if $self->verbose() > 5; + return 0 if $val =~ /^\s*$/; + + my ( $unit, $factor ); + + if ( $val =~ /^\s*(\d+(?:\.\d*))\s*(?:([kmg])(?:b|byte))?\s*$/i ) { + $factor = 1; + $val = $1 + 0; + $unit = lc( $2 || 'b' ); + if ( $unit eq 'k' ) { + $factor = 1024; + } elsif ( $unit eq 'm' ) { + $factor = 1024 * 1024; + } elsif ( $unit eq 'g' ) { + $factor = 1024 * 1024 * 1024; + } + print $p . "Faktor fuer '$unit': " . $factor . "'.\n" if $self->verbose() > 5; + $val = int( $val * $factor ); + } else { + warn $p . "Ungueltige Byte-Angabe: '$val'.\n"; + $val = undef; + } + + return $val; + +} + +#------------------------------------------------------------------------------------------ + +=head2 log_begin( $_, $f, $in_fd, $linenr ); + +Verarbeitet den Beginn einer Logfile-Definition (Geschweifte Klammer auf). + +=cut + +sub log_begin($$$$$) { + + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = $self->verbose() ? __PACKAGE__ . "::log_begin(): " : ""; + + my ( @Values, @Files, @FileGlob ); + my ( $name, $file ); + + if ( $in_fd ) { + warn $p . "Verschachtelte Logfile-Definition in Konfigdatei '$f', Zeile $linenr.\n"; + return 1; + } + + $line =~ s/\s*{$//; + @Values = $self->parts( $line ); + + unless ( @Values ) { + warn $p . "Kein Dateiname fuer eine Logdatei am Beginn der Logdatei-Definition in Konfigdatei '" . + $f . "', Zeile $linenr gefunden.\n"; + return undef; + } + + print "\nStart Logfile-Definition:\n - " . join( "\n - ", @Values ) . "\n" if $self->{'verbose'} > 2; + + @Files = (); + foreach $name ( @Values ) { + + if ( $name =~ m#^/# ) { + + # Datei-Globbing aufloesen + if ( $name =~ /[\*\?\[]/ ) { + @FileGlob = glob( $name ); + $FileGlob[0] = $name unless scalar @FileGlob; + } else { + @FileGlob = (); + $FileGlob[0] = $name; + } + + foreach $file ( @FileGlob ) { + next if -d $file; + if ( $self->{'logfiles'}{$file} ) { + warn $p . "Die Logdatei '$file' wurde bereits definiert. Die neue Definition " . + "wird die alte ueberschreiben (Datei '$f', Zeile $linenr).\n"; + } + push @Files, $file; + } + + } else { + warn $p . "Die Logdatei '$file' hat keine absolute Pfaddefinition (Datei '$f', Zeile $linenr).\n"; + } + + } + + if ( scalar @Files ) { + $self->{'newfile'} = {}; + %{$self->{'newfile'}} = %{$self->{'default'}}; + $self->{'newfile'}{'files'} = [ @Files ]; + $self->{'newfile'}{'create'} = {}; + %{$self->{'newfile'}{'create'}} = %{$self->{'default'}{'create'}}; + $self->{'newfile'}{'olddir'} = {}; + %{$self->{'newfile'}{'olddir'}} = %{$self->{'default'}{'olddir'}}; + } + + return 1; + +} + +#------------------------------------------------------------------------------------------ + +=head2 log_end( $_, $f, $in_fd, $linenr ); + +Schliesst eine Logfile-Definition ab. + +=cut + +sub log_end($$$$$) { + + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = $self->verbose() ? __PACKAGE__ . "::log_end(): " : ""; + + my ( $name ); + + unless ( $in_fd ) { + warn $p . "Alleinstehende schliessende geschweifte Klammer in Konfigdatei '$f', Zeile $linenr gefunden.\n"; + return undef; + } + + print "Ende Logfile-Definition\n" if $self->{'verbose'} > 2; + print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if $self->{'verbose'} > 3; + + foreach $name ( @{$self->{'newfile'}{'files'}} ) { + %{$self->{'logfiles'}{$name}} = %{$self->{'newfile'}}; + $self->{'logfiles'}{$name}{'create'} = {}; + %{$self->{'logfiles'}{$name}{'create'}} = %{$self->{'newfile'}{'create'}}; + $self->{'logfiles'}{$name}{'olddir'} = {}; + if ( defined $self->{'newfile'}{'olddir'} ) { + %{$self->{'logfiles'}{$name}{'olddir'}} = %{$self->{'newfile'}{'olddir'}}; + } else { + $self->{'logfiles'}{$name}{'olddir'} = undef; + } + delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'}; + $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++ if $self->{'newfile'}{'postrotate'}; + } + + return 1; + + +} + +#------------------------------------------------------------------------------------------ + +=head2 new_script_name( [$scriptname] ) + +Ermittelt einen neuen einmaligen Scriptnamen. + +=cut + +sub new_script_name($;$) { + + my $self = shift; + my $pre = shift || "script"; + my $p = $self->verbose() ? __PACKAGE__ . "::new_script_name(): " : ""; + + my $i = 0; + my $name = "$pre$i"; + + while ( 1 ) { + if ( defined $self->{'scripts'}{$name}{'cmd'} ) { + if ( scalar @{$self->{'scripts'}{$name}{'cmd'}} ) { + $i++; + $name = "$pre$i"; + } else { + last; + } + } else { + last; + } + } + + return $name; +} + +#------------------------------------------------------------------------------------ + +=head2 parts( $string ) + +Zerlegt einen String an Whitespaces in seine Bestandteile unter Beachtung +von Quotierung und gibt diese als Array zurueck. + +=cut + +sub parts($$) { + + my $self = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::parts(): " : ""; + + my $term = shift; + my @Parts = (); + my $part; + + while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) { + $part = $1 || $2; + $part =~ s/\\"/"/g; + push @Parts, $part; + } + + return @Parts; + +} + +#------------------------------------------------------------------------------------------ + +=head2 read( $file ) + +Liest die uebergebene Datei in die Konfiguration ein. + +=cut + +sub read($$) { + + my $self = shift; + my $file = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::read(): " : ""; + + my ( $dir, $f, $real_dir, $linenr, $in_fd, $in_script, $newscript, $lastrow ); + my ( @Lines ); + + print $p . "Aufgerufen mit '" . $file . "'.\n" if $self->verbose() > 2; + + unless ( $file ) { + carp $p . "Keine Datei uebergeben.\n"; + return undef; + } + + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n"; + return undef; + } + + if ( $file =~ m#/# ) { + ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#; + } else { + $dir = "."; + $f = $file; + } + $real_dir = abs_path( $dir ); + print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if $self->{'verbose'} > 2; + $f = $real_dir . "/" . $f; + + if ( $self->{'configfiles'}{$f} ) { + warn $p . "recursive call for file '$f', exiting.\n"; + return undef; + } + + $self->{'configfiles'}{$f} = 1; + + print $p . "Lese Datei '$f' ...\n" if $self->{'verbose'}; + unless ( open FILE, "<$f" ) { + warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n"; + return undef; + } + + @Lines = ; + close FILE; + + $linenr = 0; + $in_fd = 0; + $in_script = 0; + $lastrow = ""; + + # Alle Zeilen abklappern + foreach ( @Lines ) { + + $linenr++; + + # Zeilen vorn und hinten abschneiden + s#^\s+##; + s#\s+$##; + + # Behandlung von \ am Ende der Zeile + $_ = $lastrow . $_; + if ( /\\$/ ) { + s/\\$//; + $lastrow = $_; + next; + } + $lastrow = ""; + + # Kommentare raus + s/^#.*//; + + next unless $_; + + # Scriptinhalt zusammensuchen + if ( $in_script ) { + if ( /^endscript$/ ) { + # Script ist zuende + $in_script = 0; + next; + } + push @{$self->{'scripts'}{$newscript}{'cmd'}}, $_; + next; + } + + if ( /{$/ ) { + return undef unless $in_fd = $self->log_begin( $_, $f, $in_fd, $linenr ); + next; + } + + if ( /^}/ ) { + return undef unless $self->log_end( $_, $f, $in_fd, $linenr ); + $in_fd = 0; + next; + } + + if ( /^include\s/i ) { + return undef unless $self->do_include( $_, $f, $in_fd, $linenr ); + next; + } + + if ( /^compress$/i ) { + $self->compress_statement( $_, $f, $in_fd, $linenr ); + next; + } + + + + } + + + return 1; + +} + +#------------------------------------------------------------------------------------------ + +=reset_defaults() + +Setzt die $self->{'defaults'} - Datenstruktur auf Vorgabewerte zurueck. + +=cut + +sub reset_defaults($) { + + my $self = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::reset_defaults(): " : ""; + my $uid = $>; + my ( $gid ) = $) =~ /^(\d+)/; + + print $p . "Setze \$self->{'defaults'} auf Vorgabewerte zurueck.\n" if $self->verbose > 3; + + $self->{'default'} = { + 'compress' => 0, + 'copytruncate' => 0, + 'create' => { + 'mode' => 0644, + 'owner' => $uid, + 'group' => $gid, + }, + 'period' => 'weekly', + 'dateext' => 0, + 'datepattern' => '%Y-%m-%d', + 'delaycompress' => 0, + 'extension' => "", + 'ifempty' => 1, + 'maxage' => 0, + 'missingok' => 0, + 'olddir' => { + 'dirname' => '', + 'dateformat' => undef, + 'mode' => undef, + 'owner' => undef, + 'group' => undef, + }, + 'rotate' => 4, + 'size' => 0, + }; + +} + +#------------------------------------------------------------------------------------------ + +=head2 to_bool( $wert ) + +Wandelt den uebergebenen Scalar sicher in einen Wahrheitswert (0 oder 1) um. + +=cut + +sub to_bool($$) { + + my $self = shift; + my $val = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::to_bool(): " : ""; + + return 0 unless defined $val; + print $p . "aufgerufen mit '" . $val . "'.\n" if $self->verbose() > 5; + return 0 if $val =~ /^\s*$/; + + if ( $val =~ /^\s*y(?:es?)?/i or + $val =~ /^\s*ja?/i or + $val =~ /^\s*[wt]\s*$/i or + $val =~ /^\s*on\s*$/i or + $val =~ /^\s*wahr|true/i ) { + return 1; + } + + if ( $val =~ /^\s*no?/i or + $val =~ /^\s*ne(?:in?)?/i or + $val =~ /^\s*f\s*$/i or + $val =~ /^\s*off\s*$/i or + $val =~ /^\s*falsch|false/i ) { + return 0; + } + + my $intval = $self->to_int($val); + if ( defined $intval ) { + return $intval ? 1 : 0; + } + + return $val ? 1 : 0; + +} + +#------------------------------------------------------------------------------------------ + +=head2 to_int( $wert, $signed ) + +Wandelt den übergebenen Wert sicher in eine Integer-Zahl um. + +Dabei legt der optionale logische Parameter $signed fest, ob auch +vorzeichenbehaftete Werte zulässig sind. + +Wenn keine gültige Zahl übergeben wird, wird undef zurückgegeben. + +=cut + +sub to_int($$;$) { + + my $self = shift; + my $val = shift; + my $signed = shift; + my $p = $self->verbose() ? __PACKAGE__ . "::to_int(): " : ""; + + return undef unless defined $val; + print $p . "aufgerufen mit '" . $val . "'.\n" if $self->verbose() > 5; + unless ( $val =~ /\d/ ) { + return undef; + } + + if ( $signed ) { + $val =~ s/.*((-\s*)?\d+).*/$1$2/; + } else { + $val =~ s/.*(\d+).*/$1/; + } + print $p . "Neuer Wert: '" . ( defined($val) ? $val : "" ) . "'.\n" if $self->verbose() > 5; + + return $val + 0; + +} + +#------------------------------------------------------------------------------------------ + +=head2 verbose() + +Setzt bzw. gibt den Verbose-Level dieses Moduls zurueck. + +=cut + +sub verbose($;$) { + + my $self = shift; + my $nv; + if ( @_ ) { + $nv = shift; + $nv = defined $nv ? ( $nv =~ /(\d+)/ ? $1 : 0 ) : 0; + $self->{'verbose'} = $nv; + } + return $self->{'verbose'}; + +} + + +__END__ + +=head1 AUTHOR + +Frank Brehm + +=cut + + diff --git a/logrotate.pl b/logrotate.pl index c7ac75b..77ea21c 100755 --- a/logrotate.pl +++ b/logrotate.pl @@ -54,18 +54,19 @@ The default state file is C. =cut -use 5.005; use strict; - -$^W = 1; +use 5.8.0; +use warnings; use Getopt::Long; use Data::Dumper; -our $VERSION = "1.21"; +use LogRotate; + +our $VERSION = "2.0"; my $DefConfigFile = "/etc/logrotate.conf"; -my $DefStateFile = "/var/lib/logrotate.pl.status"; +my $DefStateFile = "/var/lib/logrotate.status"; my $ConfigFile = $DefConfigFile; my $StateFile = $DefStateFile; my $force = 0; @@ -77,13 +78,6 @@ my $test = 0; my $config_check = 0; my $config = {}; -my $CompressModule = "Compress::Zlib"; -my @CompressPrograms = qw( gzip bzip2 compress ); -my %CompressExts = ( 1 => ".gz", - "gzip" => ".gz", - "bzip2" => ".bz2", - "compress" => ".Z" ); - my @ActDate = localtime(); $| = 1; @@ -127,6 +121,8 @@ if ( $Debug ) { $test = 1 if $config_check; +$test = 1; + if ( $verbose and not $test ) { print "\n" . ( "#" x 80 ) . "\n"; print "$0 starts with logrotation at: " . localtime() . "\n\n"; @@ -163,21 +159,23 @@ print "Used configuration files: " . join( ",\n ", @Con ".\n\n" if $verbose > 1; print "\n" . $p . "initialisation:\n\n" if $verbose; -my $lr = new logrotate( verbose => $verbose, +my $lr = new LogRotate( verbose => $verbose, test => $test, force => $force, statusfile => $StateFile ); - -print Dumper( $lr ) if $verbose > 3; - -print "\n" . $p . "reading config files:\n\n" if $verbose > 1; +print "\n" . $p . "Lese Konfig-Dateien:\n\n" if $verbose > 1; foreach $ConfigFile ( @ConfigFiles ) { $res = $lr->read_config( $ConfigFile ); + exit 10 unless $res; } +print Dumper( $lr ) if $verbose > 3; + +exit 0; + $lr->read_state_file(); print Dumper( $lr ) if $verbose > 2; @@ -223,2295 +221,6 @@ ENDE } -##################################################################################### -#------------------------------------------------------------------------------------ -##################################################################################### - -package logrotate; - -# Header: /opt/cvsroot/logrotate/logrotate.pm,v 1.7 2003/08/25 12:03:57 fbrehm Exp - -require Exporter; -use Carp qw(:DEFAULT cluck); - -#------------------------------------------------------------------------------------ - -use strict; -use Cwd qw(cwd getcwd abs_path); -use File::Basename; -use Data::Dumper; -use POSIX; -use File::Copy; -$^W = 1; - -use constant default_firstline_statusfile => "Logrotate State -- Version 2"; -use constant default_buffer_size => 4096; -use constant max_rotate => 100000; - -#------------------------------------------------------------------------------------ - -sub new { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my $uid = $>; - my ( $gid ) = $) =~ /^(\d+)/; - my ( $res, $cmd ); - - my $self = { - verbose => 0, - test => 0, - force => 0, - included_files => {}, - compress_cmd => 1, - compressext => ".gz", - compressoptions => "", - default => { compress => 0, - copytruncate => 0, - create => { mode => 0644, - owner => $uid, - group => $gid }, - period => 'weekly', - dateext => 0, - datepattern => "%Y-%m-%d", - delaycompress => 0, - extension => "", - ifempty => 1, - maxage => 0, - missingok => 0, - olddir => { dirname => '', - dateformat => undef, - mode => undef, - owner => undef, - group => undef }, - rotate => 4, - sharedscripts => 1, - size => 0, - lastrotated => "", - targetfile => "", - }, - taboo => [ '\.rpmorig$', - '\.rpmsave$', - ',v$', - '\.swp$', - '\.rpmnew$', - '~$', - '^\.' ], - statusfile => '/var/lib/logrotate.pl.status', - scripts => {}, - logfiles => {}, - configfiles => {}, - rotatet_files => {}, - files_to_compress => {}, - @_ - }; - - $res = bless $self, $class; - - my $p = $self->{'verbose'} > 2 ? "logrotate::new: " : ""; - - return undef unless $self->check_state_file(); - - if ( $self->{'compress_cmd'} ) { - unless ( $cmd = $self->check_compress_program( $self->{'compress_cmd'}, 1 ) ) { - carp $p . "no valid compression program given, compression disabled.\n" if $self->{'verbose'}; - $self->{'compress_cmd'} = undef; - } - $self->{'compress_cmd'} = $cmd; - } - - return $res; - -} - -#------------------------------------------------------------------------------------ - -sub check_state_file { - my $self = shift; - - my $f = $self->{'statusfile'}; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_state_file: " : ""; - - unless ( $f ) { - carp $p . "No status file defined.\n"; - return undef; - } - - print $p . "checking '$f'.\n" if $self->{'verbose'} > 1; - - if ( -f $f ) { - if ( open FILE, "<$f" ) { - close FILE; - } else { - warn $p . "Error in open status file '$f' for read: $!\n"; - return undef; - } - } - - unless ( $self->{'test'} ) { - if ( open FILE, ">>$f" ) { - close FILE; - } else { - warn $p . "Error in open status file '$f' for write: $!\n"; - return undef; - } - } - - return 1; -} - -#------------------------------------------------------------------------------------ - -sub read_state_file { - my $self = shift; - - my $f = $self->{'statusfile'}; - my $p = $self->{'verbose'} > 2 ? "logrotate::read_state_file: " : ""; - my $i = 0; - my ( $file, $date ); - - unless ( $f ) { - carp $p . "No status file defined.\n"; - return undef; - } - - print $p . "reading '$f'.\n" if $self->{'verbose'} > 1; - - if ( -f $f ) { - if ( open FILE, "<$f" ) { - - while ( $_ = ) { - $i++; - if ( $i == 1 ) { - if ( /^logrotate state -- version [12]$/i ) { - next; - } else { - warn $p . "uncompatible version of state file '$f'.\n"; - close FILE; - return undef; - } - } - s/^\s+//; - s/\s+$//; - - if ( $_ ) { - ( $file, $date ) = $self->parts( $_ ); - if ( $file and $date ) { - if ( $self->{'logfiles'}{$file} ) { - $self->{'logfiles'}{$file}{'lastrotated'} = $date; - } - } - } - } - - close FILE; - } else { - warn $p . "Error in open status file '$f' for read: $!\n"; - return undef; - } - } - return 1; - -} - -#------------------------------------------------------------------------------------ - -sub check_compress_program { - - my $self = shift; - my $cmd = shift || 0; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_compress_program: " : ""; - my $check_if_empty = shift || 0; - my @Dirs; - my ( $dir, $found, $prog ); - - @Dirs = split ":", $ENV{'PATH'}; - - if ( $cmd ) { - if ( $cmd =~ m#^/# ) { - if ( -f $cmd and -x $cmd ) { - print $p . "Found compression program in '$cmd'.\n" - if $self->{'verbose'} > 1; - return $cmd; - } else { - warn $p . "Invalid compression program '$cmd'.\n"; - $cmd = undef; - } - } else { - if ( $cmd eq "1" or $cmd =~ /^$CompressModule$/i ) { - eval "use $CompressModule;"; - if ( $@ ) { - warn "$@\n" if $self->{'verbose'}; - $cmd = undef; - } else { - print $p . "use perl module '$CompressModule' for compression.\n" - if $self->{'verbose'} > 1; - return 1; - } - } else { - foreach $dir ( @Dirs ) { - $prog = $dir . "/" . $cmd; - if ( -f $prog and -x $prog ) { - print $p . "Found compression program in '$prog'.\n" - if $self->{'verbose'} > 1; - return $prog; - } - } - warn $p . "'$cmd' not found in search path '$ENV{'PATH'}'.\n"; - $cmd = undef; - } - } - } - - if ( $check_if_empty ) { - - eval "use $CompressModule;"; - if ( $@ ) { - $cmd = undef; - } else { - print $p . "use perl module '$CompressModule' for compression.\n" - if $self->{'verbose'} > 1; - return 1; - } - - foreach $cmd ( @CompressPrograms ) { - foreach $dir ( @Dirs ) { - $prog = $dir . "/" . $cmd; - if ( -f $prog and -x $prog ) { - $self->{'compressext'} = $CompressExts{$cmd}; - print $p . "Found compression program in '$prog'.\n" if $self->{'verbose'} > 1; - return $prog; - } - } - } - warn $p . "No valid compress program found in '$ENV{'PATH'}'.\n"; - - } - - return undef; - -} - -#------------------------------------------------------------------------------------------ - -sub read_config { - - my $self = shift; - my $file = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::read_config: " : ""; - - my ( $f, $dir, $real_dir, $c_comment, $linenr, $in_fd, $in_script, $newscript ); - my ( @Lines ); - - unless ( $file ) { - carp $p . "No file given.\n"; - return undef; - } - - unless ( -f $file ) { - warn $p . "file '$file' doesn't exists.\n"; - return undef; - } - - if ( $file =~ m#/# ) { - ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#; - } else { - $dir = "."; - $f = $file; - } - $real_dir = abs_path( $dir ); - print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if $self->{'verbose'} > 2; - $f = $real_dir . "/" . $f; - # $f = abs_path( $file ); - - if ( $self->{'configfiles'}{$f} ) { - warn $p . "recursive call for file '$f', exiting.\n"; - return undef; - } - - $self->{'configfiles'}{$f} = 1; - - print $p . "Try to read file '$f' ...\n" if $self->{'verbose'} > 1; - unless ( open FILE, "<$f" ) { - warn $p . "couldn't open file '$f': $!\n"; - return undef; - } - - print $p . "reading file '$f' ...\n" if $self->{'verbose'}; - @Lines = ; - close FILE; - - $c_comment = 0; - $linenr = 0; - $in_fd = 0; - $in_script = 0; - - # Alle Zeilen abklappern - foreach ( @Lines ) { - $linenr++; - s#^\s+##; - s#\s+$##; - - s/^#.*//; - if ( $_ ) { - - # Scriptinhalt zusammensuchen - if ( $in_script ) { - if ( /^endscript$/ ) { - # Script ist zuende - $in_script = 0; - next; - } - push @{$self->{'scripts'}{$newscript}{'cmd'}}, $_; - next; - } - - if ( /{$/ ) { - return undef unless $in_fd = $self->check_log_begin( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^}/ ) { - return undef unless $self->check_log_end( $_, $f, $in_fd, $linenr ); - $in_fd = 0; - next; - } - - if ( /^include\s/i ) { - return undef unless $self->check_include( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^compress$/i ) { - $self->check_compress( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^compresscmd\s/i ) { - $self->check_compresscmd( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^compressext\s/i ) { - $self->check_compressext( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^compressoptions(?:\s+.*)?$/i ) { - $self->check_compressoptions( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^copytruncate$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'copytruncate'} = 1; - } else { - $self->{'default'}{'copytruncate'} = 1; - } - next; - } - - if ( /^create(?:\s+.*)?$/i ) { - $self->check_create( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^daily$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'period'} = 'daily'; - } else { - $self->{'default'}{'period'} = 'daily'; - } - next; - } - - if ( /^dateext(?:\s+.*)?$/i ) { - $self->check_dateext( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^nodateext$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'dateext'} = 0; - } else { - $self->{'default'}{'dateext'} = 0; - } - next; - } - - if ( /^delaycompress$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'delaycompress'} = 1; - } else { - $self->{'default'}{'delaycompress'} = 1; - } - next; - } - - if ( /^(errors)\s/i ) { - warn $p . "unsupported feature '$1' found " . - "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2; - } - - if ( /^extension(?:\s+.*)?$/i ) { - $self->check_extension( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^ifempty$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'ifempty'} = 1; - } else { - $self->{'default'}{'ifempty'} = 1; - } - next; - } - - if ( /^((?:no)?mail)\s/i ) { - warn $p . "Unsupported feature '$1' found " . - "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2; - } - - if ( /^(mail(?:first|last))/i ) { - warn $p . "Unsupported feature '$1' found " . - "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2; - } - - if ( /^maxage\s/i ) { - $self->check_maxage( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^missingok$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'missingok'} = 1; - } else { - $self->{'default'}{'missingok'} = 1; - } - next; - } - - if ( /^monthly$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'period'} = 'monthly'; - } else { - $self->{'default'}{'period'} = 'monthly'; - } - next; - } - - if ( /^nocompress$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'compress'} = 0; - } else { - $self->{'default'}{'compress'} = 0; - } - next; - } - - if ( /^nocreate$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'copytruncate'} = 1; - } else { - $self->{'default'}{'copytruncate'} = 1; - } - next; - } - - if ( /^nocopytruncate$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'copytruncate'} = 0; - } else { - $self->{'default'}{'copytruncate'} = 0; - } - next; - } - - if ( /^nodelaycompress$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'delaycompress'} = 0; - } else { - $self->{'default'}{'delaycompress'} = 0; - } - next; - } - - if ( /^nomissingok$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'missingok'} = 0; - } else { - $self->{'default'}{'missingok'} = 0; - } - next; - } - - if ( /^noolddir$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'olddir'} = undef; - } else { - $self->{'default'}{'olddir'} = undef; - } - next; - } - - if ( /^nosharedscripts$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'sharedscripts'} = 0; - } else { - $self->{'default'}{'sharedscripts'} = 0; - } - next; - } - - if ( /^notifempty$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'ifempty'} = 0; - } else { - $self->{'default'}{'ifempty'} = 0; - } - next; - } - - if ( /^olddir\s/i ) { - $self->check_olddir( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^postrotate(?:\s+.*)?$/i ) { - $in_script = 1 if $newscript = $self->check_postrotate( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^prerotate(?:\s+.*)?$/i ) { - $in_script = 1 if $newscript = $self->check_prerotate( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^rotate\s/i ) { - $self->check_rotate( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^script\s/i ) { - $in_script = 1 if $newscript = $self->check_script( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^size[\s=]/i ) { - $self->check_size( $_, $f, $in_fd, $linenr ); - next; - } - - if ( /^sharedscripts$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'sharedscripts'} = 1; - } else { - $self->{'default'}{'sharedscripts'} = 1; - } - next; - } - - if ( /^tabooext\s/i ) { - $self->check_taboo( $_, $f, $in_fd, $linenr, 'ext' ); - next; - } - - if ( /^taboofile\s/i ) { - $self->check_taboo( $_, $f, $in_fd, $linenr, 'file' ); - next; - } - - if ( /^tabooprefix\s/i ) { - $self->check_taboo( $_, $f, $in_fd, $linenr, 'prefix' ); - next; - } - - if ( /^weekly$/i ) { - if ( $in_fd ) { - $self->{'newfile'}{'period'} = 'weekly'; - } else { - $self->{'default'}{'period'} = 'weekly'; - } - next; - } - - if ( /^(uncompresscmd)\s/i ) { - warn $p . "unsupported feature '$1' found " . - "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2; - } - - warn $p . "Unknown or invalide directive '$_' found (line $linenr of file '$f').\n" - if $self->{'verbose'} > 1; - - } - - } - - return 1; -} - -#------------------------------------------------------------------------------------------ - -sub check_log_begin { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_log_begin: " : ""; - - my ( @Values, @Files, @FileGlob ); - my ( $name, $file ); - - if ( $in_fd ) { - warn $p . "Nested logfile definition in configuration file '$f' line $linenr.\n"; - return 1; - } - - $line =~ s/\s*{$//; - @Values = $self->parts( $line ); - - if ( @Values ) { - print "\nStart logfile definition: - " . join( "\n" . (" " x 26) . "- ", @Values ) . "\n" - if $self->{'verbose'} > 2; - @Files = (); - foreach $name ( @Values ) { - if ( $name =~ m#^/# ) { - if ( $name =~ /[\*\?\[]/ ) { - @FileGlob = glob( $name ); - $FileGlob[0] = $name unless scalar @FileGlob; - } else { - @FileGlob = (); - $FileGlob[0] = $name; - } - foreach $file ( @FileGlob ) { - next if -d $file; - if ( $self->{'logfiles'}{$file} ) { - warn $p . "logfile '$file' has even a definition, " . - "the new definition will overwrite the old one. (line $linenr in file '$f').\n"; - } - push @Files, $file; - } - } else { - warn $p . "logfile '$name' has not an absolute path (line $linenr in file '$f').\n"; - } - } - if ( scalar @Files ) { - $self->{'newfile'} = {}; - %{$self->{'newfile'}} = %{$self->{'default'}}; - $self->{'newfile'}{'files'} = [ @Files ]; - $self->{'newfile'}{'create'} = {}; - %{$self->{'newfile'}{'create'}} = %{$self->{'default'}{'create'}}; - $self->{'newfile'}{'olddir'} = {}; - %{$self->{'newfile'}{'olddir'}} = %{$self->{'default'}{'olddir'}}; - } - } else { - warn $p . "No filename of a logfile found in beginning" . - " of the logfile definition in configuration file '$f' line $linenr.\n"; - return 0; - } - - return 1; -} - -#------------------------------------------------------------------------------------------ - -sub check_log_end { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 1 ? "logrotate::check_log_end: " : ""; - - my ( $name ); - - unless ( $in_fd ) { - warn $p . "Found standalone closing curl in configuration file '$f' line $linenr.\n"; - return undef; - } - - print "End logfile definition\n" if $self->{'verbose'} > 2; - print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if $self->{'verbose'} > 3; - foreach $name ( @{$self->{'newfile'}{'files'}} ) { - %{$self->{'logfiles'}{$name}} = %{$self->{'newfile'}}; - $self->{'logfiles'}{$name}{'create'} = {}; - %{$self->{'logfiles'}{$name}{'create'}} = %{$self->{'newfile'}{'create'}}; - $self->{'logfiles'}{$name}{'olddir'} = {}; - if ( defined $self->{'newfile'}{'olddir'} ) { - %{$self->{'logfiles'}{$name}{'olddir'}} = %{$self->{'newfile'}{'olddir'}}; - } else { - $self->{'logfiles'}{$name}{'olddir'} = undef; - } - delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'}; - $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++ - if $self->{'newfile'}{'postrotate'}; - } - - return 1; - -} - -#------------------------------------------------------------------------------------------ - -sub check_include { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_include: " : ""; - - if ( $in_fd ) { - warn $p . "include directives inside logfile definitions are not allowed " . - "(line $linenr of file '$f')\n"; - return undef; - } - - my ( $key, $val, $if, $name, $bname, $found, $pattern, $basename, $dir ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - - if ( @Values ) { - if ( scalar @Values > 1 ) { - warn $p . "Only one include per include directive is allowed. " . - "Only the first first is taken.\n"; - } - $if = $Values[0]; - - if ( $if !~ m#^/# ) { - if ( $f =~ m#/# ) { - ( $dir, $basename ) = $f =~ m#(.*)/([^/]+)$#; - } else { - $dir = "."; - $basename = $f; - } - $if = $dir . "/" . $if; - } - - if ( -f $if ) { - print $p . "Including file '$if' ...\n" if $self->{'verbose'} > 1; - unless ( $self->read_config( $f ) ){ - warn $p . "Reading of configuration file '$if' was NOT successful.\n"; - return undef; - } - } elsif ( -d $if ) { - print $p . "Including directory '$if' ...\n" if $self->{'verbose'} > 1; - foreach $name ( glob( "$if/.* $if/*") ) { - # ( $bname ) = $name =~ m#([^/]+)$#; - $bname = basename( $name ); - next if $bname eq "." or $bname eq ".."; - print $p . "Checking include file $if/$bname ...\n" if $self->{'verbose'} > 1; - if ( -d "$if/$bname" ) { - # Keine Verzeichnis-Rekursion !!! - print $p . "Step over directory $if/$bname.\n" if $self->{'verbose'} > 1; - next; - } - $found = 0; - foreach $pattern ( @{$self->{'taboo'}} ) { - if ( $bname =~ /$pattern/ ) { - $found = 1; - print $p . "File $if/$bname was matching Taboo-Pattern '$pattern', not considerd.\n" - if $self->{'verbose'} > 1; - last; - } - } - unless ( $found ) { - print $p . "Including file '$name' ...\n" if $self->{'verbose'} > 1; - unless ( $self->read_config( $name ) ){ - warn $p . "Reading of configuration file '$name' was NOT successful.\n"; - return undef; - } - } - } - } else { - warn $p . "Invalid include directive '$line' in line $linenr of file $f.\n"; - return undef; - } - - } else { - warn $p . "Include directive found without given include file or directory ". - "in configuration file '$f' line $linenr.\n"; - return undef; - } - - return 1; - -} - -#------------------------------------------------------------------------------------------ - -sub check_compress { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_compress: " : ""; - - if ( $self->{'compress_cmd'} ) { - if ( $in_fd ) { - $self->{'newfile'}{'compress'} = 1; - } else { - $self->{'default'}{'compress'} = 1; - } - } else { - warn $p . "Compression impossible, no compress command given. " . - "(line $linenr of file '$f')\n" if $self->{'verbose'} > 1; - if ( $in_fd ) { - $self->{'newfile'}{'compress'} = 0; - } else { - $self->{'default'}{'compress'} = 0; - } - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_compresscmd { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_compresscmd: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - if ( $in_fd ) { - warn $p . "directive 'compresscmd' not allowed inside logfile definitions " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - return; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - unless ( $Values[0] ) { - warn $p . "directive 'compresscmd' without given command ". - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - return; - } - - if ( $name = $self->check_compress_program( $Values[0] ) ) { - $self->{'compress_cmd'} = $name; - return; - } - - warn $p . "given compress command '$Values[0]' is NOT valid ". - "Using ald value '" . ($self->{'compress_cmd'} ? $self->{'compress_cmd'} eq "1" ? - $CompressModule : - $self->{'compress_cmd'} : - "no compression" ) . "'. " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - -} - -#------------------------------------------------------------------------------------------ - -sub check_compressext { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_compressext: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - if ( $in_fd ) { - warn $p . "directive 'compressext' not allowed inside logfile definitions " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - return; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $self->{'compressext'} = $Values[0] || ""; - -} - -#------------------------------------------------------------------------------------------ - -sub check_compressoptions { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_compressoptions: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - if ( $in_fd ) { - warn $p . "directive 'compressoptions' not allowed inside logfile definitions " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - return; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $self->{'compressoptions'} = join( " ", @Values ) || ""; - -} - -#------------------------------------------------------------------------------------------ - -sub check_create { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_create: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - $self->{$key}{'copytruncate'} = 0; - - # Mode (Permission) definition - if ( defined $Values[0] ) { - if ( $Values[0] =~ /^\d+$/ ) { - $self->{$key}{'create'}{'mode'} = oct( $Values[0] ); - } else { - warn $p . "directive 'create' with invalid mode '$Values[0]' " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - } - } - - # User (owner, uid) definition - if ( defined $Values[1] and $Values[1] ne "" ) { - if ( $Values[1] =~ /^[1-9]\d*$/ ) { - $self->{$key}{'create'}{'owner'} = $Values[1]; - } else { - $self->{$key}{'create'}{'owner'} = scalar getpwnam( $Values[1] ); - } - } - - # Group (gid) definition - if ( defined $Values[2] and $Values[2] ne "" ) { - if ( $Values[2] =~ /^[1-9]\d*$/ ) { - $self->{$key}{'create'}{'group'} = $Values[2]; - } else { - $self->{$key}{'create'}{'group'} = scalar getgrnam( $Values[2] ); - } - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_dateext { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_dateext: " : ""; - - my ( $key, $val, $name, $ext ); - my ( @Values ); - - my %YesValues = ( '1' => 1, - 'on' => 1, - 'yes' => 1, - 'ja' => 1, - 'y' => 1, - 'j' => 1, - ); - - my %NoValues = ( '0' => 1, - 'off' => 1, - 'no' => 1, - 'nein' => 1, - 'n' => 1, - ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - $ext = lc( $Values[0] || "" ); - unless ( $ext ) { - $self->{$key}{'dateext'} = 1; - return; - } - - unless ( $NoValues{$ext} ) { - $self->{$key}{'dateext'} = 1; - $self->{$key}{'datepattern'} = $ext unless $YesValues{$ext}; - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_extension { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_extension: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - $self->{$key}{'extension'} = $Values[0] || ""; - -} - -#------------------------------------------------------------------------------------------ - -sub check_maxage { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_maxage: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - if ( $Values[0] =~ /^\d+$/ ) { - $self->{$key}{'maxage'} = $Values[0]; - } else { - warn $p . "invalid directive 'maxage' with parameter '". $Values[0] . - "' (line $linenr of file '$f').\n" if $self->{'verbose'}; - } - -} - -#------------------------------------------------------------------------------------------ - -=head2 check_olddir ( $line, $f, $in_fd, $linenr ) - -Überprüft eine olddir-Direktive einer Konfigurations-Datei. - -=cut - -sub check_olddir { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_olddir: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - if ( $Values[0] ) { - $self->{$key}{'olddir'}{'dirname'} = $Values[0]; - } else { - warn $p . "directive 'olddir' without parameter ". - "' (line $linenr of file '$f').\n" if $self->{'verbose'}; - return undef; - } - - $self->{$key}{'olddir'}{'mode'} = undef; - $self->{$key}{'olddir'}{'owner'} = undef; - $self->{$key}{'olddir'}{'group'} = undef; - - # Mode (Permission) definition - if ( defined $Values[1] ) { - if ( $Values[1] =~ /^\d+$/ ) { - $self->{$key}{'olddir'}{'mode'} = oct( $Values[1] ); - } else { - warn $p . "directive 'oldir' with invalid mode '$Values[1]' " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - } - } - - # User (owner, uid) definition - if ( defined $Values[2] and $Values[2] ne "" ) { - if ( $Values[2] =~ /^[1-9]\d*$/ ) { - $self->{$key}{'olddir'}{'owner'} = $Values[2]; - } else { - $self->{$key}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] ); - } - } - - # Group (gid) definition - if ( defined $Values[3] and $Values[3] ne "" ) { - if ( $Values[3] =~ /^[1-9]\d*$/ ) { - $self->{$key}{'olddir'}{'group'} = $Values[3]; - } else { - $self->{$key}{'olddir'}{'group'} = scalar getgrnam( $Values[3] ); - } - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_rotate { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_rotate: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - if ( $Values[0] =~ /^-?\d+$/ ) { - $self->{$key}{'rotate'} = $Values[0]; - } else { - warn $p . "invalid directive 'rotate' with parameter '". $Values[0] . - "' (line $linenr of file '$f').\n" if $self->{'verbose'}; - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_postrotate { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_postrotate: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - unless ( $in_fd ) { - warn $p . "directive 'postrotate' not allowed outside a logfile " . - "definition (line $linenr of file '$f').\n" if $self->{'verbose'}; - return undef; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - - if ( $Values[0] ) { - $self->{'newfile'}{'postrotate'} = lc($Values[0]); - return undef; - } else { - $name = $self->new_script_name( "postrotate" ); - $self->{'scripts'}{$name}{'cmd'} = []; - $self->{'scripts'}{$name}{'post'} = 0; - $self->{'scripts'}{$name}{'prerun'} = 0; - $self->{'newfile'}{'postrotate'} = $name; - return $name; - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_prerotate { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_prerotate: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - unless ( $in_fd ) { - warn $p . "directive 'prerotate' not allowed outside a logfile " . - "definition (line $linenr of file '$f').\n" if $self->{'verbose'}; - return undef; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - - if ( $Values[0] ) { - $self->{'newfile'}{'prerotate'} = lc($Values[0]); - return undef; - } else { - $name = $self->new_script_name( "prerotate" ); - $self->{'scripts'}{$name}{'cmd'} = []; - $self->{'scripts'}{$name}{'post'} = 0; - $self->{'scripts'}{$name}{'prerun'} = 0; - $self->{'newfile'}{'prerotate'} = $name; - return $name; - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_script { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_script: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - if ( $in_fd ) { - warn $p . "directive 'script' not allowed inside a logfile " . - "definition (line $linenr of file '$f').\n" if $self->{'verbose'}; - return undef; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - - unless ( $Values[0] ) { - warn $p . "directive 'script' without a valid script name " . - "definition (line $linenr of file '$f').\n" if $self->{'verbose'}; - return undef; - } - - $name = lc($Values[0]); - if ( $self->{'scripts'}{$name} ) { - warn $p . "script '$name' even declared, will be overwritten " . - "definition (line $linenr of file '$f').\n" if $self->{'verbose'}; - } - - $self->{'scripts'}{$name}{'cmd'} = []; - $self->{'scripts'}{$name}{'post'} = 0; - $self->{'scripts'}{$name}{'prerun'} = 0; - return $name; - -} - -#------------------------------------------------------------------------------------------ - -sub check_size { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_size: " : ""; - - my ( $key, $val, $name ); - my ( @Values ); - - $line =~ s/^size//i; - $line =~ s/^\s*=?\s*\+?//; - - @Values = $line ? $self->parts( $line ) : (); - $key = $in_fd ? 'newfile' : 'default'; - - if ( $Values[0] ) { - if ( $Values[0] =~ /^\d+\s*[kmg]?$/i ) { - $self->{$key}{'size'} = lc($Values[0]); - if ( $Values[1] and $Values[1] =~ /^([kmg])$/i ) { - $self->{$key}{'size'} .= lc($1); - } - } else { - warn $p . "invalid directive 'size' with parameter '". $Values[0] . - "' (line $linenr of file '$f').\n" if $self->{'verbose'}; - } - } else { - warn $p . "directive 'size' without parameter " . - "' (line $linenr of file '$f').\n" if $self->{'verbose'}; - } - -} - -#------------------------------------------------------------------------------------------ - -sub check_taboo { - - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $what = shift || ""; - my $p = $self->{'verbose'} > 2 ? "logrotate::check_taboo: " : ""; - - my ( $pattern, $key, $val, $name, $found ); - my ( @Values ); - my %Pat = ( ext => '%s$', - file => '^%s$', - prefix => '^%s' ); - - unless ( $Pat{$what} ) { - carp $p . "invalid parameter in calling.\n"; - return; - } - - if ( $in_fd ) { - warn $p . "directive 'taboo$what' not allowed inside logfile definitions " . - "(line $linenr of file '$f')\n" if $self->{'verbose'}; - return; - } - - ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/; - @Values = $val ? $self->parts( $val ) : (); - - $found = 0; - if ( $Values[0] and $Values[0] eq "+" ) { - $found = 1; - shift @Values; - } - $self->{'taboo'} = [] unless $found; - foreach $name ( @Values ) { - $pattern = sprintf( $Pat{$what}, $name ); - print $p . "New Taboo-Pattern '$pattern' from '$name'.\n" if $self->{'verbose'} > 1; - push @{$self->{'taboo'}}, sprintf( $Pat{$what}, $name ); - } - -} - -#------------------------------------------------------------------------------------------ - -sub new_script_name { - - my $self = shift; - my $pre = shift || ""; - my $p = $self->{'verbose'} > 2 ? "logrotate::new_script_name: " : ""; - - my $i = 0; - my $name = "$pre$i"; - - while ( 1 ) { - if ( defined $self->{'scripts'}{$name}{'cmd'} ) { - if ( scalar @{$self->{'scripts'}{$name}{'cmd'}} ) { - $i++; - $name = "$pre$i"; - } else { - last; - } - } else { - last; - } - } - - return $name; -} - -#------------------------------------------------------------------------------------ - -sub parts { - - my $self = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::parts: " : ""; - - my $term = shift; - my @Parts = (); - my $part; - - while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) { - $part = $1 || $2; - $part =~ s/\\"/"/g; - push @Parts, $part; - } - - return @Parts; - -} - -#------------------------------------------------------------------------------------ - -sub rotate_time_over { - - my $self = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::rotate_time_over: " : ""; - - my ( $type, $date ) = @_; - my @ATime = localtime( time ); - my ( $y1, $m1, $d1, $y2, $m2, $d2 ); - - my %Types = ( 'daily' => 1, 'weekly' => 1, 'monthly' => 1); - - unless ( $Types{$type} ) { - carp $p . "invalid mode given on calling.\n"; - return undef; - } - - unless ( ( $y1, $m1, $d1 ) = $date =~ /^(\d+)-(\d+)-(\d+)$/ ) { - ( $y1, $m1, $d1 ) = ( 1971, 1, 1 ); - } - ( $y2, $m2, $d2 ) = @ATime[5, 4, 3]; - $y2 += 1900; - $m2++; - - my $days1 = int( POSIX::mktime( 0, 0, 0, $d1, $m1 - 1, ($y1 - 1900), 0, 0, 0 ) / 24 / 60 / 60 ); - my $days2 = int( POSIX::mktime( 0, 0, 0, $d2, $m2 - 1, ($y2 - 1900), 0, 0, 0 ) / 24 / 60 / 60 ); - my $diff = $days2 - $days1; - print $p . $diff . " days difference between current day and last rotated day.\n" - if $self->{'verbose'} > 1; - - if ( $type eq 'monthly' ) { - return 1 if $diff > 30; - return 0 unless $d2 == 1; - return $diff > 0; - } elsif ( $type eq 'weekly' ) { - return $diff >= 7; - } else { - return $diff > 0; - } - -} - -#------------------------------------------------------------------------------------ - -sub rotate { - - my $self = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::rotate: " : ""; - - my ( $file, $should_rotate, $target, $name, $text, $fsize, $prescript, $postscript, $rotated_file, $cmd ); - my ( $ouid, $ogid, $omode, $nuid, $ngid, $nmode ); - my ( @Stats ); - - print "\n$p" . "starting with rotation:\n\n" if $self->{'verbose'}; - - foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'logfiles'}} ) { - - $should_rotate = $self->test_for_rotate( $file ); - - $prescript = $self->{'logfiles'}{$file}{'prerotate'} || ""; - $postscript = $self->{'logfiles'}{$file}{'postrotate'} || ""; - - if ( $should_rotate ) { - - if ( $prescript ) { - unless ( $self->{'scripts'}{$prescript}{'prerun'} and $self->{'logfiles'}{$file}{'sharedscripts'} ) { - print $p . "Executing prerotate script '$prescript':\n" if $self->{'verbose'}; - $cmd = join( "\n", @{$self->{'scripts'}{$prescript}{'cmd'}} ) . "\n"; - print "$cmd\n" if $self->{'verbose'}; - system $cmd unless $self->{'test'}; - } - $self->{'scripts'}{$prescript}{'prerun'} = 1; - } - - unless ( $self->create_olddir( $file ) ) { - next; - } - - unless ( $target = $self->get_logfile_target( $file ) ) { - next; - } - $self->{'logfiles'}{$file}{'targetfile'} = $target; - - print $p . "\$self->{'logfiles'}{$file}: " . Dumper( $self->{'logfiles'}{$file} ) if $self->{'verbose'} > 3; - - $target = $self->rotate_file( $file ); - - unless ( defined $target ) { - warn $p . "Could NOT rotate logfile '$file'!\n"; - next; - } - print $p . "Result of rotating: '$target'\n" if $self->{'verbose'} > 1; - - $self->{'rotatet_files'}{$file} = 1; - $self->{'files_to_compress'}{$target} = 1 if $self->{'logfiles'}{$file}{'compress'} and $target; - - if ( $postscript ) { - print $p . "testing for postrotate script '$postscript'...\n" if $self->{'verbose'} > 1; - $self->{'scripts'}{$postscript}{'post'}--; - $self->{'scripts'}{$postscript}{'dopost'} = 1; - unless ( $self->{'scripts'}{$postscript}{'post'} > 0 and $self->{'logfiles'}{$file}{'sharedscripts'} ) { - print $p . "Executing postrotatescript '$postscript':\n" if $self->{'verbose'}; - $cmd = join( "\n", @{$self->{'scripts'}{$postscript}{'cmd'}} ) . "\n"; - print "$cmd\n" if $self->{'verbose'}; - system $cmd unless $self->{'test'}; - $self->{'scripts'}{$postscript}{'donepost'} = 1; - } - - } - - } - - } - - print "\n$p" . "Checking for scripts ...\n" if $self->{'verbose'}; - foreach $name ( keys %{$self->{'scripts'}} ) { - if ( $self->{'scripts'}{$name}{'dopost'} and not $self->{'scripts'}{$name}{'donepost'} ) { - print $p . "executing postrotatescript '$name':\n" if $self->{'verbose'}; - $cmd = join( "\n", @{$self->{'scripts'}{$name}{'cmd'}} ) . "\n"; - print "$cmd\n" if $self->{'verbose'}; - system $cmd unless $self->{'test'}; - } - } - -} - -#------------------------------------------------------------------------------------ - -=head2 rotate_file ( $file ) - -Rotiert (bedingungslos) die in $file übergebene Datei. - -Dabei MUSS in $self->{'logfiles'}{$file}{'target'} der Dateiname der -rotierten Datei (ohne Nummerierung) vorher abgelegt worden sein. - -Rückgabe: - - undef - irgendwas ging schief - - "" - Datei rotiert und getrunct (kein Komprimieren nötig) - - targetname - Dateiname der rotierten Datei, die dann (wenn gewünscht) - komprimiert werden kann - -=cut - -sub rotate_file { - - my $self = shift; - my $file = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::rotate_file: " : ""; - my $uid = $>; - my ( $gid ) = $) =~ /^(\d+)/; - - my ( $target, $omode, $ouid, $ogid, $nmode, $nuid, $ngid ); - my ( $rotate, $i, $ext, $ofile, $nfile, $res, $text, $age ); - my ( @Stats, @Files, @Nr, @FilesToDelete ); - my ( %FoundFiles ); - - unless ( $file ) { - carp $p . "No filename given!\n"; - return undef; - } - - unless ( $self->{'logfiles'}{$file} ) { - carp $p . "Invalid filename '$file' given!\n"; - return undef; - } - - $rotate = $self->{'logfiles'}{$file}{'rotate'}; - unless ( $rotate ) { - # Es soll keine Kopie des rotierten Datei aufbewahrt werden ... - unless ( $self->{'logfiles'}{$file}{'copytruncate'} ) { - print $p . "Deleting '$file' ...\n" if $self->{'verbose'}; - unlink $file unless $self->{'test'}; - } - - # Truncen bzw. neu anlegen ... - $text = $self->{'logfiles'}{$file}{'copytruncate'} ? "Truncating" : "Creating"; - print $p . "$text logfile '$file' ...\n" if $self->{'verbose'}; - unless ( open LOG, ">$file" ) { - warn $p . "Could NOT open file '$file' for $text: $!\n"; - return undef; - } - close LOG; - - # Permissions und Ownership setzen ... - unless ( $self->{'logfiles'}{$file}{'copytruncate'} ) { - - # alte Permissions und Besitzer ermitteln - @Stats = stat $file; - ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ]; - # gewünschte Permissions und Besitzer ermitteln - $nmode = defined $self->{'logfiles'}{$file}{'create'}{'mode'} ? $self->{'logfiles'}{$file}{'create'}{'mode'} : 0644; - $nuid = defined $self->{'logfiles'}{$file}{'create'}{'owner'} ? $self->{'logfiles'}{$file}{'create'}{'owner'} : $uid; - $ngid = defined $self->{'logfiles'}{$file}{'create'}{'group'} ? $self->{'logfiles'}{$file}{'create'}{'group'} : $gid; - - if ( $nmode != $omode ) { - # gewünschte Permissions setzen - print $p . "Changing permissions of '$file'.\n" if $self->{'verbose'} > 1; - unless ( chmod $nmode, $file ) { - warn $p . "Change of permissions of '$file' was not successful: $!\n"; - } - } - - if ( $ouid != $nuid or $ogid != $ngid ) { - # gewünschte Besitzer setzen - print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1; - unless ( chown $nuid, $ngid, $file ) { - warn $p . "Change of ownership of '$file' was not successful: $!\n"; - } - } - - } - return ""; - } - - $target = $self->{'logfiles'}{$file}{'targetfile'}; - unless ( $target ) { - carp $p . "File '$file' without valid target name given!\n"; - return undef; - } - - # alte rotierte Logfiles rausschmeißen, wenn im olddir kein dateformat (irgendwas mit %) angegeben ist ... - if ( $self->{'logfiles'}{$file}{'olddir'}{'dateformat'} ) { - - print $p . "No deleting of old rotated logfile versions, because of a date-FORMAT in olddir.\n" - if $self->{'verbose'} > 1; - - } else { - - # Maximal $rotate Anzahl alte Logfile-Versionen aufbewahren. - $rotate = max_rotate if $rotate > max_rotate; - # $rotate--; - - # alte Logfiles einsammeln - @Files = glob( $target . "*" ); - foreach ( @Files ) { - next if $_ eq $file; - # als alte Logfiles zählen, wenn sie wie das festgelegte Target heißen, daß danach - # möglicherweise ein Punkt kommt, danach möglicherweise irgendwelche Ziffern und danach - # möglicherweise die Copress-Extension (.gz) - if ( m#^$target\.?(?:\d+)?(?:$self->{'compressext'})?$# ) { - print $p . "Found ratated Logfile '$_'.\n" if $self->{'verbose'} > 2; - @Stats = stat $_; - $FoundFiles{$_} = $Stats[9]; - } - } - print $p . "Found " . scalar( keys %FoundFiles ) . " old logfile versions of '$file'.\n" if $self->{'verbose'} > 1; - - $i = 0; - foreach ( sort { $FoundFiles{$b} <=> $FoundFiles{$a} } keys %FoundFiles ) { - $i++; - - # Dateien, die zuviel sind weg ... - if ( $i >= $rotate ) { - print $p . "File '$_' is No. $i, will deleted because $i >= $rotate rotations.\n" if $self->{'verbose'} > 1; - push @FilesToDelete, $_; - next; - } - - # Dateien, die zu alt sind, weg ... - $age = time() - ( $FoundFiles{$_} || 0 ); - $age = int( $age / 60 / 60 / 24 ); - print $p . "File '$_' is $age days old.\n" if $self->{'verbose'} > 2; - if ( defined $self->{'logfiles'}{$file}{'maxage'} and $self->{'logfiles'}{$file}{'maxage'} > 0 ) { - if ( $age > $self->{'logfiles'}{$file}{'maxage'} ) { - print $p . "File '$_' will deleted because it's with $age days older then maxage of " . - $self->{'logfiles'}{$file}{'maxage'} . " days.\n" if $self->{'verbose'} > 1; - push @FilesToDelete, $_; - } - } - } - - # Löschen, was zuviel ist ... - foreach ( @FilesToDelete ) { - print $p . "Deleting old logfile '$_' ...\n" if $self->{'verbose'}; - unless ( $self->{'test'} ) { - unless ( unlink $_ ) { - warn $p . "Could NOT remove old logfile '$_': $!\n"; - } - } - } - - } - - - if ( $self->{'logfiles'}{$file}{'dateext'} ) { - - # Sichergehen, daß das alte Logfile wirklich noch nicht existiert ... - if ( -f $target ) { - $i = 0; - $nfile = "$target.00000"; - while ( -f $nfile ) { - $i++; - $nfile = sprintf "$target.%05d", $i; - } - $target = $nfile; - } - $res = $target; - - } else { - - # alte Logfiles einsammeln - @Files = glob( $target . ".*" ); - foreach ( @Files ) { - if ( ( $i ) = m#^$target\.(\d+)(?:$self->{'compressext'})?$# ) { - print $p . "Found Logfile No. '$i'.\n" if $self->{'verbose'} > 2; - push @Nr, int( $i ); - } - } - print $p . "Found " . scalar @Nr . " old logfile versions of '$file'.\n" if $self->{'verbose'} > 1; - - foreach $i ( sort { $b <=> $a } @Nr ) { - # $i von oben nach unten zählen ... - $ofile = sprintf "$target.%05d", $i; - $ext = ""; - unless ( -f $ofile ) { - $ofile .= $self->{'compressext'}; - $ext = $self->{'compressext'}; - } - $nfile = sprintf "$target.%05d$ext", $i + 1; - if ( -f $ofile ) { - # Moven von $i zu $i+1 - print $p . "Moving '$ofile' --> '$nfile' ...\n" if $self->{'verbose'} > 1; - unless ( $self->{'test'} ) { - unless ( move $ofile, $nfile ) { - warn $p . "Could NOT move '$ofile' --> '$nfile': $!\n"; - } - } - } else { - warn $p . "Ooops, old logfile '$ofile' does NOT exists!\n"; - } - } - - $nfile = $target . ".00001"; - $target .= ".00000"; - if ( $self->{'logfiles'}{$file}{'delaycompress'} ) { - $res = $self->{'test'} ? $nfile : ( -f $nfile ? $nfile : "" ); - } else { - $res = $target; - } - } - - print $p . "Name of the rotated logfile: '$target'.\n" if $self->{'verbose'} > 1; - - if ( $self->{'logfiles'}{$file}{'copytruncate'} ) { - - # Kopieren und truncen - print $p . "Copying logfile '$file' -> '$target' ...\n" if $self->{'verbose'}; - unless ( $self->{'test'} ) { - unless ( copy $file, $target ) { - warn $p . "Could not copy '$file' -> '$target': $!\n"; - return undef; - } - } - - print $p . "Truncating logfile '$file'.\n" if $self->{'verbose'}; - unless ( $self->{'test'} ) { - if ( open FILE, ">$file" ) { - close FILE; - } else { - warn $p . "Could not truncating logfile '$file': $!\n"; - return undef; - } - } - - } else { - - # Moven des Logfiles - print $p . "Moving logfile '$file' -> '$target' ...\n" if $self->{'verbose'}; - unless ( $self->{'test'} ) { - if ( move $file, $target ) { - print $p . "Creating logfile '$file' ...\n" if $self->{'verbose'} > 1; - if ( open FILE, ">$file" ) { - close FILE; - - # alte Permissions und Besitzer ermitteln - @Stats = stat $file; - ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ]; - # gewünschte Permissions und Besitzer ermitteln - $nmode = $self->{'logfiles'}{$file}{'create'}{'mode'} || 0644; - $nuid = $self->{'logfiles'}{$file}{'create'}{'owner'}; - $ngid = $self->{'logfiles'}{$file}{'create'}{'group'}; - - if ( $nmode != $omode ) { - # gewünschte Permissions setzen - print $p . "Changing permissions of '$file'.\n" if $self->{'verbose'} > 1; - unless ( chmod $nmode, $file ) { - warn $p . "Change of permissions of '$file' was not successful: $!\n"; - } - } - - if ( $ouid != $nuid or $ogid != $ngid ) { - # gewünschte Besitzer setzen - print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1; - unless ( chown $nuid, $ngid, $file ) { - warn $p . "Change of ownership of '$file' was not successful: $!\n"; - } - } - - } else { - warn $p . "Could not create logfile '$file': $!\n"; - return undef; - } - } else { - warn $p . "Could not move '$file' -> '$target': $!\n"; - return undef; - } - } - - } - - return $res; - -} - -#------------------------------------------------------------------------------------ - -=head2 compress_files - -Komprimiert die Dateien, die im Hash $self-E{'files_to_compress'} aufgelistet sind. - -=cut - -sub compress_files { - - my $self = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::compress_files: " : ""; - - my ( $file, $gz, $target, $buffer, $cmd, $ok, $size, $blocks, $every ); - my ( $i, $ouid, $ogid, $nuid, $ngid, $utime, $strat ); - my ( @OldStat, @NewStat ); - - if ( $self->{'compress_cmd'} == 1 ) { - unless ( $self->{'compressext'} ) { - warn $p . "No valid file extension given for compressed files.\n"; - return undef; - } - eval "use $CompressModule;"; - } - - print "\n" . $p . "Compressing files ...\n" if $self->{'verbose'}; - foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'files_to_compress'}} ) { - print " - $file" if $self->{'verbose'}; - if ( $self->{'compress_cmd'} == 1 ) { - $target = $file . $self->{'compressext'}; - print " --> $target\n" if $self->{'verbose'}; - next if $self->{'test'}; - $ok = 1; - $size = ( -s $file ); - unless ( $size ) { - print $p . "File '$file' has size of zero, not compressed.\n" if $self->{'verbose'}; - next; - } - $blocks = int( $size / default_buffer_size ); - $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1; - $i = 0; - if ( open LOG, "<$file" ) { - if ( $gz = eval " gzopen( '$target', 'wb' )" ) { - print " " if $self->{'verbose'}; - $strat = eval "Z_DEFAULT_STRATEGY"; - $gz->gzsetparams( 9, $strat ); - while ( read LOG, $buffer, default_buffer_size ) { - $i++; - $gz->gzwrite( $buffer ); - print "." if $self->{'verbose'} and ( $i % $every == 0 ); - } - $gz->gzclose(); - } else { - warn $p . "Could not open compressed file '$target' for writing: $!.\n"; - $ok = 0; - } - close LOG; - print "\n" if $self->{'verbose'} > 1; - @OldStat = stat $file; - ( $ouid, $ogid, $utime ) = @OldStat[ 4, 5, 9 ]; - @NewStat = stat $target; - ( $nuid, $ngid ) = @NewStat[ 4, 5 ]; - print $p . "Setting Modification time of '$file'.\n" if $self->{'verbose'} > 1; - utime $utime, $utime, $target; - if ( $ouid != $nuid or $ogid != $ngid ) { - print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1; - chown $ouid, $ogid, $target; - } - if ( $ok ) { - print $p . "Removing file '$file'.\n" if $self->{'verbose'} > 1; - unless ( unlink $file ) { - warn $p . "Could not remove logfile '$file': $!\n"; - $ok = 0; - } - } - print " ok.\n" if $self->{'verbose'} == 1; - } else { - warn $p . "Could not read logfile '$file': $!\n"; - next; - } - } else { - $cmd = $self->{'compress_cmd'} . " " . ( $self->{'compressoptions'} || "" ) . " " . $file; - print " --> $cmd\n" if $self->{'verbose'}; - next if $self->{'test'}; - system $cmd; - } - } - - print $p . "Compressing files successful.\n" if $self->{'verbose'} > 1; - return 1; - -} - -#------------------------------------------------------------------------------------ - -=head2 write_status - -Schreibt den Status der rotierten Logfiles in das Status-File. - -Gibt als Wahrheitswert zurück, ob erfolgreich. - -=cut - -sub write_status { - - my $self = shift; - - my $f = $self->{'statusfile'}; - my $p = $self->{'verbose'} > 2 ? "logrotate::write_status: " : ""; - my $i = 0; - my ( $file, $date, $first_line, $lines ); - my %FileList; - my $datum = sprintf "%d-%d-%d", $ActDate[5] + 1900, $ActDate[4] + 1, $ActDate[3]; - - unless ( $f ) { - carp $p . "No status file defined.\n"; - return undef; - } - - print "\n" . $p . "Reading status file '$f'.\n" if $self->{'verbose'} > 1; - - if ( -f $f ) { - if ( open FILE, "<$f" ) { - - while ( $_ = ) { - $i++; - if ( $i == 1 ) { - if ( /^logrotate state -- version [12]$/i ) { - $first_line = $_; - chomp $first_line; - next; - } else { - warn $p . "Uncompatible version of state file '$f'.\n"; - close FILE; - return undef; - } - } - s/^\s+//; - s/\s+$//; - - if ( $_ ) { - ( $file, $date ) = $self->parts( $_ ); - if ( $file and $date ) { - $FileList{$file} = $date; - } - } - } - - close FILE; - } else { - warn $p . "Error in open status file '$f' for read: $!\n"; - return undef; - } - } - - $first_line ||= default_firstline_statusfile; - - foreach $file ( keys %{$self->{'rotatet_files'}} ) { - $FileList{$file} = $datum; - } - - $lines = $first_line . "\n"; - foreach $file ( sort { lc($a) cmp lc($b) } keys %FileList ) { - $lines .= "\"$file\" " . $FileList{$file} . "\n"; - } - print $p . "New status file:\n" . $lines if $self->{'verbose'} > 1; - - print "\n" . $p . "Writing status file '$f'...\n" if $self->{'verbose'}; - unless ( $self->{'test'} ) { - if ( open FILE, ">$f" ) { - print FILE $lines; - close FILE; - } else { - warn $p . "Error in open status file '$f' for write: $!\n"; - return undef; - } - } - print $p . "Writing status file '$f' successful.\n" if $self->{'verbose'} > 1; - return 1; - -} - -#------------------------------------------------------------------------------------ - -sub test_for_rotate { - - my $self = shift; - my $file = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::test_for_rotate: " : ""; - - my ( $text, $fsize, $maxsize, $time_to_rotate ); - - unless ( $file ) { - carp $p . "no filename given on calling.\n"; - return undef; - } - - print "\n$p" . "Testing logfile '$file' for rotating ...\n" if $self->{'verbose'} > 1; - - unless ( -f $file ) { - $text = $p . "Logfile '$file' does NOT exists, no rotating\n"; - unless ( $self->{'logfiles'}{$file}{'missingok'} ) { - warn $text; - return 0; - } - print $text if $self->{'verbose'} > 1; - return 0; - } - - unless ( -s $file ) { - $text = $p . "Logfile '$file' has a file lenght of 0, no rotating\n"; - unless ( $self->{'logfiles'}{$file}{'ifempty'} ) { - print $text if $self->{'verbose'} > 1; - return 0; - } - } - - if ( $self->{'force'} ) { - print $p . "Logfile '$file' will rotated because of FORCE-Mode.\n" if $self->{'verbose'} > 1; - return 1; - } - - $fsize = ( -s $file ); - $maxsize = $self->get_bytes( $self->{'logfiles'}{$file}{'size'} || 0 ); - - $time_to_rotate = $self->rotate_time_over( $self->{'logfiles'}{$file}{'period'}, - $self->{'logfiles'}{$file}{'lastrotated'} ); - - if ( $maxsize ) { - if ( $fsize > $maxsize ) { - if ( $time_to_rotate ) { - $text = $p . "logfile '$file' maximum size ($maxsize bytes) exseeded " . - "with $fsize bytes, will be rotated.\n"; - print $text if $self->{'verbose'} > 1; - return 1; - } - } else { - $text = $p . "logfile '$file' maximum size ($maxsize bytes) NOT exseeded " . - "with $fsize bytes, no rotating\n"; - print $text if $self->{'verbose'} > 1; - return 0; - } - } else { - if ( $time_to_rotate ) { - $text = $p . "logfile '$file' time for rotating achieved, will be rotated.\n"; - print $text if $self->{'verbose'} > 1; - return 1; - } - } - - $text = $p . "logfile '$file' time for rotating NOT achieved, no rotating\n"; - print $text if $self->{'verbose'} > 1; - return 0; -} - -#------------------------------------------------------------------------------------ - -=head2 create_olddir ( $logfile ) - -Checkt das Vorhandensein von $self-E{'logfiles'}{$logfile}{'olddir'}, vorher werden aber die -POSIX-Datumsersetzungen daran gemacht und in $self-E{'logfiles'}{$logfile}{'olddir'} zurückgespeichert. - -Wenn es kein Testfall ist, wird dieses Verzeichnis auch tatsächlich angelegt. - -Gibt den Erfolg als Wahrheitswert zurück. - -=cut - -sub create_olddir { - - my $self = shift; - my $file = shift; - my $p = $self->{'verbose'} > 2 ? "logrotate::create_olddir: " : ""; - - my ( $dir, $adir, $mode, $owner, $group, $olddir ); - my ( $pmode, $puid, $pgid ); - my ( @Dirs, @Stats ); - my $uid = $>; - my ( $gid ) = $) =~ /^(\d+)/; - - unless ( $file ) { - carp $p . "No logfile given!\n"; - return undef; - } - print $p . "Checking and creating 'olddir' for logfile '$file'.\n" if $self->{'verbose'} > 1; - my $f = $self->{'logfiles'}{$file}; - - print $p . Dumper( $f ) if $self->{'verbose'} > 2; - - unless ( $f ) { - carp $p . "No valid logfile given!\n"; - return undef; - } - - unless ( $f->{'olddir'}{'dirname'} ) { - print $p . "No 'olddir' given.\n" if $self->{'verbose'} > 1; - return 1; - } - - $mode = $f->{'olddir'}{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755; - $owner = $f->{'olddir'}{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid; - $group = $f->{'olddir'}{'group'} || $self->{'logfiles'}{'default'}{'olddir'}{'group'} || $gid; - unless ( $owner =~ /^\d+$/ ) { - $owner = getpwuid( $owner ); - $owner = $uid unless defined $owner; - } - unless ( $group =~ /^\d+$/ ) { - $group = getgrnam( $group ); - $group = $gid unless defined $group; - } - - if ( $f->{'olddir'}{'dirname'} =~ /%/ ) { - $f->{'olddir'}{'dateformat'} = 1; - $olddir = POSIX::strftime( $f->{'olddir'}{'dirname'}, @ActDate ); - } else { - $olddir = $f->{'olddir'}{'dirname'}; - } - - unless ( $olddir =~ m#^/# ) { - ( $dir ) = $file =~ m#(.*)/[^/]*$#; - $olddir = $dir . "/" . $olddir; - } - $f->{'olddir'}{'dirname'} = $olddir; - print $p . "Olddir is now: '$olddir'.\n" if $self->{'verbose'} > 1; - - unless ( -d $olddir ) { - - @Dirs = split m#/#, $olddir; - $adir = ""; - @Stats = stat "/"; - ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5]; - foreach $dir ( @Dirs ) { - next unless $dir; - next if $dir eq "/"; - $adir .= "/" . $dir; - print " - checking $adir\n" if $self->{'verbose'} > 2; - if ( -d $adir ) { - @Stats = stat $adir; - ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5]; - } else { - print "Creating directory $adir ...\n" if $self->{'verbose'}; - # Ermittlung effektive Permissions + Ownership - # wenn in config-file gegeben, diese, - # ansonsten die vom übergeordneten Verzeichnis. - $mode = defined $f->{'olddir'}{'mode'} ? $f->{'olddir'}{'mode'} : $pmode; - $owner = defined $f->{'olddir'}{'owner'} ? $f->{'olddir'}{'owner'} : $puid; - $group = defined $f->{'olddir'}{'group'} ? $f->{'olddir'}{'group'} : $pgid; - print " Permissions: $mode, Owner: $owner, Group: $group\n" if $self->{'verbose'} > 1; - unless ( $self->{'test'} ) { - print " mkdir $adir $mode\n" if $self->{'verbose'} > 1; - unless ( mkdir $adir, $mode ) { - warn $p . "$!\n"; - return undef; - } - if ( $owner != $uid and $group != $gid ) { - print " chown $owner, $group, $adir\n" if $self->{'verbose'} > 1; - unless ( chown $owner, $group, $adir ) { - warn $p . "$!\n"; - return undef; - } - } - } - } - } - - } - - return 1; -} - -#------------------------------------------------------------------------------------ - -=head2 get_logfile_target ( $file ) - -Legt das Ziel des Rotierens für das übergebene Logfile fest und gibt dieses zurück. - -=cut - -sub get_logfile_target { - - my $self = shift; - my $file = shift; - - unless ( $file ) { - carp $p . "Kein Logfile übergeben!\n"; - return undef; - } - my $p = $self->{'verbose'} > 2 ? "logrotate::get_logfile_target: " : ""; - - print $p . "Receiving target file name for logfile '$file'.\n" if $self->{'verbose'} > 1; - my $f = $self->{'logfiles'}{$file}; - - print $p . $file . " " . Dumper( $f ) if $self->{'verbose'} > 2; - - my ( $nr, $dir, $basename, $target, $pattern, $ext ); - - unless ( $f ) { - carp $p . "No valid logfile given!\n"; - return undef; - } - - unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { - warn $p . "Invalid logfile name: '$file'\n"; - return undef; - } - - $ext = $f->{'extension'} || ""; - - $basename = $f->{'olddir'}{'dirname'} ? $f->{'olddir'}{'dirname'} . "/" . $basename : $file; - if ( $f->{'dateext'} ) { - $pattern = $f->{'datepattern'}; - print $p . "Using Date-Extension '$pattern' for '$file'.\n" if $self->{'verbose'} > 1; - $basename .= "." . $pattern; - $basename = POSIX::strftime( $basename, @ActDate ); - } - $target = $basename . $ext; - - print $p . "Found target file name '$target' for logfile '$file'.\n" if $self->{'verbose'} > 1; - return $target; - -} - -#------------------------------------------------------------------------------------ - -sub get_bytes { - - my $self = shift; - my $size = shift || 0; - my $p = $self->{'verbose'} > 2 ? "logrotate::get_bytes: " : ""; - - my $res = 0; - - unless ( ( $res ) = $size =~ /(\d+)/ ) { - $res = 0; - } - $res *= 1024 if $size =~ /k$/i; - $res *= ( 1024 * 1024 ) if $size =~ /m$/i; - $res *= ( 1024 * 1024 * 1024 ) if $size =~ /g$/i; - - return $res; - -} - #------------------------------------------------------------------------------------ __END__ @@ -2553,6 +262,8 @@ the config file. =item I(8) +=item I + =item I(1) =item I(1) -- 2.39.5