From: Frank Brehm Date: Tue, 18 Sep 2007 07:36:50 +0000 (+0000) Subject: Neue Logrotate-Direktive 'nocreate', perltity X-Git-Url: https://git.uhu-banane.org/?a=commitdiff_plain;h=8db8446d92cf4dc141d7f34d32eae96a2650c16a;p=scripts%2Fsolaris.git Neue Logrotate-Direktive 'nocreate', perltity --- diff --git a/LogRotate.pm b/LogRotate.pm index 2f4f2f6..71a613d 100644 --- a/LogRotate.pm +++ b/LogRotate.pm @@ -41,14 +41,14 @@ ENDE $Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis; -$Data::Dumper::Indent = 1; +$Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; use LogRotate::Conf; use LogRotate::StateFile; -use constant default_buffer_size => 4096; -use constant max_rotate => 100000; +use constant default_buffer_size => 4096; +use constant max_rotate => 100000; #------------------------------------------------------------------------------------ @@ -63,71 +63,71 @@ Der Konstruktor dieses LogRotate-Objekts. =cut sub new { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my $uid = $>; - my ( $gid ) = $) =~ /^(\d+)/; - my ( $res, $cmd, $t, $domain, $host ); - - my $self = { - test => 0, - force => 0, - statusfile => '/var/lib/logrotate.status', - scripts => {}, - logfiles => {}, - rotatet_files => {}, - files_to_compress => {}, - @_ - }; - - $res = bless $self, $class; - - my $p = verbose() > 2 ? __PACKAGE__ . "::new(): " : ""; - - my $conf = new LogRotate::Conf(); - - $self->{'c'} = $conf; - - # Ermittlung aller Platzhalter fuer olddir-Sachen ... - $self->{'template'} = {}; - - # Host- und Domainname ... - $t = hostname(); - $domain = ""; - $host = $t; - if ( $t =~ /^([^\.]+)\.(.*)/ ) { - $host = $1; - $domain = $2; - } - $self->{'template'}{'nodename'} = $host; - $self->{'template'}{'domain'} = $domain; + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my $uid = $>; + my ($gid) = $) =~ /^(\d+)/; + my ( $res, $cmd, $t, $domain, $host ); + + my $self = { + test => 0, + force => 0, + statusfile => '/var/lib/logrotate.status', + scripts => {}, + logfiles => {}, + rotatet_files => {}, + files_to_compress => {}, + @_ + }; + + $res = bless $self, $class; + + my $p = verbose() > 2 ? __PACKAGE__ . "::new(): " : ""; + + my $conf = new LogRotate::Conf(); + + $self->{'c'} = $conf; + + # Ermittlung aller Platzhalter fuer olddir-Sachen ... + $self->{'template'} = {}; + + # Host- und Domainname ... + $t = hostname(); + $domain = ""; + $host = $t; + if ( $t =~ /^([^\.]+)\.(.*)/ ) { + $host = $1; + $domain = $2; + } + $self->{'template'}{'nodename'} = $host; + $self->{'template'}{'domain'} = $domain; - # Plattform - $t = `uname -i`; - chomp $t; - $self->{'template'}{'platform'} = $t; + # Plattform + $t = `uname -i`; + chomp $t; + $self->{'template'}{'platform'} = $t; - # Prozessor - $t = `uname -p`; - chomp $t; - $self->{'template'}{'isa'} = $t; + # Prozessor + $t = `uname -p`; + chomp $t; + $self->{'template'}{'isa'} = $t; - # OS-Release - $t = `uname -r`; - chomp $t; - $self->{'template'}{'release'} = $t; + # OS-Release + $t = `uname -r`; + chomp $t; + $self->{'template'}{'release'} = $t; - # Maschinen-Version - $t = `uname -m`; - chomp $t; - $self->{'template'}{'machine'} = $t; + # Maschinen-Version + $t = `uname -m`; + chomp $t; + $self->{'template'}{'machine'} = $t; - $self->{'files_delete'} = {}; - $self->{'files_compress'} = {}; + $self->{'files_delete'} = {}; + $self->{'files_compress'} = {}; - return $res; + return $res; -} +} ## end sub new #------------------------------------------------------------------------------------------ @@ -140,26 +140,24 @@ der Statusdatei. sub check_state($) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::check_state(): " : ""; + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::check_state(): " : ""; - my $state_file = new LogRotate::StateFile( - 'test' => $self->{'test'}, - ); - $state_file->file($self->{'statusfile'}); + my $state_file = new LogRotate::StateFile( 'test' => $self->{'test'}, ); + $state_file->file( $self->{'statusfile'} ); - my $states = $state_file->check(); + my $states = $state_file->check(); - if ( $states ) { - $self->{'state_file'} = $state_file; - $self->{'states'} = $states; - return 1; - } + if ($states) { + $self->{'state_file'} = $state_file; + $self->{'states'} = $states; + return 1; + } - warn $p . "Statusdatei '" . $self->{'statusfile'} . " ist nicht verwendungsfaehig.\n"; - return undef; + warn $p . "Statusdatei '" . $self->{'statusfile'} . " ist nicht verwendungsfaehig.\n"; + return undef; -} +} ## end sub check_state($) #------------------------------------------------------------------------------------------ @@ -197,51 +195,51 @@ Wenn diese Zahl -1 oder kleiner ist, gibt es keine Beschraenkung fuer die Maxima sub collect_files_delete($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::collect_files_delete(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::collect_files_delete(): " : ""; - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } - print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } + print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; - my $candidates = {}; - my $of = $f->{'oldfiles'}; - my $maxage = (defined $f->{'maxage'} ? $f->{'maxage'} : 0 ) * 24 * 60 * 60; + my $candidates = {}; + my $of = $f->{'oldfiles'}; + my $maxage = ( defined $f->{'maxage'} ? $f->{'maxage'} : 0 ) * 24 * 60 * 60; - unless ( defined $of and scalar( keys %$of ) ) { - print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2; - return $candidates; - } + unless ( defined $of and scalar( keys %$of ) ) { + print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2; + return $candidates; + } - my ( $oldfile, $age, $count ); + my ( $oldfile, $age, $count ); - # Nach Alter sortiert die Liste abklappern ... - $count = scalar( keys %$of ); - foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) { - $count--; - $age = time() - $of->{$oldfile}; - print $p . "Untersuche, ob '$oldfile' weggeschmissen werden soll ...\n" if verbose() > 2; + # Nach Alter sortiert die Liste abklappern ... + $count = scalar( keys %$of ); + foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) { + $count--; + $age = time() - $of->{$oldfile}; + print $p . "Untersuche, ob '$oldfile' weggeschmissen werden soll ...\n" if verbose() > 2; - # Erst mal alles weg, was mehr als die Zahl von "rotate" aussagt ... - if ( $f->{'rotate'} >= 0 and $count >= $f->{'rotate'} ) { - print $p . "Loesche '$oldfile' wegen zuviel (" . $count . " >= " . $f->{'rotate'} . ").\n" if verbose() > 2; - $candidates->{$oldfile} = 1; - next; - } + # Erst mal alles weg, was mehr als die Zahl von "rotate" aussagt ... + if ( $f->{'rotate'} >= 0 and $count >= $f->{'rotate'} ) { + print $p . "Loesche '$oldfile' wegen zuviel (" . $count . " >= " . $f->{'rotate'} . ").\n" if verbose() > 2; + $candidates->{$oldfile} = 1; + next; + } - if ( $maxage and $age >= $maxage ) { - print $p . "Loesche '$oldfile' wegen zu alt (" . $age . " >= " . $maxage . ").\n" if verbose() > 2; - $candidates->{$oldfile} = 1; - } - } + if ( $maxage and $age >= $maxage ) { + print $p . "Loesche '$oldfile' wegen zu alt (" . $age . " >= " . $maxage . ").\n" if verbose() > 2; + $candidates->{$oldfile} = 1; + } + } ## end foreach $oldfile ( sort { $of->{$a} <=> $of->{$b... - return $candidates; + return $candidates; -} +} ## end sub collect_files_delete($$) #------------------------------------------------------------------------------------------ @@ -258,74 +256,74 @@ Die Rueckgabe erfolgt als Hash-Ref sub collect_compress_logfiles($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::collect_compress_logfiles(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::collect_compress_logfiles(): " : ""; - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } - print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; - - my $candidates = {}; - my $of = $f->{'oldfiles'}; - - unless ( $f->{'compress'} ) { - print $p . "Es werden keine Logdateien komprimiert.\n" if verbose() > 2; - return $candidates; - } - - my $behalten = $f->{'delaycompress'} || 0; + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } + print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; - # Compress-Endung ermitteln ... - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; - } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + my $candidates = {}; + my $of = $f->{'oldfiles'}; - unless ( defined $of and scalar( keys %$of ) ) { - print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2; - return $candidates; - } + unless ( $f->{'compress'} ) { + print $p . "Es werden keine Logdateien komprimiert.\n" if verbose() > 2; + return $candidates; + } - my ( $oldfile, $count ); + my $behalten = $f->{'delaycompress'} || 0; - # Nach Alter sortiert die Liste abklappern ... - $count = scalar( keys %$of ); - foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) { - $count--; - if ( $oldfile =~ /$ce$/i ) { - print $p . "Logdatei '$oldfile' scheint schon komprimiert zu sein.\n" if verbose() > 2; - next; - } - if ( $self->{'files_delete'}{$oldfile} ) { - print $p . "Logdatei '$oldfile' ist zum Loeschen vorgesehen.\n" if verbose() > 2; - next; + # Compress-Endung ermitteln ... + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; } - $candidates->{$oldfile} = $of->{$oldfile}; - } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - if ( $behalten and scalar( keys %$candidates ) ) { - my $files_behalten = {}; - my $i = 0; - foreach $oldfile ( sort { $candidates->{$b} <=> $candidates->{$a} } keys %$candidates ) { - $i++; - last if $i > $behalten; - $files_behalten->{$oldfile} = 1; + unless ( defined $of and scalar( keys %$of ) ) { + print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2; + return $candidates; } - foreach $oldfile ( keys %$files_behalten ) { - print $p . "Logdatei '$oldfile' wird NICHT komprimiert.\n" if verbose() > 2; - delete $candidates->{$oldfile}; - } - $files_behalten = undef; - } - return $candidates; + my ( $oldfile, $count ); -} + # Nach Alter sortiert die Liste abklappern ... + $count = scalar( keys %$of ); + foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) { + $count--; + if ( $oldfile =~ /$ce$/i ) { + print $p . "Logdatei '$oldfile' scheint schon komprimiert zu sein.\n" if verbose() > 2; + next; + } + if ( $self->{'files_delete'}{$oldfile} ) { + print $p . "Logdatei '$oldfile' ist zum Loeschen vorgesehen.\n" if verbose() > 2; + next; + } + $candidates->{$oldfile} = $of->{$oldfile}; + } ## end foreach $oldfile ( sort { $of->{$a} <=> $of->{$b... + + if ( $behalten and scalar( keys %$candidates ) ) { + my $files_behalten = {}; + my $i = 0; + foreach $oldfile ( sort { $candidates->{$b} <=> $candidates->{$a} } keys %$candidates ) { + $i++; + last if $i > $behalten; + $files_behalten->{$oldfile} = 1; + } + foreach $oldfile ( keys %$files_behalten ) { + print $p . "Logdatei '$oldfile' wird NICHT komprimiert.\n" if verbose() > 2; + delete $candidates->{$oldfile}; + } + $files_behalten = undef; + } ## end if ( $behalten and scalar( keys %$candidates... + + return $candidates; + +} ## end sub collect_compress_logfiles($$) #------------------------------------------------------------------------------------------ @@ -338,184 +336,206 @@ als Hash-Ref mit den Dateinamen als Key und dem Zeitstempel der letzten Aenderun sub collect_old_logfiles($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::collect_old_logfiles(): " : ""; - - my ( $dir, $basename, $olddir, $pattern, $t ); - my ( @Pattern, @Liste, @Stats ); + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::collect_old_logfiles(): " : ""; - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; - } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - print $p . "Kompressionsendung '$ce'.\n" if verbose() > 3; + my ( $dir, $basename, $olddir, $pattern, $t ); + my ( @Pattern, @Liste, @Stats ); - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } - print $p . "Ermittle alte Logdateien fuer '$file'.\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; - - my $ext = defined $f->{'extension'} ? $f->{'extension'} : ""; - $ext = "" if $ext =~ /^\s*$/; - $ext = "." . $ext if $ext ne "" and $ext !~ /^\./; - my $ext_ohne = $ext; - - # Compress-Endung hinten dran bammeln ... - if ( $f->{'compress'} ) { my $ce = $self->{'c'}->compressext(); if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; + $ce = ".gz"; } $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - $ext .= $ce; - } + print $p . "Kompressionsendung '$ce'.\n" if verbose() > 3; + + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } + print $p . "Ermittle alte Logdateien fuer '$file'.\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; + + my $ext = defined $f->{'extension'} ? $f->{'extension'} : ""; + $ext = "" if $ext =~ /^\s*$/; + $ext = "." . $ext if $ext ne "" and $ext !~ /^\./; + my $ext_ohne = $ext; + + # Compress-Endung hinten dran bammeln ... + if ( $f->{'compress'} ) { + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; + } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + $ext .= $ce; + } - my $res = {}; + my $res = {}; - unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { - warn $p . "Ungueltiger Logdateiname: '$file'\n"; - return undef; - } + unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { + warn $p . "Ungueltiger Logdateiname: '$file'\n"; + return undef; + } - if ( $f->{'dateext'} ) { - $basename .= ".*"; - } + if ( $f->{'dateext'} ) { + $basename .= ".*"; + } - if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'} ) { + if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'} ) { - # Ersetzung aller Platzhalter in Olddir-Angabe + # Ersetzung aller Platzhalter in Olddir-Angabe - $olddir = $f->{'olddir'}{'dirname'}; + $olddir = $f->{'olddir'}{'dirname'}; - # Verzeichnisname ... - $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g; + # Verzeichnisname ... + $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g; - # Basename ... - $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g; + # Basename ... + $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g; - # Nodename - $t = $self->{'template'}{'nodename'}; - $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g; + # Nodename + $t = $self->{'template'}{'nodename'}; + $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g; - # Domain - $t = $self->{'template'}{'domain'}; - $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g; + # Domain + $t = $self->{'template'}{'domain'}; + $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g; - # Platform - $t = $self->{'template'}{'platform'}; - $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g; + # Platform + $t = $self->{'template'}{'platform'}; + $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g; - # Isa - $t = $self->{'template'}{'isa'}; - $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g; + # Isa + $t = $self->{'template'}{'isa'}; + $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g; - # Release - $t = $self->{'template'}{'release'}; - $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g; + # Release + $t = $self->{'template'}{'release'}; + $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g; - # Machine - $t = $self->{'template'}{'machine'}; - $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g; + # Machine + $t = $self->{'template'}{'machine'}; + $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g; - $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#; + $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#; - # Ersetzen aller POSIX::strftime-Platzhalter durch Shell-Pattern: - # Wochentag - $olddir =~ s/\%a/*/gi; - # Monatsname - $olddir =~ s/\%b/*/gi; - $olddir =~ s/\%h/*/g; - # Datum komplett - $olddir =~ s/\%c/*/g; - # Jahrhundert - $olddir =~ s/\%C/[0-9][0-9]/g; - # Tag im Monat - $olddir =~ s/\%d/[0-9][0-9]/g; - # Datum als %m/%d/%y - $olddir =~ s#\%D#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g; - $olddir =~ s#\%x#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g; - # Stunde im 24h-Format - $olddir =~ s/\%H/[012][0-9]/g; - # Stunde im 12h-Format - $olddir =~ s/\%J/[01][0-9]/g; - # Nummer des Tags im Jahr - $olddir =~ s/\%j/[0123][0-9][0-9]/g; - # Stunde im 24h-Format - $olddir =~ s/\%k/[\\ 12][0-9]/g; - # Stunde im 12h-Format - $olddir =~ s/\%l/[\\ 1][0-9]/g; - # Monatsnummer - $olddir =~ s/\%m/[0-9][0-9]/g; - # Minute - $olddir =~ s/\%M/[0-5][0-9]/g; - # AM/PM - $olddir =~ s/\%p/[AP]M/g; - # komplette Uhrzeit im 12h-Format mit AM/PM - $olddir =~ s/\%r/[01][0-9]:[0-5][0-9]:[0-5][0-9] [AP]M/g; - # Uhrzeit im Format %H:%M - $olddir =~ s/\%R/[012][0-9]:[0-5][0-9]/g; - # Sekunden - $olddir =~ s/\%S/[0-6][0-9]/g; - # komplette Uhrzeit im 24h-Format - $olddir =~ s/\%T/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g; - $olddir =~ s/\%X/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g; - # Wochentag als Zahl (1-7) - $olddir =~ s/\%u/[0-7]/g; - $olddir =~ s/\%w/[0-7]/g; - # Nummer der Woche im Jahr - $olddir =~ s/\%U/[0-5][0-9]/g; - $olddir =~ s/\%V/[0-5][0-9]/g; - $olddir =~ s/\%W/[0-5][0-9]/g; - # Jahr - $olddir =~ s/\%Y/[1-9][0-9][0-9][0-9]/g; - # Zeitzone - $olddir =~ s/\%Z/*/g; - - } else { - - $olddir = $dir; + # Ersetzen aller POSIX::strftime-Platzhalter durch Shell-Pattern: + # Wochentag + $olddir =~ s/\%a/*/gi; - } + # Monatsname + $olddir =~ s/\%b/*/gi; + $olddir =~ s/\%h/*/g; - push @Pattern, $olddir . "/" . $basename . $ext; - push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext; - - if ( $f->{'compress'} ) { - push @Pattern, $olddir . "/" . $basename . $ext_ohne; - push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext_ohne; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext_ohne; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext_ohne; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext_ohne; - push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext_ohne; - } + # Datum komplett + $olddir =~ s/\%c/*/g; + + # Jahrhundert + $olddir =~ s/\%C/[0-9][0-9]/g; + + # Tag im Monat + $olddir =~ s/\%d/[0-9][0-9]/g; + + # Datum als %m/%d/%y + $olddir =~ s#\%D#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g; + $olddir =~ s#\%x#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g; + + # Stunde im 24h-Format + $olddir =~ s/\%H/[012][0-9]/g; + + # Stunde im 12h-Format + $olddir =~ s/\%J/[01][0-9]/g; + + # Nummer des Tags im Jahr + $olddir =~ s/\%j/[0123][0-9][0-9]/g; + + # Stunde im 24h-Format + $olddir =~ s/\%k/[\\ 12][0-9]/g; + + # Stunde im 12h-Format + $olddir =~ s/\%l/[\\ 1][0-9]/g; + + # Monatsnummer + $olddir =~ s/\%m/[0-9][0-9]/g; + + # Minute + $olddir =~ s/\%M/[0-5][0-9]/g; + + # AM/PM + $olddir =~ s/\%p/[AP]M/g; -# $pattern = '"' . join( '" "', @Pattern ) . '"'; -# print $p . "Suchpattern nach den alten Logdateien: '$pattern'.\n" if verbose() > 2; + # komplette Uhrzeit im 12h-Format mit AM/PM + $olddir =~ s/\%r/[01][0-9]:[0-5][0-9]:[0-5][0-9] [AP]M/g; -# @Liste = glob( $pattern ); + # Uhrzeit im Format %H:%M + $olddir =~ s/\%R/[012][0-9]:[0-5][0-9]/g; + + # Sekunden + $olddir =~ s/\%S/[0-6][0-9]/g; + + # komplette Uhrzeit im 24h-Format + $olddir =~ s/\%T/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g; + $olddir =~ s/\%X/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g; + + # Wochentag als Zahl (1-7) + $olddir =~ s/\%u/[0-7]/g; + $olddir =~ s/\%w/[0-7]/g; + + # Nummer der Woche im Jahr + $olddir =~ s/\%U/[0-5][0-9]/g; + $olddir =~ s/\%V/[0-5][0-9]/g; + $olddir =~ s/\%W/[0-5][0-9]/g; + + # Jahr + $olddir =~ s/\%Y/[1-9][0-9][0-9][0-9]/g; + + # Zeitzone + $olddir =~ s/\%Z/*/g; + + } ## end if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'... + else { + + $olddir = $dir; - foreach $pattern ( @Pattern ) { - print $p . "Suche nach Pattern '$pattern'.\n" if verbose() > 2; - @Liste = glob( $pattern ); - for ( @Liste ) { - if ( $_ ne $file ) { - print " - '$_'\n" if verbose() > 3; - @Stats = stat $_; - $res->{$_} = $Stats[9]; - } } - } - return $res; -} + push @Pattern, $olddir . "/" . $basename . $ext; + push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext; + + if ( $f->{'compress'} ) { + push @Pattern, $olddir . "/" . $basename . $ext_ohne; + push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext_ohne; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext_ohne; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext_ohne; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext_ohne; + push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext_ohne; + } + + # $pattern = '"' . join( '" "', @Pattern ) . '"'; + # print $p . "Suchpattern nach den alten Logdateien: '$pattern'.\n" if verbose() > 2; + + # @Liste = glob( $pattern ); + + foreach $pattern (@Pattern) { + print $p . "Suche nach Pattern '$pattern'.\n" if verbose() > 2; + @Liste = glob($pattern); + for (@Liste) { + if ( $_ ne $file ) { + print " - '$_'\n" if verbose() > 3; + @Stats = stat $_; + $res->{$_} = $Stats[9]; + } + } + } ## end foreach $pattern (@Pattern) + + return $res; +} ## end sub collect_old_logfiles($$) #------------------------------------------------------------------------------------ @@ -527,40 +547,41 @@ Komprimiert alle alten Logdateien, die in $self->{'files_compress'} erfasst word sub compress($) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::compress(): " : ""; + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::compress(): " : ""; - print $p . "Komprimiere alte Logdateien ...\n" if verbose(); + print $p . "Komprimiere alte Logdateien ...\n" if verbose(); - unless ( $self->{'files_compress'} and scalar( keys %{$self->{'files_compress'}} ) ) { - print $p . "Keine alten Logdateien zum Komprimieren gefunden.\n"; - return 1; - } + unless ( $self->{'files_compress'} and scalar( keys %{ $self->{'files_compress'} } ) ) { + print $p . "Keine alten Logdateien zum Komprimieren gefunden.\n"; + return 1; + } - my ( $file ); - my $cmd = $self->{'c'}{'compress_cmd'}; + my ($file); + my $cmd = $self->{'c'}{'compress_cmd'}; - unless ( $cmd ) { - warn $p . "Kein gueltiges Kompressionsprogramm gegeben oder gefunden.\n"; - return 1; - } + unless ($cmd) { + warn $p . "Kein gueltiges Kompressionsprogramm gegeben oder gefunden.\n"; + return 1; + } - my $method = ( $cmd eq 'Compress::Zlib' or $cmd eq '1' ) ? \&compress_file_zlib : - ( $cmd eq 'Compress::Bzip2' or $cmd eq '2' ) ? \&compress_file_bzip2 : - \&compress_external; + my $method + = ( $cmd eq 'Compress::Zlib' or $cmd eq '1' ) ? \&compress_file_zlib + : ( $cmd eq 'Compress::Bzip2' or $cmd eq '2' ) ? \&compress_file_bzip2 + : \&compress_external; - for $file ( keys %{$self->{'files_compress'}} ) { + for $file ( keys %{ $self->{'files_compress'} } ) { - unless ( $self->$method($file) ) { - warn $p . "Komprimieren von '$file' ging gewaltig schief.\n"; - return undef; - } + unless ( $self->$method($file) ) { + warn $p . "Komprimieren von '$file' ging gewaltig schief.\n"; + return undef; + } - } + } - return 1; + return 1; -} +} ## end sub compress($) #------------------------------------------------------------------------------------ @@ -572,54 +593,56 @@ Komprimiert die uebergebene Datei mittels eines externen Programms. sub compress_external($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::compress_external(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::compress_external(): " : ""; - my $cmd = $self->{'c'}{'compress_cmd'}; + my $cmd = $self->{'c'}{'compress_cmd'}; - unless ( $file ) { - carp( $p . "Keine Datei uebergeben!\n" ); - return undef; - } - print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels '$cmd'" : "" ) . " ...\n"; + unless ($file) { + carp( $p . "Keine Datei uebergeben!\n" ); + return undef; + } + print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels '$cmd'" : "" ) . " ...\n"; - # Gucken, ob Datei ueberhaupt da ist - unless ( -f $file ) { - warn $p . "Datei '$file' existiert nicht!\n"; - return 1; - } + # Gucken, ob Datei ueberhaupt da ist + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht!\n"; + return 1; + } - # Weiter, wenn Dateigroesse == 0 - my $size = ( -s $file ); - unless ( $size ) { - print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; - return 1; - } + # Weiter, wenn Dateigroesse == 0 + my $size = ( -s $file ); + unless ($size) { + print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; + return 1; + } - $cmd .= " " . ( $self->{'compressoptions'} || "" ) . " " . $file; - print " -> $cmd\n"; + $cmd .= " " . ( $self->{'compressoptions'} || "" ) . " " . $file; + print " -> $cmd\n"; - # Weiter, wenn Testmodus - return 1 if $self->{'test'}; + # Weiter, wenn Testmodus + return 1 if $self->{'test'}; - system $cmd; + system $cmd; - if ( $? ) { - if ($? == -1) { - warn $p . "Konnte Kompressions-Kommando nicht ausfuehren: $!\n"; - return undef; - } elsif ($? & 127) { - warn( $p . printf "Das Kommando starb mit Signal %d, %s Coredump\n", ($? & 127), ($? & 128) ? 'mit' : 'ohne'); - return undef; - } else { - printf $p . "Das Kommando wurde mit dem Wert %d beendet.\n", $? >> 8; - } - } + if ($?) { + if ( $? == -1 ) { + warn $p . "Konnte Kompressions-Kommando nicht ausfuehren: $!\n"; + return undef; + } + elsif ( $? & 127 ) { + warn( $p . printf "Das Kommando starb mit Signal %d, %s Coredump\n", ( $? & 127 ), ( $? & 128 ) ? 'mit' : 'ohne' ); + return undef; + } + else { + printf $p . "Das Kommando wurde mit dem Wert %d beendet.\n", $? >> 8; + } + } ## end if ($?) - return 1; + return 1; -} +} ## end sub compress_external($$) #------------------------------------------------------------------------------------ @@ -634,96 +657,96 @@ bereits geladen ist. sub compress_file_bzip2($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::compress_file_bzip2(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::compress_file_bzip2(): " : ""; - my ( $size ); + my ($size); - unless ( $file ) { - carp( $p . "Keine Datei uebergeben!\n" ); - return undef; - } - print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Bzip2" : "" ) . " ...\n"; + unless ($file) { + carp( $p . "Keine Datei uebergeben!\n" ); + return undef; + } + print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Bzip2" : "" ) . " ...\n"; - # Endung der komprimierten Datei ermitteln - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; - } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + # Endung der komprimierten Datei ermitteln + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; + } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - # Gucken, ob Datei ueberhaupt da ist - unless ( -f $file ) { - warn $p . "Datei '$file' existiert nicht!\n"; - return 1; - } + # Gucken, ob Datei ueberhaupt da ist + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht!\n"; + return 1; + } - # Weiter, wenn Dateigroesse == 0 - $size = ( -s $file ); - unless ( $size ) { - print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; - return 1; - } + # Weiter, wenn Dateigroesse == 0 + $size = ( -s $file ); + unless ($size) { + print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; + return 1; + } - # Weiter, wenn Testmodus - return 1 if $self->{'test'}; + # Weiter, wenn Testmodus + return 1 if $self->{'test'}; - my $target = $file . $ce; - my ( $bz, $buffer ); - my ( @Stat ); - my %BzParams = (); - $BzParams{'-verbosity'} = verbose() > 7 ? 4 : int((verbose()+1) / 2) ; + my $target = $file . $ce; + my ( $bz, $buffer ); + my (@Stat); + my %BzParams = (); + $BzParams{'-verbosity'} = verbose() > 7 ? 4 : int( ( verbose() + 1 ) / 2 ); - unless ( open LOG, "<", "$file" ) { - warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n"; - return undef; - } + unless ( open LOG, "<", "$file" ) { + warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n"; + return undef; + } - unless ( $bz = Compress::Bzip2::bzopen( $target, 'w' ) ) { - warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n"; - close LOG; - return undef; - } + unless ( $bz = Compress::Bzip2::bzopen( $target, 'w' ) ) { + warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n"; + close LOG; + return undef; + } - print " "; - $bz->bzsetparams( %BzParams ); - while ( read LOG, $buffer, default_buffer_size ) { - $bz->bzwrite( $buffer ); - } - $bz->bzclose(); + print " "; + $bz->bzsetparams(%BzParams); + while ( read LOG, $buffer, default_buffer_size ) { + $bz->bzwrite($buffer); + } + $bz->bzclose(); - close LOG; - print "\n" if verbose(); + close LOG; + print "\n" if verbose(); - @Stat = stat $file; - my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ]; - $mode &= 0777; + @Stat = stat $file; + my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ]; + $mode &= 0777; - print $p . "Setze Permissions von '$target'.\n" if verbose(); - unless ( chmod $mode, $target ) { - warn $p . "Problem beim Setzen der Permissions von '$target': $!\n"; - } + print $p . "Setze Permissions von '$target'.\n" if verbose(); + unless ( chmod $mode, $target ) { + warn $p . "Problem beim Setzen der Permissions von '$target': $!\n"; + } - print $p . "Setze Mtime von '$target'.\n" if verbose(); - unless ( utime $mtime, $mtime, $target ) { - warn $p . "Problem beim Setzen der Mtime von '$target': $!\n"; - } + print $p . "Setze Mtime von '$target'.\n" if verbose(); + unless ( utime $mtime, $mtime, $target ) { + warn $p . "Problem beim Setzen der Mtime von '$target': $!\n"; + } - print $p . "Setze Besitzerschaft von '$target'.\n" if verbose(); - unless ( chown $uid, $gid, $target ) { - warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n"; - } + print $p . "Setze Besitzerschaft von '$target'.\n" if verbose(); + unless ( chown $uid, $gid, $target ) { + warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n"; + } - print $p . "Loesche Original-Datei '$file' ...\n" if verbose(); - unless ( unlink $file ) { - warn $p . "Problem beim Loeschen von '$file': $!\n"; - return undef; - } + print $p . "Loesche Original-Datei '$file' ...\n" if verbose(); + unless ( unlink $file ) { + warn $p . "Problem beim Loeschen von '$file': $!\n"; + return undef; + } - return 1; + return 1; -} +} ## end sub compress_file_bzip2($$) #------------------------------------------------------------------------------------ @@ -738,115 +761,115 @@ bereits geladen ist. sub compress_file_zlib($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::compress_file_zlib(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::compress_file_zlib(): " : ""; - my ( $size ); + my ($size); - unless ( $file ) { - carp( $p . "Keine Datei uebergeben!\n" ); - return undef; - } - print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Zlib" : "" ) . " ...\n"; + unless ($file) { + carp( $p . "Keine Datei uebergeben!\n" ); + return undef; + } + print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Zlib" : "" ) . " ...\n"; - # Endung der komprimierten Datei ermitteln - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; - } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + # Endung der komprimierten Datei ermitteln + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; + } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - # Gucken, ob Datei ueberhaupt da ist - unless ( -f $file ) { - warn $p . "Datei '$file' existiert nicht!\n"; - return 1; - } + # Gucken, ob Datei ueberhaupt da ist + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht!\n"; + return 1; + } - # Weiter, wenn Dateigroesse == 0 - $size = ( -s $file ); - unless ( $size ) { - print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; - return 1; - } + # Weiter, wenn Dateigroesse == 0 + $size = ( -s $file ); + unless ($size) { + print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n"; + return 1; + } - # Ermittlung Compress-Level - my $level = 5; - if ( $self->{'c'}{'compressoptions'} and $self->{'c'}{'compressoptions'} =~ /^[^\d-]*-(\d)/ ) { - $level = $1; - } - print $p . "Gewuenschtes Kompressions-Level: $level\n" if verbose() > 1; - unless ( $level ) { - warn $p . "Kompressions-Level '0' eingestellt, keine Kompression.\n"; - return 1; - } + # Ermittlung Compress-Level + my $level = 5; + if ( $self->{'c'}{'compressoptions'} and $self->{'c'}{'compressoptions'} =~ /^[^\d-]*-(\d)/ ) { + $level = $1; + } + print $p . "Gewuenschtes Kompressions-Level: $level\n" if verbose() > 1; + unless ($level) { + warn $p . "Kompressions-Level '0' eingestellt, keine Kompression.\n"; + return 1; + } - # Weiter, wenn Testmodus - return 1 if $self->{'test'}; + # Weiter, wenn Testmodus + return 1 if $self->{'test'}; - my $blocks = int( $size / default_buffer_size ); - my $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1; - my $i = 0; - my $target = $file . $ce; - my $strategy = eval("Compress::Zlib::Z_DEFAULT_STRATEGY;"); - my ( $gz, $buffer ); - my ( @Stat ); + my $blocks = int( $size / default_buffer_size ); + my $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1; + my $i = 0; + my $target = $file . $ce; + my $strategy = eval("Compress::Zlib::Z_DEFAULT_STRATEGY;"); + my ( $gz, $buffer ); + my (@Stat); - print $p . "Oeffne '$file' zum Lesen ...\n" if verbose() > 1; - unless ( open LOG, "<", "$file" ) { - warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n"; - return undef; - } + print $p . "Oeffne '$file' zum Lesen ...\n" if verbose() > 1; + unless ( open LOG, "<", "$file" ) { + warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n"; + return undef; + } - print $p . "Oeffne '$target' zum komprimierten Schreiben ...\n" if verbose() > 1; - unless ( $gz = Compress::Zlib::gzopen( $target, 'wb' ) ) { - warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n"; - close LOG; - return undef; - } + print $p . "Oeffne '$target' zum komprimierten Schreiben ...\n" if verbose() > 1; + unless ( $gz = Compress::Zlib::gzopen( $target, 'wb' ) ) { + warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n"; + close LOG; + return undef; + } - print $p . "Setze Kompressions-Parameter auf Level '$level' und Strategie auf '$strategy'.\n" if verbose() > 2; - $gz->gzsetparams( $level, $strategy ); + print $p . "Setze Kompressions-Parameter auf Level '$level' und Strategie auf '$strategy'.\n" if verbose() > 2; + $gz->gzsetparams( $level, $strategy ); - print " "; - while ( read LOG, $buffer, default_buffer_size ) { - $i++; - $gz->gzwrite( $buffer ); - print "." if verbose() and ( $i % $every == 0 ); - } - $gz->gzclose(); + print " "; + while ( read LOG, $buffer, default_buffer_size ) { + $i++; + $gz->gzwrite($buffer); + print "." if verbose() and ( $i % $every == 0 ); + } + $gz->gzclose(); - close LOG; - print "\n" if verbose(); + close LOG; + print "\n" if verbose(); - @Stat = stat $file; - my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ]; - $mode &= 0777; + @Stat = stat $file; + my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ]; + $mode &= 0777; - print $p . "Setze Permissions von '$target'.\n" if verbose(); - unless ( chmod $mode, $target ) { - warn $p . "Problem beim Setzen der Permissions von '$target': $!\n"; - } + print $p . "Setze Permissions von '$target'.\n" if verbose(); + unless ( chmod $mode, $target ) { + warn $p . "Problem beim Setzen der Permissions von '$target': $!\n"; + } - print $p . "Setze Mtime von '$target'.\n" if verbose(); - unless ( utime $mtime, $mtime, $target ) { - warn $p . "Problem beim Setzen der Mtime von '$target': $!\n"; - } + print $p . "Setze Mtime von '$target'.\n" if verbose(); + unless ( utime $mtime, $mtime, $target ) { + warn $p . "Problem beim Setzen der Mtime von '$target': $!\n"; + } - print $p . "Setze Besitzerschaft von '$target'.\n" if verbose(); - unless ( chown $uid, $gid, $target ) { - warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n"; - } + print $p . "Setze Besitzerschaft von '$target'.\n" if verbose(); + unless ( chown $uid, $gid, $target ) { + warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n"; + } - print $p . "Loesche Original-Datei '$file' ...\n" if verbose(); - unless ( unlink $file ) { - warn $p . "Problem beim Loeschen von '$file': $!\n"; - return undef; - } + print $p . "Loesche Original-Datei '$file' ...\n" if verbose(); + unless ( unlink $file ) { + warn $p . "Problem beim Loeschen von '$file': $!\n"; + return undef; + } - return 1; + return 1; -} +} ## end sub compress_file_zlib($$) #------------------------------------------------------------------------------------ @@ -863,142 +886,145 @@ Gibt den Erfolg als Wahrheitswert zurueck. sub create_olddir($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::create_olddir(): " : ""; - - my ( $dir, $adir, $mode, $owner, $group, $olddir ); - my ( $pmode, $puid, $pgid, $basename, $t ); - my ( @Dirs, @Stats ); - my $uid = $>; - my ( $gid ) = $) =~ /^(\d+)/; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::create_olddir(): " : ""; - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } - print $p . "Ueberpruefe und erstelle 'olddir' fuer Logdatei '$file'.\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; + my ( $dir, $adir, $mode, $owner, $group, $olddir ); + my ( $pmode, $puid, $pgid, $basename, $t ); + my ( @Dirs, @Stats ); + my $uid = $>; + my ($gid) = $) =~ /^(\d+)/; - print $p . Dumper( $f ) if verbose() > 2; + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } + print $p . "Ueberpruefe und erstelle 'olddir' fuer Logdatei '$file'.\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; - unless ( $f ) { - carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); - return undef; - } + print $p . Dumper($f) if verbose() > 2; - my $o = $f->{'olddir'}; + unless ($f) { + carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); + return undef; + } - unless ( $o->{'dirname'} ) { - print $p . "Keine 'olddir'-Direktive fuer '$file' gegeben.\n" if verbose() > 1; - return 1; - } + my $o = $f->{'olddir'}; - $mode = $o->{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755; - $owner = $o->{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid; - $group = $o->{'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; - } + unless ( $o->{'dirname'} ) { + print $p . "Keine 'olddir'-Direktive fuer '$file' gegeben.\n" if verbose() > 1; + return 1; + } - if ( $o->{'dirname'} =~ /%/ ) { - $o->{'dateformat'} = 1; - $olddir = POSIX::strftime( $o->{'dirname'}, localtime() ); - } else { - $olddir = $o->{'dirname'}; - } + $mode = $o->{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755; + $owner = $o->{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid; + $group = $o->{'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; + } - # Ersetzung aller Platzhalter in Olddir-Angabe + if ( $o->{'dirname'} =~ /%/ ) { + $o->{'dateformat'} = 1; + $olddir = POSIX::strftime( $o->{'dirname'}, localtime() ); + } + else { + $olddir = $o->{'dirname'}; + } - unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { - warn $p . "Ungueltiger Logdateiname: '$file'\n"; - return undef; - } + # Ersetzung aller Platzhalter in Olddir-Angabe - # Verzeichnisname ... - $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g; - - # Basename ... - $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g; - - # Nodename - $t = $self->{'template'}{'nodename'}; - $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g; - - # Domain - $t = $self->{'template'}{'domain'}; - $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g; - - # Platform - $t = $self->{'template'}{'platform'}; - $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g; - - # Isa - $t = $self->{'template'}{'isa'}; - $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g; - - # Release - $t = $self->{'template'}{'release'}; - $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g; - - # Machine - $t = $self->{'template'}{'machine'}; - $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g; - - $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#; - - $o->{'expanded'} = $olddir; - print $p . "Olddir ist jetzt: '$olddir'.\n" if 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 " - ueberpruefe $adir\n" if verbose() > 2; - if ( -d $adir ) { - @Stats = stat $adir; - ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5]; - } else { - print $p . "Erstelle Verzeichnis $adir ...\n"; - # Ermittlung effektive Permissions + Ownership - # wenn in config-file gegeben, diese, - # ansonsten die vom uebergeordneten Verzeichnis. - $mode = defined $o->{'mode'} ? $o->{'mode'} : $pmode; - $owner = defined $o->{'owner'} ? $o->{'owner'} : $puid; - $group = defined $o->{'group'} ? $o->{'group'} : $pgid; - print " Permissions: $mode, Owner: $owner, Group: $group\n" if verbose() > 1; - unless ( $self->{'test'} ) { - print " mkdir $adir $mode\n" if verbose() > 1; - unless ( mkdir $adir, $mode ) { - warn $p . "$!\n"; - return undef; - } - if ( $owner != $uid and $group != $gid ) { - print " chown $owner, $group, $adir\n" if verbose() > 1; - unless ( chown $owner, $group, $adir ) { - warn $p . "$!\n"; - return undef; - } - } - } - } + unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { + warn $p . "Ungueltiger Logdateiname: '$file'\n"; + return undef; } - } + # Verzeichnisname ... + $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g; - return 1; -} + # Basename ... + $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g; + + # Nodename + $t = $self->{'template'}{'nodename'}; + $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g; + + # Domain + $t = $self->{'template'}{'domain'}; + $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g; + + # Platform + $t = $self->{'template'}{'platform'}; + $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g; + + # Isa + $t = $self->{'template'}{'isa'}; + $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g; + + # Release + $t = $self->{'template'}{'release'}; + $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g; + + # Machine + $t = $self->{'template'}{'machine'}; + $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g; + + $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#; + + $o->{'expanded'} = $olddir; + print $p . "Olddir ist jetzt: '$olddir'.\n" if 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 " - ueberpruefe $adir\n" if verbose() > 2; + if ( -d $adir ) { + @Stats = stat $adir; + ( $pmode, $puid, $pgid ) = @Stats[ 2, 4, 5 ]; + } + else { + print $p . "Erstelle Verzeichnis $adir ...\n"; + + # Ermittlung effektive Permissions + Ownership + # wenn in config-file gegeben, diese, + # ansonsten die vom uebergeordneten Verzeichnis. + $mode = defined $o->{'mode'} ? $o->{'mode'} : $pmode; + $owner = defined $o->{'owner'} ? $o->{'owner'} : $puid; + $group = defined $o->{'group'} ? $o->{'group'} : $pgid; + print " Permissions: $mode, Owner: $owner, Group: $group\n" if verbose() > 1; + unless ( $self->{'test'} ) { + print " mkdir $adir $mode\n" if verbose() > 1; + unless ( mkdir $adir, $mode ) { + warn $p . "$!\n"; + return undef; + } + if ( $owner != $uid and $group != $gid ) { + print " chown $owner, $group, $adir\n" if verbose() > 1; + unless ( chown $owner, $group, $adir ) { + warn $p . "$!\n"; + return undef; + } + } + } ## end unless ( $self->{'test'} ) + } ## end else [ if ( -d $adir ) + } ## end foreach $dir (@Dirs) + + } ## end unless ( -d $olddir ) + + return 1; +} ## end sub create_olddir($$) #------------------------------------------------------------------------------------ @@ -1010,31 +1036,31 @@ Loescht alle alten Logdateien, die in $self->{'files_delete'} erfasst worden sin sub delete_oldfiles($) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::delete_oldfiles(): " : ""; + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::delete_oldfiles(): " : ""; - print $p . "Loesche alte Logdateien ...\n" if verbose(); + print $p . "Loesche alte Logdateien ...\n" if verbose(); - unless ( $self->{'files_delete'} and scalar( keys %{$self->{'files_delete'}} ) ) { - print $p . "Keine alten Logdateien zum Loeschen gefunden.\n"; - return 1; - } + unless ( $self->{'files_delete'} and scalar( keys %{ $self->{'files_delete'} } ) ) { + print $p . "Keine alten Logdateien zum Loeschen gefunden.\n"; + return 1; + } - my ( $file ); + my ($file); - for $file ( sort keys %{$self->{'files_delete'}} ) { - print $p . "Loesche alte Logdatei '$file' ...\n"; - unless ( $self->{'test'} ) { - unless ( unlink($file) ) { - warn $p . "Konnte alte Logdatei '$file' nicht loeschen: $!\n"; - return undef; - } + for $file ( sort keys %{ $self->{'files_delete'} } ) { + print $p . "Loesche alte Logdatei '$file' ...\n"; + unless ( $self->{'test'} ) { + unless ( unlink($file) ) { + warn $p . "Konnte alte Logdatei '$file' nicht loeschen: $!\n"; + return undef; + } + } } - } - return 1; + return 1; -} +} ## end sub delete_oldfiles($) #------------------------------------------------------------------------------------ @@ -1069,84 +1095,85 @@ Umbenennungen erfolgen muessen. =cut - sub find_rotatings($$$) { - my $self = shift; - my $file = shift; - my $target = shift; - my $p = verbose() ? __PACKAGE__ . "::find_rotatings(): " : ""; + my $self = shift; + my $file = shift; + my $target = shift; + my $p = verbose() ? __PACKAGE__ . "::find_rotatings(): " : ""; - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } - unless ( $target ) { - carp( $p . "Kein Dateiname fuer rotierte Logdatei uebergeben!\n" ); - return undef; - } + unless ($target) { + carp( $p . "Kein Dateiname fuer rotierte Logdatei uebergeben!\n" ); + return undef; + } - print $p . "Ermittle alle Umbenennungen und Rotationen fuer Logdatei '$file' -> '$target'...\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; + print $p . "Ermittle alle Umbenennungen und Rotationen fuer Logdatei '$file' -> '$target'...\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; - my $ext = defined $f->{'extension'} ? $f->{'extension'} : ""; - $ext = "" if $ext =~ /^\s*$/; - $ext = "." . $ext if $ext ne "" and $ext !~ /^\./; - my $ext_ohne = $ext; + my $ext = defined $f->{'extension'} ? $f->{'extension'} : ""; + $ext = "" if $ext =~ /^\s*$/; + $ext = "." . $ext if $ext ne "" and $ext !~ /^\./; + my $ext_ohne = $ext; - # Compress-Endung hinten dran bammeln ... - if ( $f->{'compress'} ) { - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; + # Compress-Endung hinten dran bammeln ... + if ( $f->{'compress'} ) { + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; + } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + $ext .= $ce; } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - $ext .= $ce; - } - my ( $i, $pair, $t, $t_ohne, $t_new, $t_new_ohne ); - $t = $target . $ext; - $t_ohne = $target . $ext_ohne; - $i = 0; - - my $res = { - 'rotate' => {}, - 'move' => [] - }; - - # Ziel der eigentlichen Rotation festlegen - if ( $file eq $t ) { - $t = $target . ".0" . $ext; - $t_ohne = $target . ".0" . $ext_ohne; - $i = 1; - } - $res->{'rotate'}{'from'} = $file; - $res->{'rotate'}{'to'} = $t_ohne; - - # Rotationsziel gibt's nicht, okay, raus hier - return $res unless -f $t or -f $t_ohne; - - print $p . "Rotationsziel '$t_ohne' gibt's schon, ermittle zyklische Rotationen ...\n" if verbose() > 2; - # restliche Rotationen festlegen ... - while ( -f $t or -f $t_ohne ) { - $t_new = $target . "." . $i . $ext; - $t_new_ohne = $target . "." . $i . $ext_ohne; - print $p . "Zyklische Rotation '$t_ohne' -> '$t_new_ohne'.\n" if verbose() > 3; - $pair = { 'from' => $t_ohne, - 'to' => $t_new_ohne, - 'compressed' => 0, - }; - $pair->{'compressed'} = 1 if -f $t and $f->{'compress'}; - unshift @{$res->{'move'}}, $pair; - $t = $t_new; - $t_ohne = $t_new_ohne; - $i++; - } - - return $res; - -} + my ( $i, $pair, $t, $t_ohne, $t_new, $t_new_ohne ); + $t = $target . $ext; + $t_ohne = $target . $ext_ohne; + $i = 0; + + my $res = { + 'rotate' => {}, + 'move' => [] + }; + + # Ziel der eigentlichen Rotation festlegen + if ( $file eq $t ) { + $t = $target . ".0" . $ext; + $t_ohne = $target . ".0" . $ext_ohne; + $i = 1; + } + $res->{'rotate'}{'from'} = $file; + $res->{'rotate'}{'to'} = $t_ohne; + + # Rotationsziel gibt's nicht, okay, raus hier + return $res unless -f $t or -f $t_ohne; + + print $p . "Rotationsziel '$t_ohne' gibt's schon, ermittle zyklische Rotationen ...\n" if verbose() > 2; + + # restliche Rotationen festlegen ... + while ( -f $t or -f $t_ohne ) { + $t_new = $target . "." . $i . $ext; + $t_new_ohne = $target . "." . $i . $ext_ohne; + print $p . "Zyklische Rotation '$t_ohne' -> '$t_new_ohne'.\n" if verbose() > 3; + $pair = { + 'from' => $t_ohne, + 'to' => $t_new_ohne, + 'compressed' => 0, + }; + $pair->{'compressed'} = 1 if -f $t and $f->{'compress'}; + unshift @{ $res->{'move'} }, $pair; + $t = $t_new; + $t_ohne = $t_new_ohne; + $i++; + } ## end while ( -f $t or -f $t_ohne ) + + return $res; + +} ## end sub find_rotatings($$$) #------------------------------------------------------------------------------------ @@ -1158,46 +1185,46 @@ Legt das Ziel des Rotierens fuer das uebergebene Logfile fest und gibt dieses zu sub get_logfile_target($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::get_logfile_target(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::get_logfile_target(): " : ""; - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); + return undef; + } - print $p . "Ermittle Dateinamen der rotierten Logdatei '$file'...\n" if verbose() > 1; - my $f = $self->{'c'}{'logfiles'}{$file}; + print $p . "Ermittle Dateinamen der rotierten Logdatei '$file'...\n" if verbose() > 1; + my $f = $self->{'c'}{'logfiles'}{$file}; - print $p . "Struktur von '$file': " . " " . Dumper( $f ) if verbose() > 2; + print $p . "Struktur von '$file': " . " " . Dumper($f) if verbose() > 2; - my ( $nr, $dir, $basename, $target, $pattern, $t ); + my ( $nr, $dir, $basename, $target, $pattern, $t ); - unless ( $f ) { - carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); - return undef; - } + unless ($f) { + carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); + return undef; + } - unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { - warn $p . "Ungueltiger Logdateiname: '$file'\n"; - return undef; - } + unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) { + warn $p . "Ungueltiger Logdateiname: '$file'\n"; + return undef; + } - $dir = $f->{'olddir'}{'expanded'} if $f->{'olddir'}{'expanded'}; - $target = $dir . "/" . $basename; - if ( $f->{'dateext'} ) { - $pattern = $f->{'datepattern'}; - print $p . "Verwende Datumsersetzung '$pattern' fuer '$file'.\n" if verbose() > 1; - $pattern = POSIX::strftime( $pattern, localtime() ); - print $p . " -> '$pattern'\n" if verbose() > 3; - $target .= "." . $pattern; - } + $dir = $f->{'olddir'}{'expanded'} if $f->{'olddir'}{'expanded'}; + $target = $dir . "/" . $basename; + if ( $f->{'dateext'} ) { + $pattern = $f->{'datepattern'}; + print $p . "Verwende Datumsersetzung '$pattern' fuer '$file'.\n" if verbose() > 1; + $pattern = POSIX::strftime( $pattern, localtime() ); + print $p . " -> '$pattern'\n" if verbose() > 3; + $target .= "." . $pattern; + } - print $p . "Dateiname '$target' fuer rotierte Logdatei '$file' gefunden.\n" if verbose() > 1; - return $target; + print $p . "Dateiname '$target' fuer rotierte Logdatei '$file' gefunden.\n" if verbose() > 1; + return $target; -} +} ## end sub get_logfile_target($$) #------------------------------------------------------------------------------------ @@ -1209,11 +1236,11 @@ Liest die uebergebene Datei in die Konfiguration ein. sub read_config($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::read_config(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::read_config(): " : ""; - return $self->{'c'}->read($file); + return $self->{'c'}->read($file); } @@ -1227,138 +1254,139 @@ Fuehrt das eigentliche Rotieren aus. sub rotate($) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::rotate(): " : ""; - - die $p . "Noch keine Konfiguration eingelesen.\n\n" unless $self->{'c'}; + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::rotate(): " : ""; - unless ( $self->{'c'}{'logfiles'} and scalar( keys %{$self->{'c'}{'logfiles'}} ) ) { - warn $p . "Keine Logdateien zum Rotieren gefunden.\n"; - return undef; - } + die $p . "Noch keine Konfiguration eingelesen.\n\n" unless $self->{'c'}; - my ( $file, $should_rotate, $firstscript, $prescript, $postscript, $lastscript, $sharedscripts ); - my ( $cmd, $do_script, $name ); - - foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'c'}{'logfiles'}} ) { - - print( "\n" . ("-" x 20) . "\n\n") if verbose() > 1; - print $p . "Bearbeite Logdatei '$file' ...\n" if verbose() > 1; - - $should_rotate = $self->test_for_rotate( $file ); - - unless( defined $should_rotate ) { - die $p . "Schwerer Fehler, breche hier ab.\n"; - } - - unless ( $should_rotate ) { - print $p . "Logdatei '$file' wird NICHT rotiert.\n" if verbose(); - next; - } - print $p . "Logdatei '$file' wird rotiert.\n" if verbose(); - - $sharedscripts = $self->{'c'}{'logfiles'}{$file}{'sharedscripts'} || 0; - $firstscript = $self->{'c'}{'logfiles'}{$file}{'firstaction'}; - $prescript = $self->{'c'}{'logfiles'}{$file}{'prerotate'}; - $postscript = $self->{'c'}{'logfiles'}{$file}{'postrotate'}; - $lastscript = $self->{'c'}{'logfiles'}{$file}{'lastaction'}; - - # Ausfuehren des Firtsaction-Scripts, falls es noch nicht ausgefuehrt wurde - if ( $firstscript ) { - print $p . "Schau nach, ob das Firstaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2; - unless ( $self->{'c'}{'scripts'}{$firstscript}{'first'} ) { - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$firstscript}{'cmd'}} ) . "\n"; - print $p . "Fuehre Firstaction-Script '$firstscript' aus:\n$cmd"; - system $cmd unless $self->{'test'}; - } - $self->{'c'}{'scripts'}{$firstscript}{'first'} = 1; - } - - # Ausfuehren des Prerotate-Scripts, falls es noch nicht ausgefuehrt wurde - # oder sharedscripts nicht gesetzt ist - if ( $prescript ) { - print $p . "Schau nach, ob das Prerotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2; - unless ( $self->{'c'}{'scripts'}{$prescript}{'prerun'} and $sharedscripts ) { - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$prescript}{'cmd'}} ) . "\n"; - print $p . "Fuehre Firstaction-Script '$prescript' aus:\n$cmd"; - system $cmd unless $self->{'test'}; - } - $self->{'c'}{'scripts'}{$prescript}{'prerun'} = 1; - } - - ##### - # Hier jetzt das eigentliche Rotieren .... - ##### - - unless ( $self->create_olddir( $file ) ) { - next; - } - - unless ( $self->rotate_file( $file ) ) { - next; - } - - # Ausfuehren des Postrotate-Scripts, falls es die letzte Rotation ist, fuer die - # dieses Script gilt, oder sharedscripts nicht gesetzt ist - if ( $postscript ) { - print $p . "Schau nach, ob das Postrotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2; - $do_script = 0; - $self->{'c'}{'scripts'}{$postscript}{'post'}--; - $self->{'c'}{'scripts'}{$postscript}{'dopost'} = 1; - if ( $sharedscripts ) { - $do_script = 0; - } else { - $do_script = 1 if $self->{'c'}{'scripts'}{$postscript}{'post'} == 0; - } - if ( $do_script ) { - $self->{'c'}{'scripts'}{$postscript}{'donepost'} = 1; - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$postscript}{'cmd'}} ) . "\n"; - print $p . "Fuehre Postrotate-Script '$postscript' aus:\n$cmd"; - system $cmd unless $self->{'test'}; - } - } - - # Ausfuehren des Lastaction-Scripts, falls es die letzte Rotation ist, fuer die - # dieses Script gilt, oder sharedscripts nicht gesetzt ist - if ( $lastscript ) { - print $p . "Schau nach, ob das Lastaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2; - $do_script = 0; - $self->{'c'}{'scripts'}{$lastscript}{'last'}--; - $self->{'c'}{'scripts'}{$lastscript}{'dolast'} = 1; - $do_script = 1 if $self->{'c'}{'scripts'}{$lastscript}{'last'} == 0; - if ( $do_script ) { - $self->{'c'}{'scripts'}{$lastscript}{'donelast'} = 1; - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$lastscript}{'cmd'}} ) . "\n"; - print $p . "Fuehre Lastaction-Script '$lastscript' aus:\n$cmd"; - system $cmd unless $self->{'test'}; - } + unless ( $self->{'c'}{'logfiles'} and scalar( keys %{ $self->{'c'}{'logfiles'} } ) ) { + warn $p . "Keine Logdateien zum Rotieren gefunden.\n"; + return undef; } - } + my ( $file, $should_rotate, $firstscript, $prescript, $postscript, $lastscript, $sharedscripts ); + my ( $cmd, $do_script, $name ); + + foreach $file ( sort { lc($a) cmp lc($b) } keys %{ $self->{'c'}{'logfiles'} } ) { + + print( "\n" . ( "-" x 20 ) . "\n\n" ) if verbose() > 1; + print $p . "Bearbeite Logdatei '$file' ...\n" if verbose() > 1; + + $should_rotate = $self->test_for_rotate($file); + + unless ( defined $should_rotate ) { + die $p . "Schwerer Fehler, breche hier ab.\n"; + } + + unless ($should_rotate) { + print $p . "Logdatei '$file' wird NICHT rotiert.\n" if verbose(); + next; + } + print $p . "Logdatei '$file' wird rotiert.\n" if verbose(); + + $sharedscripts = $self->{'c'}{'logfiles'}{$file}{'sharedscripts'} || 0; + $firstscript = $self->{'c'}{'logfiles'}{$file}{'firstaction'}; + $prescript = $self->{'c'}{'logfiles'}{$file}{'prerotate'}; + $postscript = $self->{'c'}{'logfiles'}{$file}{'postrotate'}; + $lastscript = $self->{'c'}{'logfiles'}{$file}{'lastaction'}; + + # Ausfuehren des Firtsaction-Scripts, falls es noch nicht ausgefuehrt wurde + if ($firstscript) { + print $p . "Schau nach, ob das Firstaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2; + unless ( $self->{'c'}{'scripts'}{$firstscript}{'first'} ) { + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$firstscript}{'cmd'} } ) . "\n"; + print $p . "Fuehre Firstaction-Script '$firstscript' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } + $self->{'c'}{'scripts'}{$firstscript}{'first'} = 1; + } - # Checke nach uebriggebliebenen Postrotate-Scripts ... - print "\n$p" . "Checke nach uebriggebliebenen Postrotate-Scripts ...\n" if verbose(); - foreach $name ( keys %{$self->{'c'}{'scripts'}} ) { - if ( $self->{'c'}{'scripts'}{$name}{'dopost'} and not $self->{'c'}{'scripts'}{$name}{'donepost'} ) { - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$name}{'cmd'}} ) . "\n"; - print $p . "Fuehre Postrotate-Script '$name' aus:\n$cmd"; - system $cmd unless $self->{'test'}; + # Ausfuehren des Prerotate-Scripts, falls es noch nicht ausgefuehrt wurde + # oder sharedscripts nicht gesetzt ist + if ($prescript) { + print $p . "Schau nach, ob das Prerotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2; + unless ( $self->{'c'}{'scripts'}{$prescript}{'prerun'} and $sharedscripts ) { + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$prescript}{'cmd'} } ) . "\n"; + print $p . "Fuehre Firstaction-Script '$prescript' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } + $self->{'c'}{'scripts'}{$prescript}{'prerun'} = 1; + } + + ##### + # Hier jetzt das eigentliche Rotieren .... + ##### + + unless ( $self->create_olddir($file) ) { + next; + } + + unless ( $self->rotate_file($file) ) { + next; + } + + # Ausfuehren des Postrotate-Scripts, falls es die letzte Rotation ist, fuer die + # dieses Script gilt, oder sharedscripts nicht gesetzt ist + if ($postscript) { + print $p . "Schau nach, ob das Postrotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2; + $do_script = 0; + $self->{'c'}{'scripts'}{$postscript}{'post'}--; + $self->{'c'}{'scripts'}{$postscript}{'dopost'} = 1; + if ($sharedscripts) { + $do_script = 0; + } + else { + $do_script = 1 if $self->{'c'}{'scripts'}{$postscript}{'post'} == 0; + } + if ($do_script) { + $self->{'c'}{'scripts'}{$postscript}{'donepost'} = 1; + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$postscript}{'cmd'} } ) . "\n"; + print $p . "Fuehre Postrotate-Script '$postscript' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } + } ## end if ($postscript) + + # Ausfuehren des Lastaction-Scripts, falls es die letzte Rotation ist, fuer die + # dieses Script gilt, oder sharedscripts nicht gesetzt ist + if ($lastscript) { + print $p . "Schau nach, ob das Lastaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2; + $do_script = 0; + $self->{'c'}{'scripts'}{$lastscript}{'last'}--; + $self->{'c'}{'scripts'}{$lastscript}{'dolast'} = 1; + $do_script = 1 if $self->{'c'}{'scripts'}{$lastscript}{'last'} == 0; + if ($do_script) { + $self->{'c'}{'scripts'}{$lastscript}{'donelast'} = 1; + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$lastscript}{'cmd'} } ) . "\n"; + print $p . "Fuehre Lastaction-Script '$lastscript' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } + } ## end if ($lastscript) + + } ## end foreach $file ( sort { lc($a) cmp lc($b) } keys... + + # Checke nach uebriggebliebenen Postrotate-Scripts ... + print "\n$p" . "Checke nach uebriggebliebenen Postrotate-Scripts ...\n" if verbose(); + foreach $name ( keys %{ $self->{'c'}{'scripts'} } ) { + if ( $self->{'c'}{'scripts'}{$name}{'dopost'} and not $self->{'c'}{'scripts'}{$name}{'donepost'} ) { + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$name}{'cmd'} } ) . "\n"; + print $p . "Fuehre Postrotate-Script '$name' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } } - } - # Checke nach uebriggebliebenen Lastaction-Scripts ... - print "\n$p" . "Checke nach uebriggebliebenen Lastaction-Scripts ...\n" if verbose(); - foreach $name ( keys %{$self->{'c'}{'scripts'}} ) { - if ( $self->{'c'}{'scripts'}{$name}{'dolast'} and not $self->{'c'}{'scripts'}{$name}{'donelast'} ) { - $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$name}{'cmd'}} ) . "\n"; - print $p . "Fuehre Lastaction-Script '$name' aus:\n$cmd"; - system $cmd unless $self->{'test'}; + # Checke nach uebriggebliebenen Lastaction-Scripts ... + print "\n$p" . "Checke nach uebriggebliebenen Lastaction-Scripts ...\n" if verbose(); + foreach $name ( keys %{ $self->{'c'}{'scripts'} } ) { + if ( $self->{'c'}{'scripts'}{$name}{'dolast'} and not $self->{'c'}{'scripts'}{$name}{'donelast'} ) { + $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$name}{'cmd'} } ) . "\n"; + print $p . "Fuehre Lastaction-Script '$name' aus:\n$cmd"; + system $cmd unless $self->{'test'}; + } } - } - return 1; + return 1; -} +} ## end sub rotate($) #------------------------------------------------------------------------------------ @@ -1375,236 +1403,257 @@ ihres letzten Aenderungsdatums (als Wert). sub rotate_file($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::rotate_file(): " : ""; - - my ( $target, $rotates, $pair, $from, $to ); - my ( $omode, $ouid, $ogid, $nmode, $nuid, $ngid, $atime, $mtime ); - my ( @Stats ); + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::rotate_file(): " : ""; - print "\n"; - - my $ce = $self->{'c'}->compressext(); - if ( not defined($ce) or $ce =~ /^\s*$/ ) { - $ce = ".gz"; - } - $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; - print $p . "Kompressionsendung '$ce'.\n" if verbose() > 2; - - unless ( $file ) { - carp( $p . "Keine Logdatei uebergeben!\n" ); - return undef; - } - print $p . "Rotiere Logdatei '$file'.\n" if verbose(); - my $f = $self->{'c'}{'logfiles'}{$file}; - - print $p . Dumper( $f ) if verbose() > 2; - - unless ( $f ) { - carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); - return undef; - } + my ( $target, $rotates, $pair, $from, $to ); + my ( $omode, $ouid, $ogid, $nmode, $nuid, $ngid, $atime, $mtime ); + my (@Stats); - unless ( $target = $self->get_logfile_target($file) ) { - carp( $p . "Kein gueltigen Dateinamen fuer Rotation gefunden!\n" ); - return undef; - } + print "\n"; - unless ( $rotates = $self->find_rotatings($file, $target) ) { - carp( $p . "Keine gueltigen Moves fuer Rotation gefunden!\n" ); - return undef; - } + my $ce = $self->{'c'}->compressext(); + if ( not defined($ce) or $ce =~ /^\s*$/ ) { + $ce = ".gz"; + } + $ce = "." . $ce if $ce ne "" and $ce !~ /^\./; + print $p . "Kompressionsendung '$ce'.\n" if verbose() > 2; - print $p . "Ermittelte Moves: " . Dumper($rotates) if verbose() > 2; - - # Zuerst mal alles Alte zyklisch rotieren ... - - for $pair ( @{$rotates->{'move'}} ) { - $from = $pair->{'from'}; - $to = $pair->{'to'}; - if ( $pair->{'compressed'} ) { - $from .= $ce; - $to .= $ce; - } - print $p . "Umbenennung '$from' => '$to'.\n"; - unless ( $self->{'test'} ) { - unless ( move $from, $to ) { - warn $p . "Konnte '$from' nicht in '$to' umbenennen: $!\n"; + unless ($file) { + carp( $p . "Keine Logdatei uebergeben!\n" ); return undef; - } } - } - - # Jetzt die eigentliche Rotation ... - - $from = $rotates->{'rotate'}{'from'}; - $to = $rotates->{'rotate'}{'to'}; - - $f->{'rotated'} = $to; + print $p . "Rotiere Logdatei '$file'.\n" if verbose(); + my $f = $self->{'c'}{'logfiles'}{$file}; - if ( $f->{'copytruncate'} ) { + print $p . Dumper($f) if verbose() > 2; - # alte Permissions und Besitzer der rotierten Datei ermitteln - @Stats = stat $from; - ( $omode, $ouid, $ogid, $atime, $mtime ) = @Stats[ 2, 4, 5, 8, 9 ]; - - print $p . "Kopiere '$from' nach '$to' ...\n"; - unless ( $self->{'test'} ) { - unless ( copy $from, $to ) { - warn $p . "Konnte '$from' nicht nach '$to' kopieren: $!\n"; + unless ($f) { + carp( $p . "Keine gueltige Logdatei uebergeben!\n" ); return undef; - } } - print $p . "Trunce Datei '$from' ...\n"; - unless ( $self->{'test'} ) { - if ( open FILE, ">$from" ) { - close FILE; - } else { - warn $p . "Konnte Logdatei '$from' nicht truncen: $!\n"; + unless ( $target = $self->get_logfile_target($file) ) { + carp( $p . "Kein gueltigen Dateinamen fuer Rotation gefunden!\n" ); return undef; - } } - # gewuenschte Permissions setzen - print $p . "Setze Permissions von '$to'.\n" if verbose(); - unless ( $self->{'test'} ) { - unless ( chmod $omode, $to ) { - warn $p . "Setzen der Permissions von '$to' war nnicht erfolgreich: $!\n"; - } - } - - # gewuenschte Besitzer stzen - print $p . "Setze Besitzer von '$to'.\n" if verbose(); - unless ( $self->{'test'} ) { - unless ( chown $ouid, $ogid, $to ) { - warn $p . "Setzen des Besitzers von '$to' war nicht erfolgreich: $!\n"; - } + unless ( $rotates = $self->find_rotatings( $file, $target ) ) { + carp( $p . "Keine gueltigen Moves fuer Rotation gefunden!\n" ); + return undef; } - # Access- und Modification-Time setzen ... - print $p . "Setze Access- und Modification-Time von '$to'.\n" if verbose(); - unless ( $self->{'test'} ) { - unless ( utime $atime, $mtime, $to ) { - warn $p . "Setzen der Access- und Modification-Time von '$to' war nicht erfolgreich: $!\n"; - } - } + print $p . "Ermittelte Moves: " . Dumper($rotates) if verbose() > 2; - } else { + # Zuerst mal alles Alte zyklisch rotieren ... - # alte Permissions und Besitzer ermitteln - @Stats = stat $from; + for $pair ( @{ $rotates->{'move'} } ) { + $from = $pair->{'from'}; + $to = $pair->{'to'}; + if ( $pair->{'compressed'} ) { + $from .= $ce; + $to .= $ce; + } + print $p . "Umbenennung '$from' => '$to'.\n"; + unless ( $self->{'test'} ) { + unless ( move $from, $to ) { + warn $p . "Konnte '$from' nicht in '$to' umbenennen: $!\n"; + return undef; + } + } + } ## end for $pair ( @{ $rotates->{'move'} } ) - print $p . "Benenne um bzw. verschiebe '$from' nach '$to' ...\n"; - unless ( $self->{'test'} ) { - unless ( move $from, $to ) { - warn $p . "Konnte '$from' nicht nach '$to' umbenennen/verschieben: $!\n"; - return undef; - } - } + # Jetzt die eigentliche Rotation ... - if ( $f->{'create'} ) { + $from = $rotates->{'rotate'}{'from'}; + $to = $rotates->{'rotate'}{'to'}; - print $p . "Lege '$from' neu an ...\n"; - unless ( $self->{'test'} ) { - if ( open FILE, ">$from" ) { - close FILE; - } else { - warn $p . "Konnte Logdatei '$from' nicht neu anlegen: $!\n"; - return undef; - } - } + $f->{'rotated'} = $to; - # gewuenschte Permissions und Besitzer ermitteln - $nmode = defined $f->{'create'}{'mode'} ? $f->{'create'}{'mode'} : $Stats[2]; - $nuid = defined $f->{'create'}{'owner'} ? $f->{'create'}{'owner'} : $Stats[4]; - $ngid = defined $f->{'create'}{'group'} ? $f->{'create'}{'group'} : $Stats[5]; + if ( $f->{'copytruncate'} ) { - # alte Permissions und Besitzer der neu angelegten Datei ermitteln - @Stats = stat $from; - ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ]; + # alte Permissions und Besitzer der rotierten Datei ermitteln + @Stats = stat $from; + ( $omode, $ouid, $ogid, $atime, $mtime ) = @Stats[ 2, 4, 5, 8, 9 ]; + + print $p . "Kopiere '$from' nach '$to' ...\n"; + unless ( $self->{'test'} ) { + unless ( copy $from, $to ) { + warn $p . "Konnte '$from' nicht nach '$to' kopieren: $!\n"; + return undef; + } + } + + print $p . "Trunce Datei '$from' ...\n"; + unless ( $self->{'test'} ) { + if ( open FILE, ">$from" ) { + close FILE; + } + else { + warn $p . "Konnte Logdatei '$from' nicht truncen: $!\n"; + return undef; + } + } - if ( $nmode != $omode ) { # gewuenschte Permissions setzen - print $p . "Setze Permissions von '$from'.\n" if verbose(); + print $p . "Setze Permissions von '$to'.\n" if verbose(); unless ( $self->{'test'} ) { - unless ( chmod $nmode, $from ) { - warn $p . "Setzen der Permissions von '$from' war nnicht erfolgreich: $!\n"; - } + unless ( chmod $omode, $to ) { + warn $p . "Setzen der Permissions von '$to' war nnicht erfolgreich: $!\n"; + } } - } - if ( $ouid != $nuid or $ogid != $ngid ) { # gewuenschte Besitzer stzen - print $p . "Setze Besitzer von '$from'.\n" if verbose(); + print $p . "Setze Besitzer von '$to'.\n" if verbose(); unless ( $self->{'test'} ) { - unless ( chown $nuid, $ngid, $from ) { - warn $p . "Setzen des Besitzers von '$from' war nicht erfolgreich: $!\n"; - } + unless ( chown $ouid, $ogid, $to ) { + warn $p . "Setzen des Besitzers von '$to' war nicht erfolgreich: $!\n"; + } } - } - } + # Access- und Modification-Time setzen ... + print $p . "Setze Access- und Modification-Time von '$to'.\n" if verbose(); + unless ( $self->{'test'} ) { + unless ( utime $atime, $mtime, $to ) { + warn $p . "Setzen der Access- und Modification-Time von '$to' war nicht erfolgreich: $!\n"; + } + } - } + } ## end if ( $f->{'copytruncate'} ) + else { - my ( $old_logfiles, $files_delete, $files_compress ); + # alte Permissions und Besitzer ermitteln + @Stats = stat $from; - # Ermittlung aller bisherigen Logdateien ... - $old_logfiles = $self->collect_old_logfiles( $file ); - unless ( $old_logfiles ) { - warn $p . "Fehler beim Ermitteln der bisher rotierten Logdateien.\n"; - return undef; - } - print $p . "Insgesamt " . scalar( keys %$old_logfiles ) . " bisher rotierte Logdateie" . (scalar( keys %$old_logfiles ) == 1 ? "" : "n") . ".\n" if verbose(); - print $p . "Liste aller bisher rotierten Logdateien: " . Dumper($old_logfiles) if verbose() > 2; - $f->{'oldfiles'} = $old_logfiles; - - # Ermittlung der alten Logdateien, die zu loeschen sind ... - if ( scalar( keys %$old_logfiles ) ) { - $files_delete = $self->collect_files_delete($file); - unless ( $files_delete ) { - warn $p . "Fehler beim Ermitteln der bisher zu loeschenden alten Logdateien.\n"; - return undef; - } - print $p . "Insgesamt " . scalar( keys %$files_delete ) . " alte Logdateie" . (scalar( keys %$files_delete ) == 1 ? "" : "n") . - " zum Loeschen ermittelt.\n" if verbose() > 1; - for ( keys %$files_delete ) { - $self->{'files_delete'}{$_} = 1; - } - } + print $p . "Benenne um bzw. verschiebe '$from' nach '$to' ...\n"; + unless ( $self->{'test'} ) { + unless ( move $from, $to ) { + warn $p . "Konnte '$from' nicht nach '$to' umbenennen/verschieben: $!\n"; + return undef; + } + } - # Ermittlung der zu komprimierenden Logdateien ... - if ( $f->{'compress'} and scalar( keys %$old_logfiles ) ) { - $files_compress = $self->collect_compress_logfiles($file); - unless ( $files_compress ) { - warn $p . "Fehler beim Ermitteln der zu komprimierenden Logdateien.\n"; - return undef; - } - print $p . "Insgesamt " . scalar( keys %$files_compress ) . " Logdateie" . (scalar( keys %$files_compress ) == 1 ? "" : "n") . " zu komprimieren.\n" if verbose(); - print $p . "Liste aller zu komprimierenden Logdateien: " . Dumper($files_compress) if verbose() > 2; + if ( $f->{'create'} ) { + + print $p . "Lege '$from' neu an ...\n"; + unless ( $self->{'test'} ) { + if ( open FILE, ">$from" ) { + close FILE; + } + else { + warn $p . "Konnte Logdatei '$from' nicht neu anlegen: $!\n"; + return undef; + } + } + + # gewuenschte Permissions und Besitzer ermitteln + $nmode = defined $f->{'create'}{'mode'} ? $f->{'create'}{'mode'} : $Stats[2]; + $nuid = defined $f->{'create'}{'owner'} ? $f->{'create'}{'owner'} : $Stats[4]; + $ngid = defined $f->{'create'}{'group'} ? $f->{'create'}{'group'} : $Stats[5]; + + # alte Permissions und Besitzer der neu angelegten Datei ermitteln + @Stats = stat $from; + ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ]; + + if ( $nmode != $omode ) { + + # gewuenschte Permissions setzen + print $p . "Setze Permissions von '$from'.\n" if verbose(); + unless ( $self->{'test'} ) { + unless ( chmod $nmode, $from ) { + warn $p . "Setzen der Permissions von '$from' war nnicht erfolgreich: $!\n"; + } + } + } ## end if ( $nmode != $omode ) + + if ( $ouid != $nuid or $ogid != $ngid ) { - for ( keys %$files_compress ) { - $self->{'files_compress'}{$_} = 1; + # gewuenschte Besitzer stzen + print $p . "Setze Besitzer von '$from'.\n" if verbose(); + unless ( $self->{'test'} ) { + unless ( chown $nuid, $ngid, $from ) { + warn $p . "Setzen des Besitzers von '$from' war nicht erfolgreich: $!\n"; + } + } + } ## end if ( $ouid != $nuid or $ogid != $ngid ) + + } ## end if ( $f->{'create'} ) + + } ## end else [ if ( $f->{'copytruncate'} ) + + my ( $old_logfiles, $files_delete, $files_compress ); + + # Ermittlung aller bisherigen Logdateien ... + $old_logfiles = $self->collect_old_logfiles($file); + unless ($old_logfiles) { + warn $p . "Fehler beim Ermitteln der bisher rotierten Logdateien.\n"; + return undef; } - } + print $p + . "Insgesamt " + . scalar( keys %$old_logfiles ) + . " bisher rotierte Logdateie" + . ( scalar( keys %$old_logfiles ) == 1 ? "" : "n" ) . ".\n" + if verbose(); + print $p . "Liste aller bisher rotierten Logdateien: " . Dumper($old_logfiles) if verbose() > 2; + $f->{'oldfiles'} = $old_logfiles; + + # Ermittlung der alten Logdateien, die zu loeschen sind ... + if ( scalar( keys %$old_logfiles ) ) { + $files_delete = $self->collect_files_delete($file); + unless ($files_delete) { + warn $p . "Fehler beim Ermitteln der bisher zu loeschenden alten Logdateien.\n"; + return undef; + } + print $p + . "Insgesamt " + . scalar( keys %$files_delete ) + . " alte Logdateie" + . ( scalar( keys %$files_delete ) == 1 ? "" : "n" ) + . " zum Loeschen ermittelt.\n" + if verbose() > 1; + for ( keys %$files_delete ) { + $self->{'files_delete'}{$_} = 1; + } + } ## end if ( scalar( keys %$old_logfiles ) ) - # Und Muell wegraeumen ... - delete $f->{'oldfiles'}; - $old_logfiles = undef; - $files_delete = undef; - $files_compress = undef; + # Ermittlung der zu komprimierenden Logdateien ... + if ( $f->{'compress'} and scalar( keys %$old_logfiles ) ) { + $files_compress = $self->collect_compress_logfiles($file); + unless ($files_compress) { + warn $p . "Fehler beim Ermitteln der zu komprimierenden Logdateien.\n"; + return undef; + } + print $p + . "Insgesamt " + . scalar( keys %$files_compress ) + . " Logdateie" + . ( scalar( keys %$files_compress ) == 1 ? "" : "n" ) + . " zu komprimieren.\n" + if verbose(); + print $p . "Liste aller zu komprimierenden Logdateien: " . Dumper($files_compress) if verbose() > 2; + + for ( keys %$files_compress ) { + $self->{'files_compress'}{$_} = 1; + } + } ## end if ( $f->{'compress'} and scalar( keys %$old_logfiles... - # und schliesslich noch das Rueckschreiben des Rotierens in die Statusdatei ... - unless ( $self->{'state_file'}->write_logfile($file) ) { - die $p . "Fehler beim Schreiben der Statusdatei.\n"; - return undef; - } + # Und Muell wegraeumen ... + delete $f->{'oldfiles'}; + $old_logfiles = undef; + $files_delete = undef; + $files_compress = undef; - return 1; + # und schliesslich noch das Rueckschreiben des Rotierens in die Statusdatei ... + unless ( $self->{'state_file'}->write_logfile($file) ) { + die $p . "Fehler beim Schreiben der Statusdatei.\n"; + return undef; + } -} + return 1; + +} ## end sub rotate_file($$) #------------------------------------------------------------------------------------ @@ -1634,64 +1683,64 @@ Schwerer Fehler, das Programm sollte besser abgebrochen werden. sub test_for_rotate($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::test_for_rotate(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::test_for_rotate(): " : ""; - my ( $text, $f_size, $maxsize, $last_updated, $time_next_rotate ); + my ( $text, $f_size, $maxsize, $last_updated, $time_next_rotate ); - unless ( $file ) { - warn $p . "Keine Datei uebergeben beim Aufruf.\n"; - return undef; - } + unless ($file) { + warn $p . "Keine Datei uebergeben beim Aufruf.\n"; + return undef; + } - print $p . "Ueberpruefe Logdatei '$file', ob sie rotiert werden soll...\n" if verbose() > 2; + print $p . "Ueberpruefe Logdatei '$file', ob sie rotiert werden soll...\n" if verbose() > 2; - unless ( -f $file ) { - $text = $p . "Logdatei '$file' existiert NICHT, keine Rotation.\n"; - unless ( $self->{'c'}{'logfiles'}{$file}{'missingok'} ) { - warn $text; - return 0; + unless ( -f $file ) { + $text = $p . "Logdatei '$file' existiert NICHT, keine Rotation.\n"; + unless ( $self->{'c'}{'logfiles'}{$file}{'missingok'} ) { + warn $text; + return 0; + } + print $text if verbose() > 1; + return 0; } - print $text if verbose() > 1; - return 0; - } - unless ( -s $file ) { - $text = $p . "Logdatei '$file' hat eine Dateigroesse von 0, keine Rotation.\n"; - unless ( $self->{'c'}{'logfiles'}{$file}{'ifempty'} ) { - print $text if verbose() > 1; - return 0; + unless ( -s $file ) { + $text = $p . "Logdatei '$file' hat eine Dateigroesse von 0, keine Rotation.\n"; + unless ( $self->{'c'}{'logfiles'}{$file}{'ifempty'} ) { + print $text if verbose() > 1; + return 0; + } } - } - if ( $self->{'force'} ) { - print $p . "Logdatei '$file' wird rotiert, da FORCE-Mode eingeschaltet wird.\n" if verbose() > 1; - return 1; - } + if ( $self->{'force'} ) { + print $p . "Logdatei '$file' wird rotiert, da FORCE-Mode eingeschaltet wird.\n" if verbose() > 1; + return 1; + } - $f_size = ( -s $file ); - $maxsize = $self->{'c'}{'logfiles'}{$file}{'size'} || 0; - $last_updated = $self->{'states'}{$file} || 0; - $time_next_rotate = $last_updated ? ( $last_updated + ($self->{'c'}{'logfiles'}{$file}{'period'} * 24 * 60 * 60) ) : 0; + $f_size = ( -s $file ); + $maxsize = $self->{'c'}{'logfiles'}{$file}{'size'} || 0; + $last_updated = $self->{'states'}{$file} || 0; + $time_next_rotate = $last_updated ? ( $last_updated + ( $self->{'c'}{'logfiles'}{$file}{'period'} * 24 * 60 * 60 ) ) : 0; - if ( $maxsize ) { - print $p . "Vergleiche Dateigroesse $f_size mit Maximalgroesse $maxsize ...\n" if verbose > 2; - return 0 if $maxsize > $f_size; - } + if ($maxsize) { + print $p . "Vergleiche Dateigroesse $f_size mit Maximalgroesse $maxsize ...\n" if verbose > 2; + return 0 if $maxsize > $f_size; + } - printf( $p . "Vergleiche Timestamp naechste Rotation %s mit aktuellem Timestamp %s ...\n", $time_next_rotate, time() ) if verbose > 2; - if ( verbose() > 3 ) { - printf( " Periode %.2f Tage.\n", $self->{'c'}{'logfiles'}{$file}{'period'} ); - printf( " Letzte Rotation %s\n", $last_updated ? (scalar(localtime($last_updated)) . " GMT") : "" ); - printf( " Naechste Rotation %s\n", $time_next_rotate ? (scalar(localtime($time_next_rotate)) . " GMT") : "" ); - printf( " Aktuelle Zeit %s\n", scalar(localtime()) . " GMT" ); - } - return 0 if $time_next_rotate > time(); + printf( $p . "Vergleiche Timestamp naechste Rotation %s mit aktuellem Timestamp %s ...\n", $time_next_rotate, time() ) if verbose > 2; + if ( verbose() > 3 ) { + printf( " Periode %.2f Tage.\n", $self->{'c'}{'logfiles'}{$file}{'period'} ); + printf( " Letzte Rotation %s\n", $last_updated ? ( scalar( localtime($last_updated) ) . " GMT" ) : "" ); + printf( " Naechste Rotation %s\n", $time_next_rotate ? ( scalar( localtime($time_next_rotate) ) . " GMT" ) : "" ); + printf( " Aktuelle Zeit %s\n", scalar( localtime() ) . " GMT" ); + } + return 0 if $time_next_rotate > time(); - return 1; + return 1; -} +} ## end sub test_for_rotate($$) #------------------------------------------------------------------------------------------ diff --git a/LogRotate/Common.pm b/LogRotate/Common.pm index 3463313..c4d6ea2 100644 --- a/LogRotate/Common.pm +++ b/LogRotate/Common.pm @@ -24,15 +24,15 @@ use Data::Dumper; use Carp qw(:DEFAULT cluck); -our @ISA = qw(Exporter); +our @ISA = qw(Exporter); our @EXPORT = qw( - &human2byte - &parts - &period2days - &verbose - &to_bool - &to_float - &to_int + &human2byte + &parts + &period2days + &verbose + &to_bool + &to_float + &to_int ); sub human2byte($); @@ -51,8 +51,8 @@ ENDE $Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; our $VERSION = $LOGROTATE_VERSION . "." . $Revis; -if( $ENV{"LANG"} and $ENV{"LANG"} =~ /utf-8/i and $] <= 5.008 and $] > 5.006 ) { - print warn "WARNING: your system is set to UTF-8 and your perl version might not support this - this might result in malfunction\n"; +if ( $ENV{"LANG"} and $ENV{"LANG"} =~ /utf-8/i and $] <= 5.008 and $] > 5.006 ) { + print warn "WARNING: your system is set to UTF-8 and your perl version might not support this - this might result in malfunction\n"; } my $verbose = 0; @@ -60,8 +60,8 @@ my $verbose = 0; #---------------------------------------------------------------------------------------- END { - my $p = __PACKAGE__ . "::END(): "; - print $p . " endet.\n" if $verbose; + my $p = __PACKAGE__ . "::END(): "; + print $p . " endet.\n" if $verbose; } ########################################################################################## @@ -84,36 +84,39 @@ Z.Bsp.: sub human2byte($) { - my $val = shift; - my $p = $verbose ? __PACKAGE__ . "::human2byte(): " : ""; - - return undef unless defined $val; - print $p . "aufgerufen mit '" . $val . "'.\n" if $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; + my $val = shift; + my $p = $verbose ? __PACKAGE__ . "::human2byte(): " : ""; + + return undef unless defined $val; + print $p . "aufgerufen mit '" . $val . "'.\n" if $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 $verbose > 5; + $val = int( $val * $factor ); + } ## end if ( $val =~ /^\s*(\d+(?:\.\d*)?)\s*(?:([kmg])(?:b|byte)?)?\s*$/i) + else { + warn $p . "Ungueltige Byte-Angabe: '$val'.\n"; + $val = undef; } - print $p . "Faktor fuer '$unit': " . $factor . "'.\n" if $verbose > 5; - $val = int( $val * $factor ); - } else { - warn $p . "Ungueltige Byte-Angabe: '$val'.\n"; - $val = undef; - } - return $val; + return $val; -} +} ## end sub human2byte($) #------------------------------------------------------------------------------------ @@ -126,21 +129,21 @@ von Quotierung und gibt diese als Array zurueck. sub parts($) { - my $p = verbose() ? __PACKAGE__ . "::parts(): " : ""; + my $p = verbose() ? __PACKAGE__ . "::parts(): " : ""; - my $term = shift; - my @Parts = (); - my $part; + my $term = shift; + my @Parts = (); + my $part; - while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) { - $part = $1 || $2; - $part =~ s/\\"/"/g; - push @Parts, $part; - } + while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) { + $part = $1 || $2; + $part =~ s/\\"/"/g; + push @Parts, $part; + } - return @Parts; + return @Parts; -} +} ## end sub parts($) #------------------------------------------------------------------------------------ @@ -152,82 +155,84 @@ Wandelt eine Perioden-Angabe der Form "5d 8h" in eine Anzahl von Tagen um. sub period2days($) { - my $period = shift; - my $p = verbose() ? __PACKAGE__ . "::period2days(): " : ""; - - $period = "" unless defined $period; - my $orig = $period; - print $p . "Aufgerufen mit '" . $period . "'.\n" if verbose() > 5; - $period =~ s/^\s+//; - $period =~ s/\s+$//; - - if ( $period eq "" ) { - warn $p . "Ungueltige Periodenangabe.\n"; - return undef; - } - - if ( $period =~ /^now$/i ) { - # Rotation immer sofort - return 0; - } - - if ( $period =~ /^never$/i ) { - # Rotation in 400 Jahren (also hoffentlich nie) - return 36525 * 4; - } - - my $days = undef; - my $t = 0; - - if ( $period =~ /(\d+)\s*h(?:ours?)?/i ) { - $t = $1; - print $p . "$t Stunden.\n" if verbose() > 5; - $t /= 24; - $days += $t; - $period =~ s/\d+\s*h(?:ours?)?//i; - } - print $p . "Noch uebrig nach Stunden: '$period'.\n" if verbose() > 5; - - if ( $period =~ /(\d+(?:\.\d*)?)\s*w(?:eeks?)?/i ) { - $t = $1; - print $p . "$t Wochen.\n" if verbose() > 5; - $t *= 7; - $days += $t; - $period =~ s/\d+(?:\.\d*)?\s*w(?:eeks?)?//i; - } - print $p . "Noch uebrig nach Wochen: '$period'.\n" if verbose() > 5; - - if ( $period =~ /(\d+(?:\.\d*)?)\s*m(?:onths?)?/i ) { - $t = $1; - print $p . "$t Monate.\n" if verbose() > 5; - $t *= 30.4; - $days += $t; - $period =~ s/\d+(?:\.\d*)?\s*m(?:onths?)?//i; - } - print $p . "Noch uebrig nach Monaten: '$period'.\n" if verbose() > 5; - - if ( $period =~ /(\d+(?:\.\d*)?)\s*y(?:ears?)?/i ) { - $t = $1; - print $p . "$t Jahre.\n" if verbose() > 5; - $t *= 365; - $days += $t; - $period =~ s/\d+(?:\.\d*)?\s*y(?:ears?)?//i; - } - print $p . "Noch uebrig nach Jahren: '$period'.\n" if verbose() > 5; - - if ( $period =~ /(\d+(?:\.\d*)?)\s*(?:d(?:ays?)?\s*)?$/i ) { - $t = $1; - print $p . "$t Tage.\n" if verbose() > 5; - $days += $t; - $period =~ s/\d+(?:\.\d*)?\s*(?:d(?:ays?)?\s*)?$//i; - } - print $p . "Noch uebrig nach Tagen: '$period'.\n" if verbose() > 5; - - warn $p . "Ungueltige Angabe einer Periode: '" . $orig . "'.\n" unless $period =~ /^\s*$/; - - return $days; + my $period = shift; + my $p = verbose() ? __PACKAGE__ . "::period2days(): " : ""; -} + $period = "" unless defined $period; + my $orig = $period; + print $p . "Aufgerufen mit '" . $period . "'.\n" if verbose() > 5; + $period =~ s/^\s+//; + $period =~ s/\s+$//; + + if ( $period eq "" ) { + warn $p . "Ungueltige Periodenangabe.\n"; + return undef; + } + + if ( $period =~ /^now$/i ) { + + # Rotation immer sofort + return 0; + } + + if ( $period =~ /^never$/i ) { + + # Rotation in 400 Jahren (also hoffentlich nie) + return 36525 * 4; + } + + my $days = undef; + my $t = 0; + + if ( $period =~ /(\d+)\s*h(?:ours?)?/i ) { + $t = $1; + print $p . "$t Stunden.\n" if verbose() > 5; + $t /= 24; + $days += $t; + $period =~ s/\d+\s*h(?:ours?)?//i; + } + print $p . "Noch uebrig nach Stunden: '$period'.\n" if verbose() > 5; + + if ( $period =~ /(\d+(?:\.\d*)?)\s*w(?:eeks?)?/i ) { + $t = $1; + print $p . "$t Wochen.\n" if verbose() > 5; + $t *= 7; + $days += $t; + $period =~ s/\d+(?:\.\d*)?\s*w(?:eeks?)?//i; + } + print $p . "Noch uebrig nach Wochen: '$period'.\n" if verbose() > 5; + + if ( $period =~ /(\d+(?:\.\d*)?)\s*m(?:onths?)?/i ) { + $t = $1; + print $p . "$t Monate.\n" if verbose() > 5; + $t *= 30.4; + $days += $t; + $period =~ s/\d+(?:\.\d*)?\s*m(?:onths?)?//i; + } + print $p . "Noch uebrig nach Monaten: '$period'.\n" if verbose() > 5; + + if ( $period =~ /(\d+(?:\.\d*)?)\s*y(?:ears?)?/i ) { + $t = $1; + print $p . "$t Jahre.\n" if verbose() > 5; + $t *= 365; + $days += $t; + $period =~ s/\d+(?:\.\d*)?\s*y(?:ears?)?//i; + } + print $p . "Noch uebrig nach Jahren: '$period'.\n" if verbose() > 5; + + if ( $period =~ /(\d+(?:\.\d*)?)\s*(?:d(?:ays?)?\s*)?$/i ) { + $t = $1; + print $p . "$t Tage.\n" if verbose() > 5; + $days += $t; + $period =~ s/\d+(?:\.\d*)?\s*(?:d(?:ays?)?\s*)?$//i; + } + print $p . "Noch uebrig nach Tagen: '$period'.\n" if verbose() > 5; + + warn $p . "Ungueltige Angabe einer Periode: '" . $orig . "'.\n" unless $period =~ /^\s*$/; + + return $days; + +} ## end sub period2days($) #------------------------------------------------------------------------------------------ @@ -239,37 +244,39 @@ Wandelt den uebergebenen Scalar sicher in einen Wahrheitswert (0 oder 1) um. sub to_bool($) { - my $val = shift; - my $p = verbose() ? __PACKAGE__ . "::to_bool(): " : ""; + my $val = shift; + my $p = verbose() ? __PACKAGE__ . "::to_bool(): " : ""; - return 0 unless defined $val; - print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5; - return 0 if $val =~ /^\s*$/; + return 0 unless defined $val; + print $p . "aufgerufen mit '" . $val . "'.\n" if 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*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; - } + 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 = to_int $val; - if ( defined $intval ) { - return $intval ? 1 : 0; - } + my $intval = to_int $val; + if ( defined $intval ) { + return $intval ? 1 : 0; + } - return $val ? 1 : 0; + return $val ? 1 : 0; -} +} ## end sub to_bool($) #------------------------------------------------------------------------------------------ @@ -283,28 +290,29 @@ Falls der uebergebene Wert keine gueltige Zahl ist, wird undef zurueckgegeben. sub to_float($) { - my $val = shift; - my $p = verbose() ? __PACKAGE__ . "::to_float(): " : ""; + my $val = shift; + my $p = verbose() ? __PACKAGE__ . "::to_float(): " : ""; - return undef unless defined( $val ) and $val =~ /\d/; - print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5; + return undef unless defined($val) and $val =~ /\d/; + print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5; - my $ts = ","; - my $ds = "."; + my $ts = ","; + my $ds = "."; - if ( ( $val =~ /\d,/ and $val !~ /\d\./ ) or - ( $val =~ /\d\.\d\d\d\./ ) or - ( $val =~ /\d\.\d\d\d,/ ) ) { - $ds = ","; - $ts = "."; - } + if ( ( $val =~ /\d,/ and $val !~ /\d\./ ) + or ( $val =~ /\d\.\d\d\d\./ ) + or ( $val =~ /\d\.\d\d\d,/ ) ) + { + $ds = ","; + $ts = "."; + } - $val =~ s/\Q$ts\E//g; - $val =~ s/\Q$ds\E/\./g; + $val =~ s/\Q$ts\E//g; + $val =~ s/\Q$ds\E/\./g; - return ( $val + 0 ); + return ( $val + 0 ); -} +} ## end sub to_float($) #------------------------------------------------------------------------------------------ @@ -321,26 +329,27 @@ Wenn keine gueltige Zahl uebergeben wird, wird undef zurueckgegeben. sub to_int($;$) { - my $val = shift; - my $signed = shift; - my $p = verbose() ? __PACKAGE__ . "::to_int(): " : ""; + my $val = shift; + my $signed = shift; + my $p = verbose() ? __PACKAGE__ . "::to_int(): " : ""; - return undef unless defined $val; - print $p . "aufgerufen mit '" . $val . "' (" . ($signed ? 'mit' : 'ohne'). " Vorzeichen) .\n" if verbose() > 5; - unless ( $val =~ /\d/ ) { - return undef; - } + return undef unless defined $val; + print $p . "aufgerufen mit '" . $val . "' (" . ( $signed ? 'mit' : 'ohne' ) . " Vorzeichen) .\n" if verbose() > 5; + unless ( $val =~ /\d/ ) { + return undef; + } - if ( $signed ) { - $val =~ s/^[^\d-]*(?:(-)\s*)?(\d+)\D?.*?/$1$2/; - } else { - $val =~ s/^\D*(\d+)\D?.*$/$1/; - } - print $p . "Neuer Wert: '" . ( defined($val) ? $val : "" ) . "'.\n" if verbose() > 5; + if ($signed) { + $val =~ s/^[^\d-]*(?:(-)\s*)?(\d+)\D?.*?/$1$2/; + } + else { + $val =~ s/^\D*(\d+)\D?.*$/$1/; + } + print $p . "Neuer Wert: '" . ( defined($val) ? $val : "" ) . "'.\n" if verbose() > 5; - return $val + 0; + return $val + 0; -} +} ## end sub to_int($;$) #------------------------------------------------------------------------------------------ @@ -374,15 +383,15 @@ Ausfuehrlichstes Geplapper bis zum Gehtnichtmehr. sub verbose(;$) { - my $new_verbose_level = shift; + my $new_verbose_level = shift; - if ( defined $new_verbose_level and $new_verbose_level =~ /^\d+$/ ) { - $verbose = $new_verbose_level; - } + if ( defined $new_verbose_level and $new_verbose_level =~ /^\d+$/ ) { + $verbose = $new_verbose_level; + } - return $verbose; + return $verbose; -} +} ## end sub verbose(;$) #------------------------------------------------------------------------------------------ diff --git a/LogRotate/Conf.pm b/LogRotate/Conf.pm index 8700159..3b7bd0d 100644 --- a/LogRotate/Conf.pm +++ b/LogRotate/Conf.pm @@ -31,6 +31,7 @@ use Carp qw(:DEFAULT cluck); use Cwd qw(cwd getcwd abs_path); use File::Basename; use Data::Dumper; + #use POSIX; use LogRotate::Common; @@ -44,48 +45,44 @@ ENDE $Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis; -$Data::Dumper::Indent = 1; +$Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; my @ValidFields = qw( parent compressext compressoptions ); -for my $attr ( @ValidFields ) { - $ok_field{$attr}++; +for my $attr (@ValidFields) { + $ok_field{$attr}++; } my %ValidPeriods = ( - 'hourly' => (1/24), - '2hourly' => (2/24), - '4hourly' => (4/24), - '6hourly' => (6/24), - '12hourly' => (12/24), - 'daily' => 1, - '2daily' => 2, - 'weekly' => 7, - 'monthly' => 30.4, - '2monthly' => 60.8, - '4monthly' => 121.7, - '6monthly' => 182.5, - 'yearly' => 365, + 'hourly' => ( 1 / 24 ), + '2hourly' => ( 2 / 24 ), + '4hourly' => ( 4 / 24 ), + '6hourly' => ( 6 / 24 ), + '12hourly' => ( 12 / 24 ), + 'daily' => 1, + '2daily' => 2, + 'weekly' => 7, + 'monthly' => 30.4, + '2monthly' => 60.8, + '4monthly' => 121.7, + '6monthly' => 182.5, + 'yearly' => 365, ); -my @StandardCompressPrograms = ( - 'gzip', - 'bzip2', - 'compress', -); +my @StandardCompressPrograms = ( 'gzip', 'bzip2', 'compress', ); my %StandardCompressPrograms = ( - 'gzip' => '.gz', - 'bzip2' => '.bz2', - 'compress' => '.Z', + 'gzip' => '.gz', + 'bzip2' => '.bz2', + 'compress' => '.Z', ); my %ScriptDirectives = ( - 'postrotate' => 1, - 'prerotate' => 1, - 'firstaction' => 1, - 'lastaction' => 1, + 'postrotate' => 1, + 'prerotate' => 1, + 'firstaction' => 1, + 'lastaction' => 1, ); #use constant default_firstline_statusfile => "Logrotate State -- Version 2"; @@ -103,49 +100,49 @@ 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' => {}, - 'included_files' => {}, - 'compress_cmd' => 'Compress::Zlib', - 'pidfile' => '/var/run/logrotate.pid', - 'statusfile' => '/var/lib/logrotate.status', - 'COMPRESSEXT' => ".gz", - 'COMPRESSOPTIONS' => "", - 'scripts' => {}, - @_ - }; - - $res = bless $self, $class; - - my $p = 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 verbose(); - $self->{'compress_cmd'} = undef; + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my ( $res, $cmd ); + + my $self = { + 'configfiles' => {}, + 'included_files' => {}, + 'compress_cmd' => 'Compress::Zlib', + 'pidfile' => '/var/run/logrotate.pid', + 'statusfile' => '/var/lib/logrotate.status', + 'COMPRESSEXT' => ".gz", + 'COMPRESSOPTIONS' => "", + 'scripts' => {}, + @_ + }; + + $res = bless $self, $class; + + my $p = 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 verbose(); + $self->{'compress_cmd'} = undef; + } + $self->{'compress_cmd'} = $cmd; } - $self->{'compress_cmd'} = $cmd; - } - return $res; + return $res; -} +} ## end sub new #------------------------------------------------------------------------------------------ @@ -157,43 +154,43 @@ Autoload-Methode zum Zugriff auf alle moeglichen Elemente. 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->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)}; + my $self = shift; + my $attr = $AUTOLOAD; + my ($val); + + $attr =~ s/.*:://; + $attr = lc($attr); + + croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr}; + + 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) }; -} +} ## end sub AUTOLOAD #------------------------------------------------------------------------------------------ @@ -211,27 +208,29 @@ Vorgabe fuer $type, wenn nicht uebergeben, ist 'file'. sub add_taboo($$;$) { - my $self = shift; - my $pattern = shift || ''; - my $p = verbose() ? __PACKAGE__ . "::add_taboo(): " : ""; - my $type = lc(shift || 'file'); + my $self = shift; + my $pattern = shift || ''; + my $p = verbose() ? __PACKAGE__ . "::add_taboo(): " : ""; + my $type = lc( shift || 'file' ); - $self->{'taboo'} = [] unless $self->{'taboo'}; + $self->{'taboo'} = [] unless $self->{'taboo'}; - my %Pat = ( 'ext' => '%s$', - 'file' => '^%s$', - 'prefix' => '^%s' ); + my %Pat = ( + 'ext' => '%s$', + 'file' => '^%s$', + 'prefix' => '^%s' + ); - unless ( $Pat{$type} ) { - carp $p . "Ungueltiger Parameter fuer \$type uebergeben: '$type'.\n"; - return; - } + 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 verbose() > 3; - push( @{$self->{'taboo'}}, $pattern ); + $pattern = sprintf( $Pat{$type}, $pattern ); + print $p . "Neues Tabu-Pattern: '$pattern'.\n" if verbose() > 3; + push( @{ $self->{'taboo'} }, $pattern ); -} +} ## end sub add_taboo($$;$) #------------------------------------------------------------------------------------------ @@ -251,96 +250,102 @@ Standard-Kompressionsmodulen oder Programmen gesucht werden soll. sub check_compress_program($$;$) { - my $self = shift; - my $cmd = shift || 0; - my $p = 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 verbose() > 1; - return $cmd; - } else { - warn $p . "Ungueltiges Kopressionsprogramm '$cmd'.\n"; - $cmd = undef; - } - } else { - if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/ ) { + my $self = shift; + my $cmd = shift || 0; + my $p = 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 verbose() > 1; + return $cmd; + } + else { + warn $p . "Ungueltiges Kopressionsprogramm '$cmd'.\n"; + $cmd = undef; + } + } ## end if ( $cmd =~ m#^/# ) + else { + if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/ ) { + eval "use Compress::Zlib;"; + if ($@) { + warn "$@\n" if verbose(); + $cmd = undef; + } + else { + print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1; + return 'Compress::Zlib'; + } + } ## end if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/) + elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/ ) { + eval "use Compress::Bzip2;"; + if ($@) { + warn "$@\n" if verbose(); + $cmd = undef; + } + else { + print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1; + return 'Compress::Bzip2'; + } + } ## end elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/) + else { + foreach $dir (@Dirs) { + $prog = $dir . "/" . $cmd; + if ( -f $prog and -x $prog ) { + print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1; + return $prog; + } + } + warn $p . "'$cmd' nicht gefunden im Suchpfad '$ENV{'PATH'}'.\n"; + $cmd = undef; + } ## end else [ if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/) + } ## end else [ if ( $cmd =~ m#^/# ) + } ## end if ($cmd) + + if ($check_if_empty) { + eval "use Compress::Zlib;"; - if ( $@ ) { - warn "$@\n" if verbose(); - $cmd = undef; - } else { - print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1; - return 'Compress::Zlib'; - } - } elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/ ) { - eval "use Compress::Bzip2;"; - if ( $@ ) { - warn "$@\n" if verbose(); - $cmd = undef; - } else { - print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1; - return 'Compress::Bzip2'; + if ($@) { + $cmd = undef; } - } else { - foreach $dir ( @Dirs ) { - $prog = $dir . "/" . $cmd; - if ( -f $prog and -x $prog ) { - print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1; - return $prog; - } + else { + print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1; + $self->{'compressext'} = ".gz"; + return 'Compress::Zlib'; } - 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 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 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 verbose() > 1; - return $prog; + eval "use Compress::Bzip2;"; + if ($@) { + $cmd = undef; + } + else { + print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1; + $self->{'compressext'} = ".bz2"; + return 'Compress::Bzip2'; } - } - } - warn $p . "Kein gueltiges Kompressionsprogramm in '$ENV{'PATH'}' gefunden.\n"; - } + 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 verbose() > 1; + return $prog; + } + } + } ## end foreach $cmd (@StandardCompressPrograms) + warn $p . "Kein gueltiges Kompressionsprogramm in '$ENV{'PATH'}' gefunden.\n"; - return undef; + } ## end if ($check_if_empty) + return undef; - -} +} ## end sub check_compress_program($$;$) #------------------------------------------------------------------------------------------ @@ -361,20 +366,20 @@ Perl-Modul 'Compress::Bzip2' verwendet. sub compress_cmd($;$) { - my $self = shift; + my $self = shift; - if ( @_ ) { - my $cmd = shift; - if ( $cmd ) { - if ( $cmd = $self->check_compress_program( $cmd ) ) { - $self->{'compress_cmd'} = $cmd; - } + if (@_) { + my $cmd = shift; + if ($cmd) { + if ( $cmd = $self->check_compress_program($cmd) ) { + $self->{'compress_cmd'} = $cmd; + } + } } - } - return $self->{'compress_cmd'}; + return $self->{'compress_cmd'}; -} +} ## end sub compress_cmd($;$) #------------------------------------------------------------------------------------------ @@ -386,40 +391,44 @@ Gibt ein alternatives Kompressionsprogramm fuer Logdateien an. sub compresscmd_statement($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = 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 verbose(); - return; - } - - $cmd = $line; - $cmd =~ s/^\S+\s*//; - @Values = $cmd ? parts( $cmd ) : (); - unless ( $Values[0] ) { - warn $p . "Direktive 'compresscmd' ohne dazugehoeriges Kommando gegeben (Datei '$f', Zeile '$f').\n" if 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 verbose(); + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = 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 verbose(); + return; + } + + $cmd = $line; + $cmd =~ s/^\S+\s*//; + @Values = $cmd ? parts($cmd) : (); + unless ( $Values[0] ) { + warn $p . "Direktive 'compresscmd' ohne dazugehoeriges Kommando gegeben (Datei '$f', Zeile '$f').\n" if 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 verbose(); + +} ## end sub compresscmd_statement($$$$$) #------------------------------------------------------------------------------------------ @@ -431,15 +440,15 @@ Setzt bzw. gibt die Default-Compress-Einstellung dieses Moduls zurueck. sub default_compress($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'compress'} = to_bool($nv); - } - return $self->{'default'}{'compress'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'compress'} = to_bool($nv); + } + return $self->{'default'}{'compress'}; -} +} ## end sub default_compress($;$) #------------------------------------------------------------------------------------------ @@ -451,15 +460,15 @@ Setzt bzw. gibt die Default-copytruncate-Einstellung dieses Moduls zurueck. sub default_copytruncate($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'copytruncate'} = $nv; - } - return $self->{'default'}{'copytruncate'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'copytruncate'} = $nv; + } + return $self->{'default'}{'copytruncate'}; -} +} ## end sub default_copytruncate($;$) #------------------------------------------------------------------------------------------ @@ -473,18 +482,18 @@ Setzt bzw. gibt die Default-create_group-Einstellung dieses Moduls zurueck. 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; + 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'}; + return $self->{'default'}{'create'}{'group'}; -} +} ## end sub default_create_group($;$) #------------------------------------------------------------------------------------------ @@ -498,16 +507,16 @@ Setzt bzw. gibt die Default-create_mode-Einstellung dieses Moduls zurueck. 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'}; + 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'}; -} +} ## end sub default_create_mode($;$) #------------------------------------------------------------------------------------------ @@ -521,18 +530,18 @@ Setzt bzw. gibt die Default-create_owner-Einstellung dieses Moduls zurueck. 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; + 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'}; + return $self->{'default'}{'create'}{'owner'}; -} +} ## end sub default_create_owner($;$) #------------------------------------------------------------------------------------------ @@ -544,15 +553,15 @@ Setzt bzw. gibt die Default-dateext-Einstellung dieses Moduls zurueck. sub default_dateext($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'dateext'} = to_bool($nv); - } - return $self->{'default'}{'dateext'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'dateext'} = to_bool($nv); + } + return $self->{'default'}{'dateext'}; -} +} ## end sub default_dateext($;$) #------------------------------------------------------------------------------------------ @@ -564,15 +573,15 @@ Setzt bzw. gibt die Default-datepattern-Einstellung dieses Moduls zurueck. sub default_datepattern($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'datepattern'} = $nv; - } - return $self->{'default'}{'datepattern'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'datepattern'} = $nv; + } + return $self->{'default'}{'datepattern'}; -} +} ## end sub default_datepattern($;$) #------------------------------------------------------------------------------------------ @@ -584,15 +593,15 @@ Setzt bzw. gibt die Default-delaycompress-Einstellung dieses Moduls zurueck. sub default_delaycompress($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'delaycompress'} = to_bool($nv); - } - return $self->{'default'}{'delaycompress'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'delaycompress'} = to_bool($nv); + } + return $self->{'default'}{'delaycompress'}; -} +} ## end sub default_delaycompress($;$) #------------------------------------------------------------------------------------------ @@ -604,15 +613,15 @@ Setzt bzw. gibt die Default-extension-Einstellung dieses Moduls zurueck. sub default_extension($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'extension'} = $nv if defined $nv; - } - return $self->{'default'}{'extension'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'extension'} = $nv if defined $nv; + } + return $self->{'default'}{'extension'}; -} +} ## end sub default_extension($;$) #------------------------------------------------------------------------------------------ @@ -624,15 +633,15 @@ Setzt bzw. gibt die Default-if_empty-Einstellung dieses Moduls zurueck. sub default_if_empty($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'if_empty'} = to_bool($nv); - } - return $self->{'default'}{'if_empty'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'if_empty'} = to_bool($nv); + } + return $self->{'default'}{'if_empty'}; -} +} ## end sub default_if_empty($;$) #------------------------------------------------------------------------------------------ @@ -644,15 +653,15 @@ Setzt bzw. gibt die Default-max_age-Einstellung dieses Moduls zurueck. sub default_max_age($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'max_age'} = to_int($nv); - } - return $self->{'default'}{'max_age'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'max_age'} = to_int($nv); + } + return $self->{'default'}{'max_age'}; -} +} ## end sub default_max_age($;$) #------------------------------------------------------------------------------------------ @@ -664,15 +673,15 @@ Setzt bzw. gibt die Default-missingok-Einstellung dieses Moduls zurueck. sub default_missingok($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'missingok'} = to_bool($nv); - } - return $self->{'default'}{'missingok'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'missingok'} = to_bool($nv); + } + return $self->{'default'}{'missingok'}; -} +} ## end sub default_missingok($;$) #------------------------------------------------------------------------------------------ @@ -684,15 +693,15 @@ Setzt bzw. gibt die Default-olddir_dirname-Einstellung dieses Moduls zurueck. 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'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'olddir'}{'dirname'} = $nv if defined $nv; + } + return $self->{'olddir'}{'dirname'}{'extension'}; -} +} ## end sub default_olddir_dirname($;$) #------------------------------------------------------------------------------------------ @@ -704,15 +713,15 @@ Setzt bzw. gibt die Default-olddir_dateformat-Einstellung dieses Moduls zurueck. sub default_olddir_dateformat($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'olddir'}{'dateformat'} = $nv; - } - return $self->{'default'}{'olddir'}{'dateformat'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'olddir'}{'dateformat'} = $nv; + } + return $self->{'default'}{'olddir'}{'dateformat'}; -} +} ## end sub default_olddir_dateformat($;$) #------------------------------------------------------------------------------------------ @@ -724,20 +733,21 @@ Setzt bzw. gibt die Default-olddir_group-Einstellung dieses Moduls zurueck. 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'}; + 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; + } + } ## end if (@_) + return $self->{'default'}{'olddir'}{'group'}; -} +} ## end sub default_olddir_group($;$) #------------------------------------------------------------------------------------------ @@ -749,16 +759,16 @@ Setzt bzw. gibt die Default-olddir_group-Einstellung dieses Moduls zurueck. 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'}; + 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'}; -} +} ## end sub default_olddir_mode($;$) #------------------------------------------------------------------------------------------ @@ -770,20 +780,21 @@ Setzt bzw. gibt die Default-olddir_owner-Einstellung dieses Moduls zurueck. 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'}; + 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; + } + } ## end if (@_) + return $self->{'default'}{'olddir'}{'owner'}; -} +} ## end sub default_olddir_owner($;$) #------------------------------------------------------------------------------------------ @@ -797,23 +808,24 @@ Setzt bzw. gibt die Default-period-Einstellung dieses Moduls zurueck. sub default_period($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - if ( defined $nv ) { - $nv = lc($nv); - if ( $ValidPeriods{$nv} ) { - $self->{'default'}{'period'} = $ValidPeriods{$nv}; - } else { - $nv = period2days($nv); - $self->{'default'}{'period'} = $nv if defined $nv; - } - } - } - return $self->{'default'}{'period'}; - -} + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + if ( defined $nv ) { + $nv = lc($nv); + if ( $ValidPeriods{$nv} ) { + $self->{'default'}{'period'} = $ValidPeriods{$nv}; + } + else { + $nv = period2days($nv); + $self->{'default'}{'period'} = $nv if defined $nv; + } + } ## end if ( defined $nv ) + } ## end if (@_) + return $self->{'default'}{'period'}; + +} ## end sub default_period($;$) #------------------------------------------------------------------------------------------ @@ -825,15 +837,15 @@ Setzt bzw. gibt die Default-rotate-Einstellung dieses Moduls zurueck. sub default_rotate($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'default'}{'rotate'} = to_int($nv); - } - return $self->{'default'}{'rotate'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'default'}{'rotate'} = to_int($nv); + } + return $self->{'default'}{'rotate'}; -} +} ## end sub default_rotate($;$) #------------------------------------------------------------------------------------------ @@ -845,18 +857,18 @@ Setzt bzw. gibt die Default-size-Einstellung dieses Moduls zurueck. sub default_size($;$) { - my $self = shift; - my ( $nv, $val ); - if ( @_ ) { - $nv = shift; - if ( defined $nv ) { - $val = human2byte($nv); - $self->{'default'}{'size'} = $val if defined $val; + my $self = shift; + my ( $nv, $val ); + if (@_) { + $nv = shift; + if ( defined $nv ) { + $val = human2byte($nv); + $self->{'default'}{'size'} = $val if defined $val; + } } - } - return $self->{'default'}{'size'}; + return $self->{'default'}{'size'}; -} +} ## end sub default_size($;$) #------------------------------------------------------------------------------------------ @@ -869,433 +881,458 @@ oder der Default-Logfile-Definition. sub directive($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = verbose() ? __PACKAGE__ . "::directive(): " : ""; - - print $p . "Untersuche '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; - my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; - my ( $key, $negated, $name, $pattern, $wert ); - my ( @Values ); - my $wo = $in_fd ? 'newfile' : 'default'; - $directive = lc($directive); - - my %GlobalDirectives = ( - 'compresscmd' => 1, - 'statusfile' => 1, - 'pidfile' => 1, - 'compressext' => 1, - 'compressoptions' => 1, - ); - - my %BoolDirectives = ( - 'compress' => 1, - 'copytruncate' => 1, - 'ifempty' => 1, - 'missingok' => 1, - 'sharedscripts' => 1, - ); - - my %DirectivesWithValues = ( - 'compresscmd' => 1, - 'statusfile' => 1, - 'pidfile' => 1, - 'compressext' => 1, - 'rotate' => 1, - 'maxage' => 1, - ); - - my %PathDirectives = ( - 'statusfile' => 1, - 'pidfile' => 1, - ); - - my %UnsupportedDirectives = ( - '(?:no)?mail' => 1, - 'mail(?:first|last)' => 1, - 'uncompresscmd' => 1, - 'error' => 1, - ); - - my %IntegerDirectives = ( - 'delaycompress' => 1, - 'rotate' => 1, - 'start' => 1, - ); - - my %StringDirectives = ( - 'extension' => 1, - ); - - 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, - ); - - - # Jetzt nicht unterstuetzte Direktiven ... - $pattern = join( "|", keys %UnsupportedDirectives ); - if ( $directive =~ /^($pattern)$/i ) { - $key = lc($1); - warn $p . "Direktive '$key' wird nicht unterstuetzt (Datei '$f', Zeile $linenr).\n"; - return 1; - } - - # jetzt die Logischen Werte untersuchen ... - $pattern = join( "|", keys %BoolDirectives ); - if ( $directive =~ /^(not?)?($pattern)$/i ) { - $negated = $1; - $key = lc($2); - print $p . "Untersuche boolsche Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - if ( defined $val and $val ne "" ) { - warn $p . "Wert '$val' hinter logischer Direktive $directive gefunden (Datei '$f', Zeile $linenr)\n"; - } - $val = $negated ? 0 : 1; - if ( $key eq 'compress' and not $self->{'compress_cmd'} and $val ) { - warn $p . "Kompression unmoeglich, kein Kompressions-Kommando gegeben (Datei '$f', Zeile $linenr)\n"; - $val = 0; - } - print $p . "Setze '$key' in '$wo' auf $val.\n" if verbose() > 5; - $self->{$wo}{$key} = $val; - return 1; - } - - # und nun die Integer-Direktiven ... - $pattern = join( "|", keys %IntegerDirectives ); - if ( $directive =~ /^(not?)?($pattern)$/i ) { - $negated = $1; - $key = lc($2); - print $p . "Untersuche Integer-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - if ( $DirectivesWithValues{$key} ) { - print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; - unless ( defined $val and $val !~ /^\s*$/ ) { - warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::directive(): " : ""; + + print $p . "Untersuche '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; + my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; + my ( $key, $negated, $name, $pattern, $wert ); + my (@Values); + my $wo = $in_fd ? 'newfile' : 'default'; + $directive = lc($directive); + + my %GlobalDirectives = ( + 'compresscmd' => 1, + 'statusfile' => 1, + 'pidfile' => 1, + 'compressext' => 1, + 'compressoptions' => 1, + ); + + my %BoolDirectives = ( + 'compress' => 1, + 'copytruncate' => 1, + 'ifempty' => 1, + 'missingok' => 1, + 'sharedscripts' => 1, + ); + + my %DirectivesWithValues = ( + 'compresscmd' => 1, + 'statusfile' => 1, + 'pidfile' => 1, + 'compressext' => 1, + 'rotate' => 1, + 'maxage' => 1, + ); + + my %PathDirectives = ( + 'statusfile' => 1, + 'pidfile' => 1, + ); + + my %UnsupportedDirectives = ( + '(?:no)?mail' => 1, + 'mail(?:first|last)' => 1, + 'uncompresscmd' => 1, + 'error' => 1, + ); + + my %IntegerDirectives = ( + 'delaycompress' => 1, + 'rotate' => 1, + 'start' => 1, + ); + + my %StringDirectives = ( 'extension' => 1, ); + + 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, + ); + + # Jetzt nicht unterstuetzte Direktiven ... + $pattern = join( "|", keys %UnsupportedDirectives ); + if ( $directive =~ /^($pattern)$/i ) { + $key = lc($1); + warn $p . "Direktive '$key' wird nicht unterstuetzt (Datei '$f', Zeile $linenr).\n"; return 1; - } } - if ( $negated ) { - $wert = 0; - } else { - if ( not defined($val) or $val =~ /^\s*$/ ) { - $wert = 1; - } else { - $wert = to_int($val); - } - } - unless ( defined $wert ) { - warn $p . "Ungueltiger Wert '$val' fuer Direktive '$key' (Datei '$f', Zeile $linenr).\n"; - return 1; - } - $self->{$wo}{$key} = $wert + 0; - return 1; - } - - # und hier allgemeine String-Direktiven - $pattern = join( "|", keys %StringDirectives ); - if ( $directive =~ /^($pattern)$/i ) { - $negated = $1; - $key = lc($2); - print $p . "Untersuche String-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - if ( $DirectivesWithValues{$key} ) { - print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; - unless ( defined $val and $val !~ /^\s*$/ ) { - warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + + # jetzt die Logischen Werte untersuchen ... + $pattern = join( "|", keys %BoolDirectives ); + if ( $directive =~ /^(not?)?($pattern)$/i ) { + $negated = $1; + $key = lc($2); + print $p . "Untersuche boolsche Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + if ( defined $val and $val ne "" ) { + warn $p . "Wert '$val' hinter logischer Direktive $directive gefunden (Datei '$f', Zeile $linenr)\n"; + } + $val = $negated ? 0 : 1; + if ( $key eq 'compress' and not $self->{'compress_cmd'} and $val ) { + warn $p . "Kompression unmoeglich, kein Kompressions-Kommando gegeben (Datei '$f', Zeile $linenr)\n"; + $val = 0; + } + print $p . "Setze '$key' in '$wo' auf $val.\n" if verbose() > 5; + $self->{$wo}{$key} = $val; return 1; - } - } - if ( $negated ) { - $val = ""; - } - $wert = defined $val ? $val : ""; - $self->{$wo}{$key} = $wert; - return 1; - } - - # Jetzt die Werte, die nur ausserhalb von Logfile-Definitionen gueltig sind - $pattern = join( "|", keys %GlobalDirectives ); - if ( $directive =~ /^($pattern)$/i ) { - $key = lc($1); - print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - if ( $in_fd ) { - warn $p . "Direktive '$key' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n"; - return 1; - } - if ( $DirectivesWithValues{$key} ) { - print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; - unless ( defined $val and $val ne "" ) { - warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + } ## end if ( $directive =~ /^(not?)?($pattern)$/i ) + + # und nun die Integer-Direktiven ... + $pattern = join( "|", keys %IntegerDirectives ); + if ( $directive =~ /^(not?)?($pattern)$/i ) { + $negated = $1; + $key = lc($2); + print $p . "Untersuche Integer-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + if ( $DirectivesWithValues{$key} ) { + print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; + unless ( defined $val and $val !~ /^\s*$/ ) { + warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + return 1; + } + } + if ($negated) { + $wert = 0; + } + else { + if ( not defined($val) or $val =~ /^\s*$/ ) { + $wert = 1; + } + else { + $wert = to_int($val); + } + } + unless ( defined $wert ) { + warn $p . "Ungueltiger Wert '$val' fuer Direktive '$key' (Datei '$f', Zeile $linenr).\n"; + return 1; + } + $self->{$wo}{$key} = $wert + 0; return 1; - } - } - $val = "" if $key eq "compressoptions" and not defined $val; - if ( $key eq 'compresscmd' ) { - if ( $name = $self->check_compress_program( $val ) ) { - print $p . "Setze 'compress_cmd' auf '$name'.\n" if verbose() > 4; - $self->{'compress_cmd'} = $name; + } ## end if ( $directive =~ /^(not?)?($pattern)$/i ) + + # und hier allgemeine String-Direktiven + $pattern = join( "|", keys %StringDirectives ); + if ( $directive =~ /^($pattern)$/i ) { + $negated = $1; + $key = lc($2); + print $p . "Untersuche String-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + if ( $DirectivesWithValues{$key} ) { + print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; + unless ( defined $val and $val !~ /^\s*$/ ) { + warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + return 1; + } + } + if ($negated) { + $val = ""; + } + $wert = defined $val ? $val : ""; + $self->{$wo}{$key} = $wert; return 1; - } - warn $p . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte " . - "Kommando '" . $self->{'compress_cmd'} . "' (Datei '$f', Zeile '$f').\n"; - } - if ( $PathDirectives{$key} ) { - unless ( $val =~ m#^/# ) { - warn $p . "Direktive '$key' erfordert absolute Pfadangaben ( '$val' in Datei '$f', Zeile $linenr).\n"; + } ## end if ( $directive =~ /^($pattern)$/i ) + + # Jetzt die Werte, die nur ausserhalb von Logfile-Definitionen gueltig sind + $pattern = join( "|", keys %GlobalDirectives ); + if ( $directive =~ /^($pattern)$/i ) { + $key = lc($1); + print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + if ($in_fd) { + warn $p . "Direktive '$key' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n"; + return 1; + } + if ( $DirectivesWithValues{$key} ) { + print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5; + unless ( defined $val and $val ne "" ) { + warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + return 1; + } + } + $val = "" if $key eq "compressoptions" and not defined $val; + if ( $key eq 'compresscmd' ) { + if ( $name = $self->check_compress_program($val) ) { + print $p . "Setze 'compress_cmd' auf '$name'.\n" if verbose() > 4; + $self->{'compress_cmd'} = $name; + return 1; + } + warn $p + . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte " + . "Kommando '" + . $self->{'compress_cmd'} + . "' (Datei '$f', Zeile '$f').\n"; + } ## end if ( $key eq 'compresscmd' ) + if ( $PathDirectives{$key} ) { + unless ( $val =~ m#^/# ) { + warn $p . "Direktive '$key' erfordert absolute Pfadangaben ( '$val' in Datei '$f', Zeile $linenr).\n"; + return 1; + } + } + print $p . "Setze '$key' auf '$val'.\n" if verbose() > 4; + $self->{$key} = $val; return 1; - } - } - print $p . "Setze '$key' auf '$val'.\n" if verbose() > 4; - $self->{$key} = $val; - return 1; - } - - # Rotations-Periode ermitteln - $pattern = join( "|", 'period', keys %ValidPeriods ); - if ( $directive =~ /^($pattern)$/i ) { - - $key = lc($1); - print $p . "Untersuche Rotations-Perioden-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - - if ( $ValidPeriods{$key} ) { - warn $p . "Direktive '$key' darf keine Argumente haben ( '$val' in Datei '$f', Zeile $linenr).\n" - if defined $val and $val !~ /^\s*$/; - $val = $ValidPeriods{$key}; - } else { - if ( defined $val and $val =~ /^\s*-\s*\d+\s*$/ ) { - $val = -1; - } else { - $val = period2days($val); - unless ( defined $val ) { - warn $p . "Ungueltige Perioden-Definition (Datei '$f', Zeile $linenr).\n"; - return 1; + } ## end if ( $directive =~ /^($pattern)$/i ) + + # Rotations-Periode ermitteln + $pattern = join( "|", 'period', keys %ValidPeriods ); + if ( $directive =~ /^($pattern)$/i ) { + + $key = lc($1); + print $p . "Untersuche Rotations-Perioden-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + + if ( $ValidPeriods{$key} ) { + warn $p . "Direktive '$key' darf keine Argumente haben ( '$val' in Datei '$f', Zeile $linenr).\n" + if defined $val and $val !~ /^\s*$/; + $val = $ValidPeriods{$key}; } - } - } + else { + if ( defined $val and $val =~ /^\s*-\s*\d+\s*$/ ) { + $val = -1; + } + else { + $val = period2days($val); + unless ( defined $val ) { + warn $p . "Ungueltige Perioden-Definition (Datei '$f', Zeile $linenr).\n"; + return 1; + } + } + } ## end else [ if ( $ValidPeriods{$key} ) + + print $p . "Setze Periode in '$wo' auf '$val'.\n" if verbose() > 5; + $self->{$wo}{'period'} = $val; + return 1; + } ## end if ( $directive =~ /^($pattern)$/i ) - print $p . "Setze Periode in '$wo' auf '$val'.\n" if verbose() > 5; - $self->{$wo}{'period'} = $val; - return 1; - } + # Maximalalter fuer alte Logdateien ermitteln + if ( $directive =~ /^(not?)?maxage$/ ) { - # Maximalalter fuer alte Logdateien ermitteln - if ( $directive =~ /^(not?)?maxage$/ ) { + $negated = $1; + print $p . "Untersuche Direktive 'maxage' (" . __LINE__ . ") ...\n" if verbose() > 5; - $negated = $1; - print $p . "Untersuche Direktive 'maxage' (" . __LINE__ . ") ...\n" if verbose() > 5; + $negated = 1 if not defined($val) or $val =~ /^\s*$/; + if ($negated) { + $val = 0; + } + else { + $val = period2days($val); + unless ( defined $val ) { + warn $p . "Ungueltige Maxage-Definition (Datei '$f', Zeile $linenr).\n"; + return 1; + } + } - $negated = 1 if not defined($val) or $val =~ /^\s*$/; - if ( $negated ) { - $val = 0; - } else { - $val = period2days($val); - unless ( defined $val ) { - warn $p . "Ungueltige Maxage-Definition (Datei '$f', Zeile $linenr).\n"; + print $p . "Setze Maxage in '$wo' auf '$val'.\n" if verbose() > 5; + $self->{$wo}{'maxage'} = $val; return 1; - } - } + } ## end if ( $directive =~ /^(not?)?maxage$/ ) - print $p . "Setze Maxage in '$wo' auf '$val'.\n" if verbose() > 5; - $self->{$wo}{'maxage'} = $val; - return 1; - } - - # Datumserweiterung der rotierten Logdateien festlegen ... - if ( $directive =~ /^(no)?dateext$/ ) { - - $negated = $1; - print $p . "Untersuche Direktive 'dateext' (" . __LINE__ . ") ...\n" if verbose() > 5; - @Values = $val ? parts( $val ) : (); - - if ( $negated ) { - $val = 0; - $name = undef; - } else { - $val = lc( defined $Values[0] ? $Values[0] : '' ); - $val = 1 if $val =~ /^\s*$/; - if ( $YesValues{$val} ) { - $val = 1; - $name = undef; - } elsif ( $NoValues{$val} ) { - $val = 0; - $name = undef; - } else { - $name = $val; - $val = 1; - } - } + # Datumserweiterung der rotierten Logdateien festlegen ... + if ( $directive =~ /^(no)?dateext$/ ) { - print $p . "Setze dateext in '$wo' auf $val.\n" if verbose() > 5; - $self->{$wo}{'dateext'} = $val; + $negated = $1; + print $p . "Untersuche Direktive 'dateext' (" . __LINE__ . ") ...\n" if verbose() > 5; + @Values = $val ? parts($val) : (); - if ( defined $name ) { - print $p . "Setze datepattern in '$wo' auf '$name'.\n" if verbose() > 5; - $self->{$wo}{'datepattern'} = $name; - } - return 1; + if ($negated) { + $val = 0; + $name = undef; + } + else { + $val = lc( defined $Values[0] ? $Values[0] : '' ); + $val = 1 if $val =~ /^\s*$/; + if ( $YesValues{$val} ) { + $val = 1; + $name = undef; + } + elsif ( $NoValues{$val} ) { + $val = 0; + $name = undef; + } + else { + $name = $val; + $val = 1; + } + } ## end else [ if ($negated) + + print $p . "Setze dateext in '$wo' auf $val.\n" if verbose() > 5; + $self->{$wo}{'dateext'} = $val; + + if ( defined $name ) { + print $p . "Setze datepattern in '$wo' auf '$name'.\n" if verbose() > 5; + $self->{$wo}{'datepattern'} = $name; + } + return 1; - } + } ## end if ( $directive =~ /^(no)?dateext$/ ) - # Erstellungs-Modi festlegen - if ( $directive eq 'create' ) { + # Erstellungs-Modi festlegen + if ( $directive =~ /^(not?)?create$/i ) { - print $p . "Untersuche Direktive 'create' (" . __LINE__ . ") ...\n" if verbose() > 5; - @Values = $val ? parts( $val ) : (); - $self->{$wo}{'copytruncate'} = 0; - print $p . "Ermittelte Werte fuer 'create': " . Dumper(\@Values) if verbose() > 5; + $negated = $1; - # Mode (Permission) definition - if ( defined $Values[0] ) { - if ( $Values[0] =~ /^\d+$/ ) { - $self->{$wo}{'create'}{'mode'} = oct( $Values[0] ); - } else { - warn $p . "Directive 'create' mit ungueltigem Modus '" . $Values[0] . "' (Datei '$f', Zeile '$f').\n"; - } - } + print $p . "Untersuche Direktive 'create' (" . __LINE__ . ") ...\n" if verbose() > 5; - # User (owner, uid) definition - if ( defined $Values[1] and $Values[1] ne "" ) { - if ( $Values[1] =~ /^[1-9]\d*$/ ) { - $self->{$wo}{'create'}{'owner'} = $Values[1]; - } else { - $self->{$wo}{'create'}{'owner'} = scalar getpwnam( $Values[1] ); - } - } + if ($negated) { + print $p . "Direktive 'create' wird in '$wo' enfernt.\n" if verbose() > 5; + delete $self->{$wo}{'create'} = if exists $self->{$wo}{'create'}; + return 1; + } - # Group (gid) definition - if ( defined $Values[2] and $Values[2] ne "" ) { - if ( $Values[2] =~ /^[1-9]\d*$/ ) { - $self->{$wo}{'create'}{'group'} = $Values[2]; - } else { - $self->{$wo}{'create'}{'group'} = scalar getgrnam( $Values[2] ); - } - } + @Values = $val ? parts($val) : (); + $self->{$wo}{'copytruncate'} = 0; + print $p . "Ermittelte Werte fuer 'create': " . Dumper( \@Values ) if verbose() > 5; + + # Mode (Permission) definition + if ( defined $Values[0] ) { + if ( $Values[0] =~ /^\d+$/ ) { + $self->{$wo}{'create'}{'mode'} = oct( $Values[0] ); + } + else { + warn $p . "Directive 'create' mit ungueltigem Modus '" . $Values[0] . "' (Datei '$f', Zeile '$f').\n"; + } + } - return 1; + # User (owner, uid) definition + if ( defined $Values[1] and $Values[1] ne "" ) { + if ( $Values[1] =~ /^[1-9]\d*$/ ) { + $self->{$wo}{'create'}{'owner'} = $Values[1]; + } + else { + $self->{$wo}{'create'}{'owner'} = scalar getpwnam( $Values[1] ); + } + } - } + # Group (gid) definition + if ( defined $Values[2] and $Values[2] ne "" ) { + if ( $Values[2] =~ /^[1-9]\d*$/ ) { + $self->{$wo}{'create'}{'group'} = $Values[2]; + } + else { + $self->{$wo}{'create'}{'group'} = scalar getgrnam( $Values[2] ); + } + } - # Olddir-Verhalten festlegen ... - if ( $directive =~ /^(not?)?olddir$/i ) { + return 1; - $negated = $1; - $directive = 'olddir'; + } ## end if ( $directive =~ /^(not?)?create$/i ) - print $p . "Untersuche Direktive 'olddir' (" . __LINE__ . ") ...\n" if verbose() > 5; + # Olddir-Verhalten festlegen ... + if ( $directive =~ /^(not?)?olddir$/i ) { - if ( $negated ) { - print $p . "Direktive 'olddir' wird in '$wo' enfernt.\n" if verbose() > 5; - $self->{$wo}{'olddir'} = undef; - return 1; - } + $negated = $1; + $directive = 'olddir'; - @Values = $val ? parts( $val ) : (); + print $p . "Untersuche Direktive 'olddir' (" . __LINE__ . ") ...\n" if verbose() > 5; - if ( $Values[0] ) { - $self->{$wo}{'olddir'} = {} unless $self->{$wo}{'olddir'}; - $self->{$wo}{'olddir'}{'dirname'} = $Values[0]; - } else { - warn $p . "Direktive '$directive' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; - return 1; - } + if ($negated) { + print $p . "Direktive 'olddir' wird in '$wo' enfernt.\n" if verbose() > 5; + delete $self->{$wo}{'olddir'} = if exists $self->{$wo}{'olddir'}; + return 1; + } - $self->{$wo}{'olddir'}{'mode'} = undef; - $self->{$wo}{'olddir'}{'owner'} = undef; - $self->{$wo}{'olddir'}{'group'} = undef; - - # Mode (Permission) definition - if ( defined $Values[1] ) { - if ( $Values[0] =~ /^\d+$/ ) { - $self->{$wo}{'olddir'}{'mode'} = oct( $Values[1] ); - } else { - warn $p . "Directive 'olddir' mit ungueltigem Modus '" . $Values[1] . "' (Datei '$f', Zeile '$f').\n"; - } - } + @Values = $val ? parts($val) : (); - # User (owner, uid) definition - if ( defined $Values[2] and $Values[2] ne "" ) { - if ( $Values[1] =~ /^[1-9]\d*$/ ) { - $self->{$wo}{'olddir'}{'owner'} = $Values[2]; - } else { - $self->{$wo}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] ); - } - } + if ( $Values[0] ) { + $self->{$wo}{'olddir'} = {} unless $self->{$wo}{'olddir'}; + $self->{$wo}{'olddir'}{'dirname'} = $Values[0]; + } + else { + warn $p . "Direktive '$directive' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n"; + return 1; + } - # Group (gid) definition - if ( defined $Values[3] and $Values[3] ne "" ) { - if ( $Values[2] =~ /^[1-9]\d*$/ ) { - $self->{$wo}{'olddir'}{'group'} = $Values[3]; - } else { - $self->{$wo}{'olddir'}{'group'} = scalar getgrnam( $Values[3] ); - } - } + $self->{$wo}{'olddir'}{'mode'} = undef; + $self->{$wo}{'olddir'}{'owner'} = undef; + $self->{$wo}{'olddir'}{'group'} = undef; + + # Mode (Permission) definition + if ( defined $Values[1] ) { + if ( $Values[0] =~ /^\d+$/ ) { + $self->{$wo}{'olddir'}{'mode'} = oct( $Values[1] ); + } + else { + warn $p . "Directive 'olddir' mit ungueltigem Modus '" . $Values[1] . "' (Datei '$f', Zeile '$f').\n"; + } + } - return 1; + # User (owner, uid) definition + if ( defined $Values[2] and $Values[2] ne "" ) { + if ( $Values[1] =~ /^[1-9]\d*$/ ) { + $self->{$wo}{'olddir'}{'owner'} = $Values[2]; + } + else { + $self->{$wo}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] ); + } + } - } + # Group (gid) definition + if ( defined $Values[3] and $Values[3] ne "" ) { + if ( $Values[2] =~ /^[1-9]\d*$/ ) { + $self->{$wo}{'olddir'}{'group'} = $Values[3]; + } + else { + $self->{$wo}{'olddir'}{'group'} = scalar getgrnam( $Values[3] ); + } + } - # Rotations-Mindestgroesse ermitteln - if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i ) { - $directive = 'size'; - $val = $1; - print $p . "Untersuche Direktive 'size' (" . __LINE__ . ") mit Groesse '" . (defined $val ? $val : "") . "' ...\n" if verbose() > 5; - unless ( defined $val ) { - warn $p . "Ungueltige Groessen-Definition (Datei '$f', Zeile $linenr).\n"; - return 1; - } - $wert = human2byte($val); - unless ( defined $wert ) { - warn $p . "Ungueltige Groessen-Definition ('$val' in Datei '$f', Zeile $linenr).\n"; - return 1; - } - print $p . "Setze Groesse in '$wo' auf '$wert'.\n" if verbose() > 5; - $self->{$wo}{'size'} = $wert; - return 1; - } + return 1; - # Tabu-Pattern aendern bzw. hinzufuegen - if ( $directive =~ /^taboo(ext|file|prefix)$/ ) { + } ## end if ( $directive =~ /^(not?)?olddir$/i ) - $key = lc($1); - print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; + # Rotations-Mindestgroesse ermitteln + if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i ) { + $directive = 'size'; + $val = $1; + print $p . "Untersuche Direktive 'size' (" . __LINE__ . ") mit Groesse '" . ( defined $val ? $val : "" ) . "' ...\n" + if verbose() > 5; + unless ( defined $val ) { + warn $p . "Ungueltige Groessen-Definition (Datei '$f', Zeile $linenr).\n"; + return 1; + } + $wert = human2byte($val); + unless ( defined $wert ) { + warn $p . "Ungueltige Groessen-Definition ('$val' in Datei '$f', Zeile $linenr).\n"; + return 1; + } + print $p . "Setze Groesse in '$wo' auf '$wert'.\n" if verbose() > 5; + $self->{$wo}{'size'} = $wert; + return 1; + } ## end if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i) - if ( $in_fd ) { - warn $p . "Direktive '$directive' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n"; - return 1; - } + # Tabu-Pattern aendern bzw. hinzufuegen + if ( $directive =~ /^taboo(ext|file|prefix)$/ ) { - @Values = $val ? parts( $val ) : (); - my $extend = 0; - if ( $Values[0] and $Values[0] eq "+" ) { - $extend = 1; - shift @Values; - } + $key = lc($1); + print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5; - $self->{'taboo'} = [] unless $extend; - for $name ( @Values ) { - $self->add_taboo( $name, $key ); - } + if ($in_fd) { + warn $p . "Direktive '$directive' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n"; + return 1; + } - return 1; - } + @Values = $val ? parts($val) : (); + my $extend = 0; + if ( $Values[0] and $Values[0] eq "+" ) { + $extend = 1; + shift @Values; + } - warn $p . "Unbekannte Direktive '$directive' (Datei '$f', Zeile $linenr).\n"; - return 1; + $self->{'taboo'} = [] unless $extend; + for $name (@Values) { + $self->add_taboo( $name, $key ); + } -} + return 1; + } ## end if ( $directive =~ /^taboo(ext|file|prefix)$/) + + warn $p . "Unbekannte Direktive '$directive' (Datei '$f', Zeile $linenr).\n"; + return 1; + +} ## end sub directive($$$$$) #------------------------------------------------------------------------------------------ @@ -1310,102 +1347,103 @@ komplettes Verzeichnis (unter Beachtung der Tabu-Muster) mit eingelesen. sub do_include($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = verbose() ? __PACKAGE__ . "::do_include(): " : ""; + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::do_include(): " : ""; - my ( $if, $dir, $basename, $name, $bname, $found, $pattern ); + 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; - } + 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*//; + # Das Wort 'include selbst wegschmeissen + $line =~ s/^\S+\s*//; - my @Values = parts($line); + my @Values = 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; + # 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 = $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 verbose() > 1; - $self->{'included_files'}{$if} = 1; - return $self->read( $f ); - } - - if ( -d $if ) { - - print $p . "Include Verzeichnis '$if' ...\n" if 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 verbose() > 1; - if ( -d "$if/$bname" ) { - # Keine Verzeichnis-Rekursion !!! - print $p . "Verzeichnis '$if/$bname' wird uebergangen.\n" if 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 verbose() > 1; - last; + $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; } - } - next if $found; + $if = $dir . "/" . $if; + } ## end if ( $if !~ m#^/# ) - 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 verbose() > 1; - $self->{'included_files'}{$name} = 1; + 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 verbose() > 1; + $self->{'included_files'}{$if} = 1; + return $self->read($f); + } - return undef unless $self->read( $name ); + if ( -d $if ) { - } + print $p . "Include Verzeichnis '$if' ...\n" if verbose() > 1; - return 1; + foreach $name ( glob("$if/.* $if/*") ) { - } + $bname = basename($name); + next if $bname eq "." or $bname eq ".."; - warn $p . "Ungueltige Include-Direktive '$line' in Datei '$f', Zeile $linenr gefunden.\n"; - return undef; + print $p . "Checke Include-Datei '$if/$bname' ...\n" if verbose() > 1; + if ( -d "$if/$bname" ) { -} + # Keine Verzeichnis-Rekursion !!! + print $p . "Verzeichnis '$if/$bname' wird uebergangen.\n" if 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 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 verbose() > 1; + $self->{'included_files'}{$name} = 1; + + return undef unless $self->read($name); + + } ## end foreach $name ( glob("$if/.* $if/*") ) + + return 1; + + } ## end if ( -d $if ) + + warn $p . "Ungueltige Include-Direktive '$line' in Datei '$f', Zeile $linenr gefunden.\n"; + return undef; + +} ## end sub do_include($$$$$) #------------------------------------------------------------------------------------------ @@ -1417,43 +1455,44 @@ Wertet den Beginn einer Script-Definition innerhalb einer Logfile-Definition aus sub do_logfilescript($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = verbose() ? __PACKAGE__ . "::do_logfilescript(): " : ""; + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::do_logfilescript(): " : ""; - print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; - my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; - $directive = lc($directive); + print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; + my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; + $directive = lc($directive); - unless ( $in_fd ) { - warn $p . "Direktive '$directive' ist nicht erlaubt ausserhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n"; - return undef; - } + unless ($in_fd) { + warn $p . "Direktive '$directive' ist nicht erlaubt ausserhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n"; + return undef; + } - my @Values = $val ? parts( $val ) : (); + my @Values = $val ? parts($val) : (); - my $name; - if ( $Values[0] ) { - $self->{'newfile'}{$directive} = lc($Values[0]); - return undef; - } else { - $name = $self->new_script_name($directive); - $self->{'scripts'}{$name}{'cmd'} = []; - $self->{'scripts'}{$name}{'post'} = 0; - $self->{'scripts'}{$name}{'last'} = 0; - $self->{'scripts'}{$name}{'first'} = 0; - $self->{'scripts'}{$name}{'prerun'} = 0; - $self->{'scripts'}{$name}{'donepost'} = 0; - $self->{'scripts'}{$name}{'donelast'} = 0; - $self->{'newfile'}{$directive} = $name; - return $name; - } + my $name; + if ( $Values[0] ) { + $self->{'newfile'}{$directive} = lc( $Values[0] ); + return undef; + } + else { + $name = $self->new_script_name($directive); + $self->{'scripts'}{$name}{'cmd'} = []; + $self->{'scripts'}{$name}{'post'} = 0; + $self->{'scripts'}{$name}{'last'} = 0; + $self->{'scripts'}{$name}{'first'} = 0; + $self->{'scripts'}{$name}{'prerun'} = 0; + $self->{'scripts'}{$name}{'donepost'} = 0; + $self->{'scripts'}{$name}{'donelast'} = 0; + $self->{'newfile'}{$directive} = $name; + return $name; + } ## end else [ if ( $Values[0] ) - return undef; -} + return undef; +} ## end sub do_logfilescript($$$$$) #------------------------------------------------------------------------------------------ @@ -1465,44 +1504,44 @@ Wertet den Beginn einer allgemeinen Script-Definition. sub do_script($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = verbose() ? __PACKAGE__ . "::do_script(): " : ""; + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::do_script(): " : ""; - print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; - my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; - $directive = lc($directive); + print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5; + my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/; + $directive = lc($directive); - if ( $in_fd ) { - warn $p . "Direktive '$directive' ist nicht erlaubt innerhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n"; - return undef; - } + if ($in_fd) { + warn $p . "Direktive '$directive' ist nicht erlaubt innerhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n"; + return undef; + } - my @Values = $val ? parts( $val ) : (); + my @Values = $val ? parts($val) : (); - unless ( $Values[0] ) { - warn $p . "Direktive '$directive' ohne gueltigen Scriptnamen (Datei '$f', Zeile $linenr).\n"; - return undef; - } - - my $name = lc($Values[0]); - if ( $self->{'scripts'}{$name} ) { - warn $p . "Das Script '$name' ist bereits deklariert, wird ueberschrieben (Datei '$f', Zeile $linenr).\n"; - } - - $self->{'scripts'}{$name}{'cmd'} = []; - $self->{'scripts'}{$name}{'post'} = 0; - $self->{'scripts'}{$name}{'prerun'} = 0; - $self->{'scripts'}{$name}{'first'} = 0; - $self->{'scripts'}{$name}{'last'} = 0; - $self->{'scripts'}{$name}{'donepost'} = 0; - $self->{'scripts'}{$name}{'donelast'} = 0; - return $name; + unless ( $Values[0] ) { + warn $p . "Direktive '$directive' ohne gueltigen Scriptnamen (Datei '$f', Zeile $linenr).\n"; + return undef; + } -} + my $name = lc( $Values[0] ); + if ( $self->{'scripts'}{$name} ) { + warn $p . "Das Script '$name' ist bereits deklariert, wird ueberschrieben (Datei '$f', Zeile $linenr).\n"; + } + + $self->{'scripts'}{$name}{'cmd'} = []; + $self->{'scripts'}{$name}{'post'} = 0; + $self->{'scripts'}{$name}{'prerun'} = 0; + $self->{'scripts'}{$name}{'first'} = 0; + $self->{'scripts'}{$name}{'last'} = 0; + $self->{'scripts'}{$name}{'donepost'} = 0; + $self->{'scripts'}{$name}{'donelast'} = 0; + return $name; + +} ## end sub do_script($$$$$) #------------------------------------------------------------------------------------------ @@ -1514,78 +1553,84 @@ Verarbeitet den Beginn einer Logfile-Definition (Geschweifte Klammer auf). sub log_begin($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = 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 = 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; - } + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::log_begin(): " : ""; - print "\nStart Logfile-Definition:\n - " . join( "\n - ", @Values ) . "\n" if verbose() > 2; + my ( @Values, @Files, @FileGlob ); + my ( $name, $file ); - @Files = (); - foreach $name ( @Values ) { + if ($in_fd) { + warn $p . "Verschachtelte Logfile-Definition in Konfigdatei '$f', Zeile $linenr.\n"; + return 1; + } - if ( $name =~ m#^/# ) { + $line =~ s/\s*{$//; + @Values = parts($line); - # Datei-Globbing aufloesen - if ( $name =~ /[\*\?\[]/ ) { - @FileGlob = glob( $name ); - $FileGlob[0] = $name unless scalar @FileGlob; - } else { - @FileGlob = (); - $FileGlob[0] = $name; - } + unless (@Values) { + warn $p + . "Kein Dateiname fuer eine Logdatei am Beginn der Logdatei-Definition in Konfigdatei '" + . $f + . "', Zeile $linenr gefunden.\n"; + return undef; + } - 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"; + print "\nStart Logfile-Definition:\n - " . join( "\n - ", @Values ) . "\n" if 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; + } + + } ## end if ( $name =~ m#^/# ) + else { + warn $p . "Die Logdatei '$file' hat keine absolute Pfaddefinition (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'}}; - if ( $self->{'default'}{'olddir'} ) { - $self->{'newfile'}{'olddir'} = {}; - %{$self->{'newfile'}{'olddir'}} = %{$self->{'default'}{'olddir'}}; - } else { - $self->{'newfile'}{'olddir'} = undef; - } - } + } ## end foreach $name (@Values) + + if ( scalar @Files ) { + $self->{'newfile'} = {}; + %{ $self->{'newfile'} } = %{ $self->{'default'} }; + $self->{'newfile'}{'files'} = [@Files]; + $self->{'newfile'}{'create'} = {}; + %{ $self->{'newfile'}{'create'} } = %{ $self->{'default'}{'create'} }; + if ( $self->{'default'}{'olddir'} ) { + $self->{'newfile'}{'olddir'} = {}; + %{ $self->{'newfile'}{'olddir'} } = %{ $self->{'default'}{'olddir'} }; + } + else { + $self->{'newfile'}{'olddir'} = undef; + } + } ## end if ( scalar @Files ) - return 1; + return 1; -} +} ## end sub log_begin($$$$$) #------------------------------------------------------------------------------------------ @@ -1597,42 +1642,42 @@ Schliesst eine Logfile-Definition ab. sub log_end($$$$$) { - my $self = shift; - my $line = shift || ""; - my $f = shift || "'unknown'"; - my $in_fd = shift || 0; - my $linenr = shift || "'unknown'"; - my $p = verbose() ? __PACKAGE__ . "::log_end(): " : ""; + my $self = shift; + my $line = shift || ""; + my $f = shift || "'unknown'"; + my $in_fd = shift || 0; + my $linenr = shift || "'unknown'"; + my $p = verbose() ? __PACKAGE__ . "::log_end(): " : ""; - my ( $name ); + 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 verbose() > 2; - print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if 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; + unless ($in_fd) { + warn $p . "Alleinstehende schliessende geschweifte Klammer in Konfigdatei '$f', Zeile $linenr gefunden.\n"; + return undef; } - delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'}; - $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++ if $self->{'newfile'}{'postrotate'}; - $self->{'scripts'}{ $self->{'newfile'}{'lastaction'} }{'last'}++ if $self->{'newfile'}{'lastaction'}; - } - return 1; + print "Ende Logfile-Definition\n" if verbose() > 2; + print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if 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'}; + $self->{'scripts'}{ $self->{'newfile'}{'lastaction'} }{'last'}++ if $self->{'newfile'}{'lastaction'}; + } ## end foreach $name ( @{ $self->{'newfile'}{'files'} ... -} + return 1; + +} ## end sub log_end($$$$$) #------------------------------------------------------------------------------------------ @@ -1644,28 +1689,30 @@ Ermittelt einen neuen einmaligen Scriptnamen. sub new_script_name($;$) { - my $self = shift; - my $pre = shift || "script"; - my $p = 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; - } - } + my $self = shift; + my $pre = shift || "script"; + my $p = 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; + } + } ## end while (1) - return $name; -} + return $name; +} ## end sub new_script_name($;$) #------------------------------------------------------------------------------------------ @@ -1677,136 +1724,138 @@ Liest die uebergebene Datei in die Konfiguration ein. sub read($$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::read(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::read(): " : ""; - my ( $dir, $f, $real_dir, $linenr, $in_fd, $in_script, $newscript, $lastrow, $pattern ); - my ( @Lines ); + my ( $dir, $f, $real_dir, $linenr, $in_fd, $in_script, $newscript, $lastrow, $pattern ); + my (@Lines); - print $p . "Aufgerufen mit '" . $file . "'.\n" if verbose() > 2; + print $p . "Aufgerufen mit '" . $file . "'.\n" if verbose() > 2; - unless ( $file ) { - carp $p . "Keine Datei uebergeben.\n"; - return undef; - } + 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 verbose() > 2; - $f = $real_dir . "/" . $f; - - if ( $self->{'configfiles'}{$f} ) { - warn $p . "recursive call for file '$f', exiting.\n"; - return undef; - } + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n"; + return undef; + } - $self->{'configfiles'}{$f} = 1; + 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 verbose() > 2; + $f = $real_dir . "/" . $f; - print $p . "Lese Datei '$f' ...\n"; - unless ( open FILE, "<$f" ) { - warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n"; - return undef; - } + if ( $self->{'configfiles'}{$f} ) { + warn $p . "recursive call for file '$f', exiting.\n"; + return undef; + } - @Lines = ; - close FILE; + $self->{'configfiles'}{$f} = 1; - $linenr = 0; - $in_fd = 0; - $in_script = 0; - $lastrow = ""; + print $p . "Lese Datei '$f' ...\n"; + unless ( open FILE, "<$f" ) { + warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n"; + return undef; + } - # Alle Zeilen abklappern - foreach ( @Lines ) { + @Lines = ; + close FILE; - $linenr++; + $linenr = 0; + $in_fd = 0; + $in_script = 0; + $lastrow = ""; - # Zeilen vorn und hinten abschneiden - s#^\s+##; - s#\s+$##; + # Alle Zeilen abklappern + foreach (@Lines) { - # 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; - } + $linenr++; - # Beginn Logfile-Definition - if ( /{$/ ) { - return undef unless $in_fd = $self->log_begin( $_, $f, $in_fd, $linenr ); - next; - } + # Zeilen vorn und hinten abschneiden + s#^\s+##; + s#\s+$##; - # Ende Logfile-Definition - if ( /^}/ ) { - return undef unless $self->log_end( $_, $f, $in_fd, $linenr ); - $in_fd = 0; - next; - } + # Behandlung von \ am Ende der Zeile + $_ = $lastrow . $_; + if (/\\$/) { + s/\\$//; + $lastrow = $_; + next; + } + $lastrow = ""; - # Includes ... - if ( /^include\s/i ) { - return undef unless $self->do_include( $_, $f, $in_fd, $linenr ); - next; - } + # Kommentare raus + s/^#.*//; - # Beginn Script-Definition fuer Logfile - $pattern = join( "|", keys %ScriptDirectives ); - if ( /^$pattern(?:\s+.*)?$/i ) { - $in_script = 1 if $newscript = $self->do_logfilescript( $_, $f, $in_fd, $linenr ); - next; - } + next unless $_; - # Beginn allgemeine Script-Definition - if ( /^script\s/i ) { - $in_script = 1 if $newscript = $self->do_script( $_, $f, $in_fd, $linenr ); - next; - } + # Scriptinhalt zusammensuchen + if ($in_script) { + if (/^endscript$/) { - # alle sonstigen Direktiven - if ( $self->directive($_, $f, $in_fd, $linenr ) ) { - next; - } else { - warn $p . "Schwerer Fehler beim Lesen der Konfigdatei '$f', Zeile Nr. $linenr: '$_'.\n"; - return undef; - } + # Script ist zuende + $in_script = 0; + next; + } + push @{ $self->{'scripts'}{$newscript}{'cmd'} }, $_; + next; + } ## end if ($in_script) - } + # Beginn Logfile-Definition + if (/{$/) { + return undef unless $in_fd = $self->log_begin( $_, $f, $in_fd, $linenr ); + next; + } + # Ende Logfile-Definition + if (/^}/) { + return undef unless $self->log_end( $_, $f, $in_fd, $linenr ); + $in_fd = 0; + next; + } - return 1; + # Includes ... + if (/^include\s/i) { + return undef unless $self->do_include( $_, $f, $in_fd, $linenr ); + next; + } -} + # Beginn Script-Definition fuer Logfile + $pattern = join( "|", keys %ScriptDirectives ); + if (/^$pattern(?:\s+.*)?$/i) { + $in_script = 1 if $newscript = $self->do_logfilescript( $_, $f, $in_fd, $linenr ); + next; + } + + # Beginn allgemeine Script-Definition + if (/^script\s/i) { + $in_script = 1 if $newscript = $self->do_script( $_, $f, $in_fd, $linenr ); + next; + } + + # alle sonstigen Direktiven + if ( $self->directive( $_, $f, $in_fd, $linenr ) ) { + next; + } + else { + warn $p . "Schwerer Fehler beim Lesen der Konfigdatei '$f', Zeile Nr. $linenr: '$_'.\n"; + return undef; + } + + } ## end foreach (@Lines) + + return 1; + +} ## end sub read($$) #------------------------------------------------------------------------------------------ @@ -1818,39 +1867,39 @@ Setzt die $self->{'defaults'} - Datenstruktur auf Vorgabewerte zurueck. sub reset_defaults($) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::reset_defaults(): " : ""; - - print $p . "Setze \$self->{'defaults'} auf Vorgabewerte zurueck.\n" if verbose() > 3; - - $self->{'default'} = { - 'compress' => undef, - 'copytruncate' => undef, - 'create' => { - 'mode' => undef, - 'owner' => undef, - 'group' => undef, - }, - 'period' => 7, - 'dateext' => undef, - 'datepattern' => '%Y-%m-%d', - 'delaycompress' => undef, - 'extension' => "", - 'ifempty' => 1, - 'maxage' => undef, - 'missingok' => undef, - 'olddir' => { - 'dirname' => '', - 'dateformat' => undef, - 'mode' => undef, - 'owner' => undef, - 'group' => undef, - }, - 'rotate' => 4, - 'size' => undef, - }; - -} + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::reset_defaults(): " : ""; + + print $p . "Setze \$self->{'defaults'} auf Vorgabewerte zurueck.\n" if verbose() > 3; + + $self->{'default'} = { + 'compress' => undef, + 'copytruncate' => undef, + 'create' => { + 'mode' => undef, + 'owner' => undef, + 'group' => undef, + }, + 'period' => 7, + 'dateext' => undef, + 'datepattern' => '%Y-%m-%d', + 'delaycompress' => undef, + 'extension' => "", + 'ifempty' => 1, + 'maxage' => undef, + 'missingok' => undef, + 'olddir' => { + 'dirname' => '', + 'dateformat' => undef, + 'mode' => undef, + 'owner' => undef, + 'group' => undef, + }, + 'rotate' => 4, + 'size' => undef, + }; + +} ## end sub reset_defaults($) #------------------------------------------------------------------------------------------ diff --git a/LogRotate/StateFile.pm b/LogRotate/StateFile.pm index d501e2b..e07a398 100644 --- a/LogRotate/StateFile.pm +++ b/LogRotate/StateFile.pm @@ -46,7 +46,7 @@ ENDE $Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis; -$Data::Dumper::Indent = 1; +$Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; use constant default_firstline_statusfile_v2 => "Logrotate State -- Version 2"; @@ -54,8 +54,8 @@ use constant default_firstline_statusfile_v3 => "Logrotate State -- Version 3"; my @ValidFields = qw( parent file test file_version fileversion file-version ); -for my $attr ( @ValidFields ) { - $ok_field{$attr}++; +for my $attr (@ValidFields) { + $ok_field{$attr}++; } #------------------------------------------------------------------------------------ @@ -70,24 +70,24 @@ Wird aufgerufen, um ein neues LogRotate::StateFile-Objekt zu erstellen. sub new { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my ( $res, $cmd ); + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my ( $res, $cmd ); - my $self = { - 'file' => '/val/lib/logrotate.status', - 'file_version' => 3, - 'test' => 0, - @_ - }; + my $self = { + 'file' => '/val/lib/logrotate.status', + 'file_version' => 3, + 'test' => 0, + @_ + }; - $res = bless $self, $class; + $res = bless $self, $class; - my $p = verbose() ? __PACKAGE__ . "::new(): " : ""; + my $p = verbose() ? __PACKAGE__ . "::new(): " : ""; - return $res; + return $res; -} +} ## end sub new #------------------------------------------------------------------------------------------ @@ -99,26 +99,26 @@ Autoload-Methode zum Zugriff auf alle moeglichen Elemente. sub AUTOLOAD { - my $self = shift; - my $attr = $AUTOLOAD; - my ( $val ); + my $self = shift; + my $attr = $AUTOLOAD; + my ($val); - $attr =~ s/.*:://; - $attr = lc($attr); + $attr =~ s/.*:://; + $attr = lc($attr); - croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr}; + croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr}; - return $self->file(@_) if $attr eq "file"; - return $self->test(@_) if $attr eq "test"; - return $self->file_version(@_) if $attr =~ /^file[\-_]*version$/i; + return $self->file(@_) if $attr eq "file"; + return $self->test(@_) if $attr eq "test"; + return $self->file_version(@_) if $attr =~ /^file[\-_]*version$/i; - if ( @_ ) { - $val = shift; - $self->{uc($attr)} = $val; - } - return $self->{uc($attr)}; + if (@_) { + $val = shift; + $self->{ uc($attr) } = $val; + } + return $self->{ uc($attr) }; -} +} ## end sub AUTOLOAD #------------------------------------------------------------------------------------------ @@ -130,29 +130,30 @@ sub AUTOLOAD { sub check($;$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::check(): " : ""; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::check(): " : ""; - print $p . "Aufgerufen mit '" . ( defined $file ? $file : "" ) . "'.\n" if verbose() > 2; + print $p . "Aufgerufen mit '" . ( defined $file ? $file : "" ) . "'.\n" if verbose() > 2; - my $res = $self->read($file); + my $res = $self->read($file); - return undef unless $res; - $file = $self->{'file'}; + return undef unless $res; + $file = $self->{'file'}; - unless ( $self->test() ) { - if ( open FILE, ">>$file" ) { - close FILE; - } else { - warn $p . "Fehler beim Oeffnen der Status-Datei '$file' zum Schreiben: $!\n"; - return undef; + unless ( $self->test() ) { + if ( open FILE, ">>$file" ) { + close FILE; + } + else { + warn $p . "Fehler beim Oeffnen der Status-Datei '$file' zum Schreiben: $!\n"; + return undef; + } } - } - return $res; + return $res; -} +} ## end sub check($;$) #------------------------------------------------------------------------------------------ @@ -173,93 +174,94 @@ Bei Misserfolg wird C zurueckgegeben. sub read($;$) { - my $self = shift; - my $file = shift; - my $p = verbose() ? __PACKAGE__ . "::read(): " : ""; - - my $res = {}; - - print $p . "Aufgerufen mit '" . ( defined $file ? $file : "" ) . "'.\n" if verbose() > 2; + my $self = shift; + my $file = shift; + my $p = verbose() ? __PACKAGE__ . "::read(): " : ""; - my ( $f, $dir, $real_dir, $logfile, $date, $time_t, $i ); + my $res = {}; - $file = $self->{'file'} unless $file; - unless ( $file ) { - carp $p . "Keine Datei uebergeben.\n"; - return undef; - } + print $p . "Aufgerufen mit '" . ( defined $file ? $file : "" ) . "'.\n" if verbose() > 2; - 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 verbose() > 2; - $f = $real_dir . "/" . $f; + my ( $f, $dir, $real_dir, $logfile, $date, $time_t, $i ); - - unless ( -f $file ) { - warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n"; - $self->{'file'} = $f; - return $res; - } - - print $p . "Lese Datei '$f' ...\n" if verbose(); - unless ( open FILE, "<$f" ) { - warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n"; - return undef; - } - - $i = 0; - while ( ) { - - $i++; - s/^\s+//; - s/\s+$//; - - if ( $i == 1 ) { - if ( /^logrotate\s+state\s+-+\s+version\s+[123]$/i ) { - next; - } else { - warn $p . "Inkompatible Version der Statusdatei '$f'.\n"; - close FILE; + $file = $self->{'file'} unless $file; + unless ($file) { + carp $p . "Keine Datei uebergeben.\n"; return undef; - } } - next unless $_; + 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 verbose() > 2; + $f = $real_dir . "/" . $f; + + unless ( -f $file ) { + warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n"; + $self->{'file'} = $f; + return $res; + } - ( $logfile, $date ) = parts( $_ ); - if ( $logfile and $date ) { - my @Date = $date =~ /^\s*(\d+)[_\-](\d+)[_\-](\d+)(?:[\s\-_]+(\d+)[_\-:](\d+)[_\-:](\d+))?/; - unless ( @Date ) { - warn $p . "Konnte Datum nicht erkennen: '$date' (Datei '$f', Zeile $.).\n"; - close FILE; + print $p . "Lese Datei '$f' ...\n" if verbose(); + unless ( open FILE, "<$f" ) { + warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n"; return undef; - } - for $i ( 0 .. 5 ) { - $Date[$i] += 0; - } - printf( $p . "Gelesenes Datum '%-20s': %04d-%02d-%02d %02d:%02d:%02d (%s)\n", $date, @Date, $logfile ) if verbose() > 4; - $time_t = mktime( $Date[5], $Date[4], $Date[3], $Date[2], $Date[1] - 1, $Date[0] - 1900 ); - unless ( $time_t ) { - warn $p . "Unbekanntes Datumsformat: '$date' (Datei '$f', Zeile $.).\n"; - close FILE; - return undef; - } } - $res->{$logfile} = $time_t; + $i = 0; + while () { + + $i++; + s/^\s+//; + s/\s+$//; + + if ( $i == 1 ) { + if (/^logrotate\s+state\s+-+\s+version\s+[123]$/i) { + next; + } + else { + warn $p . "Inkompatible Version der Statusdatei '$f'.\n"; + close FILE; + return undef; + } + } ## end if ( $i == 1 ) + + next unless $_; + + ( $logfile, $date ) = parts($_); + if ( $logfile and $date ) { + my @Date = $date =~ /^\s*(\d+)[_\-](\d+)[_\-](\d+)(?:[\s\-_]+(\d+)[_\-:](\d+)[_\-:](\d+))?/; + unless (@Date) { + warn $p . "Konnte Datum nicht erkennen: '$date' (Datei '$f', Zeile $.).\n"; + close FILE; + return undef; + } + for $i ( 0 .. 5 ) { + $Date[$i] += 0; + } + printf( $p . "Gelesenes Datum '%-20s': %04d-%02d-%02d %02d:%02d:%02d (%s)\n", $date, @Date, $logfile ) if verbose() > 4; + $time_t = mktime( $Date[5], $Date[4], $Date[3], $Date[2], $Date[1] - 1, $Date[0] - 1900 ); + unless ($time_t) { + warn $p . "Unbekanntes Datumsformat: '$date' (Datei '$f', Zeile $.).\n"; + close FILE; + return undef; + } + } ## end if ( $logfile and $date ) + + $res->{$logfile} = $time_t; + + } ## end while () - } - - close FILE; - $self->{'file'} = $f; - return $res; + close FILE; + $self->{'file'} = $f; + return $res; -} +} ## end sub read($;$) #------------------------------------------------------------------------------------------ @@ -271,15 +273,15 @@ Setzt bzw. gibt die Status-Datei dieses Moduls zurueck. sub file($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'file'} = $nv if defined $nv; - } - return $self->{'file'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'file'} = $nv if defined $nv; + } + return $self->{'file'}; -} +} ## end sub file($;$) #------------------------------------------------------------------------------------------ @@ -291,27 +293,28 @@ Setzt bzw. gibt die Version der zu schreibenden Status-Datei dieses Moduls zurue sub file_version($;$) { - my $self = shift; - my $p = verbose() ? __PACKAGE__ . "::file_version(): " : ""; - my ( $nv, $old_version ); - if ( @_ ) { - $nv = shift; - $old_version = defined $nv ? $nv : ""; - $nv = to_int( $nv ); - if ( defined $nv ) { - unless ( $nv == 2 or $nv == 3 ) { - $nv = undef; - } - } - if ( defined $nv ) { - $self->{'file_version'} = $nv; - } else { - warn $p . "Ungueltige Versionsnummer: '$old_version', gueltig sind nur '2' oder '3'.\n"; - } - } - return $self->{'file_version'}; - -} + my $self = shift; + my $p = verbose() ? __PACKAGE__ . "::file_version(): " : ""; + my ( $nv, $old_version ); + if (@_) { + $nv = shift; + $old_version = defined $nv ? $nv : ""; + $nv = to_int($nv); + if ( defined $nv ) { + unless ( $nv == 2 or $nv == 3 ) { + $nv = undef; + } + } + if ( defined $nv ) { + $self->{'file_version'} = $nv; + } + else { + warn $p . "Ungueltige Versionsnummer: '$old_version', gueltig sind nur '2' oder '3'.\n"; + } + } ## end if (@_) + return $self->{'file_version'}; + +} ## end sub file_version($;$) #------------------------------------------------------------------------------------------ @@ -323,15 +326,15 @@ Setzt bzw. gibt den Test-Modus dieses Moduls zurueck. sub test($;$) { - my $self = shift; - my $nv; - if ( @_ ) { - $nv = shift; - $self->{'test'} = $nv; - } - return $self->{'test'}; + my $self = shift; + my $nv; + if (@_) { + $nv = shift; + $self->{'test'} = $nv; + } + return $self->{'test'}; -} +} ## end sub test($;$) #------------------------------------------------------------------------------------------ @@ -347,54 +350,55 @@ Die Funktion gibt zurueck, ob erfolgreich oder nicht. sub write_logfile($$;$) { - my $self = shift; - my $logfile = shift; - my $timestamp = shift || time(); - my $p = verbose() ? __PACKAGE__ . "::write_logfile(): " : ""; - my $ver = $self->file_version(); - - unless ( defined($logfile) and $logfile !~ /^\s*$/ ) { - warn $p . "Ungueltiger Dateiname uebergeben zum Schreiben in Statusdatei.\n"; - return undef; - } - - my ( @Date ); - my ( $f, $d, $max ); - my $file = $self->{'file'}; + my $self = shift; + my $logfile = shift; + my $timestamp = shift || time(); + my $p = verbose() ? __PACKAGE__ . "::write_logfile(): " : ""; + my $ver = $self->file_version(); - my $files = $self->read(); - return undef unless $files; + unless ( defined($logfile) and $logfile !~ /^\s*$/ ) { + warn $p . "Ungueltiger Dateiname uebergeben zum Schreiben in Statusdatei.\n"; + return undef; + } - $files->{$logfile} = $timestamp; + my (@Date); + my ( $f, $d, $max ); + my $file = $self->{'file'}; - $max = 1; - foreach $f ( keys %$files ) { - $max = length($f) if length($f) > $max; - } - $max += 2; + my $files = $self->read(); + return undef unless $files; - print $p . "Schreibe Statusdatei '$file' ...\n" if verbose(); + $files->{$logfile} = $timestamp; - unless ( $self->test() ) { - unless ( open FILE, ">$file" ) { - warn $p . "Konnte Statusdatei nicht zum Schreiben oeffnen: " . $! . "\n"; - return undef; + $max = 1; + foreach $f ( keys %$files ) { + $max = length($f) if length($f) > $max; } - print FILE ( $ver == 2 ? default_firstline_statusfile_v2 : default_firstline_statusfile_v3 ) . "\n"; - foreach $f ( sort { lc($a) cmp lc($b) } keys %$files ) { - @Date = localtime($files->{$f}); - if ( $ver == 2 ) { - $d = sprintf "%d-%d-%d", $Date[5] + 1900, $Date[4] + 1, $Date[3]; - } else { - $d = strftime( '%Y-%m-%d_%H:%M:%S', @Date ); - } - printf FILE "%-*s %s\n", $max, ('"' . $f . '"' ), $d; - } - close FILE; - } - return 1; + $max += 2; + + print $p . "Schreibe Statusdatei '$file' ...\n" if verbose(); + + unless ( $self->test() ) { + unless ( open FILE, ">$file" ) { + warn $p . "Konnte Statusdatei nicht zum Schreiben oeffnen: " . $! . "\n"; + return undef; + } + print FILE ( $ver == 2 ? default_firstline_statusfile_v2 : default_firstline_statusfile_v3 ) . "\n"; + foreach $f ( sort { lc($a) cmp lc($b) } keys %$files ) { + @Date = localtime( $files->{$f} ); + if ( $ver == 2 ) { + $d = sprintf "%d-%d-%d", $Date[5] + 1900, $Date[4] + 1, $Date[3]; + } + else { + $d = strftime( '%Y-%m-%d_%H:%M:%S', @Date ); + } + printf FILE "%-*s %s\n", $max, ( '"' . $f . '"' ), $d; + } ## end foreach $f ( sort { lc($a) cmp lc($b) } keys %$files) + close FILE; + } ## end unless ( $self->test() ) + return 1; -} +} ## end sub write_logfile($$;$) #------------------------------------------------------------------------------------------ diff --git a/logrotate.pl b/logrotate.pl index 85c9d73..c692f47 100755 --- a/logrotate.pl +++ b/logrotate.pl @@ -64,10 +64,10 @@ use POSIX qw(setlocale LC_ALL LC_CTYPE LC_NUMERIC LC_TIME LC_MESSAGES); BEGIN { - my ( $dir ) = $0 =~ m#^(.*)/#; - if ( $dir ) { - unshift @INC, $dir; - } + my ($dir) = $0 =~ m#^(.*)/#; + if ($dir) { + unshift @INC, $dir; + } } @@ -75,10 +75,10 @@ use LogRotate; use LogRotate::Common; # Ruecksetzen aller locale-Einstellungen auf Standard -setlocale( LC_ALL, "C" ); -setlocale( LC_CTYPE, "C" ); -setlocale( LC_NUMERIC, "C" ); -setlocale( LC_TIME, "C" ); +setlocale( LC_ALL, "C" ); +setlocale( LC_CTYPE, "C" ); +setlocale( LC_NUMERIC, "C" ); +setlocale( LC_TIME, "C" ); setlocale( LC_MESSAGES, "C" ); $ENV{'TZ'} = 'GMT'; @@ -89,7 +89,7 @@ ENDE $Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis; -$Data::Dumper::Indent = 1; +$Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; sub write_pidfile($$); @@ -98,165 +98,173 @@ sub check_pidfile($); my $DefConfigFile = "/etc/logrotate.conf"; my $ConfigFile = $DefConfigFile; my $StateFile; -my $force = 0; -my $Debug = 0; -my $help = 0; -my $verbose = 0; -my $version = 0; -my $test = 0; -my $config_check = 0; -my $config = {}; +my $force = 0; +my $Debug = 0; +my $help = 0; +my $verbose = 0; +my $version = 0; +my $test = 0; +my $config_check = 0; +my $config = {}; my @ActDate = localtime(); $| = 1; -my ( @ConfigFiles, @InvalidConfigFiles ); +my ( @ConfigFiles, @InvalidConfigFiles ); my ( $res, $delete_pidfile, $pidfile ); Getopt::Long::Configure("bundling"); Getopt::Long::Configure("no_ignore_case"); -unless ( GetOptions( 'verbose|v+' => \$verbose, - 'usage|help|h' => \$help, - 'debug|d' => \$Debug, - 'force|f' => \$force, - 'configcheck|c' => \$config_check, - 'Version|V' => \$version, - 'state|s:s' => \$StateFile, - 'test|t' => \$test, - ) ) { - warn "Invalid option called in $0.\n"; - warn usage(); - exit 1; -} - -if ( $help ) { - print "Version of $0: $VERSION\n\n"; - print usage(); - exit 0; +unless ( + GetOptions( + 'verbose|v+' => \$verbose, + 'usage|help|h' => \$help, + 'debug|d' => \$Debug, + 'force|f' => \$force, + 'configcheck|c' => \$config_check, + 'Version|V' => \$version, + 'state|s:s' => \$StateFile, + 'test|t' => \$test, + ) + ) +{ + warn "Invalid option called in $0.\n"; + warn usage(); + exit 1; +} ## end unless ( GetOptions( 'verbose|v+' => \$verbose... + +if ($help) { + print "Version of $0: $VERSION\n\n"; + print usage(); + exit 0; } -if ( $version ) { - print "Version of $0: $VERSION\n"; - exit 0; +if ($version) { + print "Version of $0: $VERSION\n"; + exit 0; } $test = 1 if $Debug; + #$test = 1; -if ( $Debug ) { - $verbose = $Debug unless $verbose; +if ($Debug) { + $verbose = $Debug unless $verbose; } verbose($verbose); $test = 1 if $config_check; -unless ( $test ) { - print "\n" . ( "#" x 80 ) . "\n"; - print "$0 beginnt mit Logrotation um: " . localtime() . "\n\n"; +unless ($test) { + print "\n" . ( "#" x 80 ) . "\n"; + print "$0 beginnt mit Logrotation um: " . localtime() . "\n\n"; } -print "Test mode is ON.\n" if $test; +print "Test mode is ON.\n" if $test; print "Verbose mode is ON on level: $verbose.\n" if $verbose; -print "Force mode is ON.\n" if $force; -print "Configuration check only.\n" if $config_check; +print "Force mode is ON.\n" if $force; +print "Configuration check only.\n" if $config_check; my $p = $verbose > 1 ? "$0 - " : ""; -unless ( $config_check ) { - print "\n"; - print( ("-" x 80) . "\n\n") if $verbose > 1; - print "Phase 1: Konfiguration einlesen ...\n\n"; +unless ($config_check) { + print "\n"; + print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1; + print "Phase 1: Konfiguration einlesen ...\n\n"; } -if ( @ARGV ) { - @ConfigFiles = @ARGV; -} else { - @ConfigFiles = ( $DefConfigFile ); +if (@ARGV) { + @ConfigFiles = @ARGV; +} +else { + @ConfigFiles = ($DefConfigFile); } @InvalidConfigFiles = (); -foreach $ConfigFile ( @ConfigFiles ) { - push(@InvalidConfigFiles, $ConfigFile) unless -f $ConfigFile; +foreach $ConfigFile (@ConfigFiles) { + push( @InvalidConfigFiles, $ConfigFile ) unless -f $ConfigFile; } if ( scalar @InvalidConfigFiles ) { - warn "No existing configuration files (" . join( ", ", @InvalidConfigFiles) . ") in calling $0\n"; - exit 3; + warn "No existing configuration files (" . join( ", ", @InvalidConfigFiles ) . ") in calling $0\n"; + exit 3; } -print "Used configuration files: " . join( ",\n ", @ConfigFiles) . - ".\n\n" if $verbose > 1; +print "Used configuration files: " . join( ",\n ", @ConfigFiles ) . ".\n\n" if $verbose > 1; print "\n" . $p . "initialisation:\n\n" if $verbose; -my $lr = new LogRotate( verbose => $verbose, - test => $test, - force => $force, - ); +my $lr = new LogRotate( + verbose => $verbose, + test => $test, + force => $force, +); print "\n" . $p . "Lese Konfig-Dateien:\n\n" if $verbose > 1; -foreach $ConfigFile ( @ConfigFiles ) { +foreach $ConfigFile (@ConfigFiles) { - $res = $lr->read_config( $ConfigFile ); - exit 10 unless $res; + $res = $lr->read_config($ConfigFile); + exit 10 unless $res; } -if ( $StateFile ) { - $lr->{'statusfile'} = $StateFile; -} else { - $lr->{'statusfile'} = $lr->{'c'}{'statusfile'} if $lr->{'c'}{'statusfile'}; +if ($StateFile) { + $lr->{'statusfile'} = $StateFile; +} +else { + $lr->{'statusfile'} = $lr->{'c'}{'statusfile'} if $lr->{'c'}{'statusfile'}; } $pidfile = $lr->{'c'}{'pidfile'} || "/var/run/logrotate.pid"; $delete_pidfile = $test ? 0 : 1; unless ( $lr->{'statusfile'} ) { - warn "Keine Statusdatei gegeben.\n"; - exit 2; + warn "Keine Statusdatei gegeben.\n"; + exit 2; } print "Statusdatei ist: '" . $lr->{'statusfile'} . "'.\n" if $verbose; -unless ( $test ) { +unless ($test) { - if ( check_pidfile $pidfile ) { - print $p . "Pidfile okay.\n" if $verbose > 1; - } else { - $delete_pidfile = undef; - exit 9; - } + if ( check_pidfile $pidfile ) { + print $p . "Pidfile okay.\n" if $verbose > 1; + } + else { + $delete_pidfile = undef; + exit 9; + } - unless ( write_pidfile $pidfile, $$ ) { - $delete_pidfile = undef; - exit 10; - } + unless ( write_pidfile $pidfile, $$ ) { + $delete_pidfile = undef; + exit 10; + } -} +} ## end unless ($test) exit 11 unless $lr->check_state(); -print "\n" . $p . "Gelesene Konfiguration: " . Dumper( $lr ) if $verbose > 3; +print "\n" . $p . "Gelesene Konfiguration: " . Dumper($lr) if $verbose > 3; -unless ( scalar keys %{$lr->{'c'}{'logfiles'}} ) { - warn $p . "Keine Logdateien zum Rotieren gefunden, exit.\n"; - exit 4; +unless ( scalar keys %{ $lr->{'c'}{'logfiles'} } ) { + warn $p . "Keine Logdateien zum Rotieren gefunden, exit.\n"; + exit 4; } -exit ( $res ? 0 : 2 ) if $config_check; +exit( $res ? 0 : 2 ) if $config_check; print "\n"; -print( ("-" x 80) . "\n\n") if $verbose > 1; +print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1; print "Phase 2: Eigentliches Rotieren ...\n\n"; $lr->rotate(); print "\n"; -print( ("-" x 80) . "\n\n") if $verbose > 1; +print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1; print "Phase 3: Loeschen der alten Logdateien ...\n\n"; $lr->delete_oldfiles(); print "\n"; -print( ("-" x 80) . "\n\n") if $verbose > 1; +print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1; print "Phase 4: Komprimieren der alten Logdateien ...\n\n"; $lr->compress(); @@ -270,15 +278,15 @@ exit 0; END { - my $p = $verbose ? __PACKAGE__ . "::END(): " : ""; - if ( $delete_pidfile and -f $pidfile ) { - print $p . "Loesche PID-File '" . $pidfile . "' ...\n" if $verbose > 1; - unless ( unlink $pidfile ) { - warn $p . "Konnte PID-File '" . $pidfile . "' nicht loeschen: $!\n"; + my $p = $verbose ? __PACKAGE__ . "::END(): " : ""; + if ( $delete_pidfile and -f $pidfile ) { + print $p . "Loesche PID-File '" . $pidfile . "' ...\n" if $verbose > 1; + unless ( unlink $pidfile ) { + warn $p . "Konnte PID-File '" . $pidfile . "' nicht loeschen: $!\n"; + } } - } -} +} ## end END #---------------------------------------------------------------------- @@ -294,12 +302,11 @@ exit 0; =cut - #------------------------------------------------------------------------------------------ sub usage { -return <; - close PID; - if ( $pid =~ /^\d+$/ ) { - if ( kill( 0, $pid ) ) { - warn $p . "Es laeuft schon ein '$0'-Script mit pid $pid!\n"; - return undef; - } - warn $p . "Altes Pidfile gefunden, Prozess aber unbekannt verstorben...\n"; - } else { - warn $p . "Nichts Verwendungsfaehiges im Pidfile gefunden, exit ...\n"; - return undef; - } - - } - - return 1; - -} + my $file = shift; + my ($pid); + my $p = $verbose ? __PACKAGE__ . "::check_pidfile(): " : ""; + + if ( -f $file ) { + unless ( open PID, "<", $file ) { + warn $p . "Konnte PID file '" . $file . "' nicht lesend oeffnen: $!\n"; + return undef; + } + $pid = ; + close PID; + if ( $pid =~ /^\d+$/ ) { + if ( kill( 0, $pid ) ) { + warn $p . "Es laeuft schon ein '$0'-Script mit pid $pid!\n"; + return undef; + } + warn $p . "Altes Pidfile gefunden, Prozess aber unbekannt verstorben...\n"; + } + else { + warn $p . "Nichts Verwendungsfaehiges im Pidfile gefunden, exit ...\n"; + return undef; + } + + } ## end if ( -f $file ) + + return 1; + +} ## end sub check_pidfile($) #------------------------------------------------------------------------------------------ @@ -367,21 +375,20 @@ Schreib die uebergebene PID in das uebergebene PID-File. sub write_pidfile($$) { - my ( $pidfile, $pid ) = @_; - my $p = $verbose ? __PACKAGE__ . "::write_pidfile(): " : ""; - - print $p . "Schreibe PID-File '$pidfile' ...\n"; - unless ( open PID, ">", $pidfile ) { - warn $p . "Konnte PID-file '" . $pidfile . "' nicht schreiben: $!\n"; - return undef; - } - print PID "$pid\n"; - close PID; + my ( $pidfile, $pid ) = @_; + my $p = $verbose ? __PACKAGE__ . "::write_pidfile(): " : ""; - return 1; + print $p . "Schreibe PID-File '$pidfile' ...\n"; + unless ( open PID, ">", $pidfile ) { + warn $p . "Konnte PID-file '" . $pidfile . "' nicht schreiben: $!\n"; + return undef; + } + print PID "$pid\n"; + close PID; -} + return 1; +} ## end sub write_pidfile($$) #------------------------------------------------------------------------------------