--- /dev/null
+package LogRotate::Conf;
+
+# $Id$
+# $URL$
+
+=head1 NAME
+
+B<LogRotate/Conf.pm> - 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<prefix> - Suche am Anfang des Dateinamens), um einen kompletten Dateinamen (C<file> -
+der Dateiname muss komplett mit dem Suchmuster uebereinstimmen), oder eine Dateiendung
+handelt (C<ext> - 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 <undef>
+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 <undef> 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 = <FILE>;
+ 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 : "<undef>" ) . "'.\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 <frank@brehm-online.com>
+
+=cut
+
+
=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;
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;
$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";
".\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;
}
-#####################################################################################
-#------------------------------------------------------------------------------------
-#####################################################################################
-
-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 ( $_ = <FILE> ) {
- $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 = <FILE>;
- 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<gt>{'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 ( $_ = <FILE> ) {
- $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<gt>{'logfiles'}{$logfile}{'olddir'}, vorher werden aber die
-POSIX-Datumsersetzungen daran gemacht und in $self-E<gt>{'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__
=item I<logrotate.conf>(8)
+=item I<LogRotate.pm>
+
=item I<perl>(1)
=item I<gzip>(1)
projects / scripts / solaris.git / commitdiff