--- /dev/null
+#!/usr/local/bin/perl
+
+# $Id: Test.pm 294 2005-09-15 14:54:18Z fbrehm $
+# $URL: http://maria.technik.berlin.strato.de:8080/svn/bsagent/lib/BsAgent/Test.pm $
+
+=head1 NAME
+
+B<logrotate.pl> - rotates and compress system logs
+
+=head1 SYNOPSIS
+
+B<logrotate.pl> [OPTIONS] config_file+
+
+=head1 OPTIONS
+
+=over 1
+
+=item B<-c, --configcheck>
+
+Checks only the given configuration files and does nothing, returns 0, if they are okay.
+
+=item B<-d, --debug>
+
+Turns on debug mode and implies I<-v>. In debug mode, no changes will be made to the logs or
+to the B<logrotate.pl> state file.
+
+=item B<-f, --force>
+
+Tells B<logrotate.pl> to force the rotation, even if it doesn't think this is necessary.
+Sometimes this is useful after adding new entries to B<logrotate.pl>, or if old log files
+have been removed by hand, as the new files will be created, and logging will continue correctly.
+
+=item B<-v, --verbose>
+
+Verbose mode. Multiple uses of this parameter increases the verbosity of the output.
+
+=item B<-V, --Version>
+
+Print out Version of the programs and returns.
+
+=item B<-h, --help, --usage>
+
+Prints this short usage message and returns.
+
+=item B<-s, --state E<lt>statefileE<gt>>
+
+Tells B<logrotate.pl> to use an alternate state file. This is useful if B<logrotate.pl> is
+being run as a different user for various sets of log files.
+The default state file is C</var/lib/logrotate.pl.status>.
+
+=back
+
+=begin comment
+
+=cut
+
+use 5.005;
+use strict;
+
+$^W = 1;
+
+use Getopt::Long;
+use Data::Dumper;
+
+our $VERSION = "1.21";
+
+my $DefConfigFile = "/etc/logrotate.conf";
+my $DefStateFile = "/var/lib/logrotate.pl.status";
+my $ConfigFile = $DefConfigFile;
+my $StateFile = $DefStateFile;
+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 $CompressModule = "Compress::Zlib";
+my @CompressPrograms = qw( gzip bzip2 compress );
+my %CompressExts = ( 1 => ".gz",
+ "gzip" => ".gz",
+ "bzip2" => ".bz2",
+ "compress" => ".Z" );
+
+my @ActDate = localtime();
+
+$| = 1;
+
+my ( @ConfigFiles, @InvalidConfigFiles );
+my ( $res );
+
+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;
+}
+
+if ( $version ) {
+ print "Version of $0: $VERSION\n";
+ exit 0;
+}
+
+$test = 1 if $Debug;
+
+if ( $Debug ) {
+ $verbose = $Debug unless $verbose;
+}
+
+$test = 1 if $config_check;
+
+if ( $verbose and not $test ) {
+ print "\n" . ( "#" x 80 ) . "\n";
+ print "$0 starts with logrotation at: " . localtime() . "\n\n";
+}
+
+print "Test mode is ON.\n" if $test and $verbose;
+print "Verbose mode is ON on level: $verbose.\n" if $verbose;
+print "Force mode is ON.\n" if $force and $verbose;
+print "Configuration check only.\n" if $config_check and $verbose;
+
+my $p = $verbose > 1 ? "$0 - " : "";
+
+unless ( $StateFile ) {
+ warn "No Statefile given with option --state|-s.\n";
+ exit 2;
+}
+print "Status file is: '$StateFile'.\n" if $verbose > 1;
+
+if ( @ARGV ) {
+ @ConfigFiles = @ARGV;
+} else {
+ @ConfigFiles = ( $DefConfigFile );
+}
+
+@InvalidConfigFiles = ();
+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;
+}
+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,
+ statusfile => $StateFile );
+
+
+print Dumper( $lr ) if $verbose > 3;
+
+print "\n" . $p . "reading config files:\n\n" if $verbose > 1;
+foreach $ConfigFile ( @ConfigFiles ) {
+
+ $res = $lr->read_config( $ConfigFile );
+
+}
+
+$lr->read_state_file();
+
+print Dumper( $lr ) if $verbose > 2;
+
+unless ( scalar keys %{$lr->{'logfiles'}} ) {
+ warn "No files for logrotating found, exit.\n";
+ exit 4;
+}
+
+exit ( $res ? 0 : 2 ) if $config_check;
+
+$lr->rotate();
+
+$lr->write_status();
+
+$lr->compress_files();
+
+print "\n$0 ends with logrotation at: " . localtime() . "\n" if $verbose and not $test;
+exit 0;
+
+
+#------------------------------------------------------------------------------------------
+
+sub usage {
+
+return <<ENDE;
+Usage: $0 [[-d]|[-v]] [-V] [-f|--force] [-s|--state file] [-h|--help|--usage] config_file+
+
+ Options: -c Checks only the given configuration files and does nothing,
+ returns 0, if they are okay
+ -d Turns on debug mode and implies -v. In debug mode,
+ no changes will be made to the logs or to the $0 state file.
+ -v Verbose mode.
+ -V Print out Version of the programs and returns.
+ -h, --help, --usage
+ Prints this short usage message and returns.
+ -s, --state <statefile>
+ Tells $0 to use an alternate state file. This is useful if $0 is
+ being run as a different user for various sets of log files.
+ The default state file is '$DefStateFile'.
+
+ENDE
+
+}
+
+#####################################################################################
+#------------------------------------------------------------------------------------
+#####################################################################################
+
+package logrotate;
+
+# Header: /opt/cvsroot/logrotate/logrotate.pm,v 1.7 2003/08/25 12:03:57 fbrehm Exp
+
+require Exporter;
+use Carp qw(:DEFAULT cluck);
+
+#------------------------------------------------------------------------------------
+
+use strict;
+use Cwd qw(cwd getcwd abs_path);
+use File::Basename;
+use Data::Dumper;
+use POSIX;
+use File::Copy;
+$^W = 1;
+
+use constant default_firstline_statusfile => "Logrotate State -- Version 2";
+use constant default_buffer_size => 4096;
+use constant max_rotate => 100000;
+
+#------------------------------------------------------------------------------------
+
+sub new {
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $uid = $>;
+ my ( $gid ) = $) =~ /^(\d+)/;
+ my ( $res, $cmd );
+
+ my $self = {
+ verbose => 0,
+ test => 0,
+ force => 0,
+ included_files => {},
+ compress_cmd => 1,
+ compressext => ".gz",
+ compressoptions => "",
+ default => { compress => 0,
+ copytruncate => 0,
+ create => { mode => 0644,
+ owner => $uid,
+ group => $gid },
+ period => 'weekly',
+ dateext => 0,
+ datepattern => "%Y-%m-%d",
+ delaycompress => 0,
+ extension => "",
+ ifempty => 1,
+ maxage => 0,
+ missingok => 0,
+ olddir => { dirname => '',
+ dateformat => undef,
+ mode => undef,
+ owner => undef,
+ group => undef },
+ rotate => 4,
+ sharedscripts => 1,
+ size => 0,
+ lastrotated => "",
+ targetfile => "",
+ },
+ taboo => [ '\.rpmorig$',
+ '\.rpmsave$',
+ ',v$',
+ '\.swp$',
+ '\.rpmnew$',
+ '~$',
+ '^\.' ],
+ statusfile => '/var/lib/logrotate.pl.status',
+ scripts => {},
+ logfiles => {},
+ configfiles => {},
+ rotatet_files => {},
+ files_to_compress => {},
+ @_
+ };
+
+ $res = bless $self, $class;
+
+ my $p = $self->{'verbose'} > 2 ? "logrotate::new: " : "";
+
+ return undef unless $self->check_state_file();
+
+ if ( $self->{'compress_cmd'} ) {
+ unless ( $cmd = $self->check_compress_program( $self->{'compress_cmd'}, 1 ) ) {
+ carp $p . "no valid compression program given, compression disabled.\n" if $self->{'verbose'};
+ $self->{'compress_cmd'} = undef;
+ }
+ $self->{'compress_cmd'} = $cmd;
+ }
+
+ return $res;
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub check_state_file {
+ my $self = shift;
+
+ my $f = $self->{'statusfile'};
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_state_file: " : "";
+
+ unless ( $f ) {
+ carp $p . "No status file defined.\n";
+ return undef;
+ }
+
+ print $p . "checking '$f'.\n" if $self->{'verbose'} > 1;
+
+ if ( -f $f ) {
+ if ( open FILE, "<$f" ) {
+ close FILE;
+ } else {
+ warn $p . "Error in open status file '$f' for read: $!\n";
+ return undef;
+ }
+ }
+
+ unless ( $self->{'test'} ) {
+ if ( open FILE, ">>$f" ) {
+ close FILE;
+ } else {
+ warn $p . "Error in open status file '$f' for write: $!\n";
+ return undef;
+ }
+ }
+
+ return 1;
+}
+
+#------------------------------------------------------------------------------------
+
+sub read_state_file {
+ my $self = shift;
+
+ my $f = $self->{'statusfile'};
+ my $p = $self->{'verbose'} > 2 ? "logrotate::read_state_file: " : "";
+ my $i = 0;
+ my ( $file, $date );
+
+ unless ( $f ) {
+ carp $p . "No status file defined.\n";
+ return undef;
+ }
+
+ print $p . "reading '$f'.\n" if $self->{'verbose'} > 1;
+
+ if ( -f $f ) {
+ if ( open FILE, "<$f" ) {
+
+ while ( $_ = <FILE> ) {
+ $i++;
+ if ( $i == 1 ) {
+ if ( /^logrotate state -- version [12]$/i ) {
+ next;
+ } else {
+ warn $p . "uncompatible version of state file '$f'.\n";
+ close FILE;
+ return undef;
+ }
+ }
+ s/^\s+//;
+ s/\s+$//;
+
+ if ( $_ ) {
+ ( $file, $date ) = $self->parts( $_ );
+ if ( $file and $date ) {
+ if ( $self->{'logfiles'}{$file} ) {
+ $self->{'logfiles'}{$file}{'lastrotated'} = $date;
+ }
+ }
+ }
+ }
+
+ close FILE;
+ } else {
+ warn $p . "Error in open status file '$f' for read: $!\n";
+ return undef;
+ }
+ }
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub check_compress_program {
+
+ my $self = shift;
+ my $cmd = shift || 0;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_compress_program: " : "";
+ my $check_if_empty = shift || 0;
+ my @Dirs;
+ my ( $dir, $found, $prog );
+
+ @Dirs = split ":", $ENV{'PATH'};
+
+ if ( $cmd ) {
+ if ( $cmd =~ m#^/# ) {
+ if ( -f $cmd and -x $cmd ) {
+ print $p . "Found compression program in '$cmd'.\n"
+ if $self->{'verbose'} > 1;
+ return $cmd;
+ } else {
+ warn $p . "Invalid compression program '$cmd'.\n";
+ $cmd = undef;
+ }
+ } else {
+ if ( $cmd eq "1" or $cmd =~ /^$CompressModule$/i ) {
+ eval "use $CompressModule;";
+ if ( $@ ) {
+ warn "$@\n" if $self->{'verbose'};
+ $cmd = undef;
+ } else {
+ print $p . "use perl module '$CompressModule' for compression.\n"
+ if $self->{'verbose'} > 1;
+ return 1;
+ }
+ } else {
+ foreach $dir ( @Dirs ) {
+ $prog = $dir . "/" . $cmd;
+ if ( -f $prog and -x $prog ) {
+ print $p . "Found compression program in '$prog'.\n"
+ if $self->{'verbose'} > 1;
+ return $prog;
+ }
+ }
+ warn $p . "'$cmd' not found in search path '$ENV{'PATH'}'.\n";
+ $cmd = undef;
+ }
+ }
+ }
+
+ if ( $check_if_empty ) {
+
+ eval "use $CompressModule;";
+ if ( $@ ) {
+ $cmd = undef;
+ } else {
+ print $p . "use perl module '$CompressModule' for compression.\n"
+ if $self->{'verbose'} > 1;
+ return 1;
+ }
+
+ foreach $cmd ( @CompressPrograms ) {
+ foreach $dir ( @Dirs ) {
+ $prog = $dir . "/" . $cmd;
+ if ( -f $prog and -x $prog ) {
+ $self->{'compressext'} = $CompressExts{$cmd};
+ print $p . "Found compression program in '$prog'.\n" if $self->{'verbose'} > 1;
+ return $prog;
+ }
+ }
+ }
+ warn $p . "No valid compress program found in '$ENV{'PATH'}'.\n";
+
+ }
+
+ return undef;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub read_config {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::read_config: " : "";
+
+ my ( $f, $dir, $real_dir, $c_comment, $linenr, $in_fd, $in_script, $newscript );
+ my ( @Lines );
+
+ unless ( $file ) {
+ carp $p . "No file given.\n";
+ return undef;
+ }
+
+ unless ( -f $file ) {
+ warn $p . "file '$file' doesn't exists.\n";
+ return undef;
+ }
+
+ if ( $file =~ m#/# ) {
+ ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#;
+ } else {
+ $dir = ".";
+ $f = $file;
+ }
+ $real_dir = abs_path( $dir );
+ print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if $self->{'verbose'} > 2;
+ $f = $real_dir . "/" . $f;
+ # $f = abs_path( $file );
+
+ if ( $self->{'configfiles'}{$f} ) {
+ warn $p . "recursive call for file '$f', exiting.\n";
+ return undef;
+ }
+
+ $self->{'configfiles'}{$f} = 1;
+
+ print $p . "Try to read file '$f' ...\n" if $self->{'verbose'} > 1;
+ unless ( open FILE, "<$f" ) {
+ warn $p . "couldn't open file '$f': $!\n";
+ return undef;
+ }
+
+ print $p . "reading file '$f' ...\n" if $self->{'verbose'};
+ @Lines = <FILE>;
+ close FILE;
+
+ $c_comment = 0;
+ $linenr = 0;
+ $in_fd = 0;
+ $in_script = 0;
+
+ # Alle Zeilen abklappern
+ foreach ( @Lines ) {
+ $linenr++;
+ s#^\s+##;
+ s#\s+$##;
+
+ s/^#.*//;
+ if ( $_ ) {
+
+ # Scriptinhalt zusammensuchen
+ if ( $in_script ) {
+ if ( /^endscript$/ ) {
+ # Script ist zuende
+ $in_script = 0;
+ next;
+ }
+ push @{$self->{'scripts'}{$newscript}{'cmd'}}, $_;
+ next;
+ }
+
+ if ( /{$/ ) {
+ return undef unless $in_fd = $self->check_log_begin( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^}/ ) {
+ return undef unless $self->check_log_end( $_, $f, $in_fd, $linenr );
+ $in_fd = 0;
+ next;
+ }
+
+ if ( /^include\s/i ) {
+ return undef unless $self->check_include( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^compress$/i ) {
+ $self->check_compress( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^compresscmd\s/i ) {
+ $self->check_compresscmd( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^compressext\s/i ) {
+ $self->check_compressext( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^compressoptions(?:\s+.*)?$/i ) {
+ $self->check_compressoptions( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^copytruncate$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'copytruncate'} = 1;
+ } else {
+ $self->{'default'}{'copytruncate'} = 1;
+ }
+ next;
+ }
+
+ if ( /^create(?:\s+.*)?$/i ) {
+ $self->check_create( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^daily$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'period'} = 'daily';
+ } else {
+ $self->{'default'}{'period'} = 'daily';
+ }
+ next;
+ }
+
+ if ( /^dateext(?:\s+.*)?$/i ) {
+ $self->check_dateext( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^nodateext$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'dateext'} = 0;
+ } else {
+ $self->{'default'}{'dateext'} = 0;
+ }
+ next;
+ }
+
+ if ( /^delaycompress$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'delaycompress'} = 1;
+ } else {
+ $self->{'default'}{'delaycompress'} = 1;
+ }
+ next;
+ }
+
+ if ( /^(errors)\s/i ) {
+ warn $p . "unsupported feature '$1' found " .
+ "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2;
+ }
+
+ if ( /^extension(?:\s+.*)?$/i ) {
+ $self->check_extension( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^ifempty$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'ifempty'} = 1;
+ } else {
+ $self->{'default'}{'ifempty'} = 1;
+ }
+ next;
+ }
+
+ if ( /^((?:no)?mail)\s/i ) {
+ warn $p . "Unsupported feature '$1' found " .
+ "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2;
+ }
+
+ if ( /^(mail(?:first|last))/i ) {
+ warn $p . "Unsupported feature '$1' found " .
+ "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2;
+ }
+
+ if ( /^maxage\s/i ) {
+ $self->check_maxage( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^missingok$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'missingok'} = 1;
+ } else {
+ $self->{'default'}{'missingok'} = 1;
+ }
+ next;
+ }
+
+ if ( /^monthly$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'period'} = 'monthly';
+ } else {
+ $self->{'default'}{'period'} = 'monthly';
+ }
+ next;
+ }
+
+ if ( /^nocompress$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'compress'} = 0;
+ } else {
+ $self->{'default'}{'compress'} = 0;
+ }
+ next;
+ }
+
+ if ( /^nocreate$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'copytruncate'} = 1;
+ } else {
+ $self->{'default'}{'copytruncate'} = 1;
+ }
+ next;
+ }
+
+ if ( /^nocopytruncate$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'copytruncate'} = 0;
+ } else {
+ $self->{'default'}{'copytruncate'} = 0;
+ }
+ next;
+ }
+
+ if ( /^nodelaycompress$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'delaycompress'} = 0;
+ } else {
+ $self->{'default'}{'delaycompress'} = 0;
+ }
+ next;
+ }
+
+ if ( /^nomissingok$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'missingok'} = 0;
+ } else {
+ $self->{'default'}{'missingok'} = 0;
+ }
+ next;
+ }
+
+ if ( /^noolddir$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'olddir'} = undef;
+ } else {
+ $self->{'default'}{'olddir'} = undef;
+ }
+ next;
+ }
+
+ if ( /^nosharedscripts$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'sharedscripts'} = 0;
+ } else {
+ $self->{'default'}{'sharedscripts'} = 0;
+ }
+ next;
+ }
+
+ if ( /^notifempty$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'ifempty'} = 0;
+ } else {
+ $self->{'default'}{'ifempty'} = 0;
+ }
+ next;
+ }
+
+ if ( /^olddir\s/i ) {
+ $self->check_olddir( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^postrotate(?:\s+.*)?$/i ) {
+ $in_script = 1 if $newscript = $self->check_postrotate( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^prerotate(?:\s+.*)?$/i ) {
+ $in_script = 1 if $newscript = $self->check_prerotate( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^rotate\s/i ) {
+ $self->check_rotate( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^script\s/i ) {
+ $in_script = 1 if $newscript = $self->check_script( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^size[\s=]/i ) {
+ $self->check_size( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ if ( /^sharedscripts$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'sharedscripts'} = 1;
+ } else {
+ $self->{'default'}{'sharedscripts'} = 1;
+ }
+ next;
+ }
+
+ if ( /^tabooext\s/i ) {
+ $self->check_taboo( $_, $f, $in_fd, $linenr, 'ext' );
+ next;
+ }
+
+ if ( /^taboofile\s/i ) {
+ $self->check_taboo( $_, $f, $in_fd, $linenr, 'file' );
+ next;
+ }
+
+ if ( /^tabooprefix\s/i ) {
+ $self->check_taboo( $_, $f, $in_fd, $linenr, 'prefix' );
+ next;
+ }
+
+ if ( /^weekly$/i ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'period'} = 'weekly';
+ } else {
+ $self->{'default'}{'period'} = 'weekly';
+ }
+ next;
+ }
+
+ if ( /^(uncompresscmd)\s/i ) {
+ warn $p . "unsupported feature '$1' found " .
+ "(line $linenr of file '$f').\n" if $self->{'verbose'} > 2;
+ }
+
+ warn $p . "Unknown or invalide directive '$_' found (line $linenr of file '$f').\n"
+ if $self->{'verbose'} > 1;
+
+ }
+
+ }
+
+ return 1;
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_log_begin {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_log_begin: " : "";
+
+ my ( @Values, @Files, @FileGlob );
+ my ( $name, $file );
+
+ if ( $in_fd ) {
+ warn $p . "Nested logfile definition in configuration file '$f' line $linenr.\n";
+ return 1;
+ }
+
+ $line =~ s/\s*{$//;
+ @Values = $self->parts( $line );
+
+ if ( @Values ) {
+ print "\nStart logfile definition: - " . join( "\n" . (" " x 26) . "- ", @Values ) . "\n"
+ if $self->{'verbose'} > 2;
+ @Files = ();
+ foreach $name ( @Values ) {
+ if ( $name =~ m#^/# ) {
+ if ( $name =~ /[\*\?\[]/ ) {
+ @FileGlob = glob( $name );
+ $FileGlob[0] = $name unless scalar @FileGlob;
+ } else {
+ @FileGlob = ();
+ $FileGlob[0] = $name;
+ }
+ foreach $file ( @FileGlob ) {
+ next if -d $file;
+ if ( $self->{'logfiles'}{$file} ) {
+ warn $p . "logfile '$file' has even a definition, " .
+ "the new definition will overwrite the old one. (line $linenr in file '$f').\n";
+ }
+ push @Files, $file;
+ }
+ } else {
+ warn $p . "logfile '$name' has not an absolute path (line $linenr in file '$f').\n";
+ }
+ }
+ if ( scalar @Files ) {
+ $self->{'newfile'} = {};
+ %{$self->{'newfile'}} = %{$self->{'default'}};
+ $self->{'newfile'}{'files'} = [ @Files ];
+ $self->{'newfile'}{'create'} = {};
+ %{$self->{'newfile'}{'create'}} = %{$self->{'default'}{'create'}};
+ $self->{'newfile'}{'olddir'} = {};
+ %{$self->{'newfile'}{'olddir'}} = %{$self->{'default'}{'olddir'}};
+ }
+ } else {
+ warn $p . "No filename of a logfile found in beginning" .
+ " of the logfile definition in configuration file '$f' line $linenr.\n";
+ return 0;
+ }
+
+ return 1;
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_log_end {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 1 ? "logrotate::check_log_end: " : "";
+
+ my ( $name );
+
+ unless ( $in_fd ) {
+ warn $p . "Found standalone closing curl in configuration file '$f' line $linenr.\n";
+ return undef;
+ }
+
+ print "End logfile definition\n" if $self->{'verbose'} > 2;
+ print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if $self->{'verbose'} > 3;
+ foreach $name ( @{$self->{'newfile'}{'files'}} ) {
+ %{$self->{'logfiles'}{$name}} = %{$self->{'newfile'}};
+ $self->{'logfiles'}{$name}{'create'} = {};
+ %{$self->{'logfiles'}{$name}{'create'}} = %{$self->{'newfile'}{'create'}};
+ $self->{'logfiles'}{$name}{'olddir'} = {};
+ if ( defined $self->{'newfile'}{'olddir'} ) {
+ %{$self->{'logfiles'}{$name}{'olddir'}} = %{$self->{'newfile'}{'olddir'}};
+ } else {
+ $self->{'logfiles'}{$name}{'olddir'} = undef;
+ }
+ delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'};
+ $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++
+ if $self->{'newfile'}{'postrotate'};
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_include {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_include: " : "";
+
+ if ( $in_fd ) {
+ warn $p . "include directives inside logfile definitions are not allowed " .
+ "(line $linenr of file '$f')\n";
+ return undef;
+ }
+
+ my ( $key, $val, $if, $name, $bname, $found, $pattern, $basename, $dir );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+
+ if ( @Values ) {
+ if ( scalar @Values > 1 ) {
+ warn $p . "Only one include per include directive is allowed. " .
+ "Only the first first is taken.\n";
+ }
+ $if = $Values[0];
+
+ if ( $if !~ m#^/# ) {
+ if ( $f =~ m#/# ) {
+ ( $dir, $basename ) = $f =~ m#(.*)/([^/]+)$#;
+ } else {
+ $dir = ".";
+ $basename = $f;
+ }
+ $if = $dir . "/" . $if;
+ }
+
+ if ( -f $if ) {
+ print $p . "Including file '$if' ...\n" if $self->{'verbose'} > 1;
+ unless ( $self->read_config( $f ) ){
+ warn $p . "Reading of configuration file '$if' was NOT successful.\n";
+ return undef;
+ }
+ } elsif ( -d $if ) {
+ print $p . "Including directory '$if' ...\n" if $self->{'verbose'} > 1;
+ foreach $name ( glob( "$if/.* $if/*") ) {
+ # ( $bname ) = $name =~ m#([^/]+)$#;
+ $bname = basename( $name );
+ next if $bname eq "." or $bname eq "..";
+ print $p . "Checking include file $if/$bname ...\n" if $self->{'verbose'} > 1;
+ if ( -d "$if/$bname" ) {
+ # Keine Verzeichnis-Rekursion !!!
+ print $p . "Step over directory $if/$bname.\n" if $self->{'verbose'} > 1;
+ next;
+ }
+ $found = 0;
+ foreach $pattern ( @{$self->{'taboo'}} ) {
+ if ( $bname =~ /$pattern/ ) {
+ $found = 1;
+ print $p . "File $if/$bname was matching Taboo-Pattern '$pattern', not considerd.\n"
+ if $self->{'verbose'} > 1;
+ last;
+ }
+ }
+ unless ( $found ) {
+ print $p . "Including file '$name' ...\n" if $self->{'verbose'} > 1;
+ unless ( $self->read_config( $name ) ){
+ warn $p . "Reading of configuration file '$name' was NOT successful.\n";
+ return undef;
+ }
+ }
+ }
+ } else {
+ warn $p . "Invalid include directive '$line' in line $linenr of file $f.\n";
+ return undef;
+ }
+
+ } else {
+ warn $p . "Include directive found without given include file or directory ".
+ "in configuration file '$f' line $linenr.\n";
+ return undef;
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_compress {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_compress: " : "";
+
+ if ( $self->{'compress_cmd'} ) {
+ if ( $in_fd ) {
+ $self->{'newfile'}{'compress'} = 1;
+ } else {
+ $self->{'default'}{'compress'} = 1;
+ }
+ } else {
+ warn $p . "Compression impossible, no compress command given. " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'} > 1;
+ if ( $in_fd ) {
+ $self->{'newfile'}{'compress'} = 0;
+ } else {
+ $self->{'default'}{'compress'} = 0;
+ }
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_compresscmd {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_compresscmd: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ if ( $in_fd ) {
+ warn $p . "directive 'compresscmd' not allowed inside logfile definitions " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ return;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ unless ( $Values[0] ) {
+ warn $p . "directive 'compresscmd' without given command ".
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ return;
+ }
+
+ if ( $name = $self->check_compress_program( $Values[0] ) ) {
+ $self->{'compress_cmd'} = $name;
+ return;
+ }
+
+ warn $p . "given compress command '$Values[0]' is NOT valid ".
+ "Using ald value '" . ($self->{'compress_cmd'} ? $self->{'compress_cmd'} eq "1" ?
+ $CompressModule :
+ $self->{'compress_cmd'} :
+ "no compression" ) . "'. " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_compressext {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_compressext: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ if ( $in_fd ) {
+ warn $p . "directive 'compressext' not allowed inside logfile definitions " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ return;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $self->{'compressext'} = $Values[0] || "";
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_compressoptions {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_compressoptions: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ if ( $in_fd ) {
+ warn $p . "directive 'compressoptions' not allowed inside logfile definitions " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ return;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $self->{'compressoptions'} = join( " ", @Values ) || "";
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_create {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_create: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ $self->{$key}{'copytruncate'} = 0;
+
+ # Mode (Permission) definition
+ if ( defined $Values[0] ) {
+ if ( $Values[0] =~ /^\d+$/ ) {
+ $self->{$key}{'create'}{'mode'} = oct( $Values[0] );
+ } else {
+ warn $p . "directive 'create' with invalid mode '$Values[0]' " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ }
+ }
+
+ # User (owner, uid) definition
+ if ( defined $Values[1] and $Values[1] ne "" ) {
+ if ( $Values[1] =~ /^[1-9]\d*$/ ) {
+ $self->{$key}{'create'}{'owner'} = $Values[1];
+ } else {
+ $self->{$key}{'create'}{'owner'} = scalar getpwnam( $Values[1] );
+ }
+ }
+
+ # Group (gid) definition
+ if ( defined $Values[2] and $Values[2] ne "" ) {
+ if ( $Values[2] =~ /^[1-9]\d*$/ ) {
+ $self->{$key}{'create'}{'group'} = $Values[2];
+ } else {
+ $self->{$key}{'create'}{'group'} = scalar getgrnam( $Values[2] );
+ }
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_dateext {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_dateext: " : "";
+
+ my ( $key, $val, $name, $ext );
+ my ( @Values );
+
+ my %YesValues = ( '1' => 1,
+ 'on' => 1,
+ 'yes' => 1,
+ 'ja' => 1,
+ 'y' => 1,
+ 'j' => 1,
+ );
+
+ my %NoValues = ( '0' => 1,
+ 'off' => 1,
+ 'no' => 1,
+ 'nein' => 1,
+ 'n' => 1,
+ );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ $ext = lc( $Values[0] || "" );
+ unless ( $ext ) {
+ $self->{$key}{'dateext'} = 1;
+ return;
+ }
+
+ unless ( $NoValues{$ext} ) {
+ $self->{$key}{'dateext'} = 1;
+ $self->{$key}{'datepattern'} = $ext unless $YesValues{$ext};
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_extension {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_extension: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ $self->{$key}{'extension'} = $Values[0] || "";
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_maxage {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_maxage: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ if ( $Values[0] =~ /^\d+$/ ) {
+ $self->{$key}{'maxage'} = $Values[0];
+ } else {
+ warn $p . "invalid directive 'maxage' with parameter '". $Values[0] .
+ "' (line $linenr of file '$f').\n" if $self->{'verbose'};
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 check_olddir ( $line, $f, $in_fd, $linenr )
+
+Überprüft eine olddir-Direktive einer Konfigurations-Datei.
+
+=cut
+
+sub check_olddir {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_olddir: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ if ( $Values[0] ) {
+ $self->{$key}{'olddir'}{'dirname'} = $Values[0];
+ } else {
+ warn $p . "directive 'olddir' without parameter ".
+ "' (line $linenr of file '$f').\n" if $self->{'verbose'};
+ return undef;
+ }
+
+ $self->{$key}{'olddir'}{'mode'} = undef;
+ $self->{$key}{'olddir'}{'owner'} = undef;
+ $self->{$key}{'olddir'}{'group'} = undef;
+
+ # Mode (Permission) definition
+ if ( defined $Values[1] ) {
+ if ( $Values[1] =~ /^\d+$/ ) {
+ $self->{$key}{'olddir'}{'mode'} = oct( $Values[1] );
+ } else {
+ warn $p . "directive 'oldir' with invalid mode '$Values[1]' " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ }
+ }
+
+ # User (owner, uid) definition
+ if ( defined $Values[2] and $Values[2] ne "" ) {
+ if ( $Values[2] =~ /^[1-9]\d*$/ ) {
+ $self->{$key}{'olddir'}{'owner'} = $Values[2];
+ } else {
+ $self->{$key}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] );
+ }
+ }
+
+ # Group (gid) definition
+ if ( defined $Values[3] and $Values[3] ne "" ) {
+ if ( $Values[3] =~ /^[1-9]\d*$/ ) {
+ $self->{$key}{'olddir'}{'group'} = $Values[3];
+ } else {
+ $self->{$key}{'olddir'}{'group'} = scalar getgrnam( $Values[3] );
+ }
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_rotate {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_rotate: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ if ( $Values[0] =~ /^-?\d+$/ ) {
+ $self->{$key}{'rotate'} = $Values[0];
+ } else {
+ warn $p . "invalid directive 'rotate' with parameter '". $Values[0] .
+ "' (line $linenr of file '$f').\n" if $self->{'verbose'};
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_postrotate {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_postrotate: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ unless ( $in_fd ) {
+ warn $p . "directive 'postrotate' not allowed outside a logfile " .
+ "definition (line $linenr of file '$f').\n" if $self->{'verbose'};
+ return undef;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+
+ if ( $Values[0] ) {
+ $self->{'newfile'}{'postrotate'} = lc($Values[0]);
+ return undef;
+ } else {
+ $name = $self->new_script_name( "postrotate" );
+ $self->{'scripts'}{$name}{'cmd'} = [];
+ $self->{'scripts'}{$name}{'post'} = 0;
+ $self->{'scripts'}{$name}{'prerun'} = 0;
+ $self->{'newfile'}{'postrotate'} = $name;
+ return $name;
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_prerotate {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_prerotate: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ unless ( $in_fd ) {
+ warn $p . "directive 'prerotate' not allowed outside a logfile " .
+ "definition (line $linenr of file '$f').\n" if $self->{'verbose'};
+ return undef;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+
+ if ( $Values[0] ) {
+ $self->{'newfile'}{'prerotate'} = lc($Values[0]);
+ return undef;
+ } else {
+ $name = $self->new_script_name( "prerotate" );
+ $self->{'scripts'}{$name}{'cmd'} = [];
+ $self->{'scripts'}{$name}{'post'} = 0;
+ $self->{'scripts'}{$name}{'prerun'} = 0;
+ $self->{'newfile'}{'prerotate'} = $name;
+ return $name;
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_script {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_script: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ if ( $in_fd ) {
+ warn $p . "directive 'script' not allowed inside a logfile " .
+ "definition (line $linenr of file '$f').\n" if $self->{'verbose'};
+ return undef;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+
+ unless ( $Values[0] ) {
+ warn $p . "directive 'script' without a valid script name " .
+ "definition (line $linenr of file '$f').\n" if $self->{'verbose'};
+ return undef;
+ }
+
+ $name = lc($Values[0]);
+ if ( $self->{'scripts'}{$name} ) {
+ warn $p . "script '$name' even declared, will be overwritten " .
+ "definition (line $linenr of file '$f').\n" if $self->{'verbose'};
+ }
+
+ $self->{'scripts'}{$name}{'cmd'} = [];
+ $self->{'scripts'}{$name}{'post'} = 0;
+ $self->{'scripts'}{$name}{'prerun'} = 0;
+ return $name;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_size {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_size: " : "";
+
+ my ( $key, $val, $name );
+ my ( @Values );
+
+ $line =~ s/^size//i;
+ $line =~ s/^\s*=?\s*\+?//;
+
+ @Values = $line ? $self->parts( $line ) : ();
+ $key = $in_fd ? 'newfile' : 'default';
+
+ if ( $Values[0] ) {
+ if ( $Values[0] =~ /^\d+\s*[kmg]?$/i ) {
+ $self->{$key}{'size'} = lc($Values[0]);
+ if ( $Values[1] and $Values[1] =~ /^([kmg])$/i ) {
+ $self->{$key}{'size'} .= lc($1);
+ }
+ } else {
+ warn $p . "invalid directive 'size' with parameter '". $Values[0] .
+ "' (line $linenr of file '$f').\n" if $self->{'verbose'};
+ }
+ } else {
+ warn $p . "directive 'size' without parameter " .
+ "' (line $linenr of file '$f').\n" if $self->{'verbose'};
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub check_taboo {
+
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $what = shift || "";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::check_taboo: " : "";
+
+ my ( $pattern, $key, $val, $name, $found );
+ my ( @Values );
+ my %Pat = ( ext => '%s$',
+ file => '^%s$',
+ prefix => '^%s' );
+
+ unless ( $Pat{$what} ) {
+ carp $p . "invalid parameter in calling.\n";
+ return;
+ }
+
+ if ( $in_fd ) {
+ warn $p . "directive 'taboo$what' not allowed inside logfile definitions " .
+ "(line $linenr of file '$f')\n" if $self->{'verbose'};
+ return;
+ }
+
+ ( $key, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ @Values = $val ? $self->parts( $val ) : ();
+
+ $found = 0;
+ if ( $Values[0] and $Values[0] eq "+" ) {
+ $found = 1;
+ shift @Values;
+ }
+ $self->{'taboo'} = [] unless $found;
+ foreach $name ( @Values ) {
+ $pattern = sprintf( $Pat{$what}, $name );
+ print $p . "New Taboo-Pattern '$pattern' from '$name'.\n" if $self->{'verbose'} > 1;
+ push @{$self->{'taboo'}}, sprintf( $Pat{$what}, $name );
+ }
+
+}
+
+#------------------------------------------------------------------------------------------
+
+sub new_script_name {
+
+ my $self = shift;
+ my $pre = shift || "";
+ my $p = $self->{'verbose'} > 2 ? "logrotate::new_script_name: " : "";
+
+ my $i = 0;
+ my $name = "$pre$i";
+
+ while ( 1 ) {
+ if ( defined $self->{'scripts'}{$name}{'cmd'} ) {
+ if ( scalar @{$self->{'scripts'}{$name}{'cmd'}} ) {
+ $i++;
+ $name = "$pre$i";
+ } else {
+ last;
+ }
+ } else {
+ last;
+ }
+ }
+
+ return $name;
+}
+
+#------------------------------------------------------------------------------------
+
+sub parts {
+
+ my $self = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::parts: " : "";
+
+ my $term = shift;
+ my @Parts = ();
+ my $part;
+
+ while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) {
+ $part = $1 || $2;
+ $part =~ s/\\"/"/g;
+ push @Parts, $part;
+ }
+
+ return @Parts;
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub rotate_time_over {
+
+ my $self = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::rotate_time_over: " : "";
+
+ my ( $type, $date ) = @_;
+ my @ATime = localtime( time );
+ my ( $y1, $m1, $d1, $y2, $m2, $d2 );
+
+ my %Types = ( 'daily' => 1, 'weekly' => 1, 'monthly' => 1);
+
+ unless ( $Types{$type} ) {
+ carp $p . "invalid mode given on calling.\n";
+ return undef;
+ }
+
+ unless ( ( $y1, $m1, $d1 ) = $date =~ /^(\d+)-(\d+)-(\d+)$/ ) {
+ ( $y1, $m1, $d1 ) = ( 1971, 1, 1 );
+ }
+ ( $y2, $m2, $d2 ) = @ATime[5, 4, 3];
+ $y2 += 1900;
+ $m2++;
+
+ my $days1 = int( POSIX::mktime( 0, 0, 0, $d1, $m1 - 1, ($y1 - 1900), 0, 0, 0 ) / 24 / 60 / 60 );
+ my $days2 = int( POSIX::mktime( 0, 0, 0, $d2, $m2 - 1, ($y2 - 1900), 0, 0, 0 ) / 24 / 60 / 60 );
+ my $diff = $days2 - $days1;
+ print $p . $diff . " days difference between current day and last rotated day.\n"
+ if $self->{'verbose'} > 1;
+
+ if ( $type eq 'monthly' ) {
+ return 1 if $diff > 30;
+ return 0 unless $d2 == 1;
+ return $diff > 0;
+ } elsif ( $type eq 'weekly' ) {
+ return $diff >= 7;
+ } else {
+ return $diff > 0;
+ }
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub rotate {
+
+ my $self = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::rotate: " : "";
+
+ my ( $file, $should_rotate, $target, $name, $text, $fsize, $prescript, $postscript, $rotated_file, $cmd );
+ my ( $ouid, $ogid, $omode, $nuid, $ngid, $nmode );
+ my ( @Stats );
+
+ print "\n$p" . "starting with rotation:\n\n" if $self->{'verbose'};
+
+ foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'logfiles'}} ) {
+
+ $should_rotate = $self->test_for_rotate( $file );
+
+ $prescript = $self->{'logfiles'}{$file}{'prerotate'} || "";
+ $postscript = $self->{'logfiles'}{$file}{'postrotate'} || "";
+
+ if ( $should_rotate ) {
+
+ if ( $prescript ) {
+ unless ( $self->{'scripts'}{$prescript}{'prerun'} and $self->{'logfiles'}{$file}{'sharedscripts'} ) {
+ print $p . "Executing prerotate script '$prescript':\n" if $self->{'verbose'};
+ $cmd = join( "\n", @{$self->{'scripts'}{$prescript}{'cmd'}} ) . "\n";
+ print "$cmd\n" if $self->{'verbose'};
+ system $cmd unless $self->{'test'};
+ }
+ $self->{'scripts'}{$prescript}{'prerun'} = 1;
+ }
+
+ unless ( $self->create_olddir( $file ) ) {
+ next;
+ }
+
+ unless ( $target = $self->get_logfile_target( $file ) ) {
+ next;
+ }
+ $self->{'logfiles'}{$file}{'targetfile'} = $target;
+
+ print $p . "\$self->{'logfiles'}{$file}: " . Dumper( $self->{'logfiles'}{$file} ) if $self->{'verbose'} > 3;
+
+ $target = $self->rotate_file( $file );
+
+ unless ( defined $target ) {
+ warn $p . "Could NOT rotate logfile '$file'!\n";
+ next;
+ }
+ print $p . "Result of rotating: '$target'\n" if $self->{'verbose'} > 1;
+
+ $self->{'rotatet_files'}{$file} = 1;
+ $self->{'files_to_compress'}{$target} = 1 if $self->{'logfiles'}{$file}{'compress'} and $target;
+
+ if ( $postscript ) {
+ print $p . "testing for postrotate script '$postscript'...\n" if $self->{'verbose'} > 1;
+ $self->{'scripts'}{$postscript}{'post'}--;
+ $self->{'scripts'}{$postscript}{'dopost'} = 1;
+ unless ( $self->{'scripts'}{$postscript}{'post'} > 0 and $self->{'logfiles'}{$file}{'sharedscripts'} ) {
+ print $p . "Executing postrotatescript '$postscript':\n" if $self->{'verbose'};
+ $cmd = join( "\n", @{$self->{'scripts'}{$postscript}{'cmd'}} ) . "\n";
+ print "$cmd\n" if $self->{'verbose'};
+ system $cmd unless $self->{'test'};
+ $self->{'scripts'}{$postscript}{'donepost'} = 1;
+ }
+
+ }
+
+ }
+
+ }
+
+ print "\n$p" . "Checking for scripts ...\n" if $self->{'verbose'};
+ foreach $name ( keys %{$self->{'scripts'}} ) {
+ if ( $self->{'scripts'}{$name}{'dopost'} and not $self->{'scripts'}{$name}{'donepost'} ) {
+ print $p . "executing postrotatescript '$name':\n" if $self->{'verbose'};
+ $cmd = join( "\n", @{$self->{'scripts'}{$name}{'cmd'}} ) . "\n";
+ print "$cmd\n" if $self->{'verbose'};
+ system $cmd unless $self->{'test'};
+ }
+ }
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 rotate_file ( $file )
+
+Rotiert (bedingungslos) die in $file übergebene Datei.
+
+Dabei MUSS in $self->{'logfiles'}{$file}{'target'} der Dateiname der
+rotierten Datei (ohne Nummerierung) vorher abgelegt worden sein.
+
+Rückgabe:
+
+ undef - irgendwas ging schief
+
+ "" - Datei rotiert und getrunct (kein Komprimieren nötig)
+
+ targetname - Dateiname der rotierten Datei, die dann (wenn gewünscht)
+ komprimiert werden kann
+
+=cut
+
+sub rotate_file {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::rotate_file: " : "";
+ my $uid = $>;
+ my ( $gid ) = $) =~ /^(\d+)/;
+
+ my ( $target, $omode, $ouid, $ogid, $nmode, $nuid, $ngid );
+ my ( $rotate, $i, $ext, $ofile, $nfile, $res, $text, $age );
+ my ( @Stats, @Files, @Nr, @FilesToDelete );
+ my ( %FoundFiles );
+
+ unless ( $file ) {
+ carp $p . "No filename given!\n";
+ return undef;
+ }
+
+ unless ( $self->{'logfiles'}{$file} ) {
+ carp $p . "Invalid filename '$file' given!\n";
+ return undef;
+ }
+
+ $rotate = $self->{'logfiles'}{$file}{'rotate'};
+ unless ( $rotate ) {
+ # Es soll keine Kopie des rotierten Datei aufbewahrt werden ...
+ unless ( $self->{'logfiles'}{$file}{'copytruncate'} ) {
+ print $p . "Deleting '$file' ...\n" if $self->{'verbose'};
+ unlink $file unless $self->{'test'};
+ }
+
+ # Truncen bzw. neu anlegen ...
+ $text = $self->{'logfiles'}{$file}{'copytruncate'} ? "Truncating" : "Creating";
+ print $p . "$text logfile '$file' ...\n" if $self->{'verbose'};
+ unless ( open LOG, ">$file" ) {
+ warn $p . "Could NOT open file '$file' for $text: $!\n";
+ return undef;
+ }
+ close LOG;
+
+ # Permissions und Ownership setzen ...
+ unless ( $self->{'logfiles'}{$file}{'copytruncate'} ) {
+
+ # alte Permissions und Besitzer ermitteln
+ @Stats = stat $file;
+ ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ];
+ # gewünschte Permissions und Besitzer ermitteln
+ $nmode = defined $self->{'logfiles'}{$file}{'create'}{'mode'} ? $self->{'logfiles'}{$file}{'create'}{'mode'} : 0644;
+ $nuid = defined $self->{'logfiles'}{$file}{'create'}{'owner'} ? $self->{'logfiles'}{$file}{'create'}{'owner'} : $uid;
+ $ngid = defined $self->{'logfiles'}{$file}{'create'}{'group'} ? $self->{'logfiles'}{$file}{'create'}{'group'} : $gid;
+
+ if ( $nmode != $omode ) {
+ # gewünschte Permissions setzen
+ print $p . "Changing permissions of '$file'.\n" if $self->{'verbose'} > 1;
+ unless ( chmod $nmode, $file ) {
+ warn $p . "Change of permissions of '$file' was not successful: $!\n";
+ }
+ }
+
+ if ( $ouid != $nuid or $ogid != $ngid ) {
+ # gewünschte Besitzer setzen
+ print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1;
+ unless ( chown $nuid, $ngid, $file ) {
+ warn $p . "Change of ownership of '$file' was not successful: $!\n";
+ }
+ }
+
+ }
+ return "";
+ }
+
+ $target = $self->{'logfiles'}{$file}{'targetfile'};
+ unless ( $target ) {
+ carp $p . "File '$file' without valid target name given!\n";
+ return undef;
+ }
+
+ # alte rotierte Logfiles rausschmeißen, wenn im olddir kein dateformat (irgendwas mit %) angegeben ist ...
+ if ( $self->{'logfiles'}{$file}{'olddir'}{'dateformat'} ) {
+
+ print $p . "No deleting of old rotated logfile versions, because of a date-FORMAT in olddir.\n"
+ if $self->{'verbose'} > 1;
+
+ } else {
+
+ # Maximal $rotate Anzahl alte Logfile-Versionen aufbewahren.
+ $rotate = max_rotate if $rotate > max_rotate;
+ # $rotate--;
+
+ # alte Logfiles einsammeln
+ @Files = glob( $target . "*" );
+ foreach ( @Files ) {
+ next if $_ eq $file;
+ # als alte Logfiles zählen, wenn sie wie das festgelegte Target heißen, daß danach
+ # möglicherweise ein Punkt kommt, danach möglicherweise irgendwelche Ziffern und danach
+ # möglicherweise die Copress-Extension (.gz)
+ if ( m#^$target\.?(?:\d+)?(?:$self->{'compressext'})?$# ) {
+ print $p . "Found ratated Logfile '$_'.\n" if $self->{'verbose'} > 2;
+ @Stats = stat $_;
+ $FoundFiles{$_} = $Stats[9];
+ }
+ }
+ print $p . "Found " . scalar( keys %FoundFiles ) . " old logfile versions of '$file'.\n" if $self->{'verbose'} > 1;
+
+ $i = 0;
+ foreach ( sort { $FoundFiles{$b} <=> $FoundFiles{$a} } keys %FoundFiles ) {
+ $i++;
+
+ # Dateien, die zuviel sind weg ...
+ if ( $i >= $rotate ) {
+ print $p . "File '$_' is No. $i, will deleted because $i >= $rotate rotations.\n" if $self->{'verbose'} > 1;
+ push @FilesToDelete, $_;
+ next;
+ }
+
+ # Dateien, die zu alt sind, weg ...
+ $age = time() - ( $FoundFiles{$_} || 0 );
+ $age = int( $age / 60 / 60 / 24 );
+ print $p . "File '$_' is $age days old.\n" if $self->{'verbose'} > 2;
+ if ( defined $self->{'logfiles'}{$file}{'maxage'} and $self->{'logfiles'}{$file}{'maxage'} > 0 ) {
+ if ( $age > $self->{'logfiles'}{$file}{'maxage'} ) {
+ print $p . "File '$_' will deleted because it's with $age days older then maxage of " .
+ $self->{'logfiles'}{$file}{'maxage'} . " days.\n" if $self->{'verbose'} > 1;
+ push @FilesToDelete, $_;
+ }
+ }
+ }
+
+ # Löschen, was zuviel ist ...
+ foreach ( @FilesToDelete ) {
+ print $p . "Deleting old logfile '$_' ...\n" if $self->{'verbose'};
+ unless ( $self->{'test'} ) {
+ unless ( unlink $_ ) {
+ warn $p . "Could NOT remove old logfile '$_': $!\n";
+ }
+ }
+ }
+
+ }
+
+
+ if ( $self->{'logfiles'}{$file}{'dateext'} ) {
+
+ # Sichergehen, daß das alte Logfile wirklich noch nicht existiert ...
+ if ( -f $target ) {
+ $i = 0;
+ $nfile = "$target.00000";
+ while ( -f $nfile ) {
+ $i++;
+ $nfile = sprintf "$target.%05d", $i;
+ }
+ $target = $nfile;
+ }
+ $res = $target;
+
+ } else {
+
+ # alte Logfiles einsammeln
+ @Files = glob( $target . ".*" );
+ foreach ( @Files ) {
+ if ( ( $i ) = m#^$target\.(\d+)(?:$self->{'compressext'})?$# ) {
+ print $p . "Found Logfile No. '$i'.\n" if $self->{'verbose'} > 2;
+ push @Nr, int( $i );
+ }
+ }
+ print $p . "Found " . scalar @Nr . " old logfile versions of '$file'.\n" if $self->{'verbose'} > 1;
+
+ foreach $i ( sort { $b <=> $a } @Nr ) {
+ # $i von oben nach unten zählen ...
+ $ofile = sprintf "$target.%05d", $i;
+ $ext = "";
+ unless ( -f $ofile ) {
+ $ofile .= $self->{'compressext'};
+ $ext = $self->{'compressext'};
+ }
+ $nfile = sprintf "$target.%05d$ext", $i + 1;
+ if ( -f $ofile ) {
+ # Moven von $i zu $i+1
+ print $p . "Moving '$ofile' --> '$nfile' ...\n" if $self->{'verbose'} > 1;
+ unless ( $self->{'test'} ) {
+ unless ( move $ofile, $nfile ) {
+ warn $p . "Could NOT move '$ofile' --> '$nfile': $!\n";
+ }
+ }
+ } else {
+ warn $p . "Ooops, old logfile '$ofile' does NOT exists!\n";
+ }
+ }
+
+ $nfile = $target . ".00001";
+ $target .= ".00000";
+ if ( $self->{'logfiles'}{$file}{'delaycompress'} ) {
+ $res = $self->{'test'} ? $nfile : ( -f $nfile ? $nfile : "" );
+ } else {
+ $res = $target;
+ }
+ }
+
+ print $p . "Name of the rotated logfile: '$target'.\n" if $self->{'verbose'} > 1;
+
+ if ( $self->{'logfiles'}{$file}{'copytruncate'} ) {
+
+ # Kopieren und truncen
+ print $p . "Copying logfile '$file' -> '$target' ...\n" if $self->{'verbose'};
+ unless ( $self->{'test'} ) {
+ unless ( copy $file, $target ) {
+ warn $p . "Could not copy '$file' -> '$target': $!\n";
+ return undef;
+ }
+ }
+
+ print $p . "Truncating logfile '$file'.\n" if $self->{'verbose'};
+ unless ( $self->{'test'} ) {
+ if ( open FILE, ">$file" ) {
+ close FILE;
+ } else {
+ warn $p . "Could not truncating logfile '$file': $!\n";
+ return undef;
+ }
+ }
+
+ } else {
+
+ # Moven des Logfiles
+ print $p . "Moving logfile '$file' -> '$target' ...\n" if $self->{'verbose'};
+ unless ( $self->{'test'} ) {
+ if ( move $file, $target ) {
+ print $p . "Creating logfile '$file' ...\n" if $self->{'verbose'} > 1;
+ if ( open FILE, ">$file" ) {
+ close FILE;
+
+ # alte Permissions und Besitzer ermitteln
+ @Stats = stat $file;
+ ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ];
+ # gewünschte Permissions und Besitzer ermitteln
+ $nmode = $self->{'logfiles'}{$file}{'create'}{'mode'} || 0644;
+ $nuid = $self->{'logfiles'}{$file}{'create'}{'owner'};
+ $ngid = $self->{'logfiles'}{$file}{'create'}{'group'};
+
+ if ( $nmode != $omode ) {
+ # gewünschte Permissions setzen
+ print $p . "Changing permissions of '$file'.\n" if $self->{'verbose'} > 1;
+ unless ( chmod $nmode, $file ) {
+ warn $p . "Change of permissions of '$file' was not successful: $!\n";
+ }
+ }
+
+ if ( $ouid != $nuid or $ogid != $ngid ) {
+ # gewünschte Besitzer setzen
+ print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1;
+ unless ( chown $nuid, $ngid, $file ) {
+ warn $p . "Change of ownership of '$file' was not successful: $!\n";
+ }
+ }
+
+ } else {
+ warn $p . "Could not create logfile '$file': $!\n";
+ return undef;
+ }
+ } else {
+ warn $p . "Could not move '$file' -> '$target': $!\n";
+ return undef;
+ }
+ }
+
+ }
+
+ return $res;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 compress_files
+
+Komprimiert die Dateien, die im Hash $self-E<gt>{'files_to_compress'} aufgelistet sind.
+
+=cut
+
+sub compress_files {
+
+ my $self = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::compress_files: " : "";
+
+ my ( $file, $gz, $target, $buffer, $cmd, $ok, $size, $blocks, $every );
+ my ( $i, $ouid, $ogid, $nuid, $ngid, $utime, $strat );
+ my ( @OldStat, @NewStat );
+
+ if ( $self->{'compress_cmd'} == 1 ) {
+ unless ( $self->{'compressext'} ) {
+ warn $p . "No valid file extension given for compressed files.\n";
+ return undef;
+ }
+ eval "use $CompressModule;";
+ }
+
+ print "\n" . $p . "Compressing files ...\n" if $self->{'verbose'};
+ foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'files_to_compress'}} ) {
+ print " - $file" if $self->{'verbose'};
+ if ( $self->{'compress_cmd'} == 1 ) {
+ $target = $file . $self->{'compressext'};
+ print " --> $target\n" if $self->{'verbose'};
+ next if $self->{'test'};
+ $ok = 1;
+ $size = ( -s $file );
+ unless ( $size ) {
+ print $p . "File '$file' has size of zero, not compressed.\n" if $self->{'verbose'};
+ next;
+ }
+ $blocks = int( $size / default_buffer_size );
+ $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1;
+ $i = 0;
+ if ( open LOG, "<$file" ) {
+ if ( $gz = eval " gzopen( '$target', 'wb' )" ) {
+ print " " if $self->{'verbose'};
+ $strat = eval "Z_DEFAULT_STRATEGY";
+ $gz->gzsetparams( 9, $strat );
+ while ( read LOG, $buffer, default_buffer_size ) {
+ $i++;
+ $gz->gzwrite( $buffer );
+ print "." if $self->{'verbose'} and ( $i % $every == 0 );
+ }
+ $gz->gzclose();
+ } else {
+ warn $p . "Could not open compressed file '$target' for writing: $!.\n";
+ $ok = 0;
+ }
+ close LOG;
+ print "\n" if $self->{'verbose'} > 1;
+ @OldStat = stat $file;
+ ( $ouid, $ogid, $utime ) = @OldStat[ 4, 5, 9 ];
+ @NewStat = stat $target;
+ ( $nuid, $ngid ) = @NewStat[ 4, 5 ];
+ print $p . "Setting Modification time of '$file'.\n" if $self->{'verbose'} > 1;
+ utime $utime, $utime, $target;
+ if ( $ouid != $nuid or $ogid != $ngid ) {
+ print $p . "Changing ownership of '$file'.\n" if $self->{'verbose'} > 1;
+ chown $ouid, $ogid, $target;
+ }
+ if ( $ok ) {
+ print $p . "Removing file '$file'.\n" if $self->{'verbose'} > 1;
+ unless ( unlink $file ) {
+ warn $p . "Could not remove logfile '$file': $!\n";
+ $ok = 0;
+ }
+ }
+ print " ok.\n" if $self->{'verbose'} == 1;
+ } else {
+ warn $p . "Could not read logfile '$file': $!\n";
+ next;
+ }
+ } else {
+ $cmd = $self->{'compress_cmd'} . " " . ( $self->{'compressoptions'} || "" ) . " " . $file;
+ print " --> $cmd\n" if $self->{'verbose'};
+ next if $self->{'test'};
+ system $cmd;
+ }
+ }
+
+ print $p . "Compressing files successful.\n" if $self->{'verbose'} > 1;
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 write_status
+
+Schreibt den Status der rotierten Logfiles in das Status-File.
+
+Gibt als Wahrheitswert zurück, ob erfolgreich.
+
+=cut
+
+sub write_status {
+
+ my $self = shift;
+
+ my $f = $self->{'statusfile'};
+ my $p = $self->{'verbose'} > 2 ? "logrotate::write_status: " : "";
+ my $i = 0;
+ my ( $file, $date, $first_line, $lines );
+ my %FileList;
+ my $datum = sprintf "%d-%d-%d", $ActDate[5] + 1900, $ActDate[4] + 1, $ActDate[3];
+
+ unless ( $f ) {
+ carp $p . "No status file defined.\n";
+ return undef;
+ }
+
+ print "\n" . $p . "Reading status file '$f'.\n" if $self->{'verbose'} > 1;
+
+ if ( -f $f ) {
+ if ( open FILE, "<$f" ) {
+
+ while ( $_ = <FILE> ) {
+ $i++;
+ if ( $i == 1 ) {
+ if ( /^logrotate state -- version [12]$/i ) {
+ $first_line = $_;
+ chomp $first_line;
+ next;
+ } else {
+ warn $p . "Uncompatible version of state file '$f'.\n";
+ close FILE;
+ return undef;
+ }
+ }
+ s/^\s+//;
+ s/\s+$//;
+
+ if ( $_ ) {
+ ( $file, $date ) = $self->parts( $_ );
+ if ( $file and $date ) {
+ $FileList{$file} = $date;
+ }
+ }
+ }
+
+ close FILE;
+ } else {
+ warn $p . "Error in open status file '$f' for read: $!\n";
+ return undef;
+ }
+ }
+
+ $first_line ||= default_firstline_statusfile;
+
+ foreach $file ( keys %{$self->{'rotatet_files'}} ) {
+ $FileList{$file} = $datum;
+ }
+
+ $lines = $first_line . "\n";
+ foreach $file ( sort { lc($a) cmp lc($b) } keys %FileList ) {
+ $lines .= "\"$file\" " . $FileList{$file} . "\n";
+ }
+ print $p . "New status file:\n" . $lines if $self->{'verbose'} > 1;
+
+ print "\n" . $p . "Writing status file '$f'...\n" if $self->{'verbose'};
+ unless ( $self->{'test'} ) {
+ if ( open FILE, ">$f" ) {
+ print FILE $lines;
+ close FILE;
+ } else {
+ warn $p . "Error in open status file '$f' for write: $!\n";
+ return undef;
+ }
+ }
+ print $p . "Writing status file '$f' successful.\n" if $self->{'verbose'} > 1;
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub test_for_rotate {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::test_for_rotate: " : "";
+
+ my ( $text, $fsize, $maxsize, $time_to_rotate );
+
+ unless ( $file ) {
+ carp $p . "no filename given on calling.\n";
+ return undef;
+ }
+
+ print "\n$p" . "Testing logfile '$file' for rotating ...\n" if $self->{'verbose'} > 1;
+
+ unless ( -f $file ) {
+ $text = $p . "Logfile '$file' does NOT exists, no rotating\n";
+ unless ( $self->{'logfiles'}{$file}{'missingok'} ) {
+ warn $text;
+ return 0;
+ }
+ print $text if $self->{'verbose'} > 1;
+ return 0;
+ }
+
+ unless ( -s $file ) {
+ $text = $p . "Logfile '$file' has a file lenght of 0, no rotating\n";
+ unless ( $self->{'logfiles'}{$file}{'ifempty'} ) {
+ print $text if $self->{'verbose'} > 1;
+ return 0;
+ }
+ }
+
+ if ( $self->{'force'} ) {
+ print $p . "Logfile '$file' will rotated because of FORCE-Mode.\n" if $self->{'verbose'} > 1;
+ return 1;
+ }
+
+ $fsize = ( -s $file );
+ $maxsize = $self->get_bytes( $self->{'logfiles'}{$file}{'size'} || 0 );
+
+ $time_to_rotate = $self->rotate_time_over( $self->{'logfiles'}{$file}{'period'},
+ $self->{'logfiles'}{$file}{'lastrotated'} );
+
+ if ( $maxsize ) {
+ if ( $fsize > $maxsize ) {
+ if ( $time_to_rotate ) {
+ $text = $p . "logfile '$file' maximum size ($maxsize bytes) exseeded " .
+ "with $fsize bytes, will be rotated.\n";
+ print $text if $self->{'verbose'} > 1;
+ return 1;
+ }
+ } else {
+ $text = $p . "logfile '$file' maximum size ($maxsize bytes) NOT exseeded " .
+ "with $fsize bytes, no rotating\n";
+ print $text if $self->{'verbose'} > 1;
+ return 0;
+ }
+ } else {
+ if ( $time_to_rotate ) {
+ $text = $p . "logfile '$file' time for rotating achieved, will be rotated.\n";
+ print $text if $self->{'verbose'} > 1;
+ return 1;
+ }
+ }
+
+ $text = $p . "logfile '$file' time for rotating NOT achieved, no rotating\n";
+ print $text if $self->{'verbose'} > 1;
+ return 0;
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 create_olddir ( $logfile )
+
+Checkt das Vorhandensein von $self-E<gt>{'logfiles'}{$logfile}{'olddir'}, vorher werden aber die
+POSIX-Datumsersetzungen daran gemacht und in $self-E<gt>{'logfiles'}{$logfile}{'olddir'} zurückgespeichert.
+
+Wenn es kein Testfall ist, wird dieses Verzeichnis auch tatsächlich angelegt.
+
+Gibt den Erfolg als Wahrheitswert zurück.
+
+=cut
+
+sub create_olddir {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::create_olddir: " : "";
+
+ my ( $dir, $adir, $mode, $owner, $group, $olddir );
+ my ( $pmode, $puid, $pgid );
+ my ( @Dirs, @Stats );
+ my $uid = $>;
+ my ( $gid ) = $) =~ /^(\d+)/;
+
+ unless ( $file ) {
+ carp $p . "No logfile given!\n";
+ return undef;
+ }
+ print $p . "Checking and creating 'olddir' for logfile '$file'.\n" if $self->{'verbose'} > 1;
+ my $f = $self->{'logfiles'}{$file};
+
+ print $p . Dumper( $f ) if $self->{'verbose'} > 2;
+
+ unless ( $f ) {
+ carp $p . "No valid logfile given!\n";
+ return undef;
+ }
+
+ unless ( $f->{'olddir'}{'dirname'} ) {
+ print $p . "No 'olddir' given.\n" if $self->{'verbose'} > 1;
+ return 1;
+ }
+
+ $mode = $f->{'olddir'}{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755;
+ $owner = $f->{'olddir'}{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid;
+ $group = $f->{'olddir'}{'group'} || $self->{'logfiles'}{'default'}{'olddir'}{'group'} || $gid;
+ unless ( $owner =~ /^\d+$/ ) {
+ $owner = getpwuid( $owner );
+ $owner = $uid unless defined $owner;
+ }
+ unless ( $group =~ /^\d+$/ ) {
+ $group = getgrnam( $group );
+ $group = $gid unless defined $group;
+ }
+
+ if ( $f->{'olddir'}{'dirname'} =~ /%/ ) {
+ $f->{'olddir'}{'dateformat'} = 1;
+ $olddir = POSIX::strftime( $f->{'olddir'}{'dirname'}, @ActDate );
+ } else {
+ $olddir = $f->{'olddir'}{'dirname'};
+ }
+
+ unless ( $olddir =~ m#^/# ) {
+ ( $dir ) = $file =~ m#(.*)/[^/]*$#;
+ $olddir = $dir . "/" . $olddir;
+ }
+ $f->{'olddir'}{'dirname'} = $olddir;
+ print $p . "Olddir is now: '$olddir'.\n" if $self->{'verbose'} > 1;
+
+ unless ( -d $olddir ) {
+
+ @Dirs = split m#/#, $olddir;
+ $adir = "";
+ @Stats = stat "/";
+ ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5];
+ foreach $dir ( @Dirs ) {
+ next unless $dir;
+ next if $dir eq "/";
+ $adir .= "/" . $dir;
+ print " - checking $adir\n" if $self->{'verbose'} > 2;
+ if ( -d $adir ) {
+ @Stats = stat $adir;
+ ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5];
+ } else {
+ print "Creating directory $adir ...\n" if $self->{'verbose'};
+ # Ermittlung effektive Permissions + Ownership
+ # wenn in config-file gegeben, diese,
+ # ansonsten die vom übergeordneten Verzeichnis.
+ $mode = defined $f->{'olddir'}{'mode'} ? $f->{'olddir'}{'mode'} : $pmode;
+ $owner = defined $f->{'olddir'}{'owner'} ? $f->{'olddir'}{'owner'} : $puid;
+ $group = defined $f->{'olddir'}{'group'} ? $f->{'olddir'}{'group'} : $pgid;
+ print " Permissions: $mode, Owner: $owner, Group: $group\n" if $self->{'verbose'} > 1;
+ unless ( $self->{'test'} ) {
+ print " mkdir $adir $mode\n" if $self->{'verbose'} > 1;
+ unless ( mkdir $adir, $mode ) {
+ warn $p . "$!\n";
+ return undef;
+ }
+ if ( $owner != $uid and $group != $gid ) {
+ print " chown $owner, $group, $adir\n" if $self->{'verbose'} > 1;
+ unless ( chown $owner, $group, $adir ) {
+ warn $p . "$!\n";
+ return undef;
+ }
+ }
+ }
+ }
+ }
+
+ }
+
+ return 1;
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 get_logfile_target ( $file )
+
+Legt das Ziel des Rotierens für das übergebene Logfile fest und gibt dieses zurück.
+
+=cut
+
+sub get_logfile_target {
+
+ my $self = shift;
+ my $file = shift;
+
+ unless ( $file ) {
+ carp $p . "Kein Logfile übergeben!\n";
+ return undef;
+ }
+ my $p = $self->{'verbose'} > 2 ? "logrotate::get_logfile_target: " : "";
+
+ print $p . "Receiving target file name for logfile '$file'.\n" if $self->{'verbose'} > 1;
+ my $f = $self->{'logfiles'}{$file};
+
+ print $p . $file . " " . Dumper( $f ) if $self->{'verbose'} > 2;
+
+ my ( $nr, $dir, $basename, $target, $pattern, $ext );
+
+ unless ( $f ) {
+ carp $p . "No valid logfile given!\n";
+ return undef;
+ }
+
+ unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
+ warn $p . "Invalid logfile name: '$file'\n";
+ return undef;
+ }
+
+ $ext = $f->{'extension'} || "";
+
+ $basename = $f->{'olddir'}{'dirname'} ? $f->{'olddir'}{'dirname'} . "/" . $basename : $file;
+ if ( $f->{'dateext'} ) {
+ $pattern = $f->{'datepattern'};
+ print $p . "Using Date-Extension '$pattern' for '$file'.\n" if $self->{'verbose'} > 1;
+ $basename .= "." . $pattern;
+ $basename = POSIX::strftime( $basename, @ActDate );
+ }
+ $target = $basename . $ext;
+
+ print $p . "Found target file name '$target' for logfile '$file'.\n" if $self->{'verbose'} > 1;
+ return $target;
+
+}
+
+#------------------------------------------------------------------------------------
+
+sub get_bytes {
+
+ my $self = shift;
+ my $size = shift || 0;
+ my $p = $self->{'verbose'} > 2 ? "logrotate::get_bytes: " : "";
+
+ my $res = 0;
+
+ unless ( ( $res ) = $size =~ /(\d+)/ ) {
+ $res = 0;
+ }
+ $res *= 1024 if $size =~ /k$/i;
+ $res *= ( 1024 * 1024 ) if $size =~ /m$/i;
+ $res *= ( 1024 * 1024 * 1024 ) if $size =~ /g$/i;
+
+ return $res;
+
+}
+
+#------------------------------------------------------------------------------------
+
+__END__
+
+=end comment
+
+=head1 DESCRIPTION
+
+B<logrotate.pl> is designed to ease administration of systems that generate large numbers
+of log files. It allows automatic rotation, compression and removal of log files.
+Each log file may be handled daily, weekly, monthly, or when it grows too large.
+
+Normally, B<logrotate.pl> is run as a daily cron job. It will not modify a log multiple
+times in one day unless the criterium for that log is based on the log's size and B<logrotate.pl>
+is being run multiple times each day, or unless the I<-f> or I<--force> option is used.
+
+Any number of config files may be given on the command line. Later config files may override
+the options given in earlier files, so the order in which the B<logrotate.pl> config
+files are listed in is important. Normally, a single config file which includes any other config
+files which are needed should be used. See I<logrotate.conf> for more information on
+how to use the include directive to accomplish this.
+
+If no command line arguments are given, B<logrotate.pl> will use I</etc/logrotate.conf> as
+the config file.
+
+=head1 FILES
+
+=over 1
+
+=item I</etc/logrotate.conf> Configuration options.
+
+=item I</var/lib/logrotate.pl.status> Default state file.
+
+=back
+
+=head1 SEE ALSO
+
+=over 1
+
+=item I<logrotate.conf>(8)
+
+=item I<perl>(1)
+
+=item I<gzip>(1)
+
+=back
+
+=head1 AUTHOR
+
+Frank Brehm <frank.brehm@gmx.de>
+
+=head1 ChangeLog
+
+ $Log: logrotate.pl,v $
+ Revision 1.22 2004/04/28 17:41:03 fbrehm
+ Bug in Auflösung geglobter Logfilenamen bereinigt
+
+ Revision 1.21 2003/09/03 11:51:16 fbrehm
+ Korrektur in check_create() beim Ermitteln der Permissions und Besitzerangaben,
+ in rotate_file() das Wegschmeißen alter rotierter Logfiles reorganisiert,
+ kleine kosmetische Änderungen
+
+ Revision 1.20 2003/09/02 16:35:29 fbrehm
+ FORCE-Modus wird jetzt tatsächlich unterstützt,
+ Rotieren einer einzelnen Datei in rotatate_file() ausgelagert,
+ Unterstützung der Direktive rotate X,
+ Unterstützung der Direktive sharedscripts,
+ Unterstützung der Direktive extension,
+ Fileglobbing als logfile Direktive möglich,
+ dafür C-Kommentare in Config-Datien nicht mehr möglich
+ Setzen von mtime der komprimierten Datei auf die der Original-Datei,
+ Beim Komprimieren wird beste Kompression eingeschaltet.
+
+ Revision 1.19 2003/09/01 18:24:38 fbrehm
+ Fehelrbereinigung in test_for_rotate()
+
+ Revision 1.18 2003/09/01 17:11:59 fbrehm
+ Veränderungen bei der Ausführung der Pre- und Post-Rotate-Scripte.
+
+ Revision 1.17 2003/09/01 17:04:22 fbrehm
+ Änderungen bei der Verbosity,
+ Fehlerbereinigung bei der Vergabe Rechte und Eigentümerschaft erstellte Verzeichnisse,
+ POD-Informationen hinzugefügt
+
+ Revision 1.16 2003/08/29 12:04:52 fbrehm
+ Fehler in check_log_end() beseitigt,
+ Kompatibilität zu Perl 5.005 hergestellt.
+
+ Revision 1.15 2003/08/27 17:07:21 fbrehm
+ Bugbereinigung in rotate_time_over (Jörn) und beim Setzen von noolddir.
+
+ Revision 1.14 2003/08/27 14:39:10 fbrehm
+ Korrekturen an rotate_time_over().
+
+ Revision 1.13 2003/08/27 14:01:54 fbrehm
+ Neuerstellen, chown und chmod nach move nachgepflegt.
+
+ Revision 1.12 2003/08/27 11:01:30 fbrehm
+ Bei includes Pfad davorgehängt,
+ Systemaufrufe im Testmodus unterbunden,
+ Chown der komprimierten Datei nur, wenn andere Besitzrechte.
+
+ Revision 1.11 2003/08/27 08:56:15 fbrehm
+ Funktion compress_files() fertiggestellt.
+
+ Revision 1.10 2003/08/27 07:33:21 fbrehm
+ Fehler in rotate_time_over() bereinigt
+
+ Revision 1.9 2003/08/27 07:20:50 fbrehm
+ Syntaxfehler bereinigt
+
+ Revision 1.8 2003/08/27 07:15:18 fbrehm
+ Scharfmachen von mkdir, copy und move und der Scripte
+
+ Revision 1.7 2003/08/25 19:13:16 fbrehm
+ Funktion write_status() eingefügt mit Aufruf,
+ Funktion compress_files() begonnen.
+
+ Revision 1.6 2003/08/25 17:10:03 fbrehm
+ Funktion get_logfile_target() zur Ermittlung des rotierten Dateinamens eingefügt und in rotate() aufgerufen.
+
+ Revision 1.5 2003/08/25 16:18:43 fbrehm
+ Neue Funktion create_olddir eingefügt,
+ neue Behandlung von olddir mit Create-Mode und Besitzrechten.
+
+ Revision 1.4 2003/08/25 13:03:20 fbrehm
+ Ausgabe des Script-Kommandos vor der Ausführung.
+
+ Revision 1.3 2003/08/25 12:23:20 fbrehm
+ logrotate.pm mit in den Quelltext von logrotate.pl aufgenommen.
+
+ Revision 1.2 2003/08/23 10:35:25 fbrehm
+ Kosmetische Korrekturen: gequotete Key-Literale
+
+ Revision 1.1 2003/08/23 09:53:40 fbrehm
+ Übernahme des Perl-Logrotate-Projekts
+
+
+=cut
+
+=head1 ChangeLog logrotate.pm
+
+ Revision 1.7 2003/08/25 12:03:57 fbrehm
+ Wird in die logrotate.pl mit aufgenommen, da seperat nicht benötigt.
+
+ Revision 1.6 2003/08/25 11:12:52 jvalent
+ Bug mit realpath() bei Perl 5.6.0 bereinigt.
+
+ Revision 1.5 2003/08/23 11:54:07 fbrehm
+ Ausgabe der schreienden Funktion erst ab Verbose-Level > 1
+
+ Revision 1.4 2003/08/23 10:51:16 fbrehm
+ Keine Verzeichnisse innerhalb include-Dirs.
+
+ Revision 1.3 2003/08/23 10:35:25 fbrehm
+ Kosmetische Korrekturen: gequotete Key-Literale
+
+ Revision 1.2 2003/08/23 09:55:38 fbrehm
+ Aktuelle Version des Moduls
+
+ Revision 1.1 2003/08/23 09:53:40 fbrehm
+ Übernahme des Perl-Logrotate-Projekts
+
+
+=cut
+
+
--- /dev/null
+#!/usr/local/bin/perl
+
+# $Id: Test.pm 294 2005-09-15 14:54:18Z fbrehm $
+# $URL: http://maria.technik.berlin.strato.de:8080/svn/bsagent/lib/BsAgent/Test.pm $
+
+use strict;
+use 5.8.0;
+use warnings;
+
+use POSIX;
+use Data::Dumper;
+use Config::General;
+use Getopt::Long;
+use File::Copy;
+use File::Glob ':glob';
+use Sys::Syslog;
+use Pod::Usage;
+use Mail::Address;
+use Email::Valid;
+use IPC::Open3;
+
+$| = 1;
+
+our $VERSION = '1.0.3';
+
+=head1 NAME
+
+B<smsd.pl> - SMS Daemon
+
+=head1 SYNOPSIS
+
+ smsd.pl [-v[v]..] [options]
+ smsd.pl -h|--help|-?
+ smsd.pl -V|--version
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<[-c | --conf | --config] /somwhere/mysmsd.conf>
+
+Describes the configuration file.
+
+If not given, C<smsd.conf> in the directory of smsd.pl will used.
+
+=item B<[ --nod | --nodaemon ]>
+
+Don't run as a daemon, only one time in batch mode.
+
+=item B<[ --noi | --noin | --noinbox ]>
+
+Don't perform actions with the inbox.
+
+=item B<[ --noo | --noout | --nooutbox ]>
+
+Don't perform actions with the outbox.
+
+=item B<[-t | --test]>
+
+Test-Mode - no writing or deleting action will performd.
+
+=item B<-h | --help | -?>
+
+Shows the help message and exits.
+
+=item B<-v | --verbose>
+
+Increases the verbose level.
+
+=item B<-V | --version>
+
+Shows the version and exits.
+
+=back
+
+=head1 DESCRIPTION
+
+This is my beautiful SMS daemon, written in perl.
+
+It depends in the I<gammu>-Tool from Marcin Wiacek L<www.mwiacek.com>.
+
+=cut
+
+Getopt::Long::Configure( 'bundling' );
+$Data::Dumper::Indent = 1;
+$Data::Dumper::Sortkeys = 1;
+
+sub debug($;$);
+sub error($;$);
+sub do_incoming();
+sub do_outgoing();
+sub generate_filename($);
+sub check_syslog_token($);
+sub open_logs();
+sub read_config();
+sub reaper();
+sub move_to_error($);
+sub move_to_sent($);
+sub perform_send( $ );
+sub save_sms( $$ );
+
+use SMS;
+
+BEGIN {
+
+ my $GammuPath;
+ if ( $ENV{'PATH'} ) {
+ foreach ( split( ":" , $ENV{'PATH'} ) ) {
+ s#/+$##;
+ if ( -x $_ . "/gammu" ) {
+ $GammuPath = $_ . "/gammu";
+ last;
+ }
+ }
+ } else {
+ $GammuPath = "/usr/bin/gammu";
+ }
+
+ unless ( $GammuPath and -x $GammuPath ) {
+ warn "Executable 'gammu' not found.\n";
+ exit 5;
+ }
+
+ $ENV{'GAMMU_EXE'} = $GammuPath;
+ foreach ( 'LANG', 'LC_MESSAGES', 'LC_ALL', 'LC_COLLATE', 'LC_CTYPE', 'LC_NUMERIC' ) {
+ $ENV{$_} = "en_US";
+ }
+
+}
+
+my $GammuExe = $ENV{'GAMMU_EXE'};
+
+my $verbose = 0;
+my $test = 0;
+my $as_daemon = 1;
+my $noinbox = undef;
+my $nooutbox = undef;
+my $mark = "startup";
+my $do = 1;
+my $reload = 0;
+my $childs = 0;
+my $zombies = 0;
+
+my ( $help, $show_version, $cmdline_verbose );
+my $o_inbox = 1;
+my $o_outbox = 1;
+
+my $config_file = $0;
+$config_file =~ s/\.pl$//i;
+$config_file .= ".conf";
+
+my $o_config_file = undef;
+my $dedicated_conf = undef;
+
+unless (
+ GetOptions(
+ "conf|config|c=s" => \$o_config_file,
+ "test|t" => \$test,
+ "help|h|?" => \$help,
+ "daemon|d!" => \$as_daemon,
+ "inbox|in|i!" => \$o_inbox,
+ "outbox|out|o!" => \$o_inbox,
+ "verbose|v+" => \$cmdline_verbose,
+ "version|V" => \$show_version,
+ )
+ )
+{
+ pod2usage( { -exitval => 1, -verbose => 1 } );
+}
+
+$cmdline_verbose ||= 0;
+$cmdline_verbose++ if $test;
+
+$verbose = $cmdline_verbose;
+
+if ($help) {
+ pod2usage( -exitstatus => 0, -verbose => ( $verbose ? 2 : 1 ) );
+}
+
+if ($show_version) {
+ print "Version: " if $verbose;
+ print "$VERSION\n";
+ exit 0;
+}
+
+$noinbox = $o_inbox ? undef : 1;
+$nooutbox = $o_outbox ? undef : 1;
+
+# no default config file, a dedicated config file was given
+if ( $o_config_file ) {
+ $config_file = $o_config_file;
+ $dedicated_conf = 1;
+}
+
+debug "Testmode" if $test;
+debug "Verbose-Level: " . $verbose, 2;
+
+my $base_dir = "/var/spool/sms";
+my $out_dir = $base_dir . "/outbox";
+my $in_dir = $base_dir . "/inbox";
+my $error_dir = $base_dir . "/error";
+my $sent_dir = $base_dir . "/sent";
+my $work_dir = $base_dir . "/work";
+my $run_dir = "/var/run/sms";
+my $pidfile = $run_dir . "/smsd.pid";
+my $lockfile = $run_dir . "/smsd.lock";
+my $user = "sms";
+my $group = "staff";
+my $count_locations = 20;
+my $inbox_folder_nr = 1;
+my $logs_opened = undef;
+my $cycle = 30;
+my $maxlen = 1500;
+
+my $logdir = "/var/log/sms";
+my $logtype = 'file';
+my $outlogfile = $logdir . "/out.log";
+my $errorlogfile = $logdir . "/error.log";
+my $syslog_facility = "local5";
+my $syslog_ident = "smsd";
+my $sendmail_exe = "/usr/lib/sendmail";
+
+unless( read_config() ) {
+ error "Invalid configuration file '" . $config_file . "'.", 'notice';
+ exit 1;
+}
+
+my $uid = getpwnam($user);
+my $gid = getgrnam($group);
+
+my ( $pid );
+
+unless ( -d $run_dir ) {
+ error "Creating run time directory '" . $run_dir . "' ...";
+ unless ( mkdir $run_dir, 0755 ) {
+ error "Error creating run time directory '" . $run_dir . "': " . $!;
+ exit 14;
+ }
+ unless ( $< ) {
+ if ( $uid ) {
+ debug "Changing owner of '" . $run_dir . "' to '" . $user . "' (" . $uid . ").", 2;
+ unless ( chown $uid, -1, $run_dir ) {
+ error "Error chowning run time directory '" . $run_dir . "': " . $!, "warn";
+ exit 15;
+ }
+ }
+ if ( $gid ) {
+ debug "Changing ownning group of '" . $run_dir . "' to '" . $group . "' (" . $gid . ").", 2;
+ unless ( chown -1, $gid, $run_dir ) {
+ error "Error chowning group of run time directory '" . $run_dir . "': " . $!, "warn";
+ exit 15;
+ }
+ }
+ }
+}
+
+unless ( -d $logdir ) {
+ error "Log directory '" . $logdir . "' doesn't exists.", "warn";
+ exit 16;
+}
+
+unless ( $< ) {
+ if ( $uid ) {
+ debug "Changing user to '" . $user . "' (" . $uid . ").\n", 2;
+ setuid( $uid );
+ }
+ if ( $gid ) {
+ debug "Changing group to '" . $group . "' (" . $gid . ").\n", 2;
+ setgid( $gid );
+ }
+}
+
+if ( $as_daemon ) {
+
+ # Looking for PID-File ...
+ if ( -f $pidfile ) {
+ # Looks wrong, application seems to run ...
+ unless ( open PID, "<", $pidfile ) {
+ error "Couldn't read PID file '" . $pidfile . "': $!", "notice";
+ exit 9;
+ }
+ $pid = <PID>;
+ close PID;
+ if ( $pid =~ /^\d+$/ ) {
+ if ( kill( 0, $pid ) ) {
+ error "There is running a SMS daemon with pid $pid.", "notice";
+ exit 10;
+ }
+ error "Old pidfile found, but died somewhere.";
+ } else {
+ error "Doesn't found any suitable in pidfile, exiting...", "notice";
+ exit 11;
+ }
+ }
+
+ if ( $pid = fork ) {
+ debug "I'm user: $user ($<)", 2;
+ error "$syslog_ident spawned: $pid";
+ unless ( open PID, ">", $pidfile ) {
+ error "Couldn't write PID file '" . $pidfile . "': $!", "notice";
+ kill 'TERM', $pid;
+ exit 12;
+ }
+ print PID "$pid\n";
+ close PID;
+ exit 0;
+ }
+
+}
+
+$mark = "master";
+open_logs;
+
+# Reaping, we don't wanna have some zombies in the wilderness
+$SIG{'CHLD'} = sub { $zombies++ };
+$SIG{'HUP'} = sub { error( "Got signal 'HUP' ." ); $do = 0 ; $reload = 1 };
+$SIG{'TERM'} = sub { error( "Got signal 'TERM'." ); $do = 0; };
+
+my $do_action = 1;
+my ( $time_startloop, $time_current );
+
+error "Starting the SMS daemon (Version $VERSION).";
+
+if ( $as_daemon ) {
+
+ $time_startloop = 0;
+ while ( $do or $reload ) {
+
+ $mark = "master";
+ debug "New turn - new luck...", 3;
+ if ( $reload ) {
+ unless ( read_config() ) {
+ error "Invalid configuration file '" . $config_file . "', using old configuration.", 'notice';
+ }
+ # reopens logfiles, their location could be changed
+ open_logs();
+ $reload = 0;
+ $do = 1;
+ $do_action = 1;
+ }
+ if ( $do_action ) {
+ debug "Doing again ...", 2;
+ $time_startloop = time();
+ do_incoming() unless $noinbox;
+ do_outgoing() unless $nooutbox;
+ $do_action = undef;
+ }
+
+ $time_current = time();
+ if ( $time_current - $time_startloop > $cycle ) {
+ $do_action = 1;
+ }
+
+ sleep 1;
+ }
+
+} else {
+ do_incoming() unless $noinbox;
+ do_outgoing() unless $nooutbox;
+}
+
+$mark = "master";
+
+reaper if $as_daemon;
+sleep 1;
+
+unlink $pidfile if $as_daemon;
+error "Ending the SMS daemon (Version $VERSION).";
+
+exit 0;
+
+##############################################################################
+
+=head1 Functions
+
+All self defined functions ...
+
+=cut
+
+#------------------------------------------------------------------
+
+=head2 debug
+
+B<C<debug $message, $level;>>
+
+Prints this message either in outlog-file or via syslog with level debug.
+
+=cut
+
+sub debug( $;$ ) {
+
+ my ( $msg, $level ) = @_;
+
+ return if $msg =~ /^\s*$/;
+ $msg =~ s/^\s+//;
+ $msg =~ s/\s+$//;
+
+ $level ||= 1;
+ if ( $level =~ /\d+/ ) {
+ $level =~ s/.*(\d+).*/$1/;
+ } else {
+ $level = 1;
+ }
+ $level ||= 1;
+
+ return unless $level <= $verbose;
+
+ unless ( $logs_opened ) {
+ print $msg . "\n";
+ return;
+ }
+
+ $msg = $mark . " - " . $msg;
+
+ if ( $logtype eq 'syslog' ) {
+ openlog( $syslog_ident, 'pid', $syslog_facility );
+ syslog( 'debug', $msg );
+ closelog;
+ } else {
+ my @LTime = localtime();
+ my $line = '[%04d-%02d-%02d %02d:%02d:%02d] (%d): ';
+ printf( $line, $LTime[5] + 1900, $LTime[4] + 1, $LTime[3], $LTime[2], $LTime[1], $LTime[0], $$ );
+ print $msg . "\n";
+ }
+
+}
+
+#------------------------------------------------------------------
+
+=head2 error
+
+B<C<error $message, $level;>>
+
+Prints this warning either to standard out or to syslog with the given syslog-level.
+
+=cut
+
+sub error( $;$ ) {
+
+ my ( $msg, $level ) = @_;
+
+ $msg =~ s/^\s+//;
+ $msg =~ s/\s+$//;
+ $msg ||= "Unknown error";
+
+ unless ( $logs_opened ) {
+ warn $msg . "\n";
+ return;
+ }
+
+ $level ||= 'info';
+ $level = 'info' unless check_syslog_token $level;
+
+ $msg = $mark . " - " . $msg;
+
+ if ( $logtype eq 'syslog' ) {
+ openlog( $syslog_ident, 'pid', $syslog_facility );
+ syslog( $level, $msg );
+ closelog;
+ }
+
+ my @LTime = localtime();
+ my $line = '[%04d-%02d-%02d %02d:%02d:%02d] (%d) %s: ';
+ warn( sprintf( $line, $LTime[5] + 1900, $LTime[4] + 1, $LTime[3], $LTime[2], $LTime[1], $LTime[0], $$, uc($level) ) .
+ $msg . "\n" );
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 open_logs
+
+Opens the logfiles and saves the filehandles in STDOUT and STDERR.
+
+=cut
+
+sub open_logs() {
+
+ return unless $as_daemon;
+
+ unless (open STDERR, ">>", $errorlogfile ) {
+ warn "Could't open error log '" . $errorlogfile . "' for write: $!\n";
+ exit 13;
+ }
+ select STDERR;
+ $|=1;
+
+ if ( $logtype ne 'syslog' ) {
+ unless (open STDOUT, ">>", $outlogfile ) {
+ warn "Could't open debug log '" . $outlogfile . "' for write: $!\n";
+ exit 13;
+ }
+ select STDOUT;
+ $|=1;
+ } else {
+ open STDOUT, "</dev/null";
+ }
+
+ open STDIN, "</dev/null";
+
+ $logs_opened = 1;
+
+}
+
+#------------------------------------------------------------------
+
+=head2 do_incoming
+
+Performs all incoming SMS-files.
+
+=cut
+
+sub do_incoming() {
+
+ my ( $i, $CmdLine, $result, $sms, $id, $count, $osms, $filename, $lockname, $error_code );
+
+ my ( %SMS, %SMSChains );
+ my ( @SMS, @Order, @SmsDelete );
+
+ $mark = "incoming";
+ debug "Reading incoming SMS ...\n";
+
+ for ( $i = 1; $i <= $count_locations; $i++ ) {
+
+ $CmdLine = $GammuExe . " --getsms " . $inbox_folder_nr . " " . $i;
+ debug "Executing: '" . $CmdLine . "'", 2;
+ $result = `$CmdLine`;
+ unless ( $? ) { # Erfolgreich!!!
+ $sms = new SMS();
+ $sms->parse_from_gammu( $result );
+ unless ( $sms->empty() ) {
+ debug "Got SMS from SIM-Location " . $i, 2;
+ $SMS{$i} = $sms;
+ if ( $sms->{'header'}->concatid() ) {
+ push @{$SMSChains{$sms->{'header'}->concatid()}}, $i;
+ } else {
+ push @SMS, $sms;
+ push @SmsDelete, $i;
+ }
+ }
+ }
+
+ }
+
+ foreach $id ( keys %SMSChains ) {
+ debug "Analysing Chain Nr.: $id", 3;
+ $i = [@{$SMSChains{$id}}]->[0];
+ $osms = $SMS{$i};
+ $count = $osms->{'header'}->Concatcount();
+ if ( scalar( @{$SMSChains{$id}} ) == $count ) {
+ debug " Got all SMS from Chain.", 3;
+ $result = "";
+ $sms = new SMS();
+ $sms->{'header'}->smscnr( $osms->{'header'}->smscnr() );
+ $sms->{'header'}->remotenr( $osms->{'header'}->remotenr() || "unknown" );
+ $sms->{'header'}->sendate( $osms->{'header'}->sendate() );
+ @Order = ();
+ @Order = sort { $SMS{$a}->{'header'}->Concatnr() <=> $SMS{$b}->{'header'}->Concatnr() } ( @{$SMSChains{$id}} );
+ foreach $i ( @Order ) {
+ $result .= $SMS{$i}->body();
+ push @SmsDelete, $i;
+ }
+ $sms->body( $result );
+ push @SMS, $sms;
+ } else {
+ debug " Chain is not complete.", 3;
+ }
+ }
+
+
+ foreach $sms ( @SMS ) {
+
+ $filename = generate_filename( $in_dir );
+ debug "Creating file: '$filename' ...";
+ $lockname = $filename . ".lock";
+
+ unless ( $test ) {
+
+ if ( open LOCK, ">", $lockname ) {
+ close LOCK;
+ } else {
+ error "Couldn't create file '$lockname': $!", "warn";
+ exit 10;
+ }
+
+ if ( open FILE, ">", $filename ) {
+ print FILE $sms->as_string();
+ close FILE;
+ } else {
+ error "Couldn't create file '$filename': $!\n", "warn";
+ exit 11;
+ }
+
+ unless ( unlink( $lockname ) ) {
+ error "Couldn't delete file '$lockname': $!\n", "warn";
+ exit 12;
+ }
+
+ }
+
+ }
+
+ if ( scalar @SmsDelete ) {
+ debug "Deleting SMS on SIM-Card ...";
+
+ foreach $i ( @SmsDelete ) {
+
+ $CmdLine = $GammuExe . " --deletesms " . $inbox_folder_nr . " " . $i . " 2>&1";
+ debug "Executing: '" . $CmdLine . "'", 2;
+ $error_code = 0;
+ $result = '';
+ unless ( $test ) {
+ $result = `$CmdLine`;
+ $error_code = $?;
+ }
+ if ( $error_code ) {
+ error "Error in deleting SMS in SIM Location $i: " . $result, "warn";
+ } else {
+ debug "SMS in SIM Location $i successful deleted.";
+ }
+ }
+
+ }
+
+}
+
+#------------------------------------------------------------------
+
+=head2 do_outgoing
+
+Performs all outgoing SMS-files.
+
+=cut
+
+sub do_outgoing() {
+
+ my ( $filename, $lockname, $original_filename, $content, $sms, $nr );
+
+ $mark = "outgoing";
+
+ my @Pattern = ( "$out_dir/*.txt", "$out_dir/*.sms" );
+ if ( $verbose > 1 ) {
+ debug "Searchpattern for outgoing SMS:";
+ debug " - '$_'" foreach @Pattern;
+ }
+ my @InFiles = map { bsd_glob( $_ , GLOB_TILDE | GLOB_ERR | GLOB_NOCASE | GLOB_NOSORT ) } @Pattern;
+ my $found = undef;
+
+ if ( scalar @InFiles ) {
+
+ debug "Sending outgoing SMS ...";
+ foreach $filename ( @InFiles ) {
+
+ $lockname = $filename . ".lock";
+ unless ( -f $lockname ) {
+ $found = 1;
+ debug "Procesing outfile '" . $filename . "'";
+ debug "Moving to workdir '" . $work_dir . "' ...", 2;
+ move $filename, $work_dir unless $test;
+ }
+ }
+
+ unless ( $found ) {
+ debug "No suitable outgoing SMS found.", 2;
+ return;
+ }
+
+ } else {
+ debug "No outgoing SMS found.", 2;
+ return;
+ }
+
+ @InFiles = bsd_glob( "$work_dir/*", GLOB_TILDE | GLOB_ERR | GLOB_NOSORT );
+ foreach $filename ( @InFiles ) {
+ debug "Reading '" . $filename . "' ...", 2;
+ if ( open FILE, "<", $filename ) {
+ {
+ local $/ = undef;
+ $content = <FILE>;
+ }
+ close FILE;
+ } else {
+ error "Couldn't read file '" . $filename . "': " . $!, 'notice';
+ next;
+ }
+
+ $sms = new SMS();
+ $sms->parse( $content );
+ debug "Read SMS: " . Dumper( $sms ), 2;
+
+ $nr = $sms->{'header'}->recipient();
+ unless ( $nr ) {
+ error "No recipient found in SMS file '" . $filename . "'", 'notice';
+ move_to_error $filename;
+ next;
+ }
+
+ unless ( $sms->body() ) {
+ error "SMS without a message found in file '" . $filename . "', not sent.", 'notice';
+ move_to_error $filename;
+ next;
+ }
+
+ $sms->{'header'}->OriginalFilename( $filename );
+ $sms->{'header'}->Performed_At( scalar( localtime() ) );
+ $sms->{'header'}->Status( "In progress" );
+
+ if ( perform_send $sms ) {
+ $sms->{'header'}->Status( "Sent" );
+ $sms->{'header'}->Sent_At( scalar( localtime() ) );
+ save_sms( $sms, $sent_dir );
+ } else {
+ $sms->{'header'}->Status( "Error" );
+ $sms->{'header'}->Error_At( scalar( localtime() ) );
+ save_sms( $sms, $error_dir );
+ move_to_error $filename;
+ }
+
+ if ( -f $filename ) {
+ debug "Delete file '" . $filename . "'.", 2;
+ unless ( $test ) {
+ unless ( unlink $filename ) {
+ error "Couldn't delete file '" . $filename . "': " . $!, 'notice';
+ }
+ }
+ }
+
+ }
+
+}
+
+#------------------------------------------------------------------
+
+=head2 perform_send
+
+I<C<perform_send $sms>>
+
+Sends the SMS of the given structure to the recipient.
+
+=cut
+
+sub perform_send( $ ) {
+
+ my $sms = shift;
+
+ my ( @EMailRcpt, @R, @S );
+ my ( $rec, $CmdLine, $smsc, $res, $mail_subject, $out );
+
+ my $rcpt = $sms->{'header'}->recipient();
+ my $emails = $sms->{'header'}->confirmemailaddress() ||
+ $sms->{'header'}->confirmemailrecipient() ||
+ $sms->{'header'}->confirmemail();
+
+ my $params = sprintf "--sendsms TEXT %%s -autolen %d -validity MAX", $maxlen;
+ $smsc = $sms->{'header'}->smscnumber() || $sms->{'header'}->smsc();
+ $params .= sprintf( " -smscnumber %s", $smsc ) if $smsc;
+
+ if ( $emails ) {
+
+ debug "Analyse E-Mail-Addresses: '" . $emails . "'.", 3;
+ @R = $emails =~ /((?:"[^"]*")*[^,;]+)[,;]\s*((?:"[^"]*")*[^,;]+)/g;
+ debug "Found E-Mail-Adresses for confirmation: " . Dumper( \@R ), 2;
+ foreach $rec ( @R ) {
+ @S = Mail::Address->parse($rec);
+ foreach( @S ) {
+ if ( Email::Valid->address($_->address()) ) {
+ push @EMailRcpt, { 'address' => $_->address(), 'phrase' => ( $_->phrase() ? $_->phrase() : $_->address() ) };
+ } else {
+ error "Invalid E-Mail-Address '" . $_->address() . "'.";
+ }
+ }
+ }
+ debug "Used E-Mail-Addresses for confirmation: " . Dumper( \@EMailRcpt ), 2;
+
+ }
+
+ $CmdLine = "| $GammuExe " . sprintf( $params, $sms->{'header'}->recipient() );
+ debug "Calling '" . $CmdLine . "'.";
+ $res = 1;
+ $mail_subject = sprintf( "SMS to %s successfully sent.", $sms->{'header'}->recipient() );
+ unless ( $test ) {
+ if ( open GAMMU, $CmdLine ) {
+ print GAMMU $sms->body();
+ close GAMMU;
+ } else {
+ error "Couldn't transmit SMS: $!", 'notice';
+ $res = undef;
+ $mail_subject = sprintf( "SMS to %s NOT successfully sent.", $sms->{'header'}->recipient() );
+ }
+ }
+
+ if ( scalar @EMailRcpt ) {
+
+ unless( -x $sendmail_exe ) {
+ error "Sendmail '" . $sendmail_exe . "' doesn't exists or isn't executable.", 'notice';
+ return undef;
+ }
+
+ $CmdLine = $sendmail_exe . " ";
+ $CmdLine .= join( " ", map( { $_->{'address'} } @EMailRcpt ) );
+
+ $out = "Subject: " . $mail_subject . "\n";
+ $out .= "X-Mailer: SMS Daemon\n";
+ $out .= "From: Sun Management Center SMC <smc\@strato.de>\n";
+ $out .= "To: " . join( ", ", map( { $_->{'phrase'} . " <" . $_->{'address'} . ">" } @EMailRcpt ) ) . "\n\n";
+ $out .= $mail_subject . "\n\n";
+ $out .= "SMS Daemon\n";
+
+ debug "Calling '" . $CmdLine . "'.";
+ debug "Sended mail:\n" . $out, 2;
+
+ unless ( $test ) {
+ if ( open( MAIL, "|$CmdLine" ) ) {
+ print MAIL $out;
+ close MAIL;
+ } else {
+ error( "Couldn't open sendmail '" . $sendmail_exe . "': ". $_ );
+ }
+ }
+
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------
+
+=head2 move_to_error
+
+I<C<move_to_error $sms_file>>
+
+Moves the given file in the error directory.
+
+=cut
+
+sub move_to_error( $ ) {
+
+ my $file = shift;
+ my ( $newfile, $basename );
+
+ ( $basename ) = $file =~ m#.*/([^/]+)$#;
+ if ( $basename ) {
+ if ( -f ( $error_dir . "/" . $basename ) ) {
+ $newfile = generate_filename $error_dir;
+ } else {
+ $newfile = $error_dir . "/" . $basename;
+ }
+ } else {
+ $newfile = generate_filename $error_dir;
+ }
+ error "Moving file '" . $file . "' to '" . $newfile . "' ...";
+ unless ( $test ) {
+ unless ( move $file, $newfile ) {
+ error "Couldn't move file '" . $file . "' to '" . $newfile . "': " . $!, 'notice';
+ return undef;
+ }
+ }
+ return 1;
+
+}
+
+#------------------------------------------------------------------
+
+=head2 move_to_sent
+
+I<C<move_to_sent $sms_file>>
+
+Moves the given file in the sent directory.
+
+=cut
+
+sub move_to_sent( $ ) {
+
+ my $file = shift;
+ my ( $newfile, $basename );
+
+ ( $basename ) = $file =~ m#.*/([^/]+)$#;
+ if ( $basename ) {
+ if ( -f ( $sent_dir . "/" . $basename ) ) {
+ $newfile = generate_filename $sent_dir;
+ } else {
+ $newfile = $sent_dir . "/" . $basename;
+ }
+ } else {
+ $newfile = generate_filename $sent_dir;
+ }
+ error "Moving file '" . $file . "' to '" . $newfile . "' ...";
+ unless ( $test ) {
+ unless ( move $file, $newfile ) {
+ error "Couldn't move file '" . $file . "' to '" . $newfile . "': " . $!, 'notice';
+ return undef;
+ }
+ }
+ return 1;
+
+}
+
+#------------------------------------------------------------------
+
+=head2 save_sms
+
+I<C<save_sms $sms $directory>>
+
+Saves the given sms-struct in the given directory.
+
+=cut
+
+sub save_sms( $$ ) {
+
+ my $sms = shift;
+ my $dir = shift;
+
+ my $newfile = generate_filename $dir;
+ my $orig_file = $sms->{'header'}->OriginalFilename();
+ my $res = 1;
+
+ $orig_file =~ s#.*/##;
+ $sms->{'header'}->OriginalFilename($orig_file);
+
+ debug "Saving SMS as '" . $newfile . "'.";
+ debug "Saved SMS: " . Dumper( $sms ), 2;
+
+ unless ( $test ) {
+ if ( open FILE, ">", $newfile ) {
+ print FILE $sms->as_string();
+ close FILE;
+ } else {
+ error "Couldn't save SMS '" . $newfile . "': " . $!, 'notice';
+ $res = undef;
+ }
+ }
+
+ return $res;
+
+}
+
+#------------------------------------------------------------------
+
+=head2 generate_filename
+
+B<C<generate_filename $folder;>>
+
+Generates a unique filename in the given folder.
+
+=cut
+
+sub generate_filename($) {
+
+ my $folder = shift;
+
+ die "Incorrect calling of generate_filename() ... " unless $folder;
+ die "Invalid folder '" . $folder . "' - does not exists.\n" unless -d $folder;
+
+ my @LTime = localtime();
+ my $filepat = $folder . '/sms_%04d-%02d-%02d_%02d-%02d-%02d_%03d.txt';
+ my ( $filename, $i, $lockname );
+
+ $i = 0;
+ while ( 1 ) {
+ $filename = sprintf( $filepat, $LTime[5] + 1900, $LTime[4] + 1, $LTime[3], $LTime[2], $LTime[1], $LTime[0], $i );
+ $lockname = $filename . ".lock";
+ unless ( -f $filename or -f $lockname ) {
+ return $filename;
+ }
+ $i++;
+ }
+
+}
+
+#------------------------------------------------------------------
+
+=head2 check_syslog_token
+
+B<C<check_syslog_token( $token );>>
+
+Checks the validity for the syslog of the given token.
+
+=cut
+
+sub check_syslog_token($) {
+
+ my ( $name ) = @_;
+ $name = uc $name;
+ $name = "LOG_$name" unless $name =~ /^LOG_/;
+ $name = "Sys::Syslog::$name";
+ # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero.
+ my $value = eval { &$name };
+ return defined $value ? 1 : undef;
+
+}
+
+#-------------------------------------------------------------------------
+
+=head2 read_config
+
+Reads the configuration file.
+
+Gives back the success.
+
+=cut
+
+sub read_config() {
+
+ my %config = ();
+
+ my ( $tmp, $dir );
+ my $ok = 1;
+ my @DirKeys = ( 'outbox', 'inbox', 'error', 'work', 'sent', 'log' );
+ my $config_options = {
+ '-ConfigFile' => $config_file,
+ '-LowerCaseNames' => 1,
+ '-AutoTrue' => 1,
+ };
+
+ my $defaults = {
+ 'debug' => 0,
+ 'directories' => {
+ 'base' => '/var/spool/sms',
+ 'outbox' => 'outbox',
+ 'inbox' => 'inbox',
+ 'error' => 'error',
+ 'work' => 'work',
+ 'sent' => 'sent',
+ 'log' => '/var/log/sms',
+ },
+ 'pidfile' => '/var/run/sms/smsd.pid',
+ 'sendmailexecutable' => '/usr/lib/sendmail',
+ 'outlog' => 'out.log',
+ 'errorlog' => 'error.log',
+ 'logtype' => 'file',
+ 'syslogfacility' => 'local5',
+ 'syslogidentification' => 'smsd',
+ 'user' => 'sms',
+ 'group' => 'staff',
+ 'cycle' => 30,
+ 'maxlength' => 1500,
+ 'countlocations' => 20,
+ 'inboxfoldernr' => 1,
+ };
+
+ if ( -r $config_file ) {
+
+ debug "Reading config file '" . $config_file . "' ...";
+
+ eval {
+ my $conf = new Config::General(%$config_options);
+ %config = $conf->getall;
+ };
+ if ( $@ ) {
+ error "Error in reading config file '" . $config_file . "':" . $@, "notice";
+ return undef;
+ }
+
+ debug( "Read configuration: " . Dumper( \%config ), 2 );
+
+ # Failure analysis
+
+ $config{'debug'} = $defaults->{'debug'} unless defined $config{'debug'};
+ ( $tmp ) = $config{'debug'} =~ /^\D*(\d+)/;
+ $tmp ||= 0;
+ $tmp = int( $tmp );
+ $config{'debug'} = ($tmp >= 0 and $tmp <= 3) ? $tmp : 0;
+
+ $config{'directories'} ||= {};
+
+ # Checking base directory
+ $config{'directories'}{'base'} = $defaults->{'directories'}{'base'} unless $config{'directories'}{'base'};
+ unless ( -d $config{'directories'}{'base'} ) {
+ error "Base directory '" . $config{'directories'}{'base'} . "' doesn't exists.";
+ delete $config{'directories'}{'base'};
+ $ok = undef;
+ }
+
+ if ( $config{'directories'}{'base'} ) {
+ foreach $dir ( @DirKeys ) {
+ $config{'directories'}{$dir} = $defaults->{'directories'}{$dir} unless $config{'directories'}{$dir};
+ $tmp = $config{'directories'}{$dir};
+ $tmp = $config{'directories'}{'base'} . "/" . $config{'directories'}{$dir} unless $config{'directories'}{$dir} =~ m#^/#;
+ unless ( -d $tmp ) {
+ error $dir . " directory '" . $tmp . "' doesn't exists.";
+ $ok = undef;
+ }
+ }
+ }
+
+ $config{'pidfile'} = $defaults->{'pidfile'} unless $config{'pidfile'};
+ if ( $config{'pidfile'} !~ m#^/# ) {
+ error "Pidfile must be an absolute path.";
+ $ok = undef;
+ } else {
+ ($tmp) = $config{'pidfile'} =~ m#(.*)/#;
+ $tmp ||= "/";
+ debug "Pid-Directory: '" . $tmp . "'.", 2;
+ $config{'piddir'} = $tmp;
+ unless ( -d $tmp ) {
+ error "Directory of Pid-File '" . $tmp . "' doesn't exists.";
+ $ok = undef;
+ }
+ }
+
+ $config{'outlog'} = $defaults->{'outlog'} unless $config{'outlog'};
+ $config{'errorlog'} = $defaults->{'errorlog'} unless $config{'errorlog'};
+
+ $config{'logtype'} = $defaults->{'logtype'} unless $config{'logtype'};
+ $config{'logtype'} = lc $config{'logtype'};
+ unless ( $config{'logtype'} eq 'syslog' or $config{'logtype'} eq 'file' ) {
+ error "Unknown typ of logging: '" . $config{'logtype'} . "', using '" . $defaults->{'logtype'} . "'.";
+ $config{'logtype'} = $defaults->{'logtype'};
+ }
+
+ $config{'syslogfacility'} = $defaults->{'syslogfacility'} unless $config{'syslogfacility'};
+ if ( $config{'logtype'} eq 'syslog' ) {
+ unless ( check_syslog_token $config{'syslogfacility'} ) {
+ error "Unknown syslog facility '" . $config{'syslogfacility'} . "', using '" . $defaults->{'syslogfacility'} . "'.";
+ $config{'syslogfacility'} = $defaults->{'syslogfacility'};
+ }
+ }
+ $config{'syslogidentification'} = $defaults->{'syslogidentification'} unless $config{'syslogidentification'};
+
+ $config{'user'} = $defaults->{'user'} unless $config{'user'};
+ $tmp = getpwnam($config{'user'});
+ unless ( defined $tmp ) {
+ error "User '" . $config{'user'} . "' doesn't exists on this system.";
+ $ok = undef;
+ }
+
+ $config{'group'} = $defaults->{'group'} unless $config{'group'};
+ $tmp = getgrnam($config{'group'});
+ unless ( defined $tmp ) {
+ error "Group '" . $config{'group'} . "' doesn't exists on this system.";
+ $ok = undef;
+ }
+
+ $config{'sendmailexecutable'} = $defaults->{'sendmailexecutable'} unless $config{'sendmailexecutable'};
+ unless ( -x $config{'sendmailexecutable'} ) {
+ error "Sendmail executable '" . $config{'sendmailexecutable'} . "' doesn't exists on this system.";
+ $ok = undef;
+ }
+
+ $config{'cycle'} = $defaults->{'cycle'} unless $config{'cycle'};
+ ($tmp) = $config{'cycle'} =~ /(\d+)/;
+ if ( ! $tmp or $tmp < 5 or $tmp > 7200 ) {
+ error "Invalid value of Cycle '" . $config{'cycle'} . "', using " . $defaults->{'cycle'} . ".";
+ $config{'cycle'} = $defaults->{'cycle'};
+ } else {
+ $config{'cycle'} = int( $tmp );
+ }
+
+ $config{'maxlength'} = $defaults->{'maxlength'} unless $config{'maxlength'};
+ ($tmp) = $config{'maxlength'} =~ /(\d+)/;
+ if ( ! $tmp or $tmp < 150 or $tmp > 1500 ) {
+ error "Invalid value of maximum length of a sms '" . $config{'maxlength'} . "', using " .
+ $defaults->{'maxlength'} . ".";
+ $config{'maxlength'} = $defaults->{'maxlength'};
+ } else {
+ $config{'maxlength'} = int( $tmp );
+ }
+
+ $config{'countlocations'} = $defaults->{'countlocations'} unless $config{'countlocations'};
+ ($tmp) = $config{'countlocations'} =~ /(\d+)/;
+ if ( ! $tmp or $tmp < 1 or $tmp > 100000 ) {
+ error "Invalid value of count locations on SIM '" . $config{'countlocations'} . "', using " .
+ $defaults->{'countlocations'} . ".";
+ $config{'countlocations'} = $defaults->{'countlocations'};
+ } else {
+ $config{'countlocations'} = int( $tmp );
+ }
+
+ $config{'inboxfoldernr'} = $defaults->{'inboxfoldernr'} unless $config{'inboxfoldernr'};
+ ($tmp) = $config{'inboxfoldernr'} =~ /(\d+)/;
+ if ( ! $tmp or $tmp < 1 or $tmp > 100000 ) {
+ error "Invalid value of inbox folder nr '" . $config{'inboxfoldernr'} . "', using " . $defaults->{'inboxfoldernr'} . ".";
+ $config{'inboxfoldernr'} = $defaults->{'inboxfoldernr'};
+ } else {
+ $config{'inboxfoldernr'} = int( $tmp );
+ }
+
+ unless ( $ok ) {
+ error "Failures found in config file '" . $config_file . "', not used.", 'notice';
+ return undef;
+ }
+
+ } else {
+ error "Config file '" . $config_file . "' doesn't exists, using default configuration.";
+ return undef if $dedicated_conf;
+ %config = %$defaults;
+ }
+
+ debug "Used configuration: " . Dumper( \%config ), 2;
+
+ $verbose = ( $config{'debug'} and $config{'debug'} > $cmdline_verbose ) ? $config{'debug'} : $cmdline_verbose;
+ $base_dir = $config{'directories'}{'base'};
+ $out_dir = $config{'directories'}{'outbox'} =~ m#^/# ? $config{'directories'}{'outbox'} :
+ $base_dir . "/" . $config{'directories'}{'outbox'};
+ $in_dir = $config{'directories'}{'inbox'} =~ m#^/# ? $config{'directories'}{'inbox'} :
+ $base_dir . "/" . $config{'directories'}{'inbox'};
+ $error_dir = $config{'directories'}{'error'} =~ m#^/# ? $config{'directories'}{'error'} :
+ $base_dir . "/" . $config{'directories'}{'error'};
+ $work_dir = $config{'directories'}{'work'} =~ m#^/# ? $config{'directories'}{'work'} :
+ $base_dir . "/" . $config{'directories'}{'work'};
+ $sent_dir = $config{'directories'}{'sent'} =~ m#^/# ? $config{'directories'}{'sent'} :
+ $base_dir . "/" . $config{'directories'}{'sent'};
+ $logdir = $config{'directories'}{'log'} =~ m#^/# ? $config{'directories'}{'log'} :
+ $base_dir . "/" . $config{'directories'}{'log'};
+ $outlogfile = $config{'outlog'} =~ m#^/# ? $config{'outlog'} :
+ $logdir . "/" . $config{'outlog'};
+ $errorlogfile = $config{'errorlog'} =~ m#^/# ? $config{'errorlog'} :
+ $logdir . "/" . $config{'errorlog'};
+ $run_dir = $config{'piddir'};
+ $pidfile = $config{'pidfile'};
+ $lockfile = $run_dir . "/smsd.lock";
+ $user = $config{'user'};
+ $group = $config{'group'};
+ $count_locations = $config{'countlocations'};
+ $inbox_folder_nr = $config{'inboxfoldernr'};
+ $cycle = $config{'cycle'};
+ $maxlen = $config{'maxlength'};
+
+ $sendmail_exe = $config{'sendmailexecutable'};
+
+ $logtype = $config{'logtype'};
+ $syslog_facility = $config{'syslogfacility'};
+ $syslog_ident = $config{'syslogidentification'};
+
+ %config = ();
+ undef $defaults;
+
+ return 1;
+
+}
+
+#-------------------------------------------------------------------------
+
+=head2 reaper
+
+Blaster all zombies away.
+
+=cut
+
+sub reaper() {
+ $zombies = 0;
+ while ( waitpid( -1, WNOHANG ) > 0 ) {
+ $childs--;
+ }
+}
+
+#------------------------------------------------------------------
+
+__END__
+
+=head1 AUTHOR
+
+Frank Brehm L<mailto:brehm@strato.de>
+
+=cut
projects / scripts / solaris.git / commitdiff